diff --git a/.dir-locals.el b/.dir-locals.el index 06ebedb7a49..af92eac5bba 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -18,6 +18,7 @@ (vc-default-patch-addressee . "bug-gnu-emacs@gnu.org"))) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" + "ATTRIBUTE_NO_SANITIZE_ADDRESS" "UNINIT" "CALLBACK" "ALIGN_STACK" "ATTRIBUTE_MALLOC" "ATTRIBUTE_DEALLOC_FREE" "ANDROID_EXPORT" "TEST_STATIC" "INLINE_HEADER_BEGIN" "INLINE_HEADER_END")) diff --git a/.mailmap b/.mailmap index 56876a30fbe..18b278961ca 100644 --- a/.mailmap +++ b/.mailmap @@ -22,6 +22,9 @@ Andrea Corallo Andrea Corallo Andrea Corallo Andrea Corallo +Andrea Corallo +Andrea Corallo +Andrea Corallo Andrew G Cohen Andrew G Cohen Arash Esbati @@ -68,6 +71,7 @@ Eric S. Raymond Etienne Prud’homme Fabián Ezequiel Gallina Fabián Ezequiel Gallina +Felicián Németh Francis Litterio Gabor Vida Gerd Möllmann @@ -79,14 +83,17 @@ Gnus developers Gregory Heytings Grégoire Jadi Ian Dunn +Ignacio Casso Jan Djärv Jan Djärv +Jan Synáček Jason Rumney Jeff Walsh Jeff Walsh Jeff Walsh Jens Lechtenbörger Jim Blandy +Jim Meyering U. Ser Jimmy Aguilar Mena Joakim Verona Joakim Verona @@ -151,6 +158,7 @@ Philip Kaludercic Philip Kaludercic Philip Kaludercic Philipp Stephani +Philipp Stephani Phillip Lord Pierre Lorenzon Pieter van Oostrum @@ -158,8 +166,9 @@ Pip Cet Po Lu Po Lu Po Lu via Przemysław Wojnowski -Rasmus +Rasmus Pank Roulund Richard M. Stallman +Robert Brown Robert J. Chassell Robert Weiner Roland Winkler @@ -183,6 +192,7 @@ Tassilo Horn Ted Zlatanov Thien-Thi Nguyen Thierry Volpiatto +Thuna Tino Calancha Tino Calancha Tom Tromey diff --git a/CONTRIBUTE b/CONTRIBUTE index 936aa326e89..0ab45a99ee2 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -160,8 +160,8 @@ If your test lasts longer than some few seconds, mark it in its 'ert-deftest' definition with ":tags '(:expensive-test)". To run tests on the entire Emacs tree, run "make check" from the -top-level directory. Most tests are in the directory "test/". From -the "test/" directory, run "make " to run the tests for +top-level directory. Most tests are in the directory "test/". From the +"test/" directory, run "make -tests" to run the tests for .el(c). See "test/README" for more information. If you're making changes that involve the Emacs build system, please @@ -172,6 +172,25 @@ test 'out-of-tree' builds as well, i.e.: ../path-to-emacs-sources/configure make +It is a good practice to run the unit test of a change prior to committing. +If you have changed, e.g., the file "xt-mouse.el", you can run the unit +tests via + + make && make -C test xt-mouse-tests + +Changes in code that implements infrastructure capabilities might affect +many tests in the test suite, not just the tests for the source files +you changed. For such changes, we recommend running unit tests that +invoke the functions you have changed. You can search for the tests +that might be affected using tools like Grep. For example, suppose you +make a change in the 'rename-file' primitive. Then + + grep -Rl rename-file test --include="*.el" + +will show all the unit tests which invoke rename-file; run them all to +be sure your changes didn't break the test suite. If in doubt, run the +entire suite. + ** Commit messages Ordinarily, a changeset you commit should contain a description of the diff --git a/Makefile.in b/Makefile.in index 342bec11d81..57cfcfd1605 100644 --- a/Makefile.in +++ b/Makefile.in @@ -859,7 +859,7 @@ install-etc: rm -f $${tmp} tmp=etc/emacsclient.tmpdesktop; rm -f $${tmp}; \ client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \ - sed -e "/^Exec=/ s|emacsclient|${bindir}/$${client_name}|" \ + sed -e "/^Exec=/ s|emacsclient|${bindir}/$${client_name}|g" \ -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \ $(USE_STARTUP_NOTIFICATION_SED_CMD) \ $(USE_WAYLAND_DISPLAY_SED_CMD) \ @@ -888,11 +888,9 @@ install-etc: rm -f $${tmp} umask 022; $(MKDIR_P) "$(DESTDIR)$(systemdunitdir)" tmp=etc/emacs.tmpservice; rm -f $${tmp}; \ - client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \ sed -e '/^##/d' \ -e "/^Documentation/ s/emacs(1)/${EMACS_NAME}(1)/" \ -e "/^ExecStart/ s|emacs|${bindir}/${EMACS}|" \ - -e "/^ExecStop/ s|emacsclient|${bindir}/$${client_name}|" \ ${srcdir}/etc/emacs.service > $${tmp}; \ $(INSTALL_DATA) $${tmp} "$(DESTDIR)$(systemdunitdir)/${EMACS_NAME}.service"; \ rm -f $${tmp} diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 8db9388b6ed..207a6a920f9 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -390,6 +390,38 @@ Yuan Fu 3. Externally maintained packages. ============================================================================== +CC Mode + Maintainer: Alan Mackenzie + Website: https://www.nongnu.org/cc-mode + Repository: https://hg.savannah.nongnu.org/hgweb/cc-mode/ + Bug reports: bug-cc-mode@gnu.org + + lisp/progmodes/cc-*.el + +Modus themes + Maintainer: Protesilaos Stavrou + Repository: https://github.com/protesilaos/modus-themes + + doc/misc/modus-themes.org + etc/themes/modus*.el + +Org Mode + Maintainer: Org Mode developers + Website: https://orgmode.org/ + Repository: https://git.savannah.gnu.org/git/emacs/org-mode.git + Mailing list: emacs-orgmode@gnu.org + Bug Reports: M-x org-submit-bug-report + Notes: Org Mode is maintained as a separate project that is + periodically merged into Emacs. To view or participate in + Org Mode development, please go to https://orgmode.org/ and + follow the instructions there. + + lisp/org/*.el + etc/org/* + etc/refcards/orgcard.tex + doc/misc/org.org + doc/misc/org-setup.org + Tramp Maintainer: Michael Albinus Repository: https://git.savannah.gnu.org/git/tramp.git @@ -409,30 +441,6 @@ Transient lisp/transient.el doc/misc/transient.texi -Modus themes - Maintainer: Protesilaos Stavrou - Repository: https://github.com/protesilaos/modus-themes - - doc/misc/modus-themes.org - etc/themes/modus*.el - -Org Mode - Home Page: https://orgmode.org/ - Maintainer: Org Mode developers - Repository: https://git.savannah.gnu.org/git/emacs/org-mode.git - Mailing list: emacs-orgmode@gnu.org - Bug Reports: M-x org-submit-bug-report - Notes: Org Mode is maintained as a separate project that is - periodically merged into Emacs. To view or participate in - Org Mode development, please go to https://orgmode.org/ and - follow the instructions there. - - lisp/org/*.el - etc/org/* - etc/refcards/orgcard.tex - doc/misc/org.org - doc/misc/org-setup.org - ;;; Local Variables: ;;; coding: utf-8 diff --git a/admin/authors.el b/admin/authors.el index e02ce550ac3..a7c5938fdad 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -264,6 +264,7 @@ files.") ;; There are other Stefans. ;;; ("Stefan Monnier" "Stefan") (nil "ssnnoo") + ("Stephane Marks" "shipmints@gmail\\.com") ("Steven L. Baur" "SL Baur" "Steven L Baur") ("Stewart M. Clamen" "Stewart Clamen") (nil "StrawberryTea" "look@strawberrytea\\.xyz") @@ -278,7 +279,7 @@ files.") ("Thomas Dye" "Tom Dye") ("Thomas Horsley" "Tom Horsley") ; FIXME ? ("Thomas Wurgler" "Tom Wurgler") - (nil "thuna\\.cing@gmail\\.com") + ("Umut Tuna Akgül" "thuna\\.cing@gmail\\.com") ("Toby Cubitt" "Toby S\\. Cubitt") ("Tomohiko Morioka" "MORIOKA Tomohiko") ("Torbjörn Axelsson" "Torbjvrn Axelsson") diff --git a/admin/download-android-deps.sh b/admin/download-android-deps.sh new file mode 100644 index 00000000000..e40392381d7 --- /dev/null +++ b/admin/download-android-deps.sh @@ -0,0 +1,133 @@ +#!/bin/sh + +# This script downloads and extracts dependencies from +# https://sourceforge.net/projects/android-ports-for-gnu-emacs/ and +# Android source code repositories for the convenience of packagers. +# +# See https://forum.f-droid.org/t/emacs-packaging/30424/12 for +# context. + +set -e + +bits_64=no + +if [ "$1" == "64" ]; then + bits_64=yes +fi + +ndk_path= + +mirror=${2-https://master.dl.sourceforge.net/project/android-ports-for-gnu-emacs} + +download_tarball () +{ + echo "Downloading $mirror/$1" + curl -OL $mirror/$1 + hash=`shasum $1 | cut -d " " -f 1` + if test "$hash" != "$3"; then + echo "Hash mismatch detected with archive $1:\ + expected $3, but received $hash." + exit 1 + fi + tar xfz $1 $2 + + if test ! -d "$2"; then + echo "\`$1' was extracted but without producing the directory \`$2'." >&2 + exit 1 + fi + + ndk_path="$ndk_path $PWD/$2" +} + +# 31e74492a49cde9e420e2c71f6d6de0f2b9d6fd3 cairo-1.16.0-emacs.tar.gz +# 98de96764c64f31a6df23adec65425e1813f571b gdk-pixbuf-2.22.1-emacs.tar.gz +# a407c568961d729bb2d0175a34e0d4ed4a269978 giflib-5.2.1-emacs.tar.gz +# e63bc0a628cec770a3a5124c00873d4a44c8c1ac glib-2.33.14-emacs.tar.gz +# 66518ea7905cdb42a22b6f003551ca3f73d249f0 gmp-6.3.0-emacs.tar.gz +# 4e92fb479c96f1c0e9eb3577262f1ebe609a752e gnutls-3.8.5-emacs-armv7a.tar.gz +# 0491c778a81e42490789db9b30a9b7c69b650618 gnutls-3.8.5-emacs.tar.gz +# 22dc71d503ab2eb263dc8411de9da1db144520f5 harfbuzz-7.1.0-emacs.tar.gz +# 590f6c6c06dfe19a8190f526b5b76de34b999a07 libcroco-0.6.13-emacs.tar.gz +# 23508b52a8d9fc3f3750c0187e4141b0d06f79c9 libffi-3.4.5-emacs.tar.gz +# b9398f30e882b140ec790a761663e829ba9bce31 libiconv-1.17-emacs.tar.gz +# 5091fe6f8b368ea2dcc92e2fd003add7bbc63a0a libjpeg-turbo-3.0.2-emacs.tar.gz +# 85e10d1d289d7fd4621cb9648533a0cc69f352a8 libpng-1.6.41-emacs.tar.gz +# 8361966e19fe25ae987b08799f1442393ae6366b libselinux-3.6-emacs.tar.gz +# fdc827211075d9b70a8ba6ceffa02eb48d6741e9 libtasn1-4.19.0-emacs.tar.gz +# 73c3174f7b22d3cfedad9eb58db916199575eea4 libxml2-2.12.4-emacs.tar.gz +# 94882f5494e5435f885d64b57e3e7b3ee5345a3b nettle-3.8-emacs.tar.gz +# b4680fcfec66220a09618489584c8f3270cc16fd p11-kit-0.24.1-emacs.tar.gz +# 89bb17b09d4381835b32291a65107dc33281e88b pango-1.38.1-emacs.tar.gz +# 1c8f3b0cbad474da0ab09018c4ecf2119ac4a52d pixman-0.38.4-emacs.tar.gz +# b687c8439d51634d921674dd009645e24873ca36 rsvg-2.40.21-emacs.tar.gz +# eda251614598aacb06f5984a0a280833de456b29 tiff-4.5.1-emacs.tar.gz +# c00d0ea9c6e848f5cce350cb3ed742024f2bdb8b tree-sitter-0.20.7-emacs.tar.gz + +download_tarball "giflib-5.2.1-emacs.tar.gz" "giflib-5.2.1" \ + "a407c568961d729bb2d0175a34e0d4ed4a269978" +download_tarball "libjpeg-turbo-3.0.2-emacs.tar.gz" "libjpeg-turbo-3.0.2" \ + "5091fe6f8b368ea2dcc92e2fd003add7bbc63a0a" +download_tarball "libpng-1.6.41-emacs.tar.gz" "libpng-1.6.41" \ + "85e10d1d289d7fd4621cb9648533a0cc69f352a8" +download_tarball "libxml2-2.12.4-emacs.tar.gz" "libxml2-2.12.4" \ + "73c3174f7b22d3cfedad9eb58db916199575eea4" +download_tarball "gmp-6.3.0-emacs.tar.gz" "gmp-6.3.0" \ + "66518ea7905cdb42a22b6f003551ca3f73d249f0" +download_tarball "nettle-3.8-emacs.tar.gz" "nettle-3.8" \ + "94882f5494e5435f885d64b57e3e7b3ee5345a3b" + +if test "$bits_64" = "yes"; then + download_tarball "gnutls-3.8.5-emacs.tar.gz" "gnutls-3.8.5" \ + "0491c778a81e42490789db9b30a9b7c69b650618" +else + download_tarball "gnutls-3.8.5-emacs-armv7a.tar.gz" "gnutls-3.8.5-armv7a" \ + "4e92fb479c96f1c0e9eb3577262f1ebe609a752e" +fi + +download_tarball "p11-kit-0.24.1-emacs.tar.gz" "p11-kit-0.24.1" \ + "b4680fcfec66220a09618489584c8f3270cc16fd" +download_tarball "libtasn1-4.19.0-emacs.tar.gz" "libtasn1-4.19.0" \ + "fdc827211075d9b70a8ba6ceffa02eb48d6741e9" +download_tarball "libselinux-3.6-emacs.tar.gz" "libselinux-3.6" \ + "8361966e19fe25ae987b08799f1442393ae6366b" +download_tarball "tree-sitter-0.20.7-emacs.tar.gz" "tree-sitter-0.20.7" \ + "c00d0ea9c6e848f5cce350cb3ed742024f2bdb8b" +download_tarball "harfbuzz-7.1.0-emacs.tar.gz" "harfbuzz-7.1.0" \ + "22dc71d503ab2eb263dc8411de9da1db144520f5" +download_tarball "tiff-4.5.1-emacs.tar.gz" "tiff-4.5.1" \ + "eda251614598aacb06f5984a0a280833de456b29" +download_tarball "gdk-pixbuf-2.22.1-emacs.tar.gz" "gdk-pixbuf-2.22.1" \ + "98de96764c64f31a6df23adec65425e1813f571b" +download_tarball "glib-2.33.14-emacs.tar.gz" "glib-2.33.14" \ + "e63bc0a628cec770a3a5124c00873d4a44c8c1ac" +download_tarball "libcroco-0.6.13-emacs.tar.gz" "libcroco-0.6.13" \ + "590f6c6c06dfe19a8190f526b5b76de34b999a07" +download_tarball "rsvg-2.40.21-emacs.tar.gz" "librsvg-2.40.21" \ + "b687c8439d51634d921674dd009645e24873ca36" +download_tarball "cairo-1.16.0-emacs.tar.gz" "cairo-1.16.0" \ + "31e74492a49cde9e420e2c71f6d6de0f2b9d6fd3" +download_tarball "libiconv-1.17-emacs.tar.gz" "libiconv-1.17" \ + "b9398f30e882b140ec790a761663e829ba9bce31" +download_tarball "pango-1.38.1-emacs.tar.gz" "pango-1.38.1" \ + "89bb17b09d4381835b32291a65107dc33281e88b" +download_tarball "pixman-0.38.4-emacs.tar.gz" "pixman-0.38.4" \ + "1c8f3b0cbad474da0ab09018c4ecf2119ac4a52d" +download_tarball "libffi-3.4.5-emacs.tar.gz" "libffi-3.4.5" \ + "23508b52a8d9fc3f3750c0187e4141b0d06f79c9" + +rm -rf sqlite +git clone https://android.googlesource.com/platform/external/sqlite -b android-7.1.2_r39 +ndk_path="$ndk_path $PWD/sqlite/dist" +rm -rf pcre +git clone https://android.googlesource.com/platform/external/pcre -b android-7.1.2_r39 +ndk_path="$ndk_path $PWD/pcre" +rm -rf libwebp +git clone https://chromium.googlesource.com/webm/libwebp -b v1.5.0 +ndk_path="$ndk_path $PWD/libwebp" + +sed -e 's/NEON := c.neon/NEON := c/g' \ + -e '/WEBP_CFLAGS *+=/s/-DHAVE_CPU_FEATURES_H//g' \ + -e 's/USE_CPUFEATURES *.*=.*$/USE_CPUFEATURES := no/g' \ + -i libwebp/Android.mk + +echo $ndk_path > search-path.txt diff --git a/admin/notes/tree-sitter/build-module/batch.sh b/admin/notes/tree-sitter/build-module/batch.sh index 012b5882e83..1b5214267f5 100755 --- a/admin/notes/tree-sitter/build-module/batch.sh +++ b/admin/notes/tree-sitter/build-module/batch.sh @@ -11,6 +11,7 @@ languages=( 'elixir' 'go' 'go-mod' + 'go-work' 'heex' 'html' 'java' diff --git a/admin/notes/tree-sitter/build-module/build.sh b/admin/notes/tree-sitter/build-module/build.sh index 9a567bb094d..4f3c6da3c5f 100755 --- a/admin/notes/tree-sitter/build-module/build.sh +++ b/admin/notes/tree-sitter/build-module/build.sh @@ -39,6 +39,11 @@ case "${lang}" in lang="gomod" org="camdencheek" ;; + "go-work") + # The parser is called "gowork". + lang="gowork" + org="omertuc" + ;; "heex") org="phoenixframework" ;; diff --git a/configure.ac b/configure.ac index 0fb35dd0e5c..d7f1788d422 100644 --- a/configure.ac +++ b/configure.ac @@ -2176,9 +2176,7 @@ case "$opsys" in ;; openbsd) - ## Han Boetes says this is necessary, - ## otherwise Emacs dumps core on elf systems. - LD_SWITCH_SYSTEM="-Z" + : ;; esac AC_SUBST([LD_SWITCH_SYSTEM]) @@ -2970,6 +2968,17 @@ if test "${opsys}" = "haiku" && test "${with_be_app}" = "yes"; then [AC_MSG_ERROR([The Application Kit headers required for building with the Application Kit were not found or cannot be compiled. Either fix this, or re-configure with the option '--without-be-app'.])]) + AC_CACHE_CHECK([whether BObjectList accepts ownership as a template parameter], + [emacs_cv_bobjectlist_ownership_is_template_parameter], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ + #include + #include + static BObjectList test;]], [])], + [emacs_cv_bobjectlist_ownership_is_template_parameter=yes], + [emacs_cv_bobjectlist_ownership_is_template_parameter=no])]) + AS_IF([test "x$emacs_cv_bobjectlist_ownership_is_template_parameter"], + [AC_DEFINE([BOBJECTLIST_OWNERSHIP_IS_TEMPLATE_PARAMETER], [1], + [Define to 1 if BObjectList ownership is defined as a template parameter.])]) AC_LANG_POP([C++]) fi @@ -7545,8 +7554,8 @@ for opt in ACL BE_APP CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTING HARFBUZZ IMAGEMAGICK JPEG LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ M17N_FLT MODULES MPS NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PGTK PNG RSVG SECCOMP \ SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS TREE_SITTER \ - UNEXEC WEBP X11 XAW3D XDBE XFT XIM XINPUT2 XPM XWIDGETS X_TOOLKIT \ - ZLIB; do + UNEXEC WEBP X11 XAW3D XDBE XFT XIM XINERAMA XINPUT2 XPM XRANDR XWIDGETS \ + X_TOOLKIT ZLIB; do case $opt in PDUMPER) val=${with_pdumper} ;; diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 53c53723074..a1801d378ea 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -1179,7 +1179,7 @@ from improved reproductions of Unix command-line utilities to package repositories providing extensive collections of free GNU and Unix software. - @uref{http://busybox.net, Busybox} provides Unix utilities and + @uref{https://busybox.net, Busybox} provides Unix utilities and limited replicas of certain popular GNU programs such as @command{wget} in a single statically-linked Linux binary, which is capable of running under Android. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index cbb37ac09c7..a894252b198 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1420,10 +1420,11 @@ this search is skipped for remote files. If needed, the search can be extended for remote files by setting the variable @code{enable-remote-dir-locals} to @code{t}. - You can also use @file{.dir-locals-2.el}; if found, Emacs loads it -in addition to @file{.dir-locals.el}. This is useful when -@file{.dir-locals.el} is under version control in a shared repository -and can't be used for personal customizations. + You can also use @file{.dir-locals-2.el}; if found in the same +directory as @file{.dir-locals.el}, Emacs loads it in addition to +@file{.dir-locals.el}. This is useful when @file{.dir-locals.el} is +under version control in a shared repository and can't be used for +personal customizations. The @file{.dir-locals.el} file should hold a specially-constructed list, which maps major mode names (symbols) to alists diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 3db291d68e9..3bc7d6ea24a 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1072,6 +1072,22 @@ identify and update that custom template: @end group @end example +Here is another example, with the time stamp inserted into the last +paragraph of an HTML document. The @code{%%} in the pattern asks for +the default format. + +@example +@r{@dots{}} +

Last modified:

+ + + +@end example + @vindex time-stamp-format By default the time stamp is formatted according to your locale setting (@pxref{Environment}) and diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index e0d8a607072..9992c39dcc9 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -1296,7 +1296,7 @@ menus' visual appearance. @section Tool Bars @cindex tool bar mode @cindex tool bar, attached to frame -@cindex mode, Tool Bar +@cindex mode, tool bar @cindex icons, toolbar On graphical displays, Emacs puts a @dfn{tool bar} at the top of each @@ -1320,14 +1320,14 @@ control the use of tool bars at startup, customize the variable @code{tool-bar-mode}. @vindex tool-bar-style -@cindex Tool Bar style +@cindex tool bar style When Emacs is compiled with GTK+ support, each tool bar item can consist of an image, or a text label, or both. By default, Emacs follows the Gnome desktop's tool bar style setting; if none is defined, it displays tool bar items as just images. To impose a specific tool bar style, customize the variable @code{tool-bar-style}. -@cindex Tool Bar position +@cindex tool bar position You can also control the placement of the tool bar for the GTK+ tool bar with the frame parameter @code{tool-bar-position}. @xref{Frame Parameters,,, elisp, The Emacs Lisp Reference Manual}. diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 2e3191440cb..9b6f7cd8f31 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -35,10 +35,13 @@ install or uninstall packages via this buffer. @xref{Package Menu}. name of a package, and displays a help buffer describing the attributes of the package and the features that it implements. - By default, Emacs downloads packages from a package archive -maintained by the Emacs developers and hosted by the GNU project. -Optionally, you can also download packages from archives maintained by -third parties. @xref{Package Installation}. +@cindex GNU ELPA +@cindex NonGNU ELPA + By default, Emacs downloads packages from two archives: +@url{https://elpa.gnu.org/, GNU ELPA} and @url{https://elpa.nongnu.org/, +NonGNU ELPA}. These are maintained by the Emacs developers and hosted +by the GNU project. Optionally, you can also download packages from +third-party archives. @xref{Package Installation}. For information about turning an Emacs Lisp program into an installable package, @xref{Packaging,,,elisp, The Emacs Lisp Reference @@ -397,17 +400,44 @@ package is somehow unavailable, Emacs signals an error and stops installation.) A package's requirements list is shown in its help buffer. -@vindex package-archives - By default, packages are downloaded from a single package archive -maintained by the Emacs developers. This is controlled by the -variable @code{package-archives}, whose value is a list of package -archives known to Emacs. Each list element must have the form -@code{(@var{id} . @var{location})}, where @var{id} is the name of a -package archive and @var{location} is the @acronym{URL} or + By default, Emacs downloads packages from two archives: +@url{https://elpa.gnu.org/, GNU ELPA} and @url{https://elpa.nongnu.org/, +NonGNU ELPA}. These are maintained by the Emacs developers and hosted +by the GNU project. @dfn{GNU ELPA} contains GNU packages that we +consider part of GNU Emacs, but are distributed separately from the core +Emacs. @dfn{NonGNU ELPA} contains third-party packages whose copyright +has not been assigned to the Free Software Foundation.@footnote{For more +information about copyright assignments, see +@url{https://www.gnu.org/licenses/why-assign.html, Why the FSF Gets +Copyright Assignments from Contributors}.} + +@noindent +This is controlled by the variable @code{package-archives}, whose value +is a list of package archives known to Emacs. Each list element must +have the form @code{(@var{id} . @var{location})}, where @var{id} is the +name of a package archive and @var{location} is the @acronym{URL} or name of the package archive directory. You can alter this list if you wish to use third party package archives---but do so at your own risk, and use only third parties that you think you can trust! +@defopt package-archives +The value of this variable is an alist of package archives recognized +by the Emacs package manager. + +Each alist element corresponds to one archive, and should have the +form @code{(@var{id} . @var{location})}, where @var{id} is the name of +the archive (a string) and @var{location} is its @dfn{base location} +(a string). + +If the base location starts with @samp{http:} or @samp{https:}, it +is treated as an HTTP(S) URL, and packages are downloaded from this +archive via HTTP(S) (as is the case for the default GNU archive). + +Otherwise, the base location should be a directory name. In this +case, Emacs retrieves packages from this archive via ordinary file +access. Such local archives are mainly useful for testing. +@end defopt + @anchor{Package Signing} @cindex package security @cindex package signing diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index 402386684ae..7a2ef9be16e 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -776,6 +776,14 @@ to. The @samp{To} field starts out as the address of the person who sent the message you received, and the @samp{CC} field starts out with all the other recipients of that message. +@vindex rmail-re-abbrevs +@vindex rmail-reply-prefix +@vindex mail-re-regexps +The @samp{Subject} header field may contain one or more instances of +@samp{Re:} or localized variants thereof. These are removed if they +match @code{rmail-re-abbrevs} (which is initialized from +@code{mail-re-regexps}), and @code{rmail-reply-prefix} is prepended. + @vindex mail-dont-reply-to-names You can exclude certain recipients from being included automatically in replies, using the variable @code{mail-dont-reply-to-names}. Its diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index a992f26fcdd..4a35fd54f66 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -511,6 +511,7 @@ selected frame, and display the buffer in that new window. @vindex split-height-threshold @vindex split-width-threshold +@vindex split-window-preferred-direction The split can be either vertical or horizontal, depending on the variables @code{split-height-threshold} and @code{split-width-threshold}. These variables should have integer @@ -519,7 +520,9 @@ window's height, the split puts the new window below. Otherwise, if @code{split-width-threshold} is smaller than the window's width, the split puts the new window on the right. If neither condition holds, Emacs tries to split so that the new window is below---but only if the -window was not split before (to avoid excessive splitting). +window was not split before (to avoid excessive splitting). Whether +Emacs tries first to split vertically or horizontally, is +determined by the value of @code{split-window-preferred-direction}. @item Otherwise, display the buffer in a window previously showing it. @@ -728,6 +731,16 @@ a custom tool bar, you could add the following code to your init file (add-hook 'special-mode-hook 'window-tool-bar-mode) @end example +@vindex window-tool-bar-style +@cindex window tool bar style +On graphical displays the window tool bar can be displayed in several +different styles. By default, the window tool bar displays items as +just images. To impose a specific style, customize the variable +@code{window-tool-bar-style}. + +On text-only displays the window tool bar only shows text for each +button even if another style is specified. + Emacs can also display a single tool bar at the top of frames (@pxref{Tool Bars}). diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi index 50c7ace253c..f3f0902f364 100644 --- a/doc/lispref/backups.texi +++ b/doc/lispref/backups.texi @@ -852,6 +852,30 @@ It is important to assure that point does not continuously jump around as a consequence of auto-reverting. Of course, moving point might be inevitable if the buffer radically changes. +@defvar inhibit-auto-revert-buffers +When the current buffer is member of this variable (a list of buffers), +auto-reverting is suppressed for that buffer. This is useful if serious +changes are applied to that buffer which would be poisoned by an +unexpected auto-revert. After the change is finished, the buffer shall +be removed from @code{inhibit-auto-revert-buffers}. + +The check of membership in @code{inhibit-auto-revert-buffers} is applied +prior to the call of @code{buffer-stale-function}; any heavy check in +that function is avoided, therefore. + +If auto-reverting is triggered by file notification while +@code{inhibit-auto-revert-buffers} prevents this, auto-revert will +happen next time the buffer is polled for changes, unless +@code{auto-revert-avoid-polling} is non-@code{nil}. @pxref{(emacs) Auto +Revert}. +@end defvar + +@defmac inhibit-auto-revert &rest body +This macro adds the current buffer to +@code{inhibit-auto-revert-buffers}, runs @var{body}, and removes the +current buffer from @code{inhibit-auto-revert-buffers} afterwards. +@end defmac + You should make sure that the @code{revert-buffer-function} does not print messages that unnecessarily duplicate Auto Revert's own messages, displayed if @code{auto-revert-verbose} is @code{t}, and effectively diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 39514145a1e..c3891b70406 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2756,6 +2756,14 @@ To test the signal handler, you can make Emacs send a signal to itself: (signal-process (emacs-pid) 'sigusr1) @end smallexample +@cindex @code{sleep-event} event +@item (sleep-event @var{sleep-wake}) +This event is injected when the device Emacs is running on enters or +leaves the sleep state. A non-@code{nil} @var{sleep-wake} indicates +entering the sleep state. + +This is implemented only on GNU/Linux. + @cindex @code{language-change} event @item language-change This kind of event is generated on MS-Windows when the input language @@ -4029,6 +4037,30 @@ The keymap which defines how to handle special events---and which events are special---is in the variable @code{special-event-map} (@pxref{Controlling Active Maps}). +@defun insert-special-event +@cindex inserting special events +This function inserts a special event into the input event queue. Only +event types which are contained in the @code{special-event-map} keymap +are accepted. As a result, the handler specified in the keymap is +invoked. + +The function returns @code{nil}. Example: + +@example +(defun my-event-handler (event) + (interactive "e") + (message "Event arrived: %S" event)) +@result{} my-event-handler + +(keymap-set special-event-map "" #'my-event-handler) +@result{} my-event-handler + +(insert-special-event '(sleep-event t)) +@result{} nil +@result{} "Event arrived: (sleep-event t)" +@end example +@end defun + @node Waiting @section Waiting for Elapsed Time or Input @cindex waiting diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 1064f347a12..c285cd1c683 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2459,6 +2459,14 @@ results in any way. This is almost the same as using @code{concat}, but @var{dirname} (and the non-final components) may or may not end with slash characters, and this function will not double those characters. + +In most cases, one or more calls to @code{expand-file-name} (@pxref{File +Name Expansion} are better suited for the job of generating file names +with leading directories than this function. Use this function only if +some of the special features of @code{expand-file-name} get in the way +of what your program needs to do. For example, the special handling by +@code{expand-file-name} of @file{~}, @file{~@var{user}}, and @code{nil}, +or the removal of @file{.} and @file{..} might not be what you want. @end defun To convert a directory name to its abbreviation, use this @@ -3227,11 +3235,11 @@ for the sake of dired. However, the normally equivalent short as any other option. @end defun -@defvar insert-directory-program -This variable's value is the program to run to generate a directory listing -for the function @code{insert-directory}. It is ignored on systems -which generate the listing with Lisp code. -@end defvar +@defopt insert-directory-program +This user option specifies the program to run to generate a directory +listing for the function @code{insert-directory}. It is ignored on +systems that generate the listing with Lisp code. +@end defopt @node Create/Delete Dirs @section Creating, Copying and Deleting Directories diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 5ce6fc6c5c5..bc2d6b07ae8 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -427,7 +427,12 @@ Name of the physical monitor as @var{string}. @item source Source of the multi-monitor information as @var{string}; -e.g., @samp{XRandR 1.5}, @samp{XRandr} or @samp{Xinerama}. +on X, it could be @samp{XRandR 1.5}, @samp{XRandr}, @samp{Xinerama}, +@samp{Gdk}, or @samp{fallback}. The last value of @samp{source} means +that Emacs was built without GTK and without XRandR or Xinerama +extensions, in which case the information about multiple physical +monitors will be provided as if they all as a whole formed a single +monitor. @end table @var{x}, @var{y}, @var{width}, and @var{height} are integers. @@ -4276,7 +4281,7 @@ selection targets that the owner supports, and @code{MULTIPLE}, used for internal purposes by X clients. A selection owner may support any number of other targets, some of which may be standardized by the X Consortium's -@url{http://x.org/releases/X11R7.6/doc/xorg-docs/specs/ICCCM/icccm.html, +@url{https://x.org/releases/X11R7.6/doc/xorg-docs/specs/ICCCM/icccm.html, Inter-Client Communication Conventions Manual}, while others, such as @code{UTF8_STRING}, were meant to be standardized by the XFree86 Project, but their standardization was never completed. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 6b02624c680..8ed992d3e79 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2998,7 +2998,7 @@ known cases where @code{unsafep} returns @code{nil} for an unsafe expression. However, a safe Lisp expression can return a string with a @code{display} property, containing an associated Lisp expression to be executed after the string is inserted into a buffer. -This associated expression can be a virus. In order to be safe, you +This associated expression can be malicious. In order to be safe, you must delete properties from all strings calculated by user code before inserting them into buffers. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index ecd34b95294..3cc206d2e1d 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1242,6 +1242,16 @@ different function to completely override the normal behavior of @code{completing-read}. @end defvar +@findex completing-read-multiple +@vindex crm-separator +If you need to prompt the user for several strings, like several +elements of a list or several parameters (e.g., user, host, and port) of +a connection, you can use @code{completing-read-multiple}. It allows +typing several strings separated by a separator string (by default, tabs +and commas; customize @code{crm-separator} to change that), and provides +completion for each individual string the user types. It returns the +strings that were read, as a list. + @node Completion Commands @subsection Minibuffer Commands that Do Completion @@ -1705,7 +1715,7 @@ If this variable is non-@code{nil}, @code{read-file-name} ignores case when performing completion. @end defopt -@defun read-directory-name prompt &optional directory default require-match initial +@defun read-directory-name prompt &optional directory default require-match initial predicate This function is like @code{read-file-name} but allows only directory names as completion alternatives. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 25512df5320..6e2a9d8221e 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -4128,7 +4128,7 @@ This variable is normally set through the ``other'' elements in @lisp (setq-local font-lock-defaults `(,python-font-lock-keywords - nil nil nil nil + nil nil nil (font-lock-syntactic-face-function . python-font-lock-syntactic-face-function))) @end lisp @@ -5416,11 +5416,14 @@ on the line which @var{parent}'s start is on. @item standalone-parent This anchor is a function that is called with 3 arguments: @var{node}, -@var{parent}, and @var{bol}. It finds the first ancestor node -(parent, grandparent, etc.@:) of @var{node} that starts on its own -line, and return the start of that node. ``Starting on its own line'' -means there is only whitespace character before the node on the line -which the node's start is on. +@var{parent}, and @var{bol}. It finds the first ancestor node (parent, +grandparent, etc.@:) of @var{node} that starts on its own line, and +return the start of that node. ``Starting on its own line'' means there +is only whitespace character before the node on the line which the +node's start is on. The exact definition of ``Starting on its own +line'' can be relaxed by setting +@code{treesit-simple-indent-standalone-predicate}, some major mode might +want to do that for easier indentation for method chaining. @item prev-sibling This anchor is a function that is called with 3 arguments: @var{node}, diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index 0d8dc6db0eb..2c2cfa68a79 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -309,36 +309,11 @@ hosted on @url{https://elpa.gnu.org, GNU ELPA} and @url{https://elpa.nongnu.org, non-GNU ELPA}. This section describes how to set up and maintain a package archive. -@cindex base location, package archive -@defopt package-archives -The value of this variable is an alist of package archives recognized -by the Emacs package manager. - -Each alist element corresponds to one archive, and should have the -form @code{(@var{id} . @var{location})}, where @var{id} is the name of -the archive (a string) and @var{location} is its @dfn{base location} -(a string). - -If the base location starts with @samp{http:} or @samp{https:}, it -is treated as an HTTP(S) URL, and packages are downloaded from this -archive via HTTP(S) (as is the case for the default GNU archive). - -Otherwise, the base location should be a directory name. In this -case, Emacs retrieves packages from this archive via ordinary file -access. Such local archives are mainly useful for testing. -@end defopt - A package archive is simply a directory in which the package files, and associated files, are stored. If you want the archive to be reachable via HTTP, this directory must be accessible to a web server; @xref{Archive Web Server}. - A convenient way to set up and update a package archive is via the -@code{package-x} library. This is included with Emacs, but not loaded -by default; type @kbd{M-x load-library @key{RET} package-x @key{RET}} to -load it, or add @code{(require 'package-x)} to your init file. -@xref{Lisp Libraries,, Lisp Libraries, emacs, The GNU Emacs Manual}. - @noindent After you create an archive, remember that it is not accessible in the Package Menu interface unless it is in @code{package-archives}. diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 37fb3b49e43..6cddd50c920 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -106,11 +106,11 @@ reference any object. (This is not the same thing as holding the symbol a value cell that is void results in an error, such as @samp{Symbol's value as variable is void}. - Because each symbol has separate value and function cells, variables -names and function names do not conflict. For example, the symbol -@code{buffer-file-name} has a value (the name of the file being -visited in the current buffer) as well as a function definition (a -primitive function that returns the name of the file): + Because each symbol has separate value and function cells, the names +of variables and functions do not conflict. For example, the symbol +@code{buffer-file-name} has a value (the name of the file being visited +in the current buffer) as well as a function definition (a primitive +function that returns the name of the file): @example buffer-file-name diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 5710971a9fa..89ccb8ea740 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -499,33 +499,37 @@ initializes it only if it is originally void. Definitions}. @defspec defvar symbol [value [doc-string]] -This special form defines @var{symbol} as a variable. Note that -@var{symbol} is not evaluated; the symbol to be defined should appear -explicitly in the @code{defvar} form. The variable is marked as -@dfn{special}, meaning that it should always be dynamically bound +This special form defines @var{symbol} as a variable and optionally +initializes and documents it. Note that it doesn't evaluate +@var{symbol}; the symbol to be defined should appear explicitly in the +@code{defvar} form. @code{defvar} also marks @var{symbol} as +@dfn{special}, meaning that its bindings should always be dynamic (@pxref{Variable Scoping}). If @var{value} is specified, and @var{symbol} is void (i.e., it has no -dynamically bound value; @pxref{Void Variables}), then @var{value} is -evaluated and @var{symbol} is set to the result. But if @var{symbol} -is not void, @var{value} is not evaluated, and @var{symbol}'s value is -left unchanged. If @var{value} is omitted, the value of @var{symbol} -is not changed in any case. +dynamically bound value; @pxref{Void Variables}), then @code{defvar} +evaluates @var{value}, and initializes @var{symbol} by setting it to the +result of the evaluation. But if @var{symbol} is not void, +@code{defvar} does not evaluate @var{value}, and leaves @var{symbol}'s +value unchanged. If @var{value} is omitted, @code{defvar} doesn't +change the value of @var{symbol} in any case. Note that specifying a value, even @code{nil}, marks the variable as -special permanently. Whereas if @var{value} is omitted then the -variable is only marked special locally (i.e.@: within the current -lexical scope, or file if at the top-level). This can be useful for -suppressing byte compilation warnings, see @ref{Compiler Errors}. +special permanently. Whereas if @var{value} is omitted, then +@code{defvar} marks the variable special only locally (i.e.@: within the +current lexical scope, or within the current file, if @code{defvar} is +at the top-level). This can be useful for suppressing byte compilation +warnings, see @ref{Compiler Errors}. -If @var{symbol} has a buffer-local binding in the current buffer, -@code{defvar} acts on the default value, which is buffer-independent, -rather than the buffer-local binding. It sets the default value if -the default value is void. @xref{Buffer-Local Variables}. +If @var{symbol} has a buffer-local binding in the current buffer, and +@var{value} is specified, @code{defvar} modifies the default value of +@var{symbol}, which is buffer-independent, rather than the buffer-local +binding. It sets the default value if the default value is void. +@xref{Buffer-Local Variables}. -If @var{symbol} is already let bound (e.g., if the @code{defvar} -form occurs in a @code{let} form), then @code{defvar} sets the toplevel -default value, like @code{set-default-toplevel-value}. +If @var{symbol} is already let bound (e.g., if the @code{defvar} form +occurs in a @code{let} form), then @code{defvar} sets the toplevel +default value of @var{symbol}, like @code{set-default-toplevel-value}. The let binding remains in effect until its binding construct exits. @xref{Variable Scoping}. @@ -2212,8 +2216,9 @@ If some of the subdirectories have their own @file{.dir-locals.el} files, Emacs uses the settings from the deepest file it finds starting from the file's directory and moving up the directory tree. This constant is also used to derive the name of a second dir-locals file -@file{.dir-locals-2.el}. If this second dir-locals file is present, -then that is loaded in addition to @file{.dir-locals.el}. This is useful +@file{.dir-locals-2.el}. If this second dir-locals file is present in +the same directory as @file{.dir-locals.el}, then it will be loaded in +addition to @file{.dir-locals.el}. This is useful when @file{.dir-locals.el} is under version control in a shared repository and cannot be used for personal customizations. The file specifies local variables as a specially formatted list; see diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 7a3aa61b7ce..b8a68f054f2 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -582,7 +582,7 @@ you are going to be editing AWK files, @file{README} describes how to configure your (X)Emacs so that @ccmode{} will supersede the obsolete @code{awk-mode.el} which might have been supplied with your (X)Emacs. @ccmode{} might not work with older versions of Emacs or XEmacs. See -the @ccmode{} release notes at @uref{https://cc-mode.sourceforge.net} +the @ccmode{} release notes at @uref{https://www.nongnu.org/cc-mode/} for the latest information on Emacs version and package compatibility (@pxref{Updating CC Mode}). @@ -3190,11 +3190,11 @@ margins of the texts kept intact: @cindex Filladapt mode It's also possible to use other adaptive filling packages, notably Kyle E. Jones' Filladapt package@footnote{It's available from -@uref{http://www.wonderworks.com/}. As of version 2.12, it does however +@uref{https://elpa.gnu.org/packages/filladapt.html}. As of version 2.12, it does however lack a feature that makes it work suboptimally when @code{c-comment-prefix-regexp} matches the empty string (which it does by default). A patch for that is available from -@uref{https://cc-mode.sourceforge.net/,, the CC Mode web site}.}, +@uref{https://www.nongnu.org/cc-mode/,, the CC Mode web site}.}, @c 2005/11/22: The above is still believed to be the case. which handles things like bulleted lists nicely. There's a convenience function @code{c-setup-filladapt} that tunes the relevant variables in @@ -7804,7 +7804,7 @@ have old versions of @ccmode{} and so should be upgraded. Access to the compatibility, etc.@: are all available on the web site: @quotation -@uref{https://cc-mode.sourceforge.net/} +@uref{https://www.nongnu.org/cc-mode/} @end quotation @@ -7838,7 +7838,7 @@ the GNU Bug Tracker at @url{https://debbugs.gnu.org}, then sends it on to @email{bug-cc-mode@@gnu.org}. You can also send reports, other questions, and suggestions (kudos?@: @t{;-)} to that address. It's a mailing list which you can join or browse an archive of; see the web site at -@uref{https://cc-mode.sourceforge.net/} for further details. +@uref{https://www.nongnu.org/cc-mode/} for further details. @cindex announcement mailing list If you want to get announcements of new @ccmode{} releases, send the diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index c678e8e1e40..bd8010edcb1 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -179,7 +179,7 @@ In your @file{~/.emacs} file, or in the system-wide initialization file (require 'dired-x) ;; Set dired-x global variables here. For example: ;; (setq dired-x-hands-off-my-keys nil) - )) + ) (add-hook 'dired-mode-hook (lambda () ;; Set dired-x buffer-local variables here. For example: diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index c85c7812b11..095af736973 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -481,7 +481,7 @@ Emacs help works best if it is invoked by a single key whose value should be stored in the variable @code{help-char}. Some Emacs slides and tutorials can be found at -@uref{http://web.psung.name/emacs/}. +@uref{https://web.psung.name/emacs/}. @node Learning how to do something @section How do I find out how to do something in Emacs? diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 722766843ec..333e369e440 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -452,6 +452,11 @@ be it the type of a variable, or the name of a formal parameter in a function call. @xref{Eglot Commands} and the @code{eglot-inlay-hints-mode} minor mode. +@item +Display of function call and type hierarchies via the +@code{eglot-show-call-hierarchy} and @code{eglot-show-type-hierarchy} +commands (@pxref{Eglot Commands}). + @item Code reformatting via the @code{eglot-format} and related commands (@pxref{Eglot Commands}). Automatic reformatting of source code is also @@ -738,6 +743,16 @@ instead of indicating problems. For example, a C++ language server can serve hints about positional parameter names in function calls and a variable's automatically deduced type. Inlay hints help the user not have to remember these things by heart. + +@cindex type hierarchy +@item M-x eglot-show-type-hierarchy +Pop up a special buffer showing a interactive tree which represents a +hierarchy of subtypes and supertypes for the symbol at point. + +@cindex call hierarchy +@item M-x eglot-call-type-hierarchy +Pop up a special buffer showing a interactive tree which represents a +hierarchy of callers and callee for the symbol at point. @end ftable The following Eglot commands are used less commonly, mostly for diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 7c934d8bb3a..1c0afa3b300 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -452,7 +452,7 @@ Buttonize URLs, nicknames, and other text Mark unidentified users on freenode and other servers supporting CAPAB. @cindex modules, command-indicator -@item command-indicator +@item command-indicator (local) Echo command lines for ``slash commands'', like @kbd{/JOIN #erc} and @kbd{/HELP join} @@ -494,7 +494,7 @@ Display a menu in ERC buffers Detect netsplits @cindex modules, nicks -@item nicks +@item nicks (local) Automatically colorize nicks @cindex modules, nickbar @@ -519,10 +519,6 @@ or your nickname is mentioned @item page Process CTCP PAGE requests from IRC -@cindex modules, querypoll -@item querypoll -Update query participant data by continually polling the server - @cindex modules, readonly @item readonly Make displayed lines read-only @@ -536,7 +532,7 @@ Replace text in messages Enable an input history @cindex modules, sasl -@item sasl +@item sasl (local) Enable SASL authentication @cindex modules, scrolltobottom @@ -583,22 +579,26 @@ Translate morse code in messages For various reasons, the following modules aren't currently listed in the Custom interface for @code{erc-modules}, but feel free to add them -explicitly. They may be managed by another module or considered more -useful when toggled interactively or just deemed experimental. +explicitly. They may be managed by another module or just deemed too +niche or experimental. @table @code @cindex modules, fill-wrap -@item fill-wrap +@item fill-wrap (local) Wrap long lines using @code{visual-line-mode} @cindex modules, keep-place-indicator -@item keep-place-indicator +@item keep-place-indicator (local) Remember your place in buffers with a visible reminder; activated interactively or via something like @code{erc-join-hook} +@cindex modules, querypoll +@item querypoll (local) +Update query participant data by continually polling the server + @cindex modules, services-regain -@item services-regain +@item services-regain (local) Automatically ask NickServ to reclaim your nick when reconnecting; experimental as of ERC 5.6 @@ -618,51 +618,84 @@ always loads anyway. @subheading Local Modules @cindex local modules -All modules operate as minor modes under the hood, and some newer ones -may be defined as buffer-local. These so-called ``local modules'' are -a work in progress and their behavior and interface are subject to -change. As of ERC 5.5, the only practical differences are as follows: +@c Earlier language in code comments, commit messages, and tracker +@c discussions used to describe a local module as being "active" in a +@c buffer if it had a local binding but "disabled" if that binding's +@c value was nil. For better or worse, ERC has since abandoned that +@c distinction and now considers "active" to be synonymous with +@c "enabled". + +All modules operate as minor modes under the hood, and newer ones are +mostly defined as buffer-local. These so-called @dfn{local modules} are +a work in progress, and their behavior and interface are subject to +change. As of ERC 5.6, the only practical differences are as follows: @enumerate @item -``Control variables,'' like @code{erc-sasl-mode}, retain their values -across IRC sessions and override @code{erc-module} membership when -influencing module activation. +@dfn{Mode variables}, a.k.a. @dfn{control variables}, like +@code{erc-sasl-mode}, retain their values across IRC sessions. @item Removing a local module from @code{erc-modules} via Customize not only -disables its mode but also kills its control variable in all ERC -buffers. +disables its mode but also kills its mode variable in all ERC buffers. @item -``Mode toggles,'' like @code{erc-sasl-mode} and the complementary -@code{erc-sasl-enable}/@code{erc-sasl-disable} pairing, behave -differently than their global counterparts. +@dfn{Mode commands}, like @code{erc-sasl-mode} and its one-way variants +@code{erc-sasl-enable} and @code{erc-sasl-disable}, behave differently +than their global counterparts. @end enumerate -In target buffers, a local module's activation state survives -``reassociation'' by default, but modules themselves always have the -final say. For example, a module may reset all instances of itself in -its network context upon reconnecting. Moreover, the value of a mode -variable may be meaningless in buffers that its module has no interest -in. For example, the value of @code{erc-sasl-mode} doesn't matter in -target buffers and may even remain non-@code{nil} after SASL has been -disabled for the current connection (and vice versa). +To detect whether a module is local, examine its mode variable. For +example, if you run @kbd{C-h v erc-sasl-mode @key{RET}}, you'll notice +it says ``Automatically becomes buffer-local when set''. You can do the +same in Lisp code with @code{(local-variable-if-set-p 'erc-sasl-mode)}. -When it comes to server buffers, a module's activation state only -persists for sessions revived via the automatic reconnection mechanism -or a manual @samp{/reconnect} issued at the prompt. In other words, -this doesn't apply to sessions revived by an entry-point command, such -as @code{erc-tls}, because such commands always ensure a clean slate -by looking only to @code{erc-modules}. Although a session revived in -this manner may indeed harvest other information from a previous -server buffer, it simply doesn't care which modules might have been -active during that connection. +In an ERC buffer, a local module is either enabled or disabled if its +mode variable has a local binding. This @dfn{activation state} may +contradict a module's presence in @code{erc-modules}, namely, in buffers +where it isn't applicable or has otherwise been disabled. In fact, a +local module's membership in @code{erc-modules} does nothing more than +guarantee -Lastly, a local mode's toggle command, like @code{erc-sasl-mode}, only -affects the current buffer, but its ``non-mode'' cousins, like +@enumerate +@item +its setup code runs in @emph{new} buffers +@item +its mode variable has a local binding in all affected buffers +@end enumerate + +In keeping with this, all built-in local modules disable themselves in +nonapplicable buffers rather than remain no-ops. Some also take strides +to enable themselves elsewhere when needed or at least emit a helpful +error. For example, the @samp{nicks} module does both in server +buffers, where it shares resources among the target buffers it primarily +services. ERC expects third-party local modules to mimic this pattern +and to document what buffer types they operate in: server, query, or +channel. (In the case of @samp{nicks}, it would be all three: it's +@dfn{session-local}.) + +In ERC, you can think of an IRC session as a group of buffers sharing +the same connection to a server. After a connection ends, this +association endures so that ERC can revive the session when +reconnecting. As it does with connection parameters, ERC therefore +persists a local module's activation state through reconnections, +reenabling modules that were previously active while ensuring others are +disabled. A couple related things to note here are + +@enumerate +@item +each module must manage its own application data and restore or reset +its environment accordingly +@item +session persistence is less predictable if a user changes the makeup of +@code{erc-modules} between sessions +@end enumerate + +When it comes to a local module's various activation commands, the +primary mode command, like @code{erc-sasl-mode}, for example, only +affects the current buffer, but its unidirectional cousins, like @code{erc-sasl-enable} and @code{erc-sasl-disable}, operate on all -buffers belonging to their connection (when called interactively). -And unlike global toggles, none of these ever mutates -@code{erc-modules}. +buffers belonging to their connection (when called interactively). And +unlike global toggles, none of these ever mutates @code{erc-modules}. + @c FIXME add section to Advanced chapter for creating modules, and @c move this there. diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 4617453d06d..566fa03bf3f 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -535,6 +535,7 @@ help ERT find the defining call to the macro by putting the property * Useful Techniques:: Some examples. * erts files:: Files containing many buffer tests. * Syntax Highlighting Tests:: Tests for face assignment. +* Helper Functions:: Various helper functions. @end menu @@ -950,6 +951,7 @@ non-@code{nil} value, the test will be skipped. If you need to use the literal line single line @samp{=-=} in a test section, you can quote it with a @samp{\} character. + @node Syntax Highlighting Tests @section Syntax Highlighting Tests @@ -1082,6 +1084,311 @@ The @code{ert-font-lock-deftest} and @code{ert-font-lock-deftest-file} macros accept the same keyword parameters as @code{ert-deftest} i.e., @code{:tag} and @code{:expected-result}. + +@node Helper Functions +@section Various Helper Functions + +The package @file{ert-x.el} contains some macros and functions useful +for writing tests. + +@subsection Test Buffers + +@defmac ert-with-test-buffer ((&key ((:name name-form))) &body body) +This macro creates a test buffer and runs @var{body} in that buffer. If +@var{body} finishes successfully, the test buffer is killed; if there is +an error, the test buffer is kept around for further inspection. + +The test buffer name is derived from the name of the ERT test and the +result of @var{NAME-FORM}. Example: + +@lisp +(ert-deftest backtrace-tests--variables () + (ert-with-test-buffer (:name "variables") + @dots{})) +@end lisp + +This uses the test buffer @file{*Test buffer +(backtrace-tests--variables): variables*}. +@end defmac + +@defmac ert-with-buffer-selected (buffer &body body) +The macro display a buffer in a temporary selected window and runs +@var{body}. If @var{buffer} is @code{nil}, the current buffer is used. + +The buffer is made the current buffer, and the temporary window +becomes the @code{selected-window}, before @var{body} is evaluated. The +modification hooks @code{before-change-functions} and +@code{after-change-functions} are not inhibited during the evaluation +of @var{body}, which makes it easier to use @code{execute-kbd-macro} to +simulate user interaction. The window configuration is restored +before returning, even if @var{body} exits nonlocally. The return +value is the last form in @var{body}. Example: + +@lisp +(with-temp-buffer + (ert-with-buffer-selected nil + @dots{})) +@end lisp + +This displays a temporary buffer like @file{ *temp*-739785*}. +@end defmac + +@defmac ert-with-test-buffer-selected ((&key name) &body body) +This creates a test buffer, switches to it, and runs @var{body}. + +It combines @code{ert-with-test-buffer} and +@code{ert-with-buffer-selected}. The return value is the last form in +@var{body}. Example: + +@lisp +(ert-deftest whitespace-tests--global () + (ert-with-test-buffer-selected (:name "global") + @dots{})) +@end lisp + +This displays the test buffer @file{*Test buffer +(whitespace-tests--global): global*}. +@end defmac + +@defun ert-kill-all-test-buffers () +It kills all test buffers that are still live. +@end defun + +@defmac ert-with-buffer-renamed ((buffer-name-form) &body body) +This macro protects the buffer @var{buffer-name} from side-effects and +runs @var{body}. It renames the buffer @var{buffer-name} to a new +temporary name, creates a new buffer named @var{buffer-name}, executes +@var{body}, kills the new buffer, and renames the original buffer back +to @var{buffer-name}. + +This is useful if @var{body} has undesirable side-effects on an Emacs +buffer with a fixed name such as @file{*Messages*}. Example: + +@lisp +(ert-with-buffer-renamed ("*Messages*") @dots{}) +@end lisp +@end defmac + +@defmac ert-with-message-capture (var &rest body) +This macro executes @var{body} while collecting messages in @var{var}. +It captures messages issued by Lisp code and concatenates them separated +by newlines into one string. This includes messages written by +@code{message} as well as objects printed by @code{print}, @code{prin1} +and @code{princ} to the echo area. Messages issued from C code using +the above mentioned functions will not be captured. + +This is useful for separating the issuance of messages by the code under +test from the behavior of the @file{*Messages*} buffer. Example: + +@lisp +(ert-with-message-capture captured-messages @dots{}) +@end lisp +@end defmac + +@subsection Test Directories and Files + +@defmac ert-resource-directory () +It returns the absolute file name of the resource (test data) directory. +The path to the resource directory is the @file{resources} directory in +the same directory as the test file this is called from. + +If that directory doesn't exist, find a directory based on the test file +name. If the test file is named @file{foo-tests.el}, it returns the +absolute file name for @file{foo-resources}. Example: + +@lisp +(let ((dir (ert-resource-directory))) + @dots{}) +@end lisp + +@vindex ert-resource-directory-format +@vindex ert-resource-directory-trim-left-regexp +@vindex ert-resource-directory-trim-right-regexp +In order to use a different resource directory naming scheme, the +variable @code{ert-resource-directory-format} can be changed. Before +formatting, the file name will be trimmed using @code{string-trim} with +arguments @code{ert-resource-directory-trim-left-regexp} and +@code{ert-resource-directory-trim-right-regexp}. Example: + +@lisp +(let* ((ert-resource-directory-format "test-resources-%s/") + (ert-resource-directory-trim-left-regexp ".*/") + (dir (ert-resource-directory))) + @dots{}) +@end lisp + +uses the absolute file name for @file{test-resources-foo}. +@end defmac + +@defmac ert-resource-file (file) +It returns the absolute file name of resource (test data) file named +@var{file}, which should be a relative file name. A resource file is +defined as any file placed in the resource directory as returned by +@code{ert-resource-directory}. Example: + +@lisp +(let ((file (ert-resource-file "bar/baz"))) + @dots{}) +@end lisp + +It returns the absolute file name for @file{foo-resources/bar/baz} when +called in test file @file{foo-tests.el}. +@end defmac + +@defmac ert-with-temp-file (name &rest body) +This macro binds @var{name} to the name of a new temporary file and +evaluates @var{body}. It deletes the temporary file after @var{body} +exits normally or non-locally. @var{name} will be bound to the file +name of the temporary file. + +The following keyword arguments are supported: + +@table @code +@vindex ert-temp-file-prefix +@item :prefix @var{string} +If non-nil, pass @var{string} to @code{make-temp-file} as +the @var{prefix} argument. Otherwise, use the value of +@code{ert-temp-file-prefix}. + +@vindex ert-temp-file-suffix +@item :suffix @var{string} +If non-nil, pass @var{string} to @code{make-temp-file} as the +@var{suffix} argument. Otherwise, use the value of +@code{ert-temp-file-suffix}; if the value of that variable is nil, +generate a suffix based on the name of the file that +@code{ert-with-temp-file} is called from. + +@item :text @var{string} +If non-nil, pass @var{string} to @code{make-temp-file} as the @var{text} +argument. + +@item :buffer @var{symbol} +Open the temporary file using @code{find-file-noselect} and bind +@var{symbol} to the buffer. Kill the buffer after @var{body} exits +normally or non-locally. + +@item :coding @var{coding} +If non-nil, bind @code{coding-system-for-write} to @var{coding} when +executing @var{body}. This is handy when @var{string} includes +non-ASCII characters or the temporary file must have a specific encoding +or end-of-line format. +@end table + +Example: + +@lisp +(ert-with-temp-file temp-file + :prefix "foo" + :suffix "bar" + :text "foobar3" + @dots{}) +@end lisp +@end defmac + +@defmac ert-with-temp-directory (name &rest body) +This macro binds @var{name} to the name of a new temporary directory and +evaluates @var{body}. It deletes the temporary directory after +@var{body} exits normally or non-locally. + +@var{name} is bound to the directory name, not the directory file name. +(In other words, it will end with the directory delimiter; on Unix-like +systems, it will end with @t{"/"}.) + +The same keyword arguments are supported as in +@code{ert-with-temp-file}, except for @code{:text}. Example: + +@lisp +(ert-with-temp-directory temp-dir + :prefix "foo" + :suffix "bar" + @dots{}) +@end lisp +@end defmac + +@defvar ert-remote-temporary-file-directory +This variable provides the name of a temporary directory for remote file +tests. Per default, a mock-up connection method is used (this might not +be possible when running on MS Windows). The default value is +@t{"/mock::/tmp/"}. + +If a real remote connection shall be used for testing, this can be +overwritten by the environment variable +@env{REMOTE_TEMPORARY_FILE_DIRECTORY}. Example: + +@example +# env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make @dots{} +@end example +@end defvar + +@subsection Miscellaneous Utilities + +@defun ert-simulate-command (command) +Simulate calling @var{command} the way the Emacs command loop would call +it. It runs hooks like @code{pre-command-hook} and +@code{post-command-hook}, and sets variables like @code{this-command} +and @code{last-command}. + +@var{command} should be a list where the @code{car} is the command +symbol and the rest are arguments to the command. Example: + +@lisp +(ert-simulate-command '(find-file "project/foo.c")) +@end lisp + +@strong{Note}: Since the command is not called by +@code{call-interactively}, a test for @code{(called-interactively-p +'interactive)} in the command will fail. +@end defun + +@defmac ert-simulate-keys (keys &rest body) +This executes @var{body} with @var{keys} as pseudo-interactive input. +@var{keys} is either a string, a list of characters, or a character +vector. Examples: + +@lisp +(ert-simulate-keys '(?n ?\C-m) @dots{}) +(ert-simulate-keys "\r\r\r\ry\r" @dots{}) +(ert-simulate-keys (kbd "#fake C-m C-a C-k C-m") @dots{}) +(ert-simulate-keys [?b ?2 return] @dots{}) +@end lisp +@end defmac + +@defun ert-filter-string (s &rest regexps) +This function returns a copy of string @var{s} with all matches of +@var{regexps} removed. Elements of @var{regexps} may also be +two-element lists @code{(@var{regexp} @var{subexp})}, where @var{subexp} +is the number of a subexpression in @var{regexp}. In that case, only +that subexpression will be removed rather than the entire match. +Example: + +@lisp +(with-current-buffer @dots{} + (ert-filter-string (buffer-string) + '("Started at:\\(.*\\)$" 1) + '("Finished at:\\(.*\\)$" 1)) + @dots{}) +@end lisp +@end defun + +@defun ert-propertized-string (&rest args) +This function returns a string with properties as specified by +@var{args}. + +@var{args} is a list of strings and plists. The strings in @var{args} +are concatenated to produce an output string. In the output string, +each string from @var{args} will have the preceding plist as its +property list, or no properties if there is no plist before it. +Example: + +@lisp +(ert-propertized-string "foo " '(face italic) "bar" " baz" nil " quux") +@end lisp + +This returns the string @t{"foo @i{bar baz} quux"} where the substring +@t{"@i{bar baz}"} has a @code{face} property with the value @code{italic}. +@end defun + + @node How to Debug Tests @chapter How to Debug Tests diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6ac07e89742..239aa43703f 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -17204,7 +17204,7 @@ filename is unrelated to the article number in Gnus. @code{nnmaildir} also stores the equivalent of @code{nnml}'s overview files in one file per article, so it uses about twice as many inodes as @code{nnml}. (Use @code{df -i} to see how plentiful your inode supply is.) If this -slows you down or takes up very much space, a non-block-structured +slows you down or takes up very much space, use a non-block-structured file system. Since maildirs don't require locking for delivery, the maildirs you use @@ -22381,6 +22381,7 @@ First of: you really need a patched mairix binary for using the marks propagation feature efficiently. Otherwise, you would have to update the mairix database all the time. You can get the patch at +@c FIXME: This link is broken as of 2025-01-26. @uref{http://www.randomsample.de/mairix-maildir-patch.tar} You need the mairix v0.21 source code for this patch; everything else @@ -26050,7 +26051,7 @@ never install such a back end. @cindex spam filtering, naive Bayesian Paul Graham has written an excellent essay about spam filtering using -statistics: @uref{http://www.paulgraham.com/spam.html,A Plan for +statistics: @uref{https://www.paulgraham.com/spam.html,A Plan for Spam}. In it he describes the inherent deficiency of rule-based filtering as used by SpamAssassin, for example: Somebody has to write the rules, and everybody else has to install these rules. You are diff --git a/doc/misc/message.texi b/doc/misc/message.texi index bd20aec5bc6..5cad78b4c48 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -289,12 +289,7 @@ supersede the message in the current buffer. @vindex message-ignored-supersedes-headers Headers matching the @code{message-ignored-supersedes-headers} are -removed before popping up the new message buffer. The default is@* -@samp{^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|@* -^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|@* -Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|@* -^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|@* -^X-Payment:\\|^Approved:}. +removed before popping up the new message buffer. @@ -1693,13 +1688,14 @@ result is inserted. @item message-subject-re-regexp @vindex message-subject-re-regexp +@vindex mail-re-regexps @cindex Aw @cindex Sv @cindex Re Responses to messages have subjects that start with @samp{Re: }. This is @emph{not} an abbreviation of the English word ``response'', but it comes from the Latin ``res'', and means ``in the matter of''. Some -illiterate nincompoops have failed to grasp this fact, and have +companies, seemingly allergic to standards, have failed to grasp this fact, and have ``internationalized'' their software to use abominations like @samp{Aw: } (``antwort'') or @samp{Sv: } (``svar'') instead, which is meaningless and evil. However, you may have to deal with users that @@ -1731,6 +1727,16 @@ responding to a message: )) @end lisp +You shouldn't need to do this, since the default value of +@code{message-subject-re-regexp} is initialized based on +@code{mail-re-regexps}, which covers most known cases of such +internationalization, and is a lot easier to customize. Customizing +@code{mail-re-regexps} updates @code{message-subject-re-regexp} to +match. + +Note that the regexp is matched case-insensitively against the +@samp{Subject} header contents. + @item message-subject-trailing-was-query @vindex message-subject-trailing-was-query @vindex message-subject-trailing-was-ask-regexp @@ -1791,6 +1797,12 @@ member list with elements @code{CC} and @code{To}, then @code{message-carefully-insert-headers} will not insert a @code{To} header when the message is already @code{CC}ed to the recipient. +@item message-header-use-obsolete-in-reply-to +@vindex message-header-use-obsolete-in-reply-to +When non-@code{nil}, use an obsolete form of the @code{In-Reply-To} +header that includes a parenthetical phrase with details of the +originating email following the message id. The default is @code{nil}. + @item message-syntax-checks @vindex message-syntax-checks Controls what syntax checks should not be performed on outgoing posts. diff --git a/doc/misc/org.org b/doc/misc/org.org index 98c416c5da4..26cb46cf13c 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -3403,7 +3403,7 @@ options: | Link Type | Example | |------------+--------------------------------------------------------------------| -| http | =http://staff.science.uva.nl/c.dominik/= | +| http | =http://orgmode.org/= | | https | =https://orgmode.org/= | | doi | =doi:10.1000/182= | | file | =file:/home/dominik/images/jupiter.jpg= | @@ -13633,7 +13633,7 @@ backend by default in-lines that image. For example: ~org-html-inline-images~. On the other hand, if the description part of the Org link is itself -another link, such as =file:= or =http:= URL pointing to an image, the +another link, such as =file:= or =https:= URL pointing to an image, the HTML export backend in-lines this image and links to the main image. This Org syntax enables the backend to link low-resolution thumbnail to the high-resolution version of the image, as shown in this example: @@ -13938,7 +13938,7 @@ terminology. You may refer to https://tug.org/begin.html to get familiar with LaTeX basics. Users with LaTeX installed may also run =texdoc latex= from terminal to open LaTeX introduction [fn:: The command will open a PDF file, which is also available for download -from http://mirrors.ctan.org/info/latex-doc-ptr/latex-doc-ptr.pdf] +from https://mirrors.ctan.org/info/latex-doc-ptr/latex-doc-ptr.pdf] *** LaTeX/PDF export commands :PROPERTIES: @@ -15220,7 +15220,7 @@ document in one of the following ways: ~org-latex-to-mathml-jar-file~. If you prefer to use MathToWeb[fn:: See - [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]].] + [[https://mathtoweb.sourceforge.io/][MathToWeb]].] as your converter, you can configure the above variables as shown below. diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi index 5d4b3b369d7..deadc991173 100644 --- a/doc/misc/sieve.texi +++ b/doc/misc/sieve.texi @@ -213,6 +213,12 @@ Bury the Manage Sieve buffer without closing the connection. @findex sieve-help Displays help in the minibuffer. +@item g +@kindex g +@findex sieve-refresh-scriptlist +Refresh list of scripts found on the currently opened server. +Update contents of the current sieve buffer. + @item Q @kindex Q @findex sieve-manage-quit diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 456696f4c9e..faad184e345 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2024-11-04.20} +\def\texinfoversion{2025-01-31.21} % -% Copyright 1985, 1986, 1988, 1990-2024 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2025 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as @@ -156,8 +156,9 @@ % Give the space character the catcode for a space. \def\spaceisspace{\catcode`\ =10\relax} -% Likewise for ^^M, the end of line character. -\def\endlineisspace{\catcode13=10\relax} +% Used to ignore an active newline that may appear immediately after +% a macro name. +{\catcode13=\active \gdef\ignoreactivenewline{\let^^M\empty}} \chardef\dashChar = `\- \chardef\slashChar = `\/ @@ -957,6 +958,10 @@ where each line of input produces a line of output.} \ifx\byeerror\relax\else\errmessage{\byeerror}\fi \tracingstats=1\ptexend} +% set in \donoderef below, but we need to define this here so that +% conditionals balance inside the large \ifpdf ... \fi blocks below. +\newif\ifnodeseen +\nodeseenfalse \message{pdf,} % adobe `portable' document format @@ -975,6 +980,11 @@ where each line of input produces a line of output.} \newif\ifpdf \newif\ifpdfmakepagedest +\newif\ifluatex +\ifx\luatexversion\thisisundefined\else + \luatextrue +\fi + % % For LuaTeX % @@ -982,8 +992,7 @@ where each line of input produces a line of output.} \newif\iftxiuseunicodedestname \txiuseunicodedestnamefalse % For pdfTeX etc. -\ifx\luatexversion\thisisundefined -\else +\ifluatex % Use Unicode destination names \txiuseunicodedestnametrue % Escape PDF strings with converting UTF-16 from UTF-8 @@ -1072,12 +1081,17 @@ where each line of input produces a line of output.} \fi \fi +\newif\ifxetex +\ifx\XeTeXrevision\thisisundefined\else + \xetextrue +\fi + \newif\ifpdforxetex \pdforxetexfalse \ifpdf \pdforxetextrue \fi -\ifx\XeTeXrevision\thisisundefined\else +\ifxetex \pdforxetextrue \fi @@ -1167,58 +1181,90 @@ with PDF output, and none of those formats could be found. (.eps cannot be supported due to the design of the PDF format; use regular TeX (DVI output) for that.)} +% definitions for pdftex or luatex with pdf output \ifpdf + % Strings in PDF outlines can either be ASCII, or encoded in UTF-16BE + % with BOM. Unfortunately there is no simple way with pdftex to output + % UTF-16, so we have to do some quite convoluted expansion games if we + % find the string contains a non-ASCII codepoint if we want these to + % display correctly. We generated the UTF-16 sequences in + % \DeclareUnicodeCharacter and we access them here. % - % Color manipulation macros using ideas from pdfcolor.tex, - % except using rgb instead of cmyk; the latter is said to render as a - % very dark gray on-screen and a very dark halftone in print, instead - % of actual black. The dark red here is dark enough to print on paper as - % nearly black, but still distinguishable for online viewing. We use - % black by default, though. - \def\rgbDarkRed{0.50 0.09 0.12} - \def\rgbBlack{0 0 0} + \def\defpdfoutlinetextunicode#1{% + \def\pdfoutlinetext{#1}% + % + % Make UTF-8 sequences expand to UTF-16 definitions. + \passthroughcharsfalse \utfbytespdftrue + \utfviiidefinedwarningfalse + % + % Completely expand, eliminating any control sequences such as \code, + % leaving only possibly \utfbytes. + \let\utfbytes\relax + \pdfaccentliterals + \xdef\pdfoutlinetextchecked{#1}% + \checkutfbytes + }% + % Check if \utfbytes occurs in expansion. + \def\checkutfbytes{% + \expandafter\checkutfbytesz\pdfoutlinetextchecked\utfbytes\finish + }% + \def\checkutfbytesz#1\utfbytes#2\finish{% + \def\after{#2}% + \ifx\after\empty + % No further action needed. Output ASCII string as-is, as converting + % to UTF-16 is somewhat slow (and uses more space). + \global\let\pdfoutlinetext\pdfoutlinetextchecked + \else + \passthroughcharstrue % pass UTF-8 sequences unaltered + \xdef\pdfoutlinetext{\pdfoutlinetext}% + \expandafter\expandutfsixteen\expandafter{\pdfoutlinetext}\pdfoutlinetext + \fi + }% + % + \catcode2=1 % begin-group character + \catcode3=2 % end-group character + % + % argument should be pure UTF-8 with no control sequences. convert to + % UTF-16BE by inserting null bytes before bytes < 128 and expanding + % UTF-8 multibyte sequences to saved UTF-16BE sequences. + \def\expandutfsixteen#1#2{% + \bgroup \asciitounicode + \passthroughcharsfalse + \let\utfbytes\asis + % + % for Byte Order Mark (BOM) + \catcode"FE=12 + \catcode"FF=12 + % + % we want to treat { and } in #1 as any other ASCII bytes. however, + % we need grouping characters for \scantokens and definitions/assignments, + % so define alternative grouping characters using control characters + % that are unlikely to occur. + % this does not affect 0x02 or 0x03 bytes arising from expansion as + % these are tokens with different catcodes. + \catcode"02=1 % begin-group character + \catcode"03=2 % end-group character + % + \expandafter\xdef\expandafter#2\scantokens{% + ^^02^^fe^^ff#1^^03}% + % NB we need \scantokens to provide both the open and close group tokens + % for \xdef otherwise there is an e-TeX error "File ended while + % scanning definition of..." + % NB \scantokens is a e-TeX command which is assumed to be provided by + % pdfTeX. + % + \egroup + }% + % + \catcode2=12 \catcode3=12 % defaults + % + % Color support % % rg sets the color for filling (usual text, etc.); % RG sets the color for stroking (thin rules, e.g., normal _'s). \def\pdfsetcolor#1{\pdfliteral{#1 rg #1 RG}} % - % Set color, and create a mark which defines \thiscolor accordingly, - % so that \makeheadline knows which color to restore. - \def\curcolor{0 0 0}% - \def\setcolor#1{% - \ifx#1\curcolor\else - \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% - \domark - \pdfsetcolor{#1}% - \xdef\curcolor{#1}% - \fi - } - % - \let\maincolor\rgbBlack - \pdfsetcolor{\maincolor} - \edef\thiscolor{\maincolor} - \def\currentcolordefs{} - % - \def\makefootline{% - \baselineskip24pt - \line{\pdfsetcolor{\maincolor}\the\footline}% - } - % - \def\makeheadline{% - \vbox to 0pt{% - \vskip-22.5pt - \line{% - \vbox to8.5pt{}% - % Extract \thiscolor definition from the marks. - \getcolormarks - % Typeset the headline with \maincolor, then restore the color. - \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}% - }% - \vss - }% - \nointerlineskip - } - % + % PDF outline support % \pdfcatalog{/PageMode /UseOutlines} % @@ -1315,18 +1361,15 @@ output) for that.)} \def\pdfoutlinetext{#1}% \else \ifx \declaredencoding \utfeight - \ifx\luatexversion\thisisundefined - % For pdfTeX with UTF-8. - % TODO: the PDF format can use UTF-16 in bookmark strings, - % but the code for this isn't done yet. - % Use ASCII approximations. - \passthroughcharsfalse - \def\pdfoutlinetext{#1}% - \else + \ifluatex % For LuaTeX with UTF-8. % Pass through Unicode characters for title texts. \passthroughcharstrue - \def\pdfoutlinetext{#1}% + \pdfaccentliterals + \xdef\pdfoutlinetext{#1}% + \else + % For pdfTeX with UTF-8. + \defpdfoutlinetextunicode{#1}% \fi \else % For non-Latin-1 or non-UTF-8 encodings. @@ -1348,11 +1391,6 @@ output) for that.)} % used to mark target names; must be expandable. \def\pdfmkpgn#1{#1} % - % by default, use black for everything. - \def\urlcolor{\rgbBlack} - \let\linkcolor\rgbBlack - \def\endlink{\setcolor{\maincolor}\pdfendlink} - % % Adding outlines to PDF; macros for calculating structure of outlines % come from Petr Olsak \def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0% @@ -1416,6 +1454,10 @@ output) for that.)} \def\unnsecentry{\numsecentry}% \def\unnsubsecentry{\numsubsecentry}% \def\unnsubsubsecentry{\numsubsubsecentry}% + % + % Treat index initials like @section. Note that this is the wrong + % level if the index is not at the level of @appendix or @chapter. + \def\idxinitialentry{\numsecentry}% \readdatafile{toc}% % % Read toc second time, this time actually producing the outlines. @@ -1437,6 +1479,8 @@ output) for that.)} \dopdfoutline{##1}{count-\expnumber{subsec##2}}{##3}{##4}}% \def\numsubsubsecentry##1##2##3##4{% count is always zero \dopdfoutline{##1}{}{##3}{##4}}% + \def\idxinitialentry##1##2##3##4{% + \dopdfoutline{##1}{}{idx.##1.##2}{##4}}% % % PDF outlines are displayed using system fonts, instead of % document fonts. Therefore we cannot use special characters, @@ -1450,6 +1494,7 @@ output) for that.)} % we use for the index sort strings. % \indexnofonts + \ifnodeseen\else \dopdfoutlinecontents \fi % for @contents at beginning \setupdatafile % We can have normal brace characters in the PDF outlines, unlike % Texinfo index files. So set that up. @@ -1458,6 +1503,10 @@ output) for that.)} \catcode`\\=\active \otherbackslash \input \tocreadfilename \endgroup + \ifnodeseen \dopdfoutlinecontents \fi % for @contents at end + } + \def\dopdfoutlinecontents{% + \expandafter\dopdfoutline\expandafter{\putwordTOC}{}{txi.CONTENTS}{}% } {\catcode`[=1 \catcode`]=2 \catcode`{=\other \catcode`}=\other @@ -1484,55 +1533,16 @@ output) for that.)} \else \let \startlink \pdfstartlink \fi - % make a live url in pdf output. - \def\pdfurl#1{% - \begingroup - % it seems we really need yet another set of dummies; have not - % tried to figure out what each command should do in the context - % of @url. for now, just make @/ a no-op, that's the only one - % people have actually reported a problem with. - % - \normalturnoffactive - \def\@{@}% - \let\/=\empty - \makevalueexpandable - % do we want to go so far as to use \indexnofonts instead of just - % special-casing \var here? - \def\var##1{##1}% - % - \leavevmode\setcolor{\urlcolor}% - \startlink attr{/Border [0 0 0]}% - user{/Subtype /Link /A << /S /URI /URI (#1) >>}% - \endgroup} - % \pdfgettoks - Surround page numbers in #1 with @pdflink. #1 may - % be a simple number, or a list of numbers in the case of an index - % entry. - \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} - \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} - \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} - \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} - \def\maketoks{% - \expandafter\poptoks\the\toksA|ENDTOKS|\relax - \ifx\first0\adn0 - \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 - \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 - \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 - \else - \ifnum0=\countA\else\makelink\fi - \ifx\first.\let\next=\done\else - \let\next=\maketoks - \addtokens{\toksB}{\the\toksD} - \ifx\first,\addtokens{\toksB}{\space}\fi - \fi - \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi - \next} - \def\makelink{\addtokens{\toksB}% - {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} + \def\pdfmakeurl#1{% + \startlink attr{/Border [0 0 0]}% + user{/Subtype /Link /A << /S /URI /URI (#1) >>}% + }% + \def\endlink{\setcolor{\maincolor}\pdfendlink} + % \def\pdflink#1{\pdflinkpage{#1}{#1}}% \def\pdflinkpage#1#2{% \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}} \setcolor{\linkcolor}#2\endlink} - \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} \else % non-pdf mode \let\pdfmkdest = \gobble @@ -1541,13 +1551,12 @@ output) for that.)} \let\setcolor = \gobble \let\pdfsetcolor = \gobble \let\pdfmakeoutlines = \relax -\fi % \ifx\pdfoutput +\fi % % For XeTeX % -\ifx\XeTeXrevision\thisisundefined -\else +\ifxetex % % XeTeX version check % @@ -1573,45 +1582,8 @@ output) for that.)} \fi % % Color support - % - \def\rgbDarkRed{0.50 0.09 0.12} - \def\rgbBlack{0 0 0} - % \def\pdfsetcolor#1{\special{pdf:scolor [#1]}} % - % Set color, and create a mark which defines \thiscolor accordingly, - % so that \makeheadline knows which color to restore. - \def\setcolor#1{% - \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% - \domark - \pdfsetcolor{#1}% - } - % - \def\maincolor{\rgbBlack} - \pdfsetcolor{\maincolor} - \edef\thiscolor{\maincolor} - \def\currentcolordefs{} - % - \def\makefootline{% - \baselineskip24pt - \line{\pdfsetcolor{\maincolor}\the\footline}% - } - % - \def\makeheadline{% - \vbox to 0pt{% - \vskip-22.5pt - \line{% - \vbox to8.5pt{}% - % Extract \thiscolor definition from the marks. - \getcolormarks - % Typeset the headline with \maincolor, then restore the color. - \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}% - }% - \vss - }% - \nointerlineskip - } - % % PDF outline support % % Emulate pdfTeX primitive @@ -1649,11 +1621,6 @@ output) for that.)} \safewhatsit{\pdfdest name{\pdfdestname} xyz}% } % - % by default, use black for everything. - \def\urlcolor{\rgbBlack} - \def\linkcolor{\rgbBlack} - \def\endlink{\setcolor{\maincolor}\pdfendlink} - % \def\dopdfoutline#1#2#3#4{% \setpdfoutlinetext{#1} \setpdfdestname{#3} @@ -1667,7 +1634,6 @@ output) for that.)} % \def\pdfmakeoutlines{% \begingroup - % % For XeTeX, counts of subentries are not necessary. % Therefore, we read toc only once. % @@ -1686,6 +1652,11 @@ output) for that.)} \def\numsubsubsecentry##1##2##3##4{% \dopdfoutline{##1}{4}{##3}{##4}}% % + % Note this is at the wrong level unless the index is in an @appendix + % or @chapter. + \def\idxinitialentry##1##2##3##4{% + \dopdfoutline{##1}{2}{idx.##1.##2}{##4}}% + % \let\appentry\numchapentry% \let\appsecentry\numsecentry% \let\appsubsecentry\numsubsecentry% @@ -1700,15 +1671,23 @@ output) for that.)} % Therefore, the encoding and the language may not be considered. % \indexnofonts + \pdfaccentliterals + \ifnodeseen\else \dopdfoutlinecontents \fi % for @contents at beginning + % \setupdatafile % We can have normal brace characters in the PDF outlines, unlike % Texinfo index files. So set that up. \def\{{\lbracecharliteral}% \def\}{\rbracecharliteral}% \catcode`\\=\active \otherbackslash - \input \tocreadfilename + \input \tocreadfilename\relax + \ifnodeseen \dopdfoutlinecontents \fi % for @contents at end \endgroup } + \def\dopdfoutlinecontents{% + \expandafter\dopdfoutline\expandafter + {\putwordTOC}{1}{txi.CONTENTS}{txi.CONTENTS}% + } {\catcode`[=1 \catcode`]=2 \catcode`{=\other \catcode`}=\other \gdef\lbracecharliteral[{]% @@ -1721,7 +1700,7 @@ output) for that.)} % However, due to a UTF-16 conversion issue of xdvipdfmx 20150315, % ``\special{pdf:dest ...}'' cannot handle non-ASCII strings. % It is fixed by xdvipdfmx 20160106 (TeX Live SVN r39753). -% + % \def\skipspaces#1{\def\PP{#1}\def\D{|}% \ifx\PP\D\let\nextsp\relax \else\let\nextsp\skipspaces @@ -1736,55 +1715,17 @@ output) for that.)} \edef\temp{#1}% \expandafter\skipspaces\temp|\relax } - % make a live url in pdf output. - \def\pdfurl#1{% - \begingroup - % it seems we really need yet another set of dummies; have not - % tried to figure out what each command should do in the context - % of @url. for now, just make @/ a no-op, that's the only one - % people have actually reported a problem with. - % - \normalturnoffactive - \def\@{@}% - \let\/=\empty - \makevalueexpandable - % do we want to go so far as to use \indexnofonts instead of just - % special-casing \var here? - \def\var##1{##1}% - % - \leavevmode\setcolor{\urlcolor}% - \special{pdf:bann << /Border [0 0 0] - /Subtype /Link /A << /S /URI /URI (#1) >> >>}% - \endgroup} + \def\pdfmakeurl#1{% + \special{pdf:bann << /Border [0 0 0] + /Subtype /Link /A << /S /URI /URI (#1) >> >>}% + } \def\endlink{\setcolor{\maincolor}\special{pdf:eann}} - \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} - \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} - \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} - \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} - \def\maketoks{% - \expandafter\poptoks\the\toksA|ENDTOKS|\relax - \ifx\first0\adn0 - \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 - \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 - \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 - \else - \ifnum0=\countA\else\makelink\fi - \ifx\first.\let\next=\done\else - \let\next=\maketoks - \addtokens{\toksB}{\the\toksD} - \ifx\first,\addtokens{\toksB}{\space}\fi - \fi - \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi - \next} - \def\makelink{\addtokens{\toksB}% - {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} \def\pdflink#1{\pdflinkpage{#1}{#1}}% \def\pdflinkpage#1#2{% \special{pdf:bann << /Border [0 0 0] /Type /Annot /Subtype /Link /A << /S /GoTo /D (#1) >> >>}% \setcolor{\linkcolor}#2\endlink} - \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} -% + % % % @image support % @@ -1841,6 +1782,164 @@ output) for that.)} } \fi +% common definitions and code for pdftex, luatex and xetex +\ifpdforxetex + % The dark red here is dark enough to print on paper as + % nearly black, but still distinguishable for online viewing. We use + % black by default, though. + \def\rgbDarkRed{0.50 0.09 0.12} + \def\rgbBlack{0 0 0} + % + % Set color, and create a mark which defines \thiscolor accordingly, + % so that \makeheadline knows which color to restore. + \def\curcolor{0 0 0}% + \def\setcolor#1{% + \ifx#1\curcolor\else + \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% + \domark + \pdfsetcolor{#1}% + \xdef\curcolor{#1}% + \fi + } + % + \let\maincolor\rgbBlack + \pdfsetcolor{\maincolor} + \edef\thiscolor{\maincolor} + \def\currentcolordefs{} + % + \def\makefootline{% + \baselineskip24pt + \line{\pdfsetcolor{\maincolor}\the\footline}% + } + % + \def\makeheadline{% + \vbox to 0pt{% + \vskip-22.5pt + \line{% + \vbox to8.5pt{}% + % Extract \thiscolor definition from the marks. + \getcolormarks + % Typeset the headline with \maincolor, then restore the color. + \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}% + }% + \vss + }% + \nointerlineskip + } + % + % by default, use black for everything. + \def\urlcolor{\rgbBlack} + \let\linkcolor\rgbBlack + % + % make a live url in pdf output. + \def\pdfurl#1{% + \begingroup + % it seems we really need yet another set of dummies; have not + % tried to figure out what each command should do in the context + % of @url. for now, just make @/ a no-op, that's the only one + % people have actually reported a problem with. + % + \normalturnoffactive + \def\@{@}% + \let\/=\empty + \makevalueexpandable + % do we want to go so far as to use \indexnofonts instead of just + % special-casing \var here? + \def\var##1{##1}% + % + \leavevmode\setcolor{\urlcolor}% + \pdfmakeurl{#1}% + \endgroup} + % + % \pdfgettoks - Surround page numbers in #1 with @pdflink. #1 may + % be a simple number, or a list of numbers in the case of an index + % entry. + \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} + \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} + \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} + \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} + \def\maketoks{% + \expandafter\poptoks\the\toksA|ENDTOKS|\relax + \ifx\first0\adn0 + \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 + \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 + \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 + \else + \ifnum0=\countA\else\makelink\fi + \ifx\first.\let\next=\done\else + \let\next=\maketoks + \addtokens{\toksB}{\the\toksD} + \ifx\first,\addtokens{\toksB}{\space}\fi + \fi + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi + \next} + \def\makelink{\addtokens{\toksB}% + {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} + \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} +\fi + +\ifpdforxetex + % for pdftex. + {\catcode`^^cc=13 + \gdef\pdfaccentliteralsutfviii{% + % For PDF outline only. Unicode combining accents follow the + % character they modify. Note we need at least the first byte + % of the UTF-8 sequences to have an active catcode to allow the + % definitions to do their magic. + \def\"##1{##1^^cc^^88}% U+0308 + \def\'##1{##1^^cc^^81}% U+0301 + \def\,##1{##1^^cc^^a7}% U+0327 + \def\=##1{##1^^cc^^85}% U+0305 + \def\^##1{##1^^cc^^82}% U+0302 + \def\`##1{##1^^cc^^80}% U+0300 + \def\~##1{##1^^cc^^83}% U+0303 + \def\dotaccent##1{##1^^cc^^87}% U+0307 + \def\H##1{##1^^cc^^8b}% U+030B + \def\ogonek##1{##1^^cc^^a8}% U+0328 + \def\ringaccent##1{##1^^cc^^8a}% U+030A + \def\u##1{##1^^cc^^8c}% U+0306 + \def\ubaraccent##1{##1^^cc^^b1}% U+0331 + \def\udotaccent##1{##1^^cc^^a3}% U+0323 + \def\v##1{##1^^cc^^8c}% U+030C + % this definition of @tieaccent will only work with exactly two characters + % in argument as we need to insert the combining character between them. + \def\tieaccent##1{\tieaccentz##1}% + \def\tieaccentz##1##2{##1^^cd^^a1##2} % U+0361 + }}% + % + % for xetex and luatex, which both support extended ^^^^ escapes and + % process the Unicode codepoint as a single token. + \gdef\pdfaccentliteralsnative{% + \def\"##1{##1^^^^0308}% + \def\'##1{##1^^^^0301}% + \def\,##1{##1^^^^0327}% + \def\=##1{##1^^^^0305}% + \def\^##1{##1^^^^0302}% + \def\`##1{##1^^^^0300}% + \def\~##1{##1^^^^0303}% + \def\dotaccent##1{##1^^^^0307}% + \def\H##1{##1^^^^030b}% + \def\ogonek##1{##1^^^^0328}% + \def\ringaccent##1{##1^^^^030a}% + \def\u##1{##1^^^^0306}% + \def\ubaraccent##1{##1^^^^0331}% + \def\udotaccent##1{##1^^^^0323}% + \def\v##1{##1^^^^030c}% + \def\tieaccent##1{\tieaccentz##1}% + \def\tieaccentz##1##2{##1^^^^0361##2} % U+0361 + }% + % + % use the appropriate definition + \ifluatex + \let\pdfaccentliterals\pdfaccentliteralsnative + \else + \ifxetex + \let\pdfaccentliterals\pdfaccentliteralsnative + \else + \let\pdfaccentliterals\pdfaccentliteralsutfviii + \fi + \fi +\fi % \message{fonts,} @@ -2772,15 +2871,15 @@ end % @cite unconditionally uses \sl with \smartitaliccorrection. \def\cite#1{{\sl #1}\smartitaliccorrection} -% @var unconditionally uses \sl. This gives consistency for -% parameter names whether they are in @def, @table @code or a -% regular paragraph. -% To get ttsl font for @var when used in code context, @set txicodevaristt. -% The \null is to reset \spacefactor. +% By default, use ttsl font for @var when used in code context. +% To unconditionally use \sl for @var, @clear txicodevaristt. This +% gives consistency for parameter names whether they are in @def, +% @table @code or a regular paragraph. \def\aftersmartic{} \def\var#1{% \let\saveaftersmartic = \aftersmartic \def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}% + % The \null is to reset \spacefactor. % \ifflagclear{txicodevaristt}% {\def\varnext{{{\sl #1}}\smartitaliccorrection}}% @@ -2788,7 +2887,6 @@ end \varnext } -% To be removed after next release \def\SETtxicodevaristt{}% @set txicodevaristt \let\i=\smartitalic @@ -2808,7 +2906,7 @@ end \def\ii#1{{\it #1}} % italic font % @b, explicit bold. Also @strong. -\def\b#1{{\bf #1}} +\def\b#1{{\bf \defcharsdefault #1}} \let\strong=\b % @sansserif, explicit sans. @@ -3039,9 +3137,7 @@ end \unhbox0\ (\urefcode{#1})% \fi \else - \ifx\XeTeXrevision\thisisundefined - \unhbox0\ (\urefcode{#1})% DVI, always show arg and url - \else + \ifxetex % For XeTeX \ifurefurlonlylink % PDF plus option to not display url, show just arg @@ -3051,6 +3147,8 @@ end % visibility, if the pdf is eventually used to print, etc. \unhbox0\ (\urefcode{#1})% \fi + \else + \unhbox0\ (\urefcode{#1})% DVI, always show arg and url \fi \fi \else @@ -3670,15 +3768,24 @@ $$% {\font\thisecfont = #1ctt\ecsize \space at \nominalsize}% % else {\ifx\curfontstyle\bfstylename - % bold: - \font\thisecfont = #1cb\ifusingit{i}{x}\ecsize \space at \nominalsize + \etcfontbold{#1}% \else - % regular: - \font\thisecfont = #1c\ifusingit{ti}{rm}\ecsize \space at \nominalsize + \ifrmisbold + \etcfontbold{#1}% + \else + % regular: + \font\thisecfont = #1c\ifusingit{ti}{rm}\ecsize \space + at \nominalsize + \fi \fi}% \thisecfont } +\def\etcfontbold#1{% + % bold: + \font\thisecfont = #1cb\ifusingit{i}{x}\ecsize \space at \nominalsize +} + % @registeredsymbol - R in a circle. The font for the R should really % be smaller yet, but lllsize is the best we can do for now. % Adapted from the plain.tex definition of \copyright. @@ -5528,7 +5635,6 @@ might help (with 'rm \jobname.?? \jobname.??s')% \def\initial{% \bgroup - \initialglyphs \initialx } @@ -5551,7 +5657,10 @@ might help (with 'rm \jobname.?? \jobname.??s')% % % No shrink because it confuses \balancecolumns. \vskip 1.67\baselineskip plus 1\baselineskip - \leftline{\secfonts \kern-0.05em \secbf #1}% + \doindexinitialentry{#1}% + \initialglyphs + \leftline{% + \secfonts \kern-0.05em \secbf #1}% % \secfonts is inside the argument of \leftline so that the change of % \baselineskip will not affect any glue inserted before the vbox that % \leftline creates. @@ -5561,6 +5670,32 @@ might help (with 'rm \jobname.?? \jobname.??s')% \egroup % \initialglyphs } +\def\doindexinitialentry#1{% + \ifpdforxetex + \global\advance\idxinitialno by 1 + \def\indexlbrace{\{} + \def\indexrbrace{\}} + \def\indexbackslash{\realbackslash} + \def\indexatchar{\@} + \writetocentry{idxinitial}{\asis #1}{IDX\the\idxinitialno}% + % The @asis removes a pair of braces around e.g. {@indexatchar} that + % are output by texindex. + % + \vbox to 0pt{}% + % This vbox fixes the \pdfdest location for double column formatting. + % Without it, the \pdfdest is output above topskip glue at the top + % of a column as this glue is not added until the first box. + \pdfmkdest{idx.\asis #1.IDX\the\idxinitialno}% + \fi +} + +% No listing in TOC +\def\idxinitialentry#1#2#3#4{} + +% For index initials. +\newcount\idxinitialno \idxinitialno=1 + + \newdimen\entryrightmargin \entryrightmargin=0pt @@ -6782,12 +6917,13 @@ might help (with 'rm \jobname.?? \jobname.??s')% % Prepare to read what we've written to \tocfile. % -\def\startcontents#1{% +\def\startcontents#1#2{% % If @setchapternewpage on, and @headings double, the contents should % start on an odd page, unlike chapters. \contentsalignmacro \immediate\closeout\tocfile % + #2% % Don't need to put `Contents' or `Short Contents' in the headline. % It is abundantly clear what they are. \chapmacro{#1}{Yomitfromtoc}{}% @@ -6818,7 +6954,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% % Normal (long) toc. % \def\contents{% - \startcontents{\putwordTOC}% + \startcontents{\putwordTOC}{\contentsmkdest}% \openin 1 \tocreadfilename\space \ifeof 1 \else \findsecnowidths @@ -6834,9 +6970,13 @@ might help (with 'rm \jobname.?? \jobname.??s')% \contentsendroman } +\def\contentsmkdest{% + \pdfmkdest{txi.CONTENTS}% +} + % And just the chapters. \def\summarycontents{% - \startcontents{\putwordShortTOC}% + \startcontents{\putwordShortTOC}{}% % \let\partentry = \shortpartentry \let\numchapentry = \shortchapentry @@ -7925,7 +8065,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% {\rm\enskip}% hskip 0.5 em of \rmfont }{}% % - \boldbrax + \parenbrackglyphs % arguments will be output next, if any. } @@ -7935,7 +8075,10 @@ might help (with 'rm \jobname.?? \jobname.??s')% \def\^^M{}% for line continuation \df \ifdoingtypefn \tt \else \sl \fi \ifflagclear{txicodevaristt}{}% - {\def\var##1{{\setregularquotes \ttsl ##1}}}% + % use \ttsl for @var in both @def* and @deftype*. + % the kern prevents an italic correction at end, which appears + % too much for ttsl. + {\def\var##1{{\setregularquotes \ttsl ##1\kern 0pt }}}% #1% \egroup } @@ -7952,8 +8095,9 @@ might help (with 'rm \jobname.?? \jobname.??s')% \let\lparen = ( \let\rparen = ) % Be sure that we always have a definition for `(', etc. For example, -% if the fn name has parens in it, \boldbrax will not be in effect yet, -% so TeX would otherwise complain about undefined control sequence. +% if the fn name has parens in it, \parenbrackglyphs will not be in +% effect yet, so TeX would otherwise complain about undefined control +% sequence. { \activeparens \gdef\defcharsdefault{% @@ -7963,49 +8107,28 @@ might help (with 'rm \jobname.?? \jobname.??s')% } \globaldefs=1 \defcharsdefault - \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} + \gdef\parenbrackglyphs{\let(=\opnr\let)=\cpnr\let[=\lbrb\let]=\rbrb} \gdef\magicamp{\let&=\amprm} } \let\ampchar\& +\def\amprm#1 {{\rm\ }} + \newcount\parencount - -% If we encounter &foo, then turn on ()-hacking afterwards -\newif\ifampseen -\def\amprm#1 {\ampseentrue{\rm\ }} - -\def\parenfont{% - \ifampseen - % At the first level, print parens in roman, - % otherwise use the default font. - \ifnum \parencount=1 \rm \fi - \else - % The \sf parens (in \boldbrax) actually are a little bolder than - % the contained text. This is especially needed for [ and ] . - \sf - \fi -} -\def\infirstlevel#1{% - \ifampseen - \ifnum\parencount=1 - #1% - \fi - \fi -} -\def\bfafterword#1 {#1 \bf} - +% opening and closing parentheses in roman font \def\opnr{% + \ptexslash % italic correction \global\advance\parencount by 1 - {\parenfont(}% - \infirstlevel \bfafterword + {\sf(}% } -\def\clnr{% - {\parenfont)}% - \infirstlevel \sl +\def\cpnr{% + \ptexslash % italic correction + {\sf)}% \global\advance\parencount by -1 } \newcount\brackcount +% left and right square brackets in bold font \def\lbrb{% \global\advance\brackcount by 1 {\bf[}% @@ -8535,7 +8658,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \expandafter\xdef\csname\the\macname\endcsname{% \begingroup \noexpand\spaceisspace - \noexpand\endlineisspace + \noexpand\ignoreactivenewline \noexpand\expandafter % skip any whitespace after the macro name. \expandafter\noexpand\csname\the\macname @@@\endcsname}% \expandafter\xdef\csname\the\macname @@@\endcsname{% @@ -8836,8 +8959,13 @@ might help (with 'rm \jobname.?? \jobname.??s')% \ifx\lastnode\empty\else \setref{\lastnode}{#1}% \global\let\lastnode=\empty + \setnodeseenonce \fi } +\def\setnodeseenonce{ + \global\nodeseentrue + \let\setnodeseenonce\relax +} % @nodedescription, @nodedescriptionblock - do nothing for TeX \parseargdef\nodedescription{} @@ -9575,7 +9703,9 @@ might help (with 'rm \jobname.?? \jobname.??s')% % For pdfTeX and LuaTeX <= 0.80 \dopdfimage{#1}{#2}{#3}% \else - \ifx\XeTeXrevision\thisisundefined + \ifxetex + \doxeteximage{#1}{#2}{#3}% + \else % For epsf.tex % \epsfbox itself resets \epsf?size at each figure. \setbox0 = \hbox{\ignorespaces #2}% @@ -9583,9 +9713,6 @@ might help (with 'rm \jobname.?? \jobname.??s')% \setbox0 = \hbox{\ignorespaces #3}% \ifdim\wd0 > 0pt \epsfysize=#3\relax \fi \epsfbox{#1.eps}% - \else - % For XeTeX - \doxeteximage{#1}{#2}{#3}% \fi \fi % @@ -9931,25 +10058,24 @@ directory should work if nowhere else does.} \newif\iftxinativeunicodecapable \newif\iftxiusebytewiseio -\ifx\XeTeXrevision\thisisundefined - \ifx\luatexversion\thisisundefined - \txinativeunicodecapablefalse - \txiusebytewiseiotrue - \else - \txinativeunicodecapabletrue - \txiusebytewiseiofalse - \fi -\else +\ifxetex \txinativeunicodecapabletrue \txiusebytewiseiofalse +\else + \ifluatex + \txinativeunicodecapabletrue + \txiusebytewiseiofalse + \else + \txinativeunicodecapablefalse + \txiusebytewiseiotrue + \fi \fi % Set I/O by bytes instead of UTF-8 sequence for XeTeX and LuaTex % for non-UTF-8 (byte-wise) encodings. % \def\setbytewiseio{% - \ifx\XeTeXrevision\thisisundefined - \else + \ifxetex \XeTeXdefaultencoding "bytes" % For subsequent files to be read \XeTeXinputencoding "bytes" % For document root file % Unfortunately, there seems to be no corresponding XeTeX command for @@ -9958,8 +10084,7 @@ directory should work if nowhere else does.} % place of non-ASCII characters. \fi - \ifx\luatexversion\thisisundefined - \else + \ifluatex \directlua{ local utf8_char, byte, gsub = unicode.utf8.char, string.byte, string.gsub local function convert_char (char) @@ -10068,8 +10193,7 @@ directory should work if nowhere else does.} \fi % lattwo \fi % ascii % - \ifx\XeTeXrevision\thisisundefined - \else + \ifxetex \ifx \declaredencoding \utfeight \else \ifx \declaredencoding \ascii @@ -10352,11 +10476,15 @@ directory should work if nowhere else does.} \gdef\UTFviiiDefined#1{% \ifx #1\relax - \message{\linenumber Unicode char \string #1 not defined for Texinfo}% + \ifutfviiidefinedwarning + \message{\linenumber Unicode char \string #1 not defined for Texinfo}% + \fi \else \expandafter #1% \fi } +\newif\ifutfviiidefinedwarning +\utfviiidefinedwarningtrue % Give non-ASCII bytes the active definitions for processing UTF-8 sequences \begingroup @@ -10366,8 +10494,8 @@ directory should work if nowhere else does.} % Loop from \countUTFx to \countUTFy, performing \UTFviiiTmp % substituting ~ and $ with a character token of that value. - \def\UTFviiiLoop{% - \global\catcode\countUTFx\active + \gdef\UTFviiiLoop{% + \catcode\countUTFx\active \uccode`\~\countUTFx \uccode`\$\countUTFx \uppercase\expandafter{\UTFviiiTmp}% @@ -10375,7 +10503,7 @@ directory should work if nowhere else does.} \ifnum\countUTFx < \countUTFy \expandafter\UTFviiiLoop \fi} - + % % For bytes other than the first in a UTF-8 sequence. Not expected to % be expanded except when writing to auxiliary files. \countUTFx = "80 @@ -10409,6 +10537,16 @@ directory should work if nowhere else does.} \else\expandafter\UTFviiiFourOctets\expandafter$\fi }}% \UTFviiiLoop + % + % for pdftex only, used to expand ASCII to UTF-16BE. + \gdef\asciitounicode{% + \countUTFx = "20 + \countUTFy = "80 + \def\UTFviiiTmp{% + \def~{\nullbyte $}}% + \UTFviiiLoop + } + {\catcode0=11 \gdef\nullbyte{^^00}}% \endgroup \def\globallet{\global\let} % save some \expandafter's below @@ -10433,8 +10571,8 @@ directory should work if nowhere else does.} \fi } -% These macros are used here to construct the name of a control -% sequence to be defined. +% These macros are used here to construct the names of macros +% that expand to the definitions for UTF-8 sequences. \def\UTFviiiTwoOctetsName#1#2{% \csname u8:#1\string #2\endcsname}% \def\UTFviiiThreeOctetsName#1#2#3{% @@ -10442,6 +10580,35 @@ directory should work if nowhere else does.} \def\UTFviiiFourOctetsName#1#2#3#4{% \csname u8:#1\string #2\string #3\string #4\endcsname}% +% generate UTF-16 from codepoint +\def\utfsixteentotoks#1#2{% + \countUTFz = "#2\relax + \ifnum \countUTFz > 65535 + % doesn't work for codepoints > U+FFFF + % we don't define glyphs for any of these anyway, so it doesn't matter + #1={U+#2}% + \else + \countUTFx = \countUTFz + \divide\countUTFx by 256 + \countUTFy = \countUTFx + \multiply\countUTFx by 256 + \advance\countUTFz by -\countUTFx + \uccode`,=\countUTFy + \uccode`;=\countUTFz + \ifnum\countUTFy = 0 + \uppercase{#1={\nullbyte\string;}}% + \else\ifnum\countUTFz = 0 + \uppercase{#1={\string,\nullbyte}}% + \else + \uppercase{#1={\string,\string;}}% + \fi\fi + % NB \uppercase cannot insert a null byte + \fi +} + +\newif\ifutfbytespdf +\utfbytespdffalse + % For UTF-8 byte sequences (TeX, e-TeX and pdfTeX), % provide a definition macro to replace a Unicode character; % this gets used by the @U command @@ -10458,18 +10625,22 @@ directory should work if nowhere else does.} \countUTFz = "#1\relax \begingroup \parseXMLCharref - - % Give \u8:... its definition. The sequence of seven \expandafter's - % expands after the \gdef three times, e.g. % + % Completely expand \UTFviiiTmp, which looks like: % 1. \UTFviiTwoOctetsName B1 B2 % 2. \csname u8:B1 \string B2 \endcsname % 3. \u8: B1 B2 (a single control sequence token) + \xdef\UTFviiiTmp{\UTFviiiTmp}% % - \expandafter\expandafter - \expandafter\expandafter - \expandafter\expandafter - \expandafter\gdef \UTFviiiTmp{#2}% + \ifpdf + \toksA={#2}% + \utfsixteentotoks\toksB{#1}% + \expandafter\xdef\UTFviiiTmp{% + \noexpand\ifutfbytespdf\noexpand\utfbytes{\the\toksB}% + \noexpand\else\the\toksA\noexpand\fi}% + \else + \expandafter\gdef\UTFviiiTmp{#2}% + \fi % \expandafter\ifx\csname uni:#1\endcsname \relax \else \message{Internal error, already defined: #1}% @@ -10479,8 +10650,9 @@ directory should work if nowhere else does.} \expandafter\globallet\csname uni:#1\endcsname \UTFviiiTmp \endgroup} % - % Given the value in \countUTFz as a Unicode code point, set \UTFviiiTmp - % to the corresponding UTF-8 sequence. + % Given the value in \countUTFz as a Unicode code point, set + % \UTFviiiTmp to one of the \UTVviii*OctetsName macros followed by + % the corresponding UTF-8 sequence. \gdef\parseXMLCharref{% \ifnum\countUTFz < "20\relax \errhelp = \EMsimple @@ -10540,7 +10712,7 @@ directory should work if nowhere else does.} } % Suppress ligature creation from adjacent characters. -\ifx\luatexversion\thisisundefined +\ifluatex \def\nolig{{}} \else % Braces do not suppress ligature creation in LuaTeX, e.g. in of{}fice @@ -11325,6 +11497,25 @@ directory should work if nowhere else does.} % \global\mathchardef\checkmark="1370% actually the square root sign \DeclareUnicodeCharacter{2713}{\ensuremath\checkmark}% + % + % These are all the combining accents. We need these empty definitions + % at present for the sake of PDF outlines. + \DeclareUnicodeCharacter{0300}{}% + \DeclareUnicodeCharacter{0301}{}% + \DeclareUnicodeCharacter{0302}{}% + \DeclareUnicodeCharacter{0303}{}% + \DeclareUnicodeCharacter{0305}{}% + \DeclareUnicodeCharacter{0306}{}% + \DeclareUnicodeCharacter{0307}{}% + \DeclareUnicodeCharacter{0308}{}% + \DeclareUnicodeCharacter{030A}{}% + \DeclareUnicodeCharacter{030B}{}% + \DeclareUnicodeCharacter{030C}{}% + \DeclareUnicodeCharacter{0323}{}% + \DeclareUnicodeCharacter{0327}{}% + \DeclareUnicodeCharacter{0328}{}% + \DeclareUnicodeCharacter{0331}{}% + \DeclareUnicodeCharacter{0361}{}% }% end of \unicodechardefs % UTF-8 byte sequence (pdfTeX) definitions (replacing and @U command) @@ -11463,12 +11654,12 @@ directory should work if nowhere else does.} \pdfhorigin = 1 true in \pdfvorigin = 1 true in \else - \ifx\XeTeXrevision\thisisundefined - \special{papersize=#8,#7}% - \else + \ifxetex \pdfpageheight #7\relax \pdfpagewidth #8\relax % XeTeX does not have \pdfhorigin and \pdfvorigin. + \else + \special{papersize=#8,#7}% \fi \fi % @@ -11668,21 +11859,21 @@ directory should work if nowhere else does.} #1#2#3=\countB\relax } -\ifx\XeTeXrevision\thisisundefined - \ifx\luatexversion\thisisundefined +\ifxetex % XeTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{} +\else + \ifluatex % LuaTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{\expandglyphsinfont#1 20 20 1\relax} + \else \ifpdf % pdfTeX \mtsetprotcode\textrm \def\mtfontexpand#1{\pdffontexpand#1 20 20 1 autoexpand\relax} \else % TeX \def\mtfontexpand#1{} \fi - \else % LuaTeX - \mtsetprotcode\textrm - \def\mtfontexpand#1{\expandglyphsinfont#1 20 20 1\relax} \fi -\else % XeTeX - \mtsetprotcode\textrm - \def\mtfontexpand#1{} \fi @@ -11691,18 +11882,18 @@ directory should work if nowhere else does.} \def\microtypeON{% \microtypetrue % - \ifx\XeTeXrevision\thisisundefined - \ifx\luatexversion\thisisundefined + \ifxetex % XeTeX + \XeTeXprotrudechars=2 + \else + \ifluatex % LuaTeX + \adjustspacing=2 + \protrudechars=2 + \else \ifpdf % pdfTeX \pdfadjustspacing=2 \pdfprotrudechars=2 \fi - \else % LuaTeX - \adjustspacing=2 - \protrudechars=2 \fi - \else % XeTeX - \XeTeXprotrudechars=2 \fi % \mtfontexpand\textrm @@ -11713,18 +11904,18 @@ directory should work if nowhere else does.} \def\microtypeOFF{% \microtypefalse % - \ifx\XeTeXrevision\thisisundefined - \ifx\luatexversion\thisisundefined + \ifxetex % XeTeX + \XeTeXprotrudechars=0 + \else + \ifluatex % LuaTeX + \adjustspacing=0 + \protrudechars=0 + \else \ifpdf % pdfTeX \pdfadjustspacing=0 \pdfprotrudechars=0 \fi - \else % LuaTeX - \adjustspacing=0 - \protrudechars=0 \fi - \else % XeTeX - \XeTeXprotrudechars=0 \fi } diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 9aad087c510..86ffba29744 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1154,7 +1154,8 @@ command to transfer is similar to the @option{scp} method. @command{rsync} performs much better than @command{scp} when transferring files that exist on both hosts. However, this advantage -is lost if the file exists only on one side of the connection. +is lost if the file exists only on one side of the connection, during +the first file transfer. This method supports the @samp{-p} argument. diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index fb8b6da145c..4740663e987 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.8.3 +@subtitle for version 0.8.4 @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.8.3. +This manual is for Transient version 0.8.4. @insertcopying @end ifnottex @@ -93,6 +93,7 @@ Defining New Commands * Binding Suffix and Infix Commands:: * Defining Suffix and Infix Commands:: * Using Infix Arguments:: +* Using Prefix Scope:: * Current Suffix Command:: * Current Prefix Command:: * Transient State:: @@ -553,6 +554,48 @@ the level specified by @code{transient-default-level} are temporarily available anyway. @end table +@defun transient-set-default-level suffix level +This function sets the default level of the suffix COMMAND to LEVEL@. + +If a suffix command appears in multiple menus, it may make sense to +consistently change its level in all those menus at once. For +example, the @code{--gpg-sign} argument (which is implemented using the +command @code{magit:--gpg-sign}), is bound in all of Magit's menu which +create commits. Users who sometimes sign their commits would want +that argument to be available in all of these menus, while for users +who never sign it is just unnecessary noise in any menus. + +To always make @code{--gpg-sign} available, use: + +@lisp +(transient-set-default-level 'magit:--gpg-sign 1) +@end lisp + +To never make @code{--gpg-sign} available, use: + +@lisp +(transient-set-default-level 'magit:--gpg-sign 0) +@end lisp + +This sets the level in the suffix prototype object for this command. +Commands only have a suffix prototype if they were defined using one +of @code{transient-define-argument}, @code{transient-define-infix} and +@code{transient-define-suffix}. For all other commands this would signal +an error. (This is one of the reasons why package authors should +use one of these functions to define shared suffix commands, and +especially shared arguments.) + +If the user changes the level of a suffix in a particular menu, +using @kbd{C-x l} as shown above, then that obviously shadows the default. + +It is also possible to set the level of a suffix binding in a +particular menu, either when defining the menu using +@code{transient-define-prefix,} or later using @code{transient-insert-suffix}. If +such bindings specify a level, then that also overrides the default. +(Per-suffix default levels is a new feature, so you might encounter +this quite often.) +@end defun + @node Other Commands @section Other Commands @@ -1017,6 +1060,7 @@ signal an error. * Binding Suffix and Infix Commands:: * Defining Suffix and Infix Commands:: * Using Infix Arguments:: +* Using Prefix Scope:: * Current Suffix Command:: * Current Prefix Command:: * Transient State:: @@ -1323,6 +1367,13 @@ be replaced with an error. The boolean @code{:pad-keys} argument controls whether keys of all suffixes contained in a group are right padded, effectively aligning the descriptions. + +@item +If a keyword argument accepts a function as value, you an use a +@code{lambda} expression. As a special case, the @code{##} macro (which returns a +@code{lambda} expression and is implemented in the @code{llama} package) is also +supported. Inside group specifications, the use of @code{##} is not +supported anywhere but directly following a keyword symbol. @end itemize The @var{ELEMENT}s are either all subgroups, or all suffixes and strings. @@ -1446,6 +1497,12 @@ Finally, details can be specified using optional @var{KEYWORD}-@var{VALUE} pairs Each keyword has to be a keyword symbol, either @code{:class} or a keyword argument supported by the constructor of that class. @xref{Suffix Slots}. +If a keyword argument accepts a function as value, you an use a @code{lambda} +expression. As a special case, the @code{##} macro (which returns a @code{lambda} +expression and is implemented in the @code{llama} package) is also supported. +Inside suffix bindings, the use of @code{##} is not supported anywhere but +directly following a keyword symbol. + @node Defining Suffix and Infix Commands @section Defining Suffix and Infix Commands @@ -1568,6 +1625,55 @@ used if you need the objects (as opposed to just their values) and if the current command is not being invoked from @var{PREFIX}. @end defun +@node Using Prefix Scope +@section Using Prefix Scope + +Some transients have a sort of secondary value, called a scope. A +prefix's scope can be accessed using @code{transient-scope}; similar to how +its value can be accessed using @code{transient-args}. + +@defun transient-scope prefixes classes +This function returns the scope of the active or current transient +prefix command. + +If optional PREFIXES and CLASSES are both nil, return the scope of +the prefix currently being setup, making this variation useful, e.g., +in @code{:if*} predicates. If no prefix is being setup, but the current +command was invoked from some prefix, then return the scope of that. + +If PREFIXES is non-nil, it must be a prefix command or a list of such +commands. If CLASSES is non-nil, it must be a prefix class or a list +of such classes. When this function is called from the body or the +@code{interactive} form of a suffix command, PREFIXES and/or CLASSES should +be non-nil. If either is non-nil, try the following in order: + +@itemize +@item +If the current suffix command was invoked from a prefix, which +appears in PREFIXES, return the scope of that prefix. + +@item +If the current suffix command was invoked from a prefix, and its +class derives from one of the CLASSES, return the scope of that +prefix. + +@item +If a prefix is being setup and it appears in PREFIXES, return its +scope. + +@item +If a prefix is being setup and its class derives from one of the +CLASSES, return its scope. + +@item +Finally try to return the default scope of the first command in +PREFIXES@. This only works if that slot is set in the respective +class definition or using its `transient-init-scope' method. +@end itemize + +If no prefix matches, return nil. +@end defun + @node Current Suffix Command @section Current Suffix Command @@ -2458,8 +2564,9 @@ being initialized. This slot is still experimental. @code{transient-mode-line-format}. It should have the same type. @item -@code{column-width} is only respected inside @code{transient-columns} groups and -allows aligning columns across separate instances of that. +@code{column-widths} is only respected inside @code{transient-columns} groups and +allows aligning columns across separate instances of that. A list +of integers. @item @code{variable-pitch} controls whether alignment is done pixel-wise to @@ -2535,8 +2642,9 @@ Also see @ref{Suffix Classes}. @subheading Slots of @code{transient-child} This is the abstract superclass of @code{transient-suffix} and @code{transient-group}. -This is where the shared @code{if*} and @code{inapt-if*} slots (see @ref{Predicate Slots}) -and the @code{level} slot (see @ref{Enabling and Disabling Suffixes}) are defined. +This is where the shared @code{if*} and @code{inapt-if*} slots (see @ref{Predicate Slots}), +the @code{level} slot (see @ref{Enabling and Disabling Suffixes}), and the @code{advice} +and @code{advice*} slots (see @ref{Slots of @code{transient-suffix}}) are defined. @itemize @item @@ -2595,6 +2703,24 @@ for details. defining a command using @code{transient-define-suffix}. @end itemize +The following two slots are experimental. They can also be set for a +group, in which case they apply to all suffixes in that group, except +for suffixes that set the same slot to a non-nil value. + +@itemize +@item +@code{advice} A function used to advise the command. The advise is called +using @code{(apply advice command args)}, i.e., it behaves like an "around" +advice. + +@item +@code{advice*} A function used to advise the command. Unlike @code{advice}, this +advises not only the command body but also its @code{interactive} spec. If +both slots are non-nil, @code{advice} is used for the body and @code{advice*} is +used for the @code{interactive} form. When advising the @code{interactive} spec, +called using @code{(funcall advice #'advice-eval-interactive-spec spec)}. +@end itemize + @anchor{Slots of @code{transient-infix}} @subheading Slots of @code{transient-infix} diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 02355e25f93..20a2e694426 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,13 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes in upcoming Eglot +** Support for call and type hierarchies + +The new commands 'eglot-show-type-hierarchy' and +'eglot-show-call-hierarchy', when invoked on a symbol, pop up a special +buffer showing an interactive tree which represents a hierarchy of sub- +and super-types or callers and callees for that symbol. + ** New 'eglot-advertise-cancellation' variable Tweaking this variable may help some LSP servers avoid doing costly but diff --git a/etc/NEWS b/etc/NEWS index 5b9e356737e..6d934b2029c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -41,12 +41,12 @@ incorrectly in rare cases. ** In compatible terminals, 'xterm-mouse-mode' is turned on by default. For these terminals the mouse will work by default. A compatible -terminal is one that supports Emacs seting and getting the OS selection +terminal is one that supports Emacs setting and getting the OS selection data (a.k.a. the clipboard) and mouse button and motion events. With -xterm-mouse-mode enabled, you must use Emacs keybindings to copy to the +'xterm-mouse-mode' enabled, you must use Emacs keybindings to copy to the OS selection instead of terminal-specific keybindings. -You can keep the old behavior by putting `(xterm-mouse-mode -1)' in your +You can keep the old behavior by putting '(xterm-mouse-mode -1)' in your init file. @@ -75,7 +75,7 @@ In particular: To enable tooltips on TTY frames, call 'tty-tip-mode'. The presence of child frame support on TTY frames can be checked with -`(featurep 'tty-child-frames)'. +'(featurep 'tty-child-frames)'. Recent versions of Posframe and Corfu are known to use child frames on TTYs if they are supported. @@ -108,7 +108,7 @@ instead of its now-obsolete variable. ** Network Security Manager (NSM) is now more strict. *** NSM warns about TLS 1.1 by default. -It has been deprecated by RFC8996, published in 2021. +It has been deprecated by RFC 8996, published in 2021. *** NSM warns about DHE and RSA key exchange by default. Emacs now warns about ephemeral Diffie-Hellman key exchange, and static @@ -176,18 +176,22 @@ will still be on that candidate after "*Completions*" is updated with a new list of completions. The candidate is automatically deselected when the "*Completions*" buffer is hidden. +--- +*** New user option 'crm-prompt' for 'completing-read-multiple'. +This option configures the prompt format of 'completing-read-multiple'. +By default the prompt indicates to the user that the completion command +accepts a comma-separated list. The prompt format can include the +separator description and the separator string, which are both stored as +text properties of the 'crm-separator' regular expression. + ** Windows +++ *** New functions to modify window layout. Several functions to modify the window layout have been added: -'rotate-window-layout-clockwise' -'rotate-window-layout-anticlockwise' -'flip-window-layout-vertically' -'flip-window-layout-horizontally' -'transpose-window-layout' -'rotate-windows' -'rotate-windows-back' +'rotate-window-layout-clockwise', 'rotate-window-layout-anticlockwise', +'flip-window-layout-vertically', 'flip-window-layout-horizontally', +'transpose-window-layout', 'rotate-windows', and 'rotate-windows-back'. +++ *** New hook 'window-deletable-functions'. @@ -230,6 +234,14 @@ It has been obsolete since Emacs 30.1. Use '(category . comint)' instead. Another user option 'display-tex-shell-buffer-action' has been removed too for which you can use '(category . tex-shell)'. ++++ +*** New user option 'split-window-preferred-direction'. +Users can now choose in which direction Emacs tries to split first: +vertical or horizontal. With this new setting, when the frame is in +landscape shape for instance, Emacs could split horizontally before +splitting vertically. The default setting preserves Emacs historical +behavior to try to split vertically first. + ** Frames +++ @@ -254,11 +266,11 @@ adjustment when a tab is restored, and avoids advice. *** New user option 'tab-bar-define-keys'. This controls which key bindings tab-bar creates. Values are t, the default, which defines all keys and is backwards compatible, 'numeric' -(tab number selection only), 'tab' (TAB and SHIFT-TAB keys only), nil +(tab number selection only), 'tab' ('TAB' and 'S-TAB' keys only), nil (which defines none). This is useful to avoid key binding conflicts, such as when folding in -outline mode using TAB keys, or when a user wants to define her own +outline mode using 'TAB' keys, or when a user wants to define her own tab-bar keys without first having to remove the defaults. --- @@ -274,12 +286,22 @@ docstring for arguments passed to a help-text function. *** New command 'project-root-find-file'. It is equivalent to running ‘project-any-command’ with ‘find-file’. +--- +*** Improved prompt for 'project-switch-project'. +The prompt now displays the chosen project on which to invoke a command. + --- *** The MAYBE-PROMPT argument of 'project-current' can be a string. When such value is used, the 'project-prompter' is called with it as the first argument. This is a way for the callers to indicate, for example, the reason or the context why the project is asked for. +--- +*** New command 'project-find-matching-file' +It can be used when switching between projects with similar file trees +(such as Git worktrees of the same repository). It supports being +invoked standalone or from the 'project-switch-commands' dispatch menu. + ** Registers *** New functions 'buffer-to-register' and 'file-to-register'. @@ -301,6 +323,11 @@ on the header lines are now these two: the selected window uses ** In 'customize-face', the "Font family" attribute now supports completion. +** 'process-adaptive-read-buffering' is now nil by default. +Setting this variable to a non-nil value reduces performance and leads +to wrong results in some cases. We believe that it is no longer useful; +please contact us if you still need it for some reason. + * Editing Changes in Emacs 31.1 @@ -386,13 +413,15 @@ modal editing packages. --- ** ASM mode + *** 'asm-mode-set-comment-hook' is obsolete. You can now set `asm-comment-char' from 'asm-mode-hook' instead. --- ** Ibuffer + *** New column 'recency' in Ibuffer display. -The variable 'ibuffer-formats' configures the Ibuffer formats. Add +The user option 'ibuffer-formats' configures the Ibuffer formats. Add 'recency' to the format to display the column. *** New value 'title' for the user option 'ibuffer-use-header-line'. @@ -402,15 +431,33 @@ set to 'title'. *** New user option 'ibuffer-human-readable-size'. When non-nil, buffer sizes are shown in human readable format. +--- +** Buffer Menu + +*** New user option 'Buffer-menu-human-readable-sizes'. +When non-nil, buffer sizes are shown in human readable format. The +default is nil, which retains the old format. + ** Smerge + *** New command 'smerge-extend' extends a conflict over surrounding lines. +*** New command 'smerge-refine-exchange-point' to jump to the other side. +When used inside a refined chunk, it jumps to the matching position in +the "other" side of the refinement: if you're in the new text, it jumps +to the corresponding position in the old text and vice versa. + ** Image Dired *** 'image-dired-show-all-from-dir' takes the same first argument as 'dired'. This allows passing a string with wildcards, or a cons cell where the first element is a list and the rest is a list of files. +*** Bound unused letters in 'image-dired-thumbnail-mode-map' +For a more comfortable navigation experience (as in, no modifier keys), +the keys "f", "b", "n", "p", "a" and "e" are now bound to the +same functions as their C- counterparts. + ** Browse URL *** New user option 'browse-url-transform-alist'. @@ -424,7 +471,7 @@ a web browser to load them. For example, it could be used like this: For better integration with the Qutebrowser, set 'browse-url(-secondary)-browser-function' to 'browse-url-qutebrowser'. -*** New GTK-native launch mode +*** New GTK-native launch mode. For better Wayland support, the pgtk toolkit exposes a new 'x-gtk-launch-uri' browse-url handler and uses it by default when URLs are browsed from a PGTK frame. For other frames, we fall back to the @@ -451,6 +498,58 @@ Such bindings make it possible to compute which function to bind to FUNC. If 'whitespace-style' includes 'missing-newline-at-eof' (which is the default), the 'whitespace-cleanup' function will now add the newline. +** Bookmark + +--- +*** Bookmark history now saves each bookmark only once. +Previously, the variable 'bookmark-history' accumulated duplicate +bookmark names when bookmark features were used interactively. This +made their history larger than necessary for frequent bookmark users. +Bookmark names are now saved uniquely. + +--- +*** New user option 'bookmark-bmenu-type-column-width'. +This user option controls the width of the type column on the bookmark +menu 'bookmark-bmenu-list'. The default value is 8 which is backwards +compatible. + +** Saveplace + +--- +*** You can now regularly auto-save places. +Customize user option 'save-place-autosave-interval' to the number of +seconds between auto saving places. For example, to save places every 5 +minutes: + + M-x customize-option RET save-place-autosave-interval RET 300 + +Or in Elisp: + + (setopt save-place-autosave-interval (* 60 5)) + +If 'save-place-autosave-interval' is nil, auto saving is disabled; this +is the default. As before, saved places are scheduled to be saved at +Emacs exit. + +** Savehist + +--- +*** Savehist no longer saves additional variables more than once. +If you configured 'savehist-additional-variables' with variables that +were also dynamically accumulated in minibuffer history during +minibuffer use, they are now saved only once in the file specified by +'savehist-file'. Previously, they were saved twice. + +** Message + +--- +*** "In-Reply-To" header contains only a message id. +The "In-Reply-To" header created when replying to a message now contains +only the originating message's id, conforming to RFC 5322. The previous +behavior included additional information about the originating message. +The new variable 'message-header-use-obsolete-in-reply-to', nil by +default, can be set to a non-nil value to restore the previous behavior. + ** Gnus --- @@ -459,6 +558,13 @@ When called with a prefix argument, accepting, declining, or tentatively accepting an icalendar event will prompt for a comment to add to the response. +** Sieve + ++++ +*** New keybinding to refresh buffer in 'sieve-manage-mode'. +'sieve-refresh-scriptlist' is now bound to 'g' to refresh the contents +of the current sieve buffer. + ** Button +++ @@ -474,6 +580,12 @@ It removes all the buttons in the specified region. 'comint-complete-input-ring' ('C-x ') is like 'minibuffer-complete-history' but completes on comint inputs. +--- +*** 'ansi-osc-directory-tracker' now respects remote directories. +Remote directories are now retained when changes to 'default-directory' +are detected by this filter. For example, "/ssh:hostname:/home/username" +would have been stripped to just "/home/username" before. + ** Eshell --- @@ -561,6 +673,32 @@ only search in input history. If you customize it to the symbol 'dwim', those commands search in input history only when the point is after the last prompt. ++++ +** Mail-util + +*** New user option 'mail-re-regexps'. +This contains the list of regular expressions used to match "Re:" and +international variants of it when modifying the Subject field in +replies. + ++++ +** Rmail + +*** 'rmail-re-abbrevs' default value is now derived from 'mail-re-regexps'. +'mail-re-regexps' is a new user option that is easier to customize than +'rmail-re-abbrevs'. 'rmail-re-abbrevs' is still honored if it was +already set. + ++++ +** Message + +*** 'message-subject-re-regexp' default value is now derived from 'mail-re-regexps'. +'mail-re-regexps' is a new user option that is easier to customize than +'message-subject-re-regexp'. 'message-subject-re-regexp' is still +honored if it was already set. + +*** 'message-strip-subject-re' now matches case-insensitively. + ** SHR +++ @@ -647,7 +785,6 @@ build tags for the test commands. The 'go-ts-mode-test-flags' user option is available to set a list of additional flags to pass to the go test command line. - ** C-ts mode +++ @@ -719,6 +856,13 @@ the 'mutool' program after their initial conversion to PDF format. The name of the 'djvused' program can be customized by changing the user option 'doc-view-djvused-program'. +** Ispell + +--- +*** The default value of 'ispell-help-timeout' has changed. +The default value is now 30 seconds, as the old value was too short to +allow reading the help text. + ** Flyspell --- @@ -861,6 +1005,30 @@ the 'grep' results editable. The edits will be reflected in the buffer visiting the originating file. Typing 'C-c C-c' will leave the Grep Edit mode. +** Time Stamp + +--- +*** 'time-stamp' can up-case, capitalize and down-case date words. +This control can be useful in languages in which days of the week and/or +month names are capitalized only at the beginning of a sentence. For +details, see the built-in documentation for user option 'time-stamp-format'. + +Because this feature is new in Emacs 31.1, do not use it in the local +variables section of any file that might be edited by an older version +of Emacs. + +--- +*** Some historical 'time-stamp' conversions now warn. +'time-stamp-pattern' and 'time-stamp-format' had quietly accepted +several 'time-stamp' conversions (e.g., "%:y") that have been deprecated +since Emacs 27.1. These now generate a warning with a suggested +migration. + +Merely having '(add-hook 'before-save-hook 'time-stamp)' +in your Emacs init file does not expose you to this change. +However, if you set 'time-stamp-format' or 'time-stamp-pattern' +with a file-local variable, you may be asked to update the value. + ** TeX modes +++ @@ -916,6 +1084,14 @@ exist. If "python" points to Python 2 on your system, you now have to customize these variables to "python3" if you want to use Python 3 instead. +--- +*** Python 2 support is now optional and disabled by default. +Since Python 2 EOL was over 5 years ago, this release removes Python +2-only builtins such as "file" from the default highlighting in +'python-mode' and 'python-ts-mode'. If you would like them highlighted, +customize the new user option 'python-2-support' to a non-nil value and +restart Emacs. + --- *** Support of 'electric-layout-mode' added. @@ -987,6 +1163,12 @@ the directory into which the repository was cloned. ** Package ++++ +*** No longer warn if a package has no footer line. +package.el no longer warns for packages without a "footer line", which +is the line that usually appears at the very end of an Emacs Lisp file: +;;; FILENAME ends here + --- *** New optional argument to 'package-autoremove'. An optional argument NOCONFIRM has been added to 'package-autoremove'. @@ -999,6 +1181,14 @@ removing packages. When invoked with a prefix argument, 'package-install-selected-packages' will not prompt the user for confirmation before installing packages. +--- +*** 'package-refresh-contents' runs asynchronously. +Refreshing the package index will no longer block when invoked +interactively. + ++++ +*** package-x.el is now obsolete. + ** Xref --- @@ -1012,6 +1202,19 @@ destination window is chosen using 'display-buffer-alist'. Example: display-buffer-use-some-window) (some-window . mru)))) +** Autorevert + ++++ +*** New variable 'inhibit-auto-revert-buffers'. +While a buffer is member of this variable, a list of buffers, +auto-reverting of this buffer is suppressed. + ++++ +*** New macro 'inhibit-auto-revert'. +This macro adds the current buffer to 'inhibit-auto-revert-buffers', +runs its body, and removes the current buffer from +'inhibit-auto-revert-buffers' afterwards. + * New Modes and Packages in Emacs 31.1 @@ -1021,11 +1224,14 @@ destination window is chosen using 'display-buffer-alist'. Example: ** Nested backquotes are not supported any more in Pcase patterns. --- -** The obsolete variable `redisplay-dont-pause' has been removed. +** The obsolete variable 'redisplay-dont-pause' has been removed. ** The 'rx' category name 'chinese-two-byte' must now be spelled correctly. An old alternative name (without the first 'e') has been removed. ++++ +** 'read-directory-name' now accepts an optional PREDICATE argument. + --- ** All the digit characters now have the 'digit' category. All the characters whose Unicode general-category is Nd now have the @@ -1097,7 +1303,7 @@ authorize the invoked D-Bus method (for example via polkit). ** The customization group 'wp' has been removed. It has been obsolete since Emacs 26.1. Use the group 'text' instead. -** Changes in tree-sitter modes. +** Changes in tree-sitter modes +++ *** Indirect buffers can have their own parser list. @@ -1122,7 +1328,7 @@ override flag by 'treesit-font-lock-setting-query', 'treesit-font-lock-setting-feature', 'treesit-font-lock-setting-enable', and 'treesit-font-lock-setting-override'. -*** New treesit thing 'list'. +*** New tree-sitter thing 'list'. Unlike the existing thing 'sexp' that defines both lists and atoms, 'list' defines only lists to be navigated by 'forward-sexp'. The new function 'treesit-forward-sexp-list' uses 'list' @@ -1145,9 +1351,9 @@ used to communicate the tree-sitter parsing results to *** Tree-sitter enabled modes now properly support 'hs-minor-mode'. All commands from hideshow.el can selectively display blocks -defined by the new treesit thing 'list'. +defined by the new tree-sitter thing 'list'. -*** New treesit thing 'comment'. +*** New tree-sitter thing 'comment'. The new variable 'forward-comment-function' is set to the new function 'treesit-forward-comment' if a major mode defines the thing 'comment'. @@ -1159,26 +1365,26 @@ variable 'treesit-language-display-name-alist' holds the translations of language symbols where that translation is not trivial. +++ -*** New command 'treesit-explore' +*** New command 'treesit-explore'. This command replaces 'treesit-explore-mode'. It turns on 'treesit-explore-mode' if it’s not on, and pops up the explorer buffer if it’s already on. +++ -*** 'treesit-explore-mode' now supports local parsers +*** 'treesit-explore-mode' now supports local parsers. Now 'treesit-explore-mode' (or 'treesit-explore') prompts for a parser rather than a language, and it’s now possible to select a local parser at point to explore. +++ -*** New variable 'treesit-aggregated-simple-imenu-settings' +*** New variable 'treesit-aggregated-simple-imenu-settings'. This variable allows major modes to setup Imenu for multiple languages. -*** New function 'treesit-add-simple-indent-rules' +*** New function 'treesit-add-simple-indent-rules'. This new function makes it easier to customize indent rules for tree-sitter modes. -*** New variable 'treesit-simple-indent-override-rules' +*** New variable 'treesit-simple-indent-override-rules'. Users can customize this variable to add simple custom indentation rules for tree-sitter major modes. @@ -1261,6 +1467,17 @@ provide instructions for finding the definition. New convenience function 'find-function-update-type-alist' offers a concise way to update a symbol's 'find-function-type-alist' property. +** Special Events + ++++ +*** New primitive 'insert-special-event'. +This function inserts the special EVENT into the input event queue. + ++++ +*** New event type 'sleep-event'. +This event is sent when the device running Emacs enters or leaves the +sleep state. + * Changes in Emacs 31.1 on Non-Free Operating Systems @@ -1319,6 +1536,12 @@ means of the GDI+ library. In addition to ':file FILE' for playing a sound from a file, ':data DATA' can now be used to play a sound from memory. +--- +** New major mode 'go-work-ts-mode'. +A major mode based on the tree-sitter library for editing "go.work" +files. If tree-sitter is properly set-up by the user, it can be +enabled for files named "go.work". + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/etc/NEWS.30 b/etc/NEWS.30 index ce5290171a1..ec14e447859 100644 --- a/etc/NEWS.30 +++ b/etc/NEWS.30 @@ -15,16 +15,9 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. -Temporary note: -+++ indicates that all relevant manuals in doc/ have been updated. ---- means no change in the manuals is needed. -When you add a new item, use the appropriate mark if you are sure it -applies, and please also update docstrings as needed. - * Installation Changes in Emacs 30.1 ---- ** Native compilation is now enabled by default. 'configure' will enable the Emacs Lisp native compiler, so long as libgccjit is present and functional on the system. To disable native @@ -32,20 +25,17 @@ compilation, configure Emacs with the option: ./configure --with-native-compilation=no -+++ ** Emacs has been ported to the Android operating system. This requires Emacs to be compiled on another computer. The Android NDK, SDK, and a suitable Java compiler must also be installed. See the file "java/INSTALL" for more details. ---- ** Native JSON support is now always available; libjansson is no longer used. No external library is required. The '--with-json' configure option has been removed. 'json-available-p' now always returns non-nil and is only kept for compatibility. ---- ** Emacs now defaults to the ossaudio library for sound on NetBSD and OpenBSD. Previously, configure used ALSA libraries if installed on the system when configured '--with-sound=yes' (which is the default), with fallback @@ -55,7 +45,6 @@ and to resolve potential incompatibilities between GNU/Linux and *BSD versions of ALSA. Use '--with-sound=alsa' to build with ALSA on these operating systems instead. ---- ** New configuration option '--disable-gc-mark-trace'. This disables the GC mark trace buffer for about 5% better garbage collection performance. Doing so may make it more difficult for Emacs @@ -65,7 +54,6 @@ why the mark trace buffer is enabled by default. * Startup Changes in Emacs 30.1 ---- ** On GNU/Linux, Emacs is now the default application for 'org-protocol'. Org mode provides a way to quickly capture bookmarks, notes, and links using 'emacsclient': @@ -79,7 +67,6 @@ arranges for Emacs to be the default application for the 'org-protocol' URI scheme. See the Org mode manual, Info node "(org) Protocols" for more details. -+++ ** New variable lets Lisp code read emacsclient arguments. When '--eval' is passed to emacsclient and Emacs is evaluating each argument, the new variable 'server-eval-args-left' is set to those @@ -92,7 +79,6 @@ escaping (to protect them from the shell). * Incompatible Changes in Emacs 30.1 ---- ** Tree-Sitter modes are now declared as submodes of the non-TS modes. In order to help the use of those Tree-Sitter modes, they are now declared to have the corresponding non-Tree-Sitter mode as an @@ -133,7 +119,6 @@ variants of major modes are available, because that variable overrides the remapping Emacs might decide to perform as result of loading Lisp files and features. ---- ** Mouse wheel events should now always be 'wheel-up/down/left/right'. At those places where the old 'mouse-4/5/6/7' events could still occur (i.e., X11 input in the absence of XInput2, and 'xterm-mouse-mode'), @@ -143,7 +128,6 @@ The old variables 'mouse-wheel-up-event', 'mouse-wheel-down-event', 'mouse-wheel-left-event', and 'mouse-wheel-right-event' are thereby obsolete. -+++ ** 'completion-auto-help' now affects 'icomplete-in-buffer'. Previously, 'completion-auto-help' mostly affected only minibuffer completion. Now, if 'completion-auto-help' has the value 'lazy', then @@ -153,7 +137,6 @@ after the 'completion-at-point' command has been invoked twice, and if completely suppressed. Thus, if you use 'icomplete-in-buffer', ensure 'completion-auto-help' is not customized to 'lazy' or nil. -+++ ** The "*Completions*" buffer now always accompanies 'icomplete-in-buffer'. Previously, it was not consistent whether the "*Completions*" buffer would appear when using 'icomplete-in-buffer'. Now the "*Completions*" buffer @@ -164,27 +147,23 @@ to your init file: (advice-add 'completion-at-point :after #'minibuffer-hide-completions) ---- ** The default process filter was rewritten in native code. The round-trip through the Lisp function 'internal-default-process-filter' is skipped when the process filter is the default one. It is reimplemented in native code, reducing GC churn. To undo this change, set 'fast-read-process-output' to nil. -+++ ** Network Security Manager now warns about 3DES by default. This cypher is no longer recommended owing to a major vulnerability disclosed in 2016, and its small 112 bit key size. Emacs now warns about its use also when 'network-security-level' is set to 'medium' (the default). See 'network-security-protocol-checks'. ---- ** Network Security Manager now warns about <2048 bits in DH key exchange. Emacs used to warn for ephemeral Diffie-Hellman (DHE) key exchanges with prime numbers smaller than 1024 bits. Since more servers now support it, this number has been bumped to 2048 bits. -+++ ** URL now never sends user email addresses in HTTP requests. Emacs never sent email addresses by default, but it used to be possible to customize 'url-privacy-level' so that the user's email @@ -196,7 +175,6 @@ removed, as it was considered more dangerous than useful. RFC 9110 To send an email address in the header of individual HTTP requests, see the variable 'url-request-extra-headers'. ---- ** 'pixel-scroll-precision-mode' sets 'make-cursor-line-fully-visible'. 'pixel-scroll-precision-mode' sets 'make-cursor-line-fully-visible' to a nil value globally, since the usual requirement of the Emacs display to @@ -206,23 +184,25 @@ expectations. * Changes in Emacs 30.1 -+++ ** New user option 'trusted-content' to allow potentially dangerous features. This option lists those files and directories whose content Emacs should consider as sufficiently trusted to run any part of the code contained therein even without any explicit user request. + For example, Flymake's backend for Emacs Lisp consults this option and disables itself with an "untrusted content" warning if the file is not listed. ---- +Emacs Lisp authors should note that a major or minor mode must never set +this option to the ':all' value. + +This option is used to fix CVE-2024-53920. See below for details. + ** Emacs now supports Unicode Standard version 15.1. -+++ ** Emacs now comes with Org v9.7. See the file "etc/ORG-NEWS" for user-visible changes in Org. -+++ ** Improved support for touchscreen devices. On systems that understand them (at present X, Android, PGTK, and MS-Windows), many touch screen gestures are now implemented and @@ -231,7 +211,6 @@ bar buttons and opening menus has been added. Countless packages, such as Dired and Custom, have been adjusted to better understand touch screen input. -+++ ** Support for styled underline face attributes. These are implemented as new values of the 'style' attribute in a face underline specification, 'double-line', 'dots', and 'dashes', and are @@ -240,36 +219,30 @@ database entry defines the 'Su' or 'Smulx' capability, Emacs will also emit the prescribed escape sequence to render faces with such styles on TTY frames. ---- ** Support for underline colors on TTY frames. Colors specified in the underline face will now also be displayed on TTY frames on terminals that support the 'Su' or 'Smulx' capabilities. -+++ ** Modeline elements can now be right-aligned. Anything following the symbol 'mode-line-format-right-align' in 'mode-line-format' will be right-aligned. Exactly where it is right-aligned to is controlled by the new user option 'mode-line-right-align-edge'. ---- ** X selection requests are now handled much faster and asynchronously. This means it should be less necessary to disable the likes of 'select-active-regions' when Emacs is running over a slow network connection. ---- ** Emacs now updates invisible frames that are made visible by a compositor. If an invisible or an iconified frame is shown to the user by the compositing manager, Emacs will now redisplay such a frame even though 'frame-visible-p' returns nil or 'icon' for it. This can happen, for example, as part of preview for iconified frames. -+++ ** Most file notification backends detect unmounting of a watched filesystem. The only exception is w32notify. -+++ ** The ':map' property of images is now recomputed when image is transformed. Images with clickable maps now work as expected after you run commands such as 'image-increase-size', 'image-decrease-size', 'image-rotate', @@ -279,13 +252,11 @@ from recomputing image maps. ** Minibuffer and Completions -+++ *** New commands 'previous-line-completion' and 'next-line-completion'. Bound to '' and '' arrow keys, respectively, they navigate the "*Completions*" buffer vertically by lines, wrapping at the top/bottom when 'completion-auto-wrap' is non-nil. -+++ *** New user option 'minibuffer-visible-completions'. When customized to non-nil, you can use arrow keys in the minibuffer to navigate the completions displayed in the "*Completions*" window. @@ -294,7 +265,6 @@ completions window. When the completions window is not visible, then all these keys have their usual meaning in the minibuffer. This option is supported for in-buffer completion as well. ---- *** Selected completion candidates are deselected on typing. When you type at the minibuffer prompt, the current completion candidate will be un-highlighted, and point in the "*Completions*" window @@ -306,13 +276,11 @@ the minibuffer contents instead. This deselection behavior can be controlled with the new user option 'completion-auto-deselect', which is t by default. -+++ *** New value 'historical' for user option 'completions-sort'. When 'completions-sort' is set to 'historical', completion candidates will be first sorted alphabetically, and then re-sorted by their order in the minibuffer history, with more recent candidates appearing first. -+++ *** 'completion-category-overrides' supports more metadata. The new supported completion properties are 'cycle-sort-function', 'display-sort-function', 'annotation-function', 'affixation-function', @@ -320,21 +288,18 @@ and 'group-function'. You can now customize them for any category in 'completion-category-overrides' that will override the properties defined in completion metadata. -+++ *** 'completion-extra-properties' supports more metadata. The new supported completion properties are 'category', 'group-function', 'display-sort-function', and 'cycle-sort-function'. ** Windows -+++ *** New command 'toggle-window-dedicated'. This makes it easy to interactively mark a specific window as dedicated, so it won't be reused by 'display-buffer'. This can be useful for complicated window setups. It is bound to 'C-x w d' globally. -+++ *** "d" in the mode line now indicates that the window is dedicated. Windows have always been able to be dedicated to a specific buffer; see 'window-dedicated-p'. Now the mode line indicates the dedicated @@ -343,7 +308,6 @@ dedicated and "D" if the window is strongly dedicated. This indicator appears before the buffer name, and after the buffer modification and remote buffer indicators (usually "---" together). -+++ *** New action alist entry 'some-window' for 'display-buffer'. It specifies which window 'display-buffer-use-some-window' should prefer. For example, when 'display-buffer-base-action' is customized to @@ -351,25 +315,21 @@ For example, when 'display-buffer-base-action' is customized to in the same most recently used window from consecutive calls of 'display-buffer' (in a configuration with more than two windows). -+++ *** New action alist entry 'category' for 'display-buffer'. If the caller of 'display-buffer' passes '(category . symbol)' in its 'action' argument, you can match the displayed buffer by adding '(category . symbol)' to the condition part of 'display-buffer-alist' entries. -+++ *** New action alist entry 'post-command-select-window' for 'display-buffer'. 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. ---- *** New variable 'window-point-context-set-function'. It can be used to set a context for window point in all windows by 'window-point-context-set' before calling 'current-window-configuration' @@ -379,14 +339,12 @@ and 'window-state-get'. Then later another new variable 'window-state-put' to restore positions of window points according to the context stored in a window parameter. -+++ *** New functions 'set-window-cursor-type' and 'window-cursor-type'. 'set-window-cursor-type' sets a per-window cursor type, and 'window-cursor-type' queries this setting for a given window. Windows are always created with a 'window-cursor-type' of t, which means to consult the variable 'cursor-type' as before. ---- *** The user option 'display-comint-buffer-action' is now obsolete. You can use a '(category . comint)' condition in 'display-buffer-alist' to match buffers displayed by comint-related commands. Another @@ -395,60 +353,50 @@ for which you can use '(category . tex-shell)'. ** Tool bars -+++ *** Tool bars can now be placed on the bottom on more systems. The 'tool-bar-position' frame parameter can be set to 'bottom' on all window systems other than macOS and GNUstep (Nextstep). -+++ *** New global minor mode 'modifier-bar-mode'. When this minor mode is enabled, the tool bar displays buttons representing modifier keys. Clicking on these buttons applies the corresponding modifiers to the next input event. -+++ *** New user option 'tool-bar-always-show-default'. When non-nil, the tool bar at the top of a frame does not show buffer local customization of the tool bar. The default value is nil. ** Tab Bars and Tab Lines ---- *** New user option 'tab-bar-select-restore-context'. It uses 'window-point-context-set' to save contexts where window points were located before switching away from the tab, and 'window-point-context-use' to restore positions of window points after switching back to that tab. ---- *** 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 with the name " *Old 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 the appearance of every tab on the tab bar. ---- *** New hook 'tab-bar-tab-post-select-functions'. ---- *** New keymap 'tab-bar-mode-map'. By default it contains a keybinding 'C-TAB' to switch tabs, but only when 'C-TAB' is not bound globally. You can unbind it if it conflicts with 'C-TAB' in other modes. ---- *** New keymap 'tab-line-mode-map'. By default it contains keybindings for switching tabs: 'C-x ', 'C-x ', 'C-x C-', 'C-x C-'. You can unbind them if you want to use these keys for the commands 'previous-buffer' and 'next-buffer'. ---- *** Default list of tab-line tabs is changed to support a fixed order. This means that 'tab-line-tabs-fixed-window-buffers', the new default tabs function, is like the previous 'tab-line-tabs-window-buffers' where @@ -458,29 +406,24 @@ original order of buffers on the tab line, even after switching between these buffers. You can drag the tabs and release at a new position to manually reorder the buffers on the tab line. ---- *** New user option 'tab-line-tabs-buffer-group-function'. It provides two choices to group tab buffers by major mode and by project name. ---- *** Buffers on tab-line group tabs are now sorted alphabetically. This will keep the fixed order of tabs, even after switching between them. ** Help -+++ *** New command 'help-find-source'. Switch to a buffer visiting the source of what is being described in "*Help*". It is bound to 'C-h 4 s' globally. ---- *** New user option 'describe-bindings-outline-rules'. This user option controls outline visibility in the output buffer of 'describe-bindings' when 'describe-bindings-outline' is non-nil. ---- *** 'describe-function' shows the function's inferred type when available. For native compiled Lisp functions, 'describe-function' prints (after the signature) the automatically inferred function type as well. If the @@ -489,18 +432,15 @@ function's type was explicitly declared (via the 'declare' form's controlled by the new user option 'help-display-function-type', which is by default t; customize to nil to disable function type display. ---- *** 'describe-function' now shows the type of the function object. The text used to say things like "car is a built-in function" whereas it now says "car is a primitive-function" where "primitive-function" is the name of the symbol returned by 'cl-type-of'. You can click on those words to get information about that type. ---- *** 'C-h m' ('describe-mode') uses outlining by default. Set 'describe-mode-outline' to nil to get back the old behavior. ---- *** 'C-h k' ('describe-key') shows Unicode name. For keybindings which produce single characters via translation or input methods, 'C-h k' now shows the Unicode name of the produced character in @@ -510,7 +450,6 @@ addition to the character itself, e.g. € 'EURO SIGN' (translated from C-x 8 E) ---- *** 'C-h b' ('describe-bindings') shows Unicode names. For keybindings which produce single characters via translation (such as those using the 'C-x 8' or 'A-' prefix, or 'dead-acute', 'dead-grave', @@ -522,54 +461,42 @@ itself, i.e. and so on. -+++ *** Multi-character key echo now ends with a suggestion to use Help. Customize 'echo-keystrokes-help' to nil to prevent that. ** Customize -+++ *** New command 'customize-dirlocals'. This command pops up a buffer to edit the settings in ".dir-locals.el". ---- *** New command 'customize-toggle-option'. This command can toggle boolean options for the duration of a session. -+++ *** New prefix argument for modifying directory-local variables. The commands 'add-dir-local-variable', 'delete-dir-local-variable' and 'copy-file-locals-to-dir-locals' now take an optional prefix argument, to enter the file name where you want to modify directory-local variables. -+++ *** New user option 'safe-local-variable-directories'. This user option names directories in which Emacs will treat all directory-local variables as safe. -+++ ** CL Print -+++ *** There is a new chapter in the CL manual documenting cl-print.el. See the Info node "(cl) Printing". -+++ *** You can expand the "..." truncation everywhere. The code that allowed "..." to be expanded in the "*Backtrace*" buffer should now work anywhere the data is generated by 'cl-print'. -+++ *** The 'backtrace-ellipsis' button is replaced by 'cl-print-ellipsis'. -+++ *** hash-tables' contents can be expanded via the ellipsis. -+++ *** Modes can control the expansion via 'cl-print-expand-ellipsis-function'. -+++ *** New setting 'raw' for 'cl-print-compiled'. This setting causes byte-compiled functions to be printed in full by 'prin1'. A button on this output can be activated to disassemble the @@ -577,17 +504,14 @@ function. ** Miscellaneous -+++ *** New command 'kill-matching-buffers-no-ask'. This works like 'kill-matching-buffers', but without asking for confirmation. -+++ *** 'recover-file' can show diffs between auto save file and current file. When answering the prompt with "diff" or "=", it now shows the diffs between the auto save file and the current file. -+++ *** 'read-passwd' can toggle the visibility of passwords. Use 'TAB' in the minibuffer to show or hide the password. Alternatively, click the new show-password icon on the mode-line with @@ -597,7 +521,6 @@ Alternatively, click the new show-password icon on the mode-line with When called interactively, 'advice-remove' now prompts for an advised function to the advice to remove. ---- *** New user option 'uniquify-dirname-transform'. This can be used to customize how buffer names are uniquified, by making arbitrary transforms on the buffer's directory name (whose @@ -606,50 +529,41 @@ can use this to distinguish between buffers visiting files with the same base name that belong to different projects by using the provided transform function 'project-uniquify-dirname-transform'. -+++ *** New user option 'remote-file-name-inhibit-delete-by-moving-to-trash'. When non-nil, this option suppresses moving remote files to the local trash when deleting. Default is nil. ---- *** New user option 'remote-file-name-inhibit-auto-save'. If this user option is non-nil, 'auto-save-mode' will not auto-save remote buffers. The default is nil. -+++ *** New user option 'remote-file-name-access-timeout'. If a positive number, this option limits the call of 'access-file' for remote files to that number of seconds. Default is nil. -+++ *** New user option 'yes-or-no-prompt'. This allows the user to customize the prompt that is appended by 'yes-or-no-p' when asking questions. The default value is "(yes or no) ". ---- *** New user option 'menu-bar-close-window'. When non-nil, selecting "Close" from the "File" menu or clicking "Close" in the tool bar will result in the current window being deleted, if possible. The default is nil, and these gestures kill the buffer shown in the current window, but don't delete the window. ---- *** New face 'display-time-date-and-time'. This is used for displaying the time and date components of 'display-time-mode'. ---- *** New face 'appt-notification' for 'appt-display-mode-line'. It can be used to customize the look of the appointment notification displayed on the mode line when 'appt-display-mode-line' is non-nil. ---- *** New icon images for general use. Several symbolic icons have been added to "etc/images/symbols", including plus, minus, check-mark, star, etc. ---- *** Emacs now recognizes shebang lines that pass '-S'/'--split-string' to 'env'. When visiting a script that invokes 'env -S INTERPRETER ARGS...' in its shebang line, Emacs will now skip over 'env -S' and deduce the @@ -661,14 +575,11 @@ executable, if it exists. This should remove the need to change its value when installing GNU coreutils using something like ports or Homebrew. -+++ *** 'write-region-inhibit-fsync' now defaults to t in interactive mode. This is the default in batch mode since Emacs 24. ---- *** The default value of 'read-process-output-max' was increased to 65536. -+++ *** 'url-gateway-broken-resolution' is now obsolete. This option was intended for use on SunOS 4.x and Ultrix systems, neither of which have been supported by Emacs since version 23.1. @@ -678,7 +589,6 @@ The user option 'url-gateway-nslookup-program' and the command * Editing Changes in Emacs 30.1 -+++ ** New minor mode 'visual-wrap-prefix-mode'. When enabled, continuation lines displayed for a wrapped long line will receive a 'wrap-prefix' automatically computed from the line's @@ -692,7 +602,6 @@ buffers. (This minor mode is the 'adaptive-wrap' ELPA package renamed and lightly edited for inclusion in Emacs.) -+++ ** New global minor mode 'kill-ring-deindent-mode'. When enabled, text being saved to the kill ring will be de-indented by the column number at its start. For example, saving the entire @@ -714,7 +623,6 @@ long_function_with_several_arguments (argument_1_compute (), This omits the two columns of extra indentation that would otherwise be copied from the second and third lines and saved to the kill ring. ---- ** New command 'replace-regexp-as-diff'. It reads a regexp to search for and a string to replace with, then displays a buffer with replacements as diffs. After reviewing the @@ -724,7 +632,6 @@ a patch to the current file buffer. There are also new commands in a list of specified files, and 'dired-do-replace-regexp-as-diff' that shows as diffs replacements in the marked files in Dired. -+++ ** New mode of prompting for register names and showing preview. The new user option 'register-use-preview' can be customized to the value t or 'insist' to request a different user interface of prompting for @@ -737,7 +644,6 @@ The default value of 'register-use-preview' ('traditional') preserves the behavior of Emacs 29 and before. See the Info node "(emacs) Registers" for more details about the new UI and its variants. -+++ ** New advanced macro counter commands. New commands have been added to implement advanced macro counter functions. @@ -753,7 +659,6 @@ The commands 'C-x C-k C-q =', 'C-x C-k C-q <', and 'C-x C-k C-q >' compare the macro counter with an optional prefix and terminate the macro if the comparison succeeds. -+++ ** New mode 'kmacro-menu-mode' and new command 'list-keyboard-macros'. The new command 'list-keyboard-macros' is the keyboard-macro version of commands like 'list-buffers' and 'list-processes', creating a listing @@ -762,19 +667,16 @@ of the currently existing keyboards macros using the new mode duplicating them, deleting them, and editing their counters, formats, and keys. ---- ** On X, Emacs now supports input methods which perform "string conversion". This means an input method can now ask Emacs to delete text surrounding point and replace it with something else, as well as query Emacs for surrounding text. If your input method allows you to "undo" mistaken compositions, this will now work as well. ---- ** New user option 'duplicate-region-final-position'. It controls the placement of point and the region after duplicating a region with 'duplicate-dwim'. -+++ ** New user option 'mouse-prefer-closest-glyph'. When enabled, clicking or dragging with the mouse will put the point or start the drag in front of the buffer position corresponding to the @@ -785,14 +687,12 @@ whereas if the mouse pointer is in the left half of a glyph, point will be put in front the buffer position corresponding to that glyph. By default this is disabled. ---- ** New pre-defined values for 'electric-quote-chars'. The available customization options for 'electric-quote-chars' have been updated with common pairs of quotation characters, including "‘", "’", "“", "”", "«", "»", "‹", "›", "‚", "„", "「", "」", "『", and "』". The default is unchanged. -+++ ** 'M-TAB' now invokes 'completion-at-point' in Text mode. By default, Text mode no longer binds 'M-TAB' to 'ispell-complete-word'. Instead, this mode arranges for 'completion-at-point', globally bound to @@ -803,7 +703,6 @@ customizing the new user option 'text-mode-ispell-word-completion'. ** Internationalization ---- *** Mode-line mnemonics for some coding-systems have changed. The mode-line mnemonic for 'utf-7' is now the lowercase 'u', to be consistent with the other encodings of this family. @@ -819,7 +718,6 @@ previous behavior of showing 'U' in the mode line for 'koi8-u': (coding-system-put 'koi8-u :mnemonic ?U) ---- *** 'vietnamese-tcvn' is now a coding system alias for 'vietnamese-vscii'. VSCII-1 and TCVN-5712 are different names for the same character encoding. Therefore, the duplicate coding system definition has been @@ -828,7 +726,6 @@ dropped in favor of an alias. The mode-line mnemonic for 'vietnamese-vscii' and its aliases is the lowercase letter "v". ---- *** Users in CJK locales can control width of some non-CJK characters. Some characters are considered by Unicode as "ambiguous" with respect to their display width: either "full-width" (i.e., taking 2 columns on @@ -845,25 +742,20 @@ or narrow (if the variable is customized to the nil value). This setting affects the results of 'string-width' and similar functions in CJK locales. ---- *** New input methods for the Urdu, Pashto, and Sindhi languages. These languages are spoken in Pakistan and Afghanistan. ---- *** New input method "english-colemak". This input method supports the Colemak keyboard layout. ---- *** Additional 'C-x 8' key translations for "æ" and "Æ". These characters can now be input with 'C-x 8 a e' and 'C-x 8 A E', respectively, in addition to the existing translations 'C-x 8 / e' and 'C-x 8 / E'. ---- *** New 'C-x 8' key translations for "low" quotes "„", and "‚". These can now be entered with 'C-x , "' and 'C-x , ''. ---- *** New German language 'C-x 8' key translations for quotation marks. The characters "„", "“", and "”" can now be entered with 'C-x 8 v', 'C-x 8 b' and 'C-x 8 n'. The single versions "‚", "‘", and "’" can now @@ -871,7 +763,6 @@ be entered with 'C-x 8 V', 'C-x 8 B' and 'C-x 8 N'. These characters are used for the official German quoting style. Using them requires activating German language support via 'iso-transl-set-language'. ---- *** "latin-prefix" and "latin-postfix" quotation marks additions. These input methods can now produce single, double and "low" left and right quotation marks: @@ -881,20 +772,17 @@ right quotation marks: by using "[", "]", and "," for "left", "right", and "low" respectively to modify "'" and """. ---- *** "latin-prefix" and "latin-postfix" guillemets support. These input methods can now produce single guillemets "‹" and "›". For "latin-prefix" use "~~<" and "~~>", for "latin-postfix" use "<~" and ">~". Double guillemets ("«" and "»") were already supported. ---- *** New French language 'C-x 8' key translations for "‹" and "›". These characters can now be entered using 'C-x 8 ~ <' and 'C-x 8 ~ >', respectively, after activating French language support via 'iso-transl-set-language'. Double guillemets were already supported via 'C-x 8 <' and 'C-x 8 >' ---- *** Additional 'C-x 8' key translation for Euro "€" currency symbol. This can now be entered using 'C-x 8 E' in addition to the existing 'C-x 8 * E' translation. @@ -904,44 +792,37 @@ This can now be entered using 'C-x 8 E' in addition to the existing ** Outline mode -+++ *** New commands to show/hide outlines by regexp. 'C-c / h' ('outline-hide-by-heading-regexp') asks for a regexp and then hides the body lines of all outlines whose heading lines match the regexp. 'C-c / s' ('outline-show-by-heading-regexp') does the inverse: it shows the bodies of outlines that matched a regexp. -+++ *** 'outline-minor-mode' is supported in tree-sitter major modes. It can be used in all tree-sitter major modes that set either the variable 'treesit-simple-imenu-settings' or 'treesit-outline-predicate'. ** Info ---- *** New user option 'Info-url-alist'. This user option associates manual names with URLs. It affects the 'Info-goto-node-web' command. By default, associations for all Emacs-included manuals are set. Further associations can be added for arbitrary Info manuals. ---- *** Emacs can now display Info manuals compressed with 'lzip'. This requires the 'lzip' program to be installed on your system. ** GUD (Grand Unified Debugger) -+++ *** New user option 'gud-highlight-current-line'. When enabled, GUD will visually emphasize the line being executed upon pauses in the debuggee's execution, such as those occasioned by breakpoints being hit. -+++ *** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. ---- *** Variable order and truncation can now be configured in 'gdb-many-windows'. The new user option 'gdb-locals-table-row-config' allows users to configure the order and max length of various properties in the local @@ -957,7 +838,6 @@ If you want to get back the old behavior, set the user option to the value (setopt gdb-locals-table-row-config `((type . 0) (name . 0) (value . ,gdb-locals-value-limit))) -+++ *** New user option 'gdb-display-io-buffer'. If this is nil, command 'gdb' will neither create nor display a separate buffer for the I/O of the program being debugged, but will instead @@ -966,7 +846,6 @@ default is t, to preserve previous behavior. ** Grep -+++ *** New user option 'grep-use-headings'. When non-nil, the output of Grep is split into sections, one for each file, instead of having file names prefixed to each line. It is @@ -976,13 +855,11 @@ The default is nil. ** Compilation mode ---- *** The 'omake' matching rule is now disabled by default. This is because it partly acts by modifying other rules which may occasionally be surprising. It can be re-enabled by adding 'omake' to 'compilation-error-regexp-alist'. ---- *** Lua errors and stack traces are now recognized. Compilation mode now recognizes Lua language errors and stack traces. Every Lua error is recognized as a compilation error, and every Lua @@ -990,24 +867,20 @@ stack frame is recognized as a compilation info. ** Project -+++ *** New user option 'project-mode-line'. When non-nil, display the name of the current project on the mode line. Clicking 'mouse-1' on the project name pops up the project menu. The default value is nil. ---- *** New user option 'project-file-history-behavior'. Customizing it to 'relativize' makes commands like 'project-find-file' and 'project-find-dir' display previous history entries relative to the current project. ---- *** New user option 'project-key-prompt-style'. The look of the key prompt in the project switcher has been changed slightly. To get the previous one, set this option to 'brackets'. ---- *** Function 'project-try-vc' tries harder to find the responsible VCS. When 'project-vc-extra-root-markers' is non-nil, and causes a subdirectory project to be detected which is not a VCS root, Project now @@ -1015,7 +888,6 @@ additionally traverses the parent directories until a VCS root is found (if any), so that the ignore rules for that repository are used, and the file listing's performance is still optimized. -+++ *** New commands 'project-any-command' and 'project-prefix-or-any-command'. The former is now bound to 'C-x p o' by default. The latter is designed primarily for use as a value of @@ -1026,7 +898,6 @@ you can add this to your init script: (setopt project-switch-commands #'project-prefix-or-any-command) ---- *** New variable 'project-files-relative-names'. If it is non-nil, 'project-files' can return file names relative to the project root. Project backends can use this to improve the performance @@ -1034,26 +905,21 @@ of their 'project-files' implementation. ** VC ---- *** Log-Edit buffers now display a tool bar. This tool bar contains items for committing log entries and editing or generating log entries, among other editing operations. ---- *** New user option 'vc-git-shortlog-switches'. This is a string or a list of strings that specifies the Git log switches for shortlogs, such as the one produced by 'C-x v L'. 'vc-git-log-switches' is no longer used for shortlogs. ---- *** New value 'no-backend' for user option 'vc-display-status'. With this value only the revision number is displayed on the mode-line. ---- *** Obsolete command 'vc-switch-backend' re-added as 'vc-change-backend'. The command was previously obsoleted and unbound in Emacs 28. ---- *** Support for viewing VC change history across renames. When a fileset's VC change history ends at a rename, 'C-x v l' now prints the old name(s) and shows a button which jumps to the history of @@ -1064,17 +930,14 @@ Unlike when the '--follow' switch is used, commands to see the diff of the old revision ('d'), to check out an old file version ('f') or to annotate it ('a'), also work on revisions which precede renames. ---- *** 'vc-annotate' now abbreviates the Git revision in the buffer name. When using the Git backend, 'vc-annotate' will use an abbreviated revision identifier in its buffer name. To restore the previous behavior, set user option 'vc-annotate-use-short-revision' to nil. ---- *** New user option 'vc-git-file-name-changes-switches'. It allows tweaking the thresholds for rename and copy detection. ---- *** VC Directory buffers now display the upstream branch in Git repositories. The "upstream branch" is the branch from which 'vc-pull' fetches changes by default. In Git terms, the upstream branch of branch B is determined @@ -1086,7 +949,6 @@ the "Tracking" header. ** Diff mode ---- *** New user option 'diff-refine-nonmodified'. When this is non-nil, 'diff-refine-hunk' will highlight lines that were added or removed in their entirety (as opposed to modified lines, where @@ -1094,26 +956,22 @@ some parts of the line were modified), using the same faces as for highlighting the words added and removed within modified lines. The default value is nil. -+++ *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. When called with a non-nil prefix argument, 'diff-ignore-whitespace-hunk' now iterates over all the hunks in the current diff, regenerating them without whitespace changes. -+++ *** New user option 'diff-ignore-whitespace-switches'. This allows changing which type of whitespace changes are ignored when regenerating hunks with 'diff-ignore-whitespace-hunk'. Defaults to the previously hard-coded "-b". -+++ *** New command 'diff-apply-buffer' bound to 'C-c RET a'. It applies the diff in the entire diff buffer and saves all modified file buffers. ** Dired ---- *** New user option 'dired-movement-style'. When non-nil, make 'dired-next-line', 'dired-previous-line', 'dired-next-dirline', 'dired-prev-dirline' skip empty lines. @@ -1121,7 +979,6 @@ It also controls how to move point when encountering a boundary (e.g., if every line is visible, invoking 'dired-next-line' at the last line will move to the first line). The default is nil. ---- *** New user option 'dired-filename-display-length'. It is an integer representing the maximum display length of file names. The middle part of a file name whose length exceeds the restriction is @@ -1129,7 +986,6 @@ hidden and an ellipsis is displayed instead. A value of 'window' means using the right edge of window as the display restriction. The default is nil. ---- *** New user option 'shell-command-guess-functions'. It defines how to populate a list of commands available for 'M-!', 'M-&', '!', '&' and the context menu "Open With" @@ -1138,32 +994,27 @@ based on marked files in Dired. Possible backends are and a universal command such as "open" or "start" that delegates to the OS. -+++ *** New command 'dired-do-open'. This command is bound to 'E' (mnemonics "External"). Also it can be used by clicking "Open" in the context menu; it "opens" the marked or clicked on files according to the OS conventions. For example, on systems supporting XDG, this runs 'xdg-open' on the files. -+++ *** New variable 'dired-guess-shell-alist-optional'. It contains commands for external viewers and players for various media formats, moved to this list from 'dired-guess-shell-alist-default'. ---- *** 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 you to customize different switches for different remote machines. ** Ediff ---- *** New user option 'ediff-floating-control-frame'. If non-nil, try making the control frame be floating rather than tiled. @@ -1173,21 +1024,18 @@ This option is useful to set if you use such a window manager. ** Buffer Selection ---- *** New user option 'bs-default-action-list'. You can now configure how to display the "*buffer-selection*" buffer using this new option. (Or set 'display-buffer-alist' directly.) ** Eshell -+++ *** You can now run Eshell scripts in batch mode. By adding the following interpreter directive to an Eshell script, you can make it executable like other shell scripts: #!/usr/bin/env -S emacs --batch -f eshell-batch-file -+++ *** New builtin Eshell command 'compile'. This command runs another command, sending its output to a compilation buffer when the command would output interactively. This can be useful @@ -1196,14 +1044,12 @@ appropriate, but still allow piping the output elsewhere if desired. For more information, see the "(eshell) Built-ins" node in the Eshell manual. -+++ *** Eshell's 'env' command now supports running commands. Like in many other shells, Eshell's 'env' command now lets you run a command passed as arguments to 'env'. If you pass any initial arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to 'VALUE' before running the command. ---- *** Eshell's 'umask' command now supports setting the mask symbolically. Now, you can pass an argument like "u+w,o-r" to Eshell's 'umask' command, which will give write permission for owners of newly-created @@ -1211,7 +1057,6 @@ files and deny read permission for users who are not members of the file's group. See the Info node "(coreutils) File permissions" for more information on this notation. ---- *** Performance improvements for interactive output in Eshell. Interactive output in Eshell should now be significantly faster, especially for commands that can print large amounts of output @@ -1220,12 +1065,10 @@ for password prompts in the last 256 characters of each block of output. To restore the previous behavior when checking for password prompts, set 'eshell-password-prompt-max-length' to 'most-positive-fixnum'. ---- *** Eshell built-in commands can now display progress. Eshell built-in commands like "cat" and "ls" now update the display periodically while running to show their progress. -+++ *** New special reference type '#'. This special reference type returns a marker at 'POSITION' in 'BUFFER'. You can insert it by typing or using the new interactive @@ -1234,7 +1077,6 @@ references of any type using the new interactive command 'eshell-insert-special-reference'. See the "(eshell) Arguments" node in the Eshell manual for more details. -+++ *** New splice operator for Eshell dollar expansions. Dollar expansions in Eshell now let you splice the elements of the expansion in-place using '$@expr'. This makes it easier to fill lists @@ -1242,21 +1084,18 @@ of arguments into a command, such as when defining aliases. For more information, see the "(eshell) Dollars Expansion" node in the Eshell manual. -+++ *** You can now splice Eshell globs in-place into argument lists. By setting 'eshell-glob-splice-results' to a non-nil value, Eshell will expand glob results in-place as if you had typed each matching file name individually. For more information, see the "(eshell) Globbing" node in the Eshell manual. -+++ *** Eshell now supports negative numbers and ranges for indices. Now, you can retrieve the last element of a list with '$my-list[-1]' or get a sublist of elements 2 through 4 with '$my-list[2..5]'. For more information, see the "(eshell) Dollars Expansion" node in the Eshell manual. -+++ *** Eshell commands can now be explicitly-remote (or local). By prefixing a command name in Eshell with a remote identifier, like "/ssh:user@remote:whoami", you can now run commands on a particular @@ -1265,12 +1104,10 @@ command on your local system no matter your current directory via "/local:whoami". For more information, see the "(eshell) Remote Access" node in the Eshell manual. -+++ *** Eshell's '$UID' and '$GID' variables are now connection-aware. Now, when expanding '$UID' or '$GID' in a remote directory, the value is the user or group ID associated with the remote connection. ---- *** Eshell now uses 'field' properties in its output. In particular, this means that pressing the '' key moves the point to the beginning of your input, not the beginning of the whole @@ -1282,25 +1119,20 @@ this to your configuration: This also means you no longer need to adjust 'eshell-prompt-regexp' when customizing your Eshell prompt. ---- *** You can now properly unload Eshell. Calling '(unload-feature 'eshell)' no longer signals an error, and now correctly unloads Eshell and all of its modules. -+++ *** 'eshell-read-aliases-list' is now an interactive command. After manually editing 'eshell-aliases-file', you can use this command to load the edited aliases. -+++ *** 'rgrep' is now a builtin Eshell command. Running 'rgrep' in Eshell now uses the Emacs grep facility instead of calling external rgrep. -+++ *** If a command exits abnormally, the Eshell prompt now shows its exit code. -+++ *** New user option 'eshell-history-append'. If non-nil, each Eshell session will save history by appending new entries of that session to the history file rather than overwriting @@ -1308,25 +1140,21 @@ the file with the whole history of the session. The default is nil. ** Pcomplete ---- *** New user option 'pcomplete-remote-file-ignore'. When this option is non-nil, remote file names are not completed by Pcomplete. Packages, like 'shell-mode', could set this in order to suppress remote file name completion at all. ---- *** Completion for the 'doas' command has been added. Command completion for 'doas' in Eshell and Shell mode will now work. ** Shell mode -+++ *** New user option 'shell-get-old-input-include-continuation-lines'. When this user option is non-nil, 'shell-get-old-input' ('C-RET') includes multiple shell "\" continuation lines from command output. Default is nil. -+++ *** New user option 'shell-history-file-name'. When this user option is set to t, 'shell-mode' does not read the shell history file. Setting this user option to a string specifies the name @@ -1335,7 +1163,6 @@ environment variable 'HISTFILE'. In a 'shell' buffer, this user option is connection-local. ---- *** Performance improvements for interactive output. Interactive output in Shell mode now scans more selectively for password prompts by only examining the last 256 characters of each block of @@ -1345,7 +1172,6 @@ To restore the old behavior, set 'comint-password-prompt-max-length' to ** Prog mode -+++ *** New command 'prog-fill-reindent-defun'. This command either fills a single paragraph in a defun, such as a docstring, or a comment, or (re)indents the surrounding defun if point @@ -1354,26 +1180,22 @@ is not in a comment or a string. By default, it is bound to 'M-q' in ** Imenu -+++ *** New user option 'imenu-flatten'. It controls whether to flatten the list of sections in an imenu, and how to display the sections in the flattened list. -+++ *** The sort order of Imenu completions can now be customized. You can customize the user option 'completion-category-overrides' and set 'display-sort-function' for the category 'imenu'. ** Which Function mode -+++ *** Which Function mode can now display function names on the header line. The new user option 'which-func-display' allows choosing where the function name is displayed. The default is 'mode' to display in the mode line. 'header' will display in the header line; 'mode-and-header' displays in both the header line and mode line. -+++ *** New user option 'which-func-update-delay'. This replaces the user option 'idle-update-delay', which was previously used to control the delay before 'which-function-mode' updated its @@ -1382,28 +1204,23 @@ Which Function mode, is now obsolete. ** Tramp -+++ *** Tramp methods can be optional. An optional connection method is not enabled by default. The user must enable it explicitly by the 'tramp-enable-method' command. The existing methods "fcp", "krlogin", " ksu" and "nc" are optional now. -+++ *** New optional connection method "androidsu". This provides access to system files with elevated privileges granted by the idiosyncratic 'su' implementations and system utilities customary on Android. -+++ *** New optional connection method "run0". This connection method is similar to "sudo", but it uses the 'systemd' framework internally. -+++ *** New connection methods "dockercp" and "podmancp". These are the external methods counterparts of "docker" and "podman". -+++ *** New optional connection methods for containers. There are new optional connection methods "toolbox", "distrobox", "flatpak", "apptainer" and "nspawn". They allow accessing system @@ -1411,7 +1228,6 @@ containers provided by Toolbox or Distrobox, sandboxes provided by Flatpak, instances managed by Apptainer, or accessing systemd-based light-weight containers.. -+++ *** Connection method "kubernetes" supports now optional container name. The host name for Kubernetes connections can be of kind [CONTAINER.]POD, in order to specify a dedicated container. If there is just the pod @@ -1419,7 +1235,6 @@ name, the first container in the pod is taken. The new user options 'tramp-kubernetes-context' and 'tramp-kubernetes-namespace' allow accessing pods with different context or namespace but the default one. -+++ *** Rename 'tramp-use-ssh-controlmaster-options' to 'tramp-use-connection-share'. The old name still exists as obsolete variable alias. This user option controls now connection sharing for both ssh-based and @@ -1428,39 +1243,33 @@ The latter suppresses also "ControlMaster" settings in the user's "~/.ssh/config" file, or connection share configuration in PuTTY sessions, respectively. -+++ *** New command 'tramp-cleanup-some-buffers'. It kills only a subset of opened remote buffers, subject to the user option 'tramp-cleanup-some-buffers-hook'. -+++ *** New command 'inhibit-remote-files'. This command disables the handling of file names with the special remote file name syntax. It should be applied only when remote files won't be used in this Emacs instance. It provides a slightly improved performance of file name handling in Emacs. -+++ *** New macro 'without-remote-files'. This macro could wrap code which handles local files only. Due to the temporary deactivation of remote files, it results in a slightly improved performance of file name handling in Emacs. -+++ *** New user option 'tramp-completion-multi-hop-methods'. It contains a list of connection methods for which completion should be attempted at the end of a multi-hop chain. This allows completion candidates to include a list of, for example, containers running on a remote docker host. -+++ *** New command 'tramp-revert-buffer-with-sudo'. It reverts the current buffer to visit with "sudo" permissions. The buffer must either visit a file, or it must run 'dired-mode'. Another method but "sudo" can be configured with user option 'tramp-file-name-with-method'. -+++ *** Direct asynchronous processes are indicated by a connection-local variable. If direct asynchronous processes shall be used, set the connection-local variable 'tramp-direct-async-process' to a non-nil value. In previous @@ -1470,14 +1279,12 @@ properties and 'tramp-connection-properties' in general) is now deprecated. See the Tramp manual "(tramp) Improving performance of asynchronous remote processes". ---- *** Direct asynchronous processes use 'tramp-remote-path'. When a direct asynchronous process is invoked, it uses 'tramp-remote-path' for setting the remote 'PATH' environment variable. ** SHR ---- *** New user option 'shr-fill-text'. When 'shr-fill-text' is non-nil (the default), SHR will fill text according to the width of the window. If you customize it to nil, SHR @@ -1487,7 +1294,6 @@ visually wrapped at word boundaries. ** EWW ---- *** New mouse bindings in EWW buffers. Certain form elements that were displayed as buttons, yet could only be activated by keyboard input, are now operable using 'mouse-2'. With @@ -1495,45 +1301,38 @@ activated by keyboard input, are now operable using 'mouse-2'. With other classes of buttons either toggle their values or prompt for user input, as the case may be. ---- *** EWW text input fields and areas are now fields. In consequence, movement commands and OS input method features now recognize and confine their activities to the text input field around point. See also the Info node "(elisp) Fields". -+++ *** 'eww-open-file' can now display the file in a new buffer. By default, the command reuses the "*eww*" buffer, but if called with the new argument NEW-BUFFER non-nil, it will use a new buffer instead. Interactively, invoke 'eww-open-file' with a prefix argument to activate this behavior. ---- *** 'eww' URL or keyword prompt now has tab completion. The interactive minibuffer prompt when invoking 'eww' now has support for tab completion. -+++ *** 'eww' URL and keyword prompt now completes suggested URIs and bookmarks. The interactive minibuffer prompt when invoking 'eww' now provides completions from 'eww-suggest-uris'. 'eww-suggest-uris' now includes bookmark URIs. -+++ *** New command 'eww-copy-alternate-url'. It copies an alternate link on the page currently visited in EWW into the kill ring. Alternate links are optional metadata that HTML pages use for linking to their alternative representations, such as translated versions or associated RSS feeds. It is bound to 'A' by default. -+++ *** 'eww-open-in-new-buffer' supports the prefix argument. When invoked with the prefix argument ('C-u'), 'eww-open-in-new-buffer' will not make the new buffer the current one. This is useful for continuing reading the URL in the current buffer when the new URL is fetched. ---- *** History navigation in EWW now behaves as in other browsers. Previously, when navigating back and forward through page history, EWW would add a duplicate entry to the end of the history list each time. @@ -1546,27 +1345,23 @@ 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 user 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 user 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 -+++ *** New command 'go-ts-mode-docstring'. This command adds a docstring comment to the current defun. If a comment already exists, point is only moved to the comment. It is @@ -1574,12 +1369,10 @@ bound to 'C-c C-d' in 'go-ts-mode'. ** Man mode -+++ *** New user option 'Man-prefer-synchronous-call'. When this is non-nil, run the 'man' command synchronously rather than asynchronously (which is the default behavior). -+++ *** New user option 'Man-support-remote-systems'. This option controls whether the man page is formatted on the remote system when the current buffer's default-directory is remote. You can @@ -1588,12 +1381,10 @@ value of this option for the current invocation of 'man'. ** DocView ---- *** New user option 'doc-view-mpdf-use-svg'. If non-nil, DocView uses SVG images to display PDF documents. The default is non-nil if your system supports display of SVG images. ---- *** New face 'doc-view-svg-face'. This replaces 'doc-view-svg-foreground' and 'doc-view-svg-background'. By default, this face has black foreground on white background and @@ -1603,7 +1394,6 @@ current theme. However, this, or any non-standard values, can result in poor contrast for documents which aren't simply black text on white background. ---- *** DocView buffers now display a new tool bar. This tool bar contains options for searching and navigating within the document, replacing the incompatible items for incremental search and @@ -1611,12 +1401,10 @@ editing within the default tool bar displayed in the past. ** Shortdoc -+++ *** New function 'shortdoc-function-examples'. This function returns examples of use of a given Emacs Lisp function from the available shortdoc information. -+++ *** New function 'shortdoc-help-fns-examples-function'. This function inserts into the current buffer examples of use of a given Emacs Lisp function, which it gleans from the shortdoc @@ -1629,24 +1417,20 @@ following to your init file: ** Package ---- *** New user option 'package-vc-register-as-project'. When non-nil, 'package-vc-install' and 'package-vc-checkout' will automatically register every package they install as a project, that you can quickly select using 'project-switch-project' ('C-x p p'). Default is t. ---- *** New user option 'package-vc-allow-build-commands'. Controls for which packages Emacs runs extra build commands when installing directly from the package VCS repository. ---- *** New command 'package-vc-log-incoming'. This commands displays incoming changes for a VC package without modifying the current checkout. ---- *** New command to start an inferior Emacs loading only specific packages. The new command 'package-isolate' will start a new Emacs process, as a sub-process of Emacs where you invoke the command, in a way that @@ -1657,29 +1441,24 @@ in a clean environment. ** Flymake -+++ *** New user option 'flymake-indicator-type'. This controls which error indicator type Flymake should use in the current buffer. Depending on your preference, this can either use fringes or margins for indicating errors, the default is 'margins'. -+++ *** New user option 'flymake-margin-indicators-string'. It controls, for each error type, the string and its face to display as the margin indicator. -+++ *** New user option 'flymake-autoresize-margins'. If non-nil (the default), Flymake will resize the margins when 'flymake-mode' is turned on or off. Only relevant if 'flymake-indicator-type' is set to 'margins'. -+++ *** New user option 'flymake-margin-indicator-position'. It controls whether to use margins for margin indicators, and which margin (left or right) to use. Default is to use the left margin. -+++ *** New user option 'flymake-show-diagnostics-at-end-of-line'. When non-nil, Flymake shows summarized descriptions of diagnostics at the end of the line. Depending on your preference, this can either be @@ -1689,13 +1468,11 @@ mouse to consult an error message. Default is nil. ** 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. Default is nil. ---- ** 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 @@ -1703,7 +1480,6 @@ which calls 'xref-find-definitions'. If the previous one worked better for you, use 'define-key' in your init script to bind 'js-find-symbol' to that combination again. ---- ** Json mode. 'js-json-mode' does not derive from 'js-mode' any more so as not to confuse tools like Eglot or YASnippet into thinking that those @@ -1711,7 +1487,6 @@ buffers contain Javascript code. ** Python mode ---- *** New user option 'python-indent-block-paren-deeper'. If non-nil, increase the indentation of the lines inside parens in a header of a block when they are indented to the same level as the body @@ -1729,19 +1504,16 @@ instead of: Default is nil. ---- *** New user option 'python-interpreter-args'. This allows the user to specify command line arguments to the non interactive Python interpreter specified by 'python-interpreter'. ---- *** New function 'python-shell-send-block'. It sends the python block delimited by 'python-nav-beginning-of-block' and 'python-nav-end-of-block' to the inferior Python process. ** Inferior Python mode ---- *** Default value of 'python-shell-compilation-regexp-alist' is changed. Support for Python's ExceptionGroup has been added, so in the Python shell, the line indicating the source of an error in the error messages @@ -1749,13 +1521,11 @@ from ExceptionGroup will be recognized as well. ** Eldoc ---- *** 'eldoc' no longer truncates to a single line by default. Previously, the entire docstring was not available to eldoc, which made 'eldoc-echo-area-use-multiline-p' ineffective. The old behavior may be kept by customizing 'eldoc-echo-area-use-multiline-p'. ---- ** Scheme mode. Scheme mode now handles the regular expression literal '#/regexp/' that is available in some Scheme implementations. @@ -1763,23 +1533,19 @@ Also, it should now handle nested sexp-comments. ** Use package -+++ *** New ':vc' keyword. This keyword enables the user to install packages using package-vc.el. -+++ *** New user option 'use-package-vc-prefer-newest'. If non-nil, always install the newest commit of a package when using the ':vc' keyword rather than its stable release. Default is nil. ** Gnus -+++ *** New backend 'nnfeed'. This allows backend developers to easily create new backends for web feeds, as inheriting backends of 'nnfeed'. -+++ *** New backend 'nnatom'. This allow users to add Atom Syndication Format feeds to Gnus as servers. @@ -1789,20 +1555,17 @@ The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set the server variable 'nnweb-type' to 'gmane'. ---- *** New user option 'gnus-mode-line-logo'. This allows the user to either disable the display of any logo or specify which logo will be displayed as part of the buffer-identification in the mode-line of Gnus buffers. ---- *** 'gnus-summary-limit-to-age' now counts days since midnight. "Less than 1 day" now means "since last midnight", rather than "less than 24 hours old". ** Rmail ---- *** New commands for reading mailing lists. The new Rmail commands 'rmail-mailing-list-post', 'rmail-mailing-list-unsubscribe', 'rmail-mailing-list-help', and @@ -1813,7 +1576,6 @@ delivered. ** Dictionary ---- *** New user option 'dictionary-search-interface'. Controls how the 'dictionary-search' command prompts for and displays dictionary definitions. Customize this user option to 'help' to have @@ -1821,13 +1583,11 @@ dictionary definitions. Customize this user option to 'help' to have provide dictionary-based minibuffer completion for word selection. Default is nil, which means to use a "*Dictionary*" buffer. ---- *** New user option 'dictionary-read-word-prompt'. This allows the user to customize the prompt that is used by 'dictionary-search' when asking for a word to search in the dictionaries. ---- *** New user option 'dictionary-display-definition-function'. This allows the user to customize the way in which 'dictionary-search' displays word definitions. If non-nil, this user option should be set @@ -1837,7 +1597,6 @@ dictionary server. The new function the definition in a "*Help*" buffer, instead of the default "*Dictionary*" buffer. ---- *** New user option 'dictionary-read-word-function'. This allows the user to customize the way in which 'dictionary-search' prompts for a word to search in the dictionary. This user option @@ -1846,7 +1605,6 @@ returns it as a string. The new function 'dictionary-completing-read-word' can be used to prompt with completion based on dictionary matches. ---- *** New user option 'dictionary-read-dictionary-function'. This allows the user to customize the way in which 'dictionary-search' prompts for a dictionary to search in. This user option should be set @@ -1855,7 +1613,6 @@ name as a string. The new function 'dictionary-completing-read-dictionary' can be used to prompt with completion based on dictionaries that the server supports. ---- *** The default value of 'dictionary-tooltip-dictionary' has changed. The new default value is t, which means use the same dictionary as the value of 'dictionary-default-dictionary'. The previous default value @@ -1864,52 +1621,43 @@ the mode was turned on. ** Pp -+++ *** New 'pp-default-function' user option replaces 'pp-use-max-width'. Its default value is 'pp-fill', a new default pretty-printing function, which tries to obey 'fill-column'. ---- *** 'pp-to-string' takes an additional PP-FUNCTION argument. This argument specifies the prettifying algorithm to use. ---- *** 'pp' and 'pp-to-string' now always include a terminating newline. In the past they included a terminating newline in most cases but not all. ** Emacs Lisp mode -+++ *** 'elisp-flymake-byte-compile' is disabled for untrusted files. For security reasons, this backend can be used only in those files specified as trusted according to 'trusted-content' and emits an "untrusted content" warning otherwise. This fixes CVE-2024-53920. ---- *** ',@' now has 'prefix' syntax. Previously, the '@' character, which normally has 'symbol' syntax, would combine with a following Lisp symbol and interfere with symbol searching. -+++ *** 'emacs-lisp-docstring-fill-column' now defaults to 72. It was previously 65. The new default formats documentation strings to fit on fewer lines without negatively impacting readability. ** CPerl mode ---- *** Subroutine signatures are now supported. CPerl mode fontifies subroutine signatures like variable declarations which makes them visually distinct from subroutine prototypes. ---- *** Syntax of Perl up to version 5.40 is supported. CPerl mode supports the new keywords for exception handling and the object oriented syntax which were added in Perl 5.36, 5.38 and 5.40. ---- *** New user option 'cperl-fontify-trailer'. This user option takes the values 'perl-code' or 'comment' and treats text after an "__END__" or "__DATA__" token accordingly. The default @@ -1917,32 +1665,27 @@ value of 'perl-code' is useful for trailing POD and for AutoSplit modules, the value 'comment' makes CPerl mode treat trailers as comment, like Perl mode does. ---- *** New command 'cperl-file-style'. This command sets the indentation style for the current buffer. To change the default style, either use the user option with the same name or use the command 'cperl-set-style'. ---- *** New minor mode 'cperl-extra-paired-delimiters-mode'. Perl 5.36 and newer allows using more than 200 non-ASCII paired delimiters for quote-like constructs, e.g. "q«text»". Use this minor mode in buffers where this feature is activated. ---- *** Commands using the Perl Info manual are obsolete. The Perl documentation in Info format is no longer distributed with Perl or on CPAN since more than 10 years. Perl documentation can be read with 'cperl-perldoc' instead. ---- *** Highlighting trailing whitespace has been removed. The user option 'cperl-invalid-face' is now obsolete, and does nothing. See the user option 'show-trailing-whitespace' instead. ** Emacs Sessions (Desktop) -+++ *** Restoring buffers visiting remote files can now time out. When a buffer is restored which visits a remote file, the restoration of the session could hang if the remote host is off-line or slow to @@ -1953,7 +1696,6 @@ desktop restoration to continue. ** Recentf -+++ *** Checking recent remote files can now time out. Similarly to buffer restoration by Desktop, 'recentf-mode' checking of the accessibility of remote files can now time out if @@ -1961,19 +1703,16 @@ of the accessibility of remote files can now time out if ** Image Dired -+++ *** New user option 'image-dired-thumb-naming'. You can now configure how thumbnails are named using this option. ** ERT -+++ *** New macro 'skip-when' to skip 'ert-deftest' tests. This can help to avoid some awkward skip conditions. For example '(skip-unless (not noninteractive))' can be changed to the easier to read '(skip-when noninteractive)'. -+++ *** Syntax highlighting unit testing support. An ERT extension ('ert-font-lock') now provides support for face assignment unit testing. For more information, see the "(ert) Syntax @@ -1981,21 +1720,18 @@ Highlighting Tests" node in the ERT manual. ** Socks -+++ *** Socks supports version 4a. The 'socks-server' user option accepts '4a' as a value for its version field. ** Edmacro -+++ *** New command 'edmacro-set-macro-to-region-lines'. Bound to 'C-c C-r', this command replaces the macro text with the lines of the region. If needed, the region is extended to include whole lines. If the region ends at the beginning of a line, that last line is excluded. -+++ *** New user option 'edmacro-reverse-macro-lines'. When this is non-nil, the lines of key sequences are displayed with the most recent line first. This is can be useful when working with @@ -2003,7 +1739,6 @@ macros with many lines, such as from 'kmacro-edit-lossage'. ** Calc -+++ *** Calc parses fractions written using U+2044 FRACTION SLASH. Fractions of the form "123⁄456" are handled as if written "123:456". Note in particular the difference in behavior from U+2215 DIVISION SLASH @@ -2015,7 +1750,6 @@ was never mentioned in the NEWS, or even the Calc manual.) ** IELM ---- *** IELM now remembers input history between sessions. The new user option 'ielm-history-file-name' is the name of the file where IELM input history will be saved. Customize it to nil to revert @@ -2023,7 +1757,6 @@ to the old behavior of not remembering input history between sessions. ** EasyPG -+++ *** New user option 'epa-keys-select-method'. 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 @@ -2031,61 +1764,52 @@ buffer method is the default, which preserves previous behavior. ** Widget -+++ *** New face 'widget-unselected'. Customize this face to a non-default value to visually distinguish the labels of unselected active radio-button or checkbox widgets from the labels of unselected inactive widgets (the default value inherits from the 'widget-inactive' face). -+++ *** New user option 'widget-skip-inactive'. If non-nil, moving point forward or backward between widgets by typing 'TAB' or 'S-TAB' skips over inactive widgets. The default value is nil. ** Ruby mode ---- *** New user option 'ruby-rubocop-use-bundler'. By default it retains the previous behavior: read the contents of Gemfile and act accordingly. But you can also set it to t or nil to skip checking the Gemfile. ---- *** New user option 'ruby-bracketed-args-indent'. When it is set to nil, multiple consecutive open braces/brackets/parens result in only one additional indentation level. Default is t. ** Thingatpt ---- *** New variables for providing custom thingatpt implementations. The new variables 'bounds-of-thing-at-point-provider-alist' and 'forward-thing-provider-alist' now allow defining custom implementations of 'bounds-of-thing-at-point' and 'forward-thing', respectively. ---- *** New helper functions for text property-based thingatpt providers. The new helper functions 'thing-at-point-for-char-property', 'bounds-of-thing-at-point-for-char-property', and 'forward-thing-for-char-property' can help to implement custom thingatpt providers for "things" that are defined by text properties. ---- *** 'bug-reference-mode' now supports 'thing-at-point'. Now, calling '(thing-at-point 'url)' when point is on a bug reference will return the URL for that bug. ** Buffer-menu ---- *** New user option 'Buffer-menu-group-by'. It controls how buffers are divided into groups that are displayed with headings using Outline minor mode. Using commands that mark buffers on the outline heading line will mark all buffers in the outline. By default, no grouping is performed. -+++ *** New command 'Buffer-menu-toggle-internal'. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. @@ -2094,22 +1818,18 @@ in Buffer Menu mode. ** Miscellaneous -+++ *** New user option 'rcirc-log-time-format'. This allows for rcirc logs to use a custom timestamp format, which the chat buffers use by default. ---- *** 'ffap-lax-url' now defaults to nil. Previously, it was set to t, but this broke remote file name detection. ---- *** More control on automatic update of Proced buffers. The user option 'proced-auto-update-flag' can now be set to an additional value 'visible', which controls automatic updates of Proced buffers that are displayed in some window. ---- *** nXML Mode now comes with schemas for Mono/.NET development. The following new XML schemas are now supported: - MSBuild project files @@ -2120,48 +1840,39 @@ The following new XML schemas are now supported: - Nuget package specification file - Nuget packages config file ---- *** color.el now supports the Oklab color representation. -+++ *** New user option 'xwidget-webkit-disable-javascript'. This allows disabling JavaScript in xwidget Webkit sessions. ---- *** 'ls-lisp--insert-directory' supports more long options of 'ls'. 'ls-lisp--insert-directory', the ls-lisp implementation of 'insert-directory', now supports the '--time=TIME' and '--sort=time' options of GNU 'ls'. ---- *** 'M-x ping' can now give additional flags to the 'ping' program. Typing 'C-u M-x ping' prompts first for the host, and then for the flags to give to the 'ping' command. ---- *** Webjump now assumes URIs are HTTPS instead of HTTP. For links in 'webjump-sites' without an explicit URI scheme, it was previously assumed that they should be prefixed with "http://". Such URIs are now prefixed with "https://" instead. ---- *** Added prefixes in titdic-cnv library. Most of the variables and functions in the file have been renamed to make sure they all use a 'tit-' namespace prefix. ---- *** 'xref-revert-buffer' is now an alias of 'revert-buffer'. The Xref buffer now sets up 'revert-buffer-function' such that 'revert-buffer' behaves like 'xref-revert-buffer' did in previous Emacs versions, and the latter is now an alias of the former. ---- *** The Makefile browser is now obsolete. The command 'makefile-switch-to-browser' command is now obsolete, together with related commands used in the "*Macros and Targets*" buffer. We recommend using an alternative like 'imenu' instead. ---- *** 'jsonrpc-default-request-timeout' is now a defcustom. @@ -2169,28 +1880,22 @@ buffer. We recommend using an alternative like 'imenu' instead. ** New major modes based on the tree-sitter library -+++ *** New major mode 'elixir-ts-mode'. A major mode based on the tree-sitter library for editing Elixir files. -+++ *** New major mode 'heex-ts-mode'. A major mode based on the tree-sitter library for editing HEEx files. -+++ *** New major mode 'html-ts-mode'. An optional major mode based on the tree-sitter library for editing HTML files. -+++ *** New major mode 'lua-ts-mode'. A major mode based on the tree-sitter library for editing Lua files. -+++ *** New major mode 'php-ts-mode'. A major mode based on the tree-sitter library for editing PHP files. -+++ ** New package EditorConfig. This package provides support for the EditorConfig standard, an editor-neutral way to provide directory local (project-wide) settings. @@ -2199,13 +1904,11 @@ which makes Emacs obey the '.editorconfig' files. There is also a new major mode 'editorconfig-conf-mode' to edit those configuration files. -+++ ** New global minor mode 'etags-regen-mode'. This minor mode generates the tags table automatically based on the current project configuration, and later updates it as you edit the files and save the changes. -+++ ** New package 'which-key'. The 'which-key' package from GNU ELPA is now included in Emacs. It implements the global minor mode 'which-key-mode' that displays a table @@ -2214,7 +1917,6 @@ moment. For example, after enabling the minor mode, if you enter 'C-x' and wait for one second, the minibuffer will expand with all available key bindings that follow 'C-x' (or as many as space allows). -+++ ** New minor mode 'completion-preview-mode'. This minor mode shows you symbol completion suggestions as you type, using an inline preview. New user options in the 'completion-preview' @@ -2222,7 +1924,6 @@ customization group control exactly when Emacs displays this preview. 'completion-preview-mode' is buffer-local, to enable it globally use 'global-completion-preview-mode'. -+++ ** New package Window-Tool-Bar. This provides a new minor mode, 'window-tool-bar-mode'. When this minor mode is enabled, a tool bar is displayed at the top of a window. To @@ -2230,7 +1931,6 @@ conserve space, no tool bar is shown if 'tool-bar-map' is nil. The global minor mode 'global-window-tool-bar-mode' enables this minor mode in all buffers. -+++ ** New library Track-Changes. This library is a layer of abstraction above 'before-change-functions' and 'after-change-functions' which provides a superset of @@ -2242,7 +1942,6 @@ the functionality of 'after-change-functions': reported (calls to 'before/after-change-functions' that are incorrectly paired, missing, etc...) and reports them adequately. -+++ ** New global minor mode 'minibuffer-regexp-mode'. This is a minor mode for editing regular expressions in the minibuffer, for example in 'query-replace-regexp'. It correctly highlights parens @@ -2251,7 +1950,6 @@ avoids reporting alleged paren mismatches and makes sexp navigation more intuitive. It is enabled by default, 'minibuffer-regexp-prompts' can be used to tune when it takes effect. ---- ** The highly accessible Modus themes collection has eight items. The 'modus-operandi' and 'modus-vivendi' are the main themes that have been part of Emacs since version 28. The former is light, the latter @@ -2263,7 +1961,6 @@ the needs of users with red-green or blue-yellow color deficiency. The Info manual "(modus-themes) Top" describes the details and showcases all their user options. -+++ ** New library PEG. Emacs now includes a library for writing Parsing Expression Grammars (PEG), an approach to text parsing that provides more structure @@ -2271,14 +1968,12 @@ than regular expressions, but less complexity than context-free grammars. The Info manual "(elisp) Parsing Expression Grammars" has documentation and examples. ---- ** New major mode 'shell-command-mode'. This mode is used by default for the output of asynchronous 'shell-command'. To revert to the previous behavior, set the (also new) variable 'async-shell-command-mode' to 'shell-mode'. Any hooks or mode-specific variables used should be adapted appropriately. -+++ ** New package Compat. Emacs now comes with a stub implementation of the forwards-compatibility Compat package from GNU ELPA. This allows @@ -2288,7 +1983,6 @@ preventing the installation of Compat if unnecessary. * Incompatible Lisp Changes in Emacs 30.1 -+++ ** Evaluating a 'lambda' returns an object of type 'interpreted-function'. Instead of representing interpreted functions as lists that start with either 'lambda' or 'closure', Emacs now represents them as objects @@ -2305,17 +1999,14 @@ no longer work and will need to use 'aref' instead to extract its various subparts (when 'interactive-form', 'documentation', and 'help-function-arglist' aren't adequate). ---- ** The escape sequence '\x' not followed by hex digits is now an error. Previously, '\x' without at least one hex digit denoted character code zero (NUL) but as this was neither intended nor documented or even known by anyone, it is now treated as an error by the Lisp reader. ---- ** 'subr-native-elisp-p' is renamed to 'native-comp-function-p'. The previous name still exists but is marked as obsolete. -+++ ** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'. Minor modes defined with 'define-globalized-minor-mode', such as 'global-font-lock-mode', will not be enabled any more in those buffers @@ -2323,7 +2014,6 @@ whose major modes fail to use 'run-mode-hooks'. Major modes defined with 'define-derived-mode' are not affected. 'run-mode-hooks' has been the recommended way to run major mode hooks since Emacs 22. -+++ ** 'buffer-match-p' and 'match-buffers' take '&rest ARGS'. They used to take a single '&optional ARG' and were documented to use an unreliable hack to try and support condition predicates that @@ -2331,18 +2021,14 @@ don't accept this optional ARG. The new semantics makes no such accommodation, but the code still supports it (with a warning) for backward compatibility. ---- ** 'post-gc-hook' runs after updating 'gcs-done' and 'gc-elapsed'. ---- ** Connection-local variables are applied in buffers visiting remote files. This overrides possible directory-local or file-local variables with the same name. -+++ ** 'copy-tree' now copies records when its optional 2nd argument is non-nil. -+++ ** Regexp zero-width assertions followed by operators are better defined. Previously, regexps such as "xy\\B*" would have ill-defined behavior. Now any operator following a zero-width assertion applies to that @@ -2350,7 +2036,6 @@ assertion only (which is useless). For historical compatibility, an operator character following '^' or '\`' becomes literal, but we advise against relying on this. -+++ ** Infinities and NaNs no longer act as symbols on non-IEEE platforms. On old platforms like the VAX that do not support IEEE floating-point, tokens like '0.0e+NaN' and '1.0e+INF' are no longer read as symbols. @@ -2358,7 +2043,6 @@ Instead, the Lisp reader approximates an infinity with the nearest finite value, and a NaN with some other non-numeric object that provokes an error if used numerically. -+++ ** Conversion of strings to and from byte-arrays works with multibyte strings. The functions 'dbus-string-to-byte-array' and 'dbus-byte-array-to-string' now accept and return multibyte Lisp @@ -2369,60 +2053,48 @@ UTF-8 byte sequence, and the optional parameter MULTIBYTE of 'dbus-string-to-byte-array' should be a regular Lisp string, not a unibyte string. -+++ ** 'minibuffer-allow-text-properties' now can be set buffer-local. 'read-from-minibuffer' and functions that use it can take the buffer-local value from the minibuffer. -+++ ** 'minibuffer-allow-text-properties' now also affects completions. When it has a non-nil value, then completion functions like 'completing-read' don't discard text properties from the returned completion candidate. -+++ ** X color support compatibility aliases are now obsolete. The compatibility aliases 'x-defined-colors', 'x-color-defined-p', 'x-color-values', and 'x-display-color-p' are now obsolete. -+++ ** 'easy-mmode-define-{minor,global}-mode' aliases are now obsolete. Use 'define-minor-mode' and 'define-globalized-minor-mode' instead. -+++ ** The 'millisec' argument of 'sleep-for' is now obsolete. Use a float value for the first argument instead. ---- ** User options 'eshell-NAME-unload-hook' are now obsolete. These hooks were named incorrectly, and so they never actually ran when unloading the corresponding feature. Instead, you should use hooks named after the feature name, like 'esh-mode-unload-hook'. ---- ** User options 'eshell-process-wait-{seconds,milliseconds}' are now obsolete. Instead, use 'eshell-process-wait-time', which supports floating-point values. ---- ** User option 'tramp-completion-reread-directory-timeout' has been removed. This user option was obsoleted in Emacs 27, use 'remote-file-name-inhibit-cache' instead. -+++ ** The obsolete calling convention of 'sit-for' has been removed. That convention was: '(sit-for SECONDS MILLISEC &optional NODISP)'. ---- ** 'defadvice' is marked as obsolete. See the "(elisp) Porting Old Advice" Info node for help converting them to use 'advice-add' or 'define-advice' instead. ---- ** 'cl-old-struct-compat-mode' is marked as obsolete. You may need to recompile your code if it was compiled with Emacs < 24.3. ---- ** Old derived.el functions removed. The following functions have been deleted because they were only used by code compiled with Emacs < 21: @@ -2435,40 +2107,33 @@ by code compiled with Emacs < 21: * Lisp Changes in Emacs 30.1 -+++ ** The 'wheel-up/down/left/right' events are now bound unconditionally. The 'mouse-wheel-up/down/left/right-event' variables are thus used only to specify the 'mouse-4/5/6/7' events that might still happen to be generated by some old packages (or if 'mouse-wheel-buttons' has been set to nil). ---- ** Xterm Mouse mode now emits 'wheel-up/down/right/left' events. This is instead of 'mouse-4/5/6/7' events for the mouse wheel. It uses the new variable 'mouse-wheel-buttons' to decide which button maps to which wheel event (if any). ---- ** In batch mode, tracing now sends the trace to stdout. -+++ ** New hook 'hack-dir-local-get-variables-functions'. This can be used to provide support for other directory-local settings beside ".dir-locals.el". -+++ ** 'auto-coding-functions' can know the name of the file. The functions on this hook can now find the name of the file to which the text belongs by consulting the variable 'auto-coding-file-name'. -+++ ** New user option 'compilation-safety' to control safety of native code. It is now possible to control how safe is the code generated by native compilation, by customizing this user option. It is also possible to control this at function granularity by using the new 'safety' parameter in the function's 'declare' form. -+++ ** New types 'closure' and 'interpreted-function'. 'interpreted-function' is the new type used for interpreted functions, and 'closure' is the common parent type of 'interpreted-function' @@ -2478,91 +2143,75 @@ Those new types come with the associated new predicates 'closurep' and 'interpreted-function-p' as well as a new constructor 'make-interpreted-closure'. ---- ** 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 'char-to-name'. This is a convenience function to return the Unicode name of a char (if it has one). -+++ ** 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 functions 'primitive-function-p' and 'cl-functionp'. 'primitive-function-p' is like 'subr-primitive-p' except that it returns t only if the argument is a function rather than a special-form, and 'cl-functionp' is like 'functionp' except it returns nil for lists and symbols. ---- ** Built-in types now have 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 things like 'C-h o integer RET' will show some information about that type. ---- ** New variable 'major-mode-remap-defaults' and function 'major-mode-remap'. The first is like Emacs-29's 'major-mode-remap-alist' but to be set by packages (instead of users). The second looks up those two variables. -+++ ** Pcase's functions (in 'pred' and 'app') can specify the argument position. For example, instead of '(pred (< 5))' you can write '(pred (> _ 5))'. -+++ ** 'define-advice' now sets the new advice's 'name' property to NAME. Named advices defined with 'define-advice' can now be removed with '(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL SYMBOL@NAME)'. -+++ ** New function 'require-with-check' to detect new versions shadowing. This is like 'require', but it checks whether the argument 'feature' is already loaded, in which case it either signals an error or forcibly reloads the file that defines the feature. -+++ ** New variable 'lisp-eval-depth-reserve'. It puts a limit to the amount by which Emacs can temporarily increase 'max-lisp-eval-depth' when handling signals. -+++ ** New special form 'handler-bind'. It provides a functionality similar to 'condition-case' except it runs the handler code without unwinding the stack, such that we can record the backtrace and other dynamic state at the point of the error. See the Info node "(elisp) Handling Errors". -+++ ** New text properties add tooltips on fringes. It is now possible to provide tooltips on fringes by adding special text properties 'left-fringe-help' and 'right-fringe-help'. See the "(elisp) Special Properties" Info node in the Emacs Lisp Reference Manual for more details. -+++ ** New 'display-buffer' action alist entry 'pop-up-frames'. This has the same effect as the variable of the same name and takes precedence over the variable when present. ---- ** New function 'merge-ordered-lists'. Mostly used internally to do a kind of topological sort of inheritance hierarchies. -+++ ** 'drop' is now an alias for the function 'nthcdr'. -+++ ** New polymorphic comparison function 'value<'. This function returns non-nil if the first argument is less than the second. It works for any two values of the same type with reasonable @@ -2572,7 +2221,6 @@ lexicographically. It is intended as a convenient ordering predicate for sorting, and is likely to be faster than hand-written Lisp functions. -+++ ** New 'sort' arguments and features. The 'sort' function can now be called using the signature @@ -2599,13 +2247,11 @@ its input in-place as before. ** New API for 'derived-mode-p' and control of the graph of major modes -+++ *** 'derived-mode-p' now takes the list of modes as a single argument. The same holds for 'provided-mode-derived-p'. The old calling convention where multiple modes are passed as separate arguments is deprecated. -+++ *** New functions to access the graph of major modes. While 'define-derived-mode' still only supports single inheritance, modes can declare additional parents (for tests like 'derived-mode-p') @@ -2614,7 +2260,6 @@ Accessing the 'derived-mode-parent' property directly is now deprecated in favor of the new functions 'derived-mode-set-parent' and 'derived-mode-all-parents'. -+++ ** Drag-and-drop functions can now be called once for compound drops. It is now possible for drag-and-drop handler functions to respond to drops incorporating more than one URL. Functions capable of this must @@ -2624,7 +2269,6 @@ See the Info node "(elisp) Drag and Drop". The function 'dnd-handle-one-url' has been made obsolete, since it cannot take these new handlers into account. -+++ ** 'notifications-notify' can use Icon Naming Specification for ':app-icon'. You can use a symbol as the value for ':app-icon' to provide icon name without specifying a file, like this: @@ -2632,54 +2276,45 @@ without specifying a file, like this: (notifications-notify :title "I am playing music" :app-icon 'multimedia-player) ---- ** New function 're-disassemble' to see the innards of a regexp. If you built Emacs with '--enable-checking', you can use this to help debug either your regexp performance problems or the regexp engine. -+++ ** XLFDs are no longer restricted to 255 characters. 'font-xlfd-name' now returns an XLFD even if it is greater than 255 characters in length, provided that the LONG_XLFDs argument is true. Other features in Emacs which employ XLFDs have been modified to produce and understand XLFDs larger than 255 characters. -+++ ** New macro 'static-if' for conditional evaluation of code. This macro hides a form from the evaluator or byte-compiler based on a compile-time condition. This is handy for avoiding byte-compilation warnings about code that will never actually run under some conditions. -+++ ** Desktop notifications are now supported on the Haiku operating system. The new function 'haiku-notifications-notify' provides a subset of the capabilities of the 'notifications-notify' function in a manner analogous to 'w32-notification-notify'. ---- ** New Haiku specific variable 'haiku-pass-control-tab-to-system'. This sets whether Emacs should pass 'C-TAB' on to the system instead of handling it, fixing a problem where window switching would not activate if an Emacs frame had focus on the Haiku operating system. Default value is t. -+++ ** New value 'if-regular' for the REPLACE argument to 'insert-file-contents'. It results in 'insert-file-contents' erasing the buffer instead of preserving markers if the file being inserted is not a regular file, rather than signaling an error. -+++ ** New variable 'current-key-remap-sequence'. It is bound to the key sequence that caused a call to a function bound within 'function-key-map' or 'input-decode-map' around those calls. -+++ ** The function 'key-translate' can now remove translations. If the second argument TO is nil, the existing key translation is removed. -+++ ** New variables describing the names of built in programs. The new variables 'ctags-program-name', 'ebrowse-program-name', 'etags-program-name', 'hexl-program-name', 'emacsclient-program-name' @@ -2687,7 +2322,6 @@ The new variables 'ctags-program-name', 'ebrowse-program-name', instead of "ctags", "ebrowse", "etags", "hexl", "emacsclient", and "rcs2log", when starting one of these built in programs in a subprocess. -+++ ** New variable 'case-symbols-as-words' affects case operations for symbols. If non-nil, then case operations such as 'upcase-initials' or 'replace-match' (with nil FIXEDCASE) will treat the entire symbol name @@ -2695,7 +2329,6 @@ as a single word. This is useful for programming languages and styles where only the first letter of a symbol's name is ever capitalized. The default value of this variable is nil. ---- ** Bytecode is now always loaded eagerly. Bytecode compiled with older Emacs versions for lazy loading using 'byte-compile-dynamic' is now loaded all at once. @@ -2703,7 +2336,6 @@ As a consequence, 'fetch-bytecode' has no use, does nothing, and is now obsolete. The variable 'byte-compile-dynamic' has no effect any more; compilation will always yield bytecode for eager loading. -+++ ** Returned strings from functions and macros are never docstrings. Functions and macros whose bodies consist of a single string literal now only return that string, and will not use it as a docstring. Example: @@ -2721,7 +2353,6 @@ forms; other defining forms such as 'cl-defun' already worked this way. ** New or changed byte-compilation warnings ---- *** Warn about missing 'lexical-binding' directive. The compiler now warns if an Elisp file lacks the standard '-*- lexical-binding: ... -*-' cookie on the first line. @@ -2745,7 +2376,6 @@ the line first in the file to declare that it uses the old dialect. ---- *** Warn about empty bodies for more special forms and macros. The compiler now warns about an empty body argument to 'when', 'unless', 'ignore-error' and 'with-suppressed-warnings' in addition to @@ -2756,7 +2386,6 @@ the existing warnings for 'let' and 'let*'. Example: This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'empty-body'. ---- *** Warn about quoted error names in 'condition-case' and 'ignore-error'. The compiler now warns about quoted condition (error) names in 'condition-case' and 'ignore-error'. Example: @@ -2768,7 +2397,6 @@ in 'condition-case' and 'ignore-error'. Example: Quoting them adds the error name 'quote' to those handled or ignored respectively, which was probably not intended. ---- *** Warn about comparison with literal constants without defined identity. The compiler now warns about comparisons by identity with a literal string, cons, vector, record, function, large integer or float as this @@ -2789,7 +2417,6 @@ compared reliably at all. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. ---- *** Warn about 'condition-case' without handlers. The compiler now warns when the 'condition-case' form is used without any actual handlers, as in @@ -2804,7 +2431,6 @@ was to catch all errors, add an explicit handler for 'error', or use This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. ---- *** Warn about 'unwind-protect' without unwind forms. The compiler now warns when the 'unwind-protect' form is used without any unwind forms, as in @@ -2819,7 +2445,6 @@ simplified away. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. ---- *** Warn about useless trailing 'cond' clauses. The compiler now warns when a 'cond' form contains clauses following a default (unconditional) clause. Example: @@ -2834,7 +2459,6 @@ perhaps due to misplaced parens. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. ---- *** Warn about mutation of constant values. The compiler now warns about code that modifies program constants in some obvious cases. Examples: @@ -2854,7 +2478,6 @@ instead. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'mutate-constant'. ---- *** Warn about more ignored function return values. The compiler now warns when the return value from certain functions is implicitly ignored. Example: @@ -2872,7 +2495,6 @@ name 'ignored-return-value'. The warning will only be issued for calls to functions declared 'important-return-value' or 'side-effect-free' (but not 'error-free'). ---- *** Warn about docstrings that contain control characters. The compiler now warns about docstrings with control characters other than newline and tab. This is often a result of improper escaping. @@ -2887,11 +2509,9 @@ where the docstring contains the four control characters 'CR', 'DEL', The warning name is 'docstrings-control-chars'. ---- *** The warning about wide docstrings can now be disabled separately. Its warning name is 'docstrings-wide'. -+++ ** 'fset', 'defalias' and 'defvaralias' now signal an error for cyclic aliases. Previously, 'fset', 'defalias' and 'defvaralias' could be made to build circular function and variable indirection chains as in @@ -2908,25 +2528,20 @@ Their 'noerror' arguments have no effect and are therefore obsolete. ** Touch Screen support -+++ *** 'x-popup-menu' now understands touch screen events. When a 'touchscreen-begin' or 'touchscreen-end' event is passed as the POSITION argument, it will behave as if that event was a mouse event. -+++ *** New functions for handling touch screen events. The new functions 'touch-screen-track-tap' and 'touch-screen-track-drag' handle tracking common touch screen gestures from within a command. -+++ *** New parameter to 'touchscreen-end' events. CANCEL non-nil establishes that the touch sequence has been intercepted by programs such as window managers and should be ignored with Emacs. ---- ** New variable 'inhibit-auto-fill' to temporarily prevent auto-fill. -+++ ** New variable 'secondary-tool-bar-map'. If non-nil, this variable contains a keymap of menu items that are displayed along tool bar items defined by 'tool-bar-map'. These items @@ -2934,7 +2549,6 @@ are displayed below the tool bar if the value of 'tool-bar-position' is 'top', and above it if the value is 'bottom'. This is used by 'modifier-bar-mode'. ---- ** New variable 'completion-lazy-hilit'. Lisp programs that present completion candidates may bind this variable non-nil around calls to functions such as @@ -2943,12 +2557,10 @@ 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 @@ -2956,34 +2568,28 @@ case.) ** Functions and variables to transpose sexps ---- *** New helper variable 'transpose-sexps-function'. Lisp programs can now set this variable to customize the behavior of the 'transpose-sexps' command. ---- *** New function 'transpose-sexps-default-function'. The previous implementation of 'transpose-sexps' was moved into its own function, to be used in 'transpose-sexps-function'. ---- *** New function 'treesit-transpose-sexps'. Tree-sitter now unconditionally sets 'transpose-sexps-function' for all tree-sitter enabled modes to this function. ** Functions and variables to move by program statements -+++ *** New variable 'forward-sentence-function'. Major modes can now set this variable to customize the behavior of the 'forward-sentence' command. ---- *** New function 'forward-sentence-default-function'. The previous implementation of 'forward-sentence' is moved into its own function, to be bound by 'forward-sentence-function'. -+++ *** New function 'treesit-forward-sentence'. All tree-sitter enabled modes that define 'sentence' in 'treesit-thing-settings' now set 'forward-sentence-function' to call @@ -2991,13 +2597,11 @@ All tree-sitter enabled modes that define 'sentence' in ** Functions and variables to move by program sexps -+++ *** New function 'treesit-forward-sexp'. Tree-sitter conditionally sets 'forward-sexp-function' for major modes that have defined 'sexp' in 'treesit-thing-settings' to enable sexp-related motion commands. ---- ** New user option 'native-comp-async-warnings-errors-kind'. It allows control of what kinds of warnings and errors from asynchronous native compilation are reported to the parent Emacs process. The @@ -3008,7 +2612,6 @@ and see if you get only warnings that matter. ** Function 'declare' forms -+++ *** New 'ftype' function declaration. The declaration '(ftype TYPE)' specifies the type of a function. Example: @@ -3024,24 +2627,20 @@ native compiler to produce better code, but specifying an incorrect type may lead to Emacs crashing. See the Info node "(elisp) Declare Form" for further information. -+++ *** New 'important-return-value' function declaration and property. The declaration '(important-return-value t)' sets the 'important-return-value' property which indicates that the function return value should probably not be thrown away implicitly. -+++ ** New functions 'file-user-uid' and 'file-group-gid'. These functions are like 'user-uid' and 'group-gid', respectively, but are aware of file name handlers, so they will return the remote UID or GID for remote files (or -1 if the connection has no associated user). -+++ ** 'treesit-font-lock-rules' now accepts additional global keywords. When supplied with ':default-language LANGUAGE', rules after it will default to use 'LANGUAGE'. ---- ** New optional argument to 'modify-dir-local-variable'. An optional 5th argument FILE has been added to 'modify-dir-local-variable'. It can be used to specify which file to @@ -3049,7 +2648,6 @@ modify instead of the default ".dir-locals.el". ** Connection local variables -+++ *** New macros 'connection-local-p' and 'connection-local-value'. The former macro returns non-nil if a variable has a connection-local binding. The latter macro returns the connection-local value of a @@ -3057,14 +2655,12 @@ variable if any, or its current value. ** Hash tables -+++ *** ':rehash-size' and ':rehash-threshold' args no longer have any effect. These keyword arguments are now ignored by 'make-hash-table'. Emacs manages the memory for all hash table objects in the same way. The functions 'hash-table-rehash-size' and 'hash-table-rehash-threshold' remain for compatibility but now always return the old default values. -+++ *** The printed representation has been shrunk and simplified. The 'test' parameter is omitted if it is 'eql' (the default), as is 'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are @@ -3072,7 +2668,6 @@ always omitted, and ignored if present when the object is read back in. ** Obarrays -+++ *** New obarray type. Obarrays are now represented by an opaque type instead of using vectors. They are created by 'obarray-make' and manage their internal storage @@ -3088,14 +2683,11 @@ with something other than 0, as in '(make-vector N nil)', will no longer work, and should be rewritten to use 'obarray-make'. Alternatively, you can fill the vector with 0. -+++ *** New function 'obarray-clear' removes all symbols from an obarray. ---- *** 'obarray-size' and 'obarray-default-size' are now obsolete. They pertained to the internal storage size which is now irrelevant. -+++ ** 'treesit-install-language-grammar' can handle local directory instead of URL. It is now possible to pass a directory of a local repository as URL inside 'treesit-language-source-alist', so that calling @@ -3103,22 +2695,18 @@ inside 'treesit-language-source-alist', so that calling It may be useful, for example, for the purposes of bisecting a treesitter grammar. -+++ ** New buffer-local variable 'tabulated-list-groups'. It controls display and separate sorting of groups of entries. By default no grouping or sorting is done. -+++ ** New variable 'revert-buffer-restore-functions'. It helps to preserve various states after reverting the buffer. ---- ** New text property 'context-menu-functions'. Like the variable with the same name, it adds menus from the list that is the value of the property to context menus shown when clicking on the text which as this property. ---- ** Detecting the end of an iteration of a keyboard macro. 'read-event', 'read-char', and 'read-char-exclusive' no longer return -1 when called at the end of an iteration of the execution of a keyboard @@ -3130,7 +2718,6 @@ 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 @@ -3139,7 +2726,6 @@ 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. -+++ ** 'vtable-insert-object' can insert "before" or at an index. The signature of 'vtable-insert-object' has changed and is now: @@ -3152,7 +2738,6 @@ this was not possible.) In addition, LOCATION can be an integer, a (zero-based) index into the table at which the new object is inserted (BEFORE is ignored in this case). -+++ ** New function 'sqlite-execute-batch'. This function lets the user execute multiple SQL statements in one go. It is useful, for example, when a Lisp program needs to evaluate an @@ -3160,45 +2745,37 @@ entire SQL file. ** JSON -+++ *** 'json-serialize' now always returns a unibyte string. This is appropriate since it is an encoding operation. In the unlikely event that a multibyte string is needed, the result can be decoded using (decode-coding-string RESULT 'utf-8) ---- *** The parser keeps duplicated object keys in alist and plist output. A JSON object such as '{"a":1,"a":2}' will now be translated into the Lisp values '((a . 1) (a . 2))' or '(:a 1 :a 2)' if alist or plist object types are requested. ---- *** The parser sometimes signals different types of errors. It will now signal 'json-utf8-decode-error' for inputs that are not correctly UTF-8 encoded. ---- *** The parser and encoder now accept arbitrarily large integers. Previously, they were limited to the range of signed 64-bit integers. ** New tree-sitter functions and variables for defining and using "things" -+++ *** New variable 'treesit-thing-settings'. It allows modes to define "things" like 'defun', 'text', 'sexp', and 'sentence' for navigation commands and tree-traversal functions. -+++ *** New functions for navigating "things". There are new navigation functions 'treesit-thing-prev', 'treesit-thing-next', 'treesit-navigate-thing', 'treesit-beginning-of-thing', and 'treesit-end-of-thing'. -+++ *** New functions 'treesit-thing-at', 'treesit-thing-at-point'. -+++ *** Tree-traversing functions. The functions 'treesit-search-subtree', 'treesit-search-forward', 'treesit-search-forward-goto', and 'treesit-induce-sparse-tree' now @@ -3208,14 +2785,12 @@ for the predicate argument. ** Other tree-sitter function and variable changes -+++ *** 'treesit-parser-list' now takes additional optional arguments. The additional arguments are LANGUAGE and TAG. If LANGUAGE is given, only return parsers for that language. If TAG is given, only return parsers with that tag. Note that passing nil as tag doesn't mean return all parsers, but rather "all parsers with no tags". -+++ *** New variable 'treesit-primary-parser'. This variable should be set by multi-langauge major modes before calling 'treesit-major-mode-setup', in order for tree-sitter integration @@ -3226,7 +2801,6 @@ functionalities to operate correctly. ** MS-Windows -+++ *** You can now opt out of following MS-Windows' Dark mode. By default, Emacs on MS-Windows follows the system's Dark mode for its title bars' and scroll bars' appearance. If the new user option @@ -3234,7 +2808,6 @@ title bars' and scroll bars' appearance. If the new user option will disregard the system's Dark mode and will always use the default Light mode. ---- *** You can now use Image-Dired even if the 'convert' program is not installed. If you don't have GraphicsMagick or ImageMagick installed, and thus the 'gm convert'/'convert' program is not available, Emacs on MS-Windows @@ -3243,7 +2816,6 @@ thumbnail images and show them in the thumbnail buffer. Unlike with using 'convert', this fallback method is synchronous, so Emacs will wait until all the thumbnails are created and displayed, before showing them. ---- *** Emacs on MS-Windows now supports the ':stipple' face attribute. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index ee72a04f493..5fdb4bd95db 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -2815,6 +2815,19 @@ set the 'visible-cursor' variable to nil in your ~/.emacs: Still other way is to change the "cvvis" capability to send the "\E[?25h\E[?0c" command. +*** GNU/Linux: GPM mouse does not display pointer, but otherwise works. + +This happens on Linux kernel versions from 6.7 to 6.13. On these +versions, the Linux kernel does not allow programs to draw the mouse +pointer unless they have superuser permissions. The GPM daemon +normally has such permissions and it draws the mouse pointer for other +programs such as your shell and many ncurses based programs, but not +for Emacs. + +To solve this, you need to change your kernel to a version with this bug +fixed, such as 6.14 or later. See associated Linux kernel fix: +https://lore.kernel.org/regressions/20250110142122.1013222-1-gnoack@google.com/ + ** FreeBSD *** FreeBSD: Getting a Meta key on the console. @@ -3791,6 +3804,16 @@ devices manufactured by OnePlus and possibly others. Sadly, to the best of our knowledge such events cannot be distinguished from legitimate keypresses. +** Emacs crashes or is not acknowledged by the OS when requesting storage permissions. + +This is only possible on Wear OS (an Android distribution), where the +system component that provides confirmation dialogs for this type of +permission is unavailable. You may circumvent this component by +connecting to your device over ADB as in the preceding entries and +executing: + + $ adb shell appops set --uid org.gnu.emacs MANAGE_EXTERNAL_STORAGE allow + * Build-time problems ** Configuration diff --git a/etc/TODO b/etc/TODO index 3c4d1275f64..30c745c6b40 100644 --- a/etc/TODO +++ b/etc/TODO @@ -95,6 +95,14 @@ modify things in their .emacs. ** See if other files can use generated-autoload-file (see e.g. ps-print) +** Come up with better set of keywords for 'finder-known-keywords'. +Eli writes: "The keywords we use today are IMO not rational and mostly +not useful. On the one hand, we have specific keywords like 'abbrevs', +OTOH we have general and vague keywords like 'convenience' and 'tools' +... I'd very much appreciate if someone will volunteer to rethink our +keywords and come up with a useful list (which probably will be +longer)." + ** Do interactive mode tagging for commands Change "(interactive)" to "(interactive nil foo-mode)" for command completion purposes. Pick a major mode or ELisp library, and check diff --git a/etc/symbol-releases.eld b/etc/symbol-releases.eld index 0609dd1467f..21bbe3c793c 100644 --- a/etc/symbol-releases.eld +++ b/etc/symbol-releases.eld @@ -13,6 +13,30 @@ ("26.1" fun when-let*) ("26.1" fun and-let*) ("26.1" fun if-let*) + ("26.1" fun caaar) + ("26.1" fun caadr) + ("26.1" fun cadar) + ("26.1" fun caddr) + ("26.1" fun cdaar) + ("26.1" fun cdadr) + ("26.1" fun cddar) + ("26.1" fun cdddr) + ("26.1" fun caaaar) + ("26.1" fun caaadr) + ("26.1" fun caadar) + ("26.1" fun caaddr) + ("26.1" fun cadaar) + ("26.1" fun cadadr) + ("26.1" fun caddar) + ("26.1" fun cadddr) + ("26.1" fun cdaaar) + ("26.1" fun cdaadr) + ("26.1" fun cdadar) + ("26.1" fun cdaddr) + ("26.1" fun cddaar) + ("26.1" fun cddadr) + ("26.1" fun cdddar) + ("26.1" fun cddddr) ("24.4" fun set-transient-map) ("22.1" fun clear-string) ("22.1" fun version=) diff --git a/exec/trace.c b/exec/trace.c index e222f0fc21a..ff67ed5d941 100644 --- a/exec/trace.c +++ b/exec/trace.c @@ -45,6 +45,9 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_SYS_UIO_H #include /* for process_vm_readv */ +#ifndef HAVE_PROCESS_VM +#include +#endif /* !HAVE_PROCESS_VM */ #endif /* HAVE_SYS_UIO_H */ #ifndef SYS_SECCOMP @@ -80,6 +83,22 @@ along with GNU Emacs. If not, see . */ /* Number of tracees children are allowed to create. */ #define MAX_TRACEES 4096 +#if defined HAVE_SYS_UIO_H && !defined HAVE_PROCESS_VM + +/* Load have_process_vm dynamically if possible to avoid PTRACE_PEEKDATA + restrictions on Android 15 QPR2+. */ + +static ssize_t (*process_vm_readv) (pid_t, const struct iovec *, + unsigned long, + const struct iovec *, + unsigned long, unsigned long); +static ssize_t (*process_vm_writev) (pid_t, const struct iovec *, + unsigned long, + const struct iovec *, + unsigned long, unsigned long); + +#endif /* HAVE_SYS_UIO_H && !HAVE_PROCESS_VM */ + #ifdef HAVE_SECCOMP /* Whether to enable seccomp acceleration. */ @@ -156,7 +175,7 @@ static struct exec_tracee *tracing_processes; ADDRESS. Return its contents in BUFFER. If there are unreadable pages within ADDRESS + N, the contents of - BUFFER after the first such page becomes undefined. */ + BUFFER after the first such page become undefined. */ static void read_memory (struct exec_tracee *tracee, char *buffer, @@ -164,7 +183,7 @@ read_memory (struct exec_tracee *tracee, char *buffer, { USER_WORD word, n_words, n_bytes, i; long rc; -#ifdef HAVE_PROCESS_VM +#ifdef HAVE_SYS_UIO_H struct iovec iov, remote; /* If `process_vm_readv' is available, use it instead. */ @@ -178,11 +197,14 @@ read_memory (struct exec_tracee *tracee, char *buffer, read, consider the read to have been a success. */ if (n <= SSIZE_MAX - && ((size_t) process_vm_readv (tracee->pid, &iov, 1, - &remote, 1, 0) != -1)) +#ifndef HAVE_PROCESS_VM + && process_vm_readv +#endif /* !HAVE_PROCESS_VM */ + && (process_vm_readv (tracee->pid, &iov, 1, + &remote, 1, 0) != -1)) return; -#endif /* HAVE_PROCESS_VM */ +#endif /* !HAVE_SYS_UIO_H */ /* First, read entire words from the tracee. */ n_words = n & ~(sizeof (USER_WORD) - 1); @@ -301,7 +323,7 @@ user_copy (struct exec_tracee *tracee, const unsigned char *buffer, { USER_WORD start, end, word; unsigned char *bytes; -#ifdef HAVE_PROCESS_VM +#ifdef HAVE_SYS_UIO_H struct iovec iov, remote; /* Try to use `process_vm_writev' if possible, but fall back to @@ -313,10 +335,13 @@ user_copy (struct exec_tracee *tracee, const unsigned char *buffer, remote.iov_len = n; if (n <= SSIZE_MAX - && ((size_t) process_vm_writev (tracee->pid, &iov, 1, - &remote, 1, 0) == n)) +#ifndef HAVE_PROCESS_VM + && process_vm_writev +#endif /* !HAVE_PROCESS_VM */ + && (process_vm_writev (tracee->pid, &iov, 1, + &remote, 1, 0) == n)) return 0; -#endif /* HAVE_PROCESS_VM */ +#endif /* HAVE_SYS_UIO_H */ /* Calculate the start and end positions for the write. */ @@ -1129,10 +1154,7 @@ handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs, 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. */ + equivalent with the PID made explicit. */ p = stpcpy (proc_pid_exe, "/proc/"); p = format_pid (p, tracee->pid); @@ -1153,7 +1175,7 @@ handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs, if (!address || user_copy (tracee, (unsigned char *) tracee->exec_file, - address, length)) + address, length + 1)) goto fail; /* Replace the file name buffer with ADDRESS. */ @@ -2203,4 +2225,12 @@ exec_init (const char *loader) } } #endif /* HAVE_SECCOMP */ +#if defined HAVE_SYS_UIO_H && !defined HAVE_PROCESS_VM + { + *(void **) (&process_vm_readv) + = dlsym (RTLD_DEFAULT, "process_vm_readv"); + *(void **) (&process_vm_writev) + = dlsym (RTLD_DEFAULT, "process_vm_writev"); + } +#endif /* HAVE_SYS_UIO_H && !HAVE_PROCESS_VM */ } diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 04563590dc4..5225337a826 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -54,6 +54,7 @@ import android.app.NotificationManager; import android.app.PendingIntent; import android.app.Service; +import android.content.ActivityNotFoundException; import android.content.ClipboardManager; import android.content.Context; import android.content.ContentResolver; @@ -2092,7 +2093,15 @@ public final class EmacsService extends Service /* Now request these permissions. */ - activity.startActivity (intent); + try + { + activity.startActivity (intent); + } + catch (ActivityNotFoundException exception) + { + Log.w (TAG, "Failed to request storage access permissions: "); + exception.printStackTrace (); + } } }; diff --git a/lib/attribute.h b/lib/attribute.h index 4939d776e72..625195c8565 100644 --- a/lib/attribute.h +++ b/lib/attribute.h @@ -257,7 +257,9 @@ because the function need not return exactly once and can depend on state addressed by its arguments.) See also and - . */ + . + ATTENTION! Efforts are underway to change the meaning of this attribute. + See . */ /* Applies to: functions, pointer to functions, function type. */ #define UNSEQUENCED _GL_ATTRIBUTE_UNSEQUENCED @@ -284,7 +286,9 @@ because the function need not return exactly once and can affect state addressed by its arguments.) See also and - . */ + . + ATTENTION! Efforts are underway to change the meaning of this attribute. + See . */ /* Applies to: functions, pointer to functions, function type. */ #define REPRODUCIBLE _GL_ATTRIBUTE_REPRODUCIBLE diff --git a/lib/flexmember.h b/lib/flexmember.h index 15ee4f5e281..b4d86c29fb5 100644 --- a/lib/flexmember.h +++ b/lib/flexmember.h @@ -28,11 +28,12 @@ #include /* Nonzero multiple of alignment of TYPE, suitable for FLEXSIZEOF below. - On older platforms without _Alignof, use a pessimistic bound that is + If _Alignof might not exist or might not work correctly on + structs with flexible array members, use a pessimistic bound that is safe in practice even if FLEXIBLE_ARRAY_MEMBER is 1. - On newer platforms, use _Alignof to get a tighter bound. */ + Otherwise, use _Alignof to get a tighter bound. */ -#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 || defined _Alignof # define FLEXALIGNOF(type) (sizeof (type) & ~ (sizeof (type) - 1)) #else # define FLEXALIGNOF(type) _Alignof (type) diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 22d102b1d86..fa2250cf686 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -281,7 +281,6 @@ EXECINFO_H = @EXECINFO_H@ EXEEXT = @EXEEXT@ FILE_HAS_ACL_LIB = @FILE_HAS_ACL_LIB@ FIND_DELETE = @FIND_DELETE@ -FIRSTFILE_OBJ = @FIRSTFILE_OBJ@ FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@ FONTCONFIG_LIBS = @FONTCONFIG_LIBS@ FONT_OBJ = @FONT_OBJ@ @@ -960,7 +959,6 @@ HAVE_WCHAR_H = @HAVE_WCHAR_H@ HAVE_WINSOCK2_H = @HAVE_WINSOCK2_H@ HAVE_XSERVER = @HAVE_XSERVER@ HAVE__EXIT = @HAVE__EXIT@ -HYBRID_MALLOC = @HYBRID_MALLOC@ IEEE754_H = @IEEE754_H@ IMAGEMAGICK_CFLAGS = @IMAGEMAGICK_CFLAGS@ IMAGEMAGICK_LIBS = @IMAGEMAGICK_LIBS@ @@ -1137,7 +1135,6 @@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ -PAXCTL = @PAXCTL@ PAXCTL_dumped = @PAXCTL_dumped@ PAXCTL_notdumped = @PAXCTL_notdumped@ PGTK_LIBS = @PGTK_LIBS@ @@ -1147,10 +1144,8 @@ PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ PNG_CFLAGS = @PNG_CFLAGS@ PNG_LIBS = @PNG_LIBS@ -POST_ALLOC_OBJ = @POST_ALLOC_OBJ@ PRAGMA_COLUMNS = @PRAGMA_COLUMNS@ PRAGMA_SYSTEM_HEADER = @PRAGMA_SYSTEM_HEADER@ -PRE_ALLOC_OBJ = @PRE_ALLOC_OBJ@ PRIPTR_PREFIX = @PRIPTR_PREFIX@ PROFILING_CFLAGS = @PROFILING_CFLAGS@ PTHREAD_H_DEFINES_STRUCT_TIMESPEC = @PTHREAD_H_DEFINES_STRUCT_TIMESPEC@ @@ -1388,7 +1383,6 @@ TREE_SITTER_LIBS = @TREE_SITTER_LIBS@ UINT32_MAX_LT_UINTMAX_MAX = @UINT32_MAX_LT_UINTMAX_MAX@ UINT64_MAX_EQ_ULONG_MAX = @UINT64_MAX_EQ_ULONG_MAX@ UNDEFINE_STRTOK_R = @UNDEFINE_STRTOK_R@ -UNEXEC_OBJ = @UNEXEC_OBJ@ UNISTD_H_DEFINES_STRUCT_TIMESPEC = @UNISTD_H_DEFINES_STRUCT_TIMESPEC@ UNISTD_H_HAVE_SYS_RANDOM_H = @UNISTD_H_HAVE_SYS_RANDOM_H@ UNISTD_H_HAVE_WINSOCK2_H = @UNISTD_H_HAVE_WINSOCK2_H@ @@ -1501,10 +1495,16 @@ gl_GNULIB_ENABLED_verify_CONDITION = @gl_GNULIB_ENABLED_verify_CONDITION@ gl_LIBOBJDEPS = @gl_LIBOBJDEPS@ gl_LIBOBJS = @gl_LIBOBJS@ gl_LTLIBOBJS = @gl_LTLIBOBJS@ +gl_libgnu_LIBOBJDEPS = @gl_libgnu_LIBOBJDEPS@ +gl_libgnu_LIBOBJS = @gl_libgnu_LIBOBJS@ +gl_libgnu_LTLIBOBJS = @gl_libgnu_LTLIBOBJS@ gltests_LIBOBJDEPS = @gltests_LIBOBJDEPS@ gltests_LIBOBJS = @gltests_LIBOBJS@ gltests_LTLIBOBJS = @gltests_LTLIBOBJS@ gltests_WITNESS = @gltests_WITNESS@ +gltests_libgnu_LIBOBJDEPS = @gltests_libgnu_LIBOBJDEPS@ +gltests_libgnu_LIBOBJS = @gltests_libgnu_LIBOBJS@ +gltests_libgnu_LTLIBOBJS = @gltests_libgnu_LTLIBOBJS@ gsettingsschemadir = @gsettingsschemadir@ host = @host@ host_alias = @host_alias@ @@ -1552,9 +1552,9 @@ x_default_search_path = @x_default_search_path@ noinst_LIBRARIES += libgnu.a libgnu_a_SOURCES = -libgnu_a_CFLAGS = $(AM_CFLAGS) $(GL_CFLAG_GNULIB_WARNINGS) -libgnu_a_LIBADD = $(gl_LIBOBJS) -libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) +libgnu_a_CFLAGS = $(AM_CFLAGS) $(GL_CFLAG_GNULIB_WARNINGS) $(GL_CFLAG_ALLOW_WARNINGS) +libgnu_a_LIBADD = $(gl_libgnu_LIBOBJS) +libgnu_a_DEPENDENCIES = $(gl_libgnu_LIBOBJS) EXTRA_libgnu_a_SOURCES = ## begin gnulib module absolute-header @@ -4446,5 +4446,5 @@ mostlyclean-local: mostlyclean-generic : distclean-local: distclean-gnulib-libobjs distclean-gnulib-libobjs: - -rm -f @gl_LIBOBJDEPS@ + -rm -f @gl_libgnu_LIBOBJDEPS@ maintainer-clean-local: distclean-gnulib-libobjs diff --git a/lib/intprops.h b/lib/intprops.h index 92dfef2500a..83efe39910a 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -34,6 +34,14 @@ signed or floating type. Do not evaluate E. */ #define EXPR_SIGNED(e) _GL_EXPR_SIGNED (e) +/* The same value as as the arithmetic expression E, but with E's type + after integer promotions. For example, if E is of type 'enum {A, B}' + then 'switch (INT_PROMOTE (E))' pacifies gcc -Wswitch-enum if some + enum values are deliberately omitted from the switch's cases. + Here, unary + is safer than a cast or inline function, as unary + + does only integer promotions. */ +#define INT_PROMOTE(e) (+ (e)) + /* Minimum and maximum values for integer types and expressions. */ diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el index bbd75033ba0..97d6f6c8754 100644 --- a/lisp/ansi-osc.el +++ b/lisp/ansi-osc.el @@ -116,15 +116,16 @@ such as with the following command: printf \"\\e]7;file://%s%s\\e\\\\\" \"$HOSTNAME\" \"$PWD\" +A remote `default-directory' is maintained. + This functionality serves as an alternative to `dirtrack-mode' and `shell-dirtrack-mode'." - (let ((url (url-generic-parse-url text))) - (when (and (string= (url-type url) "file") - (or (null (url-host url)) - ;; Use `downcase' to match `url-generic-parse-url' behavior - (string= (url-host url) (downcase (system-name))))) - (ignore-errors - (cd-absolute (url-unhex-string (url-filename url))))))) + (when-let* ((url (url-generic-parse-url text)) + ((string= (url-type url) "file"))) + (ignore-errors + (cd-absolute + (concat (file-remote-p default-directory) + (url-unhex-string (url-filename url))))))) ;; Hyperlink handling (OSC 8) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 1dcfe8e911f..e6a12d37ad1 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -772,11 +772,39 @@ If the buffer needs to be reverted, do it now." (when auto-revert-notify-modified-p (auto-revert-handler))))) +;;;###autoload +(progn + (defvar inhibit-auto-revert-buffers nil + "A list of buffers with suppressed auto-revert.") + + (defmacro inhibit-auto-revert (&rest body) + "Deactivate auto-reverting of current buffer temporarily. +Run BODY." + (declare (indent 0) (debug (body))) + (let ((buf (make-symbol "buf"))) + `(progn + ;; Cleanup. + (dolist (,buf inhibit-auto-revert-buffers) + (unless (buffer-live-p ,buf) + (setq inhibit-auto-revert-buffers + (delq ,buf inhibit-auto-revert-buffers)))) + (let ((,buf + (and (not (memq (current-buffer) inhibit-auto-revert-buffers)) + (current-buffer)))) + (unwind-protect + (progn + (when ,buf (add-to-list 'inhibit-auto-revert-buffers ,buf)) + ,@body) + (when ,buf + (setq inhibit-auto-revert-buffers + (delq ,buf inhibit-auto-revert-buffers))))))))) + (defun auto-revert-active-p () "Check if auto-revert is active in current buffer." - (or auto-revert-mode - auto-revert-tail-mode - auto-revert--global-mode)) + (and (or auto-revert-mode + auto-revert-tail-mode + auto-revert--global-mode) + (not (memq (current-buffer) inhibit-auto-revert-buffers)))) (defun auto-revert-handler () "Revert current buffer, if appropriate. @@ -792,6 +820,7 @@ This is an internal function used by Auto-Revert Mode." (not (file-remote-p buffer-file-name))) (or (not auto-revert-notify-watch-descriptor) auto-revert-notify-modified-p) + (not (memq (current-buffer) inhibit-auto-revert-buffers)) (if auto-revert-tail-mode (and (file-readable-p buffer-file-name) (/= auto-revert-tail-pos @@ -803,6 +832,7 @@ This is an internal function used by Auto-Revert Mode." t))) (and (or auto-revert-mode global-auto-revert-non-file-buffers) + (not (memq (current-buffer) inhibit-auto-revert-buffers)) (funcall (or buffer-stale-function #'buffer-stale--default-function) t)))) @@ -840,7 +870,7 @@ This is an internal function used by Auto-Revert Mode." (set-window-point window (point-max))))) ;; `preserve-modes' avoids changing the (minor) modes. But we do ;; want to reset the mode for VC, so we do it manually. - (when (or revert auto-revert-check-vc-info) + (when (and (not auto-revert-tail-mode) (or revert auto-revert-check-vc-info)) (let ((revert-buffer-in-progress-p t)) (vc-refresh-state))))) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index d68e9308208..8495f33cb5f 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -165,6 +165,10 @@ This includes the annotations column.") You can toggle whether files are shown with \\\\[bookmark-bmenu-toggle-filenames]." :type 'natnum) +(defcustom bookmark-bmenu-type-column-width 8 + "Column width for bookmark type in a buffer listing bookmarks." + :type 'natnum + :version "31.1") (defcustom bookmark-bmenu-toggle-filenames t "Non-nil means show filenames when listing bookmarks. @@ -599,7 +603,7 @@ from other commands that pass in the bookmark name, so `completing-read' never gets a chance to set `bookmark-history'." `(or (called-interactively-p 'interactive) - (setq bookmark-history (cons ,string bookmark-history)))) + (add-to-history 'bookmark-history ,string))) (defvar bookmark-make-record-function 'bookmark-make-record-default "A function that should be called to create a bookmark record. @@ -1582,6 +1586,8 @@ confirmation." (when (or no-confirm (yes-or-no-p "Permanently delete all bookmarks? ")) (bookmark-maybe-load-default-file) + (dolist (bm bookmark-alist) + (bookmark--remove-fringe-mark bm)) (setq bookmark-alist-modification-count (+ bookmark-alist-modification-count (length bookmark-alist))) (setq bookmark-alist nil) @@ -2061,7 +2067,7 @@ At any time you may use \\[revert-buffer] to go back to sorting by creation orde `[("" 1) ;; Space to add "*" for bookmark with annotation ("Bookmark Name" ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate) - ("Type" 8 bookmark-bmenu--type-predicate) + ("Type" ,bookmark-bmenu-type-column-width bookmark-bmenu--type-predicate) ,@(if bookmark-bmenu-toggle-filenames '(("File" 0 bookmark-bmenu--file-predicate)))]) (setq tabulated-list-padding bookmark-bmenu-marks-width) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 4418db01724..36268b3512a 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -135,6 +135,14 @@ If this is nil, group names are unsorted." :group 'Buffer-menu :version "30.1") +(defcustom Buffer-menu-human-readable-sizes nil + "If non-nil, show buffer sizes in human-readable format. +That means to use `file-size-human-readable' (which see) to format the +buffer sizes in the buffer size column." + :type 'boolean + :group 'Buffer-menu + :version "31.1") + (defvar-local Buffer-menu-files-only nil "Non-nil if the current Buffer Menu lists only file buffers. This is set by the prefix argument to `buffer-menu' and related @@ -831,7 +839,10 @@ See more at `Buffer-menu-filter-predicate'." (if buffer-read-only "%" " ") (if (buffer-modified-p) "*" " ") (Buffer-menu--pretty-name name) - (number-to-string (buffer-size)) + (funcall (if Buffer-menu-human-readable-sizes + #'file-size-human-readable + #'number-to-string) + (buffer-size)) (concat (format-mode-line mode-name nil nil buffer) (if mode-line-process diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 4ec96d3ef53..060d352fe66 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -877,7 +877,7 @@ calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw math-exp-minus-1-raw math-exp-raw math-from-radians math-from-radians-2 math-hypot math-infinite-dir -math-ln-raw math-nearly-equal math-nearly-equal-float +math-ln-10 math-ln-raw math-nearly-equal math-nearly-equal-float math-nearly-zerop math-nearly-zerop-float math-nth-root math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw math-tan-raw math-to-radians math-to-radians-2) diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el index 2761f35061e..82874284b65 100644 --- a/lisp/calc/calc-nlfit.el +++ b/lisp/calc/calc-nlfit.el @@ -678,7 +678,7 @@ (sdata (if (math-contains-sdev-p ydata) (mapcar (lambda (x) (math-get-sdev x t)) ydata) nil)) - (ydata (mapcar (lambda (x) (math-get-value x)) ydata)) + (ydata (mapcar #'math-get-value ydata)) (calc-curve-varnames nil) (calc-curve-coefnames nil) (calc-curve-nvars 1) @@ -757,7 +757,7 @@ (sdata (if (math-contains-sdev-p pdata) (mapcar (lambda (x) (math-get-sdev x t)) pdata) nil)) - (pdata (mapcar (lambda (x) (math-get-value x)) pdata)) + (pdata (mapcar #'math-get-value pdata)) (poverqdata (math-map-binop 'math-div pdata qdata)) (parmvals (math-nlfit-least-squares qdata poverqdata sdata sdevv)) (finalparms (list (nth 0 parmvals) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index d2396a9b262..4a638e66132 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -314,7 +314,8 @@ ;; Logarithmic units ( Np nil "*Neper") - ( dB "(ln(10)/20) Np" "decibel")) + ( dB "(ln10/20) Np" "Decibel" nil + "(ln(10)/20) Np")) "List of predefined units for Calc. Each element is (NAME DEF DESC TEMP-UNIT HUMAN-DEF), where: @@ -948,10 +949,9 @@ If COMP or STD is non-nil, put that in the units table instead." ((eq (car expr) '+) (math-find-base-units-rec (nth 1 expr) pow)) ((eq (car expr) 'var) - (or (eq (nth 1 expr) 'pi) + (or (memq (nth 1 expr) '(pi ln10)) (error "Unknown name %s in defining expression for unit %s" (nth 1 expr) (car math-fbu-entry)))) - ((equal expr '(calcFunc-ln 10))) (t (error "Malformed defining expression for unit %s" (car math-fbu-entry)))))) @@ -1055,9 +1055,9 @@ If COMP or STD is non-nil, put that in the units table instead." math-unit-prefixes)) expr))) expr) - (if (eq base 'pi) - (math-pi) - expr))) + (cond ((eq base 'pi) (math-pi)) + ((eq base 'ln10) (math-ln-10)) + (t expr)))) (if (or (Math-primp expr) (and (eq (car-safe expr) 'calcFunc-subscr) diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 8df47431889..c0bb9760810 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -1600,7 +1600,7 @@ FINAL-SEPARATOR is non-nil." (or separator (setq separator "\\\\")) (let (result) (setq result - (mapconcat (lambda (x) (cal-tex-LaTeXify-string x)) + (mapconcat #'cal-tex-LaTeXify-string (dolist (d date-list (reverse result)) (and (car d) (calendar-date-equal date (car d)) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 09b4cfb0edf..1d792952f98 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -305,7 +305,7 @@ right of \"%x\", trailing zero units are not output." ("x"))) (case-fold-search t) spec match usedunits zeroflag larger prev name unit num - leading-zeropos trailing-zeropos fraction + leading-zeropos trailing-zeropos fraction minus chop-leading chop-trailing) (while (string-match "%\\.?[0-9]*\\(,[0-9]\\)?\\(.\\)" string start) (setq start (match-end 0) @@ -327,8 +327,11 @@ right of \"%x\", trailing zero units are not output." (error "Units are not in decreasing order of size")) (unless (numberp seconds) (setq seconds (float-time seconds))) - (setq fraction (mod seconds 1) - seconds (round seconds)) + (setq minus (when (< seconds 0) "-") ; Treat -0.0 like 0.0. + seconds (abs seconds) + seconds (let ((s (floor seconds))) + (setq fraction (- seconds s)) + s)) (dolist (u units) (setq spec (car u) name (cadr u) @@ -392,8 +395,8 @@ right of \"%x\", trailing zero units are not output." ;; string in full. (when (equal string "") (setq string pre))) - (setq string (replace-regexp-in-string "%[zx]" "" string))) - (string-trim (string-replace "%%" "%" string))) + (setq string (replace-regexp-in-string "%[zx]" "" string)) + (concat minus (string-trim (string-replace "%%" "%" string))))) (defvar seconds-to-string (list (list 1 "ms" 0.001) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 27678328b4a..dc6f7345b21 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -3772,7 +3772,7 @@ option `todo-categories-align'." "Return a copy of LIST, possibly sorted according to KEY." (let* ((l (copy-sequence list)) (fn (if (eq key 'alpha) - (lambda (x) (upcase x)) ; Alphabetize case insensitively. + #'upcase ; Alphabetize case insensitively. (lambda (x) (todo-get-count key x)))) ;; Keep track of whether the last sort by key was descending or ;; ascending. diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el index 9fc935f4893..3570ccd855d 100644 --- a/lisp/cedet/semantic/ctxt.el +++ b/lisp/cedet/semantic/ctxt.el @@ -362,7 +362,7 @@ This will move past type/field names when applicable. Depends on `semantic-type-relation-separator-character', and will work on C like languages." (if point (goto-char point)) - (let* ((fieldsep1 (mapconcat (lambda (a) (regexp-quote a)) + (let* ((fieldsep1 (mapconcat #'regexp-quote semantic-type-relation-separator-character "\\|")) ;; NOTE: The [ \n] expression below should used \\s-, but that @@ -446,7 +446,7 @@ This will include a list of type/field names when applicable. Depends on `semantic-type-relation-separator-character'." (save-excursion (if point (goto-char point)) - (let* ((fieldsep1 (mapconcat (lambda (a) (regexp-quote a)) + (let* ((fieldsep1 (mapconcat #'regexp-quote semantic-type-relation-separator-character "\\|")) ;; NOTE: The [ \n] expression below should used \\s-, but that diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el index 9c4aad3db55..3eb4c159b75 100644 --- a/lisp/cedet/semantic/sort.el +++ b/lisp/cedet/semantic/sort.el @@ -243,7 +243,7 @@ unmodified as components of their parent tags." ;; table, and reorganize them into buckets based on class. ;; (defvar semantic-bucketize-tag-class - ;; Must use lambda because `semantic-tag-class' is a macro. + ;; Must use lambda because `semantic-tag-class' is a defsubst. (lambda (tok) (semantic-tag-class tok)) "Function used to get a symbol describing the class of a tag. This function must take one argument of a semantic tag. @@ -401,6 +401,7 @@ buckets with the bucket function." ;; get embedded types to scan and make copies ;; of them. (mapcar + ;; Must use lambda because `semantic-tag-clone' is a defsubst. (lambda (tok) (semantic-tag-clone tok)) (semantic-find-tags-by-class 'type (semantic-tag-type-members (car decent-list))))) diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index 99a3287343f..b1a99634ef0 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -398,7 +398,7 @@ this list.") (if (slot-boundp result 'hit-files) (oref result hit-files) (let* ((lines (oref result hit-lines)) - (files (mapcar (lambda (a) (cdr a)) lines)) + (files (mapcar #'cdr lines)) (ans nil)) (setq ans (list (car files)) files (cdr files)) diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el index 27720930328..5965e62d151 100644 --- a/lisp/cedet/semantic/texi.el +++ b/lisp/cedet/semantic/texi.el @@ -385,7 +385,7 @@ Optional argument POINT is where to look for the environment." )) (defvar semantic-texi-command-completion-list - (append (mapcar (lambda (a) (car a)) texinfo-section-list) + (append (mapcar #'car texinfo-section-list) texinfo-environments ;; Is there a better list somewhere? Here are few ;; of the top of my head. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 0f7d7c3c020..5d35edd212b 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -698,9 +698,9 @@ since it could result in memory overflow and make Emacs crash." frames (choice (const :tag "Images" :value image) (const :tag "Text" :value text) - (const :tag "Both" :value both) - (const :tag "Both-horiz" :value both-horiz) - (const :tag "Text-image-horiz" :value text-image-horiz) + (const :tag "Both, text below image" :value both) + (const :tag "Both, text to right of image" :value both-horiz) + (const :tag "Both, text to left of image" :value text-image-horiz) (const :tag "System default" :value nil)) "24.1") (tool-bar-max-label-size frames integer "24.1") (tab-bar-position diff --git a/lisp/custom.el b/lisp/custom.el index 3abc326e674..9e6eb930467 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -306,7 +306,8 @@ The following keywords are meaningful: The following common keywords are also meaningful. :group VALUE should be a customization group. - Add SYMBOL (or FACE with `defface') to that group. + Add SYMBOL (or FACE with `defface') to that group instead of + the default group. Can be repeated. :link LINK-DATA Include an external link after the documentation string for this item. This is a sentence containing an active field which diff --git a/lisp/descr-text.el b/lisp/descr-text.el index ff4c259463e..3fb21309f7b 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -407,8 +407,7 @@ The character information includes: (composition-string nil) (disp-vector (and display-table (aref display-table char))) (multibyte-p enable-multibyte-characters) - (overlays (mapcar (lambda (o) (overlay-properties o)) - (overlays-at pos))) + (overlays (mapcar #'overlay-properties (overlays-at pos))) (char-description (if (< char 128) (single-key-description char) (string (if (not multibyte-p) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 4a05f609b2b..89390a482f0 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -498,8 +498,10 @@ status message." nil (if dired-omit-verbose (format "Omitted %%d line%%s in %s" - (abbreviate-file-name - dired-directory)) + (replace-regexp-in-string + "%" "%%" + (abbreviate-file-name + dired-directory))) "") init-count))) (force-mode-line-update)))) diff --git a/lisp/dired.el b/lisp/dired.el index 2eb6546107a..91163186443 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -944,9 +944,6 @@ Return value is the number of files marked, or nil if none were marked." "")))) (and (> count 0) count))) -(defvar-local dired--inhibit-auto-revert nil - "A non-nil value prevents `auto-revert-mode' from reverting the buffer.") - (defmacro dired-map-over-marks (body arg &optional show-progress distinguish-one-marked) "Eval BODY with point on each marked line. Return a list of BODY's results. @@ -983,48 +980,48 @@ marked file, return (t FILENAME) instead of (FILENAME)." ;;endless loop. ;;This warning should not apply any longer, sk 2-Sep-1991 14:10. `(prog1 - (let ((dired--inhibit-auto-revert t) - (inhibit-read-only t) - case-fold-search found results) - (if (and ,arg (not (eq ,arg 'marked))) - (if (integerp ,arg) - (progn ;; no save-excursion, want to move point. - (dired-repeat-over-lines - ,arg - (lambda () - (if ,show-progress (sit-for 0)) - (setq results (cons ,body results)))) - (when (< ,arg 0) - (setq results (nreverse results))) - results) - ;; non-nil, non-integer, non-marked ARG means use current file: - (list ,body)) - (let ((regexp (dired-marker-regexp)) next-position) - (save-excursion - (goto-char (point-min)) - ;; remember position of next marked file before BODY - ;; can insert lines before the just found file, - ;; confusing us by finding the same marked file again - ;; and again and... - (setq next-position (and (re-search-forward regexp nil t) - (point-marker)) - found (not (null next-position))) - (while next-position - (goto-char next-position) - (if ,show-progress (sit-for 0)) - (setq results (cons ,body results)) - ;; move after last match - (goto-char next-position) - (forward-line 1) - (set-marker next-position nil) - (setq next-position (and (re-search-forward regexp nil t) - (point-marker))))) - (if (and ,distinguish-one-marked (= (length results) 1)) - (setq results (cons t results))) - (if found - results - (unless (eq ,arg 'marked) - (list ,body)))))) + (inhibit-auto-revert + (let ((inhibit-read-only t) + case-fold-search found results) + (if (and ,arg (not (eq ,arg 'marked))) + (if (integerp ,arg) + (progn ;; no save-excursion, want to move point. + (dired-repeat-over-lines + ,arg + (lambda () + (if ,show-progress (sit-for 0)) + (setq results (cons ,body results)))) + (when (< ,arg 0) + (setq results (nreverse results))) + results) + ;; non-nil, non-integer, non-marked ARG means use current file: + (list ,body)) + (let ((regexp (dired-marker-regexp)) next-position) + (save-excursion + (goto-char (point-min)) + ;; remember position of next marked file before BODY + ;; can insert lines before the just found file, + ;; confusing us by finding the same marked file again + ;; and again and... + (setq next-position (and (re-search-forward regexp nil t) + (point-marker)) + found (not (null next-position))) + (while next-position + (goto-char next-position) + (if ,show-progress (sit-for 0)) + (setq results (cons ,body results)) + ;; move after last match + (goto-char next-position) + (forward-line 1) + (set-marker next-position nil) + (setq next-position (and (re-search-forward regexp nil t) + (point-marker))))) + (if (and ,distinguish-one-marked (= (length results) 1)) + (setq results (cons t results))) + (if found + results + (unless (eq ,arg 'marked) + (list ,body))))))) ;; save-excursion loses, again (dired-move-to-filename))) @@ -1294,12 +1291,6 @@ This feature is used by Auto Revert mode." ;; Do not auto-revert when the dired buffer can be currently ;; written by the user as in `wdired-mode'. buffer-read-only - ;; When a dired operation using dired-map-over-marks is in - ;; progress, dired--inhibit-auto-revert is bound to some - ;; non-nil value and we must not auto-revert because that could - ;; change the order of files leading to skipping or - ;; double-processing (see bug#75626). - (not dired--inhibit-auto-revert) (dired-directory-changed-p dirname)))) (defcustom dired-auto-revert-buffer nil @@ -4089,26 +4080,26 @@ non-empty directories is allowed." (while l (goto-char (marker-position (cdr (car l)))) (dired-move-to-filename) - (let ((inhibit-read-only t) - ;; Temporarily prevent auto-revert while deleting - ;; entry in the dired buffer (bug#71264). - (dired--inhibit-auto-revert t)) - (condition-case err - (let ((fn (car (car l)))) - (dired-delete-file fn dired-recursive-deletes trash) - ;; if we get here, removing worked - (setq succ (1+ succ)) - (progress-reporter-update progress-reporter succ) - (dired-fun-in-all-buffers - (file-name-directory fn) (file-name-nondirectory fn) - #'dired-delete-entry fn) - ;; For when FN's directory name is different - ;; from the current buffer's dired-directory. - (dired-delete-entry fn)) - (quit (throw '--delete-cancel (message "OK, canceled"))) - (error ;; catch errors from failed deletions - (dired-log "%s: %s\n" (car err) (error-message-string err)) - (setq failures (cons (car (car l)) failures))))) + ;; Temporarily prevent auto-revert while deleting entry in + ;; the dired buffer (bug#71264). + (inhibit-auto-revert + (let ((inhibit-read-only t)) + (condition-case err + (let ((fn (car (car l)))) + (dired-delete-file fn dired-recursive-deletes trash) + ;; if we get here, removing worked + (setq succ (1+ succ)) + (progress-reporter-update progress-reporter succ) + (dired-fun-in-all-buffers + (file-name-directory fn) (file-name-nondirectory fn) + #'dired-delete-entry fn) + ;; For when FN's directory name is different + ;; from the current buffer's dired-directory. + (dired-delete-entry fn)) + (quit (throw '--delete-cancel (message "OK, canceled"))) + (error ;; catch errors from failed deletions + (dired-log "%s: %s\n" (car err) (error-message-string err)) + (setq failures (cons (car (car l)) failures)))))) (setq l (cdr l))) (if (not failures) (progress-reporter-done progress-reporter) diff --git a/lisp/dom.el b/lisp/dom.el index fc032058e9f..4d904c92de9 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -258,31 +258,41 @@ white-space." (insert ")") (insert "\n" (make-string (1+ column) ?\s)))))))) +(define-inline dom--html-boolean-attribute-p (attr) + "Return non-nil if ATTR is an HTML boolean attribute." + (inline-quote + (memq ,attr + ;; Extracted from the HTML Living Standard list of attributes + ;; at . + '( allowfullscreen alpha async autofocus autoplay checked + controls default defer disabled formnovalidate inert ismap + itemscope loop multiple muted nomodule novalidate open + playsinline readonly required reversed selected + shadowrootclonable shadowrootdelegatesfocus + shadowrootserializable)))) + (defun dom-print (dom &optional pretty xml) "Print DOM at point as HTML/XML. If PRETTY, indent the HTML/XML logically. If XML, generate XML instead of HTML." - (let ((column (current-column))) + (let ((column (current-column)) + (indent-tabs-mode nil)) ;; Indent with spaces (insert (format "<%s" (dom-tag dom))) - (let ((attr (dom-attributes dom))) - (dolist (elem attr) - ;; In HTML, these are boolean attributes that should not have - ;; an = value. - (insert (if (and (memq (car elem) - '(async autofocus autoplay checked - contenteditable controls default - defer disabled formNoValidate frameborder - hidden ismap itemscope loop - multiple muted nomodule novalidate open - readonly required reversed - scoped selected typemustmatch)) - (cdr elem) - (not xml)) - (format " %s" (car elem)) - (format " %s=\"%s\"" (car elem) - (url-insert-entities-in-string (cdr elem))))))) + (pcase-dolist (`(,attr . ,value) (dom-attributes dom)) + ;; Don't print attributes without a value. + (when value + (insert + ;; HTML boolean attributes should not have an = value. The + ;; presence of a boolean attribute on an element represents + ;; the true value, and the absence of the attribute + ;; represents the false value. + (if (and (not xml) (dom--html-boolean-attribute-p attr)) + (format " %s" attr) + (format " %s=%S" attr (url-insert-entities-in-string + (format "%s" value))))))) (let* ((children (dom-children dom)) - (non-text nil)) + (non-text nil) + (indent (+ column 2))) (if (null children) (insert " />") (insert ">") @@ -291,16 +301,14 @@ If XML, generate XML instead of HTML." (insert (url-insert-entities-in-string child)) (setq non-text t) (when pretty - (insert "\n" (make-string (+ column 2) ?\s))) + (insert "\n") + (indent-line-to indent)) (dom-print child pretty xml))) ;; If we inserted non-text child nodes, or a text node that ;; ends with a newline, then we indent the end tag. - (when (and pretty - (or (bolp) - non-text)) - (unless (bolp) - (insert "\n")) - (insert (make-string column ?\s))) + (when (and pretty (or (bolp) non-text)) + (or (bolp) (insert "\n")) + (indent-line-to column)) (insert (format "" (dom-tag dom))))))) (provide 'dom) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1333edf5885..8b96fbd65af 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2133,7 +2133,6 @@ If compilation is needed, this functions returns the result of (and file (not (equal file "")) (with-temp-buffer (insert-file-contents file) - (goto-char (point-min)) (let ((vars nil) var) (while (ignore-errors (setq var (read (current-buffer)))) @@ -2356,7 +2355,8 @@ See also `emacs-lisp-byte-compile-and-load'." (let ((gen-dynvars (getenv "EMACS_GENERATE_DYNVARS"))) (when (and gen-dynvars (not (equal gen-dynvars "")) byte-compile--seen-defvars) - (let ((dynvar-file (concat target-file ".dynvars"))) + (let ((dynvar-file (concat target-file ".dynvars")) + (print-symbols-bare t)) (message "Generating %s" dynvar-file) (with-temp-buffer (dolist (var (delete-dups byte-compile--seen-defvars)) @@ -3584,7 +3584,7 @@ This assumes the function has the `important-return-value' property." (cl-nsubst 3) (cl-nsubst-if 3) (cl-nsubst-if-not 3) (cl-nsubstitute 3) (cl-nsubstitute-if 3) (cl-nsubstitute-if-not 3) (cl-nsublis 2) - (cl-nunion 1 2) (cl-nintersection 1 2) (cl-nset-difference 1 2) + (cl-nunion 1 2) (cl-nintersection 1) (cl-nset-difference 1) (cl-nset-exclusive-or 1 2) (cl-nreconc 1) (cl-sort 1) (cl-stable-sort 1) (cl-merge 2 3) @@ -5276,11 +5276,11 @@ FORM is used to provide location, `bytecomp--cus-function' and (and tl (progn (bytecomp--cus-warn - tl "misplaced %s keyword in `%s' type" (car tl) head) + tl "misplaced %S keyword in `%S' type" (car tl) head) t)))))) ((memq head '(choice radio)) (unless tail - (bytecomp--cus-warn type "`%s' without any types inside" head)) + (bytecomp--cus-warn type "`%S' without any types inside" head)) (let ((clauses tail) (constants nil) (tags nil)) @@ -5288,7 +5288,7 @@ FORM is used to provide location, `bytecomp--cus-function' and (let* ((ty (car clauses)) (ty-head (car-safe ty))) (when (and (eq ty-head 'other) (cdr clauses)) - (bytecomp--cus-warn ty "`other' not last in `%s'" head)) + (bytecomp--cus-warn ty "`other' not last in `%S'" head)) (when (memq ty-head '(const other)) (let ((ty-tail (cdr ty)) (val nil)) @@ -5300,13 +5300,13 @@ FORM is used to provide location, `bytecomp--cus-function' and (setq val (car ty-tail))) (when (member val constants) (bytecomp--cus-warn - ty "duplicated value in `%s': `%S'" head val)) + ty "duplicated value in `%S': `%S'" head val)) (push val constants))) (let ((tag (and (consp ty) (plist-get (cdr ty) :tag)))) (when (stringp tag) (when (member tag tags) (bytecomp--cus-warn - ty "duplicated :tag string in `%s': %S" head tag)) + ty "duplicated :tag string in `%S': %S" head tag)) (push tag tags))) (bytecomp--check-cus-type ty)) (setq clauses (cdr clauses))))) @@ -5318,7 +5318,7 @@ FORM is used to provide location, `bytecomp--cus-function' and (bytecomp--check-cus-type ty))) ((memq head '(list group vector set repeat)) (unless tail - (bytecomp--cus-warn type "`%s' without type specs" head)) + (bytecomp--cus-warn type "`%S' without type specs" head)) (dolist (ty tail) (bytecomp--check-cus-type ty))) ((memq head '(alist plist)) @@ -5334,21 +5334,21 @@ FORM is used to provide location, `bytecomp--cus-function' and (val (car tail))) (cond ((or (> n 1) (and value-tag tail)) - (bytecomp--cus-warn type "`%s' with too many values" head)) + (bytecomp--cus-warn type "`%S' with too many values" head)) (value-tag (setq val (cadr value-tag))) ;; ;; This is a useful check but it results in perhaps ;; ;; a bit too many complaints. ;; ((null tail) ;; (bytecomp--cus-warn - ;; type "`%s' without value is implicitly nil" head)) + ;; type "`%S' without value is implicitly nil" head)) ) (when (memq (car-safe val) '(quote function)) - (bytecomp--cus-warn type "`%s' with quoted value: %S" head val)))) + (bytecomp--cus-warn type "`%S' with quoted value: %S" head val)))) ((eq head 'quote) - (bytecomp--cus-warn type "type should not be quoted: %s" (cadr type))) + (bytecomp--cus-warn type "type should not be quoted: %S" (cadr type))) ((memq head invalid-types) - (bytecomp--cus-warn type "`%s' is not a valid type" head)) + (bytecomp--cus-warn type "`%S' is not a valid type" head)) ((or (not (symbolp head)) (keywordp head)) (bytecomp--cus-warn type "irregular type `%S'" head)) ))) @@ -5356,9 +5356,9 @@ FORM is used to provide location, `bytecomp--cus-function' and (bytecomp--cus-warn type "irregular type `%S'" type)) ((memq type '( list cons group vector choice radio const other function-item variable-item set repeat restricted-sexp)) - (bytecomp--cus-warn type "`%s' without arguments" type)) + (bytecomp--cus-warn type "`%S' without arguments" type)) ((memq type invalid-types) - (bytecomp--cus-warn type "`%s' is not a valid type" type)) + (bytecomp--cus-warn type "`%S' is not a valid type" type)) ))) (defun bytecomp--check-cus-face-spec (spec) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 96260c3aff8..09470457d93 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -69,6 +69,7 @@ TYPE is a Common Lisp type specifier. This is like `equal', except that it accepts numerically equal numbers of different types (float vs. integer), and also compares strings case-insensitively." + (declare (side-effect-free error-free)) (cond ((eq x y) t) ((stringp x) (and (stringp y) (string-equal-ignore-case x y))) @@ -126,10 +127,11 @@ strings case-insensitively." (and acc (nreverse cl-res))))) ;;;###autoload -(defun cl-map (cl-type cl-func cl-seq &rest cl-rest) +(defsubst cl-map (cl-type cl-func cl-seq &rest cl-rest) "Map a FUNCTION across one or more SEQUENCEs, returning a sequence. TYPE is the sequence type to return. \n(fn TYPE FUNCTION SEQUENCE...)" + (declare (important-return-value t)) (let ((cl-res (apply #'cl-mapcar cl-func cl-seq cl-rest))) (and cl-type (cl-coerce cl-res cl-type)))) @@ -139,6 +141,7 @@ TYPE is the sequence type to return. Like `cl-mapcar', except applies to lists and their cdr's rather than to the elements themselves. \n(fn FUNCTION LIST...)" + (declare (important-return-value t)) (if cl-rest (let ((cl-res nil) (cl-args (cons cl-list (copy-sequence cl-rest))) @@ -188,6 +191,7 @@ the elements themselves. (defun cl-mapcan (cl-func cl-seq &rest cl-rest) "Like `cl-mapcar', but nconc's together the values returned by the function. \n(fn FUNCTION SEQUENCE...)" + (declare (important-return-value t)) (if cl-rest (apply #'nconc (apply #'cl-mapcar cl-func cl-seq cl-rest)) (mapcan cl-func cl-seq))) @@ -196,6 +200,7 @@ the elements themselves. (defun cl-mapcon (cl-func cl-list &rest cl-rest) "Like `cl-maplist', but nconc's together the values returned by the function. \n(fn FUNCTION LIST...)" + (declare (important-return-value t)) (apply #'nconc (apply #'cl-maplist cl-func cl-list cl-rest))) ;;;###autoload @@ -206,6 +211,7 @@ same as the first return value of PREDICATE where PREDICATE has a non-nil value. \n(fn PREDICATE SEQ...)" + (declare (important-return-value t)) (if (or cl-rest (nlistp cl-seq)) (catch 'cl-some (apply #'cl-map nil @@ -221,6 +227,7 @@ non-nil value. (defun cl-every (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is true of every element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" + (declare (important-return-value t)) (if (or cl-rest (nlistp cl-seq)) (catch 'cl-every (apply #'cl-map nil @@ -232,15 +239,17 @@ non-nil value. (null cl-seq))) ;;;###autoload -(defun cl-notany (cl-pred cl-seq &rest cl-rest) +(defsubst cl-notany (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of every element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" + (declare (important-return-value t)) (not (apply #'cl-some cl-pred cl-seq cl-rest))) ;;;###autoload -(defun cl-notevery (cl-pred cl-seq &rest cl-rest) +(defsubst cl-notevery (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of some element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" + (declare (important-return-value t)) (not (apply #'cl-every cl-pred cl-seq cl-rest))) ;;;###autoload @@ -317,6 +326,7 @@ non-nil value. ;;;###autoload (defun cl-gcd (&rest args) "Return the greatest common divisor of the arguments." + (declare (side-effect-free t)) (let ((a (or (pop args) 0))) (dolist (b args) (while (/= b 0) @@ -326,6 +336,7 @@ non-nil value. ;;;###autoload (defun cl-lcm (&rest args) "Return the least common multiple of the arguments." + (declare (side-effect-free t)) (if (memq 0 args) 0 (let ((a (or (pop args) 1))) @@ -336,6 +347,7 @@ non-nil value. ;;;###autoload (defun cl-isqrt (x) "Return the integer square root of the (integer) argument X." + (declare (side-effect-free t)) (if (and (integerp x) (> x 0)) (let ((g (ash 2 (/ (logb x) 2))) g2) @@ -348,6 +360,7 @@ non-nil value. (defun cl-floor (x &optional y) "Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient." + (declare (side-effect-free t)) (let ((q (floor x y))) (list q (- x (if y (* y q) q))))) @@ -355,6 +368,7 @@ With two arguments, return floor and remainder of their quotient." (defun cl-ceiling (x &optional y) "Return a list of the ceiling of X and the fractional part of X. With two arguments, return ceiling and remainder of their quotient." + (declare (side-effect-free t)) (let ((res (cl-floor x y))) (if (= (car (cdr res)) 0) res (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) @@ -363,6 +377,7 @@ With two arguments, return ceiling and remainder of their quotient." (defun cl-truncate (x &optional y) "Return a list of the integer part of X and the fractional part of X. With two arguments, return truncation and remainder of their quotient." + (declare (side-effect-free t)) (if (eq (>= x 0) (or (null y) (>= y 0))) (cl-floor x y) (cl-ceiling x y))) @@ -370,6 +385,7 @@ With two arguments, return truncation and remainder of their quotient." (defun cl-round (x &optional y) "Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient." + (declare (side-effect-free t)) (if y (if (and (integerp x) (integerp y)) (let* ((hy (/ y 2)) @@ -388,16 +404,19 @@ With two arguments, return rounding and remainder of their quotient." ;;;###autoload (defun cl-mod (x y) "The remainder of X divided by Y, with the same sign as Y." + (declare (side-effect-free t)) (nth 1 (cl-floor x y))) ;;;###autoload (defun cl-rem (x y) "The remainder of X divided by Y, with the same sign as X." + (declare (side-effect-free t)) (nth 1 (cl-truncate x y))) ;;;###autoload (defun cl-signum (x) "Return 1 if X is positive, -1 if negative, 0 if zero." + (declare (side-effect-free t)) (cond ((> x 0) 1) ((< x 0) -1) (t 0))) ;;;###autoload @@ -441,12 +460,13 @@ as an integer unless JUNK-ALLOWED is non-nil." ;; Random numbers. (defun cl--random-time () - "Return high-precision timestamp from `time-convert'. + "Return high-precision timestamp from `time-convert'. For example, suitable for use as seed by `cl-make-random-state'." - (car (time-convert nil t))) + (car (time-convert nil t))) ;;;###autoload (autoload 'cl-random-state-p "cl-extra") +;;;###autoload (function-put 'cl-random-state-p 'side-effect-free 'error-free) (cl-defstruct (cl--random-state (:copier nil) (:predicate cl-random-state-p) @@ -549,7 +569,8 @@ If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end. Signal an error if START or END are outside of the sequence (i.e too large if positive or too small if negative)." - (declare (gv-setter + (declare (side-effect-free t) + (gv-setter (lambda (new) (macroexp-let2 nil new new `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) @@ -568,19 +589,21 @@ too large if positive or too small if negative)." ;;; List functions. ;;;###autoload -(defun cl-revappend (x y) +(defsubst cl-revappend (x y) "Equivalent to (append (reverse X) Y)." (declare (side-effect-free t)) (nconc (reverse x) y)) ;;;###autoload -(defun cl-nreconc (x y) +(defsubst cl-nreconc (x y) "Equivalent to (nconc (nreverse X) Y)." + (declare (important-return-value t)) (nconc (nreverse x) y)) ;;;###autoload (defun cl-list-length (x) "Return the length of list X. Return nil if list is circular." + (declare (side-effect-free t)) (cl-check-type x list) (condition-case nil (length x) @@ -599,7 +622,8 @@ too large if positive or too small if negative)." (defun cl-get (sym tag &optional def) "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. \n(fn SYMBOL PROPNAME &optional DEFAULT)" - (declare (compiler-macro cl--compiler-macro-get) + (declare (side-effect-free t) + (compiler-macro cl--compiler-macro-get) (gv-setter (lambda (store) (ignore def) `(put ,sym ,tag ,store)))) (cl-getf (symbol-plist sym) tag def)) (autoload 'cl--compiler-macro-get "cl-macs") @@ -609,7 +633,8 @@ too large if positive or too small if negative)." "Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'. \n(fn PROPLIST PROPNAME &optional DEFAULT)" - (declare (gv-expander + (declare (side-effect-free t) + (gv-expander (lambda (do) (gv-letplace (getter setter) plist (macroexp-let2* nil ((k tag) (d def)) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 3f7ca28d2bb..dba01b28325 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -185,8 +185,8 @@ to an element already in the list stored in PLACE. ;;; Blocks and exits. -(defalias 'cl--block-wrapper 'identity) -(defalias 'cl--block-throw 'throw) +(defalias 'cl--block-wrapper #'identity) +(defalias 'cl--block-throw #'throw) ;;; Multiple values. @@ -232,7 +232,7 @@ right when EXPRESSION calls an ordinary Emacs Lisp function that returns just one value." (apply function expression)) -(defalias 'cl-multiple-value-call 'apply +(defalias 'cl-multiple-value-call #'apply "Apply FUNCTION to ARGUMENTS, taking multiple values into account. This implementation only handles the case where there is only one argument.") @@ -272,18 +272,24 @@ so that they are registered at compile-time as well as run-time." (defsubst cl-plusp (number) "Return t if NUMBER is positive." + (declare (side-effect-free t)) (> number 0)) (defsubst cl-minusp (number) "Return t if NUMBER is negative." + (declare (side-effect-free t)) (< number 0)) (defun cl-oddp (integer) "Return t if INTEGER is odd." + (declare (side-effect-free t) + (compiler-macro (lambda (_) `(eq (logand ,integer 1) 1)))) (eq (logand integer 1) 1)) (defun cl-evenp (integer) "Return t if INTEGER is even." + (declare (side-effect-free t) + (compiler-macro (lambda (_) `(eq (logand ,integer 1) 0)))) (eq (logand integer 1) 0)) (defconst cl-digit-char-table @@ -352,7 +358,7 @@ Call `cl-float-limits' to set this.") ;;; Sequence functions. -(cl--defalias 'cl-copy-seq 'copy-sequence) +(cl--defalias 'cl-copy-seq #'copy-sequence) (declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs &optional acc)) @@ -363,6 +369,7 @@ and mapping stops as soon as the shortest list runs out. With just one SEQ, this is like `mapcar'. With several, it is like the Common Lisp `mapcar' function extended to arbitrary sequence types. \n(fn FUNCTION SEQ...)" + (declare (important-return-value t)) (if cl-rest (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) (cl--mapcar-many cl-func (cons cl-x cl-rest) 'accumulate) @@ -372,71 +379,77 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp (nreverse cl-res))) (mapcar cl-func cl-x))) -(cl--defalias 'cl-svref 'aref) +(cl--defalias 'cl-svref #'aref) ;;; List functions. -(cl--defalias 'cl-first 'car) -(cl--defalias 'cl-second 'cadr) -(cl--defalias 'cl-rest 'cdr) +(cl--defalias 'cl-first #'car) +(cl--defalias 'cl-second #'cadr) +(cl--defalias 'cl-rest #'cdr) (cl--defalias 'cl-third #'caddr "Return the third element of the list X.") (cl--defalias 'cl-fourth #'cadddr "Return the fourth element of the list X.") (defsubst cl-fifth (x) "Return the fifth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 4 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 4 ,x) ,store)))) (nth 4 x)) (defsubst cl-sixth (x) "Return the sixth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 5 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 5 ,x) ,store)))) (nth 5 x)) (defsubst cl-seventh (x) "Return the seventh element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 6 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 6 ,x) ,store)))) (nth 6 x)) (defsubst cl-eighth (x) "Return the eighth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 7 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 7 ,x) ,store)))) (nth 7 x)) (defsubst cl-ninth (x) "Return the ninth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 8 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 8 ,x) ,store)))) (nth 8 x)) (defsubst cl-tenth (x) "Return the tenth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) (nth 9 x)) -(defalias 'cl-caaar 'caaar) -(defalias 'cl-caadr 'caadr) -(defalias 'cl-cadar 'cadar) -(defalias 'cl-caddr 'caddr) -(defalias 'cl-cdaar 'cdaar) -(defalias 'cl-cdadr 'cdadr) -(defalias 'cl-cddar 'cddar) -(defalias 'cl-cdddr 'cdddr) -(defalias 'cl-caaaar 'caaaar) -(defalias 'cl-caaadr 'caaadr) -(defalias 'cl-caadar 'caadar) -(defalias 'cl-caaddr 'caaddr) -(defalias 'cl-cadaar 'cadaar) -(defalias 'cl-cadadr 'cadadr) -(defalias 'cl-caddar 'caddar) -(defalias 'cl-cadddr 'cadddr) -(defalias 'cl-cdaaar 'cdaaar) -(defalias 'cl-cdaadr 'cdaadr) -(defalias 'cl-cdadar 'cdadar) -(defalias 'cl-cdaddr 'cdaddr) -(defalias 'cl-cddaar 'cddaar) -(defalias 'cl-cddadr 'cddadr) -(defalias 'cl-cdddar 'cdddar) -(defalias 'cl-cddddr 'cddddr) +(defalias 'cl-caaar #'caaar) +(defalias 'cl-caadr #'caadr) +(defalias 'cl-cadar #'cadar) +(defalias 'cl-caddr #'caddr) +(defalias 'cl-cdaar #'cdaar) +(defalias 'cl-cdadr #'cdadr) +(defalias 'cl-cddar #'cddar) +(defalias 'cl-cdddr #'cdddr) +(defalias 'cl-caaaar #'caaaar) +(defalias 'cl-caaadr #'caaadr) +(defalias 'cl-caadar #'caadar) +(defalias 'cl-caaddr #'caaddr) +(defalias 'cl-cadaar #'cadaar) +(defalias 'cl-cadadr #'cadadr) +(defalias 'cl-caddar #'caddar) +(defalias 'cl-cadddr #'cadddr) +(defalias 'cl-cdaaar #'cdaaar) +(defalias 'cl-cdaadr #'cdaadr) +(defalias 'cl-cdadar #'cdadar) +(defalias 'cl-cdaddr #'cdaddr) +(defalias 'cl-cddaar #'cddaar) +(defalias 'cl-cddadr #'cddadr) +(defalias 'cl-cdddar #'cdddar) +(defalias 'cl-cddddr #'cddddr) ;;(defun last* (x &optional n) ;; "Returns the last link in the list LIST. @@ -454,7 +467,8 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to `(cons A (cons B (cons C D)))'. \n(fn ARG...)" - (declare (compiler-macro cl--compiler-macro-list*)) + (declare (side-effect-free error-free) + (compiler-macro cl--compiler-macro-list*)) (cond ((not rest) arg) ((not (cdr rest)) (cons arg (car rest))) (t (let* ((n (length rest)) @@ -465,6 +479,7 @@ Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to (defun cl-ldiff (list sublist) "Return a copy of LIST with the tail SUBLIST removed." + (declare (side-effect-free t)) (let ((res nil)) (while (and (consp list) (not (eq list sublist))) (push (pop list) res)) @@ -492,7 +507,8 @@ The elements of LIST are not copied, just the list structure itself." Otherwise, return LIST unmodified. \nKeywords supported: :test :test-not :key \n(fn ITEM LIST [KEYWORD VALUE]...)" - (declare (compiler-macro cl--compiler-macro-adjoin)) + (declare (important-return-value t) + (compiler-macro cl--compiler-macro-adjoin)) (cond ((or (equal cl-keys '(:test eq)) (and (null cl-keys) (not (numberp cl-item)))) (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) @@ -505,6 +521,7 @@ Otherwise, return LIST unmodified. Return a copy of TREE with all elements `eql' to OLD replaced by NEW. \nKeywords supported: :test :test-not :key \n(fn NEW OLD TREE [KEYWORD VALUE]...)" + (declare (important-return-value t)) (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old)))) (apply 'cl-sublis (list (cons cl-old cl-new)) cl-tree cl-keys) (cl--do-subst cl-new cl-old cl-tree))) @@ -518,9 +535,10 @@ Return a copy of TREE with all elements `eql' to OLD replaced by NEW. cl-tree (cons a d)))) (t cl-tree))) -(defun cl-acons (key value alist) +(defsubst cl-acons (key value alist) "Add KEY and VALUE to ALIST. Return a new list with (cons KEY VALUE) as car and ALIST as cdr." + (declare (side-effect-free error-free)) (cons (cons key value) alist)) (defun cl-pairlis (keys values &optional alist) @@ -528,6 +546,7 @@ Return a new list with (cons KEY VALUE) as car and ALIST as cdr." Return a new alist composed by associating KEYS to corresponding VALUES; the process stops as soon as KEYS or VALUES run out. If ALIST is non-nil, the new pairs are prepended to it." + (declare (side-effect-free t)) (nconc (cl-mapcar 'cons keys values) alist)) ;;; Miscellaneous. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 7559c58e77a..caaffcf19be 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -70,9 +70,6 @@ (setq form `(cons ,(car args) ,form))) form)) -;; Note: `cl--compiler-macro-cXXr' has been copied to -;; `internal--compiler-macro-cXXr' in subr.el. If you amend either -;; one, you may want to amend the other, too. ;;;###autoload (define-obsolete-function-alias 'cl--compiler-macro-cXXr #'internal--compiler-macro-cXXr "25.1") @@ -3728,74 +3725,6 @@ macro that returns its `&whole' argument." `(cl-getf (symbol-plist ,sym) ,prop ,def) `(get ,sym ,prop))) -(dolist (y '(cl-first cl-second cl-third cl-fourth - cl-fifth cl-sixth cl-seventh - cl-eighth cl-ninth cl-tenth - cl-rest cl-endp cl-plusp cl-minusp - cl-caaar cl-caadr cl-cadar - cl-caddr cl-cdaar cl-cdadr - cl-cddar cl-cdddr cl-caaaar - cl-caaadr cl-caadar cl-caaddr - cl-cadaar cl-cadadr cl-caddar - cl-cadddr cl-cdaaar cl-cdaadr - cl-cdadar cl-cdaddr cl-cddaar - cl-cddadr cl-cdddar cl-cddddr)) - (put y 'side-effect-free t)) - -;;; Things that are inline. -(cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend - cl-nreconc)) - -;;; Things that are side-effect-free. -(mapc (lambda (x) (function-put x 'side-effect-free t)) - '(cl-oddp cl-evenp cl-signum cl-ldiff cl-pairlis cl-gcd - cl-lcm cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem - cl-subseq cl-list-length cl-get cl-getf)) - -;;; Things that are side-effect-and-error-free. -(mapc (lambda (x) (function-put x 'side-effect-free 'error-free)) - '(cl-list* cl-acons cl-equalp - cl-random-state-p copy-tree)) - -;;; Things whose return value should probably be used. -(mapc (lambda (x) (function-put x 'important-return-value t)) - '( - ;; Functions that are side-effect-free except for the - ;; behavior of functions passed as argument. - cl-mapcar cl-mapcan cl-maplist cl-map cl-mapcon - cl-reduce - cl-assoc cl-assoc-if cl-assoc-if-not - cl-rassoc cl-rassoc-if cl-rassoc-if-not - cl-member cl-member-if cl-member-if-not - cl-adjoin - cl-mismatch cl-search - cl-find cl-find-if cl-find-if-not - cl-position cl-position-if cl-position-if-not - cl-count cl-count-if cl-count-if-not - cl-remove cl-remove-if cl-remove-if-not - cl-remove-duplicates - cl-subst cl-subst-if cl-subst-if-not - cl-substitute cl-substitute-if cl-substitute-if-not - cl-sublis - cl-union cl-intersection cl-set-difference cl-set-exclusive-or - cl-subsetp - cl-every cl-some cl-notevery cl-notany - cl-tree-equal - - ;; Functions that mutate and return a list. - cl-delete cl-delete-if cl-delete-if-not - cl-delete-duplicates - cl-nsubst cl-nsubst-if cl-nsubst-if-not - cl-nsubstitute cl-nsubstitute-if cl-nsubstitute-if-not - cl-nunion cl-nintersection cl-nset-difference cl-nset-exclusive-or - cl-nreconc cl-nsublis - cl-merge - ;; It's safe to ignore the value of `cl-sort' and `cl-stable-sort' - ;; when used on arrays, but most calls pass lists. - cl-sort cl-stable-sort - )) - - ;;; Types and assertions. ;;;###autoload diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 7a79488f1f5..651de6c4d47 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -115,6 +115,7 @@ (defun cl-endp (x) "Return true if X is the empty list; false if it is a cons. Signal an error if X is not a list." + (declare (side-effect-free t)) (cl-check-type x list) (null x)) @@ -144,6 +145,7 @@ the SEQ moving forward, and the order of arguments to the FUNCTION is also reversed. \n(fn FUNCTION SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) () (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) (setq cl-seq (cl-subseq cl-seq cl-start cl-end)) @@ -234,6 +236,7 @@ This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. \nKeywords supported: :test :test-not :key :count :start :end :from-end \n(fn ITEM SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end (:start 0) :end) () (let ((len (length cl-seq))) @@ -281,6 +284,7 @@ This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. \nKeywords supported: :key :count :start :end :from-end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-remove nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -290,6 +294,7 @@ This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. \nKeywords supported: :key :count :start :end :from-end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-remove nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -298,6 +303,7 @@ to avoid corrupting the original SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. \nKeywords supported: :test :test-not :key :count :start :end :from-end \n(fn ITEM SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end (:start 0) :end) () (let ((len (length cl-seq))) @@ -343,6 +349,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible. \nKeywords supported: :key :count :start :end :from-end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-delete nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -351,6 +358,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible. \nKeywords supported: :key :count :start :end :from-end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-delete nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -358,6 +366,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. "Return a copy of SEQ with all duplicate elements removed. \nKeywords supported: :test :test-not :key :start :end :from-end \n(fn SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--delete-duplicates cl-seq cl-keys t)) ;;;###autoload @@ -365,6 +374,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. "Remove all duplicate elements from SEQ (destructively). \nKeywords supported: :test :test-not :key :start :end :from-end \n(fn SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--delete-duplicates cl-seq cl-keys nil)) (defun cl--delete-duplicates (cl-seq cl-keys cl-copy) @@ -416,6 +426,7 @@ This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. \nKeywords supported: :test :test-not :key :count :start :end :from-end \n(fn NEW OLD SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :if :if-not :count (:start 0) :end :from-end) () (if (or (eq cl-old cl-new) @@ -440,6 +451,7 @@ This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. \nKeywords supported: :key :count :start :end :from-end \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-substitute cl-new nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -449,6 +461,7 @@ This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. \nKeywords supported: :key :count :start :end :from-end \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-substitute cl-new nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -457,6 +470,7 @@ to avoid corrupting the original SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. \nKeywords supported: :test :test-not :key :count :start :end :from-end \n(fn NEW OLD SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :if :if-not :count (:start 0) :end :from-end) () (let* ((cl-seq (if (stringp seq) (string-to-vector seq) seq)) @@ -493,6 +507,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible. \nKeywords supported: :key :count :start :end :from-end \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-nsubstitute cl-new nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -501,6 +516,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible. \nKeywords supported: :key :count :start :end :from-end \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -509,6 +525,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. Return the matching ITEM, or nil if not found. \nKeywords supported: :test :test-not :key :start :end :from-end \n(fn ITEM SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (let ((cl-pos (apply 'cl-position cl-item cl-seq cl-keys))) (and cl-pos (elt cl-seq cl-pos)))) @@ -518,6 +535,7 @@ Return the matching ITEM, or nil if not found. Return the matching item, or nil if not found. \nKeywords supported: :key :start :end :from-end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-find nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -526,6 +544,7 @@ Return the matching item, or nil if not found. Return the matching item, or nil if not found. \nKeywords supported: :key :start :end :from-end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-find nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -534,6 +553,7 @@ Return the matching item, or nil if not found. Return the index of the matching item, or nil if not found. \nKeywords supported: :test :test-not :key :start :end :from-end \n(fn ITEM SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end :from-end) () (cl--position cl-item cl-seq cl-start cl-end cl-from-end))) @@ -564,6 +584,7 @@ Return the index of the matching item, or nil if not found. Return the index of the matching item, or nil if not found. \nKeywords supported: :key :start :end :from-end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-position nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -572,6 +593,7 @@ Return the index of the matching item, or nil if not found. Return the index of the matching item, or nil if not found. \nKeywords supported: :key :start :end :from-end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-position nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -579,6 +601,7 @@ Return the index of the matching item, or nil if not found. "Count the number of occurrences of ITEM in SEQ. \nKeywords supported: :test :test-not :key :start :end \n(fn ITEM SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () (let ((cl-count 0) cl-x) (or cl-end (setq cl-end (length cl-seq))) @@ -594,6 +617,7 @@ Return the index of the matching item, or nil if not found. "Count the number of items satisfying PREDICATE in SEQ. \nKeywords supported: :key :start :end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-count nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -601,6 +625,7 @@ Return the index of the matching item, or nil if not found. "Count the number of items not satisfying PREDICATE in SEQ. \nKeywords supported: :key :start :end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-count nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -610,6 +635,7 @@ Return nil if the sequences match. If one sequence is a prefix of the other, the return value indicates the end of the shorter sequence. \nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :from-end (:start1 0) :end1 (:start2 0) :end2) () (or cl-end1 (setq cl-end1 (length cl-seq1))) @@ -641,6 +667,7 @@ Return the index of the leftmost element of the first match found; return nil if there are no matches. \nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :from-end (:start1 0) :end1 (:start2 0) :end2) () (or cl-end1 (setq cl-end1 (length cl-seq1))) @@ -667,6 +694,9 @@ return nil if there are no matches. This is a destructive function; it reuses the storage of SEQ if possible. \nKeywords supported: :key \n(fn SEQ PREDICATE [KEYWORD VALUE]...)" + ;; It's safe to ignore the return value when used on arrays, + ;; but most calls pass lists. + (declare (important-return-value t)) (if (nlistp cl-seq) (if (stringp cl-seq) (concat (apply #'cl-sort (vconcat cl-seq) cl-pred cl-keys)) @@ -685,6 +715,9 @@ This is a destructive function; it reuses the storage of SEQ if possible. This is a destructive function; it reuses the storage of SEQ if possible. \nKeywords supported: :key \n(fn SEQ PREDICATE [KEYWORD VALUE]...)" + ;; It's safe to ignore the return value when used on arrays, + ;; but most calls pass lists. + (declare (important-return-value t)) (apply 'cl-sort cl-seq cl-pred cl-keys)) ;;;###autoload @@ -694,6 +727,7 @@ TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument sequences, and PREDICATE is a `less-than' predicate on the elements. \nKeywords supported: :key \n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)" + (declare (important-return-value t)) (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) (cl--parsing-keywords (:key) () @@ -711,7 +745,8 @@ sequences, and PREDICATE is a `less-than' predicate on the elements. Return the sublist of LIST whose car is ITEM. \nKeywords supported: :test :test-not :key \n(fn ITEM LIST [KEYWORD VALUE]...)" - (declare (compiler-macro cl--compiler-macro-member)) + (declare (important-return-value t) + (compiler-macro cl--compiler-macro-member)) (if cl-keys (cl--parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-list (not (cl--check-test cl-item (car cl-list)))) @@ -726,6 +761,7 @@ Return the sublist of LIST whose car is ITEM. Return the sublist of LIST whose car matches. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-member nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -734,6 +770,7 @@ Return the sublist of LIST whose car matches. Return the sublist of LIST whose car matches. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-member nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -748,7 +785,8 @@ Return the sublist of LIST whose car matches. "Find the first item whose car matches ITEM in LIST. \nKeywords supported: :test :test-not :key \n(fn ITEM LIST [KEYWORD VALUE]...)" - (declare (compiler-macro cl--compiler-macro-assoc)) + (declare (important-return-value t) + (compiler-macro cl--compiler-macro-assoc)) (if cl-keys (cl--parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-alist @@ -766,6 +804,7 @@ Return the sublist of LIST whose car matches. "Find the first item whose car satisfies PREDICATE in LIST. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-assoc nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -773,6 +812,7 @@ Return the sublist of LIST whose car matches. "Find the first item whose car does not satisfy PREDICATE in LIST. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-assoc nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -780,6 +820,7 @@ Return the sublist of LIST whose car matches. "Find the first item whose cdr matches ITEM in LIST. \nKeywords supported: :test :test-not :key \n(fn ITEM LIST [KEYWORD VALUE]...)" + (declare (important-return-value t)) (if (or cl-keys (numberp cl-item)) (cl--parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-alist @@ -794,6 +835,7 @@ Return the sublist of LIST whose car matches. "Find the first item whose cdr satisfies PREDICATE in LIST. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-rassoc nil cl-list :if cl-pred cl-keys)) ;;;###autoload @@ -801,6 +843,7 @@ Return the sublist of LIST whose car matches. "Find the first item whose cdr does not satisfy PREDICATE in LIST. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-rassoc nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload @@ -811,6 +854,7 @@ This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) ((and (not cl-keys) (equal cl-list1 cl-list2)) cl-list1) (t @@ -833,6 +877,7 @@ This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) (t (apply 'cl-union cl-list1 cl-list2 cl-keys)))) @@ -844,6 +889,7 @@ This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (and cl-list1 cl-list2 (if (equal cl-list1 cl-list2) cl-list1 (cl--parsing-keywords (:key) (:test :test-not) @@ -863,10 +909,11 @@ to avoid corrupting the original LIST1 and LIST2. (defun cl-nintersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. The resulting list contains all items that appear in both LIST1 and LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. +This is a destructive function; it reuses the storage of LIST1 (but not +LIST2) whenever possible. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (and cl-list1 cl-list2 (apply 'cl-intersection cl-list1 cl-list2 cl-keys))) ;;;###autoload @@ -877,6 +924,7 @@ This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (if (or (null cl-list1) (null cl-list2)) cl-list1 (cl--parsing-keywords (:key) (:test :test-not) (let ((cl-res nil)) @@ -893,10 +941,11 @@ to avoid corrupting the original LIST1 and LIST2. (defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. The resulting list contains all items that appear in LIST1 but not LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. +This is a destructive function; it reuses the storage of LIST1 (but not +LIST2) whenever possible. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (if (or (null cl-list1) (null cl-list2)) cl-list1 (apply 'cl-set-difference cl-list1 cl-list2 cl-keys))) @@ -908,6 +957,7 @@ This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) ((equal cl-list1 cl-list2) nil) (t (append (apply 'cl-set-difference cl-list1 cl-list2 cl-keys) @@ -921,6 +971,7 @@ This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) ((equal cl-list1 cl-list2) nil) (t (nconc (apply 'cl-nset-difference cl-list1 cl-list2 cl-keys) @@ -932,6 +983,7 @@ whenever possible. I.e., if every element of LIST1 also appears in LIST2. \nKeywords supported: :test :test-not :key \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cond ((null cl-list1) t) ((null cl-list2) nil) ((equal cl-list1 cl-list2) t) (t (cl--parsing-keywords (:key) (:test :test-not) @@ -947,6 +999,7 @@ I.e., if every element of LIST1 also appears in LIST2. Return a copy of TREE with all matching elements replaced by NEW. \nKeywords supported: :key \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) ;;;###autoload @@ -955,6 +1008,7 @@ Return a copy of TREE with all matching elements replaced by NEW. Return a copy of TREE with all non-matching elements replaced by NEW. \nKeywords supported: :key \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) ;;;###autoload @@ -964,6 +1018,7 @@ Any element of TREE which is `eql' to OLD is changed to NEW (via a call to `setcar'). \nKeywords supported: :test :test-not :key \n(fn NEW OLD TREE [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) ;;;###autoload @@ -972,6 +1027,7 @@ to `setcar'). Any element of TREE which matches is changed to NEW (via a call to `setcar'). \nKeywords supported: :key \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) ;;;###autoload @@ -980,6 +1036,7 @@ Any element of TREE which matches is changed to NEW (via a call to `setcar'). Any element of TREE which matches is changed to NEW (via a call to `setcar'). \nKeywords supported: :key \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" + (declare (important-return-value t)) (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) (defvar cl--alist) @@ -990,6 +1047,7 @@ Any element of TREE which matches is changed to NEW (via a call to `setcar'). Return a copy of TREE with all matching elements replaced. \nKeywords supported: :test :test-not :key \n(fn ALIST TREE [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :if :if-not) () (let ((cl--alist cl-alist)) (cl--sublis-rec cl-tree)))) @@ -1013,6 +1071,7 @@ Return a copy of TREE with all matching elements replaced. Any matching element of TREE is changed via a call to `setcar'. \nKeywords supported: :test :test-not :key \n(fn ALIST TREE [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key :if :if-not) () (let ((cl-hold (list cl-tree)) (cl--alist cl-alist)) @@ -1039,6 +1098,7 @@ Any matching element of TREE is changed via a call to `setcar'. Atoms are compared by `eql'; cons cells are compared recursively. \nKeywords supported: :test :test-not :key \n(fn TREE1 TREE2 [KEYWORD VALUE]...)" + (declare (important-return-value t)) (cl--parsing-keywords (:test :test-not :key) () (cl--tree-equal-rec cl-x cl-y))) diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 454c3e85074..676252ae126 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -79,9 +79,25 @@ (define-obsolete-variable-alias 'crm-default-separator 'crm-separator "29.1") -(defvar crm-separator "[ \t]*,[ \t]*" +(defvar crm-separator + (propertize "[ \t]*,[ \t]*" 'separator "," 'description "comma-separated list") "Separator regexp used for separating strings in `completing-read-multiple'. -It should be a regexp that does not match the list of completion candidates.") +It should be a regexp that does not match the list of completion +candidates. The regexp string can carry the text properties `separator' +and `description', which if present `completing-read-multiple' will show +as part of the prompt. See the user option `crm-prompt'.") + +(defcustom crm-prompt "[%d] %p" + "Prompt format for `completing-read-multiple'. +The prompt is formatted by `format-spec' with the keys %d, %s and %p +standing for the separator description, the separator itself and the +original prompt respectively." + :type '(choice (const :tag "Original prompt" "%p") + (const :tag "Description and prompt" "[%d] %p") + (const :tag "Short CRM indication" "[CRM%s] %p") + (string :tag "Custom string")) + :group 'minibuffer + :version "31.1") (defvar-keymap crm-local-completion-map :doc "Local keymap for minibuffer multiple input with completion. @@ -251,29 +267,29 @@ with empty strings removed." (setq-local minibuffer-completion-table #'crm--collection-fn) (setq-local minibuffer-completion-predicate predicate) (setq-local completion-list-insert-choice-function - (lambda (start end choice) - (if (and (stringp start) (stringp end)) - (let* ((beg (save-excursion - (goto-char (minibuffer-prompt-end)) - (or (search-forward start nil t) - (search-forward-regexp crm-separator nil t) - (minibuffer-prompt-end)))) - (end (save-excursion - (goto-char (point-max)) - (or (search-backward end nil t) - (progn - (goto-char beg) - (search-forward-regexp crm-separator nil t)) - (point-max))))) - (completion--replace beg end choice)) - (completion--replace start end choice)))) + (lambda (_start _end choice) + (let* ((beg (save-excursion + (if (search-backward-regexp crm-separator nil t) + (1+ (point)) + (minibuffer-prompt-end)))) + (end (save-excursion + (if (search-forward-regexp crm-separator nil t) + (1- (point)) + (point-max))))) + (completion--replace beg end choice)))) ;; see completing_read in src/minibuf.c (setq-local minibuffer-completion-confirm (unless (eq require-match t) require-match)) (setq-local crm-completion-table table)) (setq input (read-from-minibuffer - prompt initial-input map - nil hist def inherit-input-method))) + (format-spec + crm-prompt + (let* ((sep (or (get-text-property 0 'separator crm-separator) + (string-replace "[ \t]*" "" crm-separator))) + (desc (or (get-text-property 0 'description crm-separator) + (concat "list separated by " sep)))) + `((?s . ,sep) (?d . ,desc) (?p . ,prompt)))) + initial-input map nil hist def inherit-input-method))) ;; If the user enters empty input, `read-from-minibuffer' ;; returns the empty string, not DEF. (when (and def (string-equal input "")) diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 2acd1b8d2e4..5ae665a57fb 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -111,7 +111,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." ))))))) ;;; Augment the Data debug thing display list. -(data-debug-add-specialized-thing (lambda (thing) (eieio-object-p thing)) +(data-debug-add-specialized-thing #'eieio-object-p #'data-debug-insert-object-button) ;;; DEBUG METHODS diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 475433bb221..1fa177b08da 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -58,6 +58,7 @@ ;;; Defining a new class ;; +;;;###autoload (defmacro defclass (name superclasses slots &rest options-and-doc) "Define NAME as a new class derived from SUPERCLASS with SLOTS. OPTIONS-AND-DOC is used as the class' options and base documentation. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 5d9230fa3cf..5d1b9f2acbb 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2856,7 +2856,7 @@ To be used in the ERT results buffer." (ert--tests-running-mode-line-indicator)))) (add-hook 'emacs-lisp-mode-hook #'ert--activate-font-lock-keywords) -(defun ert--unload-function () +(defun ert-unload-function () "Unload function to undo the side-effects of loading ert.el." (ert--remove-from-list 'find-function-regexp-alist 'ert--test :key #'car) (ert--remove-from-list 'minor-mode-alist 'ert--current-run-stats :key #'car) @@ -2864,6 +2864,8 @@ To be used in the ERT results buffer." 'ert--activate-font-lock-keywords) nil) +;;; erts files. + (defun ert-test-erts-file (file &optional transform) "Parse FILE as a file containing before/after parts (an erts file). @@ -2990,9 +2992,6 @@ write erts files." (forward-line 1))) (nreverse specs)))) -(defvar ert-unload-hook ()) -(add-hook 'ert-unload-hook #'ert--unload-function) - ;;; Obsolete (define-obsolete-function-alias 'ert-equal-including-properties @@ -3000,6 +2999,8 @@ write erts files." (put 'ert-equal-including-properties 'ert-explainer 'ert--explain-equal-including-properties) +(define-obsolete-function-alias 'ert--unload-function 'ert-unload-function "31.1") + (provide 'ert) ;;; ert.el ends here diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index 239a4ad69eb..b79c2e51de9 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -146,6 +146,12 @@ the variables of the outer one. You can, however, access alists inside the original alist by using dots inside the symbol, as displayed in the example above. +To refer to a non-`let-alist' variable starting with a dot in BODY, use +two dots instead of one. For example, in the following form `..foo' +refers to the variable `.foo' bound outside of the `let-alist': + + (let ((.foo 42)) (let-alist \\='((foo . nil)) ..foo)) + Note that there is no way to differentiate the case where a key is missing from when it is present, but its value is nil. Thus, the following form evaluates to nil: diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 6b50bee6fbb..111d512ef59 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -468,6 +468,13 @@ package version (a string)." (lm--prepare-package-dependencies (package-read-from-string (mapconcat #'identity require-lines " ")))))) +(defun lm-package-version (&optional file) + "Return \"Package-Version\" or \"Version\" header. +Prefer Package-Version; if defined, the package author +probably wants us to use it. Otherwise try Version." + (lm-with-file file + (or (lm-header "package-version") (lm-header "version")))) + (defun lm-package-needs-footer-line (&optional file) "Return non-nil if package in current buffer needs a footer line. @@ -661,8 +668,6 @@ which do not include a recognizable synopsis." (lm-summary)) (when must-kill (kill-buffer (current-buffer)))))))) -(defvar report-emacs-bug-address) - (defun lm-report-bug (topic) "Report a bug in the package currently being visited to its maintainer. Prompts for bug subject TOPIC. Leaves you in a mail buffer." diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 3b1d34bf7cd..9bed4374dff 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -559,7 +559,9 @@ This will generate compile-time constants from BINDINGS." (,(concat "(" cl-errs-re "\\_>") (1 font-lock-warning-face)) ;; Words inside ‘’ and `' tend to be symbol names. - (,(concat "[`‘]\\(" (rx lisp-mode-symbol) "\\)['’]") + (,(concat "[`‘]\\(" + (rx (* lisp-mode-symbol (+ space)) lisp-mode-symbol) + "\\)['’]") (1 font-lock-constant-face prepend)) ;; Uninterned symbols, e.g., (defpackage #:my-package ...) ;; must come before keywords below to have effect @@ -1431,16 +1433,17 @@ Any non-integer value means do not use a different value of :group 'lisp :version "30.1") -(defvar lisp-fill-paragraph-as-displayed nil - "Modify the behavior of `lisp-fill-paragraph'. +(defvar lisp-fill-paragraphs-as-doc-string t + "Whether `lisp-fill-paragraph' should fill strings as ELisp doc strings. The default behavior of `lisp-fill-paragraph' is tuned for filling Emacs Lisp doc strings, with their special treatment for the first line. -Particularly, strings are filled in a narrowed context to avoid filling +Specifically, strings are filled in a narrowed context to avoid filling surrounding code, which means any leading indent is disregarded, which can cause the filled string to extend passed the configured `fill-column' variable value. If you would rather fill the string in -its original context and ensure the `fill-column' value is more strictly -respected, set this variable to true. Doing so makes +its original context, disregarding the special conventions of ELisp doc +strings, and want to ensure the `fill-column' value is more strictly +respected, set this variable to nil. Doing so makes `lisp-fill-paragraph' behave as it used to in Emacs 27 and prior versions.") @@ -1506,7 +1509,7 @@ and initial semicolons." ;; code. (if (not string-start) (lisp--fill-line-simple) - (unless lisp-fill-paragraph-as-displayed + (when lisp-fill-paragraphs-as-doc-string ;; If we're in a string, then narrow (roughly) to that ;; string before filling. This avoids filling Lisp ;; statements that follow the string. diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 14cbbfda033..18277b60fb8 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -185,7 +185,12 @@ The function's value is the number of actions taken." (let ((overriding-text-conversion-style nil)) (when (fboundp 'set-text-conversion-style) (set-text-conversion-style text-conversion-style)) - (setq char (read-event))) + ;; Do NOT use read-event here. That + ;; function does not consult + ;; input-decode-map (bug#75886). + (setq char (read-key)) + (when (eq char ?\C-g) + (signal 'quit nil))) (when (fboundp 'set-text-conversion-style) (set-text-conversion-style text-conversion-style))) ;; Show the answer to the question. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b29e0a5f564..5239c8c34a1 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1168,11 +1168,11 @@ Signal an error if the entire string was not used." (declare-function lm-header "lisp-mnt" (header)) (declare-function lm-package-requires "lisp-mnt" (&optional file)) +(declare-function lm-package-version "lisp-mnt" (&optional file)) (declare-function lm-website "lisp-mnt" (&optional file)) (declare-function lm-keywords-list "lisp-mnt" (&optional file)) (declare-function lm-maintainers "lisp-mnt" (&optional file)) (declare-function lm-authors "lisp-mnt" (&optional file)) -(declare-function lm-package-needs-footer-line "lisp-mnt" (&optional file)) (defun package-buffer-info () "Return a `package-desc' describing the package in the current buffer. @@ -1184,32 +1184,16 @@ boundaries." (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t) (error "Package lacks a file header")) (let ((file-name (match-string-no-properties 1)) - (desc (match-string-no-properties 2)) - (start (line-beginning-position))) + (desc (match-string-no-properties 2))) (require 'lisp-mnt) - ;; This warning was added in Emacs 27.1, and should be removed at - ;; the earliest in version 31.1. The idea is to phase out the - ;; requirement for a "footer line" without unduly impacting users - ;; on earlier Emacs versions. See Bug#26490 for more details. - (unless (search-forward (concat ";;; " file-name ".el ends here") nil 'move) - (when (lm-package-needs-footer-line) - (lwarn '(package package-format) :warning - "Package lacks a terminating comment"))) - ;; Try to include a trailing newline. - (forward-line) - (narrow-to-region start (point)) - ;; Use some headers we've invented to drive the process. - (let* (;; Prefer Package-Version; if defined, the package author - ;; probably wants us to use it. Otherwise try Version. - (version-info - (or (lm-header "package-version") (lm-header "version"))) + (let* ((version-info (lm-package-version)) (pkg-version (package-strip-rcs-id version-info)) (keywords (lm-keywords-list)) (website (lm-website))) (unless pkg-version - (if version-info - (error "Unrecognized package version: %s" version-info) - (error "Package lacks a \"Version\" or \"Package-Version\" header"))) + (if version-info + (error "Unrecognized package version: %s" version-info) + (error "Package lacks a \"Version\" or \"Package-Version\" header"))) (package-desc-from-define file-name pkg-version desc (lm-package-requires) @@ -1858,8 +1842,11 @@ For each archive configured in the variable `package-archives', inform Emacs about the latest versions of all packages it offers, and make them available for download. Optional argument ASYNC specifies whether to perform the -downloads in the background." - (interactive) +downloads in the background. This is always the case when the command +is invoked interactively." + (interactive (list t)) + (when async + (message "Refreshing package contents...")) (unless (file-exists-p package-user-dir) (make-directory package-user-dir t)) (let ((default-keyring (expand-file-name "package-keyring.gpg" @@ -4559,10 +4546,7 @@ the `Version:' header." (unless (file-readable-p mainfile) (setq mainfile file)) (when (file-readable-p mainfile) (require 'lisp-mnt) - (with-temp-buffer - (insert-file-contents mainfile) - (or (lm-header "package-version") - (lm-header "version"))))))))) + (lm-package-version mainfile))))))) ;;;; Quickstart: precompute activation actions for faster start up. diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 27e5d6c612b..158c1e857cc 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -191,7 +191,7 @@ Usage example: (format "%s (%s): " prompt - (mapconcat (lambda (e) (cdr e)) altered-names ", "))) + (mapconcat #'cdr altered-names ", "))) tchar buf wrong-char answer command) (save-window-excursion (save-excursion @@ -216,8 +216,14 @@ Usage example: (car elem))) prompt-choices))) (condition-case nil - (let ((cursor-in-echo-area t)) - (read-event)) + (let ((cursor-in-echo-area t) + ;; Do NOT use read-event here. That + ;; function does not consult + ;; input-decode-map (bug#75886). + (key (read-key))) + (when (eq key ?\C-g) + (signal 'quit nil)) + key) (error nil)))) (if (memq (car-safe tchar) '(touchscreen-begin touchscreen-end diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 25c9ad7c859..125314fa814 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -372,7 +372,9 @@ and re-enable the TRACKER corresponding to ID." track-changes--state)) ;; Nothing to do. nil) - (cl-assert (not (memq id track-changes--clean-trackers))) + ;; ID may still be in `track-changes--clean-trackers' if + ;; `after-change-functions' was skipped. + ;;(cl-assert (not (memq id track-changes--clean-trackers))) (cl-assert (<= (point-min) beg end (point-max))) ;; Update the tracker's state *before* running `func' so we don't risk ;; mistakenly replaying the changes in case `func' exits non-locally. diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 56c4085804b..baee1a6965f 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -699,10 +699,29 @@ Repeating prefix key when region is active works as a single prefix key." (interactive) (cua--prefix-override-replay 0)) -;; These aliases are so that we can look up the commands and find the -;; correct keys when generating menus. -(defalias 'cua-cut-handler #'cua--prefix-override-handler) -(defalias 'cua-copy-handler #'cua--prefix-override-handler) +;; These two functions are so that we can look up the commands and find the +;; correct keys when generating menus. Also, when cua--prefix-override-handler +;; is nil, allow C-x C-c to cut/copy immediately without waiting for +;; cua--prefix-override-timer to expire. +(declare-function cua-cut-to-global-mark "cua-gmrk") +(declare-function cua-copy-to-global-mark "cua-gmrk") +(defun cua--copy-or-cut-handler (&optional cut) + (if (or (not (numberp cua-prefix-override-inhibit-delay)) + (<= cua-prefix-override-inhibit-delay 0)) + (cond ((and (bound-and-true-p cua--global-mark-active)) + (funcall (if cut #'cua-cut-to-global-mark + #'cua-copy-to-global-mark))) + (t (call-interactively (if cut #'kill-region + #'copy-region-as-kill)))) + (cua--prefix-override-handler))) + +(defun cua-cut-handler () + (interactive) + (cua--copy-or-cut-handler t)) + +(defun cua-copy-handler () + (interactive) + (cua--copy-or-cut-handler)) (defun cua--prefix-repeat-handler () "Repeating prefix key when region is active works as a single prefix key." diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index cfd0d3415ea..24a3205e0cd 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -372,7 +372,9 @@ than the indicator's position." "Buffer-local `keep-place' with fringe arrow and/or highlighted face. Play nice with global module `keep-place' but don't depend on it. Expect that users may want different combinations of `keep-place' -and `keep-place-indicator' in different buffers." +and `keep-place-indicator' in different buffers. + +This module is local to individual buffers." ((cond (erc-keep-place-mode) ((memq 'keep-place erc-modules) (erc-keep-place-mode +1)) @@ -589,7 +591,9 @@ message's speaker." Skip those appearing in `erc-noncommands-list'. Users can run \\[erc-command-indicator-toggle-hidden] to hide and -reveal echoed command lines after they've been inserted." +reveal echoed command lines after they've been inserted. + +This module is local to individual buffers." ((add-hook 'erc--input-review-functions #'erc--command-indicator-permit-insertion 80 t) (erc-command-indicator-toggle-hidden -1)) diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index b0629f7754c..a3e9b1f7b46 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -541,7 +541,9 @@ Abandon search after examining LIMIT faces." nick-object) (define-erc-module nicks nil - "Uniquely colorize nicknames in target buffers." + "Uniquely colorize nicknames in target buffers. + +This module is local per connection." ((if erc--target (progn (erc-with-server-buffer diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 82754cb1989..1e04c90177e 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -299,7 +299,8 @@ like `nickbar', to provide UI feedback when changes occur. Once ERC implements the `monitor' extension, this module will serve as an optional fallback for keeping query-participant rolls up to date on servers that lack support or are stingy with their allotments. Until -such time, this module should be considered experimental. +such time, this module should be considered experimental and only really +useful for bots and other non-interactive Lisp programs. This is a local ERC module, so selectively polling only a subset of query targets is possible but cumbersome. To do so, ensure @@ -307,7 +308,8 @@ query targets is possible but cumbersome. To do so, ensure as appropriate in desired query buffers. To stop polling for the current connection, toggle off the command \\[erc-querypoll-mode] from a server buffer, or run \\`M-x C-u erc-querypoll-disable RET' from a -target buffer." +target buffer. Note that this module's minor mode must remain active in +at least the server buffer." ((if erc--target (if (erc-query-buffer-p) (progn ; accommodate those who eschew `erc-modules' diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index a16f554f2d1..5228fc5e5aa 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -34,13 +34,6 @@ ;; ;; - Implement a proxy mechanism that chooses the strongest available ;; mechanism for you. Requires CAP 3.2 (see bug#49860). -;; -;; - Integrate with whatever solution ERC eventually settles on to -;; handle user options for different network contexts. At the -;; moment, this does its own thing for stashing and restoring -;; session options, but ERC should make abstractions available for -;; all local modules to use, possibly based on connection-local -;; variables. ;;; Code: (require 'erc) @@ -315,9 +308,10 @@ If necessary, pass PROMPT to `read-passwd'." (define-erc-module sasl nil "Non-IRCv3 SASL support for ERC. -This doesn't solicit or validate a suite of supported mechanisms." - ;; See bug#49860 for a CAP 3.2-aware WIP implementation. - ((unless erc--target +This local module only enables its minor mode in server buffers, and it +doesn't currently solicit or validate supported mechanisms." + ((if erc--target + (erc-sasl-mode -1) (setq erc-sasl--state (make-erc-sasl--state)) ;; If the previous attempt failed during registration, this may be ;; non-nil and contain erroneous values, but how can we detect that? diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index d16aa8c54d8..25da873076e 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -548,6 +548,9 @@ for details and use cases." (function-item erc-services-issue-ghost-and-retry-nick) function))) +(defvar erc-services-regain-timeout-seconds 5 + "Seconds after which to run callbacks if necessary.") + (defun erc-services-retry-nick-on-connect (want) "Try at most once to grab nickname WANT after reconnecting. Expect to be used when automatically reconnecting to servers @@ -608,10 +611,12 @@ consider its main option, `erc-services-regain-alist': In practical terms, this means that this module, which is still somewhat experimental, is likely only useful in conjunction with -SASL authentication rather than the traditional approach provided -by the `services' module it shares a library with (see Info -node `(erc) SASL' for more)." - nil nil localp) +SASL authentication or CertFP rather than the traditional approach +provided by the `services' module it shares a library with (see Info +node `(erc) SASL' for more). + +This local module's minor mode is only active in server buffers." + ((when erc--target (erc-services-regain-mode -1))) nil localp) (cl-defmethod erc--nickname-in-use-make-request ((want string) temp &context (erc-server-connected null) @@ -632,11 +637,21 @@ one." (funcall found want)))) (on-900 (lambda (_ parsed) + (cancel-timer timer) (remove-hook 'erc-server-900-functions on-900 t) - (unless erc-server-connected - (when (equal (car (erc-response.command-args parsed)) temp) - (add-hook 'erc-after-connect after-connect nil t))) - nil))) + (unless (equal want (erc-current-nick)) + (if erc-server-connected + (funcall after-connect nil temp) + (when (or (eq parsed 'forcep) + (equal (car (erc-response.command-args parsed)) temp)) + (add-hook 'erc-after-connect after-connect nil t)))) + nil)) + (timer (run-at-time erc-services-regain-timeout-seconds + nil (lambda (buffer) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (funcall on-900 nil 'forcep)))) + (current-buffer)))) (add-hook 'erc-server-900-functions on-900 nil t)) (cl-call-next-method)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 72335a444cb..0d72b46360e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1272,10 +1272,11 @@ particular sessions and/or `let'-bound for spells." :group 'erc) (defcustom erc-mode-hook nil - "Hook run after `erc-mode' setup is finished." + "Hook run after `erc-mode' setup is finished. +Members should be robust enough to run in any order and not depend on +hook depth." :group 'erc-hooks - :type 'hook - :options '(erc-add-scroll-to-bottom)) + :type 'hook) (defcustom erc-timer-hook nil "Abnormal hook run after each response handler. @@ -2661,7 +2662,9 @@ side effect of setting the current buffer to the one it returns. Use (erc--initialize-markers old-point continued-session) (erc-determine-parameters server port nick full-name user passwd) (save-excursion (run-mode-hooks) - (dolist (mod (car delayed-modules)) (funcall mod +1)) + (dolist (mod (car delayed-modules)) + (unless (and (boundp mod) (symbol-value mod)) + (funcall mod +1))) (dolist (var (cdr delayed-modules)) (set var nil))) ;; Saving log file on exit diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 754c17a1926..845fc5a3b3d 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -122,7 +122,7 @@ The format of each entry is (?e . (lambda (lst) (mapcar #'file-name-extension lst))) (?t . (lambda (lst) (mapcar #'file-name-nondirectory lst))) (?q . #'identity) ; Obsolete as of Emacs 31.1. - (?u . (lambda (lst) (seq-uniq lst))) + (?u . #'seq-uniq) (?o . (lambda (lst) (sort lst #'string-lessp))) (?O . (lambda (lst) (sort lst #'string-greaterp))) (?j . (eshell-join-members)) diff --git a/lisp/faces.el b/lisp/faces.el index 5fe3ab1a294..dd8c24f5001 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1137,19 +1137,30 @@ returned. Otherwise, DEFAULT is returned verbatim." (let ((prompt (if default (format-prompt prompt default) (format "%s: " prompt))) - aliasfaces nonaliasfaces faces) + aliasfaces nonaliasfaces table) ;; Build up the completion tables. (mapatoms (lambda (s) (if (facep s) (if (get s 'face-alias) (push (symbol-name s) aliasfaces) (push (symbol-name s) nonaliasfaces))))) + (setq table + (completion-table-with-metadata + (completion-table-in-turn nonaliasfaces aliasfaces) + `((affixation-function + . ,(lambda (faces) + (mapcar + (lambda (face) + (list face + (concat (propertize read-face-name-sample-text + 'face face) + "\t") + "")) + faces)))))) (if multiple - (progn - (dolist (face (completing-read-multiple - prompt - (completion-table-in-turn nonaliasfaces aliasfaces) - nil t nil 'face-name-history default)) + (let (faces) + (dolist (face (completing-read-multiple prompt table nil t nil + 'face-name-history default)) ;; Ignore elements that are not faces ;; (for example, because DEFAULT was "all faces") (if (facep face) (push (if (stringp face) @@ -1157,21 +1168,8 @@ returned. Otherwise, DEFAULT is returned verbatim." face) faces))) (nreverse faces)) - (let ((face (completing-read - prompt - (completion-table-with-metadata - (completion-table-in-turn nonaliasfaces aliasfaces) - `((affixation-function - . ,(lambda (faces) - (mapcar - (lambda (face) - (list face - (concat (propertize read-face-name-sample-text - 'face face) - "\t") - "")) - faces))))) - nil t nil 'face-name-history defaults))) + (let ((face (completing-read prompt table nil t nil + 'face-name-history defaults))) (when (facep face) (if (stringp face) (intern face) face))))))) diff --git a/lisp/files.el b/lisp/files.el index 5ff40c335d7..bf05939ebeb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -721,11 +721,12 @@ enabled (for example, when it is added to a mode hook). Each element of the list should be a string: - If it ends in \"/\", it is considered as a directory name and means that Emacs should trust all the files whose name has this directory as a prefix. -- else it is considered as a file name. +- Otherwise, it is considered a file name. Use abbreviated file names. For example, an entry \"~/mycode/\" means that Emacs will trust all the files in your directory \"mycode\". This variable can also be set to `:all', in which case Emacs will trust -all files, which opens a gaping security hole." +all files, which opens a gaping security hole. Emacs Lisp authors +should note that this value must never be set by a major or minor mode." :type '(choice (repeat :tag "List" file) (const :tag "Trust everything (DANGEROUS!)" :all)) :version "30.1") @@ -874,28 +875,43 @@ See Info node `(elisp)Standard File Names' for more details." (dos-convert-standard-filename filename)) (t filename))) -(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial) +(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial predicate) "Read directory name, prompting with PROMPT and completing in directory DIR. -Value is not expanded---you must call `expand-file-name' yourself. -Default name to DEFAULT-DIRNAME if user exits with the same -non-empty string that was inserted by this function. +The return value is not expanded---you must call `expand-file-name' +yourself. + +DIR is the directory to use for completing relative file names. +It should be an absolute directory name, or nil (which means the +current buffer's value of `default-directory'). + +DEFAULT-DIRNAME specifies the default directory name to return if user +exits with the same non-empty string that was inserted by this function. (If DEFAULT-DIRNAME is omitted, DIR combined with INITIAL is used, or just DIR if INITIAL is nil.) -If the user exits with an empty minibuffer, this function returns -an empty string. (This can happen only if the user erased the -pre-inserted contents or if `insert-default-directory' is nil.) -Fourth arg MUSTMATCH non-nil means require existing directory's name. - Non-nil and non-t means also require confirmation after completion. + +If the user exits with an empty minibuffer, return an empty +string. (This can happen only if the user erased the pre-inserted +contents or if `insert-default-directory' is nil.) + +Fourth arg MUSTMATCH, is like for `read-file-name', which see. + Fifth arg INITIAL specifies text to start with. -DIR should be an absolute directory name. It defaults to -the value of `default-directory'." + +Sixth arg PREDICATE, if non-nil, should be a function of one +argument; then a directory is considered an acceptable completion +alternative only if PREDICATE returns non-nil with the file name +as its argument." (unless dir (setq dir default-directory)) (read-file-name prompt dir (or default-dirname (if initial (expand-file-name initial dir) dir)) mustmatch initial - 'file-directory-p)) + (if predicate + (lambda (filename) + (and (file-directory-p filename) + (funcall predicate filename))) + #'file-directory-p))) (defun pwd (&optional insert) @@ -2954,13 +2970,13 @@ the local variables spec." (let ((enable-local-variables (or (not find-file) enable-local-variables))) ;; FIXME this is less efficient than it could be, since both ;; s-a-m and h-l-v may parse the same regions, looking for "mode:". - (with-demoted-errors "File mode specification error: %s" + (with-demoted-errors "File mode specification error: %S" (set-auto-mode)) ;; `delay-mode-hooks' being non-nil will have prevented the major ;; mode's call to `run-mode-hooks' from calling ;; `hack-local-variables'. In that case, call it now. (when delay-mode-hooks - (with-demoted-errors "File local-variables error: %s" + (with-demoted-errors "File local-variables error: %S" (hack-local-variables 'no-mode)))) ;; Turn font lock off and on, to make sure it takes account of ;; whatever file local variables are relevant to it. @@ -3453,27 +3469,37 @@ Also applies to `magic-fallback-mode-alist'.") If CASE-INSENSITIVE, the file system of file NAME is case-insensitive." (let (mode) (while name - (setq mode - (if case-insensitive - ;; Filesystem is case-insensitive. - (let ((case-fold-search t)) + (let ((newmode + (if case-insensitive + ;; Filesystem is case-insensitive. + (let ((case-fold-search t)) + (assoc-default name alist 'string-match)) + ;; Filesystem is case-sensitive. + (or + ;; First match case-sensitively. + (let ((case-fold-search nil)) (assoc-default name alist 'string-match)) - ;; Filesystem is case-sensitive. - (or - ;; First match case-sensitively. - (let ((case-fold-search nil)) - (assoc-default name alist 'string-match)) - ;; Fallback to case-insensitive match. - (and auto-mode-case-fold - (let ((case-fold-search t)) - (assoc-default name alist 'string-match)))))) - (if (and mode - (not (functionp mode)) - (consp mode) - (cadr mode)) - (setq mode (car mode) - name (substring name 0 (match-beginning 0))) - (setq name nil))) + ;; Fallback to case-insensitive match. + (and auto-mode-case-fold + (let ((case-fold-search t)) + (assoc-default name alist 'string-match))))))) + (when newmode + (when mode + ;; We had already found a mode but in a (REGEXP MODE t) + ;; entry, so we still have to run MODE. Let's do it now. + ;; FIXME: It's kind of ugly to run the function here. + ;; An alternative could be to return a list of functions and + ;; callers. + (set-auto-mode-0 mode t)) + (setq mode newmode)) + (if (and newmode + (not (functionp newmode)) + (consp newmode) + (cadr newmode)) + ;; It's a (REGEXP MODE t): Keep looking but remember the MODE. + (setq mode (car newmode) + name (substring name 0 (match-beginning 0))) + (setq name nil)))) mode)) (defun set-auto-mode--apply-alist (alist keep-mode-if-same dir-local) @@ -3501,7 +3527,7 @@ extra checks should be done." alist name case-insensitive-p)) (when (and dir-local mode (not (set-auto-mode--dir-local-valid-p mode))) - (message "Ignoring invalid mode `%s'" mode) + (message "Ignoring invalid mode `%S'" mode) (setq mode nil)) (when mode (set-auto-mode-0 mode keep-mode-if-same) diff --git a/lisp/frame.el b/lisp/frame.el index a55fcb41ce1..e66270130d2 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2543,6 +2543,10 @@ details depend on the platform and environment. The `source' attribute describes the source from which the information was obtained. On X, this may be one of: \"Gdk\", \"XRandR 1.5\", \"XRandr\", \"Xinerama\", or \"fallback\". +If it is \"fallback\", it means Emacs was built without GTK +and without XrandR or Xinerama extensions, in which case the +information about multiple physical monitors will be provided +as if they all as a whole formed a single monitor. A frame is dominated by a physical monitor when either the largest area of the frame resides in the monitor, or the monitor diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 89982f0b1ca..5b16e82fc48 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -981,11 +981,11 @@ be controlled by `gnus-treat-body-boundary'." "/usr/share/picons") "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please -see http://www.cs.indiana.edu/picons/ftp/index.html" +see https://kinzler.com/ftp/faces/picons/" :version "22.1" :type '(repeat directory) :link '(url-link :tag "download" - "http://www.cs.indiana.edu/picons/ftp/index.html") + "https://kinzler.com/ftp/faces/picons/") :link '(custom-manual "(gnus)Picons") :group 'gnus-picon) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index b9af1ec93bb..59c5d7bb891 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -502,7 +502,7 @@ Returns the list of articles removed." (file-name-coding-system nnmail-pathname-coding-system)) (when (file-exists-p dir) (setq articles - (sort (mapcar (lambda (name) (string-to-number name)) + (sort (mapcar #'string-to-number (directory-files dir nil "\\`[0-9]+\\'" t)) #'<)) ;; Update the cache active file, just to synch more. diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index ce27fc404ac..1b296cbcffc 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -136,10 +136,8 @@ filenames." ;; warn if user tries to attach without any files marked (if (null files-to-attach) (error "No files to attach") - (setq files-str - (mapconcat - (lambda (f) (file-name-nondirectory f)) - files-to-attach ", ")) + (setq files-str (mapconcat #'file-name-nondirectory + files-to-attach ", ")) (setq bufs (gnus-dired-mail-buffers)) ;; set up destination mail composition buffer diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index c4c1c649e1e..0d7282d73da 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -1174,7 +1174,7 @@ non-nil." (defun gnus-registry-clear () "Clear the registry." - (gnus-registry-unload-hook) + (gnus-registry-unload-function) (setq gnus-registry-db nil)) (gnus-add-shutdown 'gnus-registry-clear 'gnus) @@ -1198,7 +1198,7 @@ non-nil." (add-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)) -(defun gnus-registry-unload-hook () +(defun gnus-registry-unload-function () "Uninstall the registry hooks." (remove-hook 'gnus-summary-article-move-hook #'gnus-registry-action) (remove-hook 'gnus-summary-article-delete-hook #'gnus-registry-action) @@ -1208,9 +1208,8 @@ non-nil." (remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save) (remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load) - (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)) - -(add-hook 'gnus-registry-unload-hook #'gnus-registry-clear) + (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids) + nil) (defun gnus-registry-install-p () "Return non-nil if the registry is enabled (and maybe enable it first). @@ -1297,6 +1296,9 @@ from your existing entries." (gnus-registry-insert db k newv))) (registry-reindex db)))) +(define-obsolete-function-alias 'gnus-registry-unload-hook + #'gnus-registry-unload-function "31.1") + (provide 'gnus-registry) ;;; gnus-registry.el ends here diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index ba5edd4bdc1..0551ca2676d 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -119,11 +119,11 @@ the `a' symbolic prefix to the score commands will always use (function-item gnus-score-find-hierarchical) (function-item gnus-score-find-bnews) (repeat :tag "List of functions" - (choice (function :tag "Other" :value 'ignore) + (choice (function :tag "Other" :value ignore) (function-item gnus-score-find-single) (function-item gnus-score-find-hierarchical) (function-item gnus-score-find-bnews))) - (function :tag "Other" :value 'ignore))) + (function :tag "Other" :value ignore))) (defcustom gnus-score-interactive-default-score 1000 "Scoring commands will raise/lower the score with this number as the default." diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 3099f95ebd3..756e28ebda5 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -757,16 +757,23 @@ be used directly.") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") +(defcustom gnus-logo-colors nil + "Colors used for the Gnus logo." + :set-after '(gnus-logo-color-style) + :type '(choice (const :tag "Use default" nil) + (list color color)) + :group 'gnus-xmas) + (defcustom gnus-logo-color-style 'ma "Color styles used for the Gnus logo." :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) gnus-logo-color-alist)) + :set (lambda (sym val) + (set-default-toplevel-value sym val) + (set-default-toplevel-value 'gnus-logo-colors + (cdr (assq val gnus-logo-color-alist)))) :group 'gnus-xmas) -(defvar gnus-logo-colors - (cdr (assq gnus-logo-color-style gnus-logo-color-alist)) - "Colors used for the Gnus logo.") - (defvar image-load-path) (declare-function image-size "image.c" (spec &optional pixels frame)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index b552b211eb8..dede5520d66 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -113,6 +113,13 @@ :group 'message :group 'faces) +(defcustom message-header-use-obsolete-in-reply-to nil + "Include extra information in the In-Reply-To header. +This form has been obsolete since RFC 2822." + :group 'message-headers + :version "31.1" + :type 'boolean) + (defcustom message-directory "~/Mail/" "Directory from which all other mail file variables are derived." :group 'message-various @@ -305,11 +312,20 @@ any confusion." regexp)) (defcustom message-subject-re-regexp - "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)* ?:[ \t]*\\)*[ \t]*" - "Regexp matching \"Re: \" in the subject line." + (mail--wrap-re-regexp + (concat + "\\(" + (string-join mail-re-regexps "\\|") + "\\)")) + "Regexp matching \"Re: \" in the subject line. +Matching is done case-insensitively. +Initialized from the value of `mail-re-regexps', which is easier to +customize." :group 'message-various :link '(custom-manual "(message)Message Headers") - :type 'regexp) + :type 'regexp + :set-after '(mail-re-regexps) + :version "31.1") (defcustom message-screenshot-command '("import" "png:-") "Command to take a screenshot. @@ -2257,10 +2273,12 @@ see `message-narrow-to-headers-or-head'." subject))) (defun message-strip-subject-re (subject) - "Remove \"Re:\" from subject lines in string SUBJECT." - (if (string-match message-subject-re-regexp subject) - (substring subject (match-end 0)) - subject)) + "Remove \"Re:\" from subject lines in string SUBJECT. +This uses `mail-re-regexps', matching is done case-insensitively." + (let ((case-fold-search t)) + (if (string-match message-subject-re-regexp subject) + (substring subject (match-end 0)) + subject))) (defcustom message-replacement-char "." "Replacement character used instead of unprintable or not decodable chars." @@ -2965,33 +2983,38 @@ Consider adding this function to `message-header-setup-hook'" "M-n" #'message-display-abbrev) -(easy-menu-define - message-mode-menu message-mode-map "Message Menu." +(easy-menu-define message-mode-menu message-mode-map + "Message Menu." '("Message" - ["Yank Original" message-yank-original message-reply-buffer] - ["Fill Yanked Message" message-fill-yanked-message t] - ["Insert Signature" message-insert-signature t] - ["Caesar (rot13) Message" message-caesar-buffer-body t] - ["Caesar (rot13) Region" message-caesar-region mark-active] + ["Yank Original" message-yank-original + :active message-reply-buffer] + ["Fill Yanked Message" message-fill-yanked-message] + ["Insert Signature" message-insert-signature] + ["Caesar (rot13) Message" message-caesar-buffer-body] + ["Caesar (rot13) Region" message-caesar-region + :active mark-active] ["Elide Region" message-elide-region :active mark-active :help "Replace text in region with an ellipsis"] ["Delete Outside Region" message-delete-not-region :active mark-active :help "Delete all quoted text outside region"] - ["Kill To Signature" message-kill-to-signature t] - ["Newline and Reformat" message-newline-and-reformat t] - ["Rename buffer" message-rename-buffer t] - ["Spellcheck" ispell-message :help "Spellcheck this message"] + ["Kill To Signature" message-kill-to-signature] + ["Newline and Reformat" message-newline-and-reformat] + ["Rename buffer" message-rename-buffer] + ["Spellcheck" ispell-message + :help "Spellcheck this message"] "----" ["Insert Region Marked" message-mark-inserted-region - :active mark-active :help "Mark region with enclosing tags"] + :active mark-active + :help "Mark region with enclosing tags"] ["Insert File Marked..." message-mark-insert-file :help "Insert file at point marked with enclosing tags"] - ["Attach File..." mml-attach-file t] - ["Insert Screenshot" message-insert-screenshot t] + ["Attach File..." mml-attach-file] + ["Insert Screenshot" message-insert-screenshot] "----" - ["Send Message" message-send-and-exit :help "Send this message"] + ["Send Message" message-send-and-exit + :help "Send this message"] ["Postpone Message" message-dont-send :help "File this draft message and exit"] ["Send at Specific Time..." gnus-delay-article @@ -2999,38 +3022,37 @@ Consider adding this function to `message-header-setup-hook'" ["Kill Message" message-kill-buffer :help "Delete this message without sending"] "----" - ["Message manual" message-info :help "Display the Message manual"])) + ["Message manual" message-info + :help "Display the Message manual"])) -(easy-menu-define - message-mode-field-menu message-mode-map "" +(easy-menu-define message-mode-field-menu message-mode-map + "Field Menu." '("Field" - ["To" message-goto-to t] - ["From" message-goto-from t] - ["Subject" message-goto-subject t] - ["Change subject..." message-change-subject t] - ["Cc" message-goto-cc t] - ["Bcc" message-goto-bcc t] - ["Fcc" message-goto-fcc t] - ["Reply-To" message-goto-reply-to t] + ["To" message-goto-to] + ["From" message-goto-from] + ["Subject" message-goto-subject] + ["Change subject..." message-change-subject] + ["Cc" message-goto-cc] + ["Bcc" message-goto-bcc] + ["Fcc" message-goto-fcc] + ["Reply-To" message-goto-reply-to] ["Flag As Important" message-insert-importance-high :help "Mark this message as important"] ["Flag As Unimportant" message-insert-importance-low :help "Mark this message as unimportant"] - ["Request Receipt" - message-insert-disposition-notification-to + ["Request Receipt" message-insert-disposition-notification-to :help "Request a receipt notification"] "----" ;; (typical) news stuff - ["Summary" message-goto-summary t] - ["Keywords" message-goto-keywords t] - ["Newsgroups" message-goto-newsgroups t] - ["Fetch Newsgroups" message-insert-newsgroups t] - ["Followup-To" message-goto-followup-to t] - ;; ["Followup-To (with note in body)" message-cross-post-followup-to t] - ["Crosspost / Followup-To..." message-cross-post-followup-to t] - ["Distribution" message-goto-distribution t] - ["Expires" message-insert-expires t ] - ["X-No-Archive" message-add-archive-header t ] + ["Summary" message-goto-summary] + ["Keywords" message-goto-keywords] + ["Newsgroups" message-goto-newsgroups] + ["Fetch Newsgroups" message-insert-newsgroups] + ["Followup-To" message-goto-followup-to] + ["Crosspost / Followup-To..." message-cross-post-followup-to] + ["Distribution" message-goto-distribution] + ["Expires" message-insert-expires] + ["X-No-Archive" message-add-archive-header] "----" ;; (typical) mailing-lists stuff ["Fetch To" message-insert-to @@ -3038,18 +3060,18 @@ Consider adding this function to `message-header-setup-hook'" ["Fetch To and Cc" message-insert-wide-reply :help "Insert To and Cc headers as if you were doing a wide reply."] "----" - ["Send to list only" message-to-list-only t] - ["Mail-Followup-To" message-goto-mail-followup-to t] + ["Send to list only" message-to-list-only] + ["Mail-Followup-To" message-goto-mail-followup-to] ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to :help "Insert a reasonable `Mail-Followup-To:' header."] - ["Reduce To: to Cc:" message-reduce-to-to-cc t] + ["Reduce To: to Cc:" message-reduce-to-to-cc] "----" - ["Sort Headers" message-sort-headers t] - ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t] + ["Sort Headers" message-sort-headers] + ["Encode non-ASCII domain names" message-idna-to-ascii-rhs] ;; We hide `message-hidden-headers' by narrowing the buffer. - ["Show Hidden Headers" message-widen-and-recenter t] - ["Goto Body" message-goto-body t] - ["Goto Signature" message-goto-signature t])) + ["Show Hidden Headers" message-widen-and-recenter] + ["Goto Body" message-goto-body] + ["Goto Signature" message-goto-signature])) (defvar message-tool-bar-map nil) @@ -5993,35 +6015,38 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." "Return the In-Reply-To header for this message." (when message-reply-headers (let ((from (mail-header-from message-reply-headers)) - (date (mail-header-date message-reply-headers)) - (msg-id (mail-header-id message-reply-headers))) + (date (mail-header-date message-reply-headers)) + (msg-id (mail-header-id message-reply-headers))) (when from - (let ((name (mail-extract-address-components from))) - (concat - msg-id (if msg-id " (") - (if (car name) - (if (string-match "[^[:ascii:]]" (car name)) - ;; Quote a string containing non-ASCII characters. - ;; It will make the RFC2047 encoder cause an error - ;; if there are special characters. - (mm-with-multibyte-buffer - (insert (car name)) - (goto-char (point-min)) - (while (search-forward "\"" nil t) - (when (prog2 - (backward-char) - (zerop (% (skip-chars-backward "\\\\") 2)) - (goto-char (match-beginning 0))) - (insert "\\")) - (forward-char)) - ;; Those quotes will be removed by the RFC2047 encoder. - (concat "\"" (buffer-string) "\"")) - (car name)) - (nth 1 name)) - "'s message of \"" - (if (or (not date) (string= date "")) - "(unknown date)" date) - "\"" (if msg-id ")"))))))) + (let ((name (mail-extract-address-components from))) + (concat + msg-id + (when message-header-use-obsolete-in-reply-to + (concat + (if msg-id " (") + (if (car name) + (if (string-match "[^[:ascii:]]" (car name)) + ;; Quote a string containing non-ASCII characters. + ;; It will make the RFC2047 encoder cause an error + ;; if there are special characters. + (mm-with-multibyte-buffer + (insert (car name)) + (goto-char (point-min)) + (while (search-forward "\"" nil t) + (when (prog2 + (backward-char) + (zerop (% (skip-chars-backward "\\\\") 2)) + (goto-char (match-beginning 0))) + (insert "\\")) + (forward-char)) + ;; Those quotes will be removed by the RFC2047 encoder. + (concat "\"" (buffer-string) "\"")) + (car name)) + (nth 1 name)) + "'s message of \"" + (if (or (not date) (string= date "")) + "(unknown date)" date) + "\"" (if msg-id ")"))))))))) (defun message-make-distribution () "Make a Distribution header." diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index f63138300b1..4965e66503a 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -2004,7 +2004,7 @@ Return the server's response to the SELECT or EXAMINE command." (cons t response) (nnheader-report 'nnimap "%s" (mapconcat (lambda (a) - (format "%s" a)) + (format "%S" a)) (car response) " ")) nil))) diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el index edf773209d6..10363560ba6 100644 --- a/lisp/gnus/nnregistry.el +++ b/lisp/gnus/nnregistry.el @@ -47,6 +47,9 @@ (deffoo nnregistry-open-server (_server &optional _defs) gnus-registry-db) +(deffoo nnregistry-request-group (_group &optional _server _dont-check _info) + t) + (defvar nnregistry-within-nnregistry nil) (deffoo nnregistry-request-article (id &optional _group _server buffer) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 57964f93437..9ada2dbc1d7 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -42,7 +42,7 @@ (defvoo nnweb-type 'google "What search engine type is being used. -Valid types include `google' and `dejanews'.") +The only valid type is currently `google'.") (defvar nnweb-type-definition '((google diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 61f0b132201..b4698e9b2b6 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -643,15 +643,17 @@ COUNT defaults to 5" (add-hook 'gnus-select-article-hook #'spam-stat-store-gnus-article-buffer)) -(defun spam-stat-unload-hook () +(defun spam-stat-unload-function () "Uninstall the spam-stat function hooks." (interactive) (remove-hook 'nnmail-prepare-incoming-message-hook #'spam-stat-store-current-buffer) (remove-hook 'gnus-select-article-hook - #'spam-stat-store-gnus-article-buffer)) + #'spam-stat-store-gnus-article-buffer) + nil) -(add-hook 'spam-stat-unload-hook #'spam-stat-unload-hook) +(define-obsolete-function-alias 'spam-stat-unload-hook + #'spam-stat-unload-function "31.1") (provide 'spam-stat) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index dab68332ec5..5c25df049e3 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -2854,7 +2854,7 @@ installed through `spam-necessary-extra-headers'." ;; Don't install things more than once. (setq spam-install-hooks nil))) -(defun spam-unload-hook () +(defun spam-unload-function () "Uninstall the spam.el hooks." (interactive) (spam-teardown-widening) @@ -2864,12 +2864,13 @@ installed through `spam-necessary-extra-headers'." (remove-hook 'gnus-summary-prepare-exit-hook #'spam-summary-prepare-exit) (remove-hook 'gnus-summary-prepare-hook #'spam-summary-prepare) (remove-hook 'gnus-get-new-news-hook #'spam-setup-widening) - (remove-hook 'gnus-summary-prepare-hook #'spam-find-spam)) - -(add-hook 'spam-unload-hook #'spam-unload-hook) + (remove-hook 'gnus-summary-prepare-hook #'spam-find-spam) + nil) ;;}}} +(define-obsolete-function-alias 'spam-unload-hook #'spam-unload-function "31.1") + (provide 'spam) ;;; spam.el ends here diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 9324cf85454..6112df99850 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -649,7 +649,8 @@ the C sources, too." (lambda (entry level) (when (symbolp map) (setq map (symbol-function map))) - (when-let* ((elem (assq entry (cdr map)))) + (when-let* ((elem (assq entry (cdr map))) + (_ (proper-list-p elem))) (when (> level 0) (push sep string)) (if (eq (nth 1 elem) 'menu-item) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 4ea4250556f..7f272de790e 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -368,7 +368,7 @@ The format is (FUNCTION ARGS...).") (define-button-type 'help-package-def :supertype 'help-xref - 'help-function (lambda (file) (dired file)) + 'help-function #'dired 'help-echo "mouse-2, RET: visit package directory") (define-button-type 'help-theme-def diff --git a/lisp/help.el b/lisp/help.el index a5f65866c01..91e036621f8 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2309,7 +2309,7 @@ the same names as used in the original source code, when possible." (dolist (arg arglist) (unless (and (symbolp arg) (let ((name (symbol-name arg))) - (if (eq (aref name 0) ?&) + (if (and (> (length name) 0) (eq (aref name 0) ?&)) (memq arg '(&rest &optional)) (not (string-search "." name))))) (setq valid nil))) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index a8d60ff7917..94742cded01 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1872,8 +1872,7 @@ Otherwise buffers whose name matches an element of (defun ibuffer-mark-modified-buffers () "Mark all modified buffers." (interactive) - (ibuffer-mark-on-buffer - (lambda (buf) (buffer-modified-p buf)))) + (ibuffer-mark-on-buffer #'buffer-modified-p)) ;;;###autoload (defun ibuffer-mark-unsaved-buffers () diff --git a/lisp/ielm.el b/lisp/ielm.el index 561185a738a..b3cd02b4dc0 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -580,7 +580,6 @@ Customized bindings may be defined in `ielm-map', which currently contains: ielm-fontify-input-enable (comint-fontify-input-mode)) - (setq-local trusted-content :all) (setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt))) (setq-local paragraph-separate "\\'") (setq-local paragraph-start comint-prompt-regexp) @@ -684,7 +683,8 @@ See `inferior-emacs-lisp-mode' for details." (unless (comint-check-proc buf-name) (with-current-buffer (get-buffer-create buf-name) (unless (zerop (buffer-size)) (setq old-point (point))) - (inferior-emacs-lisp-mode))) + (inferior-emacs-lisp-mode) + (setq-local trusted-content :all))) (pop-to-buffer-same-window buf-name) (when old-point (push-mark old-point)))) diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 452be29c5d5..906e3521a61 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -950,6 +950,15 @@ You probably want to use this together with (defvar-keymap image-dired-thumbnail-mode-map :doc "Keymap for `image-dired-thumbnail-mode'." + + ;; Regular navigation + "f" #'image-dired-forward-image + "b" #'image-dired-backward-image + "n" #'image-dired-next-line + "p" #'image-dired-previous-line + "a" #'image-dired-move-beginning-of-line + "e" #'image-dired-move-end-of-line + "d" #'image-dired-flag-thumb-original-file "" #'image-dired-flag-thumb-original-file "m" #'image-dired-mark-thumb-original-file @@ -2084,7 +2093,7 @@ when using per-directory thumbnail file storage")) ;; ;; Sort function. Compare time between two files. ;; (lambda (l1 l2) ;; (time-less-p (car l1) (car l2))))) -;; (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files)))) +;; (dirsize (apply #'+ (mapcar #'cadr files)))) ;; (while (> dirsize image-dired-dir-max-size) ;; (y-or-n-p ;; (format "Size of thumbnail directory: %d, delete old file %s? " diff --git a/lisp/info.el b/lisp/info.el index 7a34b43369e..b8ab5b19776 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4678,7 +4678,6 @@ Advanced commands: ("java" . "ccmode") ("idl" . "ccmode") ("pike" . "ccmode") ("skeleton" . "autotype") ("auto-insert" . "autotype") ("copyright" . "autotype") ("executable" . "autotype") - ("time-stamp" . "autotype") ("tempo" . "autotype") ("hippie-expand" . "autotype") ("cvs" . "pcl-cvs") ("ada" . "ada-mode") "calc" ("calcAlg" . "calc") ("calcDigit" . "calc") ("calcVar" . "calc") diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 94d4a758705..daa55b14b87 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -772,8 +772,7 @@ you type is correctly handled." (defun quail-keyseq-translate (keyseq) (apply 'string - (mapcar (lambda (x) (quail-keyboard-translate x)) - keyseq))) + (mapcar #'quail-keyboard-translate keyseq))) (defun quail-insert-kbd-layout (kbd-layout) "Insert the visual keyboard layout table according to KBD-LAYOUT. @@ -2144,9 +2143,7 @@ minibuffer and the selected frame has no other windows)." (setq str (format "%s[%s]" str - (concat (sort (mapcar (lambda (x) (car x)) - (cdr map)) - '<))))) + (concat (sort (mapcar #'car (cdr map)) #'<))))) ;; Show list of translations. (if (and quail-current-translations (not (quail-deterministic))) diff --git a/lisp/isearch.el b/lisp/isearch.el index 3d06e78f4f0..1e65a645a1d 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3230,7 +3230,7 @@ See more for options in `search-exit-option'." (setq isearch-pre-move-point (point))) ;; Append control characters to the search string ((eq search-exit-option 'append) - (unless (memq nil (mapcar (lambda (k) (characterp k)) key)) + (unless (memq nil (mapcar #'characterp key)) (isearch-process-search-string key key)) (setq this-command 'ignore)) ;; Other characters terminate the search and are then executed normally. @@ -4654,8 +4654,7 @@ defaults to the value of `isearch-search-fun-default' when nil." (match-data))))) (when found (goto-char found)) (when match-data (set-match-data - (mapcar (lambda (m) (copy-marker m)) - match-data)))) + (mapcar #'copy-marker match-data)))) (setq found (funcall (or search-fun (isearch-search-fun-default)) string (if bound (if isearch-forward diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el index 14098c7e470..9c254cbfc6e 100644 --- a/lisp/language/ethiopic.el +++ b/lisp/language/ethiopic.el @@ -36,28 +36,6 @@ ;;; Code: -(define-ccl-program ccl-encode-ethio-font - '(0 - ;; In: R0:ethiopic (not checked) - ;; R1:position code 1 - ;; R2:position code 2 - ;; Out: R1:font code point 1 - ;; R2:font code point 2 - ((r1 -= 33) - (r2 -= 33) - (r1 *= 94) - (r2 += r1) - (if (r2 < 256) - (r1 = #x12) - (if (r2 < 448) - ((r1 = #x13) (r2 -= 256)) - ((r1 = #xfd) (r2 -= 208)) - )))) - "CCL program to encode an Ethiopic code to code point of Ethiopic font.") - -(setq font-ccl-encoder-alist - (cons (cons "ethiopic" ccl-encode-ethio-font) font-ccl-encoder-alist)) - (set-language-info-alist "Ethiopic" '((setup-function . setup-ethiopic-environment-internal) (exit-function . exit-ethiopic-environment) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 648633004c9..c1deb84754d 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -417,7 +417,7 @@ indented." t) ;;; Generated autoloads from allout.el -(push (purecopy '(allout 2 3)) package--builtin-versions) +(push '(allout 2 3) package--builtin-versions) (autoload 'allout-auto-activation-helper "allout" "\ Institute `allout-auto-activation'. @@ -758,7 +758,7 @@ for details on preparing Emacs for automatic allout activation. ;;; Generated autoloads from allout-widgets.el -(push (purecopy '(allout-widgets 1 0)) package--builtin-versions) +(push '(allout-widgets 1 0) package--builtin-versions) (autoload 'allout-widgets-setup "allout-widgets" "\ Commission or decommission `allout-widgets-mode' along with `allout-mode'. @@ -874,7 +874,7 @@ the buffer *Birthday-Present-for-Name*. ;;; Generated autoloads from ansi-color.el -(push (purecopy '(ansi-color 3 4 2)) package--builtin-versions) +(push '(ansi-color 3 4 2) package--builtin-versions) (autoload 'ansi-color-for-comint-mode-on "ansi-color" "\ Set `ansi-color-for-comint-mode' to t." t) (autoload 'ansi-color-process-output "ansi-color" "\ @@ -909,7 +909,7 @@ and is meant to be used in `compilation-filter-hook'.") ;;; Generated autoloads from progmodes/antlr-mode.el -(push (purecopy '(antlr-mode 2 2 3)) package--builtin-versions) +(push '(antlr-mode 2 2 3) package--builtin-versions) (autoload 'antlr-show-makefile-rules "antlr-mode" "\ Show Makefile rules for all grammar files in the current directory. If the `major-mode' of the current buffer has the value `makefile-mode', @@ -1420,9 +1420,7 @@ Features a private abbrev table and the following bindings: The character used for making comments is set by the variable `asm-comment-char' (which defaults to `?\\;'). - -Alternatively, you may set this variable in `asm-mode-set-comment-hook', -which is called near the beginning of mode initialization. +Alternatively, you may set this variable in `asm-mode-hook'. Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization. @@ -1470,7 +1468,7 @@ by doing (clear-string STRING). ;;; Generated autoloads from auth-source-pass.el -(push (purecopy '(auth-source-pass 5 0 0)) package--builtin-versions) +(push '(auth-source-pass 5 0 0) package--builtin-versions) (autoload 'auth-source-pass-enable "auth-source-pass" "\ Enable auth-source-password-store.") (autoload 'auth-source-pass-get "auth-source-pass" "\ @@ -1684,6 +1682,11 @@ The mode's hook is called both when the mode is enabled and when it is disabled. (fn &optional ARG)" t) +(defvar inhibit-auto-revert-buffers nil "\ +A list of buffers with suppressed auto-revert.") +(defmacro inhibit-auto-revert (&rest body) "\ +Deactivate auto-reverting of current buffer temporarily. +Run BODY." (declare (indent 0) (debug (body))) (let ((buf (make-symbol "buf"))) `(progn (dolist (,buf inhibit-auto-revert-buffers) (unless (buffer-live-p ,buf) (setq inhibit-auto-revert-buffers (delq ,buf inhibit-auto-revert-buffers)))) (let ((,buf (and (not (memq (current-buffer) inhibit-auto-revert-buffers)) (current-buffer)))) (unwind-protect (progn (when ,buf (add-to-list 'inhibit-auto-revert-buffers ,buf)) ,@body) (when ,buf (setq inhibit-auto-revert-buffers (delq ,buf inhibit-auto-revert-buffers)))))))) (register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-")) @@ -1729,7 +1732,7 @@ definition of \"random distance\".) ;;; Generated autoloads from emacs-lisp/backtrace.el -(push (purecopy '(backtrace 1 0)) package--builtin-versions) +(push '(backtrace 1 0) package--builtin-versions) (autoload 'backtrace "backtrace" "\ Print a trace of Lisp function calls currently active. Output stream used is value of `standard-output'.") @@ -1958,7 +1961,7 @@ Major mode for editing BibTeX style files. ;;; Generated autoloads from bind-key.el -(push (purecopy '(bind-key 2 4 1)) package--builtin-versions) +(push '(bind-key 2 4 1) package--builtin-versions) (defvar personal-keybindings nil "\ List of bindings performed by `bind-key'. @@ -2384,7 +2387,7 @@ deletion, or > if it is flagged for displaying." t) (defalias 'edit-bookmarks 'bookmark-bmenu-list) (autoload 'bookmark-bmenu-search "bookmark" "\ Incremental search of bookmarks, hiding the non-matches as we go." '(bookmark-bmenu-mode)) -(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (bindings--define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (bindings--define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (bindings--define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (bindings--define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (bindings--define-key map [delete-all] '(menu-item "Delete all Bookmarks..." bookmark-delete-all :help "Delete all bookmarks from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (bindings--define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (bindings--define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (bindings--define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (bindings--define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map)) +(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (define-key map [delete-all] '(menu-item "Delete all Bookmarks..." bookmark-delete-all :help "Delete all bookmarks from the bookmark list")) (define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map)) (defalias 'menu-bar-bookmark-map menu-bar-bookmark-map) (register-definition-prefixes "bookmark" '("bookmark-" "with-buffer-modified-unmodified")) @@ -2487,7 +2490,13 @@ Optional prefix argument ARG non-nil inverts the value of the option (fn &optional ARG)" t) (autoload 'browse-url-with-browser-kind "browse-url" "\ Browse URL with a browser of the given browser KIND. -KIND is either `internal' or `external'. + +KIND is either `internal' or `external'. In order to find an +appropriate browser for the given KIND, first consult the `browse-url-handlers' +and `browse-url-default-handlers' lists. If no handler is found, try the +functions `browse-url-browser-function', +`browse-url-secondary-browser-function', `browse-url-default-browser' +and `eww', in that order. When called interactively, the default browser kind is the opposite of the browser kind of `browse-url-browser-function'. @@ -2568,6 +2577,12 @@ If `browse-url-android-share' is non-nil, try to share URL using an external program instead. Default to the URL around or before point. +(fn URL &optional NEW-WINDOW)" t) +(autoload 'browse-url-default-gtk-browser "browse-url" "\ +Browse URL with GTK's idea of the default browser. +If the selected frame isn't a GTK frame, fall back to +`browse-url-default-browser'. + (fn URL &optional NEW-WINDOW)" t) (autoload 'browse-url-emacs "browse-url" "\ Ask Emacs to load URL into a buffer and show it in another window. @@ -2575,41 +2590,6 @@ Optional argument SAME-WINDOW non-nil means show the URL in the currently selected window instead. (fn URL &optional SAME-WINDOW)" t) -(autoload 'browse-url-gnome-moz "browse-url" "\ -Ask Mozilla to load URL via the GNOME program `gnome-moz-remote'. -Default to the URL around or before point. The strings in variable -`browse-url-gnome-moz-arguments' are also passed. - -When called interactively, if variable `browse-url-new-window-flag' is -non-nil, load the document in a new browser window, otherwise use an -existing one. A non-nil interactive prefix argument reverses the -effect of `browse-url-new-window-flag'. - -When called non-interactively, optional second argument NEW-WINDOW is -used instead of `browse-url-new-window-flag'. - -(fn URL &optional NEW-WINDOW)" t) -(make-obsolete 'browse-url-gnome-moz 'nil "25.1") -(autoload 'browse-url-conkeror "browse-url" "\ -Ask the Conkeror WWW browser to load URL. -Default to the URL around or before point. Also pass the strings -in the variable `browse-url-conkeror-arguments' to Conkeror. - -When called interactively, if variable -`browse-url-new-window-flag' is non-nil, load the document in a -new Conkeror window, otherwise use a random existing one. A -non-nil interactive prefix argument reverses the effect of -`browse-url-new-window-flag'. - -If variable `browse-url-conkeror-new-window-is-buffer' is -non-nil, then whenever a document would otherwise be loaded in a -new window, load it in a new buffer in an existing window instead. - -When called non-interactively, use optional second argument -NEW-WINDOW instead of `browse-url-new-window-flag'. - -(fn URL &optional NEW-WINDOW)" t) -(make-obsolete 'browse-url-conkeror 'nil "28.1") (autoload 'browse-url-w3 "browse-url" "\ Ask the w3 WWW browser to load URL. Default to the URL around or before point. @@ -2623,13 +2603,6 @@ used instead of `browse-url-new-window-flag'. (fn URL &optional NEW-WINDOW)" t) (make-obsolete 'browse-url-w3 'nil "29.1") -(autoload 'browse-url-w3-gnudoit "browse-url" "\ -Ask another Emacs running emacsclient to load the URL using the W3 browser. -The `browse-url-gnudoit-program' program is used with options given by -`browse-url-gnudoit-args'. Default to the URL around or before point. - -(fn URL &optional NEW-WINDOW)" t) -(make-obsolete 'browse-url-w3-gnudoit 'nil "25.1") (autoload 'browse-url-text-xterm "browse-url" "\ Ask a text browser to load URL. URL defaults to the URL around or before point. @@ -3595,7 +3568,7 @@ the absolute file name of the file if STYLE-NAME is nil. ;;; Generated autoloads from progmodes/cc-mode.el -(push (purecopy '(cc-mode 5 33 1)) package--builtin-versions) +(push '(cc-mode 5 33 1) package--builtin-versions) (autoload 'c-initialize-cc-mode "cc-mode" "\ Initialize CC Mode for use in the current buffer. If the optional NEW-STYLE-INIT is nil or left out then all necessary @@ -4116,7 +4089,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;; Generated autoloads from cedet/cedet.el -(push (purecopy '(cedet 2 0)) package--builtin-versions) +(push '(cedet 2 0) package--builtin-versions) (register-definition-prefixes "cedet" '("cedet-")) @@ -4142,7 +4115,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;; Generated autoloads from progmodes/cfengine.el -(push (purecopy '(cfengine 1 4)) package--builtin-versions) +(push '(cfengine 1 4) package--builtin-versions) (autoload 'cfengine3-mode "cfengine" "\ Major mode for editing CFEngine3 input. There are no special keybindings by default. @@ -4508,7 +4481,7 @@ disabled. ;;; Generated autoloads from emacs-lisp/cl-generic.el -(push (purecopy '(cl-generic 1 0)) package--builtin-versions) +(push '(cl-generic 1 0) package--builtin-versions) ;;; Generated autoloads from emacs-lisp/cl-indent.el @@ -4595,7 +4568,7 @@ instead. ;;; Generated autoloads from emacs-lisp/cl-lib.el -(push (purecopy '(cl-lib 1 0)) package--builtin-versions) +(push '(cl-lib 1 0) package--builtin-versions) (defvar cl-custom-print-functions nil "\ This is a list of functions that format user objects for printing. Each function is called in turn with three arguments: the object, the @@ -4654,7 +4627,7 @@ disabled. ;;; Generated autoloads from emacs-lisp/cl-print.el -(push (purecopy '(cl-print 1 0)) package--builtin-versions) +(push '(cl-print 1 0) package--builtin-versions) (autoload 'cl-print-object "cl-print" "\ Dispatcher to print OBJECT on STREAM according to its type. You can add methods to it to customize the output. @@ -4849,7 +4822,7 @@ See `make-comint' and `comint-exec'. (fn PROGRAM &optional SWITCHES)" t) (function-put 'comint-run 'interactive-only 'make-comint) -(defvar comint-file-name-prefix (purecopy "") "\ +(defvar comint-file-name-prefix "" "\ Prefix prepended to absolute file names taken from process input. This is used by Comint's and shell's completion functions, and by shell's directory tracking functions.") @@ -4945,6 +4918,8 @@ Force the produced .eln to be outputted in the eln system directory (the last entry in `native-comp-eln-load-path') unless `native-compile-target-directory' is non-nil. If the environment variable \"NATIVE_DISABLED\" is set, only byte compile.") +(autoload 'native-compile-prune-cache "comp" "\ +Remove .eln files that aren't applicable to the current Emacs invocation." t) (register-definition-prefixes "comp" '("comp-" "native-comp" "no-native-compile")) @@ -5120,7 +5095,7 @@ List of directories to search for source files named in error messages. Elements should be directory names, not file names of directories. The value nil as an element means to try the default directory.") (custom-autoload 'compilation-search-path "compile" t) -(defvar compile-command (purecopy "make -k ") "\ +(defvar compile-command "make -k " "\ Last shell command used to do a compilation; default for next compilation. Sometimes it is useful for files to supply local values for this variable. @@ -5417,7 +5392,43 @@ list.") ;;; Generated autoloads from emacs-lisp/cond-star.el -(register-definition-prefixes "cond-star" '("cond*" "match*")) +(autoload 'cond* "cond-star" "\ +Extended form of traditional Lisp `cond' construct. +A `cond*' construct is a series of clauses, and a clause +normally has the form (CONDITION BODY...). + +CONDITION can be a Lisp expression, as in `cond'. +Or it can be one of `(pcase* PATTERN DATUM)', +`(bind* BINDINGS...)', or `(match* PATTERN DATUM)', + +`(pcase* PATTERN DATUM)' means to match DATUM against the +pattern PATTERN, using the same pattern syntax as `pcase'. +The condition counts as true if PATTERN matches DATUM. + +`(bind* BINDINGS...)' means to bind BINDINGS (as if they were in `let*') +for the body of the clause. As a condition, it counts as true +if the first binding's value is non-nil. All the bindings are made +unconditionally for whatever scope they cover. + +`(match* PATTERN DATUM)' is an alternative to `pcase*' that uses another +syntax for its patterns, see `match*'. + +When a clause's condition is true, and it exits the `cond*' +or is the last clause, the value of the last expression +in its body becomes the return value of the `cond*' construct. + +Non-exit clause: + +If a clause has only one element, or if its first element is +a `bind*' clause, this clause never exits the `cond*' construct. +Instead, control always falls through to the next clause (if any). +All bindings made in CONDITION for the BODY of the non-exit clause +are passed along to the rest of the clauses in this `cond*' construct. + +\\[match*\\] for documentation of the patterns for use in `match*'. + +(fn &rest CLAUSES)" nil t) +(register-definition-prefixes "cond-star" '("cond*-" "match*")) ;;; Generated autoloads from textmodes/conf-mode.el @@ -7545,7 +7556,7 @@ the word at mouse click. ;;; Generated autoloads from vc/diff.el -(defvar diff-switches (purecopy "-u") "\ +(defvar diff-switches "-u" "\ A string or list of strings specifying switches to be passed to diff. This variable is also used in the `vc-diff' command (and related @@ -7553,7 +7564,7 @@ commands) if the backend-specific diff switch variable isn't set (`vc-git-diff-switches' for git, for instance), and `vc-diff-switches' isn't set.") (custom-autoload 'diff-switches "diff" t) -(defvar diff-command (purecopy "diff") "\ +(defvar diff-command "diff" "\ The command to use to run diff.") (custom-autoload 'diff-command "diff" t) (autoload 'diff "diff" "\ @@ -7680,7 +7691,7 @@ If given a \\[universal-argument] \\[universal-argument] prefix, also prompt for ;;; Generated autoloads from dired.el -(defvar dired-listing-switches (purecopy "-al") "\ +(defvar dired-listing-switches "-al" "\ Switches passed to `ls' for Dired. MUST contain the `l' option. May contain all other options that don't contradict `-l'; may contain even `F', `b', `i' and `s'. See also the variable @@ -7893,16 +7904,24 @@ redefine OBJECT if it is a symbol. Return a new, empty display table.") (autoload 'display-table-slot "disp-table" "\ Return the value of the extra slot in DISPLAY-TABLE named SLOT. -SLOT may be a number from 0 to 5 inclusive, or a slot name (symbol). +SLOT may be a number from 0 to 17 inclusive, or a slot name (symbol). Valid symbols are `truncation', `wrap', `escape', `control', -`selective-display', and `vertical-border'. +`selective-display', `vertical-border', `box-vertical', +`box-horizontal', `box-down-right', `box-down-left', `box-up-right', +`box-up-left',`box-double-vertical', `box-double-horizontal', +`box-double-down-right', `box-double-down-left', +`box-double-up-right', `box-double-up-left', (fn DISPLAY-TABLE SLOT)") (autoload 'set-display-table-slot "disp-table" "\ Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE. -SLOT may be a number from 0 to 5 inclusive, or a name (symbol). +SLOT may be a number from 0 to 17 inclusive, or a name (symbol). Valid symbols are `truncation', `wrap', `escape', `control', -`selective-display', and `vertical-border'. +`selective-display', `vertical-border', `box-vertical', +`box-horizontal', `box-down-right', `box-down-left', `box-up-right', +`box-up-left',`box-double-vertical', `box-double-horizontal', +`box-double-down-right', `box-double-down-left', +`box-double-up-right', `box-double-up-left', (fn DISPLAY-TABLE SLOT VALUE)") (autoload 'describe-display-table "disp-table" "\ @@ -7911,6 +7930,13 @@ Describe the display table DT in a help buffer. (fn DT)") (autoload 'describe-current-display-table "disp-table" "\ Describe the display table in use in the selected window and buffer." t) +(autoload 'standard-display-unicode-special-glyphs "disp-table" "\ +Display some glyps using Unicode characters. +The glyphs being changed by this function are `vertical-border', +`box-vertical',`box-horizontal', `box-down-right', `box-down-left', +`box-up-right', `box-up-left',`box-double-vertical', +`box-double-horizontal', `box-double-down-right', +`box-double-down-left', `box-double-up-right', `box-double-up-left'," t) (autoload 'standard-display-8bit "disp-table" "\ Display characters representing raw bytes in the range L to H literally. @@ -8227,7 +8253,7 @@ Default is 2. ;;; Generated autoloads from dnd.el -(defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://[^/]") . dnd-open-file) (,(purecopy "^file:/[^/]") . dnd-open-local-file) (,(purecopy "^file:[^/]") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|nfs\\)://") . dnd-open-file)) "\ +(defvar dnd-protocol-alist '(("^file:///" . dnd-open-local-file) ("^file://[^/]" . dnd-open-file) ("^file:/[^/]" . dnd-open-local-file) ("^file:[^/]" . dnd-open-local-file) ("^\\(https?\\|ftp\\|nfs\\)://" . dnd-open-file)) "\ The functions to call for different protocols when a drop is made. This variable is used by `dnd-handle-multiple-urls'. The list contains of (REGEXP . FUNCTION) pairs. @@ -8981,7 +9007,7 @@ Read the .ecompleterc file.") ;;; Generated autoloads from cedet/ede.el -(push (purecopy '(ede 2 0)) package--builtin-versions) +(push '(ede 2 0) package--builtin-versions) (defvar global-ede-mode nil "\ Non-nil if Global Ede mode is enabled. See the `global-ede-mode' command @@ -9073,7 +9099,7 @@ Toggle edebugging of all forms." t) ;;; Generated autoloads from vc/ediff.el -(push (purecopy '(ediff 2 81 6)) package--builtin-versions) +(push '(ediff 2 81 6) package--builtin-versions) (autoload 'ediff-files "ediff" "\ Run Ediff on a pair of files, FILE-A and FILE-B. STARTUP-HOOKS is a list of functions that Emacs calls without @@ -9409,7 +9435,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see." t) ;;; Generated autoloads from editorconfig.el -(push (purecopy '(editorconfig 0 11 0)) package--builtin-versions) +(push '(editorconfig 0 11 0) package--builtin-versions) (defvar editorconfig-mode nil "\ Non-nil if Editorconfig mode is enabled. See the `editorconfig-mode' command @@ -9559,7 +9585,7 @@ Turn on EDT Emulation." t) ;;; Generated autoloads from progmodes/eglot.el -(push (purecopy '(eglot 1 17)) package--builtin-versions) +(push '(eglot 1 18) package--builtin-versions) (define-obsolete-function-alias 'eglot-update #'eglot-upgrade-eglot "29.1") (autoload 'eglot "eglot" "\ Start LSP server for PROJECT's buffers under MANAGED-MAJOR-MODES. @@ -9661,7 +9687,7 @@ BUFFER is put back into its original major mode. ;;; Generated autoloads from emacs-lisp/eieio.el -(push (purecopy '(eieio 1 4)) package--builtin-versions) +(push '(eieio 1 4) package--builtin-versions) (autoload 'make-instance "eieio" "\ Make a new instance of CLASS based on INITARGS. For example: @@ -9684,7 +9710,7 @@ for each slot. For example: ;;; Generated autoloads from emacs-lisp/eieio-core.el -(push (purecopy '(eieio-core 1 4)) package--builtin-versions) +(push '(eieio-core 1 4) package--builtin-versions) (autoload 'eieio-defclass-autoload "eieio-core" "\ Create autoload symbols for the EIEIO class CNAME. SUPERCLASSES are the superclasses that CNAME inherits from. @@ -9746,7 +9772,7 @@ Describe CTR if it is a class constructor. ;;; Generated autoloads from emacs-lisp/eldoc.el -(push (purecopy '(eldoc 1 15 0)) package--builtin-versions) +(push '(eldoc 1 15 0) package--builtin-versions) ;;; Generated autoloads from elec-pair.el @@ -10462,7 +10488,9 @@ The buffer is expected to contain a mail message." t) (function-put 'epa-mail-decrypt 'interactive-only 't) (autoload 'epa-mail-verify "epa-mail" "\ Verify OpenPGP cleartext signed messages in the current buffer. -The buffer is expected to contain a mail message." t) +The buffer is expected to contain a mail message. + +If the verification fails, signal an error." t) (function-put 'epa-mail-verify 'interactive-only 't) (autoload 'epa-mail-sign "epa-mail" "\ Sign the current buffer. @@ -10522,7 +10550,7 @@ disabled. ;;; Generated autoloads from epg.el -(push (purecopy '(epg 1 0 0)) package--builtin-versions) +(push '(epg 1 0 0) package--builtin-versions) (autoload 'epg-make-context "epg" "\ Return a context object. @@ -10565,7 +10593,7 @@ Look at CONFIG and try to expand GROUP. ;;; Generated autoloads from erc/erc.el -(push (purecopy '(erc 5 6 1 -4)) package--builtin-versions) +(push '(erc 5 6 1 -4) package--builtin-versions) (dolist (symbol '( erc-sasl erc-spelling ; 29 erc-imenu erc-nicks)) ; 30 (custom-add-load symbol symbol)) @@ -11025,7 +11053,7 @@ Default bookmark handler for Eshell buffers. ;;; Generated autoloads from eshell/eshell.el -(push (purecopy '(eshell 2 4 2)) package--builtin-versions) +(push '(eshell 2 4 2) package--builtin-versions) (autoload 'eshell "eshell" "\ Create an interactive Eshell buffer. Start a new Eshell session, or switch to an already active @@ -11081,7 +11109,7 @@ To switch to a new tags table, do not set this variable; instead, invoke `visit-tags-table', which is the only reliable way of setting the value of this variable, whether buffer-local or global. Use the `etags' program to make a tags table file.") - (put 'tags-file-name 'variable-interactive (purecopy "fVisit tags table: ")) + (put 'tags-file-name 'variable-interactive "fVisit tags table: ") (put 'tags-file-name 'safe-local-variable 'stringp) (defvar tags-case-fold-search 'default "\ Whether tags operations should be case-sensitive. @@ -11096,7 +11124,7 @@ To switch to a new list of tags tables, setting this variable is sufficient. If you set this variable, do not also set `tags-file-name'. Use the `etags' program to make a tags table file.") (custom-autoload 'tags-table-list "etags" t) -(defvar tags-compression-info-list (purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz")) "\ +(defvar tags-compression-info-list '("" ".Z" ".bz2" ".gz" ".xz" ".tgz") "\ List of extensions tried by etags when `auto-compression-mode' is on. An empty string means search the non-compressed file.") (custom-autoload 'tags-compression-info-list "etags" t) @@ -11627,7 +11655,7 @@ queries the server for the existing fields and displays a corresponding form. (autoload 'eudc-load-eudc "eudc" "\ Load the Emacs Unified Directory Client. This does nothing except loading eudc by autoload side-effect." t) -(defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] `(menu-item ,(purecopy "Get Phone") eudc-get-phone :help ,(purecopy "Get the phone field of name from the directory server"))) (define-key map [email] `(menu-item ,(purecopy "Get Email") eudc-get-email :help ,(purecopy "Get the email field of NAME from the directory server"))) (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] `(menu-item ,(purecopy "Expand Inline Query") eudc-expand-inline :help ,(purecopy "Query the directory server, and expand the query string before point"))) (define-key map [query] `(menu-item ,(purecopy "Query with Form") eudc-query-form :help ,(purecopy "Display a form to query the directory server"))) (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] `(menu-item ,(purecopy "New Server") eudc-set-server :help ,(purecopy "Set the directory server to SERVER using PROTOCOL"))) (define-key map [load] `(menu-item ,(purecopy "Load Hotlist of Servers") eudc-load-eudc :help ,(purecopy "Load the Emacs Unified Directory Client"))) map)) +(defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] '(menu-item "Get Phone" eudc-get-phone :help "Get the phone field of name from the directory server")) (define-key map [email] '(menu-item "Get Email" eudc-get-email :help "Get the email field of NAME from the directory server")) (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] '(menu-item "Expand Inline Query" eudc-expand-inline :help "Query the directory server, and expand the query string before point")) (define-key map [query] '(menu-item "Query with Form" eudc-query-form :help "Display a form to query the directory server")) (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] '(menu-item "New Server" eudc-set-server :help "Set the directory server to SERVER using PROTOCOL")) (define-key map [load] '(menu-item "Load Hotlist of Servers" eudc-load-eudc :help "Load the Emacs Unified Directory Client")) map)) (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu)) (register-definition-prefixes "eudc" '("eudc-")) @@ -11837,8 +11865,9 @@ new buffer instead of reusing the default EWW buffer. (fn FILE &optional NEW-BUFFER)" t) (autoload 'eww-search-words "eww" "\ Search the web for the text in the region. -If region is active (and not whitespace), search the web for -the text between region beginning and end. Else, prompt the +If region is active (and not whitespace), search the web for the +text between region beginning and end, subject to user's confirmation +controlled by `eww-search-confirm-send-region'. Else, prompt the user for a search string. See the variable `eww-search-prefix' for the search engine used." t) (autoload 'eww-mode "eww" "\ @@ -11952,7 +11981,7 @@ This is used only in conjunction with `expand-add-abbrevs'." t) ;;; Generated autoloads from external-completion.el -(push (purecopy '(external-completion 0 1)) package--builtin-versions) +(push '(external-completion 0 1) package--builtin-versions) (register-definition-prefixes "external-completion" '("external-completion-")) @@ -12270,7 +12299,7 @@ color. The function should accept a single argument, the color name. ;;; Generated autoloads from emacs-lisp/faceup.el -(push (purecopy '(faceup 0 0 6)) package--builtin-versions) +(push '(faceup 0 0 6) package--builtin-versions) (autoload 'faceup-view-buffer "faceup" "\ Display the faceup representation of the current buffer." t) (autoload 'faceup-write-file "faceup" "\ @@ -12307,7 +12336,7 @@ FUNCTION must return an explanation when the test fails and ;;; Generated autoloads from mail/feedmail.el -(push (purecopy '(feedmail 11)) package--builtin-versions) +(push '(feedmail 11) package--builtin-versions) (autoload 'feedmail-send-it "feedmail" "\ Send the current mail buffer using the Feedmail package. This is a suitable value for `send-mail-function'. It can be used @@ -12737,7 +12766,7 @@ Set up hooks, load the cache file -- if existing -- and build the menu.") ;;; Generated autoloads from find-cmd.el -(push (purecopy '(find-cmd 0 6)) package--builtin-versions) +(push '(find-cmd 0 6) package--builtin-versions) (autoload 'find-cmd "find-cmd" "\ Initiate the building of a find command. For example: @@ -12819,7 +12848,7 @@ specifies what to use in place of \"-ls\" as the final argument. ;;; Generated autoloads from find-file.el -(defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") \, (lambda nil (match-string 2)))) "\ +(defvar ff-special-constructs `(("^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]" \, (lambda nil (match-string 2)))) "\ List of special constructs recognized by `ff-treat-as-special'. Each element, tried in order, has the form (REGEXP . EXTRACT). If REGEXP matches the current line (from the beginning of the line), @@ -12939,12 +12968,21 @@ Search for SYMBOL's definition of type TYPE in LIBRARY. Visit the library in a buffer, and return a cons cell (BUFFER . POSITION), or just (BUFFER . nil) if the definition can't be found in the file. -If TYPE is nil, look for a function definition. -Otherwise, TYPE specifies the kind of definition, -and it is interpreted via `find-function-regexp-alist'. +If TYPE is nil, look for a function definition, +otherwise, TYPE specifies the kind of definition. +TYPE is looked up in SYMBOL's property `find-function-type-alist' +(which can be maintained with `find-function-update-type-alist') +or the variable `find-function-regexp-alist'. + The search is done in the source for library LIBRARY. (fn SYMBOL TYPE LIBRARY)") +(autoload 'find-function-update-type-alist "find-func" "\ +Update SYMBOL property `find-function-type-alist' with (TYPE . VARIABLE). +Property `find-function-type-alist' is a symbol-specific version +of variable `find-function-regexp-alist' and has the same format. + +(fn SYMBOL TYPE VARIABLE)") (autoload 'find-function-noselect "find-func" "\ Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION. @@ -13157,7 +13195,7 @@ lines. ;;; Generated autoloads from progmodes/flymake.el -(push (purecopy '(flymake 1 3 7)) package--builtin-versions) +(push '(flymake 1 3 7) package--builtin-versions) (autoload 'flymake-log "flymake" "\ Log, at level LEVEL, the message MSG formatted with ARGS. LEVEL is passed to `display-warning', which is used to display @@ -13278,7 +13316,7 @@ REPORT-FN is Flymake's callback. ;;; Generated autoloads from progmodes/flymake-proc.el -(push (purecopy '(flymake-proc 1 0)) package--builtin-versions) +(push '(flymake-proc 1 0) package--builtin-versions) (register-definition-prefixes "flymake-proc" '("flymake-proc-")) @@ -13354,7 +13392,7 @@ Flyspell whole buffer." t) ;;; Generated autoloads from foldout.el -(push (purecopy '(foldout 1 10)) package--builtin-versions) +(push '(foldout 1 10) package--builtin-versions) (register-definition-prefixes "foldout" '("foldout-")) @@ -14235,7 +14273,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;; Generated autoloads from gnus/gnus.el -(push (purecopy '(gnus 5 13)) package--builtin-versions) +(push '(gnus 5 13) package--builtin-versions) (custom-autoload 'gnus-select-method "gnus") (autoload 'gnus-child-no-server "gnus" "\ Read network news as a child, without connecting to the local server. @@ -15221,14 +15259,14 @@ Face name to use for grep matches.") (defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:" "\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg 1)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches" 1 nil nil 0 1)) "\ Regexp used to match grep hits. See `compilation-error-regexp-alist' for format details.") -(defvar grep-program (purecopy "grep") "\ +(defvar grep-program "grep" "\ The default grep program for `grep-command' and `grep-find-command'. This variable's value takes effect when `grep-compute-defaults' is called.") -(defvar find-program (purecopy "find") "\ +(defvar find-program "find" "\ The default find program. This is used by commands like `grep-find-command', `find-dired' and others.") -(defvar xargs-program (purecopy "xargs") "\ +(defvar xargs-program "xargs" "\ The default xargs program for `grep-find-command'. See `grep-find-use-xargs'. This variable's value takes effect when `grep-compute-defaults' is called.") @@ -15707,20 +15745,20 @@ If the `kbd-help' text or overlay property at point produces a string, return it. Otherwise, use the `help-echo' property. If this produces no string either, return nil.") (autoload 'display-local-help "help-at-pt" "\ -Display local help in the echo area. -This command, by default, displays a short help message, namely -the string produced by the `kbd-help' property at point. If -`kbd-help' does not produce a string, but the `help-echo' -property does, then that string is printed instead. +Display in the echo area `kbd-help' or `help-echo' text at point. +This command displays the help message which is the string produced +by the `kbd-help' property at point. If `kbd-help' at point does not +produce a string, but the `help-echo' property does, then that string +is displayed instead. The string is passed through `substitute-command-keys' before it is displayed. -If INHIBIT-WARNING is non-nil, this prevents display of a message -in case there is no help. +If INHIBIT-WARNING is non-nil, do not display a warning message when +there is no help property at point. If DESCRIBE-BUTTON in non-nil (interactively, the prefix arg), and -there's a button/widget at point, pop a buffer describing that +there's a button/widget at point, pop up a buffer describing that button/widget instead. (fn &optional INHIBIT-WARNING DESCRIBE-BUTTON)" t) @@ -16461,7 +16499,7 @@ disabled. ;;; Generated autoloads from progmodes/hideshow.el -(defvar hs-special-modes-alist (mapcar #'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c-ts-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (c++-ts-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (java-ts-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil) (js-ts-mode "{" "}" "/[*/]" nil) (lua-ts-mode "{\\|\\[\\[" "}\\|\\]\\]" "--" nil) (mhtml-mode "{\\|<[^/>]*?" "}\\|]*[^/]>" " func.method is one node. + ;; .method({ + ;; return 1; ({ return 1; }) is another node + ;; }) + ;; + ;; So when we go up the parse tree, we go through the block + ;; ({...}), then the next parent is already the whole call + ;; expression, and we never stops at the beginning of "method". + ;; Therefore we need this heuristic. + (and (progn (back-to-indentation) + (eq (char-after) ?.)) + (point)))) + (defun c-ts-common--standalone-parent (parent) "Find the first parent that starts on a new line. Start searching from PARENT, so if PARENT satisfies the condition, it'll be returned. Return the starting position of the parent, return nil if -no parent satisfies the condition." - (save-excursion - (catch 'term - (while parent - (goto-char (treesit-node-start parent)) - (when (looking-back (rx bol (* whitespace)) - (line-beginning-position)) - (throw 'term (point))) - (setq parent (treesit-node-parent parent)))))) +no parent satisfies the condition. + +Unlike simple-indent's standalone preset, this function handles method +chaining like + + func + .method() <-- Considered standalone even if there's a \".\" in + .method() front of the node. + +But ff `treesit-simple-indent-standalone-predicate' is non-nil, use that +for determining standlone line." + (let (anchor) + (save-excursion + (catch 'term + (while parent + (goto-char (treesit-node-start parent)) + (when (setq anchor + (if treesit-simple-indent-standalone-predicate + (funcall treesit-simple-indent-standalone-predicate + parent) + (c-ts-common--standalone-predicate parent))) + (throw 'term (if (numberp anchor) anchor (point)))) + (setq parent (treesit-node-parent parent))))))) (defun c-ts-common--prev-standalone-sibling (node) - "Return the previous sibling of NODE that starts on a new line. -Return nil if no sibling satisfies the condition." + "Return the start of the previous sibling of NODE that starts on a new line. +Return nil if no sibling satisfies the condition. + +Unlike simple-indent's standalone preset, this function handles method +chaining like + + func + .method() <-- Considered standalone even if there's a \".\" in + .method() front of the node. + +But ff `treesit-simple-indent-standalone-predicate' is non-nil, use that +for determining standlone line." (save-excursion (setq node (treesit-node-prev-sibling node 'named)) (goto-char (treesit-node-start node)) - (while (and node - (goto-char (treesit-node-start node)) - (not (looking-back (rx bol (* whitespace)) - (pos-bol)))) - (setq node (treesit-node-prev-sibling node 'named))) - node)) + (let (anchor) + (while (and node + (goto-char (treesit-node-start node)) + (not (setq anchor + (if treesit-simple-indent-standalone-predicate + (funcall + treesit-simple-indent-standalone-predicate + node) + (c-ts-common--standalone-predicate node))))) + (setq node (treesit-node-prev-sibling node 'named))) + (if (numberp anchor) anchor (treesit-node-start node))))) (defun c-ts-common-parent-ignore-preproc (node) "Return the parent of NODE, skipping preproc nodes." @@ -629,7 +684,13 @@ This rule tries to be smart and ignore proprocessor node in some situations. By default, any node that has \"proproc\" in its type are considered a preprocessor node. If that heuristic is inaccurate, define a `preproc' thing in `treesit-thing-settings', and this rule will use -the thing definition instead." +the thing definition instead. + +The rule also handles method chaining like + + func + .method() <-- Considered \"starts at a newline\" even if there's + .method() a \".\" in front of the node." (let ((prev-line-node (treesit--indent-prev-line-node bol)) (offset (symbol-value c-ts-common-indent-offset))) (cond @@ -664,9 +725,8 @@ the thing definition instead." (cons (c-ts-common--standalone-parent parent) offset))) ;; Not first sibling - (t (cons (treesit-node-start - (or (c-ts-common--prev-standalone-sibling node) - first-sibling)) + (t (cons (or (c-ts-common--prev-standalone-sibling node) + (treesit-node-start first-sibling)) 0))))) ;; Condition 2 for initializer list, only apply to ;; second line. Eg, diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index c5bf135e286..499c2ad66d4 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -147,10 +147,10 @@ This function takes no arguments and is expected to return a list of indent RULEs as described in `treesit-simple-indent-rules'. Note that the list of RULEs doesn't need to contain the language symbol." :version "29.1" - :type '(choice (symbol :tag "Gnu" gnu) - (symbol :tag "K&R" k&r) - (symbol :tag "Linux" linux) - (symbol :tag "BSD" bsd) + :type '(choice (const :tag "Gnu" gnu) + (const :tag "K&R" k&r) + (const :tag "Linux" linux) + (const :tag "BSD" bsd) (function :tag "A function for user customized style" ignore)) :set #'c-ts-mode--indent-style-setter :safe 'c-ts-indent-style-safep @@ -1041,14 +1041,11 @@ Return nil if NODE is not a defun node or doesn't have a name." (defun c-ts-mode--outline-predicate (node) "Match outlines on lines with function names." - (or (when-let* ((decl (treesit-node-child-by-field-name - (treesit-node-parent node) "declarator")) - (node-pos (treesit-node-start node)) - (decl-pos (treesit-node-start decl)) - (eol (save-excursion (goto-char node-pos) (line-end-position)))) - (and (equal (treesit-node-type decl) "function_declarator") - (<= node-pos decl-pos) - (< decl-pos eol))) + (or (and (equal (treesit-node-type node) "function_declarator") + ;; Handle the case when "function_definition" is + ;; not an immediate parent of "function_declarator" + ;; but there is e.g. "pointer_declarator" between them. + (treesit-parent-until node "function_definition")) ;; DEFUNs in Emacs sources. (and c-ts-mode-emacs-sources-support (c-ts-mode--emacs-defun-p node)))) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 77e853271a4..a92be508a65 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -66,7 +66,7 @@ ;; You can get the latest version of CC Mode, including PostScript ;; documentation and separate individual files from: ;; -;; https://cc-mode.sourceforge.net/ +;; https://www.nongnu.org/cc-mode/ ;; ;; You can join a moderated CC Mode announcement-only mailing list by ;; visiting @@ -172,8 +172,8 @@ ;; `c-font-lock-init' too to set up CC Mode's font lock support. ;; ;; See cc-langs.el for further info. A small example of a derived mode -;; is also available at . +;; is also available at +;; . (defun c-leave-cc-mode-mode () (when c-buffer-is-cc-mode diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 3c386eb07e9..0687801d69f 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1566,7 +1566,7 @@ working due to this change." (defun c-make-font-lock-extra-types-blurb (mode1 mode2 example) (concat "\ -*List of extra types (aside from the type keywords) to recognize in " +List of extra types (aside from the type keywords) to recognize in " mode1 " mode. Each list item should be a regexp matching a single identifier. " example " diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 3e07da40cdd..b26ce4e34a5 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -736,6 +736,12 @@ compilation and evaluation time conflicts." (treesit-query-compile 'c-sharp "(interpolated_string_text)" t) t)) +(defun csharp-ts-mode--test-string-content () + "Return non-nil if (interpolated_string_text) is in the grammar." + (ignore-errors + (treesit-query-compile 'c-sharp "(string_content)" t) + t)) + (defun csharp-ts-mode--test-type-constraint () "Return non-nil if (type_constraint) is in the grammar." (ignore-errors @@ -748,6 +754,12 @@ compilation and evaluation time conflicts." (treesit-query-compile 'c-sharp "(type_of_expression)" t) t)) +(defun csharp-ts-mode--test-typeof-expression () + "Return non-nil if (type_of_expression) is in the grammar." + (ignore-errors + (treesit-query-compile 'c-sharp "(typeof_expression)" t) + t)) + (defun csharp-ts-mode--test-name-equals () "Return non-nil if (name_equals) is in the grammar." (ignore-errors @@ -824,10 +836,12 @@ compilation and evaluation time conflicts." (boolean_literal) @font-lock-constant-face) :language 'c-sharp - :override t :feature 'string `([(string_literal) (verbatim_string_literal) + ,@ (when (csharp-ts-mode--test-string-content) + '((string_content) + "\"")) ,@(if (csharp-ts-mode--test-interpolated-string-text) '((interpolated_string_text) (interpolated_verbatim_string_text) @@ -871,7 +885,9 @@ compilation and evaluation time conflicts." (type_parameter_constraint (type type: (generic_name (identifier) @font-lock-type-face))))) ,@(when (csharp-ts-mode--test-type-of-expression) - '((type_of_expression (identifier) @font-lock-type-face)) + '((type_of_expression (identifier) @font-lock-type-face))) + + ,@(when (csharp-ts-mode--test-typeof-expression) '((typeof_expression (identifier) @font-lock-type-face))) (object_creation_expression diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 76648f310e6..bd28174e7da 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -269,6 +269,7 @@ automatically)." . ,(eglot-alternatives '("clangd" "ccls"))) (((caml-mode :language-id "ocaml") + (ocaml-ts-mode :language-id "ocaml") (tuareg-mode :language-id "ocaml") reason-mode) . ("ocamllsp")) ((ruby-mode ruby-ts-mode) @@ -278,11 +279,12 @@ automatically)." (elm-mode . ("elm-language-server")) (mint-mode . ("mint" "ls")) ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) - ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) + ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode go-work-ts-mode) . ("gopls")) ((R-mode ess-r-mode) . ("R" "--slave" "-e" "languageserver::run()")) - ((java-mode java-ts-mode) . ("jdtls")) + ((java-mode java-ts-mode) + . ,(eglot-alternatives '("jdtls" "java-language-server"))) ((dart-mode dart-ts-mode) . ("dart" "language-server" "--client-id" "emacs.eglot-dart")) @@ -325,6 +327,7 @@ automatically)." ((csharp-mode csharp-ts-mode) . ,(eglot-alternatives '(("omnisharp" "-lsp") + ("OmniSharp" "-lsp") ("csharp-ls")))) (purescript-mode . ("purescript-language-server" "--stdio")) ((perl-mode cperl-mode) @@ -565,7 +568,9 @@ under cursor." (const :tag "Decorate color references" :colorProvider) (const :tag "Fold regions of buffer" :foldingRangeProvider) (const :tag "Execute custom commands" :executeCommandProvider) - (const :tag "Inlay hints" :inlayHintProvider))) + (const :tag "Inlay hints" :inlayHintProvider) + (const :tag "Type hierarchies" :typeHierarchyProvider) + (const :tag "Call hierarchies" :callHierarchyProvider))) (defcustom eglot-advertise-cancellation nil "If non-nil, Eglot attemps to inform server of cancelled requests. @@ -716,7 +721,13 @@ This can be useful when using docker to run a language server.") (WorkspaceSymbol (:name :kind) (:containerName :location :data)) (InlayHint (:position :label) (:kind :textEdits :tooltip :paddingLeft :paddingRight :data)) - (InlayHintLabelPart (:value) (:tooltip :location :command))) + (InlayHintLabelPart (:value) (:tooltip :location :command)) + ;; HACK! 'HierarchyItem' doesn't exist, only `CallHierarchyItem' + ;; and `TypeHierarchyItem'. But they're the same, so no bother. + (HierarchyItem (:name :kind) + (:tags :detail :uri :range :selectionRange :data)) + (CallHierarchyIncomingCall (:from :fromRanges) ()) + (CallHierarchyOutgoingCall (:to :fromRanges) ())) "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces. INTERFACE-NAME is a symbol designated by the spec as @@ -1065,6 +1076,8 @@ object." :rangeFormatting `(:dynamicRegistration :json-false) :rename `(:dynamicRegistration :json-false) :inlayHint `(:dynamicRegistration :json-false) + :callHierarchy `(:dynamicRegistration :json-false) + :typeHierarchy `(:dynamicRegistration :json-false) :publishDiagnostics (list :relatedInformation :json-false ;; TODO: We can support :codeDescription after ;; adding an appropriate UI to @@ -1245,8 +1258,8 @@ SERVER." (unwind-protect (progn (setf (eglot--shutdown-requested server) t) - (eglot--request server :shutdown nil :timeout (or timeout 1.5)) - (jsonrpc-notify server :exit nil)) + (eglot--request server :shutdown eglot--{} :timeout (or timeout 1.5)) + (jsonrpc-notify server :exit eglot--{})) ;; Now ask jsonrpc.el to shut down the server. (jsonrpc-shutdown server (not preserve-buffers)) (unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server))))) @@ -1311,22 +1324,28 @@ in `eglot-server-programs' (which see). CONTACT-PROXY is the value of the corresponding `eglot-server-programs' entry." (cl-loop + with lang-from-sym = (lambda (sym &optional language-id) + (cons sym + (or language-id + (or (get sym 'eglot-language-id) + (replace-regexp-in-string + "\\(?:-ts\\)?-mode$" "" + (symbol-name sym)))))) for (modes . contact) in eglot-server-programs for llists = (mapcar #'eglot--ensure-list - (if (or (symbolp modes) (keywordp (cadr modes))) - (list modes) modes)) + (if (or (symbolp modes) (keywordp (cadr modes))) + (list modes) modes)) for normalized = (mapcar (jsonrpc-lambda (sym &key language-id &allow-other-keys) - (cons sym - (or language-id - (or (get sym 'eglot-language-id) - (replace-regexp-in-string - "\\(?:-ts\\)?-mode$" "" - (symbol-name sym)))))) + (funcall lang-from-sym sym language-id)) llists) when (cl-some (lambda (cell) (provided-mode-derived-p mode (car cell))) normalized) - return (cons normalized contact))) + return (cons normalized contact) + ;; If lookup fails at least return some suitable LANGUAGES. + finally (cl-return + (cons (list (funcall lang-from-sym major-mode)) + nil)))) (defun eglot--guess-contact (&optional interactive) "Helper for `eglot'. @@ -1781,6 +1800,15 @@ in project `%s'." (let ((warning-minimum-level :error)) (display-warning 'eglot (apply #'eglot--format format args) :warning))) +(defun eglot--goto (range) + "Goto and momentarily highlight RANGE in current buffer." + (pcase-let ((`(,beg . ,end) (eglot-range-region range))) + ;; FIXME: it is very naughty to use someone else's `--' + ;; function, but `xref--goto-char' happens to have + ;; exactly the semantics we want vis-a-vis widening. + (xref--goto-char beg) + (pulse-momentary-highlight-region beg end 'highlight))) + (defalias 'eglot--bol (if (fboundp 'pos-bol) #'pos-bol (lambda (&optional n) (let ((inhibit-field-text-motion t)) @@ -1929,32 +1957,34 @@ Doubles as an indicator of snippet support." (unless (bound-and-true-p yas-minor-mode) (yas-minor-mode 1)) (apply #'yas-expand-snippet args))))) - (defun eglot--format-markup (markup) + (defun eglot--format-markup (markup &optional mode) "Format MARKUP according to LSP's spec. MARKUP is either an LSP MarkedString or MarkupContent object." - (let (string mode language) + (let (string render-mode language) (cond ((stringp markup) (setq string markup - mode 'gfm-view-mode)) + render-mode (or mode 'gfm-view-mode))) ((setq language (plist-get markup :language)) ;; Deprecated MarkedString (setq string (concat "```" language "\n" (plist-get markup :value) "\n```") - mode 'gfm-view-mode)) + render-mode (or mode 'gfm-view-mode))) (t ;; MarkupContent (setq string (plist-get markup :value) - mode (pcase (plist-get markup :kind) - ("markdown" 'gfm-view-mode) - ("plaintext" 'text-mode) - (_ major-mode))))) + render-mode + (or mode + (pcase (plist-get markup :kind) + ("markdown" 'gfm-view-mode) + ("plaintext" 'text-mode) + (_ major-mode)))))) (with-temp-buffer (setq-local markdown-fontify-code-blocks-natively t) (insert string) (let ((inhibit-message t) (message-log-max nil) match) - (ignore-errors (delay-mode-hooks (funcall mode))) + (ignore-errors (delay-mode-hooks (funcall render-mode))) (font-lock-ensure) (goto-char (point-min)) (let ((inhibit-read-only t)) @@ -2284,6 +2314,11 @@ If it is activated, also signal textDocument/didOpen." :visible (eglot-server-capable :codeActionProvider)] ["Quickfix" eglot-code-action-quickfix :visible (eglot-server-capable :codeActionProvider)] + "--" + ["Show type hierarchy" eglot-show-type-hierarchy + :active (eglot-server-capable :typeHierarchyProvider)] + ["Show call hierarchy" eglot-show-call-hierarchy + :active (eglot-server-capable :callHierarchyProvider)] "--")) (easy-menu-define eglot-server-menu nil "Manage server communication" @@ -2698,12 +2733,7 @@ THINGS are either registrations or unregisterations (sic)." (select-frame-set-input-focus (selected-frame))) ((display-buffer (current-buffer)))) (when selection - (pcase-let ((`(,beg . ,end) (eglot-range-region selection))) - ;; FIXME: it is very naughty to use someone else's `--' - ;; function, but `xref--goto-char' happens to have - ;; exactly the semantics we want vis-a-vis widening. - (xref--goto-char beg) - (pulse-momentary-highlight-region beg end 'highlight))))))) + (eglot--goto selection)))))) (t (setq success :json-false))) `(:success ,success))) @@ -3316,81 +3346,79 @@ for which LSP on-type-formatting should be requested." (add-to-list 'completion-category-defaults '(eglot-capf (styles eglot--dumb-flex))) (add-to-list 'completion-styles-alist '(eglot--dumb-flex eglot--dumb-tryc eglot--dumb-allc)) -(defun eglot-completion-at-point () +(cl-defun eglot-completion-at-point (&aux completion-capability) "Eglot's `completion-at-point' function." ;; Commit logs for this function help understand what's going on. - (when-let* ((completion-capability (eglot-server-capable :completionProvider))) - (let* ((server (eglot--current-server-or-lose)) - (bounds (or (bounds-of-thing-at-point 'symbol) - (cons (point) (point)))) - (bounds-string (buffer-substring (car bounds) (cdr bounds))) - (sort-completions - (lambda (completions) - (cl-sort completions - #'string-lessp - :key (lambda (c) - (plist-get - (get-text-property 0 'eglot--lsp-item c) - :sortText))))) - (metadata `(metadata (category . eglot-capf) - (display-sort-function . ,sort-completions))) - (local-cache :none) - (orig-pos (point)) - (resolved (make-hash-table)) - (proxies - (lambda () - (if (listp local-cache) local-cache - (let* ((resp (eglot--request server - :textDocument/completion - (eglot--CompletionParams) - :cancel-on-input t)) - (items (append - (if (vectorp resp) resp (plist-get resp :items)) - nil)) - (cachep (and (listp resp) items - eglot-cache-session-completions - (eq (plist-get resp :isIncomplete) :json-false))) - (retval - (mapcar - (jsonrpc-lambda - (&rest item &key label insertText insertTextFormat - textEdit &allow-other-keys) - (let ((proxy - ;; Snippet or textEdit, it's safe to - ;; display/insert the label since - ;; it'll be adjusted. If no usable - ;; insertText at all, label is best, - ;; too. - (cond ((or (eql insertTextFormat 2) - textEdit - (null insertText) - (string-empty-p insertText)) - (string-trim-left label)) - (t insertText)))) - (unless (zerop (length proxy)) - (put-text-property 0 1 'eglot--lsp-item item proxy)) - proxy)) - items))) - ;; (trace-values "Requested" (length proxies) cachep bounds) - (setq eglot--capf-session - (if cachep (list bounds retval resolved orig-pos - bounds-string) :none)) - (setq local-cache retval))))) - (resolve-maybe - ;; Maybe completion/resolve JSON object `lsp-comp' into - ;; another JSON object, if at all possible. Otherwise, - ;; just return lsp-comp. - (lambda (lsp-comp &optional dont-cancel-on-input) - (or (gethash lsp-comp resolved) - (setf (gethash lsp-comp resolved) - (if (and (eglot-server-capable :completionProvider - :resolveProvider) - (plist-get lsp-comp :data)) - (eglot--request server :completionItem/resolve - lsp-comp :cancel-on-input - (not dont-cancel-on-input) - :immediate t) - lsp-comp)))))) + (setq completion-capability (eglot-server-capable :completionProvider)) + (unless completion-capability (cl-return-from eglot-completion-at-point)) + (let* ((server (eglot--current-server-or-lose)) + (bounds (or (bounds-of-thing-at-point 'symbol) + (cons (point) (point)))) + (bounds-string (buffer-substring (car bounds) (cdr bounds))) + (local-cache :none) + (orig-pos (point)) + (resolved (make-hash-table))) + (cl-labels + ((sort-completions (completions) + (cl-sort completions + #'string-lessp + :key (lambda (c) + (plist-get + (get-text-property 0 'eglot--lsp-item c) + :sortText)))) + (proxies () + (if (listp local-cache) local-cache + (let* ((resp (eglot--request server + :textDocument/completion + (eglot--CompletionParams) + :cancel-on-input t)) + (items (append + (if (vectorp resp) resp (plist-get resp :items)) + nil)) + (cachep (and (listp resp) items + eglot-cache-session-completions + (eq (plist-get resp :isIncomplete) :json-false))) + (retval + (mapcar + (jsonrpc-lambda + (&rest item &key label insertText insertTextFormat + textEdit &allow-other-keys) + (let ((proxy + ;; Snippet or textEdit, it's safe to + ;; display/insert the label since + ;; it'll be adjusted. If no usable + ;; insertText at all, label is best, + ;; too. + (cond ((or (eql insertTextFormat 2) + textEdit + (null insertText) + (string-empty-p insertText)) + (string-trim-left label)) + (t insertText)))) + (unless (zerop (length proxy)) + (put-text-property 0 1 'eglot--lsp-item item proxy)) + proxy)) + items))) + ;; (trace-values "Requested" (length proxies) cachep bounds) + (setq eglot--capf-session + (if cachep (list bounds retval resolved orig-pos + bounds-string) + :none)) + (setq local-cache retval)))) + (ensure-resolved (lsp-comp &optional dont-cancel-on-input) + ;; Maybe completion/resolve JSON object `lsp-comp' into + ;; another JSON object, if at all possible. Otherwise, + ;; just return lsp-comp. + (or (gethash lsp-comp resolved) + (setf (gethash lsp-comp resolved) + (if (and (eglot-server-capable :completionProvider + :resolveProvider) + (plist-get lsp-comp :data)) + (eglot--request server :completionItem/resolve + lsp-comp :cancel-on-input + (not dont-cancel-on-input) + :immediate t) + lsp-comp))))) (when (and (consp eglot--capf-session) (= (car bounds) (car (nth 0 eglot--capf-session))) (>= (cdr bounds) (cdr (nth 0 eglot--capf-session)))) @@ -3405,14 +3433,16 @@ for which LSP on-type-formatting should be requested." (cdr bounds) (lambda (pattern pred action) (cond - ((eq action 'metadata) metadata) ; metadata + ((eq action 'metadata) ; metadata + `(metadata (category . eglot-capf) + (display-sort-function . ,#'sort-completions))) ((eq action 'lambda) ; test-completion - (test-completion pattern (funcall proxies))) + (test-completion pattern (proxies))) ((eq (car-safe action) 'boundaries) nil) ; boundaries ((null action) ; try-completion - (try-completion pattern (funcall proxies))) + (try-completion pattern (proxies))) ((eq action t) ; all-completions - (let ((comps (funcall proxies))) + (let ((comps (proxies))) (dolist (c comps) (eglot--dumb-flex pattern c completion-ignore-case)) (all-completions "" @@ -3456,17 +3486,18 @@ for which LSP on-type-formatting should be requested." 1) (eq t (plist-get lsp-item :deprecated))))) :company-docsig - ;; FIXME: autoImportText is specific to the pyright language server (lambda (proxy) - (when-let* ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)) - (data (plist-get (funcall resolve-maybe lsp-comp) :data)) - (import-text (plist-get data :autoImportText))) - import-text)) + (let ((detail (plist-get + (ensure-resolved (get-text-property 0 'eglot--lsp-item proxy)) + :detail))) + (when (and (stringp detail) (not (string= detail ""))) + (eglot--format-markup detail major-mode)))) :company-doc-buffer (lambda (proxy) - (let* ((documentation - (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy))) - (plist-get (funcall resolve-maybe lsp-comp) :documentation))) + (let* ((resolved + (ensure-resolved (get-text-property 0 'eglot--lsp-item proxy))) + (documentation + (plist-get resolved :documentation)) (formatted (and documentation (eglot--format-markup documentation)))) (when formatted @@ -3497,15 +3528,14 @@ for which LSP on-type-formatting should be requested." (current-buffer)) (eglot--dbind ((CompletionItem) insertTextFormat insertText textEdit additionalTextEdits label) - (funcall - resolve-maybe + (ensure-resolved (or (get-text-property 0 'eglot--lsp-item proxy) ;; When selecting from the *Completions* ;; buffer, `proxy' won't have any properties. ;; A lookup should fix that (github#148) (get-text-property 0 'eglot--lsp-item - (cl-find proxy (funcall proxies) :test #'string=))) + (cl-find proxy (proxies) :test #'string=))) ;; Be sure to pass non-nil here since we don't want ;; any quick typing after the soon-to-be-undone ;; insertion to potentially cancel an essential @@ -4246,47 +4276,47 @@ If NOERROR, return predicate, else erroring function." (defvar-local eglot--outstanding-inlay-regions-timer nil "Helper timer for `eglot--update-hints'.") -(defun eglot--update-hints (from to) +(cl-defun eglot--update-hints (from to) "Jit-lock function for Eglot inlay hints." + ;; XXX: We're relying on knowledge of jit-lock internals here. + ;; Comparing `jit-lock-context-unfontify-pos' (if non-nil) to + ;; `point-max' tells us whether this call to `jit-lock-functions' + ;; happens after `jit-lock-context-timer' has just run. + (when (and jit-lock-context-unfontify-pos + (/= jit-lock-context-unfontify-pos (point-max))) + (cl-return-from eglot--update-hints)) (cl-symbol-macrolet ((region eglot--outstanding-inlay-hints-region) (last-region eglot--outstanding-inlay-hints-last-region) (timer eglot--outstanding-inlay-regions-timer)) (setcar region (min (or (car region) (point-max)) from)) (setcdr region (max (or (cdr region) (point-min)) to)) - ;; HACK: We're relying on knowledge of jit-lock internals here. The - ;; condition comparing `jit-lock-context-unfontify-pos' to - ;; `point-max' is a heuristic for telling whether this call to - ;; `jit-lock-functions' happens after `jit-lock-context-timer' has - ;; just run. Only after this delay should we start the smoothing - ;; timer that will eventually call `eglot--update-hints-1' with the - ;; coalesced region. I wish we didn't need the timer, but sometimes - ;; a lot of "non-contextual" calls come in all at once and do verify - ;; the condition. Notice it is a 0 second timer though, so we're - ;; not introducing any more delay over jit-lock's timers. - (when (= jit-lock-context-unfontify-pos (point-max)) - (if timer (cancel-timer timer)) - (let ((buf (current-buffer))) - (setq timer (run-at-time - 0 nil - (lambda () - (eglot--when-live-buffer buf - ;; HACK: In some pathological situations - ;; (Emacs's own coding.c, for example), - ;; jit-lock is calling `eglot--update-hints' - ;; repeatedly with same sequence of - ;; arguments, which leads to - ;; `eglot--update-hints-1' being called with - ;; the same region repeatedly. This happens - ;; even if the hint-painting code does - ;; nothing else other than widen, narrow, - ;; move point then restore these things. - ;; Possible Emacs bug, but this fixes it. - (unless (equal last-region region) - (eglot--update-hints-1 (max (car region) (point-min)) - (min (cdr region) (point-max))) - (setq last-region region)) - (setq region (cons nil nil) - timer nil))))))))) + ;; XXX: Then there is a smoothing timer. I wish we didn't need it, + ;; but sometimes a lot of calls come in all at once and do make it + ;; past the check above. Notice it is a 0 second timer though, so + ;; we're not introducing any more delay over jit-lock's timers. + (when timer (cancel-timer timer)) + (setq timer (run-at-time + 0 nil + (lambda (buf) + (eglot--when-live-buffer buf + ;; HACK: In some pathological situations + ;; (Emacs's own coding.c, for example), + ;; jit-lock is calling `eglot--update-hints' + ;; repeatedly with same sequence of + ;; arguments, which leads to + ;; `eglot--update-hints-1' being called with + ;; the same region repeatedly. This happens + ;; even if the hint-painting code does + ;; nothing else other than widen, narrow, + ;; move point then restore these things. + ;; Possible Emacs bug, but this fixes it. + (unless (equal last-region region) + (eglot--update-hints-1 (max (car region) (point-min)) + (min (cdr region) (point-max))) + (setq last-region region)) + (setq region (cons nil nil) + timer nil))) + (current-buffer))))) (defun eglot--update-hints-1 (from to) "Do most work for `eglot--update-hints', including LSP request." @@ -4368,6 +4398,224 @@ If NOERROR, return predicate, else erroring function." (jit-lock-unregister #'eglot--update-hints) (remove-overlays nil nil 'eglot--inlay-hint t)))) + +;;; Call and type hierarchies +(require 'button) +(require 'tree-widget) + +(define-button-type 'eglot--hierarchy-item + 'follow-link t + 'face 'font-lock-function-name-face) + +(defun eglot--hierarchy-interactive (specs) + (let ((ans + (completing-read "[eglot] Direction (default both)?" + (cons "both" (mapcar #'cl-fourth specs)) + nil t nil nil "both"))) + (list + (cond ((equal ans "both") t) + (t (cl-third (cl-find ans specs :key #'cl-fourth :test #'equal))))))) + +(defmacro eglot--define-hierarchy-command + (name kind feature preparer specs) + `(defun ,name (direction) + ,(concat + "Show " kind " hierarchy for symbol at point.\n" + "DIRECTION can be:\n" + (cl-loop for (_ _ d e) in specs + concat (format " - `%s' for %s;\n" d e)) + "or t, the default, to consider both.\n" + "Interactively with a prefix argument, prompt for DIRECTION.") + (interactive (if current-prefix-arg + (eglot--hierarchy-interactive ',specs) + (list t))) + (let* ((specs ',specs) + (specs (if (eq t direction) specs + (list + (cl-find direction specs :key #'cl-third))))) + (eglot--hierarchy-1 + (format "*EGLOT %s hierarchy for %s*" + ,kind + (eglot-project-nickname (eglot--current-server-or-lose))) + ,feature ,preparer specs)))) + +(eglot--define-hierarchy-command + eglot-show-type-hierarchy + "type" + :typeHierarchyProvider + :textDocument/prepareTypeHierarchy + ((:typeHierarchy/supertypes " ↑ " derived "supertypes" "derives from") + (:typeHierarchy/subtypes " ↓ " base "subtypes" "base of"))) + +(eglot--define-hierarchy-command + eglot-show-call-hierarchy + "call" + :callHierarchyProvider + :textDocument/prepareCallHierarchy + ((:callHierarchy/incomingCalls " ← " incoming "incoming calls" "called by" + :from :fromRanges) + (:callHierarchy/outgoingCalls " → " base "outgoing calls" "calls" + :to :fromRanges))) + +(defvar-local eglot--hierarchy-roots nil) +(defvar-local eglot--hierarchy-specs nil) +(defvar-local eglot--hierarchy-source-major-mode nil) + +(defun eglot--hierarchy-children (node) + (cl-flet ((get-them (method node) + (eglot--dbind ((HierarchyItem) name) node + (let* ((sym (intern (format "eglot--%s" method))) + (plist (text-properties-at 0 name)) + (probe (cl-getf plist sym :none))) + (cond ((eq probe :none) + (let ((v (ignore-errors (jsonrpc-request + (eglot--current-server-or-lose) method + `(:item ,node))))) + (put-text-property 0 1 sym v name) + v)) + (t probe)))))) + (cl-loop + with specs = eglot--hierarchy-specs + for (method bullet _ _ hint key ranges) in specs + for resp = (get-them method node) + for items = + (cl-loop for r across resp + for item = (if key (plist-get r key) r) + collect item + do (eglot--dbind ((HierarchyItem) name) item + (put-text-property 0 1 'eglot--hierarchy-method + method name) + (put-text-property 0 1 'eglot--hierarchy-bullet + (propertize bullet + 'help-echo hint) + name) + (when ranges + (put-text-property 0 1 'eglot--hierarchy-call-sites + (plist-get r ranges) + name)))) + append items))) + +(defvar eglot-hierarchy-label-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map button-map) + (define-key map [mouse-3] (eglot--mouse-call + #'eglot-hierarchy-center-on-node)) + map) + "Keymap active in labels Eglot hierarchy buffers.") + +(defun eglot--hierarchy-label (node) + (eglot--dbind ((HierarchyItem) name uri _detail ((:range item-range))) node + (with-temp-buffer + (insert (propertize + (or (get-text-property + 0 'eglot--hierarchy-bullet name) + " ∘ ") + 'face 'shadow)) + (insert-text-button + name + :type 'eglot--hierarchy-item + 'eglot--hierarchy-node node + 'help-echo "mouse-1, RET: goto definition, mouse-3: center on node" + 'keymap eglot-hierarchy-label-map + 'action + (lambda (_btn) + (pop-to-buffer (find-file-noselect (eglot-uri-to-path uri))) + (eglot--goto + (or + (elt + (get-text-property 0 'eglot--hierarchy-call-sites name) + 0) + item-range)))) + (buffer-string)))) + +(defun eglot--hierarchy-1 (name provider preparer specs) + (eglot-server-capable-or-lose provider) + (let* ((server (eglot-current-server)) + (mode major-mode) + (roots (jsonrpc-request + server + preparer + (eglot--TextDocumentPositionParams)))) + (unless (cl-plusp (length roots)) + (eglot--error "No hierarchy information here")) + (with-current-buffer (get-buffer-create name) + (eglot-hierarchy-mode) + (setq-local + eglot--hierarchy-roots roots + eglot--hierarchy-specs specs + eglot--cached-server server + eglot--hierarchy-source-major-mode mode + buffer-read-only t + revert-buffer-function + (lambda (&rest _ignore) + ;; flush cache, would defeat purpose of a revert + (mapc (lambda (r) + (eglot--dbind ((HierarchyItem) name) r + (set-text-properties 0 1 nil name))) + eglot--hierarchy-roots) + (eglot--hierarchy-2))) + (eglot--hierarchy-2)))) + +(defun eglot--hierarchy-2 () + (cl-labels ((expander-for (node) + (lambda (_widget) + (mapcar + #'convert + (eglot--hierarchy-children node)))) + (convert (node) + (let ((w (widget-convert + 'tree-widget + :tag (eglot--hierarchy-label node) + :expander (expander-for node)))) + (widget-put w :empty-icon + (widget-get w :leaf-icon)) + w))) + (let ((inhibit-read-only t)) + (erase-buffer) + (mapc (lambda (r) + (let ((w (widget-create (convert r)))) + (widget-apply-action w))) + eglot--hierarchy-roots) + (goto-char (point-min)))) + (pop-to-buffer (current-buffer))) + +(define-derived-mode eglot-hierarchy-mode special-mode + "Eglot special" "Eglot mode for viewing hierarchies. +\\{eglot-hierarchy-mode-map}" + :interactive nil + (setq eldoc-documentation-strategy + #'eldoc-documentation-compose) + (add-hook 'eldoc-documentation-functions + #'eglot-hierarchy-detail-eldoc-function + nil t) + (add-hook 'eldoc-documentation-functions + #'eglot-hierarchy-locus-eldoc-function + t t)) + +(defun eglot-hierarchy-center-on-node () + "Refresh hierarchy, centering on node at point." + (interactive) + (setq-local eglot--hierarchy-roots + (list (get-text-property (point) + 'eglot--hierarchy-node))) + (eglot--hierarchy-2)) + +(defun eglot-hierarchy-detail-eldoc-function (_cb &rest _ignored) + (when-let* ((detail + (plist-get (get-text-property (point) 'eglot--hierarchy-node) + :detail))) + (eglot--format-markup detail eglot--hierarchy-source-major-mode))) + +(defun eglot-hierarchy-locus-eldoc-function (_cb &rest _ignored) + (let* ((node (get-text-property (point) 'eglot--hierarchy-node)) + (uri (plist-get node :uri)) + (loc (plist-get (plist-get node :range) :start))) + (and uri loc + ;; maybe use `file-relative-name'? + (format "%s:%s:%s" (eglot-uri-to-path uri) + (1+ (plist-get loc :line)) + (plist-get loc :character))))) + ;;; Hacks ;;; diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 078563a123c..d61cf4684f9 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1340,8 +1340,7 @@ Semicolons start comments. \\{lisp-interaction-mode-map}" :abbrev-table nil - (setq-local lexical-binding t) - (setq-local trusted-content :all)) + (setq-local lexical-binding t)) ;;; Emacs Lisp Byte-Code mode diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index b322b35ed63..42057a3aacb 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -445,6 +445,10 @@ Returns non-nil if it is a valid table." (set-buffer (get-file-buffer file)) (or verify-tags-table-function (tags-table-mode)) (unless (or (verify-visited-file-modtime (current-buffer)) + ;; 'verify-visited-file-modtime' return non-nil if + ;; the tags table file was meanwhile deleted. Avoid + ;; asking the question below again if so. + (not (file-exists-p file)) ;; Decide whether to revert the file. ;; revert-without-query can say to revert ;; or the user can say to revert. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index ef2af3cd5af..3b0b519f239 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -26,6 +26,8 @@ ;; ;; go-ts-mode is known to work with the following languages and version: ;; - tree-sitter-go: v0.23.4-1-g12fe553 +;; - tree-sitter-go-mod: v1.1.0-3b01edce +;; - tree-sitter-go-work: 949a8a47 ;; ;; We try our best to make builtin modes work with latest grammar ;; versions, so a more recent grammar version has a good chance to work. @@ -33,10 +35,14 @@ ;;; Commentary: ;; +;; Go uses tabs as a convention for indentation: +;; https://go.dev/doc/effective_go#formatting +;; so `indent-tabs-mode' is enabled for the modes. ;;; Code: (require 'treesit) +(require 'c-ts-common) (eval-when-compile (require 'rx)) (treesit-declare-unavailable-functions) @@ -274,9 +280,7 @@ (setq treesit-primary-parser (treesit-parser-create 'go)) ;; Comments. - (setq-local comment-start "// ") - (setq-local comment-end "") - (setq-local comment-start-skip (rx "//" (* (syntax whitespace)))) + (c-ts-common-comment-setup) ;; Navigation. (setq-local treesit-defun-type-regexp @@ -478,7 +482,7 @@ be run." default-directory (go-ts-mode--get-test-flags)))) -;; go.mod support. +;;;; go.mod support. (defvar go-mod-ts-mode--syntax-table (let ((table (make-syntax-table))) @@ -495,12 +499,12 @@ be run." ((parent-is "replace_directive") parent-bol go-ts-mode-indent-offset) ((parent-is "require_directive") parent-bol go-ts-mode-indent-offset) ((parent-is "retract_directive") parent-bol go-ts-mode-indent-offset) - ((go-mod-ts-mode--in-directive-p) no-indent go-ts-mode-indent-offset) + ((go-mod-ts-mode--directive-matcher) no-indent go-ts-mode-indent-offset) (no-node no-indent 0))) "Tree-sitter indent rules for `go-mod-ts-mode'.") -(defun go-mod-ts-mode--in-directive-p () - "Return non-nil if point is inside a directive. +(defun go-mod-ts-mode--directive-matcher () + "Return a function for determining if point is inside a Go module directive. When entering an empty directive or adding a new entry to one, no node will be present meaning none of the indentation rules will match, because there is no parent to match against. This function determines @@ -510,12 +514,12 @@ what the parent of the node would be if it were a node." (save-excursion (backward-up-list) (back-to-indentation) - (pcase (treesit-node-type (treesit-node-at (point))) - ("exclude" t) - ("module" t) - ("replace" t) - ("require" t) - ("retract" t)))))) + (member (treesit-node-type (treesit-node-at (point))) + '("exclude" + "module" + "replace" + "require" + "retract")))))) (defvar go-mod-ts-mode--keywords '("exclude" "go" "module" "replace" "require" "retract") @@ -559,9 +563,7 @@ what the parent of the node would be if it were a node." (setq treesit-primary-parser (treesit-parser-create 'gomod)) ;; Comments. - (setq-local comment-start "// ") - (setq-local comment-end "") - (setq-local comment-start-skip (rx "//" (* (syntax whitespace)))) + (c-ts-common-comment-setup) ;; Indent. (setq-local indent-tabs-mode t @@ -582,6 +584,94 @@ what the parent of the node would be if it were a node." (if (treesit-ready-p 'gomod) (add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode))) +;;;; go.work support. + +(defvar go-work-ts-mode--indent-rules + `((gowork + ((node-is ")") parent-bol 0) + ((parent-is "replace_directive") parent-bol go-ts-mode-indent-offset) + ((parent-is "use_directive") parent-bol go-ts-mode-indent-offset) + ((go-work-ts-mode--directive-matcher) no-indent go-ts-mode-indent-offset) + (no-node no-indent 0))) + "Tree-sitter indent rules for `go-work-ts-mode'.") + +(defun go-work-ts-mode--directive-matcher () + "Return a function for determining if point is inside a Go workspace directive. +When entering an empty directive or adding a new entry to one, no node +will be present meaning none of the indentation rules will match, +because there is no parent to match against. This function determines +what the parent of the node would be if it were a node." + (lambda (node _ _ &rest _) + (unless (treesit-node-type node) + (save-excursion + (backward-up-list) + (back-to-indentation) + (member (treesit-node-type (treesit-node-at (point))) + '("replace" + "use")))))) + +(defvar go-work-ts-mode--keywords + '("go" "replace" "use") + "go.work keywords for tree-sitter font-locking.") + +(defvar go-work-ts-mode--font-lock-settings + (treesit-font-lock-rules + :language 'gowork + :feature 'bracket + '((["(" ")"]) @font-lock-bracket-face) + + :language 'gowork + :feature 'comment + '((comment) @font-lock-comment-face) + + :language 'gowork + :feature 'keyword + `([,@go-work-ts-mode--keywords] @font-lock-keyword-face) + + :language 'gowork + :feature 'number + '([(go_version) (version)] @font-lock-number-face) + + :language 'gowork + :feature 'operator + '((["=>"]) @font-lock-operator-face) + + :language 'gowork + :feature 'error + :override t + '((ERROR) @font-lock-warning-face)) + "Tree-sitter font-lock settings for `go-work-ts-mode'.") + +;;;###autoload +(define-derived-mode go-work-ts-mode prog-mode "Go Work" + "Major mode for editing go.work files, powered by tree-sitter." + :group 'go + + (when (treesit-ready-p 'gowork) + (setq treesit-primary-parser (treesit-parser-create 'gowork)) + + ;; Comments. + (setq-local comment-start "// ") + (setq-local comment-end "") + (setq-local comment-start-skip (rx "//" (* (syntax whitespace)))) + + ;; Indent. + (setq-local indent-tabs-mode t + treesit-simple-indent-rules go-work-ts-mode--indent-rules) + + ;; Font-lock. + (setq-local treesit-font-lock-settings go-work-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-feature-list + '((comment) + (keyword) + (number) + (bracket error operator))) + + (treesit-major-mode-setup))) + +;;;###autoload +(add-to-list 'auto-mode-alist '("/go\\.work\\'" . go-work-ts-mode)) + (provide 'go-ts-mode) ;;; go-ts-mode.el ends here diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index b63de1abff2..7ced54170ff 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1261,42 +1261,16 @@ containing the executable being debugged." output)) -;; The dbx in IRIX is a pain. It doesn't print the file name when -;; stopping at a breakpoint (but you do get it from the `up' and -;; `down' commands...). The only way to extract the information seems -;; to be with a `file' command, although the current line number is -;; available in $curline. Thus we have to look for output which -;; appears to indicate a breakpoint. Then we prod the dbx sub-process -;; to output the information we want with a combination of the -;; `printf' and `file' commands as a pseudo marker which we can -;; recognize next time through the marker-filter. This would be like -;; the gdb marker but you can't get the file name without a newline... -;; Note that gud-remove won't work since Irix dbx expects a breakpoint -;; number rather than a line number etc. Maybe this could be made to -;; work by listing all the breakpoints and picking the one(s) with the -;; correct line number, but life's too short. -;; d.love@dl.ac.uk (Dave Love) can be blamed for this - (defvar gud-irix-p nil "Non-nil to assume the interface appropriate for IRIX dbx. This works in IRIX 4, 5 and 6, but `gud-dbx-use-stopformat-p' provides a better solution in 6.1 upwards.") +(make-obsolete-variable 'gud-irix-p nil "31.1") (defvar gud-dbx-use-stopformat-p nil "Non-nil to use the dbx feature present at least from Irix 6.1 whereby $stopformat=1 produces an output format compatible with `gud-dbx-marker-filter'.") -;; [Irix dbx seemed to be a moving target. The dbx output changed -;; subtly sometime between OS v4.0.5 and v5.2 so that, for instance, -;; the output from `up' is no longer spotted by gud (and it's probably -;; not distinctive enough to try to match it -- use C-<, C-> -;; exclusively) . For 5.3 and 6.0, the $curline variable changed to -;; `long long'(why?!), so the printf stuff needed changing. The line -;; number was cast to `long' as a compromise between the new `long -;; long' and the original `int'. This was reported not to work in 6.2, -;; so it's changed back to int -- don't make your sources too long. -;; From Irix6.1 (but not 6.0?) dbx supported an undocumented feature -;; whereby `set $stopformat=1' reportedly produces output compatible -;; with `gud-dbx-marker-filter', which we prefer. +(make-obsolete-variable 'gud-dbx-use-stopformat-p nil "31.1") (defvar-keymap gud-dbx-repeat-map :doc "Keymap to repeat `dbx' stepping instructions \\`C-x C-a C-n n n'. @@ -1313,13 +1287,8 @@ Used in `repeat-mode'." gud-irix-p) (keymap-set gud-dbx-repeat-map "f" #'gud-finish)) - -;; The process filter is also somewhat -;; unreliable, sometimes not spotting the markers; I don't know -;; whether there's anything that can be done about that.] - -;; this filter is influenced by the xdb one rather than the gdb one (defun gud-irixdbx-marker-filter (string) + (declare (obsolete nil "31.1")) (let (result (case-fold-search nil)) (if (or (string-match comint-prompt-regexp string) (string-match ".*\012" string)) @@ -1417,8 +1386,9 @@ and source-file directory for your debugger." (gud-mips-p (gud-common-init command-line nil 'gud-mipsdbx-marker-filter)) (gud-irix-p - (gud-common-init command-line 'gud-dbx-massage-args - 'gud-irixdbx-marker-filter)) + (with-suppressed-warnings ((obsolete gud-irixdbx-marker-filter)) + (gud-common-init command-line 'gud-dbx-massage-args + #'gud-irixdbx-marker-filter))) (t (gud-common-init command-line 'gud-dbx-massage-args 'gud-dbx-marker-filter))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 8029a304757..3168395acf1 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3490,7 +3490,10 @@ Check if a node type is available, then return the right indent rules." ((match "/" "jsx_self_closing_element") parent 0) ((parent-is "jsx_self_closing_element") parent js-indent-level) ;; FIXME(Theo): This no-node catch-all should be removed. When is it needed? - (no-node parent-bol 0))))) + (no-node parent-bol 0)) + (jsdoc + ((and (parent-is "document") c-ts-common-looking-at-star) + c-ts-common-comment-start-after-first-star -1))))) (defvar js--treesit-keywords '("as" "async" "await" "break" "case" "catch" "class" "const" "continue" @@ -3718,6 +3721,22 @@ Return nil if there is no name or if NODE is not a defun node." ("lexical_declaration" (treesit-node-top-level node)) (_ t))) +(defun js--treesit-language-at-point (point) + "Return the language at POINT." + (let* ((node (treesit-node-at point 'javascript)) + (node-type (treesit-node-type node)) + (node-start (treesit-node-start node)) + (node-end (treesit-node-end node))) + (if (not (treesit-ready-p 'jsdoc t)) + 'javascript + (if (equal node-type "comment") + (save-excursion + (goto-char node-start) + (if (search-forward "/**" node-end t) + 'jsdoc + 'javascript)) + 'javascript)))) + ;;; Main Function ;;;###autoload @@ -3927,6 +3946,7 @@ See `treesit-thing-settings' for more information.") ;; Tree-sitter setup. (setq-local treesit-primary-parser (treesit-parser-create 'javascript)) + (setq-local treesit-language-at-point-function #'js--treesit-language-at-point) ;; Indent. (setq-local treesit-simple-indent-rules js--treesit-indent-rules) diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index f26ba9e8d63..1b8f033e97a 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -152,6 +152,7 @@ Return nil if there is no name or if NODE is not a defun node." (setq-local treesit-thing-settings `((json + (list ,(rx (or "object" "array"))) (sentence "pair")))) ;; Font-lock. @@ -165,7 +166,12 @@ Return nil if there is no name or if NODE is not a defun node." (setq-local treesit-simple-imenu-settings '((nil "\\`pair\\'" nil nil))) - (treesit-major-mode-setup)) + (treesit-major-mode-setup) + + ;; Disable outlines since they are created for 'pair' from + ;; 'treesit-simple-imenu-settings' almost on every line: + (kill-local-variable 'outline-search-function) + (kill-local-variable 'outline-level)) (derived-mode-add-parents 'json-ts-mode '(json-mode)) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index f2a27ff91dd..35bf66c9ffb 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1284,6 +1284,34 @@ directories listed in `vc-directory-exclusion-list'." (user-error "You didn't specify the file") (find-file file)))) +;;;###autoload +(defun project-find-matching-file () + "Visit the file that matches the current one, in another project. +It will skip to the same line number as well. +A matching file has the same file name relative to the project root. +When called during switching to another project, this command will +detect it and use the override. Otherwise, it prompts for the project +to use from the known list." + (interactive) + (let* ((pr (project-current)) + (line (line-number-at-pos nil t)) + relative-name mirror-name) + (if project-current-directory-override + (let* (project-current-directory-override + (real-project (project-current t))) + (setq relative-name (file-relative-name buffer-file-name + (project-root real-project)))) + (setq relative-name (file-relative-name buffer-file-name (project-root pr))) + (setq pr (project-read-project))) + (setq mirror-name (expand-file-name relative-name (project-root pr))) + (if (not (file-exists-p mirror-name)) + (user-error "File `%s' not found in `%s'" relative-name (project-root pr)) + (find-file mirror-name) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- line)))))) + (defun project--completing-read-strict (prompt collection &optional predicate hist mb-default @@ -1824,7 +1852,8 @@ With some possible metadata (to be decided).") (lambda (elem) (let ((name (car elem))) (list (if (file-remote-p name) name - (abbreviate-file-name name))))) + (file-name-as-directory + (abbreviate-file-name name)))))) (condition-case nil (read (current-buffer)) (end-of-file @@ -2027,11 +2056,13 @@ bindings from `project-prefix-map'." (project-any-command project-prefix-map "[execute in %s]:")) (defun project-remember-projects-under (dir &optional recursive) - "Index all projects below a directory DIR. -If RECURSIVE is non-nil, recurse into all subdirectories to find -more projects. After finishing, a message is printed summarizing -the progress. The function returns the number of detected -projects." + "Remember projects below a directory DIR. +Interactively, prompt for DIR. +Optional argument RECURSIVE, if non-nil (interactively, the prefix +argument) means recurse into subdirectories of DIR to find more +projects. +Display a message at the end summarizing what was found. +Return the number of detected projects." (interactive "DDirectory: \nP") (project--ensure-read-project-list) (let ((dirs (if recursive @@ -2054,8 +2085,9 @@ projects." (if (zerop count) (message "No projects were found") (project--write-project-list) - (message "%d project%s were found" - count (if (= count 1) "" "s"))) + (message (ngettext "%d project was found" + "%d projects were found" + count) count)) count)) (defun project-forget-zombie-projects () @@ -2067,10 +2099,12 @@ projects." (defun project-forget-projects-under (dir &optional recursive) "Forget all known projects below a directory DIR. -If RECURSIVE is non-nil, recurse into all subdirectories to -remove all known projects. After finishing, a message is printed -summarizing the progress. The function returns the number of -forgotten projects." +Interactively, prompt for DIR. +Optional argument RECURSIVE, if non-nil (interactively, the prefix +argument), means recurse into subdirectories under DIR +to remove those projects from the index. +Display a message at the end summarizing what was forgotten. +Return the number of forgotten projects." (interactive "DDirectory: \nP") (let ((count 0)) (if recursive @@ -2085,8 +2119,9 @@ forgotten projects." (if (zerop count) (message "No projects were forgotten") (project--write-project-list) - (message "%d project%s were forgotten" - count (if (= count 1) "" "s"))) + (message (ngettext "%d project was forgotten" + "%d projects were forgotten" + count) count)) count)) @@ -2180,7 +2215,7 @@ Otherwise, use the face `help-key-binding' in the prompt." project-switch-commands " ")) -(defun project--switch-project-command () +(defun project--switch-project-command (&optional dir) (let* ((commands-menu (mapcar (lambda (row) @@ -2210,7 +2245,14 @@ Otherwise, use the face `help-key-binding' in the prompt." (propertize "Unrecognized input" 'face 'warning) (help-key-description choice nil))))) - (setq choice (read-key-sequence (concat "Choose: " prompt))) + (setq choice (read-key-sequence (concat + (if dir + (format-message "Command in `%s': " + (propertize + dir 'face + 'font-lock-string-face)) + "Command: ") + prompt))) (when (setq command (lookup-key commands-map choice)) (when (numberp command) (setq command nil)) (unless (or project-switch-use-entire-map @@ -2235,7 +2277,7 @@ to directory DIR." (project--remember-dir dir) (let ((command (if (symbolp project-switch-commands) project-switch-commands - (project--switch-project-command))) + (project--switch-project-command dir))) (buffer (current-buffer))) (unwind-protect (progn diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3a297a3979c..a42e2b2a28a 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -316,6 +316,16 @@ To customize the Python interpreter for interactive use, modify :version "30.1" :type 'string) +(defcustom python-2-support nil + "If non-nil, enable Python 2 support. +Currently only affects highlighting. + +After customizing this variable, you must restart Emacs for it to take +effect." + :version "31.1" + :type 'boolean + :safe 'booleanp) + ;;; Bindings @@ -689,6 +699,40 @@ the {...} holes that appear within f-strings." This is the minimum decoration level, including function and class declarations.") +(defvar python-font-lock-builtin-types + '("bool" "bytearray" "bytes" "complex" "dict" "float" "frozenset" + "int" "list" "memoryview" "range" "set" "str" "tuple")) + +(defvar python-font-lock-builtins-python3 + '("abs" "aiter" "all" "anext" "any" "ascii" "bin" "breakpoint" + "callable" "chr" "classmethod" "compile" "delattr" "dir" "divmod" + "enumerate" "eval" "exec" "filter" "format" "getattr" "globals" + "hasattr" "hash" "help" "hex" "id" "input" "isinstance" + "issubclass" "iter" "len" "locals" "map" "max" "min" "next" + "object" "oct" "open" "ord" "pow" "print" "property" "repr" + "reversed" "round" "setattr" "slice" "sorted" "staticmethod" "sum" + "super" "type" "vars" "zip" "__import__")) + +(defvar python-font-lock-builtins-python2 + '("basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce" + "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce" + "intern")) + +(defvar python-font-lock-builtins + (append python-font-lock-builtins-python3 + (when python-2-support + python-font-lock-builtins-python2))) + +(defvar python-font-lock-special-attributes + '(;; https://docs.python.org/3/reference/datamodel.html + "__annotations__" "__bases__" "__closure__" "__code__" + "__defaults__" "__dict__" "__doc__" "__firstlineno__" + "__globals__" "__kwdefaults__" "__name__" "__module__" + "__mro__" "__package__" "__qualname__" + "__static_attributes__" "__type_params__" + ;; Extras: + "__all__")) + (defvar python-font-lock-keywords-level-2 `(,@python-font-lock-keywords-level-1 ,(rx symbol-start @@ -711,33 +755,11 @@ class declarations.") "self") symbol-end) ;; Builtins - (,(rx symbol-start - (or - "abs" "all" "any" "bin" "bool" "callable" "chr" "classmethod" - "compile" "complex" "delattr" "dict" "dir" "divmod" "enumerate" - "eval" "filter" "float" "format" "frozenset" "getattr" "globals" - "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance" - "issubclass" "iter" "len" "list" "locals" "map" "max" "memoryview" - "min" "next" "object" "oct" "open" "ord" "pow" "print" "property" - "range" "repr" "reversed" "round" "set" "setattr" "slice" "sorted" - "staticmethod" "str" "sum" "super" "tuple" "type" "vars" "zip" - "__import__" - ;; Python 2: - "basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce" - "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce" - "intern" - ;; Python 3: - "aiter" "anext" "ascii" "breakpoint" "bytearray" "bytes" "exec" - ;; Special attributes: - ;; https://docs.python.org/3/reference/datamodel.html - "__annotations__" "__bases__" "__closure__" "__code__" - "__defaults__" "__dict__" "__doc__" "__firstlineno__" - "__globals__" "__kwdefaults__" "__name__" "__module__" - "__mro__" "__package__" "__qualname__" - "__static_attributes__" "__type_params__" - ;; Extras: - "__all__") - symbol-end) . font-lock-builtin-face)) + (,(rx-to-string `(seq symbol-start + (or ,@(append python-font-lock-builtin-types + python-font-lock-builtins + python-font-lock-special-attributes)) + symbol-end)) . font-lock-builtin-face)) "Font lock keywords to use in `python-mode' for level 2 decoration. This is the medium decoration level, including everything in @@ -759,6 +781,41 @@ sign in chained assignment." (equal (char-after) ?=)) return (progn (backward-char) t)))) +(defvar python-font-lock-builtin-exceptions-python3 + '(;; Python 2 and 3: + "ArithmeticError" "AssertionError" "AttributeError" "BaseException" + "BufferError" "BytesWarning" "DeprecationWarning" "EOFError" + "EnvironmentError" "Exception" "FloatingPointError" "FutureWarning" + "GeneratorExit" "IOError" "ImportError" "ImportWarning" + "IndentationError" "IndexError" "KeyError" "KeyboardInterrupt" + "LookupError" "MemoryError" "NameError" "NotImplementedError" + "OSError" "OverflowError" "PendingDeprecationWarning" + "ReferenceError" "RuntimeError" "RuntimeWarning" "StopIteration" + "SyntaxError" "SyntaxWarning" "SystemError" "SystemExit" "TabError" + "TypeError" "UnboundLocalError" "UnicodeDecodeError" + "UnicodeEncodeError" "UnicodeError" "UnicodeTranslateError" + "UnicodeWarning" "UserWarning" "ValueError" "Warning" + "ZeroDivisionError" + ;; Python 3: + "BlockingIOError" "BrokenPipeError" "ChildProcessError" + "ConnectionAbortedError" "ConnectionError" "ConnectionRefusedError" + "ConnectionResetError" "EncodingWarning" "FileExistsError" + "FileNotFoundError" "InterruptedError" "IsADirectoryError" + "NotADirectoryError" "ModuleNotFoundError" "PermissionError" + "ProcessLookupError" "PythonFinalizationError" "RecursionError" + "ResourceWarning" "StopAsyncIteration" "TimeoutError" + "BaseExceptionGroup" "ExceptionGroup" + ;; OS specific + "VMSError" "WindowsError")) + +(defvar python-font-lock-builtin-exceptions-python2 + '("StandardError")) + +(defvar python-font-lock-builtin-exceptions + (append python-font-lock-builtin-exceptions-python3 + (when python-2-support + python-font-lock-builtin-exceptions-python2))) + (defvar python-font-lock-keywords-maximum-decoration `((python--font-lock-f-strings) ,@python-font-lock-keywords-level-2 @@ -776,38 +833,9 @@ sign in chained assignment." (0+ "." (1+ (or word ?_))))) (1 font-lock-type-face)) ;; Builtin Exceptions - (,(rx symbol-start - (or - ;; Python 2 and 3: - "ArithmeticError" "AssertionError" "AttributeError" "BaseException" - "BufferError" "BytesWarning" "DeprecationWarning" "EOFError" - "EnvironmentError" "Exception" "FloatingPointError" "FutureWarning" - "GeneratorExit" "IOError" "ImportError" "ImportWarning" - "IndentationError" "IndexError" "KeyError" "KeyboardInterrupt" - "LookupError" "MemoryError" "NameError" "NotImplementedError" - "OSError" "OverflowError" "PendingDeprecationWarning" - "ReferenceError" "RuntimeError" "RuntimeWarning" "StopIteration" - "SyntaxError" "SyntaxWarning" "SystemError" "SystemExit" "TabError" - "TypeError" "UnboundLocalError" "UnicodeDecodeError" - "UnicodeEncodeError" "UnicodeError" "UnicodeTranslateError" - "UnicodeWarning" "UserWarning" "ValueError" "Warning" - "ZeroDivisionError" - ;; Python 2: - "StandardError" - ;; Python 3: - "BlockingIOError" "BrokenPipeError" "ChildProcessError" - "ConnectionAbortedError" "ConnectionError" "ConnectionRefusedError" - "ConnectionResetError" "EncodingWarning" "FileExistsError" - "FileNotFoundError" "InterruptedError" "IsADirectoryError" - "NotADirectoryError" "ModuleNotFoundError" "PermissionError" - "ProcessLookupError" "PythonFinalizationError" "RecursionError" - "ResourceWarning" "StopAsyncIteration" "TimeoutError" - "BaseExceptionGroup" "ExceptionGroup" - ;; OS specific - "VMSError" "WindowsError" - ) - symbol-end) - . font-lock-type-face) + (,(rx-to-string `(seq symbol-start + (or ,@python-font-lock-builtin-exceptions) + symbol-end)) . font-lock-type-face) ;; single assignment with/without type hints, e.g. ;; a: int = 5 ;; b: Tuple[Optional[int], Union[Sequence[str], str]] = (None, 'foo') @@ -1015,8 +1043,7 @@ It makes underscores and dots word constituent chars.") "and" "in" "is" "not" "or" "not in" "is not")) (defvar python--treesit-builtin-types - '("int" "float" "complex" "bool" "list" "tuple" "range" "str" - "bytes" "bytearray" "memoryview" "set" "frozenset" "dict")) + python-font-lock-builtin-types) (defvar python--treesit-type-regex (rx-to-string `(seq bol (or @@ -1025,17 +1052,7 @@ It makes underscores and dots word constituent chars.") eol))) (defvar python--treesit-builtins - (append python--treesit-builtin-types - '("abs" "aiter" "all" "anext" "any" "ascii" "bin" "breakpoint" - "callable" "chr" "classmethod" "compile" - "delattr" "dir" "divmod" "enumerate" "eval" "exec" - "filter" "format" "getattr" "globals" - "hasattr" "hash" "help" "hex" "id" "input" "isinstance" - "issubclass" "iter" "len" "locals" "map" "max" - "min" "next" "object" "oct" "open" "ord" "pow" - "print" "property" "repr" "reversed" "round" - "setattr" "slice" "sorted" "staticmethod" "sum" "super" - "type" "vars" "zip" "__import__"))) + python-font-lock-builtins) (defvar python--treesit-constants '("Ellipsis" "False" "None" "NotImplemented" "True" "__debug__" @@ -1047,42 +1064,10 @@ It makes underscores and dots word constituent chars.") ">>" ">>=" "|" "|=" "~" "@" "@=")) (defvar python--treesit-special-attributes - '("__annotations__" "__bases__" "__closure__" "__code__" - "__defaults__" "__dict__" "__doc__" "__firstlineno__" - "__globals__" "__kwdefaults__" "__name__" "__module__" - "__mro__" "__package__" "__qualname__" - "__static_attributes__" "__type_params__" - "__all__")) + python-font-lock-special-attributes) (defvar python--treesit-exceptions - '(;; Python 2 and 3: - "ArithmeticError" "AssertionError" "AttributeError" "BaseException" - "BufferError" "BytesWarning" "DeprecationWarning" "EOFError" - "EnvironmentError" "Exception" "FloatingPointError" "FutureWarning" - "GeneratorExit" "IOError" "ImportError" "ImportWarning" - "IndentationError" "IndexError" "KeyError" "KeyboardInterrupt" - "LookupError" "MemoryError" "NameError" "NotImplementedError" - "OSError" "OverflowError" "PendingDeprecationWarning" - "ReferenceError" "RuntimeError" "RuntimeWarning" "StopIteration" - "SyntaxError" "SyntaxWarning" "SystemError" "SystemExit" "TabError" - "TypeError" "UnboundLocalError" "UnicodeDecodeError" - "UnicodeEncodeError" "UnicodeError" "UnicodeTranslateError" - "UnicodeWarning" "UserWarning" "ValueError" "Warning" - "ZeroDivisionError" - ;; Python 2: - "StandardError" - ;; Python 3: - "BlockingIOError" "BrokenPipeError" "ChildProcessError" - "ConnectionAbortedError" "ConnectionError" "ConnectionRefusedError" - "ConnectionResetError" "EncodingWarning" "FileExistsError" - "FileNotFoundError" "InterruptedError" "IsADirectoryError" - "NotADirectoryError" "ModuleNotFoundError" "PermissionError" - "ProcessLookupError" "PythonFinalizationError" "RecursionError" - "ResourceWarning" "StopAsyncIteration" "TimeoutError" - "BaseExceptionGroup" "ExceptionGroup" - ;; OS specific - "VMSError" "WindowsError" - )) + python-font-lock-builtin-exceptions) (defun python--treesit-fontify-string (node override start end &rest _) "Fontify string. @@ -2343,8 +2328,11 @@ of the statement." (setq last-string-end (or (if (eq t (nth 3 (syntax-ppss))) - (re-search-forward - (rx (syntax string-delimiter)) nil t) + (cl-loop + while (re-search-forward + (rx (or "\"\"\"" "'''")) nil t) + unless (python-syntax-context 'string) + return (point)) (ignore-error scan-error (goto-char string-start) (python-nav--lisp-forward-sexp) diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 15394f28b27..551271275d7 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1168,7 +1168,7 @@ leading double colon is not added." (setq-local treesit-thing-settings `((ruby (sexp ,(cons (rx - bol + bos (or "class" "singleton_class" @@ -1211,49 +1211,48 @@ leading double colon is not added." "instance_variable" "global_variable" ) - eol) + eos) #'ruby-ts--sexp-p)) - (list - ,(cons (rx - bol - (or - "begin_block" - "end_block" - "method" - "singleton_method" - "method_parameters" - "parameters" - "block_parameters" - "class" - "singleton_class" - "module" - "do" - "case" - "case_match" - "array_pattern" - "find_pattern" - "hash_pattern" - "parenthesized_pattern" - "expression_reference_pattern" - "if" - "unless" - "begin" - "parenthesized_statements" - "argument_list" - "do_block" - "block" - "destructured_left_assignment" - "interpolation" - "string" - "string_array" - "symbol_array" - "delimited_symbol" - "regex" - "heredoc_body" - "array" - "hash") - eol) - #'ruby-ts--list-p)) + (list ,(cons (rx + bos + (or + "begin_block" + "end_block" + "method" + "singleton_method" + "method_parameters" + "parameters" + "block_parameters" + "class" + "singleton_class" + "module" + "do" + "case" + "case_match" + "array_pattern" + "find_pattern" + "hash_pattern" + "parenthesized_pattern" + "expression_reference_pattern" + "if" + "unless" + "begin" + "parenthesized_statements" + "argument_list" + "do_block" + "block" + "destructured_left_assignment" + "interpolation" + "string" + "string_array" + "symbol_array" + "delimited_symbol" + "regex" + "heredoc_body" + "array" + "hash") + eos) + #'ruby-ts--list-p)) (text ,(lambda (node) (or (member (treesit-node-type node) '("comment" "string_content" "heredoc_content")) @@ -1275,12 +1274,14 @@ leading double colon is not added." ;; Outline minor mode. (setq-local treesit-outline-predicate - (rx bos (or "singleton_method" - "method" - "alias" - "class" - "module") - eos)) + `(and ,(rx bos (or "singleton_method" + "method" + "alias" + "singleton_class" + "class" + "module") + eos) + named)) ;; Restore default values of outline variables ;; to use `treesit-outline-predicate'. (kill-local-variable 'outline-regexp) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 8896c2547c8..6fa92164f43 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -681,10 +681,15 @@ indentation." (put 'define-values 'scheme-indent-function 1) (put 'define-record-type 'scheme-indent-function 1) ;; is 1 correct? (put 'define-library 'scheme-indent-function 1) +(put 'guard 'scheme-indent-function 1) ;; SRFI-8 (put 'receive 'scheme-indent-function 2) +;; SRFI 64 +(put 'test-group 'scheme-indent-function 1) +(put 'test-group-with-cleanup 'scheme-indent-function 1) + ;; SRFI-204 (withdrawn, but provided in many implementations, see the SRFI text) (put 'match 'scheme-indent-function 1) (put 'match-lambda 'scheme-indent-function 0) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 3a41ef297ef..c4b7d0837a4 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1646,10 +1646,45 @@ not written in Bash or sh." sh-mode--treesit-settings) (setq-local treesit-thing-settings `((bash - (sentence ,(regexp-opt '("comment" - "heredoc_start" - "heredoc_body")))))) + (list + ,(rx bos (or "do_group" + "if_statement" + "case_statement" + "compound_statement" + "subshell" + "test_command" + "parenthesized_expression" + "arithmetic_expansion" + "brace_expression" + "string" + "array" + "expansion" ;; but not "simple_expansion" + "command_substitution" + "process_substitution") + eos)) + (sentence + ,(rx bos (or "redirected_statement" + "declaration_command" + "unset_command" + "command" + "variable_assignment") + eos)) + (text + ,(rx bos (or "comment" + "heredoc_body") + eos))))) (setq-local treesit-defun-type-regexp "function_definition") + (setq-local treesit-defun-name-function + (lambda (node) + (treesit-node-text + (treesit-node-child-by-field-name node "name") + t))) + (setq-local treesit-simple-imenu-settings + '((nil "\\`function_definition\\'" nil nil))) + ;; Override regexp-based outline variable from `sh-base-mode' + ;; to use `treesit-simple-imenu-settings' for outlines: + (kill-local-variable 'outline-regexp) + (treesit-major-mode-setup))) (derived-mode-add-parents 'bash-ts-mode '(sh-mode)) diff --git a/lisp/recentf.el b/lisp/recentf.el index a282fbee3b1..8862fea9926 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -73,13 +73,14 @@ You should define the options of your own filters in this group." :group 'recentf) -(defcustom recentf-max-saved-items 20 +(defcustom recentf-max-saved-items 25 "Maximum number of items of the recent list that will be saved. A nil value means to save the whole list. See the command `recentf-save-list'." :group 'recentf - :type '(choice (integer :tag "Entries" :value 1) - (const :tag "No Limit" nil))) + :type '(choice (natnum :tag "Entries") + (const :tag "No Limit" nil)) + :version "31.1") (defcustom recentf-save-file (locate-user-emacs-file "recentf" ".recentf") "File to save the recent list into." diff --git a/lisp/savehist.el b/lisp/savehist.el index 153e2db8706..32985bac0e1 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -96,11 +96,39 @@ the user's privacy." :type '(choice (natnum :tag "Specify") (const :tag "Use default" :value nil))) +(defvar savehist-timer nil) + +(defun savehist--cancel-timer () + "Cancel `savehist-autosave' timer, if set." + (when (timerp savehist-timer) + (cancel-timer savehist-timer)) + (setq savehist-timer nil)) + +(defvar savehist-autosave-interval) + +(defun savehist--manage-timer () + "Set or cancel an invocation of `savehist-autosave' on a timer. +If `savehist-mode' is enabled, set the timer, otherwise cancel the timer. +This should not cause noticeable delays for users -- `savehist-autosave' +executes in under 5 ms on my system." + (if (and savehist-mode + savehist-autosave-interval + (null savehist-timer)) + (setq savehist-timer + (run-with-timer savehist-autosave-interval + savehist-autosave-interval #'savehist-autosave)) + (savehist--cancel-timer))) + (defcustom savehist-autosave-interval (* 5 60) "The interval between autosaves of minibuffer history. -If set to nil, disables timer-based autosaving." +If set to nil, disables timer-based autosaving. +Use `setopt' or Customize commands to set this option." :type '(choice (const :tag "Disabled" nil) - (integer :tag "Seconds"))) + (integer :tag "Seconds")) + :set (lambda (sym val) + (set-default sym val) + (savehist--cancel-timer) + (savehist--manage-timer))) (defcustom savehist-mode-hook nil "Hook called when Savehist mode is turned on." @@ -122,8 +150,6 @@ unwise, unless you know what you are doing.") ;; Internal variables. -(defvar savehist-timer nil) - (defvar savehist-last-checksum nil) (defvar savehist-minibuffer-history-variables nil @@ -197,23 +223,14 @@ Installs `savehist-autosave' in `kill-emacs-hook' and on a timer. To undo this, call `savehist-uninstall'." (add-hook 'minibuffer-setup-hook #'savehist-minibuffer-hook) (add-hook 'kill-emacs-hook #'savehist-autosave) - ;; Install an invocation of savehist-autosave on a timer. This - ;; should not cause noticeable delays for users -- savehist-autosave - ;; executes in under 5 ms on my system. - (when (and savehist-autosave-interval - (null savehist-timer)) - (setq savehist-timer - (run-with-timer savehist-autosave-interval - savehist-autosave-interval #'savehist-autosave)))) + (savehist--manage-timer)) (defun savehist-uninstall () "Undo installing savehist. Normally invoked by calling `savehist-mode' to unset the minor mode." (remove-hook 'minibuffer-setup-hook #'savehist-minibuffer-hook) (remove-hook 'kill-emacs-hook #'savehist-autosave) - (when savehist-timer - (cancel-timer savehist-timer) - (setq savehist-timer nil))) + (savehist--manage-timer)) (defvar savehist--has-given-file-warning nil) (defun savehist-save (&optional auto-save) @@ -282,20 +299,21 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, (insert "))\n")))))) ;; Save the additional variables. (dolist (elem savehist-additional-variables) - (let ((symbol (if (consp elem) - (car elem) - elem))) - (when (boundp symbol) - (let ((value (symbol-value symbol))) - (when (savehist-printable value) - ;; When we have a max-size, chop off the last elements. - (when (and (consp elem) - (listp value) - (length> value (cdr elem))) - (setq value (copy-sequence value)) - (setcdr (nthcdr (cdr elem) value) nil)) - (prin1 `(setq ,symbol ',value) (current-buffer)) - (insert ?\n))))))) + (when (not (memq elem savehist-minibuffer-history-variables)) + (let ((symbol (if (consp elem) + (car elem) + elem))) + (when (boundp symbol) + (let ((value (symbol-value symbol))) + (when (savehist-printable value) + ;; When we have a max-size, chop off the last elements. + (when (and (consp elem) + (listp value) + (length> value (cdr elem))) + (setq value (copy-sequence value)) + (setcdr (nthcdr (cdr elem) value) nil)) + (prin1 `(setq ,symbol ',value) (current-buffer)) + (insert ?\n)))))))) ;; If autosaving, avoid writing if nothing has changed since the ;; last write. (let ((checksum (md5 (current-buffer) nil nil savehist-coding-system))) diff --git a/lisp/saveplace.el b/lisp/saveplace.el index c2e68f39730..b6c57d2da80 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -101,47 +101,44 @@ this happens automatically before saving `save-place-alist' to :type 'boolean) (defun save-place-load-alist-from-file () - (if (not save-place-loaded) - (progn - (setq save-place-loaded t) - (let ((file (expand-file-name save-place-file))) - ;; make sure that the alist does not get overwritten, and then - ;; load it if it exists: - (if (file-readable-p file) - ;; don't want to use find-file because we have been - ;; adding hooks to it. - (with-current-buffer (get-buffer-create " *Saved Places*") - (delete-region (point-min) (point-max)) - ;; Make sure our 'coding:' cookie in the save-place - ;; file will take effect, in case the caller binds - ;; coding-system-for-read. - (let (coding-system-for-read) - (insert-file-contents file)) - (goto-char (point-min)) - (setq save-place-alist - (with-demoted-errors "Error reading save-place-file: %S" - (car (read-from-string - (buffer-substring (point-min) (point-max)))))) + (unless save-place-loaded + (setq save-place-loaded t) + ;; FIXME: Obey `save-place-abbreviate-file-names'? + (let ((file (expand-file-name save-place-file))) + ;; make sure that the alist does not get overwritten, and then + ;; load it if it exists: + (when (file-readable-p file) + ;; don't want to use find-file because we have been + ;; adding hooks to it. + (with-temp-buffer + ;; Make sure our 'coding:' cookie in the save-place + ;; file will take effect, in case the caller binds + ;; coding-system-for-read. + (let (coding-system-for-read) + (insert-file-contents file)) + (goto-char (point-min)) + (setq save-place-alist + (with-demoted-errors "Error reading save-place-file: %S" + (car (read-from-string + (buffer-substring (point-min) (point-max)))))) - ;; If there is a limit, and we're over it, then we'll - ;; have to truncate the end of the list: - (if save-place-limit - (if (<= save-place-limit 0) - ;; Zero gets special cased. I'm not thrilled - ;; with this, but the loop for >= 1 is tight. - (setq save-place-alist nil) - ;; Else the limit is >= 1, so enforce it by - ;; counting and then `setcdr'ing. - (let ((s save-place-alist) - (count 1)) - (while s - (if (>= count save-place-limit) - (setcdr s nil) - (setq count (1+ count))) - (setq s (cdr s)))))) - - (kill-buffer (current-buffer)))) - nil)))) + ;; If there is a limit, and we're over it, then we'll + ;; have to truncate the end of the list: + (if save-place-limit + (if (<= save-place-limit 0) + ;; Zero gets special cased. I'm not thrilled + ;; with this, but the loop for >= 1 is tight. + (setq save-place-alist nil) + ;; Else the limit is >= 1, so enforce it by + ;; counting and then `setcdr'ing. + (let ((s save-place-alist) + (count 1)) + (while s + (if (>= count save-place-limit) + (setcdr s nil) + (setq count (1+ count))) + (setq s (cdr s)))))))) + (save-place--normalize-alist)))) (defcustom save-place-abbreviate-file-names nil "If non-nil, abbreviate file names before saving them. @@ -154,27 +151,32 @@ just using `setq' may cause out-of-sync problems. You should use either `setopt' or \\[customize-variable] to set this option." :type 'boolean :set (lambda (sym val) - (set-default sym val) - (or save-place-loaded (save-place-load-alist-from-file)) - (let ((fun (if val #'abbreviate-file-name #'expand-file-name)) - ;; Don't expand file names for non-existing remote connections. - (non-essential t)) - (setq save-place-alist - (cl-delete-duplicates - (cl-loop for (k . v) in save-place-alist - collect - (cons (funcall fun k) - (if (listp v) - (cl-loop for (k1 . v1) in v - collect - (cons k1 (funcall fun v1))) - v))) - :key #'car - :from-end t - :test #'equal))) - val) + (let ((old (if (default-boundp sym) (default-value sym)))) + (set-default sym val) + (if (or (equal old val) (not save-place-loaded)) + nil ;Nothing to do. + (save-place--normalize-alist)))) :version "28.1") +(defun save-place--normalize-alist () + (let ((fun (if save-place-abbreviate-file-names + #'abbreviate-file-name #'expand-file-name)) + ;; Don't expand file names for non-existing remote connections. + (non-essential t)) + (setq save-place-alist + (cl-delete-duplicates + (cl-loop for (k . v) in save-place-alist + collect + (cons (funcall fun k) + (if (listp v) + (cl-loop for (k1 . v1) in v + collect + (cons k1 (funcall fun v1))) + v))) + :key #'car + :from-end t + :test #'equal)))) + (defcustom save-place-save-skipped t "If non-nil, remember files matching `save-place-skip-check-regexp'. @@ -208,6 +210,45 @@ disabled, i.e., no files are excluded." (declare-function dired-current-directory "dired" (&optional localp)) +(defvar save-place--autosave-timer nil) + +(defun save-place--cancel-timer () + "Cancel `save-place-autosave' timer, if set." + (when (timerp save-place--autosave-timer) + (cancel-timer save-place--autosave-timer)) + (setq save-place--autosave-timer nil)) + +(defvar save-place-autosave-interval) + +(defun save-place--manage-timer () + "Set or cancel an invocation of `save-place--autosave' on a timer. +If `save-place-mode' is enabled, set the timer, otherwise cancel the timer." + (if (and save-place-mode + save-place-autosave-interval + (null save-place--autosave-timer)) + (setq save-place--autosave-timer + (run-with-timer + save-place-autosave-interval + save-place-autosave-interval #'save-place--autosave)) + (save-place--cancel-timer))) + +(defcustom save-place-autosave-interval nil + "The interval between auto saves of buffer places. +If set to nil, disables timer-based auto saving. +Use `setopt' or Customize commands to set this option." + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Seconds")) + :version "31.1" + :set (lambda (sym val) + (set-default sym val) + (save-place--cancel-timer) + (save-place--manage-timer))) + +(defun save-place--autosave () + "Called by `save-place--autosave-timer'." + (save-places-to-alist) + (save-place-alist-to-file)) + (defun save-place--setup-hooks (add) (cond (add @@ -234,8 +275,8 @@ disabled, i.e., no files are excluded." This means when you visit a file, point goes to the last place where it was when you previously visited the same file." :global t - :group 'save-place - (save-place--setup-hooks save-place-mode)) + (save-place--setup-hooks save-place-mode) + (save-place--manage-timer)) (make-variable-buffer-local 'save-place-mode) @@ -258,7 +299,8 @@ file: dired-subdir-alist (dired-current-directory)))) (message "Buffer `%s' not visiting a file or directory" (buffer-name)) - (save-place--setup-hooks save-place-mode))) + (save-place--setup-hooks save-place-mode) + (save-place--manage-timer))) (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) @@ -342,8 +384,7 @@ may have changed) back to `save-place-alist'." (defun save-place-alist-to-file () (let ((file (expand-file-name save-place-file)) (coding-system-for-write 'utf-8)) - (with-current-buffer (get-buffer-create " *Saved Places*") - (delete-region (point-min) (point-max)) + (with-temp-buffer (when save-place-forget-unreadable-files (save-place-forget-unreadable-files)) (insert (format ";;; -*- coding: %s; mode: lisp-data -*-\n" @@ -361,8 +402,7 @@ may have changed) back to `save-place-alist'." (condition-case nil ;; Don't use write-file; we don't want this buffer to visit it. (write-region (point-min) (point-max) file) - (file-error (message "Saving places: can't write %s" file))) - (kill-buffer (current-buffer)))))) + (file-error (message "Saving places: can't write %s" file))))))) (defun save-places-to-alist () ;; go through buffer-list, saving places to alist if save-place-mode diff --git a/lisp/ses.el b/lisp/ses.el index eeef8f040f9..88e83ae160b 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -4011,7 +4011,7 @@ Use `math-format-value' as a printer for Calc objects." (unless reorient-x (setq result (mapcar #'nreverse result))) (when transpose - (let ((ret (mapcar (lambda (x) (list x)) (pop result))) iter) + (let ((ret (mapcar #'list (pop result))) iter) (while result (setq iter ret) (dolist (elt (pop result)) diff --git a/lisp/simple.el b/lisp/simple.el index d3005c69b0c..e1c0dd4a092 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -11249,7 +11249,9 @@ too short to have a dst element. (when initial-scratch-message (insert (substitute-command-keys initial-scratch-message)) (set-buffer-modified-p nil)) - (funcall initial-major-mode)) + (funcall initial-major-mode) + (when (eq initial-major-mode 'lisp-interaction-mode) + (setq-local trusted-content :all))) scratch))) (defun scratch-buffer () diff --git a/lisp/subr.el b/lisp/subr.el index 65b50dc5598..77e909d1bf6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -590,9 +590,6 @@ treatment of negative COUNT provided by this function." ;;;; List functions. -;; Note: `internal--compiler-macro-cXXr' was copied from -;; `cl--compiler-macro-cXXr' in cl-macs.el. If you amend either one, -;; you may want to amend the other, too. (defun internal--compiler-macro-cXXr (form x) (let* ((head (car form)) (n (symbol-name head)) @@ -609,142 +606,170 @@ treatment of negative COUNT provided by this function." (defun caar (x) "Return the car of the car of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (car x))) (defun cadr (x) "Return the car of the cdr of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (cdr x))) (defun cdar (x) "Return the cdr of the car of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (car x))) (defun cddr (x) "Return the cdr of the cdr of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (cdr x))) (defun caaar (x) "Return the `car' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (car (car x)))) (defun caadr (x) "Return the `car' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (car (cdr x)))) (defun cadar (x) "Return the `car' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (cdr (car x)))) (defun caddr (x) "Return the `car' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (cdr (cdr x)))) (defun cdaar (x) "Return the `cdr' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (car (car x)))) (defun cdadr (x) "Return the `cdr' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (car (cdr x)))) (defun cddar (x) "Return the `cdr' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (cdr (car x)))) (defun cdddr (x) "Return the `cdr' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (cdr (cdr x)))) (defun caaaar (x) "Return the `car' of the `car' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (car (car (car x))))) (defun caaadr (x) "Return the `car' of the `car' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (car (car (cdr x))))) (defun caadar (x) "Return the `car' of the `car' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (car (cdr (car x))))) (defun caaddr (x) "Return the `car' of the `car' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (car (cdr (cdr x))))) (defun cadaar (x) "Return the `car' of the `cdr' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (cdr (car (car x))))) (defun cadadr (x) "Return the `car' of the `cdr' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (cdr (car (cdr x))))) (defun caddar (x) "Return the `car' of the `cdr' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (cdr (cdr (car x))))) (defun cadddr (x) "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (car (cdr (cdr (cdr x))))) (defun cdaaar (x) "Return the `cdr' of the `car' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (car (car (car x))))) (defun cdaadr (x) "Return the `cdr' of the `car' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (car (car (cdr x))))) (defun cdadar (x) "Return the `cdr' of the `car' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (car (cdr (car x))))) (defun cdaddr (x) "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (car (cdr (cdr x))))) (defun cddaar (x) "Return the `cdr' of the `cdr' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (cdr (car (car x))))) (defun cddadr (x) "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (cdr (car (cdr x))))) (defun cdddar (x) "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (cdr (cdr (car x))))) (defun cddddr (x) "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) + (declare (side-effect-free t) + (compiler-macro internal--compiler-macro-cXXr)) (cdr (cdr (cdr (cdr x))))) (defun last (list &optional n) @@ -3547,13 +3572,15 @@ causes it to evaluate `help-form' and display the result." char)) (defun sit-for (seconds &optional nodisp) - "Redisplay, then wait for SECONDS seconds. Stop when input is available. + "Redisplay, then wait for SECONDS seconds; stop when input is available. SECONDS may be a floating-point value. \(On operating systems that do not support waiting for fractions of a second, floating-point values are rounded down to the nearest integer.) -If optional arg NODISP is t, don't redisplay, just wait for input. -Redisplay does not happen if input is available before it starts. +If there's pending input, return nil immediately without redisplaying +and without waiting. +If optional arg NODISP is t, don't redisplay, just wait for input (but +still return nil immediately if there's pending input). Value is t if waited the full time with no input arriving, and nil otherwise." ;; This used to be implemented in C until the following discussion: diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index 14808dc7c8b..1c15234c49c 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -194,6 +194,7 @@ EVENT is a `preedit-text' event." ("etc/images/save" . ("document-save" "gtk-save")) ("etc/images/saveas" . ("document-save-as" "gtk-save-as")) ("etc/images/undo" . ("edit-undo" "gtk-undo")) + ("etc/images/redo" . ("edit-redo" "gtk-redo")) ("etc/images/cut" . ("edit-cut" "gtk-cut")) ("etc/images/copy" . ("edit-copy" "gtk-copy")) ("etc/images/paste" . ("edit-paste" "gtk-paste")) @@ -251,11 +252,19 @@ EVENT is a `preedit-text' event." ;; No themed versions available: ;; mail/preview (combining stock_mail and stock_zoom) ;; mail/save (combining stock_mail, stock_save and stock_convert) + ("images/mpc/prev" . "media-skip-backward") + ("images/mpc/rewind" . "media-seek-backward") + ("images/mpc/pause" . "media-playback-pause") + ("images/mpc/play" . "media-playback-start") + ("images/mpc/ffwd" . "media-seek-forward") + ("images/mpc/next" . "media-skip-forward") + ("images/mpc/stop" . "media-playback-stop") + ("images/mpc/add" . "list-add") ) "How icons for tool bars are mapped to Gtk+ stock items. Emacs must be compiled with the Gtk+ toolkit for this to have any effect. A value that begins with n: denotes a named icon instead of a stock icon." - :version "22.2" + :version "31.1" :type '(choice (repeat (choice symbol (cons (string :tag "Emacs icon") diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index b614e9aa31d..debcb669b76 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1440,11 +1440,19 @@ This returns an error if any Emacs frames are X frames." ;; No themed versions available: ;; mail/preview (combining stock_mail and stock_zoom) ;; mail/save (combining stock_mail, stock_save and stock_convert) + ("images/mpc/prev" . "media-skip-backward") + ("images/mpc/rewind" . "media-seek-backward") + ("images/mpc/pause" . "media-playback-pause") + ("images/mpc/play" . "media-playback-start") + ("images/mpc/ffwd" . "media-seek-forward") + ("images/mpc/next" . "media-skip-forward") + ("images/mpc/stop" . "media-playback-stop") + ("images/mpc/add" . "list-add") ) "How icons for tool bars are mapped to Gtk+ stock items. Emacs must be compiled with the Gtk+ toolkit for this to have any effect. A value that begins with n: denotes a named icon instead of a stock icon." - :version "22.2" + :version "31.1" :type '(choice (repeat (choice symbol (cons (string :tag "Emacs icon") diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 15101ebd59d..4f23a909b69 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -912,10 +912,10 @@ We run the first FUNCTION whose STRING matches the input events." (catch 'result (xterm--query "\e[>0q" - '(("\eP>|" . (lambda () - ;; The reply should be: \e P > | STRING \e \\ - (let ((str (xterm--read-string ?\e ?\\))) - (throw 'result str)))))) + `(("\eP>|" . ,(lambda () + ;; The reply should be: \e P > | STRING \e \\ + (let ((str (xterm--read-string ?\e ?\\))) + (throw 'result str)))))) nil))) (defun xterm--push-map (map basemap) diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index d49dd5eeac7..32a8a224df7 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -260,7 +260,7 @@ untagged NEWS entry." (while (re-search-forward "\"\\(([a-z0-9-]+)[ \n][^\"]\\{1,80\\}\\)\"" nil t) (buttonize-region (match-beginning 1) (match-end 1) - (lambda (node) (info node)) + #'info (match-string 1))))))) (defun emacs-news--sections (regexp) diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index dad49b7ed4c..0f07fbedeed 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -41,6 +41,7 @@ (declare-function treesit-parser-create "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-search-subtree "treesit.c") (defcustom html-ts-mode-indent-offset 2 "Number of spaces for each indentation step in `html-ts-mode'." @@ -90,8 +91,20 @@ (defun html-ts-mode--defun-name (node) "Return the defun name of NODE. Return nil if there is no name or if NODE is not a defun node." - (when (equal (treesit-node-type node) "tag_name") - (treesit-node-text node t))) + (when (string-match-p "element" (treesit-node-type node)) + (treesit-node-text + (treesit-search-subtree node "\\`tag_name\\'" nil nil 2) + t))) + +(defun html-ts-mode--outline-predicate (node) + "Limit outlines to a few most meaningful elements." + (let ((name (html-ts-mode--defun-name node))) + (and name (string-match-p + (rx bos (or "html" "head" "script" "style" + "body" (and "h" (any "1-6")) + "ol" "ul" "table") + eos) + name)))) ;;;###autoload (define-derived-mode html-ts-mode html-mode "HTML" @@ -108,7 +121,6 @@ Return nil if there is no name or if NODE is not a defun node." ;; Navigation. (setq-local treesit-defun-type-regexp "element") - (setq-local treesit-defun-name-function #'html-ts-mode--defun-name) (setq-local treesit-thing-settings @@ -117,8 +129,12 @@ Return nil if there is no name or if NODE is not a defun node." "text" "attribute" "value"))) - (list ,(regexp-opt '("element")) 'symbols) - (sentence "tag") + (list ,(rx (or + ;; Also match script_element and style_element + "element" + ;; HTML comments have the element syntax + "comment"))) + (sentence ,(rx (and bos (or "tag_name" "attribute") eos))) (text ,(regexp-opt '("comment" "text")))))) ;; Font-lock. @@ -130,10 +146,10 @@ Return nil if there is no name or if NODE is not a defun node." ;; Imenu. (setq-local treesit-simple-imenu-settings - '(("Element" "\\`tag_name\\'" nil nil))) + '((nil "element" nil nil))) ;; Outline minor mode. - (setq-local treesit-outline-predicate "\\`element\\'") + (setq-local treesit-outline-predicate #'html-ts-mode--outline-predicate) ;; `html-ts-mode' inherits from `html-mode' that sets ;; regexp-based outline variables. So need to restore ;; the default values of outline variables to be able diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index abe3abefc26..9cec637f996 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -402,10 +402,10 @@ re-start Emacs." (const :tag "default" nil)) (coding-system :tag "Coding System")))) -(defcustom ispell-help-timeout 5 +(defcustom ispell-help-timeout 30 "The number of seconds to display the help text." :type 'number - :version "28.1") + :version "31.1") (defvar ispell-dictionary-base-alist '((nil ; default @@ -2512,7 +2512,7 @@ Selections are: (with-current-buffer buffer (insert (concat help-1 "\n" help-2 "\n" help-3))) (ispell-display-buffer buffer) - (sit-for ispell-help-timeout) + (sit-for (max 0.5 ispell-help-timeout)) (kill-buffer "*Ispell Help*")) (unwind-protect (let ((resize-mini-windows 'grow-only)) @@ -2522,7 +2522,7 @@ Selections are: ;;(set-minibuffer-window (selected-window)) (enlarge-window 2) (insert (concat help-1 "\n" help-2 "\n" help-3)) - (sit-for ispell-help-timeout)) + (sit-for (max 0.5 ispell-help-timeout))) (erase-buffer))))))) (define-obsolete-function-alias 'lookup-words 'ispell-lookup-words "24.4") @@ -3310,9 +3310,7 @@ otherwise, the current line is skipped." Generated from `ispell-tex-skip-alists'." (concat ;; raw tex keys - (mapconcat (lambda (lst) (car lst)) - (car ispell-tex-skip-alists) - "\\|") + (mapconcat #'car (car ispell-tex-skip-alists) "\\|") "\\|" ;; keys wrapped in begin{} (mapconcat (lambda (lst) diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 759995590f6..3b55fe7706a 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -137,6 +137,14 @@ Return nil if there is no name or if NODE is not a defun node." (setq-local treesit-defun-type-regexp (rx (or "table" "table_array_element"))) (setq-local treesit-defun-name-function #'toml-ts-mode--defun-name) + (setq-local treesit-thing-settings + `((toml + (list + ,(rx bos (or "array" "inline_table") eos)) + (sentence + ,(rx bos (or "pair") eos)) + (text + ,(rx bos (or "comment") eos))))) ;; Font-lock. (setq-local treesit-font-lock-settings toml-ts-mode--font-lock-settings) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index defef096aa6..9b211902e14 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -33,6 +33,7 @@ (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-end "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") (defvar yaml-ts-mode--syntax-table (let ((table (make-syntax-table))) @@ -141,6 +142,20 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (fill-region start-marker end justify)) t)))) +(defun yaml-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (when (equal (treesit-node-type node) "block_mapping_pair") + (treesit-node-text (treesit-node-child-by-field-name + node "key") + t))) + +(defun yaml-ts-mode--outline-predicate (node) + "Limit outlines to top-level mappings." + (let ((regexp (rx (or "block_mapping_pair" "block_sequence_item")))) + (when (string-match-p regexp (treesit-node-type node)) + (not (treesit-parent-until node regexp))))) + ;;;###autoload (define-derived-mode yaml-ts-mode text-mode "YAML" "Major mode for editing YAML, powered by tree-sitter." @@ -168,11 +183,21 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (setq-local fill-paragraph-function #'yaml-ts-mode--fill-paragraph) ;; Navigation. + (setq-local treesit-defun-type-regexp "block_mapping_pair") + (setq-local treesit-defun-name-function #'yaml-ts-mode--defun-name) + (setq-local treesit-defun-tactic 'top-level) + (setq-local treesit-thing-settings `((yaml - (list ,(regexp-opt '("block_mapping_pair" - "flow_sequence")) - 'symbols)))) + (list ,(rx (or "block_mapping_pair" "flow_sequence"))) + (sentence ,"block_mapping_pair")))) + + ;; Imenu. + (setq-local treesit-simple-imenu-settings + '((nil "\\`block_mapping_pair\\'" nil nil))) + + ;; Outline minor mode. + (setq-local treesit-outline-predicate #'yaml-ts-mode--outline-predicate) (treesit-major-mode-setup) @@ -181,8 +206,8 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." ;; with `C-M-f', `C-M-b' neither adapt to 'show-paren-mode' ;; that is problematic in languages without explicit ;; opening/closing nodes. - (setq-local forward-sexp-function nil) - (setq-local show-paren-data-function 'show-paren--default))) + (kill-local-variable 'forward-sexp-function) + (kill-local-variable 'show-paren-data-function))) (derived-mode-add-parents 'yaml-ts-mode '(yaml-mode)) diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index a2e91246ae2..4117db71058 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -114,7 +114,7 @@ limit yourself to the formats recommended by that older version." (defcustom time-stamp-active t - "Non-nil to enable time-stamping of buffers by \\[time-stamp]. + "Non-nil enables time-stamping of buffers by \\[time-stamp]. Can be toggled by \\[time-stamp-toggle-active]. This option does not affect when `time-stamp' is run, only what it @@ -248,37 +248,42 @@ your init file, you would be incompatible with other people's files.") (defvar time-stamp-count 1 ;Do not change! "How many templates \\[time-stamp] will look for in a buffer. -The same time stamp will be written in each case. + +If the value is greater than 1, the same time stamp will be written in +each case. If you want to insert different text on different lines, +then instead of changing this variable, include a newline (written as +\"\\n\") in `time-stamp-format' or the format part of `time-stamp-pattern'. `time-stamp-count' is best changed with a file-local variable. If you were to change it in your init file, you would be incompatible with other people's files.") -;;;###autoload(put 'time-stamp-count 'safe-local-variable 'integerp) +;;;###autoload(put 'time-stamp-count 'safe-local-variable (lambda (c) (and (integerp c) (< c 100)))) (defvar time-stamp-pattern nil ;Do not change! "Convenience variable setting all `time-stamp' location and format values. This string has four parts, each of which is optional. -These four parts set `time-stamp-line-limit', `time-stamp-start', -`time-stamp-format', and `time-stamp-end'. See the documentation -for each of these variables for details. +These four parts override `time-stamp-line-limit', `time-stamp-start', +`time-stamp-format' and `time-stamp-end', respectively. See the +documentation for each of these variables for details. The first part is a number followed by a slash; the number sets the number of lines at the beginning (negative counts from end) of the file searched for the time stamp. The number and the slash may be omitted to use the -normal value. +value of `time-stamp-line-limit' as the number. The second part is a regexp identifying the pattern preceding the time stamp. -This part may be omitted to use the normal pattern. +This part may be omitted to use the value of `time-stamp-start'. -The third part specifies the format of the time stamp inserted. See -the documentation for `time-stamp-format' for details. Specify this -part as \"%%\" to use the normal format. +The third part specifies the format of the time stamp inserted. Specify +this part as \"%%\" to use the value of `time-stamp-format'. The fourth part is a regexp identifying the pattern following the time stamp. -This part may be omitted to use the normal pattern. +This part may be omitted to use the value of `time-stamp-end'. The pattern does not need to match the entire line of the time stamp. +The pattern will update time stamp information on multiple lines if the +pattern includes newlines, written as \"\\n\". These variables are best changed with file-local variables. If you were to change `time-stamp-pattern', `time-stamp-line-limit', @@ -299,6 +304,11 @@ Examples: %% time-stamp-pattern: \"newcommand{\\\\\\\\timestamp}{%%}\" (sets `time-stamp-start' and `time-stamp-end') +// time-stamp-pattern: \"10/Author %L\\nRevised %-d %b %Y$\" + (sets all four variables and updates text on two lines) + +See Info node `Time Stamps' for more examples. + See also `time-stamp-count' and `time-stamp-inserts-lines'.") ;;;###autoload(put 'time-stamp-pattern 'safe-local-variable 'stringp) @@ -332,12 +342,11 @@ To enable automatic time-stamping for only a specific file, add this line to a local variables list near the end of the file: eval: (add-hook \\='before-save-hook \\='time-stamp nil t) -If the file has no time stamp template, this function does nothing. +If the file has no time stamp template or if `time-stamp-active' is nil, +this function does nothing. You can set `time-stamp-pattern' in a file's local variables list -to customize the information in the time stamp and where it is written. - -The time stamp is updated only if `time-stamp-active' is non-nil." +to customize the information in the time stamp and where it is written." (interactive) (let ((line-limit time-stamp-line-limit) (ts-start time-stamp-start) @@ -411,6 +420,7 @@ The time stamp is updated only if `time-stamp-active' is non-nil." Returns the end point, which is where `time-stamp' begins the next search." (let ((case-fold-search nil) (end nil) + (advance-nudge 0) end-search-start (end-length nil)) (save-excursion @@ -420,6 +430,9 @@ Returns the end point, which is where `time-stamp' begins the next search." (while (and (< (goto-char start) search-limit) (not end) (re-search-forward ts-start search-limit 'move)) + ;; Whether or not we find a template, we must + ;; advance through the buffer. + (setq advance-nudge (if (> (point) start) 0 1)) (setq start (point)) (if (not time-stamp-inserts-lines) (forward-line format-lines)) @@ -434,7 +447,8 @@ Returns the end point, which is where `time-stamp' begins the next search." (if (re-search-forward ts-end line-end t) (progn (setq end (match-beginning 0)) - (setq end-length (- (match-end 0) end)))))))))))) + (setq end-length (- (match-end 0) end))) + (setq start (+ start advance-nudge))))))))))) (if end (progn ;; do all warnings outside save-excursion @@ -468,7 +482,7 @@ Returns the end point, which is where `time-stamp' begins the next search." (setq end (point)))))))))))) ;; return the location after this time stamp, if there was one (and end end-length - (+ end end-length)))) + (+ end (max advance-nudge end-length))))) ;;;###autoload diff --git a/lisp/transient.el b/lisp/transient.el index 24ab56e830b..aa0fc442638 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -5,7 +5,7 @@ ;; Author: Jonas Bernoulli ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Version: 0.8.3 +;; Version: 0.8.4 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -32,7 +32,7 @@ ;;; Code: -(defconst transient-version "v0.8.3-2-gf0478b29-builtin") +(defconst transient-version "v0.8.4-7-gabee7353-builtin") (require 'cl-lib) (require 'eieio) @@ -281,6 +281,20 @@ number is positive, or hide the menu if it is negative." :format "\n %t: %v" :value -20))) +(defcustom transient-show-docstring-format "%s" + "How to display suffix docstrings. + +The command `transient-toggle-docstrings' toggles between showing suffix +descriptions as usual, and instead or additionally displaying the suffix +docstrings. The format specified here controls how that is done. %c is +the description and %s is the docstring. Use \"%-14c %s\" or similar to +display both. + +This command is not bound by default, see its docstring for instructions." + :package-version '(transient . "0.8.4") + :group 'transient + :type 'string) + (defcustom transient-read-with-initial-input nil "Whether to use the last history element as initial minibuffer input." :package-version '(transient . "0.2.0") @@ -709,7 +723,7 @@ the prototype is stored in the clone's `prototype' slot.") :documentation "The parent group object.") (level :initarg :level - :initform (symbol-value 'transient--default-child-level) + :initform nil :documentation "Enable if level of prefix is equal or greater.") (if :initarg :if @@ -779,7 +793,15 @@ the prototype is stored in the clone's `prototype' slot.") (inapt-if-not-derived :initarg :inapt-if-not-derived :initform nil - :documentation "Inapt if major-mode does not derive from value.")) + :documentation "Inapt if major-mode does not derive from value.") + (advice + :initarg :advice + :initform nil + :documentation "Advise applied to the command body.") + (advice* + :initarg :advice* + :initform nil + :documentation "Advise applied to the command body and interactive spec.")) "Abstract superclass for group and suffix classes. It is undefined which predicates are used if more than one `if*' @@ -1188,14 +1210,15 @@ commands are aliases for." (cond ((eq key :class) (setq class val)) ((or (symbolp val) - (and (listp val) (not (eq (car val) 'lambda)))) + (and (listp val) + (not (memq (car val) (list 'lambda (intern "")))))) (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) + level (list 'quote (cond (class) ((cl-typep (car spec) @@ -1286,7 +1309,8 @@ commands are aliases for." ((guard (eq (car-safe val) '\,)) (use key (cadr val))) ((guard (or (symbolp val) - (and (listp val) (not (eq (car val) 'lambda))))) + (and (listp val) + (not (memq (car val) (list 'lambda (intern ""))))))) (use key (macroexp-quote val))) (_ (use key val))))) (when spec @@ -1295,7 +1319,7 @@ commands are aliases for." (shortarg (plist-get args :shortarg))) (use :key shortarg))) (list 'list - (or level transient--default-child-level) + level (macroexp-quote (or class 'transient-suffix)) (cons 'list args)))) @@ -1530,6 +1554,21 @@ See info node `(transient)Modifying Existing Transients'." (defun transient--nthcdr (n list) (nthcdr (if (< n 0) (- (length list) (abs n)) n) list)) +(defun transient-set-default-level (command level) + "Set the default level of suffix COMMAND to LEVEL. + +The default level is shadowed if the binding of the suffix in a +prefix menu specifies a level, and also if the user changes the +level of such a binding. + +The default level can only be set for commands that were defined +using `transient-define-suffix', `transient-define-infix' or +`transient-define-argument'." + (if-let* ((proto (transient--suffix-prototype command))) + (oset proto level level) + (user-error "Cannot set level for `%s'; no prototype object exists" + command))) + ;;; Variables (defvar transient-current-prefix nil @@ -2216,7 +2255,8 @@ value. Otherwise return CHILDREN as is.") (string (list spec)))) (defun transient--init-group (levels spec parent) - (pcase-let ((`(,level ,class ,args ,children) (append spec nil))) + (pcase-let* ((`(,level ,class ,args ,children) (append spec nil)) + (level (or level transient--default-child-level))) (and-let* (((transient--use-level-p level)) (obj (apply class :parent parent :level level args)) ((transient--use-suffix-p obj)) @@ -2233,9 +2273,12 @@ value. Otherwise return CHILDREN as is.") (pcase-let* ((`(,level ,class ,args) spec) (cmd (plist-get args :command)) (key (transient--kbd (plist-get args :key))) + (proto (and cmd (transient--suffix-prototype cmd))) (level (or (alist-get (cons cmd key) levels nil nil #'equal) (alist-get cmd levels) - level))) + level + (and proto (oref proto level)) + transient--default-child-level))) (let ((fn (and (symbolp cmd) (symbol-function cmd)))) (when (autoloadp fn) @@ -2246,7 +2289,7 @@ value. Otherwise return CHILDREN as is.") (apply class :parent parent :level level args) (unless (and cmd (symbolp cmd)) (error "BUG: Non-symbolic suffix command: %s" cmd)) - (if-let* ((proto (and cmd (transient--suffix-prototype cmd)))) + (if proto (apply #'clone proto :level level args) (apply class :command cmd :parent parent :level level args))))) @@ -2436,6 +2479,8 @@ value. Otherwise return CHILDREN as is.") (setq transient--redisplay-map nil) (setq transient--redisplay-key nil) (setq transient--helpp nil) + (unless (eq transient--docsp 'permanent) + (setq transient--docsp nil)) (setq transient--editp nil) (setq transient--prefix nil) (setq transient--layout nil) @@ -2563,7 +2608,13 @@ value. Otherwise return CHILDREN as is.") (let ((abort t)) (unwind-protect (prog1 (let ((debugger #'transient--exit-and-debug)) - (advice-eval-interactive-spec spec)) + (if-let* ((obj (transient-suffix-object suffix)) + (grp (oref obj parent)) + (adv (or (oref obj advice*) + (oref grp advice*)))) + (funcall + adv #'advice-eval-interactive-spec spec) + (advice-eval-interactive-spec spec))) (setq abort nil)) (when abort (when-let* ((unwind (oref prefix unwind-suffix))) @@ -2573,7 +2624,14 @@ value. Otherwise return CHILDREN as is.") (oset prefix unwind-suffix nil)))))) (unwind-protect (let ((debugger #'transient--exit-and-debug)) - (apply fn args)) + (if-let* ((obj (transient-suffix-object suffix)) + (grp (oref obj parent)) + (adv (or (oref obj advice) + (oref grp advice) + (oref obj advice*) + (oref grp advice*)))) + (apply adv fn args) + (apply fn args))) (when-let* ((unwind (oref prefix unwind-suffix))) (transient--debug 'unwind-command) (funcall unwind suffix)) @@ -3212,12 +3270,21 @@ For example: (interactive) (setq transient-show-common-commands (not transient-show-common-commands))) -(transient-define-suffix transient-toggle-docstrings () +(transient-define-suffix transient-toggle-docstrings (&optional permanent) "Toggle whether to show docstrings instead of suffix descriptions. -To make this available in all menus, bind it in `transient-map'." + +By default this is only enabled temporarily for the current transient +menu invocation. With a prefix argument, enable this until explicitly +disabled again. + +Infix arguments are not affected by this, because otherwise many menus +would likely become unreadable. To make this command available in all +menus, bind it in `transient-map'. `transient-show-docstring-format' +controls how the docstrings are displayed and whether descriptions are +also displayed." :transient t - (interactive) - (setq transient--docsp (not transient--docsp))) + (interactive (list current-prefix-arg)) + (setq transient--docsp (if permanent 'permanent (not transient--docsp)))) (defun transient-toggle-debug () "Toggle debugging statements for transient commands." @@ -3789,37 +3856,48 @@ a default implementation, which is a noop.") ;;;; Get -(defun transient-scope (&optional prefixes) +(defun transient-scope (&optional prefixes classes) "Return the scope of the active or current transient prefix command. -If optional PREFIXES is nil, return the scope of the prefix currently -being setup, making this variant useful, e.g., in `:if*' predicates. -If no prefix is being setup, but the current command was invoked from -some prefix, then return the scope of that. - -When this function is called from the body or `interactive' form of a -suffix command, PREFIXES should be non-nil. +If optional PREFIXES and CLASSES are both nil, return the scope of +the prefix currently being setup, making this variation useful, e.g., +in `:if*' predicates. If no prefix is being setup, but the current +command was invoked from some prefix, then return the scope of that. If PREFIXES is non-nil, it must be a prefix command or a list of such -commands. In this case try the following in order: +commands. If CLASSES is non-nil, it must be a prefix class or a list +of such classes. When this function is called from the body or the +`interactive' form of a suffix command, PREFIXES and/or CLASSES should +be non-nil. If either is non-nil, try the following in order: - If the current suffix command was invoked from a prefix, which - appears in PREFIXES, then return the scope of that prefix. + appears in PREFIXES, return the scope of that prefix. -- If a prefix is being setup and it appears in PREFIXES, then return - its scope. +- If the current suffix command was invoked from a prefix, and its + class derives from one of the CLASSES, return the scope of that + prefix. -- Finally try to return the default scope of the first prefix in +- If a prefix is being setup and it appears in PREFIXES, return its + scope. + +- If a prefix is being setup and its class derives from one of the + CLASSES, return its scope. + +- Finally try to return the default scope of the first command in PREFIXES. This only works if that slot is set in the respective class definition or using its `transient-init-scope' method. If no prefix matches, return nil." - (if prefixes - (let ((prefixes (ensure-list prefixes))) - (if-let* ((obj (or (and-let* ((obj transient-current-prefix)) - (and (memq (oref obj command) prefixes) obj)) - (and-let* ((obj transient--prefix)) - (and (memq (oref obj command) prefixes) obj))))) + (if (or prefixes classes) + (let ((prefixes (ensure-list prefixes)) + (type (if (symbolp classes) classes (cons 'or classes)))) + (if-let* ((obj (cl-flet ((match (obj) + (and obj + (or (memq (oref obj command) prefixes) + (cl-typep obj type)) + obj))) + (or (match transient-current-prefix) + (match transient--prefix))))) (oref obj scope) (and (get (car prefixes) 'transient--prefix) (oref (transient--init-prefix (car prefixes)) scope)))) @@ -4247,16 +4325,21 @@ face `transient-heading' to the complete string." If the result is nil, then use \"(BUG: no description)\" as the description. If the OBJ's `key' is currently unreachable, then apply the face `transient-unreachable' to the complete string." - (let ((desc (if-let* ((transient--docsp) - (cmd (oref obj command)) - (doc (ignore-errors (documentation cmd))) - ((not (equal doc (documentation - 'transient--default-infix-command))))) - (substring doc 0 (string-match "\\.?\n" doc)) - (or (cl-call-next-method obj) - (and (slot-boundp transient--prefix 'suffix-description) - (funcall (oref transient--prefix suffix-description) - obj)))))) + (let ((desc (or (cl-call-next-method obj) + (and (slot-boundp transient--prefix 'suffix-description) + (funcall (oref transient--prefix suffix-description) + obj))))) + (when-let* ((transient--docsp) + (cmd (oref obj command)) + ((not (memq 'transient--default-infix-command + (function-alias-p cmd)))) + (docstr (ignore-errors (documentation cmd))) + (docstr (string-trim + (substring docstr 0 (string-match "\\.?\n" docstr)))) + ((not (equal docstr "")))) + (setq desc (format-spec transient-show-docstring-format + `((?c . ,desc) + (?s . ,docstr))))) (if desc (when-let* ((face (transient--get-face obj 'face))) (setq desc (transient--add-face desc face t))) @@ -4568,34 +4651,44 @@ Select the help window, and make the help buffer current and return it." (insert "\n")) (when transient--helpp (insert - (format (propertize "\ + (format + (propertize "\ Type a %s to show help for that suffix command, or %s to show manual. Type %s to exit help.\n" - 'face 'transient-heading) - (propertize "" 'face 'transient-key) - (propertize "?" 'face 'transient-key) - (propertize "C-g" 'face 'transient-key)))) + 'face 'transient-heading) + (propertize "" 'face 'transient-key) + (propertize "?" 'face 'transient-key) + (propertize "C-g" 'face 'transient-key)))) (when transient--editp (unless transient--helpp (insert - (format (propertize "\ -Type a %s to set level for that suffix command. -Type %s to set what levels are available for this prefix command.\n" - 'face 'transient-heading) - (propertize "" 'face 'transient-key) - (propertize "C-x l" 'face 'transient-key)))) + (format + (propertize "\ +Type %s and then %s to put the respective suffix command on level %s. +Type %s and then %s to display suffixes up to level %s in this menu. +Type %s and then %s to describe the respective suffix command.\n" + 'face 'transient-heading) + (propertize "" 'face 'transient-key) + (propertize "" 'face 'transient-key) + (propertize " N " 'face 'transient-enabled-suffix) + (propertize "C-x l" 'face 'transient-key) + (propertize "" 'face 'transient-key) + (propertize " N " 'face 'transient-enabled-suffix) + (propertize "C-h" 'face 'transient-key) + (propertize "" 'face 'transient-key)))) (with-slots (level) transient--prefix (insert - (format (propertize " -Suffixes on levels %s are available. -Suffixes on levels %s and %s are unavailable.\n" - 'face 'transient-heading) - (propertize (format "1-%s" level) - 'face 'transient-enabled-suffix) - (propertize " 0 " - 'face 'transient-disabled-suffix) - (propertize (format ">=%s" (1+ level)) - 'face 'transient-disabled-suffix)))))) + (format + (propertize " +The current level of this menu is %s, so + commands on levels %s are displayed, and + commands on levels %s and %s are not displayed.\n" + 'face 'transient-heading) + (propertize (format " %s " level) 'face 'transient-enabled-suffix) + (propertize (format " 1..%s " level) 'face 'transient-enabled-suffix) + (propertize (format " >= %s " (1+ level)) + 'face 'transient-disabled-suffix) + (propertize " 0 " 'face 'transient-disabled-suffix)))))) (cl-defgeneric transient-show-summary (obj &optional return) "Show brief summary about the command at point in the echo area. diff --git a/lisp/treesit.el b/lisp/treesit.el index 97fb2f478f2..b923545d50c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -226,15 +226,35 @@ is nil, try to guess the language at POS using `treesit-language-at'. If there's a local parser at POS, the local parser takes priority unless PARSER-OR-LANG is a parser, or PARSER-OR-LANG is a language and doesn't match the language of the local parser." - (let* ((root (if (treesit-parser-p parser-or-lang) - (treesit-parser-root-node parser-or-lang) - (or (when-let* ((parser - (car (treesit-local-parsers-at - pos parser-or-lang)))) - (treesit-parser-root-node parser)) - (treesit-buffer-root-node - (or parser-or-lang - (treesit-language-at pos)))))) + (let* ((root + ;; 1. Given a parser, just use the parser's root node. + (cond ((treesit-parser-p parser-or-lang) + (treesit-parser-root-node parser-or-lang)) + ;; 2. Given a language, try local parser, then global + ;; parser. + (parser-or-lang + (let* ((local-parser (car (treesit-local-parsers-at + pos parser-or-lang))) + (global-parser (car (treesit-parser-list + nil parser-or-lang))) + (parser (or local-parser global-parser))) + (when parser + (treesit-parser-root-node parser)))) + ;; 3. No given language, try to get a language at point. + ;; If we got a language, only use parser of that + ;; language, otherwise use any parser we can find. When + ;; finding parser, try local parser first, then global + ;; parser. + (t + ;; LANG can be nil. + (let* ((lang (treesit-language-at pos)) + (local-parser (car (treesit-local-parsers-at + pos lang))) + (global-parser (car (treesit-parser-list + nil lang))) + (parser (or local-parser global-parser))) + (when parser + (treesit-parser-root-node parser)))))) (node root) (node-before root) (pos-1 (max (1- pos) (point-min))) @@ -1772,6 +1792,38 @@ over `treesit-simple-indent-rules'.") (back-to-indentation) (treesit--indent-largest-node-at (point))))) +(defvar treesit-simple-indent-standalone-predicate nil + "Function used to determine if a node is \"standalone\". + +\"Standalone\" means the node starts on a new line. For example, if we +look at the opening bracket, then it's standalone in this case: + + { <-- Standalone. + return 1; + } + +but not in this case: + + if (true) { <-- Not standalone. + return 1; + } + +The value of this variable affects the `standalone-parent' indent preset +for treesit-simple-indent. If the value is nil, the standlone condition +is as described. Some major mode might want to relax the condition a +little bit, so that it ignores some punctuation like \".\". For +example, a Javascript mode might want to consider the method call below +to be standalone too: + + obj + .method(() => { <-- Consider \".method\" to be standalone, + return 1; <-- so this line anchors on \".method\". + }); + +The value should be a function that takes a node, and return t if it's +standalone. If the function returns a position, that position is used +as the anchor.") + (defvar treesit-simple-indent-presets (list (cons 'match (lambda @@ -1905,16 +1957,23 @@ over `treesit-simple-indent-rules'.") (goto-char (treesit-node-start parent)) (back-to-indentation) (point)))) - (cons 'standalone-parent - (lambda (_n parent &rest _) - (save-excursion - (catch 'term - (while parent - (goto-char (treesit-node-start parent)) - (when (looking-back (rx bol (* whitespace)) - (line-beginning-position)) - (throw 'term (point))) - (setq parent (treesit-node-parent parent))))))) + (cons + 'standalone-parent + (lambda (_n parent &rest _) + (save-excursion + (let (anchor) + (catch 'term + (while parent + (goto-char (treesit-node-start parent)) + (when (if (null treesit-simple-indent-standalone-predicate) + (looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (setq anchor + (funcall + treesit-simple-indent-standalone-predicate + parent))) + (throw 'term (if (numberp anchor) anchor (point)))) + (setq parent (treesit-node-parent parent)))))))) (cons 'prev-sibling (lambda (node parent bol &rest _) (treesit-node-start (or (treesit-node-prev-sibling node t) @@ -2045,7 +2104,10 @@ parent-bol standalone-parent Finds the first ancestor node (parent, grandparent, etc.) that - starts on its own line, and returns the start of that node. + starts on its own line, and returns the start of that node. The + definition of \"standalone\" can be customized by setting + `treesit-simple-indent-standalone-predicate'. Some major mode might + want to do that for easier indentation for method chaining. prev-sibling @@ -2769,12 +2831,6 @@ friends." ;; ;; There are also some defun-specific functions, like ;; treesit-defun-name, treesit-add-log-current-defun. -;; -;; TODO: Integration with thing-at-point: once our thing interface is -;; stable. -;; -;; TODO: Integration with hideshow: I tried and failed, we need -;; SomeOne that understands hideshow to look at it. (defvar-local treesit-defun-type-regexp nil "A regexp that matches the node type of defun nodes. @@ -3241,7 +3297,6 @@ function is called recursively." ;; Counter equal to 0 means we successfully stepped ARG steps. (if (eq counter 0) pos nil))) -;; 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. @@ -3487,15 +3542,26 @@ when a major mode sets it.") (funcall (nth 2 setting) node)))) treesit-simple-imenu-settings)) +(defun treesit-outline--at-point () + "Return the outline heading node at the current line." + (let* ((pred treesit-outline-predicate) + (bol (pos-bol)) + (eol (pos-eol)) + (current (treesit-thing-at (point) pred)) + (current-valid (when current + (<= bol (treesit-node-start current) eol))) + (next (unless current-valid + (treesit-navigate-thing (point) 1 'beg pred))) + (next-valid (when next (<= bol next eol)))) + (or (and current-valid current) + (and next-valid (treesit-thing-at next pred))))) + (defun treesit-outline-search (&optional bound move backward looking-at) "Search for the next outline heading in the syntax tree. For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in `outline-search-function'." (if looking-at - (when-let* ((node (or (treesit-thing-at (pos-eol) treesit-outline-predicate) - (treesit-thing-at (pos-bol) treesit-outline-predicate))) - (start (treesit-node-start node))) - (eq (pos-bol) (save-excursion (goto-char start) (pos-bol)))) + (when (treesit-outline--at-point) (pos-bol)) (let* ((bob-pos ;; `treesit-navigate-thing' can't find a thing at bobp, @@ -3526,9 +3592,8 @@ For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in (defun treesit-outline-level () "Return the depth of the current outline heading." - (let* ((node (treesit-node-at (point) nil t)) - (level (if (treesit-node-match-p node treesit-outline-predicate) - 1 0))) + (let* ((node (treesit-outline--at-point)) + (level 1)) (while (setq node (treesit-parent-until node treesit-outline-predicate)) (setq level (1+ level))) (if (zerop level) 1 level))) @@ -3566,7 +3631,7 @@ For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in (let* ((comment-pred (when comments (if (treesit-thing-defined-p 'comment (treesit-language-at (point))) - 'comment "comment"))) + 'comment "\\`comment\\'"))) (pred (if comment-pred (append '(or list) (list comment-pred)) 'list)) ;; `treesit-navigate-thing' can't find a thing at bobp, ;; so use `treesit-thing-at' to match at bobp. @@ -3601,7 +3666,7 @@ For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in "Tree-sitter implementation of `hs-inside-comment-p-func'." (let* ((comment-pred (if (treesit-thing-defined-p 'comment (treesit-language-at (point))) - 'comment "comment")) + 'comment "\\`comment\\'")) (thing (or (treesit-thing-at (point) comment-pred) (unless (bobp) (treesit-thing-at (1- (point)) comment-pred))))) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 77807fc4f35..5906f8a0571 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1550,6 +1550,10 @@ else cover the whole buffer." (defvar whitespace-style) (defvar whitespace-trailing-regexp) +;; Prevent applying `view-read-only' to diff-mode buffers (bug#75993). +;; We don't derive from `special-mode' because that would inhibit the +;; `self-insert-command' binding of normal keys. +(put 'diff-mode 'mode-class 'special) ;;;###autoload (define-derived-mode diff-mode fundamental-mode "Diff" "Major mode for viewing/editing context diffs. @@ -1620,15 +1624,16 @@ a diff with \\[diff-reverse-direction]. \\{diff-minor-mode-map}" :group 'diff-mode :lighter " Diff" ;; FIXME: setup font-lock - (when diff--track-changes (track-changes-unregister diff--track-changes)) + (when diff--track-changes + (track-changes-unregister diff--track-changes) + (setq diff--track-changes nil)) (remove-hook 'write-contents-functions #'diff-write-contents-hooks t) (when diff-minor-mode (if (not diff-update-on-the-fly) (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t) - (unless diff--track-changes - (setq diff--track-changes - (track-changes-register #'diff--track-changes-signal - :nobefore t)))))) + (setq diff--track-changes + (track-changes-register #'diff--track-changes-signal + :nobefore t))))) ;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 5d172238a60..f77b73c6170 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -505,6 +505,8 @@ This relies on mode-specific knowledge and thus only works in some major modes. Uses `smerge-resolve-function' to do the actual work." (interactive) (smerge-match-conflict) + ;; FIXME: This ends up removing the refinement-highlighting when no + ;; resolution is performed. (smerge-remove-props (match-beginning 0) (match-end 0)) (let ((md (match-data)) (m0b (match-beginning 0)) @@ -526,13 +528,12 @@ major modes. Uses `smerge-resolve-function' to do the actual work." (eq (match-beginning 1) (match-beginning 3))) (smerge-keep-n 3)) ;; Mode-specific conflict resolution. - ((condition-case nil - (atomic-change-group - (if safe - (funcall smerge-resolve-function safe) - (funcall smerge-resolve-function)) - t) - (error nil)) + ((ignore-errors + (atomic-change-group + (if safe + (funcall smerge-resolve-function safe) + (funcall smerge-resolve-function)) + t)) ;; Nothing to do: the resolution function has done it already. nil) ;; Non-conflict. @@ -653,11 +654,9 @@ major modes. Uses `smerge-resolve-function' to do the actual work." (save-excursion (goto-char (point-min)) (while (re-search-forward smerge-begin-re nil t) - (condition-case nil - (progn - (smerge-match-conflict) - (smerge-resolve 'safe)) - (error nil))))) + (with-demoted-errors "%S" + (smerge-match-conflict) + (smerge-resolve 'safe))))) (defun smerge-batch-resolve () ;; command-line-args-left is what is left of the command line. @@ -1038,25 +1037,62 @@ chars to try and eliminate some spurious differences." smerge-refine-forward-function) startline) (point))) - (end (progn (funcall (if smerge-refine-weight-hack - #'forward-char - smerge-refine-forward-function) - (if match-num2 - (- (string-to-number match-num2) - startline) - 1)) - (point)))) - (when smerge-refine-ignore-whitespace - (skip-chars-backward " \t\n" beg) (setq end (point)) - (goto-char beg) - (skip-chars-forward " \t\n" end) (setq beg (point))) - (when (> end beg) + (end (if (eq t match-num2) beg + (funcall (if smerge-refine-weight-hack + #'forward-char + smerge-refine-forward-function) + (if match-num2 + (- (string-to-number match-num2) + startline) + 1)) + (point)))) + (cl-assert (<= beg end)) + (when (and (eq t match-num2) (not (eolp))) + ;; FIXME: No idea where this off-by-one comes from, nor why it's only + ;; within lines. + (setq beg (1+ beg)) + (setq end (1+ end)) + (goto-char end)) + (let ((olbeg beg) + (olend end)) + (cond + ((> end beg) + (when smerge-refine-ignore-whitespace + (let* ((newend (progn (skip-chars-backward " \t\n" beg) (point))) + (newbeg (progn (goto-char beg) + (skip-chars-forward " \t\n" newend) (point)))) + (unless (= newend newbeg) + (push `(smerge--refine-adjust ,(- newbeg beg) . ,(- end newend)) + props) + (setq olend newend) + (setq olbeg newbeg))))) + (t + (cl-assert (= end beg)) + ;; If BEG=END, we have nothing to highlight, but we still want + ;; to create an overlay that we can find with char properties, + ;; so as to keep track of the position where a text was + ;; inserted/deleted, so make it span at a char. + (push (cond + ((< beg (point-max)) + (setq olend (1+ beg)) + '(smerge--refine-adjust 0 . -1)) + (t (cl-assert (< (point-min) end)) + (setq olbeg (1- end)) + '(smerge--refine-adjust -1 . 0))) + props))) + (let ((ol (make-overlay - beg end nil + olbeg olend nil ;; Make them tend to shrink rather than spread when editing. 'front-advance nil))) + ;; (overlay-put ol 'smerge--debug + ;; (list match-num1 match-num2 startline)) (overlay-put ol 'evaporate t) - (dolist (x props) (overlay-put ol (car x) (cdr x))) + (dolist (x props) + (when (or (> end beg) + ;; Don't highlight the char we cover artificially. + (not (memq (car-safe x) '(face font-lock-face)))) + (overlay-put ol (car x) (cdr x)))) ol))))) ;;;###autoload @@ -1080,6 +1116,29 @@ used to replace chars to try and eliminate some spurious differences." (file2 (make-temp-file "diff2")) (smerge--refine-long-words (if smerge-refine-weight-hack (make-hash-table :test #'equal)))) + + ;; Cover the two regions with one `smerge--refine-region' overlay each. + (let ((ol1 (make-overlay beg1 end1 nil + ;; Make it shrink rather than spread when editing. + 'front-advance nil)) + (ol2 (make-overlay beg2 end2 nil + ;; Make it shrink rather than spread when editing. + 'front-advance nil)) + (common-props '((evaporate . t) (smerge--refine-region . t)))) + (dolist (prop (or props-a props-c)) + (when (and (not (memq (car prop) '(face font-lock-face))) + (member prop (or props-r props-c)) + (or (not (and props-c props-a props-r)) + (member prop props-c))) + ;; This PROP is shared among all those overlays. + ;; Better keep it also for the `smerge--refine-region' overlays, + ;; so the client package recognizes them as being part of the + ;; refinement (e.g. it will hopefully delete them like the others). + (push prop common-props))) + (dolist (prop common-props) + (overlay-put ol1 (car prop) (cdr prop)) + (overlay-put ol2 (car prop) (cdr prop)))) + (unless (markerp beg1) (setq beg1 (copy-marker beg1))) (unless (markerp beg2) (setq beg2 (copy-marker beg2))) (let ((write-region-inhibit-fsync t)) ; Don't fsync temp files (Bug#12747). @@ -1118,20 +1177,20 @@ used to replace chars to try and eliminate some spurious differences." (m2 (match-string 2)) (m4 (match-string 4)) (m5 (match-string 5))) - (when (memq op '(?d ?c)) - (setq last1 - (smerge--refine-highlight-change - beg1 m1 m2 - ;; Try to use props-c only for changed chars, - ;; fallback to props-r for changed/removed chars, - ;; but if props-r is nil then fallback to props-c. - (or (and (eq op '?c) props-c) props-r props-c)))) - (when (memq op '(?a ?c)) - (setq last2 - (smerge--refine-highlight-change - beg2 m4 m5 - ;; Same logic as for removed chars above. - (or (and (eq op '?c) props-c) props-a props-c))))) + (setq last1 + (smerge--refine-highlight-change + beg1 m1 (if (eq op ?a) t m2) + ;; Try to use props-c only for changed chars, + ;; fallback to props-r for changed/removed chars, + ;; but if props-r is nil then fallback to props-c. + (or (and (eq op '?c) props-c) props-r props-c))) + (setq last2 + (smerge--refine-highlight-change + beg2 m4 (if (eq op ?d) t m5) + ;; Same logic as for removed chars above. + (or (and (eq op '?c) props-c) props-a props-c)))) + (overlay-put last1 'smerge--refine-other last2) + (overlay-put last2 'smerge--refine-other last1) (forward-line 1) ;Skip hunk header. (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body. (goto-char (match-beginning 0)))) @@ -1206,6 +1265,57 @@ repeating the command will highlight other two parts." (unless smerge-use-changed-face '((smerge . refine) (font-lock-face . smerge-refined-added)))))) +(defun smerge-refine-exchange-point () + "Go to the matching position in the other chunk." + (interactive) + (let* ((covering-ol + (let ((ols (overlays-at (point)))) + (while (and ols (not (overlay-get (car ols) + 'smerge--refine-region))) + (pop ols)) + (or (car ols) + (user-error "Not inside a refined region")))) + (ref-pos + (if (or (get-char-property (point) 'smerge--refine-other) + (get-char-property (1- (point)) 'smerge--refine-other)) + (point) + (let ((next (next-single-char-property-change + (point) 'smerge--refine-other nil + (overlay-end covering-ol))) + (prev (previous-single-char-property-change + (point) 'smerge--refine-other nil + (overlay-start covering-ol)))) + (cond + ((and (> prev (overlay-start covering-ol)) + (or (>= next (overlay-end covering-ol)) + (> (- next (point)) (- (point) prev)))) + prev) + ((< next (overlay-end covering-ol)) next) + (t (user-error "No \"other\" position info found")))))) + (boundary + (cond + ((< ref-pos (point)) + (let ((adjust (get-char-property (1- ref-pos) + 'smerge--refine-adjust))) + (min (point) (+ ref-pos (or (cdr adjust) 0))))) + ((> ref-pos (point)) + (let ((adjust (get-char-property ref-pos 'smerge--refine-adjust))) + (max (point) (- ref-pos (or (car adjust) 0))))) + (t ref-pos))) + (other-forw (get-char-property ref-pos 'smerge--refine-other)) + (other-back (get-char-property (1- ref-pos) 'smerge--refine-other)) + (other (or other-forw other-back)) + (dist (- boundary (point)))) + (if (not (overlay-start other)) + (user-error "The \"other\" position has vanished") + (goto-char + (- (if other-forw + (- (overlay-start other) + (or (car (overlay-get other 'smerge--refine-adjust)) 0)) + (+ (overlay-end other) + (or (cdr (overlay-get other 'smerge--refine-adjust)) 0))) + dist))))) + (defun smerge-swap () ;; FIXME: Extend for diff3 to allow swapping the middle end as well. "Swap the \"Upper\" and the \"Lower\" chunks. @@ -1470,7 +1580,9 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict." (goto-char (point-min)) (while (smerge-find-conflict) (save-excursion - (font-lock-fontify-region (match-beginning 0) (match-end 0) nil))))) + (with-demoted-errors "%S" ;Those things do happen, occasionally. + (font-lock-fontify-region + (match-beginning 0) (match-end 0) nil)))))) (if (string-match (regexp-quote smerge-parsep-re) paragraph-separate) (unless smerge-mode (setq-local paragraph-separate diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 91db030fa1c..06597ed7853 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -790,7 +790,7 @@ and that it passes `vc-cvs-global-switches' to it before FLAGS." If FILE is a list of files, return non-nil if any of them individually should stay local." (if (listp file) - (delq nil (mapcar (lambda (arg) (vc-cvs-stay-local-p arg)) file)) + (delq nil (mapcar #'vc-cvs-stay-local-p file)) (let ((stay-local vc-cvs-stay-local)) (if (symbolp stay-local) stay-local (let ((dirname (if (file-directory-p file) diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 1691ba9c500..f2a186ce320 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -164,7 +164,7 @@ PREFIX was empty." ;; units of the font's average-width) large enough to fit the ;; first-line prefix. (let ((avg-space (propertize (buffer-substring position (1+ position)) - 'display '(space :width 1)))) + 'display '(space :width (1 . width))))) ;; Remove any `min-width' display specs since we'll replace with ;; our own later in `visual-wrap--apply-to-line' (bug#73882). (add-display-text-property 0 (length prefix) 'min-width nil prefix) diff --git a/lisp/which-key.el b/lisp/which-key.el index 45a02955e11..bfeb9da7422 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -2038,7 +2038,7 @@ that width." (mapcar (pcase-lambda (`(,key ,sep ,desc ,_doc)) (concat (format col-format key sep desc) - (make-string (- col-desc-width (string-width desc)) ?\s))) + (make-string (max (- col-desc-width (string-width desc)) 0) ?\s))) col-keys)))) (defun which-key--partition-list (n list) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 7260f60196a..a1d4c4850ae 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1730,6 +1730,49 @@ The value of the :type attribute should be an unconverted widget type." (call-interactively (widget-get widget :complete-function)))))))) +(defun widget--prepare-markers-for-inside-insertion (widget) + "Prepare the WIDGET's parent for insertions inside it, if necessary. + +Usually, the :from marker has type t, while the :to marker has type nil. +When recreating a child or a button inside a composite widget right at these +markers, they have to be changed to nil and t respectively, +so that the WIDGET's parent (if any), properly contains all of its +recreated children and buttons. + +Prepares also the markers of the WIDGET's grandparent, if necessary. + +Returns a list of the markers that had its type changed, for later resetting." + (let* ((parent (widget-get widget :parent)) + (parent-from-marker (and parent (widget-get parent :from))) + (parent-to-marker (and parent (widget-get parent :to))) + (lst nil) + (pos (point))) + (when (and parent-from-marker + (eq pos (marker-position parent-from-marker)) + (marker-insertion-type parent-from-marker)) + (set-marker-insertion-type parent-from-marker nil) + (push (cons parent-from-marker t) lst)) + (when (and parent-to-marker + (eq pos (marker-position parent-to-marker)) + (not (marker-insertion-type parent-to-marker))) + (set-marker-insertion-type parent-to-marker t) + (push (cons parent-to-marker nil) lst)) + (when lst + (nconc lst (widget--prepare-markers-for-inside-insertion parent))))) + +(defun widget--revert-markers-for-outside-insertion (markers) + "Revert MARKERS for insertions that do not belong to a widget. + +MARKERS is a list of the form (MARKER . NEW-TYPE), as returned by +`widget--prepare-markers-for-inside-insertion' and this function sets MARKER +to NEW-TYPE. + +Coupled with `widget--prepare-parent-for-inside-insertion', this has the effect +of setting markers back to the type needed for insertions that do not belong +to a given widget." + (dolist (marker markers) + (set-marker-insertion-type (car marker) (cdr marker)))) + (defun widget-default-create (widget) "Create WIDGET at point in the current buffer." (widget-specify-insert @@ -1737,7 +1780,8 @@ The value of the :type attribute should be an unconverted widget type." button-begin button-end sample-begin sample-end doc-begin doc-end - value-pos) + value-pos + (markers (widget--prepare-markers-for-inside-insertion widget))) (insert (widget-get widget :format)) (goto-char from) ;; Parse escapes in format. @@ -1797,7 +1841,8 @@ The value of the :type attribute should be an unconverted widget type." (widget-specify-doc widget doc-begin doc-end)) (when value-pos (goto-char value-pos) - (widget-apply widget :value-create))) + (widget-apply widget :value-create)) + (widget--revert-markers-for-outside-insertion markers)) (let ((from (point-min-marker)) (to (point-max-marker))) (set-marker-insertion-type from t) diff --git a/lisp/window-tool-bar.el b/lisp/window-tool-bar.el index e2c886c41e5..96726960fea 100644 --- a/lisp/window-tool-bar.el +++ b/lisp/window-tool-bar.el @@ -4,8 +4,9 @@ ;; Author: Jared Finder ;; Created: Nov 21, 2023 -;; Version: 0.2.1 +;; Version: 0.3 ;; Keywords: mouse +;; URL: http://github.com/chaosemer/window-tool-bar ;; Package-Requires: ((emacs "27.1") (compat "29.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality that @@ -54,44 +55,27 @@ ;;; Known issues: ;; -;; On GNU Emacs 29.1, terminals dragging to resize windows will error -;; with message " is undefined". This is a -;; bug in GNU Emacs, +;; On GNU Emacs 29.1 and earlier, terminals dragging to resize windows +;; will error with message " is undefined". +;; This is a bug in GNU Emacs, ;; . ;; -;; On GNU Emacs 29, performance in terminals is lower than on -;; graphical frames. This is due to a workaround, see "Workaround for -;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334", below. +;; On GNU Emacs 29 and earlier, performance in terminals is lower than +;; on graphical frames. This is due to a workaround, see "Workaround +;; for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334", below. ;;; Todo: ;; ;; Not all features planned are implemented yet. Eventually I would ;; like to also generally make tool bars better. ;; -;; Targeting 0.3: -;; * Properly support remaining less frequently used tool bar item specs. From -;; `parse_tool_bar_item': -;; * :visible -;; * :filter -;; * :button -;; * :wrap -;; * Add display customization similar to `tool-bar-style'. -;; -;; Targeting 1.0: +;; Post 1.0 work: ;; ;; * Clean up Emacs tool bars ;; * Default: Remove default tool-bar entirely ;; * grep, vc: Remove default tool-bar inherited ;; * info: Remove Next / Prev / Up, which is already in the header ;; * smerge: Add tool bar for next/prev -;; -;; Post 1.0 work: -;; -;; * Show keyboard shortcut on help text. -;; -;; * Add a bit more documentation. -;; * Add customization option: ignore-default-tool-bar-map -;; * Make tab-line dragging resize the window ;;; Code: @@ -99,6 +83,11 @@ (require 'mwheel) (require 'tab-line) (require 'tool-bar) + +(add-to-list 'customize-package-emacs-version-alist + '(window-tool-bar ("0.1" . "30.1") + ("0.2" . "30.1") + ("0.3" . "31.1"))) ;;; Benchmarking code ;; @@ -227,7 +216,7 @@ AVG-MEMORY-USE is a list of averages, with the same meaning as (defun window-tool-bar-string () "Return a (propertized) string for the tool bar. -This is for when you want more customizations than +This is for when you want more customizations than the command `window-tool-bar-mode' provides. Commonly added to the variable `tab-line-format', `header-line-format', or `mode-line-format'" (if (or (null window-tool-bar-string--cache) @@ -235,13 +224,14 @@ This is for when you want more customizations than (let* ((mem0 (memory-use-counts)) (toolbar-menu (window-tool-bar--get-keymap)) (mem1 (memory-use-counts)) - (result (mapconcat #'window-tool-bar--keymap-entry-to-string - (cdr toolbar-menu) ;Skip 'keymap + (strs (mapcar #'window-tool-bar--keymap-entry-to-string + (cdr toolbar-menu))) ;Skip 'keymap + (result (mapconcat #'identity + (delete nil strs) ;; Without spaces between the text, hovering ;; highlights all adjacent buttons. - (if (window-tool-bar--use-images) - (propertize " " 'invisible t) - " "))) + (if (eq 'text (window-tool-bar--style)) " " + (propertize " " 'invisible t)))) (mem2 (memory-use-counts))) (cl-mapl (lambda (l-init l0 l1) (cl-incf (car l-init) (- (car l1) (car l0)))) @@ -281,45 +271,101 @@ MENU-ITEM is a menu item to convert. See info node `(elisp)Tool Bar'." ((or `(,_ "--") `(,_ menu-item ,(and (pred stringp) (pred (string-prefix-p "--"))))) - (if (window-tool-bar--use-images) - window-tool-bar--graphical-separator - "|")) + (if (eq 'text (window-tool-bar--style)) "|" + window-tool-bar--graphical-separator)) ;; Menu item, turn into propertized string button (`(,key menu-item ,name-expr ,binding . ,plist) - (when binding ; If no binding exists, then button is hidden. - (let* ((name (eval name-expr)) - (str (upcase-initials (or (plist-get plist :label) - (string-trim-right name "\\.+")))) - (len (length str)) - (enable-form (plist-get plist :enable)) - (enabled (or (not enable-form) - (eval enable-form)))) - (if enabled + (let* ((visible-entry (plist-member plist :visible)) + (visible (or (null visible-entry) ;Default is visible + (eval (cadr visible-entry)))) + (wrap (plist-get plist :wrap)) + (filter (plist-get plist :filter))) + (when filter + (setf binding + ;; You would expect this to use `funcall', but existing + ;; code in `parse_tool_bar_item' uses `eval'. + (eval `(,filter ',binding)))) + (when (and binding + visible + (null wrap)) + (let* ((name (eval name-expr)) + (str (upcase-initials (or (plist-get plist :label) + (string-trim-right name "\\.+")))) + (len (length str)) + (enable-form (plist-get plist :enable)) + (enabled (or (not enable-form) + (eval enable-form))) + (button-spec (plist-get plist :button)) + (button-selected (eval (cdr-safe button-spec))) + (vert-only (plist-get plist :vert-only)) + image-start + image-end) + ;; Depending on style, Images can be displayed to the + ;; left, to the right, or in place of the text + (pcase-exhaustive (window-tool-bar--style) + ('image + (setf image-start 0 + image-end len)) + ('text + ;; Images shouldn't be available + ) + ((or 'both 'both-horiz) + (if vert-only + (setf image-start 0 image-end len) + (setf str (concat " " str) + image-start 0 + image-end 1 + len (1+ len)))) + ('text-image-horiz + (if vert-only + (setf image-start 0 image-end len) + (setf str (concat str " ") + image-start len + image-end (1+ len) + len (1+ len))))) + + (cond + ((and enabled button-selected) + (add-text-properties 0 len + '(mouse-face + window-tool-bar-button-checked-hover + keymap window-tool-bar--button-keymap + face window-tool-bar-button-checked) + str)) + (enabled (add-text-properties 0 len '(mouse-face window-tool-bar-button-hover keymap window-tool-bar--button-keymap face window-tool-bar-button) - str) - (put-text-property 0 len - 'face - 'window-tool-bar-button-disabled - str)) - (when-let* ((spec (and (window-tool-bar--use-images) - (plist-get menu-item :image)))) - (put-text-property 0 len - 'display - (append spec - (if enabled '(:margin 2 :ascent center) - '(:margin 2 :ascent center - :conversion disabled))) - str)) - (put-text-property 0 len - 'help-echo - (or (plist-get plist :help) name) - str) - (put-text-property 0 len 'tool-bar-key key str) - str))))) + str)) + (t + (put-text-property 0 len + 'face + 'window-tool-bar-button-disabled + str))) + (when-let* ((spec (and image-start image-end + (plist-get menu-item :image)))) + (put-text-property image-start image-end + 'display + (append spec + (if enabled '(:margin 2 :ascent center) + '(:margin 2 :ascent center + :conversion disabled))) + str)) + (let ((help-text (or (plist-get plist :help) name)) + (keys (where-is-internal binding nil t))) + (put-text-property 0 len + 'help-echo + (if keys + (concat help-text + " (" + (key-description keys) + ")") + help-text) + str)) + (put-text-property 0 len 'tool-bar-key key str) + str)))))) (defun window-tool-bar--call-button () "Call the button that was clicked on in the tab line." @@ -378,8 +424,8 @@ enclosed in a `progn' form. ELSE-FORMS may be empty." ;; interactions that can alter the tool bar. Specifically, this ;; excludes mouse movement, mouse wheel scroll, and pinch. (not (member type window-tool-bar--ignored-event-types)) - ;; Assume that any command that triggers shift select can't alter - ;; the tool bar. This excludes pure navigation commands. + ;; Assume that any command that triggers shift select cannot + ;; alter the tool bar. This excludes pure navigation commands. (not (window-tool-bar--command-triggers-shift-select-p last-command)) ;; Assume that self-insert-command won't alter the tool bar. ;; This is the most commonly executed command. @@ -415,20 +461,53 @@ enclosed in a `progn' form. ELSE-FORMS may be empty." (define-globalized-minor-mode global-window-tool-bar-mode window-tool-bar-mode window-tool-bar--turn-on :group 'window-tool-bar + :package-version '(window-tool-bar . "0.1") (add-hook 'isearch-mode-hook #'window-tool-bar--turn-on) (add-hook 'isearch-mode-end-hook #'window-tool-bar--turn-on)) -(defvar window-tool-bar--allow-images t - "Internal debug flag to force text mode.") - -(defun window-tool-bar--use-images () - "Internal function. -Respects `window-tool-bar--allow-images' as well as frame -capabilities." - (and window-tool-bar--allow-images - (display-images-p))) +(defun window-tool-bar--turn-on () + "Internal function called by the command `global-window-tool-bar-mode'." + (when global-window-tool-bar-mode + (window-tool-bar-mode 1))) ;;; Display styling: +(defcustom window-tool-bar-style 'image + "Tool bar style to use for window tool bars. +The meaning is the same as for `tool-bar-style', which see. If +set to the symbol `tool-bar-style', then use the value of +`tool-bar-style' instead. + +When images cannot be displayed (see `display-images-p'), the value set +here is ignored and the window tool bar displays text." + :type '(choice + (const :tag "Images" :value image) + (const :tag "Text" :value text) + ;; This option would require multiple tool bar lines. + ;;(const :tag "Both, text below image" :value both) + (const :tag "Both, text to right of image" :value both-horiz) + (const :tag "Both, text to left of image" :value text-image-horiz) + (const :tag "Inherit tool-bar-style" :value tool-bar-style) + (const :tag "System default" :value nil)) + :group 'window-tool-bar + :package-version '(window-tool-bar . "0.3")) + +(defun window-tool-bar--style () + "Return the effective style based on `window-tool-bar-style'. + +This also takes into account frame capabilities. If the current +frame cannot display images (see `display-images-p'), then this +will always return the symbol text." + (if (not (display-images-p)) + 'text + (let ((style window-tool-bar-style)) + (when (eq style 'tool-bar-style) + (setf style tool-bar-style)) + (unless (memq style '(image text both both-horiz text-image-horiz)) + (setf style (if (fboundp 'tool-bar-get-system-style) + (tool-bar-get-system-style) + 'image))) + style))) + (defface window-tool-bar-button '((default :inherit tab-line) @@ -441,7 +520,8 @@ capabilities." (t :inverse-video t)) "Face used for buttons when the mouse is not hovering over the button." - :group 'window-tool-bar) + :group 'window-tool-bar + :package-version '(window-tool-bar . "0.2")) (defface window-tool-bar-button-hover '((default @@ -452,7 +532,8 @@ capabilities." (t :inverse-video t)) "Face used for buttons when the mouse is hovering over the button." - :group 'window-tool-bar) + :group 'window-tool-bar + :package-version '(window-tool-bar . "0.2")) (defface window-tool-bar-button-disabled '((default @@ -465,7 +546,38 @@ capabilities." :inverse-video t :background "brightblack")) "Face used for buttons when the button is disabled." - :group 'window-tool-bar) + :group 'window-tool-bar + :package-version '(window-tool-bar . "0.2")) + +(defface window-tool-bar-button-checked + '((default + :inherit tab-line) + (((supports :box t)) + :box (:line-width -1 :style pressed-button) + :background "grey85") + (((class color)) + :background "blue" + :foreground "white") + (t + :inverse-video t)) + "Face used for buttons when they are toggled." + :group 'window-tool-bar + :package-version '(window-tool-bar . "0.3")) + +(defface window-tool-bar-button-checked-hover + '((default + :inherit tab-line) + (((class color) (min-colors 88) (supports :box t)) + :box (:line-width -1 :style pressed-button) + :background "grey95") + (((class color)) + :background "brightblue" + :foreground "white") + (t + :inverse-video t)) + "Face used for buttons when the mouse is hovering over the button." + :group 'window-tool-bar + :package-version '(window-tool-bar . "0.3")) ;;; Workaround for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334. @@ -476,10 +588,10 @@ capabilities." "Return the tool bar keymap." (let ((tool-bar-always-show-default nil)) (if (and (version< emacs-version "30") - (not (window-tool-bar--use-images))) - ;; This code path is a less efficient workaround. - (window-tool-bar--make-keymap-1) - (keymap-global-lookup "")))) + (eq 'text (window-tool-bar--style))) + ;; This code path is a less efficient workaround. + (window-tool-bar--make-keymap-1) + (keymap-global-lookup "")))) (declare-function image-mask-p "image.c" (spec &optional frame)) @@ -506,12 +618,7 @@ capabilities." (plist-put plist :image image))) bind)) tool-bar-map)) - -(defun window-tool-bar--turn-on () - "Internal function called by `global-window-tool-bar-mode'." - (when global-window-tool-bar-mode - (window-tool-bar-mode 1))) - + (provide 'window-tool-bar) ;;; window-tool-bar.el ends here diff --git a/lisp/window.el b/lisp/window.el index 74bb2985254..290b5cae64d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6309,8 +6309,7 @@ specific buffers." ,@(when next-buffers `((next-buffers . ,(if writable - (mapcar (lambda (buffer) (buffer-name buffer)) - next-buffers) + (mapcar #'buffer-name next-buffers) next-buffers)))) ,@(when prev-buffers `((prev-buffers @@ -7394,20 +7393,64 @@ hold: (* 2 (max window-min-height (if mode-line-format 2 1)))))))))) +(defcustom split-window-preferred-direction 'vertical + "The first direction tried when Emacs needs to split a window. +This variable controls in which order `split-window-sensibly' will try to +split the window. That order specially matters when both dimensions of +the frame are long enough to be split according to +`split-width-threshold' and `split-height-threshold'. If this is set to +`vertical' (the default), `split-window-sensibly' tries to split +vertically first and then horizontally. If set to `horizontal' it does +the opposite. If set to `longest', the first direction tried +depends on the frame shape: in landscape orientation it will be like +`horizontal', but in portrait it will be like `vertical'. Basically, +the longest of the two dimension is split first. + +If both `split-width-threshold' and `split-height-threshold' cannot be +satisfied, it will fallback to split vertically. + +See `split-window-preferred-function' for more control of the splitting +strategy." + :type '(radio + (const :tag "Try to split vertically first" + vertical) + (const :tag "Try to split horizontally first" + horizontal) + (const :tag "Try to split along the longest edge first" + longest)) + :version "31.1" + :group 'windows) + +(defun window--try-vertical-split (window) + "Helper function for `split-window-sensibly'" + (when (window-splittable-p window) + (with-selected-window window + (split-window-below)))) + +(defun window--try-horizontal-split (window) + "Helper function for `split-window-sensibly'" + (when (window-splittable-p window t) + (with-selected-window window + (split-window-right)))) + (defun split-window-sensibly (&optional window) "Split WINDOW in a way suitable for `display-buffer'. -WINDOW defaults to the currently selected window. -If `split-height-threshold' specifies an integer, WINDOW is at -least `split-height-threshold' lines tall and can be split -vertically, split WINDOW into two windows one above the other and -return the lower window. Otherwise, if `split-width-threshold' -specifies an integer, WINDOW is at least `split-width-threshold' -columns wide and can be split horizontally, split WINDOW into two -windows side by side and return the window on the right. If this -can't be done either and WINDOW is the only window on its frame, -try to split WINDOW vertically disregarding any value specified -by `split-height-threshold'. If that succeeds, return the lower -window. Return nil otherwise. +The variable `split-window-preferred-direction' prescribes an order of +directions in which Emacs should try to split WINDOW. If that order +mandates starting with a vertical split, and `split-height-threshold' +specifies an integer that is at least as large a WINDOW's height, split +WINDOW into two windows one below the other and return the lower one. +If that order mandates starting with a horizontal split, and +`split-width-threshold' specifies an integer that is at least as large +as WINDOW's width, split WINDOW into two windows side by side and return +the one on the right. + +In either case, if the first attempt to split WINDOW fails, try to split +the window in the other direction in the same manner as described above. +If that attempt fails too, and WINDOW is the only window on its frame, +try splitting WINDOW into two windows, one below the other, disregarding +the value of `split-height-threshold' and return the window on the +bottom. By default `display-buffer' routines call this function to split the largest or least recently used window. To change the default @@ -7427,14 +7470,14 @@ Have a look at the function `window-splittable-p' if you want to know how `split-window-sensibly' determines whether WINDOW can be split." (let ((window (or window (selected-window)))) - (or (and (window-splittable-p window) - ;; Split window vertically. - (with-selected-window window - (split-window-below))) - (and (window-splittable-p window t) - ;; Split window horizontally. - (with-selected-window window - (split-window-right))) + (or (if (or + (eql split-window-preferred-direction 'horizontal) + (and (eql split-window-preferred-direction 'longest) + (> (frame-width) (frame-height)))) + (or (window--try-horizontal-split window) + (window--try-vertical-split window)) + (or (window--try-vertical-split window) + (window--try-horizontal-split window))) (and ;; If WINDOW is the only usable window on its frame (it is ;; the only one or, not being the only one, all the other @@ -7452,10 +7495,8 @@ split." frame nil 'nomini) t))) (not (window-minibuffer-p window)) - (let ((split-height-threshold 0)) - (when (window-splittable-p window) - (with-selected-window window - (split-window-below)))))))) + (let ((split-height-threshold 0)) + (window--try-vertical-split window)))))) (defun window--try-to-split-window (window &optional alist) "Try to split WINDOW. diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index fc48a8290f3..13fe3842f18 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -469,13 +469,15 @@ Currently XDND, Motif and old KDE 1.x protocols are recognized." (progn (let ((action (cdr (assoc (symbol-name (cadr client-message)) x-dnd-xdnd-to-action))) - (targets (cddr client-message)) + (targets (cdddr client-message)) (local-value (nth 2 client-message))) (when (windowp window) (select-window window)) - (x-dnd-save-state window nil nil - (apply #'vector targets)) - (x-dnd-maybe-call-test-function window action) + ;; Remove XdndDirectSave0 from this list--Emacs does not + ;; support this protocol for internal drops. + (setq targets (delete 'XdndDirectSave0 targets)) + (x-dnd-save-state window nil nil (apply #'vector targets)) + (x-dnd-maybe-call-test-function window action nil) (unwind-protect (x-dnd-drop-data event (if (framep window) window (window-frame window)) @@ -1558,9 +1560,9 @@ was taken, or the direct save failed." (x-change-window-property "XdndDirectSave0" encoded-name frame "text/plain" 8 nil) (gui-set-selection 'XdndSelection (concat "file://" file-name)) - ;; FIXME: this does not work with GTK file managers, since - ;; they always reach for `text/uri-list' first, contrary to - ;; the spec. + ;; FIXME: this does not work with GTK file managers, + ;; since they always reach for `text/uri-list' first, + ;; contrary to the spec. (let ((action (x-begin-drag '("XdndDirectSave0" "text/uri-list" "application/octet-stream") 'XdndActionDirectSave @@ -1578,7 +1580,8 @@ was taken, or the direct save failed." (unless prop-deleted (x-delete-window-property "XdndDirectSave0" frame)) ;; Delete any remote copy that was made. - (when (not (equal file-name original-file-name)) + (when (and (not (equal file-name original-file-name)) + x-dnd-xds-performed) (delete-file file-name))))) (defun x-dnd-save-direct (need-name filename) @@ -1717,7 +1720,7 @@ VERSION is the version of the XDND protocol understood by SOURCE." (if (or (not success) (< version 5)) 0 - "XdndDirectSave0"))))))) + "XdndActionDirectSave"))))))) ;; Internal wheel movement. diff --git a/m4/acl.m4 b/m4/acl.m4 index c9cb6dd09ed..7e4b0e354d9 100644 --- a/m4/acl.m4 +++ b/m4/acl.m4 @@ -1,5 +1,5 @@ # acl.m4 -# serial 34 +# serial 35 dnl Copyright (C) 2002, 2004-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -18,7 +18,7 @@ AC_DEFUN([gl_FUNC_ACL_ARG], , [enable_acl=auto]) AC_ARG_WITH([libsmack], [AS_HELP_STRING([--without-libsmack], - [do not use libsmack, even on systems that have it])] + [do not use libsmack, even on systems that have it])], [], [with_libsmack=maybe]) ]) diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index b3b1391bd54..6eff85bea12 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,5 +1,5 @@ # gnulib-common.m4 -# serial 106 +# serial 107 dnl Copyright (C) 2007-2025 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -753,7 +753,9 @@ AC_DEFUN([gl_COMMON_BODY], [ than _GL_ATTRIBUTE_PURE because the function need not return exactly once and can affect state addressed by its arguments.) See also and - . */ + . + ATTENTION! Efforts are underway to change the meaning of this attribute. + See . */ /* Applies to: functions, pointer to functions, function types. */ #ifndef _GL_ATTRIBUTE_REPRODUCIBLE /* This may be revisited when gcc and clang support [[reproducible]] or possibly @@ -804,7 +806,9 @@ AC_DEFUN([gl_COMMON_BODY], [ _GL_ATTRIBUTE_CONST because the function need not return exactly once and can depend on state addressed by its arguments.) See also and - . */ + . + ATTENTION! Efforts are underway to change the meaning of this attribute. + See . */ /* Applies to: functions, pointer to functions, function types. */ #ifndef _GL_ATTRIBUTE_UNSEQUENCED /* This may be revisited when gcc and clang support [[unsequenced]] or possibly diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 980baf83998..42f67d0a42b 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -1057,27 +1057,35 @@ AC_DEFUN([gl_INIT], gl_libobjs= gl_ltlibobjs= gl_libobjdeps= + gl_libgnu_libobjs= + gl_libgnu_ltlibobjs= + gl_libgnu_libobjdeps= if test -n "$gl_LIBOBJS"; then # Remove the extension. changequote(,)dnl sed_drop_objext='s/\.o$//;s/\.obj$//' sed_dirname1='s,//*,/,g' sed_dirname2='s,\(.\)/$,\1,' - sed_dirname3='s,^[^/]*$,.,' - sed_dirname4='s,\(.\)/[^/]*$,\1,' + sed_dirname3='s,[^/]*$,,' sed_basename1='s,.*/,,' changequote([, ])dnl for i in `for i in $gl_LIBOBJS; do echo "$i"; done | sed -e "$sed_drop_objext" | sort | uniq`; do gl_libobjs="$gl_libobjs $i.$ac_objext" gl_ltlibobjs="$gl_ltlibobjs $i.lo" - i_dir=`echo "$i" | sed -e "$sed_dirname1" -e "$sed_dirname2" -e "$sed_dirname3" -e "$sed_dirname4"` + i_dir=`echo "$i" | sed -e "$sed_dirname1" -e "$sed_dirname2" -e "$sed_dirname3"` i_base=`echo "$i" | sed -e "$sed_basename1"` - gl_libobjdeps="$gl_libobjdeps $i_dir/\$(DEPDIR)/$i_base.Po" + gl_libgnu_libobjs="$gl_libgnu_libobjs $i_dir""libgnu_a-$i_base.$ac_objext" + gl_libgnu_ltlibobjs="$gl_libgnu_ltlibobjs $i_dir""libgnu_la-$i_base.lo" + gl_libobjdeps="$gl_libobjdeps $i_dir\$(DEPDIR)/$i_base.Po" + gl_libgnu_libobjdeps="$gl_libgnu_libobjdeps $i_dir\$(DEPDIR)/libgnu_a-$i_base.Po" done fi AC_SUBST([gl_LIBOBJS], [$gl_libobjs]) AC_SUBST([gl_LTLIBOBJS], [$gl_ltlibobjs]) AC_SUBST([gl_LIBOBJDEPS], [$gl_libobjdeps]) + AC_SUBST([gl_libgnu_LIBOBJS], [$gl_libgnu_libobjs]) + AC_SUBST([gl_libgnu_LTLIBOBJS], [$gl_libgnu_ltlibobjs]) + AC_SUBST([gl_libgnu_LIBOBJDEPS], [$gl_libgnu_libobjdeps]) ]) gltests_libdeps= gltests_ltlibdeps= @@ -1121,27 +1129,35 @@ changequote([, ])dnl gltests_libobjs= gltests_ltlibobjs= gltests_libobjdeps= + gltests_libgnu_libobjs= + gltests_libgnu_ltlibobjs= + gltests_libgnu_libobjdeps= if test -n "$gltests_LIBOBJS"; then # Remove the extension. changequote(,)dnl sed_drop_objext='s/\.o$//;s/\.obj$//' sed_dirname1='s,//*,/,g' sed_dirname2='s,\(.\)/$,\1,' - sed_dirname3='s,^[^/]*$,.,' - sed_dirname4='s,\(.\)/[^/]*$,\1,' + sed_dirname3='s,[^/]*$,,' sed_basename1='s,.*/,,' changequote([, ])dnl for i in `for i in $gltests_LIBOBJS; do echo "$i"; done | sed -e "$sed_drop_objext" | sort | uniq`; do gltests_libobjs="$gltests_libobjs $i.$ac_objext" gltests_ltlibobjs="$gltests_ltlibobjs $i.lo" - i_dir=`echo "$i" | sed -e "$sed_dirname1" -e "$sed_dirname2" -e "$sed_dirname3" -e "$sed_dirname4"` + i_dir=`echo "$i" | sed -e "$sed_dirname1" -e "$sed_dirname2" -e "$sed_dirname3"` i_base=`echo "$i" | sed -e "$sed_basename1"` - gltests_libobjdeps="$gltests_libobjdeps $i_dir/\$(DEPDIR)/$i_base.Po" + gltests_libgnu_libobjs="$gltests_libgnu_libobjs $i_dir""libgnu_a-$i_base.$ac_objext" + gltests_libgnu_ltlibobjs="$gltests_libgnu_ltlibobjs $i_dir""libgnu_la-$i_base.lo" + gltests_libobjdeps="$gltests_libobjdeps $i_dir\$(DEPDIR)/$i_base.Po" + gltests_libgnu_libobjdeps="$gltests_libgnu_libobjdeps $i_dir\$(DEPDIR)/libgnu_a-$i_base.Po" done fi AC_SUBST([gltests_LIBOBJS], [$gltests_libobjs]) AC_SUBST([gltests_LTLIBOBJS], [$gltests_ltlibobjs]) AC_SUBST([gltests_LIBOBJDEPS], [$gltests_libobjdeps]) + AC_SUBST([gltests_libgnu_LIBOBJS], [$gltests_libgnu_libobjs]) + AC_SUBST([gltests_libgnu_LTLIBOBJS], [$gltests_libgnu_ltlibobjs]) + AC_SUBST([gltests_libgnu_LIBOBJDEPS], [$gltests_libgnu_libobjdeps]) ]) AC_REQUIRE([gl_CC_GNULIB_WARNINGS]) LIBGNU_LIBDEPS="$gl_libdeps" diff --git a/src/alloc.c b/src/alloc.c index 7bad029b858..7e74fd53335 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -515,18 +515,6 @@ Lisp_Object const *staticvec[NSTATICS]; int staticidx; -/* Return PTR rounded up to the next multiple of ALIGNMENT. */ - -#ifndef HAVE_MPS -#ifndef HAVE_ALIGNED_ALLOC -static void * -pointer_align (void *ptr, int alignment) -{ - return (void *) ROUNDUP ((uintptr_t) ptr, alignment); -} -#endif -#endif - /* Extract the pointer hidden within O. */ static ATTRIBUTE_NO_SANITIZE_UNDEFINED void * @@ -636,23 +624,28 @@ buffer_memory_full (ptrdiff_t nbytes) #define COMMON_MULTIPLE(a, b) \ ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b)) -/* Alignment needed for memory blocks that are allocated via malloc - and that contain Lisp objects. */ +/* Alignment needed for memory blocks managed by the garbage collector. */ enum { LISP_ALIGNMENT = alignof (union { union emacs_align_type x; GCALIGNED_UNION_MEMBER }) }; static_assert (LISP_ALIGNMENT % GCALIGNMENT == 0); -/* Verify Emacs's assumption that malloc (N) returns storage suitably - aligned for Lisp objects whenever N is a multiple of LISP_ALIGNMENT. - This assumption holds for current Emacs porting targets; - if the assumption fails on a new platform, this check should - cause compilation to fail and some porting work will need to be done. +/* Emacs assumes that malloc (N) returns storage suitably aligned for + any Lisp object whenever N is a multiple of LISP_ALIGNMENT. + This Emacs assumption holds for current Emacs porting targets. - In practice the assumption holds when alignof (max_align_t) is also a - multiple of LISP_ALIGNMENT. This works even for buggy platforms - like MinGW circa 2020, where alignof (max_align_t) is 16 even though - the malloc alignment is only 8, and where Emacs still works because - it never does anything that requires an alignment of 16. */ + On all current Emacs porting targets, it also happens that + alignof (max_align_t) is a multiple of LISP_ALIGNMENT. + Check this with a static_assert. If the static_assert fails on an + unusual platform, Emacs may well not work, so inspect this module's + source code carefully with the unusual platform's quirks in mind. + + In practice the static_assert works even for buggy platforms where + malloc can yield an unaligned address if given a large but unaligned + size; Emacs avoids the bug because it aligns the size before calling + malloc. The static_assert also works for MinGW circa 2020, where + alignof (max_align_t) is 16 even though the malloc alignment is only 8; + Emacs avoids the bug because on this platform it never does anything + that requires an alignment of 16. */ enum { MALLOC_IS_LISP_ALIGNED = alignof (max_align_t) % LISP_ALIGNMENT == 0 }; static_assert (MALLOC_IS_LISP_ALIGNED); @@ -958,6 +951,19 @@ void *lisp_malloc_loser EXTERNALLY_VISIBLE; #endif #ifndef HAVE_MPS +/* Allocate memory for Lisp data. + NBYTES is the number of bytes to allocate; + it must be a multiple of LISP_ALIGNMENT. + If CLEARIT, arrange for the allocated memory to be cleared + by using calloc, which can be faster than malloc+memset. + TYPE describes the intended use of the allocated memory block + (for strings, for conses, ...). + Return a null pointer if and only if allocation failed. + + Code allocating heap memory for Lisp should use this function to get + a pointer P; that way, if T is an enum Lisp_Type value and + L == make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T. */ + static void * lisp_malloc (size_t nbytes, bool clearit, enum mem_type type) { @@ -1137,6 +1143,16 @@ struct ablocks /* The list of free ablock. */ static struct ablock *free_ablock; +#if !USE_ALIGNED_ALLOC + +static void * +pointer_align (void *ptr, int alignment) +{ + return (void *) ROUNDUP ((uintptr_t) ptr, alignment); +} + +#endif /* !USE_ALIGNED_ALLOC */ + /* Allocate an aligned block of nbytes. Alignment is on a multiple of BLOCK_ALIGN and `nbytes' has to be smaller or equal to BLOCK_BYTES. */ diff --git a/src/android.c b/src/android.c index f8d2df8fcf5..05b593f0f31 100644 --- a/src/android.c +++ b/src/android.c @@ -2530,6 +2530,11 @@ NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object, length = (*env)->GetStringLength (env, string); buffer = malloc (length * sizeof *buffer); + + /* Out of memory. */ + if (!buffer) + return 0; + characters = (*env)->GetStringChars (env, string, NULL); if (!characters) @@ -2567,6 +2572,11 @@ NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object, length = (*env)->GetStringLength (env, string); buffer = malloc (length * sizeof *buffer); + + /* Out of memory. */ + if (!buffer) + return 0; + characters = (*env)->GetStringChars (env, string, NULL); if (!characters) diff --git a/src/bidi.c b/src/bidi.c index d8754e2db73..bad67fbb8a3 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -289,7 +289,9 @@ bidi_get_type (int ch, bidi_dir_t override) if (default_type == UNKNOWN_BT) emacs_abort (); - switch (default_type) + /* Promote default_type to int to allow not enumerating all the values + without compiler warnings. */ + switch (INT_PROMOTE (default_type)) { case WEAK_BN: case NEUTRAL_B: @@ -2010,7 +2012,7 @@ bidi_resolve_explicit (struct bidi_it *bidi_it) embedding level of the _following_ characters, so we must first look at the type of the previous character to support that. */ - switch (prev_type) + switch (INT_PROMOTE (prev_type)) /* promote to int to avoid warnings */ { case RLI: /* X5a */ if (current_level < BIDI_MAXDEPTH @@ -2074,7 +2076,7 @@ bidi_resolve_explicit (struct bidi_it *bidi_it) bidi_it->type_after_wn = UNKNOWN_BT; - switch (type) + switch (INT_PROMOTE (type)) /* promote to int to avoid warnings */ { case RLE: /* X2 */ case RLO: /* X4 */ @@ -2707,7 +2709,7 @@ bidi_find_bracket_pairs (struct bidi_it *bidi_it) /* Whenever we see a strong type, update the flags of all the slots on the stack. */ - switch (bidi_it->type) + switch (INT_PROMOTE (bidi_it->type)) /* avoid warnings */ { case STRONG_L: flag = ((embedding_level & 1) == 0 @@ -2979,7 +2981,7 @@ bidi_resolve_brackets (struct bidi_it *bidi_it) if (prev_type_for_neutral == UNKNOWN_BT) prev_type_for_neutral = embedding_type; - switch (prev_type_for_neutral) + switch (INT_PROMOTE (prev_type_for_neutral)) /* avoid warnings */ { case STRONG_R: case WEAK_EN: @@ -3175,7 +3177,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it) } else { - switch (type) + switch (INT_PROMOTE (type)) /* promotion to int avoids warnings */ { case STRONG_L: case STRONG_R: diff --git a/src/ccl.c b/src/ccl.c index 78845ebaf65..a45fe0439c4 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -2379,19 +2379,6 @@ syms_of_ccl (void) doc: /* Vector of code conversion maps. */); Vcode_conversion_map_vector = make_nil_vector (16); - DEFVAR_LISP ("font-ccl-encoder-alist", Vfont_ccl_encoder_alist, - doc: /* Alist of fontname patterns vs corresponding CCL program. -Each element looks like (REGEXP . CCL-CODE), - where CCL-CODE is a compiled CCL program. -When a font whose name matches REGEXP is used for displaying a character, - CCL-CODE is executed to calculate the code point in the font - from the charset number and position code(s) of the character which are set - in CCL registers R0, R1, and R2 before the execution. -The code point in the font is set in CCL registers R1 and R2 - when the execution terminated. - If the font is single-byte font, the register R2 is not used. */); - Vfont_ccl_encoder_alist = Qnil; - DEFVAR_LISP ("translation-hash-table-vector", Vtranslation_hash_table_vector, doc: /* Vector containing all translation hash tables ever defined. Comprises pairs (SYMBOL . TABLE) where SYMBOL and TABLE were set up by calls diff --git a/src/dispnew.c b/src/dispnew.c index 4b1a8b2e1f2..c4e77ce85fc 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3267,7 +3267,7 @@ DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "", Lisp_Object tail, frame; FOR_EACH_FRAME (tail, frame) - if (FRAME_REDISPLAY_P (XFRAME (frame))) + if (frame_redisplay_p (XFRAME (frame))) redraw_frame (XFRAME (frame)); return Qnil; @@ -3936,10 +3936,12 @@ frame_selected_window_frame (struct frame *f) static bool is_cursor_obscured (struct frame *root) { - /* Determine in which frame on ROOT the cursor could be. */ - struct frame *sf = frame_selected_window_frame (root); - if (sf == NULL) - return false; + /* Which frame contains the cursor? If the selected frame is in + root's z-order, it's the selected frame. Otherwise fall back to + the root itself. */ + struct frame *sf = (frame_ancestor_p (root, SELECTED_FRAME ()) + ? SELECTED_FRAME () + : root); /* Give up if we can't tell where the cursor currently is. */ int x, y; @@ -4622,9 +4624,6 @@ gui_update_window_end (struct window *w, bool cursor_on_p, w->output_cursor.hpos, w->output_cursor.vpos, w->output_cursor.x, w->output_cursor.y); - if (cursor_in_mouse_face_p (w) && cursor_on_p) - mouse_face_overwritten_p = 1; - if (draw_window_fringes (w, true)) { if (WINDOW_RIGHT_DIVIDER_WIDTH (w)) diff --git a/src/editfns.c b/src/editfns.c index 0b134ea7aea..46e57360e60 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3444,9 +3444,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } *info; CHECK_STRING (args[0]); - char *format_start = SSDATA (args[0]); bool multibyte_format = STRING_MULTIBYTE (args[0]); ptrdiff_t formatlen = SBYTES (args[0]); + char *format_start = SAFE_ALLOCA (formatlen + 1); + memcpy (format_start, SSDATA (args[0]), formatlen + 1); bool fmt_props = !!string_intervals (args[0]); /* Upper bound on number of format specs. Each uses at least 2 chars. */ diff --git a/src/eval.c b/src/eval.c index 5609b432a35..8a8a40ac1e4 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1501,7 +1501,7 @@ Lisp_Object internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, Lisp_Object handlers) { - struct handler *volatile oldhandlerlist = handlerlist; + struct handler *oldhandlerlist = handlerlist; /* The number of non-success handlers, plus 1 for a sentinel. */ ptrdiff_t clausenb = 1; @@ -1566,12 +1566,11 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, if (!CONSP (condition)) condition = list1 (condition); struct handler *c = push_handler (condition, CONDITION_CASE); - Lisp_Object volatile *clauses_volatile = clauses; if (sys_setjmp (c->jmp)) { var = var_volatile; val = handlerlist->val; - Lisp_Object volatile *chosen_clause = clauses_volatile; + Lisp_Object volatile *chosen_clause = clauses; struct handler *oldh = oldhandlerlist; for (struct handler *h = handlerlist->next; h != oldh; h = h->next) chosen_clause++; diff --git a/src/fileio.c b/src/fileio.c index e511b90d681..12a4f1bec14 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -846,6 +846,10 @@ 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. +In most cases, one or more calls to `expand-file-name' are better +suited for the job than this function. Use this function only if +some of the special expansions done by `expand-file-name' get in +the way of what your program needs to do. usage: (file-name-concat DIRECTORY &rest COMPONENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { @@ -2049,7 +2053,9 @@ the value of this function. If `/~' appears, all of FILENAME through that `/' is discarded. If `//' appears, everything up to and including the first of -those `/' is discarded. */) +those `/' is discarded. More generally, if a variable substitution +produces an absolute file name, everything before that file name +is discarded. */) (Lisp_Object filename) { char *nm, *p, *x, *endp; diff --git a/src/fns.c b/src/fns.c index 62835b03a2b..2143a780fd4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3440,7 +3440,8 @@ characters; nil stands for the empty string. FUNCTION must be a function of one argument, and must return a value that is a sequence of characters: either a string, or a vector or - list of numbers that are valid character codepoints. */) + list of numbers that are valid character codepoints; nil is treated + as an empty string. */) (Lisp_Object function, Lisp_Object sequence, Lisp_Object separator) { USE_SAFE_ALLOCA; diff --git a/src/frame.c b/src/frame.c index 22da6a655aa..ec12f891099 100644 --- a/src/frame.c +++ b/src/frame.c @@ -339,6 +339,51 @@ predicates which report frame's specific UI-related capabilities. */) return type; } +/** Return true if F can be redisplayed, that is if F is visible and, if + F is a tty frame, all its ancestors are visible too. */ +bool +frame_redisplay_p (struct frame *f) +{ + if (is_tty_frame (f)) + { + struct frame *p = FRAME_PARENT_FRAME (f); + struct frame *q = NULL; + + while (p) + { + if (!p->visible) + /* A tty child frame cannot be redisplayed if one of its + ancestors is invisible. */ + return false; + else + { + q = p; + p = FRAME_PARENT_FRAME (p); + } + } + + struct tty_display_info *tty = FRAME_TTY (f); + struct frame *r = XFRAME (tty->top_frame); + + /* A tty child frame can be redisplayed iff its root is the top + frame of its terminal. Any other tty frame can be redisplayed + iff it is the top frame of its terminal itself which must be + always visible. */ + return (q ? q == r : f == r); + } + else +#ifndef HAVE_X_WINDOWS + return FRAME_VISIBLE_P (f); +#else + /* Under X, frames can continue to be displayed to the user by the + compositing manager even if they are invisible, so this also + checks whether or not the frame is reported visible by the X + server. */ + return (FRAME_VISIBLE_P (f) + || (FRAME_X_P (f) && FRAME_X_VISIBLE (f))); +#endif +} + /* Placeholder used by temacs -nw before window.el is loaded. */ DEFUN ("frame-windows-min-size", Fframe_windows_min_size, Sframe_windows_min_size, 4, 4, 0, @@ -1408,18 +1453,6 @@ make_terminal_frame (struct terminal *terminal, Lisp_Object parent, FRAME_TEXT_HEIGHT (f) = FRAME_TEXT_HEIGHT (f) - FRAME_MENU_BAR_HEIGHT (f) - FRAME_TAB_BAR_HEIGHT (f); - /* Mark current topmost frame obscured if we make a new root frame. - Child frames don't completely obscure other frames. */ - if (NILP (parent) && FRAMEP (FRAME_TTY (f)->top_frame)) - { - struct frame *top = XFRAME (FRAME_TTY (f)->top_frame); - struct frame *root = root_frame (top); - if (FRAME_LIVE_P (root)) - SET_FRAME_VISIBLE (root, false); - } - - /* Set the top frame to the newly created frame. */ - FRAME_TTY (f)->top_frame = frame; return f; } @@ -1773,28 +1806,27 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor struct tty_display_info *tty = FRAME_TTY (f); Lisp_Object top_frame = tty->top_frame; - /* Switching to a frame on a different root frame is special. The - old root frame has to be marked invisible, and the new root - frame has to be made visible. */ - if (!EQ (frame, top_frame) - && (!FRAMEP (top_frame) - || root_frame (f) != root_frame (XFRAME (top_frame)))) + /* When FRAME's root frame is not its terminal's top frame, make + that root frame the new top frame of FRAME's terminal. */ + if (root_frame (f) != XFRAME (top_frame)) { - struct frame *new_root = root_frame (f); - SET_FRAME_VISIBLE (new_root, true); - SET_FRAME_VISIBLE (f, true); + struct frame *p = FRAME_PARENT_FRAME (f); - /* Mark previously displayed root frame as no longer - visible. */ - if (FRAMEP (top_frame)) + XSETFRAME (top_frame, root_frame (f)); + tty->top_frame = top_frame; + + while (p) { - struct frame *top = XFRAME (top_frame); - struct frame *old_root = root_frame (top); - if (old_root != new_root) - SET_FRAME_VISIBLE (old_root, false); + /* If FRAME is a child frame, make its ancsetors visible + and garbage them ... */ + SET_FRAME_VISIBLE (p, true); + SET_FRAME_GARBAGED (p); + p = FRAME_PARENT_FRAME (p); } - tty->top_frame = frame; + /* ... and FRAME itself too. */ + SET_FRAME_VISIBLE (f, true); + SET_FRAME_GARBAGED (f); /* FIXME: Why is it correct to set FrameCols/Rows here? */ if (!FRAME_PARENT_FRAME (f)) @@ -1809,10 +1841,8 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor } } else - { - SET_FRAME_VISIBLE (f, true); - tty->top_frame = frame; - } + /* Should be covered by the condition above. */ + SET_FRAME_VISIBLE (f, true); } sf->select_mini_window_flag = MINI_WINDOW_P (XWINDOW (sf->selected_window)); @@ -2230,8 +2260,8 @@ DEFUN ("last-nonminibuffer-frame", Flast_nonminibuf_frame, * other_frames: * * Return true if there exists at least one visible or iconified frame - * but F. Tooltip frames do not qualify as candidates. Return false - * if no such frame exists. + * but F. Tooltip and child frames do not qualify as candidates. + * Return false if no such frame exists. * * INVISIBLE true means we are called from make_frame_invisible where * such a frame must be visible or iconified. INVISIBLE nil means we @@ -2323,7 +2353,6 @@ other_frames (struct frame *f, bool invisible, bool force) /* For invisibility and normal deletions, at least one visible or iconified frame must remain (Bug#26682). */ && (FRAME_VISIBLE_P (f1) - || is_tty_frame (f1) || FRAME_ICONIFIED_P (f1) || (!invisible && (force @@ -2482,7 +2511,6 @@ delete_frame (Lisp_Object frame, Lisp_Object force) else { Lisp_Object tail; - Lisp_Object frame1 UNINIT; /* This line works around GCC bug 85563. */ eassume (CONSP (Vframe_list)); /* Look for another visible frame on the same terminal. @@ -3236,11 +3264,18 @@ displayed in the terminal. */) if (FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->frame_visible_invisible_hook) FRAME_TERMINAL (f)->frame_visible_invisible_hook (f, false); - /* The ELisp manual says that this "usually" makes child frames - invisible, too, but without saying when not. Since users can't - rely on this, it's not implemented. */ - if (is_tty_frame (f)) - SET_FRAME_VISIBLE (f, false); + if (is_tty_frame (f) && EQ (frame, selected_frame)) + /* On a tty if FRAME is the selected frame, we have to select another + frame instead. If FRAME is a child frame, use the first visible + ancestor as returned by 'mru_rooted_frame'. If FRAME is a root + frame, use the frame returned by 'next-frame' which must exist since + otherwise other_frames above would have lied. */ + Fselect_frame (FRAME_PARENT_FRAME (f) + ? mru_rooted_frame (f) + : next_frame (frame, make_fixnum (0)), + Qnil); + + SET_FRAME_VISIBLE (f, false); /* Make menu bar update for the Buffers and Frames menus. */ windows_or_buffers_changed = 16; diff --git a/src/frame.h b/src/frame.h index 585726eef8f..b9b60557bc2 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1152,20 +1152,6 @@ default_pixels_per_inch_y (void) /* True if frame F is currently visible. */ #define FRAME_VISIBLE_P(f) (f)->visible -/* True if frame F should be redisplayed. This is normally the same - as FRAME_VISIBLE_P (f). Under X, frames can continue to be - displayed to the user by the compositing manager even if they are - invisible, so this also checks whether or not the frame is reported - visible by the X server. */ - -#ifndef HAVE_X_WINDOWS -#define FRAME_REDISPLAY_P(f) FRAME_VISIBLE_P (f) -#else -#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f) \ - || (FRAME_X_P (f) \ - && FRAME_X_VISIBLE (f))) -#endif - /* True if frame F is currently iconified. */ #define FRAME_ICONIFIED_P(f) (f)->iconified @@ -1473,6 +1459,7 @@ extern struct frame *decode_live_frame (Lisp_Object); extern struct frame *decode_any_frame (Lisp_Object); extern struct frame *make_initial_frame (void); extern struct frame *make_frame (bool); +extern bool frame_redisplay_p (struct frame *); extern int tty_child_pos_param (struct frame *, Lisp_Object, Lisp_Object, int); extern int tty_child_size_param (struct frame *, Lisp_Object, diff --git a/src/haiku_support.cc b/src/haiku_support.cc index d83b5c145d6..bfa2cb51456 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2862,8 +2862,13 @@ class EmacsFontSelectionDialog : public BWindow BScrollView font_family_scroller; BScrollView font_style_scroller; TripleLayoutView style_view; +#ifdef BOBJECTLIST_OWNERSHIP_IS_TEMPLATE_PARAMETER + BObjectList all_families; + BObjectList all_styles; +#else /* !BOBJECTLIST_OWNERSHIP_IS_TEMPLATE_PARAMETER */ BObjectList all_families; BObjectList all_styles; +#endif /* !BOBJECTLIST_OWNERSHIP_IS_TEMPLATE_PARAMETER */ BButton cancel_button, ok_button; BTextControl size_entry; port_id comm_port; @@ -3126,8 +3131,13 @@ public: B_SUPPORTS_LAYOUT, false, true), style_view (&font_style_scroller, &antialias_checkbox, &preview_checkbox), +#ifdef BOBJECTLIST_OWNERSHIP_IS_TEMPLATE_PARAMETER + all_families (20), + all_styles (20), +#else /* !BOBJECTLIST_OWNERSHIP_IS_TEMPLATE_PARAMETER */ all_families (20, true), all_styles (20, true), +#endif /* !BOBJECTLIST_OWNERSHIP_IS_TEMPLATE_PARAMETER */ cancel_button ("Cancel", "Cancel", new BMessage (B_CANCEL)), ok_button ("OK", "OK", new BMessage (B_OK)), diff --git a/src/keyboard.c b/src/keyboard.c index 2f7f2c415c2..c43702787b0 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4284,6 +4284,7 @@ kbd_buffer_get_event (KBOARD **kbp, case CONFIG_CHANGED_EVENT: case FOCUS_OUT_EVENT: case SELECT_WINDOW_EVENT: + case SLEEP_EVENT: { obj = make_lispy_event (&event->ie); kbd_fetch_ptr = next_kbd_event (event); @@ -7125,6 +7126,9 @@ make_lispy_event (struct input_event *event) #endif #endif /* USE_FILE_NOTIFY */ + case SLEEP_EVENT: + return Fcons (Qsleep_event, event->arg); + case CONFIG_CHANGED_EVENT: return list3 (Qconfig_changed_event, event->arg, event->frame_or_window); @@ -8144,8 +8148,15 @@ tty_read_avail_input (struct terminal *terminal, buf.code = cbuf[i]; /* Set the frame corresponding to the active tty. Note that the value of selected_frame is not reliable here, redisplay tends - to temporarily change it. */ - buf.frame_or_window = tty->top_frame; + to temporarily change it. However, if the selected frame is a + child frame, don't do that since it will cause switch frame + events to switch to the root frame instead. */ + if (FRAME_PARENT_FRAME (XFRAME (selected_frame)) + && (root_frame (XFRAME (selected_frame)) + == XFRAME (tty->top_frame))) + buf.frame_or_window = selected_frame; + else + buf.frame_or_window = tty->top_frame; buf.arg = Qnil; kbd_buffer_store_event (&buf); @@ -11675,6 +11686,63 @@ If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */) ? Qt : Qnil); } +DEFUN ("insert-special-event", Finsert_special_event, Sinsert_special_event, + 1, 1, 0, + doc: /* Insert the special EVENT into the input event queue. +Only 'input_event' slots KIND and ARG are set. */) + (Lisp_Object event) +{ + /* Check, that it is a special event. */ + CHECK_CONS (event); + if (NILP (access_keymap + (get_keymap (Vspecial_event_map, 0, 1), event, 0, 0, 1))) + signal_error ("Invalid event kind", XCAR (event)); + + /* Construct an input event. */ + struct input_event ie; + EVENT_INIT (ie); + ie.kind = + (EQ (XCAR (event), Qdelete_frame) ? DELETE_WINDOW_EVENT +#ifdef HAVE_NTGUI + : EQ (XCAR (event), Qend_session) ? END_SESSION_EVENT +#endif +#ifdef HAVE_NS + : EQ (XCAR (event), Qns_put_working_text) ? KEY_NS_PUT_WORKING_TEXT +#endif +#ifdef HAVE_NS + : EQ (XCAR (event), Qns_unput_working_text) ? KEY_NS_UNPUT_WORKING_TEXT +#endif + : EQ (XCAR (event), Qiconify_frame) ? ICONIFY_EVENT + : EQ (XCAR (event), Qmake_frame_visible) ? DEICONIFY_EVENT + /* : EQ (XCAR (event), Qselect_window) ? SELECT_WINDOW_EVENT */ + : EQ (XCAR (event), Qsave_session) ? SAVE_SESSION_EVENT +#ifdef HAVE_DBUS + : EQ (XCAR (event), Qdbus_event) ? DBUS_EVENT +#endif +#ifdef THREADS_ENABLED + : EQ (XCAR (event), Qthread_event) ? THREAD_EVENT +#endif +#ifdef USE_FILE_NOTIFY + : EQ (XCAR (event), Qfile_notify) ? FILE_NOTIFY_EVENT +#endif /* USE_FILE_NOTIFY */ + : EQ (XCAR (event), Qconfig_changed_event) ? CONFIG_CHANGED_EVENT +#if defined (WINDOWSNT) + : EQ (XCAR (event), Qlanguage_change) ? LANGUAGE_CHANGE_EVENT +#endif + : EQ (XCAR (event), Qfocus_in) ? FOCUS_IN_EVENT + : EQ (XCAR (event), Qfocus_out) ? FOCUS_OUT_EVENT + : EQ (XCAR (event), Qmove_frame) ? MOVE_FRAME_EVENT + : EQ (XCAR (event), Qsleep_event) ? SLEEP_EVENT + : NO_EVENT); + ie.frame_or_window = Qnil; + ie.arg = CDR (event); + + /* Store it into the input event queue. */ + kbd_buffer_store_event (&ie); + + return (Qnil); +} + /* Reallocate recent_keys copying the recorded keystrokes in the right order. */ static void @@ -12878,6 +12946,7 @@ init_while_no_input_ignore_events (void) #ifdef THREADS_ENABLED events = Fcons (Qthread_event, events); #endif + events = Fcons (Qsleep_event, events); return events; } @@ -12901,6 +12970,7 @@ is_ignored_event (union buffered_input_event *event) #ifdef HAVE_DBUS case DBUS_EVENT: ignore_event = Qdbus_event; break; #endif + case SLEEP_EVENT: ignore_event = Qsleep_event; break; default: ignore_event = Qnil; break; } @@ -13058,6 +13128,7 @@ syms_of_keyboard (void) #endif /* USE_FILE_NOTIFY */ DEFSYM (Qtouch_end, "touch-end"); + DEFSYM (Qsleep_event, "sleep-event"); /* Menu and tool bar item parts. */ DEFSYM (QCenable, ":enable"); @@ -13271,6 +13342,7 @@ syms_of_keyboard (void) defsubr (&Srecursive_edit); defsubr (&Sinternal_track_mouse); defsubr (&Sinput_pending_p); + defsubr (&Sinsert_special_event); defsubr (&Slossage_size); defsubr (&Srecent_keys); defsubr (&Sthis_command_keys); @@ -14030,7 +14102,10 @@ function is called to remap that sequence. */); pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper); DEFSYM (Qactivate_mark_hook, "activate-mark-hook"); +#ifdef HAVE_NS + DEFSYM (Qns_put_working_text, "ns-put-working-text"); DEFSYM (Qns_unput_working_text, "ns-unput-working-text"); +#endif DEFSYM (Qinternal_timer_start_idle, "internal-timer-start-idle"); DEFSYM (Qconcat, "concat"); DEFSYM (Qsuspend_hook, "suspend-hook"); @@ -14079,10 +14154,12 @@ keys_of_keyboard (void) initial_define_lispy_key (Vspecial_event_map, "end-session", "kill-emacs"); #endif +#ifdef HAVE_NS initial_define_lispy_key (Vspecial_event_map, "ns-put-working-text", "ns-put-working-text"); initial_define_lispy_key (Vspecial_event_map, "ns-unput-working-text", "ns-unput-working-text"); +#endif /* Here we used to use `ignore-event' which would simple set prefix-arg to current-prefix-arg, as is done in `handle-switch-frame'. But `handle-switch-frame is not run from the special-map. @@ -14147,6 +14224,8 @@ keys_of_keyboard (void) "handle-focus-out"); initial_define_lispy_key (Vspecial_event_map, "move-frame", "handle-move-frame"); + initial_define_lispy_key (Vspecial_event_map, "sleep-event", + "ignore"); } #ifndef HAVE_MPS diff --git a/src/keymap.c b/src/keymap.c index 5691b34c40d..bc731c54ef0 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2866,7 +2866,7 @@ You type Translation\n\ if (alternate_heading) { insert_string (alternate_heading); - alternate_heading = 0; + alternate_heading = NULL; } bufend = push_key_description (translate[c], buf); @@ -2893,9 +2893,7 @@ You type Translation\n\ } /* Print the (major mode) local map. */ - Lisp_Object start1 = Qnil; - if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) - start1 = KVAR (current_kboard, Voverriding_terminal_local_map); + Lisp_Object start1 = KVAR (current_kboard, Voverriding_terminal_local_map); if (!NILP (start1)) { diff --git a/src/lisp.h b/src/lisp.h index 9dad41f4f8f..58b7f440872 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -287,7 +287,7 @@ DEFINE_GDB_SYMBOL_END (VALMASK) # define alignas(a) #endif -/* Minimum alignment requirement for Lisp objects, imposed by the +/* The minimum alignment requirement for Lisp objects that is imposed by the internal representation of tagged pointers. It is 2**GCTYPEBITS if USE_LSB_TAG, 1 otherwise. It must be a literal integer constant, for older versions of GCC (through at least 4.9). */ diff --git a/src/lread.c b/src/lread.c index e8cd689d794..96a91ac53b3 100644 --- a/src/lread.c +++ b/src/lread.c @@ -399,7 +399,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte) tem = call0 (readcharfun); - if (NILP (tem)) + if (!FIXNUMP (tem)) return -1; return XFIXNUM (tem); @@ -817,7 +817,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, tem1 = Fget (Fcar (tem), Qascii_character); /* Merge this symbol's modifier bits with the ASCII equivalent of its basic code. */ - if (!NILP (tem1)) + if (FIXNUMP (tem1) && FIXNUMP (Fcar (Fcdr (tem)))) XSETFASTINT (val, XFIXNUM (tem1) | XFIXNUM (Fcar (Fcdr (tem)))); } } @@ -899,7 +899,7 @@ If `inhibit-interaction' is non-nil, this function will signal an } val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds); - return (NILP (val) ? Qnil + return (!FIXNUMP (val) ? Qnil : make_fixnum (char_resolve_modifier_mask (XFIXNUM (val)))); } @@ -977,7 +977,7 @@ If `inhibit-interaction' is non-nil, this function will signal an val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds); - return (NILP (val) ? Qnil + return (!FIXNUMP (val) ? Qnil : make_fixnum (char_resolve_modifier_mask (XFIXNUM (val)))); } @@ -2821,7 +2821,7 @@ character_name_to_code (char const *name, ptrdiff_t name_len, invalid_syntax_lisp (CALLN (Fformat, format, namestr), readcharfun); } - return XFIXNUM (code); + return FIXNUMP (code) ? XFIXNUM (code) : -1; } /* Bound on the length of a Unicode character name. As of @@ -3060,6 +3060,8 @@ read_char_escape (Lisp_Object readcharfun, int next_char) break; } eassert (chr >= 0 && chr < (1 << CHARACTERBITS)); + if (chr < 0 || chr >= (1 << CHARACTERBITS)) + invalid_syntax ("Invalid character", readcharfun); /* Apply Control modifiers, using the rules: \C-X = ascii_ctrl(nomod(X)) | mods(X) if nomod(X) is one of: diff --git a/src/pdumper.c b/src/pdumper.c index f15af499026..b96a2f2edcd 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2784,7 +2784,7 @@ dump_hash_table_value (struct dump_context *ctx, struct Lisp_Hash_Table *h) static dump_off dump_hash_table (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_DC3E781B68 +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_2A3C3E2B62 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); diff --git a/src/process.c b/src/process.c index 9f02b668ccf..eb13b6a5363 100644 --- a/src/process.c +++ b/src/process.c @@ -8891,7 +8891,7 @@ allow them to produce more output before Emacs tries to read it. If the value is t, the delay is reset after each write to the process; any other non-nil value means that the delay is not reset on write. The variable takes effect when `start-process' is called. */); - Vprocess_adaptive_read_buffering = Qt; + Vprocess_adaptive_read_buffering = Qnil; DEFVAR_BOOL ("process-prioritize-lower-fds", process_prioritize_lower_fds, doc: /* Whether to start checking for subprocess output from first file descriptor. diff --git a/src/term.c b/src/term.c index b40be389e4c..2038f5de651 100644 --- a/src/term.c +++ b/src/term.c @@ -2560,36 +2560,89 @@ A value of zero means TTY uses the system's default value. */) #if !defined DOS_NT && !defined HAVE_ANDROID /* Implementation of draw_row_with_mouse_face for TTY/GPM and macOS. */ + void -tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, - int start_hpos, int end_hpos, +tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *window_row, + int window_start_x, + int window_end_x, enum draw_glyphs_face draw) { - int nglyphs = end_hpos - start_hpos; - struct frame *f = XFRAME (WINDOW_FRAME (w)); - struct tty_display_info *tty = FRAME_TTY (f); - int face_id = tty->mouse_highlight.mouse_face_face_id; + struct frame *f = XFRAME (w->frame); + struct frame *root = root_frame (f); - if (end_hpos >= row->used[TEXT_AREA]) - nglyphs = row->used[TEXT_AREA] - start_hpos; + /* Window coordinates are relative to the text area. Make + them relative to the window's left edge, */ + window_end_x = min (window_end_x, window_row->used[TEXT_AREA]); + window_start_x += window_row->used[LEFT_MARGIN_AREA]; + window_end_x += window_row->used[LEFT_MARGIN_AREA]; - int pos_y = row->y + WINDOW_TOP_EDGE_Y (w); - int pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w); + /* Translate from window to window's frame. */ + int frame_start_x = WINDOW_LEFT_EDGE_X (w) + window_start_x; + int frame_end_x = WINDOW_LEFT_EDGE_X (w) + window_end_x; + int frame_y = window_row->y + WINDOW_TOP_EDGE_Y (w); - /* Save current cursor coordinates. */ - int save_y = curY (tty); + /* Translate from (possible) child frame to root frame. */ + int root_start_x, root_end_x, root_y; + root_xy (f, frame_start_x, frame_y, &root_start_x, &root_y); + root_xy (f, frame_end_x, frame_y, &root_end_x, &root_y); + struct glyph_row *root_row = MATRIX_ROW (root->current_matrix, root_y); + + /* Remember current cursor coordinates so that we can restore + them at the end. */ + struct tty_display_info *tty = FRAME_TTY (root); int save_x = curX (tty); - cursor_to (f, pos_y, pos_x); + int save_y = curY (tty); - if (draw == DRAW_MOUSE_FACE) + /* If the root frame displays child frames, we cannot naively + write to the terminal what the window thinks should be drawn. + Instead, write only those parts that are not obscured by + other frames. */ + for (int root_x = root_start_x; root_x < root_end_x; ) { - struct glyph *glyph = row->glyphs[TEXT_AREA] + start_hpos; - struct face *face = FACE_FROM_ID (f, face_id); - tty_write_glyphs_with_face (f, glyph, nglyphs, face); - } - else if (draw == DRAW_NORMAL_TEXT) - write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs); + /* Find the start of a run of glyphs from frame F. */ + struct glyph *root_start = root_row->glyphs[TEXT_AREA] + root_x; + while (root_x < root_end_x && root_start->frame != f) + ++root_x, ++root_start; + /* If start of a run of glyphs from F found. */ + int root_run_start_x = root_x; + if (root_run_start_x < root_end_x) + { + /* Find the end of the run of glyphs from frame F. */ + struct glyph *root_end = root_start; + while (root_x < root_end_x && root_end->frame == f) + ++root_x, ++root_end; + + /* If we have a run glyphs to output, do it. */ + if (root_end > root_start) + { + cursor_to (root, root_y, root_run_start_x); + ptrdiff_t n = root_end - root_start; + switch (draw) + { + case DRAW_NORMAL_TEXT: + write_glyphs (f, root_start, n); + break; + + case DRAW_MOUSE_FACE: + { + int face_id = tty->mouse_highlight.mouse_face_face_id; + struct face *face = FACE_FROM_ID (f, face_id); + tty_write_glyphs_with_face (f, root_start, n, face); + } + break; + + case DRAW_INVERSE_VIDEO: + case DRAW_CURSOR: + case DRAW_IMAGE_RAISED: + case DRAW_IMAGE_SUNKEN: + emacs_abort (); + } + } + } + } + + /* Restore cursor where it was before. */ cursor_to (f, save_y, save_x); } diff --git a/src/termhooks.h b/src/termhooks.h index 84e2597e8f6..648f1dbcfe3 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -291,6 +291,9 @@ enum event_kind , FILE_NOTIFY_EVENT #endif + /* Sleep/wake event. */ + , SLEEP_EVENT + /* Pre-edit text was changed. */ , PREEDIT_TEXT_EVENT diff --git a/src/w32console.c b/src/w32console.c index 9cfedde3b3f..b18eda437ad 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -167,7 +167,7 @@ w32con_clear_end_of_line (struct frame *f, int end) for (i = 0; i < glyphs_len; i++) { memcpy (&glyphs[i], &space_glyph, sizeof (struct glyph)); - glyphs[i].frame = f; + glyphs[i].frame = NULL; } ceol_initialized = TRUE; } @@ -339,8 +339,10 @@ w32con_write_glyphs (struct frame *f, register struct glyph *string, && string[n].frame == face_id_frame)) break; + /* w32con_clear_end_of_line sets frame of glyphs to NULL. */ + struct frame *attr_frame = face_id_frame ? face_id_frame : f; /* Turn appearance modes of the face of the run on. */ - char_attr = w32_face_attributes (face_id_frame, face_id); + char_attr = w32_face_attributes (attr_frame, face_id); if (n == len) /* This is the last run. */ @@ -425,34 +427,88 @@ w32con_write_glyphs_with_face (struct frame *f, register int x, register int y, /* Implementation of draw_row_with_mouse_face for W32 console. */ void -tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, - int start_hpos, int end_hpos, +tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *window_row, + int window_start_x, int window_end_x, enum draw_glyphs_face draw) { - int nglyphs = end_hpos - start_hpos; struct frame *f = XFRAME (WINDOW_FRAME (w)); - struct tty_display_info *tty = FRAME_TTY (f); - int face_id = tty->mouse_highlight.mouse_face_face_id; - int pos_x, pos_y; + struct frame *root = root_frame (f); - if (end_hpos >= row->used[TEXT_AREA]) - nglyphs = row->used[TEXT_AREA] - start_hpos; + /* Window coordinates are relative to the text area. Make + them relative to the window's left edge, */ + window_end_x = min (window_end_x, window_row->used[TEXT_AREA]); + window_start_x += window_row->used[LEFT_MARGIN_AREA]; + window_end_x += window_row->used[LEFT_MARGIN_AREA]; - pos_y = row->y + WINDOW_TOP_EDGE_Y (w); - pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w); + /* Translate from window to window's frame. */ + int frame_start_x = WINDOW_LEFT_EDGE_X (w) + window_start_x; + int frame_end_x = WINDOW_LEFT_EDGE_X (w) + window_end_x; + int frame_y = window_row->y + WINDOW_TOP_EDGE_Y (w); - if (draw == DRAW_MOUSE_FACE) - w32con_write_glyphs_with_face (f, pos_x, pos_y, - row->glyphs[TEXT_AREA] + start_hpos, - nglyphs, face_id); - else if (draw == DRAW_NORMAL_TEXT) + /* Translate from (possible) child frame to root frame. */ + int root_start_x, root_end_x, root_y; + root_xy (f, frame_start_x, frame_y, &root_start_x, &root_y); + root_xy (f, frame_end_x, frame_y, &root_end_x, &root_y); + struct glyph_row *root_row = MATRIX_ROW (root->current_matrix, root_y); + + /* Remember current cursor coordinates so that we can restore + them at the end. */ + COORD save_coords = cursor_coords; + + /* If the root frame displays child frames, we cannot naively + write to the terminal what the window thinks should be drawn. + Instead, write only those parts that are not obscured by + other frames. */ + for (int root_x = root_start_x; root_x < root_end_x; ) { - COORD save_coords = cursor_coords; + /* Find the start of a run of glyphs from frame F. */ + struct glyph *root_start = root_row->glyphs[TEXT_AREA] + root_x; + while (root_x < root_end_x && root_start->frame != f) + ++root_x, ++root_start; - w32con_move_cursor (f, pos_y, pos_x); - write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs); - w32con_move_cursor (f, save_coords.Y, save_coords.X); + /* If start of a run of glyphs from F found. */ + int root_run_start_x = root_x; + if (root_run_start_x < root_end_x) + { + /* Find the end of the run of glyphs from frame F. */ + struct glyph *root_end = root_start; + while (root_x < root_end_x && root_end->frame == f) + ++root_x, ++root_end; + + /* If we have a run glyphs to output, do it. */ + if (root_end > root_start) + { + w32con_move_cursor (root, root_y, root_run_start_x); + + ptrdiff_t nglyphs = root_end - root_start; + switch (draw) + { + case DRAW_NORMAL_TEXT: + write_glyphs (f, root_start, nglyphs); + break; + + case DRAW_MOUSE_FACE: + { + struct tty_display_info *tty = FRAME_TTY (f); + int face_id = tty->mouse_highlight.mouse_face_face_id; + w32con_write_glyphs_with_face (f, root_run_start_x, root_y, + root_start, nglyphs, + face_id); + } + break; + + case DRAW_INVERSE_VIDEO: + case DRAW_CURSOR: + case DRAW_IMAGE_RAISED: + case DRAW_IMAGE_SUNKEN: + emacs_abort (); + } + } + } } + + /* Restore cursor where it was before. */ + w32con_move_cursor (f, save_coords.Y, save_coords.X); } static void diff --git a/src/xdisp.c b/src/xdisp.c index ed90710a63b..195a5d2ff79 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1232,7 +1232,7 @@ static void get_cursor_offset_for_mouse_face (struct window *w, static void produce_special_glyphs (struct it *, enum display_element_type); static void pad_mode_line (struct it *, bool); -static void show_mouse_face (Mouse_HLInfo *, enum draw_glyphs_face); +static void show_mouse_face (Mouse_HLInfo *, enum draw_glyphs_face, bool); static bool coords_in_mouse_face_p (struct window *, int, int); static void reset_box_start_end_flags (struct it *); @@ -5649,7 +5649,7 @@ get_display_property (ptrdiff_t charpos, Lisp_Object prop, Lisp_Object object) /* Handle 'display' property '(min-width (WIDTH))' at CHARPOS in OBJECT. OBJECT can be a buffer (or nil, which means the current buffer) or a - string. MIN_WIDTH is the value of min-width spec that we expect to + string. WIDTH_SPEC is the value of min-width spec that we expect to process. */ static void display_min_width (struct it *it, ptrdiff_t charpos, @@ -5695,8 +5695,9 @@ display_min_width (struct it *it, ptrdiff_t charpos, a stretch that ends beyond the visible portion of the window if we are truncating screen lines. If we are requested to do that, some Lisp program went awry. */ - if (!(it->line_wrap == TRUNCATE - && it->current_x + width > it->last_visible_x)) + if (width > 0 + && !(it->line_wrap == TRUNCATE + && it->current_x + width > it->last_visible_x)) w = list1 (make_int (width)); } else @@ -5707,8 +5708,9 @@ display_min_width (struct it *it, ptrdiff_t charpos, NULL, true, NULL); width -= (it->current_x - it->min_width_start) / FRAME_COLUMN_WIDTH (it->f); - if (!(it->line_wrap == TRUNCATE - && it->current_x + width > it->last_visible_x)) + if (width > 0 + && !(it->line_wrap == TRUNCATE + && it->current_x + width > it->last_visible_x)) w = make_int (width); } @@ -13458,7 +13460,7 @@ clear_garbaged_frames (void) { struct frame *f = XFRAME (frame); - if (FRAME_REDISPLAY_P (f) && FRAME_GARBAGED_P (f)) + if (frame_redisplay_p (f) && FRAME_GARBAGED_P (f)) { if (f->resized_p /* It makes no sense to redraw a non-selected TTY @@ -13512,7 +13514,7 @@ echo_area_display (bool update_frame_p) /* Don't display if frame is invisible or not yet initialized or if redisplay is inhibited. */ - if (!FRAME_REDISPLAY_P (f) || !f->glyphs_initialized_p + if (!frame_redisplay_p (f) || !f->glyphs_initialized_p || !NILP (Vinhibit_redisplay)) return; @@ -14053,7 +14055,7 @@ prepare_menu_bars (void) TTY frames to be completely redrawn, when there are more than one of them, even though nothing should be changed on display. */ - || (FRAME_REDISPLAY_P (f) && FRAME_WINDOW_P (f)))) + || (frame_redisplay_p (f) && FRAME_WINDOW_P (f)))) gui_consider_frame_title (frame); } } @@ -15059,14 +15061,14 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, { /* Show the clicked button in pressed state. */ if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN); + show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN, true); f->last_tab_bar_item = prop_idx; /* record the pressed tab */ } else { /* Show item in released state. */ if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_RAISED); + show_mouse_face (hlinfo, DRAW_IMAGE_RAISED, true); f->last_tab_bar_item = -1; } @@ -15164,7 +15166,7 @@ note_tab_bar_highlight (struct frame *f, int x, int y) hlinfo->mouse_face_face_id = TAB_BAR_FACE_ID; /* Display it as active. */ - show_mouse_face (hlinfo, draw); + show_mouse_face (hlinfo, draw, true); } set_help_echo: @@ -16081,7 +16083,7 @@ handle_tool_bar_click_with_device (struct frame *f, int x, int y, bool down_p, { /* Show item in pressed state. */ if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN); + show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN, true); f->last_tool_bar_item = prop_idx; } else @@ -16092,7 +16094,7 @@ handle_tool_bar_click_with_device (struct frame *f, int x, int y, bool down_p, /* Show item in released state. */ if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_RAISED); + show_mouse_face (hlinfo, DRAW_IMAGE_RAISED, true); key = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_KEY); @@ -16188,7 +16190,7 @@ note_tool_bar_highlight (struct frame *f, int x, int y) hlinfo->mouse_face_face_id = TOOL_BAR_FACE_ID; /* Display it as active. */ - show_mouse_face (hlinfo, draw); + show_mouse_face (hlinfo, draw, true); } set_help_echo: @@ -17067,8 +17069,8 @@ redisplay_internal (void) { struct frame *f = XFRAME (frame); - /* FRAME_REDISPLAY_P true basically means the frame is visible. */ - if (FRAME_REDISPLAY_P (f)) + /* frame_redisplay_p true basically means the frame is visible. */ + if (frame_redisplay_p (f)) { ++number_of_visible_frames; /* Adjust matrices for visible frames only. */ @@ -17211,7 +17213,7 @@ redisplay_internal (void) && !w->update_mode_line && !current_buffer->clip_changed && !current_buffer->prevent_redisplay_optimizations_p - && FRAME_REDISPLAY_P (XFRAME (w->frame)) + && frame_redisplay_p (XFRAME (w->frame)) && !XFRAME (w->frame)->cursor_type_changed && !XFRAME (w->frame)->face_change /* Make sure recorded data applies to current buffer, etc. */ @@ -17472,7 +17474,7 @@ redisplay_internal (void) if (is_tty_frame (f)) { /* Ignore all invisble tty frames, children or root. */ - if (!FRAME_VISIBLE_P (root_frame (f))) + if (!frame_redisplay_p (f)) continue; /* Remember tty root frames which we've seen. */ @@ -17503,7 +17505,7 @@ redisplay_internal (void) if (gcscrollbars && FRAME_TERMINAL (f)->condemn_scroll_bars_hook) FRAME_TERMINAL (f)->condemn_scroll_bars_hook (f); - if (FRAME_REDISPLAY_P (f)) + if (frame_redisplay_p (f)) { /* Don't allow freeing images and faces for this frame as long as the frame's update wasn't @@ -17529,7 +17531,7 @@ redisplay_internal (void) if (gcscrollbars && FRAME_TERMINAL (f)->judge_scroll_bars_hook) FRAME_TERMINAL (f)->judge_scroll_bars_hook (f); - if (FRAME_REDISPLAY_P (f)) + if (frame_redisplay_p (f)) { /* If fonts changed on visible frame, display again. */ if (f->fonts_changed) @@ -17635,7 +17637,7 @@ redisplay_internal (void) } } } - else if (FRAME_REDISPLAY_P (sf)) + else if (frame_redisplay_p (sf)) { sf->inhibit_clear_image_cache = true; displayed_buffer = XBUFFER (XWINDOW (selected_window)->contents); @@ -17686,7 +17688,7 @@ redisplay_internal (void) unrequest_sigio (); STOP_POLLING; - if (FRAME_REDISPLAY_P (sf)) + if (frame_redisplay_p (sf)) { if (hscroll_retries <= MAX_HSCROLL_RETRIES && hscroll_windows (selected_window)) @@ -17768,7 +17770,7 @@ redisplay_internal (void) FOR_EACH_FRAME (tail, frame) { - if (FRAME_REDISPLAY_P (XFRAME (frame))) + if (frame_redisplay_p (XFRAME (frame))) new_count++; } @@ -25013,7 +25015,6 @@ maybe_produce_line_number (struct it *it) /* Produce the glyphs for the line number. */ struct it tem_it; - char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1]; bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE; ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */ int lnum_face_id = merge_faces (it->w, Qline_number, 0, DEFAULT_FACE_ID); @@ -25042,7 +25043,17 @@ maybe_produce_line_number (struct it *it) if (!it->lnum_width) { if (FIXNATP (Vdisplay_line_numbers_width)) - it->lnum_width = XFIXNAT (Vdisplay_line_numbers_width); + { + EMACS_INT lnum_width = XFIXNAT (Vdisplay_line_numbers_width); + /* Limit the width to show at least 1 text character. */ + int lnum_width_limit + = (it->last_visible_x - it->first_visible_x) + / FRAME_COLUMN_WIDTH (it->f) + - 5 /* leave space for a few characters */ + - 2; /* two spaces around the number */ + it->lnum_width + = clip_to_bounds (1, lnum_width, lnum_width_limit); + } /* Max line number to be displayed cannot be more than the one corresponding to the last row of the desired matrix. */ @@ -25062,6 +25073,8 @@ maybe_produce_line_number (struct it *it) it->lnum_width = max (it->lnum_width, log10 (max_lnum) + 1); eassert (it->lnum_width > 0); } + /* Extra +2 for the two blanks we add before and after the number. */ + char *lnum_buf = alloca (it->lnum_width + 2 + 1); if (EQ (Vdisplay_line_numbers, Qrelative)) lnum_offset = it->pt_lnum; else if (EQ (Vdisplay_line_numbers, Qvisual)) @@ -34207,12 +34220,13 @@ erase_phys_cursor (struct window *w) /* Since erasing the phys cursor will probably lead to corruption of the mouse face display if the glyph's pixel_width is not kept up to date with the :box property of the mouse face, just redraw the - mouse face. */ + mouse face, but leave the mouse cursor as it was. */ if (FRAME_WINDOW_P (WINDOW_XFRAME (w)) && mouse_face_here_p) { w->phys_cursor_on_p = false; w->phys_cursor_type = NO_CURSOR; - show_mouse_face (MOUSE_HL_INFO (WINDOW_XFRAME (w)), DRAW_MOUSE_FACE); + show_mouse_face (MOUSE_HL_INFO (WINDOW_XFRAME (w)), DRAW_MOUSE_FACE, + false); return; } #endif @@ -34276,7 +34290,7 @@ display_and_set_cursor (struct window *w, bool on, windows and frames; in the latter case, the frame or window may be in the midst of changing its size, and x and y may be off the window. */ - if (! FRAME_REDISPLAY_P (f) + if (! frame_redisplay_p (f) || vpos >= w->current_matrix->nrows || hpos >= w->current_matrix->matrix_w) return; @@ -34444,7 +34458,7 @@ gui_update_cursor (struct frame *f, bool on_p) void gui_clear_cursor (struct window *w) { - if (FRAME_REDISPLAY_P (XFRAME (w->frame)) && w->phys_cursor_on_p) + if (frame_redisplay_p (XFRAME (w->frame)) && w->phys_cursor_on_p) update_window_cursor (w, false); } @@ -34473,7 +34487,8 @@ draw_row_with_mouse_face (struct window *w, int start_x, struct glyph_row *row, /* Display the active region described by mouse_face_* according to DRAW. */ static void -show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) +show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw, + bool define_mouse_cursor) { /* Don't bother doing anything if the mouse-face window is not set up. */ @@ -34615,7 +34630,7 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) #ifdef HAVE_WINDOW_SYSTEM /* Change the mouse cursor. */ - if (FRAME_WINDOW_P (f) && NILP (track_mouse)) + if (FRAME_WINDOW_P (f) && NILP (track_mouse) && define_mouse_cursor) { if (draw == DRAW_NORMAL_TEXT #ifndef HAVE_EXT_TOOL_BAR @@ -34623,8 +34638,7 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) #endif && !EQ (hlinfo->mouse_face_window, f->tab_bar_window)) FRAME_RIF (f)->define_frame_cursor (f, FRAME_OUTPUT_DATA (f)->text_cursor); - else - if (draw == DRAW_MOUSE_FACE) + else if (draw == DRAW_MOUSE_FACE) FRAME_RIF (f)->define_frame_cursor (f, FRAME_OUTPUT_DATA (f)->hand_cursor); else FRAME_RIF (f)->define_frame_cursor (f, FRAME_OUTPUT_DATA (f)->nontext_cursor); @@ -34643,7 +34657,7 @@ clear_mouse_face (Mouse_HLInfo *hlinfo) bool cleared = !hlinfo->mouse_face_hidden && !NILP (hlinfo->mouse_face_window); if (cleared) - show_mouse_face (hlinfo, DRAW_NORMAL_TEXT); + show_mouse_face (hlinfo, DRAW_NORMAL_TEXT, true); hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; @@ -35210,7 +35224,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, = face_at_buffer_position (w, mouse_charpos, &ignore, mouse_charpos + 1, !hlinfo->mouse_face_hidden, -1, 0); - show_mouse_face (hlinfo, DRAW_MOUSE_FACE); + show_mouse_face (hlinfo, DRAW_MOUSE_FACE, true); } /* The following function is not used anymore (replaced with @@ -35920,7 +35934,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, face_at_string_position (w, string, charpos, 0, &ignore, glyph->face_id, true, 0); - show_mouse_face (hlinfo, DRAW_MOUSE_FACE); + show_mouse_face (hlinfo, DRAW_MOUSE_FACE, true); mouse_face_shown = true; if (NILP (pointer)) @@ -36459,7 +36473,7 @@ note_mouse_highlight (struct frame *f, int x, int y) hlinfo->mouse_face_face_id = face_at_string_position (w, object, pos, 0, &ignore, glyph->face_id, true, 0); - show_mouse_face (hlinfo, DRAW_MOUSE_FACE); + show_mouse_face (hlinfo, DRAW_MOUSE_FACE, true); cursor = No_Cursor; } else diff --git a/src/xterm.c b/src/xterm.c index 80108190590..c3137945ac5 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -27553,7 +27553,7 @@ x_calc_absolute_position (struct frame *f) /* Treat negative positions as relative to the leftmost bottommost position that fits on the screen. */ - if ((flags & XNegative) && (f->left_pos <= 0)) + if (flags & XNegative) { int width = FRAME_PIXEL_WIDTH (f); @@ -27580,7 +27580,7 @@ x_calc_absolute_position (struct frame *f) } - if ((flags & YNegative) && (f->top_pos <= 0)) + if (flags & YNegative) { int height = FRAME_PIXEL_HEIGHT (f); @@ -30632,7 +30632,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) block_input (); +#ifdef USE_GTK bool was_initialized = x_initialized; +#endif /* USE_GTK */ if (!x_initialized) { x_initialize (); diff --git a/src/xterm.h b/src/xterm.h index 6693c485202..428cca0daca 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1494,7 +1494,7 @@ extern void x_mark_frame_dirty (struct frame *f); #define FRAME_X_VISUAL_INFO(f) (&FRAME_DISPLAY_INFO (f)->visual_info) /* Whether or not the frame is visible. Do not test this alone. - Instead, use FRAME_REDISPLAY_P. */ + Instead, use frame_redisplay_p. */ #define FRAME_X_VISIBLE(f) (FRAME_X_OUTPUT (f)->visibility_state \ != VisibilityFullyObscured) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 5e46216cc42..319f3285d2d 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -687,6 +687,41 @@ This expects `auto-revert--messages' to be bound by (auto-revert--deftest-remote auto-revert-test07-auto-revert-several-buffers "Check autorevert for several buffers visiting the same remote file.") +(ert-deftest auto-revert-test08-auto-revert-inhibit-auto-revert () + "Check the power of `inhibit-auto-revert'." + ;; `auto-revert-buffers' runs every 5". And we must wait, until the + ;; file has been reverted. + (with-auto-revert-test + (ert-with-temp-file tmpfile + (let ((times '(60 30 15)) + buf) + (unwind-protect + (progn + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + (setq buf (find-file-noselect tmpfile)) + (with-current-buffer buf + (ert-with-message-capture auto-revert--messages + (inhibit-auto-revert + (auto-revert-mode 1) + (should auto-revert-mode) + + (auto-revert-tests--write-file "another text" tmpfile (pop times)) + ;; Check, that the buffer hasn't been reverted. + (auto-revert--wait-for-revert buf) + (should-not (string-match "another text" (buffer-string)))) + + ;; Check, that the buffer has been reverted. + (auto-revert--wait-for-revert buf) + (should (string-match "another text" (buffer-string)))))) + + ;; Exit. + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf))))))) + +(auto-revert--deftest-remote auto-revert-test08-auto-revert-inhibit-auto-revert + "Check the power of `inhibit-auto-revert' on a remote file.") + ;; Mark all tests as unstable on Cygwin (bug#49665). (when (eq system-type 'cygwin) (dolist (test (apropos-internal "^auto-revert" #'ert-test-boundp)) diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el index 9099f6cb169..d551d429363 100644 --- a/test/lisp/bookmark-tests.el +++ b/test/lisp/bookmark-tests.el @@ -193,9 +193,12 @@ the lexically-bound variable `buffer'." (should (equal (bookmark-prop-get bmk 'filename) "prop"))))) (ert-deftest bookmark-tests-maybe-historicize-string () - (let ((bookmark-history)) + (let ((bookmark-history) + (history-delete-duplicates t)) (bookmark-maybe-historicize-string "foo") - (should (equal (car bookmark-history) "foo")))) + (bookmark-maybe-historicize-string "foo") + (should (equal (car bookmark-history) "foo")) + (should (= 1 (length bookmark-history))))) (defun bookmark-remove-last-modified (bmk) (assoc-delete-all 'last-modified bmk)) diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index 3a69a0c7b18..b8d3381528e 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -106,24 +106,31 @@ (should-error (date-days-in-month 2020 'foo))) (ert-deftest test-format-seconds () - (should (equal (format-seconds "%y %d %h %m %s %%" 0) "0 0 0 0 0 %")) - (should (equal (format-seconds "%y %d %h %m %s %%" 9999999) "0 115 17 46 39 %")) - (should (equal (format-seconds "%y %d %h %m %z %s %%" 1) "1 %")) - (should (equal (format-seconds "%mm %ss" 66) "1m 6s")) - (should (equal (format-seconds "%mm %5ss" 66) "1m 6s")) - (should (equal (format-seconds "%mm %.5ss" 66.4) "1m 00006s")) - - (should (equal (format-seconds "%mm %,1ss" 66.4) "1m 6.4s")) - (should (equal (format-seconds "%mm %5,1ss" 66.4) "1m 6.4s")) - (should (equal (format-seconds "%mm %.5,1ss" 66.4) "1m 006.4s")) - - (should (equal (format-seconds "%hh %z%x%mm %ss" (* 60 2)) "2m")) - (should (equal (format-seconds "%hh %z%mm %ss" (* 60 2)) "2m 0s")) - (should (equal (format-seconds "%hh %x%mm %ss" (* 60 2)) "0h 2m")) - (should (equal (format-seconds "%hh %x%mm %ss" 0) "0h 0m 0s")) - ;; Bug#70322 - (should (equal (format-seconds "%y %z%d %h %m %s %%" 9999999) "115 17 46 39 %")) - (should (equal (format-seconds "%Y, %D, %H, %M, %z%S" 0) "0 seconds"))) + (let ((format-seconds-list + '(("%y %d %h %m %s %%" 0 "0 0 0 0 0 %") + ("%y %d %h %m %s %%" 0 "0 0 0 0 0 %") + ("%y %d %h %m %s %%" 9999999 "0 115 17 46 39 %") + ("%y %d %h %m %z %s %%" 1 "1 %") + ("%mm %ss" 66 "1m 6s") + ("%mm %5ss" 66 "1m 6s") + ("%mm %.5ss" 66.4 "1m 00006s") + ("%mm %,1ss" 66.4 "1m 6.4s") + ("%mm %5,1ss" 66.4 "1m 6.4s") + ("%mm %.5,1ss" 66.4 "1m 006.4s") + ("%hh %z%x%mm %ss" 120 "2m") + ("%hh %z%mm %ss" 120 "2m 0s") + ("%hh %x%mm %ss" 120 "0h 2m") + ("%hh %x%mm %ss" 0 "0h 0m 0s") + ("%y %z%d %h %m %s %%" 9999999 "115 17 46 39 %") + ("%Y, %D, %H, %M, %z%S" 0 "0 seconds")))) + (dolist (fs format-seconds-list) + (let ((string (nth 0 fs)) + (seconds (nth 1 fs)) + (expected (nth 2 fs))) + (should (equal (format-seconds string seconds) expected)) + (when (< 0 seconds) + (should (equal (format-seconds string (- seconds)) + (concat "-" expected)))))))) (ert-deftest test-ordinal () (should (equal (date-ordinal-to-time 2008 271) diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index 47c2a7bb569..eecc4f39808 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -27,6 +27,7 @@ ;;; Code: (require 'dom) +(require 'svg) (require 'ert) ;; `defsubst's are not inlined inside `ert-deftest' (see Bug#24402), @@ -219,6 +220,59 @@ child results in an error." "<div class="default"> </div>" ""))))) +(ert-deftest dom-tests-print-svg () + "Test that `dom-print' correctly print a SVG DOM." + (let ((svg (svg-create 100 100))) + (svg-rectangle svg 0 0 "100%" "100%" :fill "blue") + (svg-text svg "A text" :x 0 :y 55 :stroke "yellow" :fill "yellow") + (with-temp-buffer + (dom-print svg t t) + (should + (equal + (buffer-string) + (concat + "\n" + " \n" + " A text\n" + "")))))) + +(ert-deftest dom-tests-print-html-boolean () + "Test that `dom-print' correctly print HTML boolean attributes." + (let ((dom (dom-node + "html" nil + (dom-node "head" nil + (dom-node "title" nil + "Test boolean attributes")) + (dom-node "body" nil + ;; The following checkboxes are checked + (dom-node "input" '((type . "checkbox") + (checked . ""))) + (dom-node "input" '((type . "checkbox") + (checked . "checked"))) + (dom-node "input" '((type . "checkbox") + (checked . "true"))) + (dom-node "input" '((type . "checkbox") + (checked . "false"))) + ;; The following checkbox is not checked + (dom-node "input" '((type . "checkbox") + (checked))) + )))) + (with-temp-buffer + (dom-print dom) + (should + (equal + (buffer-string) + (concat + "Test boolean attributes" + "" + "" + "" + "" + "" + "")))))) + (ert-deftest dom-test-search () (let ((dom '(a nil (b nil (c nil))))) (should (equal (dom-search dom (lambda (d) (eq (dom-tag d) 'a))) diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el index e2a0276ae0a..75533b36f29 100644 --- a/test/lisp/emacs-lisp/cl-extra-tests.el +++ b/test/lisp/emacs-lisp/cl-extra-tests.el @@ -22,12 +22,55 @@ (require 'cl-lib) (require 'ert) +(ert-deftest cl-lib-test-remprop () + (let ((x (cl-gensym))) + (should (equal (symbol-plist x) '())) + ;; Remove nonexistent property on empty plist. + (cl-remprop x 'b) + (should (equal (symbol-plist x) '())) + (put x 'a 1) + (should (equal (symbol-plist x) '(a 1))) + ;; Remove nonexistent property on nonempty plist. + (cl-remprop x 'b) + (should (equal (symbol-plist x) '(a 1))) + (put x 'b 2) + (put x 'c 3) + (put x 'd 4) + (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4))) + ;; Remove property that is neither first nor last. + (cl-remprop x 'c) + (should (equal (symbol-plist x) '(a 1 b 2 d 4))) + ;; Remove last property from a plist of length >1. + (cl-remprop x 'd) + (should (equal (symbol-plist x) '(a 1 b 2))) + ;; Remove first property from a plist of length >1. + (cl-remprop x 'a) + (should (equal (symbol-plist x) '(b 2))) + ;; Remove property when there is only one. + (cl-remprop x 'b) + (should (equal (symbol-plist x) '())))) + (ert-deftest cl-get () (put 'cl-get-test 'x 1) (put 'cl-get-test 'y nil) (should (eq (cl-get 'cl-get-test 'x) 1)) (should (eq (cl-get 'cl-get-test 'y :none) nil)) - (should (eq (cl-get 'cl-get-test 'z :none) :none))) + (should (eq (cl-get 'cl-get-test 'z :none) :none)) + (let ((sym (make-symbol "test"))) + (put sym 'foo 'bar) + (should (equal (cl-get sym 'foo) 'bar)) + (cl-remprop sym 'foo) + (should (equal (cl-get sym 'foo 'default) 'default)))) + +(ert-deftest cl-lib-test-coerce-to-vector () + (let* ((a (vector)) + (b (vector 1 a 3)) + (c (list)) + (d (list b a))) + (should (eql (cl-coerce a 'vector) a)) + (should (eql (cl-coerce b 'vector) b)) + (should (equal (cl-coerce c 'vector) (vector))) + (should (equal (cl-coerce d 'vector) (vector b a))))) (ert-deftest cl-extra-test-coerce () (should (equal (cl-coerce "abc" 'list) '(?a ?b ?c))) @@ -152,7 +195,8 @@ (should (equal (cl-concatenate 'vector [1 2 3] [4 5 6]) [1 2 3 4 5 6])) (should (equal (cl-concatenate 'string "123" "456") - "123456"))) + "123456")) + (should (equal (cl-concatenate 'list '(1 2) '(3 4) '(5 6)) '(1 2 3 4 5 6)))) (ert-deftest cl-extra-test-mapcan () (should (equal (cl-mapcan #'list '(1 2 3)) '(1 2 3))) @@ -220,8 +264,8 @@ (should (equal (cl-isqrt 0) 0)) (should (equal (cl-isqrt 3) 1)) (should (equal (cl-isqrt 10) 3)) - (should-error (cl-isqrt -4)) - (should-error (cl-isqrt 2.5))) + (should-error (cl-isqrt -4) :type 'arith-error) + (should-error (cl-isqrt 2.5) :type 'arith-error)) (ert-deftest cl-extra-test-floor () (should (equal (cl-floor 4.5) '(4 0.5))) @@ -258,6 +302,17 @@ (should (equal (cl-signum -10) -1)) (should (equal (cl-signum 0) 0))) +(ert-deftest cl-parse-integer () + (should-error (cl-parse-integer "abc")) + (should (null (cl-parse-integer "abc" :junk-allowed t))) + (should (null (cl-parse-integer "" :junk-allowed t))) + (should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t))) + (should-error (cl-parse-integer "0123456789" :radix 8)) + (should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t))) + (should-error (cl-parse-integer "efz" :radix 16)) + (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2))) + (should (= -123 (cl-parse-integer " -123 ")))) + (ert-deftest cl-extra-test-parse-integer () (should (equal (cl-parse-integer "10") 10)) (should (equal (cl-parse-integer "-10") -10)) @@ -274,21 +329,17 @@ (should (equal (cl-subseq '(1 2 3 4 5) 2) '(3 4 5))) (should (equal (cl-subseq '(1 2 3 4 5) 1 3) '(2 3)))) -(ert-deftest cl-extra-test-concatenate () - (should (equal (cl-concatenate 'string "hello " "world") "hello world")) - (should (equal (cl-concatenate 'list '(1 2) '(3 4) '(5 6)) '(1 2 3 4 5 6)))) - (ert-deftest cl-extra-test-revappend () (should (equal (cl-revappend '(1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) (ert-deftest cl-extra-test-nreconc () - (should (equal (cl-nreconc '(1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) + (should (equal (cl-nreconc (list 1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) (ert-deftest cl-extra-test-list-length () (should (equal (cl-list-length '(1 2 3)) 3)) (should (equal (cl-list-length '()) 0)) (let ((xl (number-sequence 1 100))) - (setcdr (nthcdr 99 xl) xl) + (nconc xl xl) (should (equal (cl-list-length xl) nil)))) (ert-deftest cl-extra-test-tailp () @@ -297,11 +348,4 @@ (should (cl-tailp l l)) (should (not (cl-tailp '(4 5) l))))) -(ert-deftest cl-extra-test-remprop () - (let ((sym (make-symbol "test"))) - (put sym 'foo 'bar) - (should (equal (cl-get sym 'foo) 'bar)) - (cl-remprop sym 'foo) - (should (equal (cl-get sym 'foo 'default) 'default)))) - ;;; cl-extra-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index ff860d94468..12de268bced 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -19,229 +19,14 @@ ;;; Commentary: -;; Extracted from ert-tests.el, back when ert used to reimplement some -;; cl functions. +;; Some of these tests were extracted from ert-tests.el, back when ert +;; used to reimplement some cl functions. ;;; Code: (require 'cl-lib) (require 'ert) -(ert-deftest cl-lib-test-remprop () - (let ((x (cl-gensym))) - (should (equal (symbol-plist x) '())) - ;; Remove nonexistent property on empty plist. - (cl-remprop x 'b) - (should (equal (symbol-plist x) '())) - (put x 'a 1) - (should (equal (symbol-plist x) '(a 1))) - ;; Remove nonexistent property on nonempty plist. - (cl-remprop x 'b) - (should (equal (symbol-plist x) '(a 1))) - (put x 'b 2) - (put x 'c 3) - (put x 'd 4) - (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4))) - ;; Remove property that is neither first nor last. - (cl-remprop x 'c) - (should (equal (symbol-plist x) '(a 1 b 2 d 4))) - ;; Remove last property from a plist of length >1. - (cl-remprop x 'd) - (should (equal (symbol-plist x) '(a 1 b 2))) - ;; Remove first property from a plist of length >1. - (cl-remprop x 'a) - (should (equal (symbol-plist x) '(b 2))) - ;; Remove property when there is only one. - (cl-remprop x 'b) - (should (equal (symbol-plist x) '())))) - -(ert-deftest cl-lib-test-remove-if-not () - (let ((list (list 'a 'b 'c 'd)) - (i 0)) - (let ((result (cl-remove-if-not (lambda (x) - (should (eql x (nth i list))) - (cl-incf i) - (member i '(2 3))) - list))) - (should (equal i 4)) - (should (equal result '(b c))) - (should (equal list '(a b c d))))) - (should (equal '() - (cl-remove-if-not (lambda (_x) (should nil)) '())))) - -(ert-deftest cl-lib-test-remove () - (let ((list (list 'a 'b 'c 'd)) - (key-index 0) - (test-index 0)) - (let ((result - (cl-remove 'foo list - :key (lambda (x) - (should (eql x (nth key-index list))) - (prog1 - (list key-index x) - (cl-incf key-index))) - :test - (lambda (a b) - (should (eql a 'foo)) - (should (equal b (list test-index - (nth test-index list)))) - (cl-incf test-index) - (member test-index '(2 3)))))) - (should (equal key-index 4)) - (should (equal test-index 4)) - (should (equal result '(a d))) - (should (equal list '(a b c d))))) - (let ((x (cons nil nil)) - (y (cons nil nil))) - (should (equal (cl-remove x (list x y)) - ;; or (list x), since we use `equal' -- the - ;; important thing is that only one element got - ;; removed, this proves that the default test is - ;; `eql', not `equal' - (list y))))) - - -(ert-deftest cl-lib-test-set-functions () - (let ((c1 (cons nil nil)) - (c2 (cons nil nil)) - (sym (make-symbol "a"))) - (let ((e '()) - (a (list 'a 'b sym nil "" "x" c1 c2)) - (b (list c1 'y 'b sym 'x))) - (should (equal (cl-set-difference e e) e)) - (should (equal (cl-set-difference a e) a)) - (should (equal (cl-set-difference e a) e)) - (should (equal (cl-set-difference a a) e)) - (should (equal (cl-set-difference b e) b)) - (should (equal (cl-set-difference e b) e)) - (should (equal (cl-set-difference b b) e)) - ;; Note: this test (and others) is sensitive to the order of the - ;; result, which is not documented. - (should (equal (cl-set-difference a b) (list 'a nil "" "x" c2))) - (should (equal (cl-set-difference b a) (list 'y 'x))) - - ;; We aren't testing whether this is really using `eq' rather than `eql'. - (should (equal (cl-set-difference e e :test 'eq) e)) - (should (equal (cl-set-difference a e :test 'eq) a)) - (should (equal (cl-set-difference e a :test 'eq) e)) - (should (equal (cl-set-difference a a :test 'eq) e)) - (should (equal (cl-set-difference b e :test 'eq) b)) - (should (equal (cl-set-difference e b :test 'eq) e)) - (should (equal (cl-set-difference b b :test 'eq) e)) - (should (equal (cl-set-difference a b :test 'eq) (list 'a nil "" "x" c2))) - (should (equal (cl-set-difference b a :test 'eq) (list 'y 'x))) - - (should (equal (cl-union e e) e)) - (should (equal (cl-union a e) a)) - (should (equal (cl-union e a) a)) - (should (equal (cl-union a a) a)) - (should (equal (cl-union b e) b)) - (should (equal (cl-union e b) b)) - (should (equal (cl-union b b) b)) - (should (equal (cl-union a b) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) - - (should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) - - (should (equal (cl-intersection e e) e)) - (should (equal (cl-intersection a e) e)) - (should (equal (cl-intersection e a) e)) - (should (equal (cl-intersection a a) a)) - (should (equal (cl-intersection b e) e)) - (should (equal (cl-intersection e b) e)) - (should (equal (cl-intersection b b) b)) - (should (equal (cl-intersection a b) (list sym 'b c1))) - (should (equal (cl-intersection b a) (list sym 'b c1)))))) - -(ert-deftest cl-lib-test-gensym () - ;; Since the expansion of `should' calls `cl-gensym' and thus has a - ;; side-effect on `cl--gensym-counter', we have to make sure all - ;; macros in our test body are expanded before we rebind - ;; `cl--gensym-counter' and run the body. Otherwise, the test would - ;; fail if run interpreted. - (let ((body (byte-compile - '(lambda () - (should (equal (symbol-name (cl-gensym)) "G0")) - (should (equal (symbol-name (cl-gensym)) "G1")) - (should (equal (symbol-name (cl-gensym)) "G2")) - (should (equal (symbol-name (cl-gensym "foo")) "foo3")) - (should (equal (symbol-name (cl-gensym "bar")) "bar4")) - (should (equal cl--gensym-counter 5)))))) - (let ((cl--gensym-counter 0)) - (funcall body)))) - -(ert-deftest cl-lib-test-coerce-to-vector () - (let* ((a (vector)) - (b (vector 1 a 3)) - (c (list)) - (d (list b a))) - (should (eql (cl-coerce a 'vector) a)) - (should (eql (cl-coerce b 'vector) b)) - (should (equal (cl-coerce c 'vector) (vector))) - (should (equal (cl-coerce d 'vector) (vector b a))))) - -(ert-deftest cl-lib-test-string-position () - (should (eql (cl-position ?x "") nil)) - (should (eql (cl-position ?a "abc") 0)) - (should (eql (cl-position ?b "abc") 1)) - (should (eql (cl-position ?c "abc") 2)) - (should (eql (cl-position ?d "abc") nil)) - (should (eql (cl-position ?A "abc") nil))) - -(ert-deftest cl-lib-test-mismatch () - (should (eql (cl-mismatch "" "") nil)) - (should (eql (cl-mismatch "" "a") 0)) - (should (eql (cl-mismatch "a" "a") nil)) - (should (eql (cl-mismatch "ab" "a") 1)) - (should (eql (cl-mismatch "Aa" "aA") 0)) - (should (eql (cl-mismatch '(a b c) '(a b d)) 2))) - -(ert-deftest cl-lib-keyword-names-versus-values () - (should (equal - (funcall (cl-function (lambda (&key a b) (list a b))) - :b :a :a 42) - '(42 :a)))) - -(ert-deftest cl-lib-empty-keyargs () - (should-error (funcall (cl-function (lambda (&key) 1)) - :b 1))) - -(cl-defstruct (mystruct - (:constructor cl-lib--con-1 (&aux (abc 1))) - (:constructor cl-lib--con-2 (&optional def) "Constructor docstring.")) - "General docstring." - (abc 5 :readonly t) (def nil)) -(ert-deftest cl-lib-struct-accessors () - (let ((x (make-mystruct :abc 1 :def 2))) - (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) - (should (eql (cl-struct-slot-value 'mystruct 'def x) 2)) - (setf (cl-struct-slot-value 'mystruct 'def x) -1) - (should (eql (cl-struct-slot-value 'mystruct 'def x) -1)) - (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1)) - (should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) - (should (pcase (cl-struct-slot-info 'mystruct) - (`((cl-tag-slot) (abc 5 :readonly t) - (def . ,(or 'nil '(nil)))) - t))))) -(ert-deftest cl-lib-struct-constructors () - (should (string-match "\\`Constructor docstring." - (documentation 'cl-lib--con-2 t))) - (should (mystruct-p (cl-lib--con-1))) - (should (mystruct-p (cl-lib--con-2)))) - -(ert-deftest cl-lib-arglist-performance () - ;; An `&aux' should not cause lambda's arglist to be turned into an &rest - ;; that's parsed by hand. - (should (equal () (help-function-arglist 'cl-lib--con-1))) - (should (pcase (help-function-arglist 'cl-lib--con-2) - (`(&optional ,_) t)))) - -(ert-deftest cl-the () - (should (eql (cl-the integer 42) 42)) - (should-error (cl-the integer "abc")) - (let ((side-effect 0)) - (should (= (cl-the integer (cl-incf side-effect)) 1)) - (should (= side-effect 1)))) - (ert-deftest cl-lib-test-pushnew () (let ((list '(1 2 3))) (cl-pushnew 0 list) @@ -468,12 +253,6 @@ (should (equal (cl-pairlis '(a nil c) '(1 2 3)) '((a . 1) (nil . 2) (c . 3)))) (should (equal (cl-pairlis '(a b c) '(1 nil 3)) '((a . 1) (b) (c . 3))))) -(ert-deftest cl-lib-test-endp () - (should (cl-endp '())) - (should-not (cl-endp '(1))) - (should-error (cl-endp 1) :type 'wrong-type-argument) - (should-error (cl-endp [1]) :type 'wrong-type-argument)) - (ert-deftest cl-lib-test-nth-value () (let ((vals (cl-values 2 3))) (should (= (cl-nth-value 0 vals) 2)) @@ -544,70 +323,6 @@ (should-error (cl-adjoin 1 nums :key 'int-to-string :test-not myfn-p) :type 'wrong-type-argument))) -(ert-deftest cl-parse-integer () - (should-error (cl-parse-integer "abc")) - (should (null (cl-parse-integer "abc" :junk-allowed t))) - (should (null (cl-parse-integer "" :junk-allowed t))) - (should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t))) - (should-error (cl-parse-integer "0123456789" :radix 8)) - (should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t))) - (should-error (cl-parse-integer "efz" :radix 16)) - (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2))) - (should (= -123 (cl-parse-integer " -123 ")))) - -(ert-deftest cl-flet-test () - (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5))) - -(ert-deftest cl-lib-test-typep () - (cl-deftype cl-lib-test-type (&optional x) `(member ,x)) - ;; Make sure we correctly implement the rule that deftype's optional args - ;; default to `*' rather than to nil. - (should (cl-typep '* 'cl-lib-test-type)) - (should-not (cl-typep 1 'cl-lib-test-type))) - -(ert-deftest cl-lib-symbol-macrolet () - ;; bug#26325 - (should (equal (cl-flet ((f (x) (+ x 5))) - (let ((x 5)) - (f (+ x 6)))) - ;; Go through `eval', otherwise the macro-expansion - ;; error prevents running the whole test suite :-( - (eval '(cl-symbol-macrolet ((f (+ x 6))) - (cl-flet ((f (x) (+ x 5))) - (let ((x 5)) - (f f)))) - t)))) - -(defmacro cl-lib-symbol-macrolet-4+5 () - ;; bug#26068 - (let* ((sname "x") - (s1 (make-symbol sname)) - (s2 (make-symbol sname))) - `(cl-symbol-macrolet ((,s1 4) - (,s2 5)) - (+ ,s1 ,s2)))) - -(ert-deftest cl-lib-symbol-macrolet-2 () - (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5)))) - - -(ert-deftest cl-lib-symbol-macrolet-hide () - ;; bug#26325, bug#26073 - (should (equal (let ((y 5)) - (cl-symbol-macrolet ((x y)) - (list x - (let ((x 6)) (list x y)) - (cl-letf ((x 6)) (list x y)) - (apply (lambda (x) (+ x 1)) (list 8))))) - '(5 (6 5) (6 6) 9)))) - -(ert-deftest cl-lib-defstruct-record () - (cl-defstruct foo x) - (let ((x (make-foo :x 42))) - (should (recordp x)) - (should (eq (type-of x) 'foo)) - (should (eql (foo-x x) 42)))) - (ert-deftest old-struct () (cl-defstruct foo x) (with-suppressed-warnings ((obsolete cl-old-struct-compat-mode)) @@ -638,37 +353,4 @@ (should (equal (mapcar (cl-constantly 3) '(a b c d)) '(3 3 3 3)))) -(ert-deftest cl-lib-set-difference () - ;; our set-difference preserves order, though it is not required to - ;; by cl standards. Nevertheless better keep that invariant - (should (equal (cl-set-difference '(1 2 3 4) '(3 4 5 6)) - '(1 2)))) - -(ert-deftest cl-nset-difference () - ;; our nset-difference doesn't - (let* ((l1 (list 1 2 3 4)) (l2 '(3 4 5 6)) - (diff (cl-nset-difference l1 l2))) - (should (memq 1 diff)) - (should (memq 2 diff)) - (should (= (length diff) 2)) - (should (equal l2 '(3 4 5 6)))) - (let* ((l1 (list "1" "2" "3" "4")) (l2 '("3" "4" "5" "6")) - (diff (cl-nset-difference l1 l2 :test #'equal))) - (should (member "1" diff)) - (should (member "2" diff)) - (should (= (length diff) 2)) - (should (equal l2 '("3" "4" "5" "6")))) - (let* ((l1 (list '(a . 1) '(b . 2) '(c . 3) '(d . 4))) - (l2 (list '(c . 3) '(d . 4) '(e . 5) '(f . 6))) - (diff (cl-nset-difference l1 l2 :key #'car))) - (should (member '(a . 1) diff)) - (should (member '(b . 2) diff)) - (should (= (length diff) 2))) - (let* ((l1 (list '("a" . 1) '("b" . 2) '("c" . 3) '("d" . 4))) - (l2 (list '("c" . 3) '("d" . 4) '("e" . 5) '("f" . 6))) - (diff (cl-nset-difference l1 l2 :key #'car :test #'string=))) - (should (member '("a" . 1) diff)) - (should (member '("b" . 2) diff)) - (should (= (length diff) 2)))) - ;;; cl-lib-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 628bae36e48..4fa5c4edba1 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -22,11 +22,9 @@ ;;; Code: (require 'cl-lib) -(require 'cl-macs) (require 'edebug) (require 'ert) (require 'ert-x) -(require 'pcase) ;;;; cl-loop tests -- many adapted from Steele's CLtL2 @@ -518,6 +516,45 @@ collection clause." collect (list k x)))))) +(cl-defstruct (mystruct + (:constructor cl-lib--con-1 (&aux (abc 1))) + (:constructor cl-lib--con-2 (&optional def) "Constructor docstring.")) + "General docstring." + (abc 5 :readonly t) (def nil)) + +(ert-deftest cl-lib-struct-accessors () + (let ((x (make-mystruct :abc 1 :def 2))) + (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) + (should (eql (cl-struct-slot-value 'mystruct 'def x) 2)) + (setf (cl-struct-slot-value 'mystruct 'def x) -1) + (should (eql (cl-struct-slot-value 'mystruct 'def x) -1)) + (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1)) + (should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) + (should (pcase (cl-struct-slot-info 'mystruct) + (`((cl-tag-slot) (abc 5 :readonly t) + (def . ,(or 'nil '(nil)))) + t))))) + +(ert-deftest cl-lib-struct-constructors () + (should (string-match "\\`Constructor docstring." + (documentation 'cl-lib--con-2 t))) + (should (mystruct-p (cl-lib--con-1))) + (should (mystruct-p (cl-lib--con-2)))) + +(ert-deftest cl-lib-arglist-performance () + ;; An `&aux' should not cause lambda's arglist to be turned into an &rest + ;; that's parsed by hand. + (should (equal () (help-function-arglist 'cl-lib--con-1))) + (should (pcase (help-function-arglist 'cl-lib--con-2) + (`(&optional ,_) t)))) + +(ert-deftest cl-lib-defstruct-record () + (cl-defstruct foo x) + (let ((x (make-foo :x 42))) + (should (recordp x)) + (should (eq (type-of x) 'foo)) + (should (eql (foo-x x) 42)))) + (ert-deftest cl-defstruct/builtin-type () (should-error (macroexpand '(cl-defstruct hash-table)) @@ -563,6 +600,41 @@ collection clause." m))) '(42 5 42)))) +(ert-deftest cl-lib-symbol-macrolet () + ;; bug#26325 + (should (equal (cl-flet ((f (x) (+ x 5))) + (let ((x 5)) + (f (+ x 6)))) + ;; Go through `eval', otherwise the macro-expansion + ;; error prevents running the whole test suite :-( + (eval '(cl-symbol-macrolet ((f (+ x 6))) + (cl-flet ((f (x) (+ x 5))) + (let ((x 5)) + (f f)))) + t)))) + +(defmacro cl-lib-symbol-macrolet-4+5 () + ;; bug#26068 + (let* ((sname "x") + (s1 (make-symbol sname)) + (s2 (make-symbol sname))) + `(cl-symbol-macrolet ((,s1 4) + (,s2 5)) + (+ ,s1 ,s2)))) + +(ert-deftest cl-lib-symbol-macrolet-2 () + (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5)))) + +(ert-deftest cl-lib-symbol-macrolet-hide () + ;; bug#26325, bug#26073 + (should (equal (let ((y 5)) + (cl-symbol-macrolet ((x y)) + (list x + (let ((x 6)) (list x y)) + (cl-letf ((x 6)) (list x y)) + (apply (lambda (x) (+ x 1)) (list 8))))) + '(5 (6 5) (6 6) 9)))) + (ert-deftest cl-macs-loop-conditional-step-clauses () "These tests failed under the initial fixes in #bug#29799." (should (cl-loop for i from 1 upto 100 and j = 1 then (1+ j) @@ -718,6 +790,9 @@ collection clause." (f lex-var))))) (should (equal (f nil) 'a))))) +(ert-deftest cl-flet-test () + (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5))) + (ert-deftest cl-macs--test-flet-block () (should (equal (cl-block f1 (cl-flet ((f1 (a) (cons (cl-return-from f1 a) 6))) @@ -803,9 +878,9 @@ collection clause." (cl-ecase val (t 1) (123 2)) (cl-ecase val (123 2) (t 1)))) (ert-info ((prin1-to-string form) :prefix "Form: ") - (let ((error (should-error (macroexpand form)))) - (should (equal (cdr error) - '("Misplaced t or `otherwise' clause")))))))) + (let ((error (should-error (macroexpand form)))) + (should (equal (cdr error) + '("Misplaced t or `otherwise' clause")))))))) (ert-deftest cl-case-warning () "Test that `cl-case' and `cl-ecase' warn about suspicious @@ -833,10 +908,10 @@ constructs." (dolist (macro '(cl-case cl-ecase)) (let ((form `(,macro val (,case 1)))) (ert-info ((prin1-to-string form) :prefix "Form: ") - (ert-with-message-capture messages - (macroexpand form) - (should (equal messages - (concat "Warning: " message "\n")))))))))) + (ert-with-message-capture messages + (macroexpand form) + (should (equal messages + (concat "Warning: " message "\n")))))))))) (ert-deftest cl-case-no-warning () "Test that `cl-case' and `cl-ecase' don't warn in some valid cases. @@ -875,4 +950,45 @@ See Bug#57915." (should (equal (cl--test-s-cl--test-a x) 4)) (should (equal (cl--test-s-b x) 'dyn))))) +(ert-deftest cl-lib-keyword-names-versus-values () + (should (equal + (funcall (cl-function (lambda (&key a b) (list a b))) + :b :a :a 42) + '(42 :a)))) + +(ert-deftest cl-lib-empty-keyargs () + (should-error (funcall (cl-function (lambda (&key) 1)) + :b 1))) + +(ert-deftest cl-lib-test-gensym () + ;; Since the expansion of `should' calls `cl-gensym' and thus has a + ;; side-effect on `cl--gensym-counter', we have to make sure all + ;; macros in our test body are expanded before we rebind + ;; `cl--gensym-counter' and run the body. Otherwise, the test would + ;; fail if run interpreted. + (let ((body (byte-compile + '(lambda () + (should (equal (symbol-name (cl-gensym)) "G0")) + (should (equal (symbol-name (cl-gensym)) "G1")) + (should (equal (symbol-name (cl-gensym)) "G2")) + (should (equal (symbol-name (cl-gensym "foo")) "foo3")) + (should (equal (symbol-name (cl-gensym "bar")) "bar4")) + (should (equal cl--gensym-counter 5)))))) + (let ((cl--gensym-counter 0)) + (funcall body)))) + +(ert-deftest cl-the () + (should (eql (cl-the integer 42) 42)) + (should-error (cl-the integer "abc")) + (let ((side-effect 0)) + (should (= (cl-the integer (cl-incf side-effect)) 1)) + (should (= side-effect 1)))) + +(ert-deftest cl-lib-test-typep () + (cl-deftype cl-lib-test-type (&optional x) `(member ,x)) + ;; Make sure we correctly implement the rule that deftype's optional args + ;; default to `*' rather than to nil. + (should (cl-typep '* 'cl-lib-test-type)) + (should-not (cl-typep 1 'cl-lib-test-type))) + ;;; cl-macs-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index 3541a989d34..f72596e4a4b 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -1,4 +1,4 @@ -;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*- +;;; cl-seq-tests.el --- Tests for cl-seq.el -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2025 Free Software Foundation, Inc. @@ -19,15 +19,13 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;; Commentary: - ;;; Code: (require 'ert) -(require 'cl-seq) +(require 'cl-lib) (ert-deftest cl-union-test-00 () - "Test for https://debbugs.gnu.org/22729 ." + "Test for bug#22729." (let ((str1 "foo") (str2 (make-string 3 ?o))) ;; Emacs may make two string literals eql when reading. @@ -36,33 +34,30 @@ (should (equal str1 str2)) (should (equal (cl-union (list str1) (list str2)) (list str2))) - (should (equal (cl-union (list str1) (list str2) :test 'eql) + (should (equal (cl-union (list str1) (list str2) :test #'eql) (list str1 str2))))) -(defvar cl-seq--test-list nil - "List used on `cl-seq' tests with side effects.") -(defvar cl-seq--test-list2 nil - "List used on `cl-seq' tests with side effects.") - -(defmacro cl-seq--with-side-effects (list list2 &rest body) - "Run a test with side effects on lists; after the test restore the lists. -LIST is the value of `cl-seq--test-list' before the test. -LIST2, if non-nil, is the value of `cl-seq--test-list2' before the test. -Body are forms defining the test." - (declare (indent 2) (debug t)) - (let ((orig (make-symbol "orig")) - (orig2 (make-symbol "orig2"))) - `(let ((,orig (copy-sequence ,list)) - (,orig2 (copy-sequence ,list2))) - (unwind-protect (progn ,@body) - (setq cl-seq--test-list ,orig) - (when ,list2 - (setq cl-seq--test-list2 ,orig2)))))) +(defmacro cl-seq-tests--relet* (binders &rest body) + "Like `let*', but reevaluate BINDERS before each form in BODY. +Additionally register an `ert-info' to help identify test failures." + (declare (debug let) (indent 1)) + (let ((syms (mapcar (lambda (binder) + (if (consp binder) (car binder) binder)) + binders))) + (macroexp-progn + (mapcar (lambda (form) + `(ert-info (,(lambda () (pp-to-string form)) :prefix "form: ") + (let* ,binders + ,@(and syms `((ignore ,@syms))) + ,form))) + body)))) (ert-deftest cl-seq-endp-test () (should (cl-endp '())) - (should (not (cl-endp '(1 2 3)))) - (should-error (cl-endp 42) :type 'wrong-type-argument)) + (should-not (cl-endp '(1))) + (should-not (cl-endp '(1 2 3))) + (should-error (cl-endp 1) :type 'wrong-type-argument) + (should-error (cl-endp [1]) :type 'wrong-type-argument)) (ert-deftest cl-seq-reduce-test () (should (equal 6 (cl-reduce #'+ '(1 2 3)))) @@ -77,51 +72,70 @@ Body are forms defining the test." ;; keywords supported: :start :end (ert-deftest cl-seq-fill-test () - (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (orig (copy-sequence cl-seq--test-list)) - (tests '((should (equal '(b b b b b b b) (cl-fill _list 'b))) - (should (equal '(1 2 3 4 b b b) (cl-fill _list 'b :start 4))) - (should (equal '(b b b b 5 2 6) (cl-fill _list 'b :end 4))) - (should (equal '(1 2 b b 5 2 6) (cl-fill _list 'b :start 2 :end 4))) - (should (equal orig (cl-fill _list 'b :end 0)))))) - (dolist (test tests) - (let ((_list cl-seq--test-list)) - (cl-seq--with-side-effects orig nil - test))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5 2 6)) + (orig (copy-sequence l))) + (should (equal '(b b b b b b b) (cl-fill l 'b))) + (should (equal '(1 2 3 4 b b b) (cl-fill l 'b :start 4))) + (should (equal '(b b b b 5 2 6) (cl-fill l 'b :end 4))) + (should (equal '(1 2 b b 5 2 6) (cl-fill l 'b :start 2 :end 4))) + (should (equal orig (cl-fill l 'b :end 0))))) ;; keywords supported: :start1 :end1 :start2 :end2 (ert-deftest cl-seq-replace-test () - (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (cl-seq--test-list2 (make-list 6 'a)) - (orig (copy-sequence cl-seq--test-list)) - (orig2 (copy-sequence cl-seq--test-list2)) - (tests '((should (equal '(a a a a a a 6) (cl-replace _list _list2))) - (should (equal '(a a a a a a 6) (cl-replace _list _list2 :start1 0))) - (should (equal '(a a a a a a 6) (cl-replace _list _list2 :start2 0))) - (should (equal orig (cl-replace _list _list2 :start1 (length _list)))) - (should (equal orig (cl-replace _list _list2 :start2 (length _list2)))) - (should (equal orig (cl-replace _list _list2 :end1 0))) - (should (equal orig (cl-replace _list _list2 :end2 0))) - (should (equal '(1 2 3 4 a a a) (cl-replace _list _list2 :start1 4))) - (should (equal '(a a a a 5 2 6) (cl-replace _list _list2 :end1 4))) - (should (equal '(a a 3 4 5 2 6) (cl-replace _list _list2 :start2 4))) - (should (equal '(a a a a 5 2 6) (cl-replace _list _list2 :end2 4))) - (should (equal '(1 2 a a 5 2 6) (cl-replace _list _list2 :start1 2 :end1 4))) - (should (equal '(a a 3 4 5 2 6) (cl-replace _list _list2 :start2 2 :end2 4)))))) - (dolist (test tests) - (let ((_list cl-seq--test-list) - (_list2 cl-seq--test-list2)) - (cl-seq--with-side-effects orig orig2 - test))))) + (cl-seq-tests--relet* ((l1 (list 1 2 3 4 5 2 6)) + (l2 (make-list 6 'a)) + (orig1 (copy-sequence l1))) + (should (equal '(a a a a a a 6) (cl-replace l1 l2))) + (should (equal '(a a a a a a 6) (cl-replace l1 l2 :start1 0))) + (should (equal '(a a a a a a 6) (cl-replace l1 l2 :start2 0))) + (should (equal orig1 (cl-replace l1 l2 :start1 (length l1)))) + (should (equal orig1 (cl-replace l1 l2 :start2 (length l2)))) + (should (equal orig1 (cl-replace l1 l2 :end1 0))) + (should (equal orig1 (cl-replace l1 l2 :end2 0))) + (should (equal '(1 2 3 4 a a a) (cl-replace l1 l2 :start1 4))) + (should (equal '(a a a a 5 2 6) (cl-replace l1 l2 :end1 4))) + (should (equal '(a a 3 4 5 2 6) (cl-replace l1 l2 :start2 4))) + (should (equal '(a a a a 5 2 6) (cl-replace l1 l2 :end2 4))) + (should (equal '(1 2 a a 5 2 6) (cl-replace l1 l2 :start1 2 :end1 4))) + (should (equal '(a a 3 4 5 2 6) (cl-replace l1 l2 :start2 2 :end2 4))))) + +(ert-deftest cl-lib-test-remove () + (let ((list (list 'a 'b 'c 'd)) + (key-index 0) + (test-index 0)) + (let ((result + (cl-remove 'foo list + :key (lambda (x) + (should (eql x (nth key-index list))) + (prog1 + (list key-index x) + (cl-incf key-index))) + :test + (lambda (a b) + (should (eql a 'foo)) + (should (equal b (list test-index + (nth test-index list)))) + (cl-incf test-index) + (member test-index '(2 3)))))) + (should (equal key-index 4)) + (should (equal test-index 4)) + (should (equal result '(a d))) + (should (equal list '(a b c d))))) + (let ((x (cons nil nil)) + (y (cons nil nil))) + (should (equal (cl-remove x (list x y)) + ;; or (list x), since we use `equal' -- the + ;; important thing is that only one element got + ;; removed, this proves that the default test is + ;; `eql', not `equal' + (list y))))) ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-remove-test () (let ((list '(1 2 3 4 5 2 6))) (should (equal list (cl-remove 'foo list))) - (should (equal '(1 3 4 5 6) (cl-remove 2 list))) - (should (equal '(1 3 4 5 6) (cl-remove 2 list - :key #'identity - :test (lambda (a b) (eql a b))))) + (should (equal '(1 3 4 5 6) (cl-remove 2 list))) + (should (equal '(1 3 4 5 6) (cl-remove 2 list :key #'identity :test #'eql))) (should (equal '(1 2 3 4 2) (cl-remove 4 list :test (lambda (a b) (> b a))))) (should (equal '(5 6) (cl-remove 4 list :test-not (lambda (a b) (> b a))))) (should (equal '(1 3 5) (cl-remove 'foo list :if #'cl-evenp))) @@ -133,67 +147,72 @@ Body are forms defining the test." (should (equal '(1 2 3 4 5 6) (cl-remove 2 list :from-end t :count 1))))) (ert-deftest cl-remove-if-test () - (should (equal '(1 3) (cl-remove-if 'cl-evenp '(1 2 3 4)))) - (should (equal '(1 3) (cl-remove-if 'cl-evenp '(1 2 3 4) :count 2))) - (should (equal '(1 3 4) (cl-remove-if 'cl-evenp '(1 2 3 4) :start 1 :end 3))) - (should (equal '(1 3) (cl-remove-if 'cl-evenp '(1 2 3 4) :from-end t))) - (should (equal '(2 4) (cl-remove-if 'cl-oddp '(1 2 3 4)))) - (should (equal '() (cl-remove-if 'cl-evenp '()))) - (should (equal '() (cl-remove-if 'cl-evenp '(2))))) + (should (equal '(1 3) (cl-remove-if #'cl-evenp '(1 2 3 4)))) + (should (equal '(1 3) (cl-remove-if #'cl-evenp '(1 2 3 4) :count 2))) + (should (equal '(1 3 4) (cl-remove-if #'cl-evenp '(1 2 3 4) :start 1 :end 3))) + (should (equal '(1 3) (cl-remove-if #'cl-evenp '(1 2 3 4) :from-end t))) + (should (equal '(2 4) (cl-remove-if #'cl-oddp '(1 2 3 4)))) + (should (equal '() (cl-remove-if #'cl-evenp '()))) + (should (equal '() (cl-remove-if #'cl-evenp '(2))))) + +(ert-deftest cl-lib-test-remove-if-not () + (let ((list (list 'a 'b 'c 'd)) + (i 0)) + (let ((result (cl-remove-if-not (lambda (x) + (should (eql x (nth i list))) + (cl-incf i) + (member i '(2 3))) + list))) + (should (equal i 4)) + (should (equal result '(b c))) + (should (equal list '(a b c d))))) + (should (equal '() + (cl-remove-if-not (lambda (_x) (should nil)) '())))) (ert-deftest cl-remove-if-not-test () - (should (equal '(2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4)))) - (should (equal '(2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4) :count 2))) - (should (equal '(1 2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4) :start 1 :end 3))) - (should (equal '(2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4) :from-end t))) - (should (equal '(1 3) (cl-remove-if-not 'cl-oddp '(1 2 3 4)))) - (should (equal '() (cl-remove-if-not 'cl-evenp '()))) - (should (equal '(2) (cl-remove-if-not 'cl-evenp '(2)))) - (should (equal '(2) (cl-remove-if-not 'cl-evenp '(2) :key #'(lambda (x) (- x)))))) + (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4)))) + (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4) :count 2))) + (should (equal '(1 2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4) :start 1 :end 3))) + (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4) :from-end t))) + (should (equal '(1 3) (cl-remove-if-not #'cl-oddp '(1 2 3 4)))) + (should (equal '() (cl-remove-if-not #'cl-evenp '()))) + (should (equal '(2) (cl-remove-if-not #'cl-evenp '(2)))) + (should (equal '(2) (cl-remove-if-not #'cl-evenp '(2) :key #'-)))) ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-delete-test () - (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (orig (copy-sequence cl-seq--test-list)) - (tests '((should (equal orig (cl-delete 'foo _list))) - (should (equal '(1 3 4 5 6) (cl-delete 2 _list))) - (should (equal '(1 3 4 5 6) (cl-delete 2 _list - :key #'identity - :test (lambda (a b) (eql a b))))) - (should (equal '(1 2 3 4 2) (cl-delete 4 _list :test (lambda (a b) (> b a))))) - (should (equal '(5 6) (cl-delete 4 _list :test-not (lambda (a b) (> b a))))) - (should (equal '(1 3 5) (cl-delete 'foo _list :if #'cl-evenp))) - (should (equal '(2 4 2 6) (cl-delete 'foo _list :if-not #'cl-evenp))) - (should (equal '(1 2 3 4 5) (cl-delete 'foo _list :if #'cl-evenp :start 4))) - (should (equal '(1 2 3 4 5 6) (cl-delete 2 _list :start 5 :end 6))) - (should (equal '(1 3 4 5 2 6) (cl-delete 2 _list :count 1))) - (should (equal '(1 3 4 5 2 6) (cl-delete 2 _list :from-end nil :count 1))) - (should (equal '(1 2 3 4 5 6) (cl-delete 2 _list :from-end t :count 1)))))) - (dolist (test tests) - (let ((_list cl-seq--test-list)) - (cl-seq--with-side-effects orig nil - test))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5 2 6)) + (orig (copy-sequence l))) + (should (equal orig (cl-delete 'foo l))) + (should (equal '(1 3 4 5 6) (cl-delete 2 l))) + (should (equal '(1 3 4 5 6) (cl-delete 2 l :key #'identity :test #'eql))) + (should (equal '(1 2 3 4 2) (cl-delete 4 l :test (lambda (a b) (> b a))))) + (should (equal '(5 6) (cl-delete 4 l :test-not (lambda (a b) (> b a))))) + (should (equal '(1 3 5) (cl-delete 'foo l :if #'cl-evenp))) + (should (equal '(2 4 2 6) (cl-delete 'foo l :if-not #'cl-evenp))) + (should (equal '(1 2 3 4 5) (cl-delete 'foo l :if #'cl-evenp :start 4))) + (should (equal '(1 2 3 4 5 6) (cl-delete 2 l :start 5 :end 6))) + (should (equal '(1 3 4 5 2 6) (cl-delete 2 l :count 1))) + (should (equal '(1 3 4 5 2 6) (cl-delete 2 l :from-end nil :count 1))) + (should (equal '(1 2 3 4 5 6) (cl-delete 2 l :from-end t :count 1))))) (ert-deftest cl-delete-if-test () - (let ((list (list 1 2 3 4 5))) - (cl-delete-if 'cl-evenp list) - (should (equal '(1 3 5) list)) - (should (equal '(1 3 5) (cl-delete-if 'cl-evenp (list 1 2 3 4 5) :start 0 :end 4))) - (should (equal '(1 3 5) (cl-delete-if 'cl-evenp (list 1 2 3 4 5) :from-end t))) - (should (equal '(2 4) (cl-delete-if 'cl-oddp (list 1 2 3 4 5)))) - (should (equal '() (cl-delete-if 'cl-evenp '()))) - (should (equal '() (cl-delete-if 'cl-evenp (list 2)))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5))) + (should (equal '(1 3 5) (cl-delete-if #'cl-evenp l))) + (should (equal '(1 3 5) (cl-delete-if #'cl-evenp l :start 0 :end 4))) + (should (equal '(1 3 5) (cl-delete-if #'cl-evenp l :from-end t))) + (should (equal '(2 4) (cl-delete-if #'cl-oddp l)))) + (should (equal '() (cl-delete-if #'cl-evenp '()))) + (should (equal '() (cl-delete-if #'cl-evenp (list 2))))) (ert-deftest cl-delete-if-not-test () - (let ((list (list 1 2 3 4 5))) - (should (equal '(2 4) (cl-delete-if-not 'cl-evenp list))) - (should (equal '() (cl-delete-if-not 'cl-evenp '()))) - (should (equal '() (cl-delete-if-not 'cl-evenp (list 1)))))) + (should (equal '(2 4) (cl-delete-if-not #'cl-evenp (list 1 2 3 4 5)))) + (should (equal '() (cl-delete-if-not #'cl-evenp '()))) + (should (equal '() (cl-delete-if-not #'cl-evenp (list 1))))) (ert-deftest cl-delete-duplicates-test () - (let ((list (list 1 2 3 2 1))) - (should (equal '(3 2 1) (cl-delete-duplicates list))) - (should (equal '() (cl-delete-duplicates '()))))) + (should (equal '(3 2 1) (cl-delete-duplicates (list 1 2 3 2 1)))) + (should (equal '() (cl-delete-duplicates '())))) ;; keywords supported: :test :test-not :key :start :end :from-end (ert-deftest cl-seq-remove-duplicates-test () @@ -203,10 +222,10 @@ Body are forms defining the test." (should (equal list (cl-remove-duplicates list :start 2))) (should (equal list (cl-remove-duplicates list :start 2 :from-end t))) (should (equal list (cl-remove-duplicates list :end 4))) - (should (equal '(6) (cl-remove-duplicates list :test (lambda (a b) (< a b))))) - (should (equal '(1 2 6) (cl-remove-duplicates list :test (lambda (a b) (>= a b))))) - (should (equal (cl-remove-duplicates list :test (lambda (a b) (>= a b))) - (cl-remove-duplicates list :test-not (lambda (a b) (< a b))))) + (should (equal '(6) (cl-remove-duplicates list :test #'<))) + (should (equal '(1 2 6) (cl-remove-duplicates list :test #'>=))) + (should (equal (cl-remove-duplicates list :test #'>=) + (cl-remove-duplicates list :test-not #'<))) (should (equal (cl-remove-duplicates list) (cl-remove-duplicates list :key #'number-to-string :test #'string=))) (should (equal list @@ -224,35 +243,38 @@ Body are forms defining the test." (should (equal '(1 b 3 4 5 2 6) (cl-substitute 'b 2 list :count 1))) (should (equal '(1 2 3 4 5 b 6) (cl-substitute 'b 2 list :count 1 :from-end t))) (should (equal list (cl-substitute 'b 2 list :count -1))) - (should (equal '(1 b 3 4 5 b 6) (cl-substitute 'b "2" list :key #'number-to-string + (should (equal '(1 b 3 4 5 b 6) (cl-substitute 'b "2" list + :key #'number-to-string :test #'string=))) (should (equal (cl-substitute 'b 2 list) (cl-substitute 'b 2 list :test #'eq))) - (should (equal '(1 2 b b b 2 b) (cl-substitute 'b 2 list :test (lambda (a b) (< a b))))) - (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b 2 list :test (lambda (a b) (>= a b))))) - (should (equal list (cl-substitute 'b 99 list :test (lambda (a b) (< a b))))) - (should (equal (cl-substitute 'b 2 list :test (lambda (a b) (>= a b))) - (cl-substitute 'b 2 list :test-not (lambda (a b) (< a b))))) - (should (equal '(1 2 b b b 2 b) (cl-substitute 'b nil list :if (lambda (x) (> (cl-position x list) 1))))) - (should (equal '(1 b b b b b b) (cl-substitute 'b nil list :if (lambda (x) (> (cl-position x list :from-end t) 1))))) - - (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b nil list - :if-not (lambda (x) (> (cl-position x list) 1))))) - (should (equal '(b 2 3 4 5 2 6) (cl-substitute 'b nil list - :if-not (lambda (x) (> (cl-position x list :from-end t) 1))))))) + (should (equal '(1 2 b b b 2 b) (cl-substitute 'b 2 list :test #'<))) + (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b 2 list :test #'>=))) + (should (equal list (cl-substitute 'b 99 list :test #'<))) + (should (equal (cl-substitute 'b 2 list :test #'>=) + (cl-substitute 'b 2 list :test-not #'<))) + (let ((pred (lambda (x) (> (cl-position x list) 1)))) + (should (equal '(1 2 b b b 2 b) (cl-substitute 'b nil list :if pred)))) + (let ((pred (lambda (x) (> (cl-position x list :from-end t) 1)))) + (should (equal '(1 b b b b b b) (cl-substitute 'b nil list :if pred)))) + (let ((pred (lambda (x) (> (cl-position x list) 1)))) + (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b nil list :if-not pred)))) + (let ((pred (lambda (x) (> (cl-position x list :from-end t) 1)))) + (should (equal '(b 2 3 4 5 2 6) (cl-substitute 'b nil list :if-not pred)))))) (ert-deftest cl-seq-substitute-if-test () (let ((result (cl-substitute-if 'x #'cl-evenp '(1 2 3 4 5)))) (should (equal result '(1 x 3 x 5)))) (let ((result (cl-substitute-if 'x #'cl-evenp '(1 3 5)))) (should (equal result '(1 3 5)))) - (let ((result (cl-substitute-if 'x #'(lambda (n) t) '(1 2 3 4 5)))) + (let ((result (cl-substitute-if 'x #'always '(1 2 3 4 5)))) (should (equal result '(x x x x x)))) (let ((result (cl-substitute-if 'x #'cl-evenp '(1 2 3 4 5) :start 1 :end 4))) (should (equal result '(1 x 3 x 5)))) (let ((result (cl-substitute-if 'x #'cl-oddp '(1 2 3 4 5) :from-end t))) (should (equal result '(x 2 x 4 x)))) - (let ((result (cl-substitute-if 'x (lambda (n) (= n 3)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-substitute-if 'x (lambda (n) (= n 3)) '(1 2 3 4 5) + :key #'identity))) (should (equal result '(1 2 x 4 5))))) (ert-deftest cl-seq-substitute-if-not-test () @@ -260,21 +282,22 @@ Body are forms defining the test." (should (equal result '(x 2 x 4 x)))) (let ((result (cl-substitute-if-not 'x #'cl-evenp '(2 4 6)))) (should (equal result '(2 4 6)))) - (let ((result (cl-substitute-if-not 'x #'(lambda (n) (> n 5)) '(1 2 3 4 5)))) + (let ((result (cl-substitute-if-not 'x (lambda (n) (> n 5)) '(1 2 3 4 5)))) (should (equal result '(x x x x x)))) (let ((result (cl-substitute-if-not 'x #'cl-evenp '(1 2 3 4 5) :start 0 :end 4))) (should (equal result '(x 2 x 4 5)))) (let ((result (cl-substitute-if-not 'x #'cl-oddp '(1 2 3 4 5) :from-end t))) (should (equal result '(1 x 3 x 5)))) - (let ((result (cl-substitute-if-not 'x (lambda (n) (= n 3)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-substitute-if-not 'x (lambda (n) (= n 3)) '(1 2 3 4 5) + :key #'identity))) (should (equal result '(x x 3 x x))))) (ert-deftest cl-find-if-test () (let ((result (cl-find-if #'cl-evenp '(1 2 3 4 5)))) (should (equal result 2))) - (let ((result (cl-find-if #'(lambda (n) (> n 5)) '(1 2 3 4 5)))) + (let ((result (cl-find-if (lambda (n) (> n 5)) '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-find-if #'(lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) + (let ((result (cl-find-if (lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) (should (equal result 4))) (let ((result (cl-find-if #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 4))) @@ -282,7 +305,7 @@ Body are forms defining the test." (should (equal result nil))) (let ((result (cl-find-if #'cl-oddp '(2 4 5 6 7) :from-end t))) (should (equal result 7))) - (let ((result (cl-find-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-find-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key #'identity))) (should (equal result 4)))) (ert-deftest cl-find-if-not-test () @@ -290,7 +313,7 @@ Body are forms defining the test." (should (equal result 1))) (let ((result (cl-find-if-not #'cl-oddp '(1 3 5)))) (should (equal result nil))) - (let ((result (cl-find-if-not #'(lambda (n) (< n 4)) '(1 2 3 4 5 6 7)))) + (let ((result (cl-find-if-not (lambda (n) (< n 4)) '(1 2 3 4 5 6 7)))) (should (equal result 4))) (let ((result (cl-find-if-not #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 3))) @@ -298,45 +321,48 @@ Body are forms defining the test." (should (equal result 1))) (let ((result (cl-find-if-not #'cl-oddp '(2 4 6 7 8) :from-end t))) (should (equal result 8))) - (let ((result (cl-find-if-not (lambda (n) (= n 4)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-find-if-not (lambda (n) (= n 4)) '(1 2 3 4 5) :key #'identity))) (should (equal result 1)))) ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-nsubstitute-test () - (let ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (orig (copy-sequence cl-seq--test-list)) - (tests '((should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b 2 _list))) - (should (equal _list (cl-substitute 'b 2 _list :start (length _list)))) - (should (equal _list (cl-substitute 'b 2 _list :end 0))) - (should (equal '(1 2 3 4 5 b 6) (cl-substitute 'b 2 _list :start 2))) - (should (equal '(1 b 3 4 5 2 6) (cl-substitute 'b 2 _list :end 2))) - (should (equal _list (cl-substitute 'b 2 _list :start 2 :end 4))) - (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 _list :count 1))) - (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 _list :count 1 :from-end t))) - (should (equal _list (cl-nsubstitute 'b 2 _list :count -1))) - (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b "2" _list :key #'number-to-string - :test #'string=))) - (should (equal (cl-nsubstitute 'b 2 _list) - (cl-nsubstitute 'b 2 _list :test #'eq))) - (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b 2 _list :test (lambda (a b) (< a b))))) - (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b 2 _list :test (lambda (a b) (>= a b))))) - (should (equal _list (cl-nsubstitute 'b 99 _list :test (lambda (a b) (< a b))))) - (should (equal (cl-nsubstitute 'b 2 _list :test (lambda (a b) (>= a b))) - (cl-nsubstitute 'b 2 _list :test-not (lambda (a b) (< a b))))) - (should (equal '(1 2 b b b 2 b) - (cl-nsubstitute 'b nil _list :if (lambda (x) (> (cl-position x _list) 1))))) - (should (equal '(1 b b b b b b) - (cl-nsubstitute 'b nil _list :if (lambda (x) (> (cl-position x _list :from-end t) 1))))) - (should (equal '(b b 3 4 5 b 6) - (cl-nsubstitute 'b nil _list - :if-not (lambda (x) (> (cl-position x _list) 1))))) - (should (equal '(b 2 3 4 5 2 6) - (cl-nsubstitute 'b nil _list - :if-not (lambda (x) (> (cl-position x _list :from-end t) 1)))))))) - (dolist (test tests) - (let ((_list cl-seq--test-list)) - (cl-seq--with-side-effects orig nil - test))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5 2 6)) + (orig (copy-sequence l))) + (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b 2 l))) + (should (equal orig (cl-nsubstitute 'b 2 l :start (length l)))) + (should (equal orig (cl-nsubstitute 'b 2 l :end 0))) + (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 l :start 2))) + (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 l :end 2))) + (should (equal orig (cl-nsubstitute 'b 2 l :start 2 :end 4))) + (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 l :count 1))) + (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 l :count 1 :from-end t))) + (should (equal orig (cl-nsubstitute 'b 2 l :count -1))) + (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b "2" l + :key #'number-to-string + :test #'string=))) + (should (equal (cl-nsubstitute 'b 2 orig) + (cl-nsubstitute 'b 2 l :test #'eq))) + (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b 2 l :test #'<))) + (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b 2 l :test #'>=))) + (should (equal orig (cl-nsubstitute 'b 99 l :test #'<))) + (should (equal (cl-nsubstitute 'b 2 orig :test #'>=) + (cl-nsubstitute 'b 2 l :test-not #'<))) + (let ((pred (lambda (x) (> (cl-position x orig) 1)))) + (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b nil l :if pred)))) + (let ((pred (lambda (x) (> (cl-position x orig :from-end t) 1)))) + (should (equal '(1 b b b b b b) (cl-nsubstitute 'b nil l :if pred)))) + (let ((pred (lambda (x) (> (cl-position x orig) 1)))) + (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b nil l :if-not pred)))) + (let ((pred (lambda (x) (> (cl-position x orig :from-end t) 1)))) + (should (equal '(b 2 3 4 5 2 6) (cl-nsubstitute 'b nil l :if-not pred)))))) + +(ert-deftest cl-lib-test-string-position () + (should (eql (cl-position ?x "") nil)) + (should (eql (cl-position ?a "abc") 0)) + (should (eql (cl-position ?b "abc") 1)) + (should (eql (cl-position ?c "abc") 2)) + (should (eql (cl-position ?d "abc") nil)) + (should (eql (cl-position ?A "abc") nil))) ;; keywords supported: :test :test-not :key :start :end :from-end (ert-deftest cl-seq-position-test () @@ -346,10 +372,10 @@ Body are forms defining the test." (should (= 5 (cl-position 2 list :start 5 :end 6))) (should (= 1 (cl-position 2 list :from-end nil))) (should (= 5 (cl-position 2 list :from-end t))) - (should (cl-position 2 list :key #'identity - :test (lambda (a b) (eql a b)))) + (should (cl-position 2 list :key #'identity :test #'eql)) (should (= 1 (cl-position "2" list :key #'number-to-string :test #'string=))) - (should (= 5 (cl-position "2" list :key #'number-to-string :test #'string= :from-end t))) + (should (= 5 (cl-position "2" list :key #'number-to-string + :test #'string= :from-end t))) (should-not (cl-position "2" list :key #'number-to-string)) (should (cl-position 5 list :key (lambda (x) (1+ (* 1.0 x x))) :test #'=)) (should-not (cl-position 5 list :key (lambda (x) (1+ (* 1.0 x x))))) @@ -359,9 +385,9 @@ Body are forms defining the test." (ert-deftest cl-position-if-test () (let ((result (cl-position-if #'cl-evenp '(1 2 3 4 5)))) (should (equal result 1))) - (let ((result (cl-position-if #'(lambda (n) (> n 5)) '(1 2 3 4 5)))) + (let ((result (cl-position-if (lambda (n) (> n 5)) '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-position-if #'(lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) + (let ((result (cl-position-if (lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) (should (equal result 3))) (let ((result (cl-position-if #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 3))) @@ -369,7 +395,7 @@ Body are forms defining the test." (should (equal result nil))) (let ((result (cl-position-if #'cl-oddp '(2 4 5 6 7) :from-end t))) (should (equal result 4))) - (let ((result (cl-position-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-position-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key #'identity))) (should (equal result 3)))) ;; keywords supported: :test :test-not :key :start :end @@ -390,11 +416,11 @@ Body are forms defining the test." (should (equal result 2))) (let ((result (cl-count-if #'cl-oddp '(2 4 6 8)))) (should (equal result 0))) - (let ((result (cl-count-if (lambda (x) t) '(1 2 3 4)))) + (let ((result (cl-count-if #'always '(1 2 3 4)))) (should (equal result 4))) - (let ((result (cl-count-if (lambda (x) nil) '(1 2 3 4)))) + (let ((result (cl-count-if #'ignore '(1 2 3 4)))) (should (equal result 0))) - (let ((result (cl-count-if #'(lambda (x) (> x 2)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-count-if (lambda (x) (> x 2)) '(1 2 3 4 5) :key #'identity))) (should (equal result 3))) (let ((result (cl-count-if #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 1))) @@ -402,7 +428,7 @@ Body are forms defining the test." (should (equal result 1))) (let ((result (cl-count-if #'cl-evenp '()))) (should (equal result 0))) - (let ((result (cl-count-if #'(lambda (x) (numberp x)) '(1 "two" 3 4 "five" 6)))) + (let ((result (cl-count-if #'numberp '(1 "two" 3 4 "five" 6)))) (should (equal result 4))) (let ((result (cl-count-if (lambda (x) (and (numberp x) (> x 2))) '(1 2 3 4 5 6)))) (should (equal result 4)))) @@ -412,11 +438,11 @@ Body are forms defining the test." (should (equal result 3))) (let ((result (cl-count-if-not #'cl-oddp '(1 3 5)))) (should (equal result 0))) - (let ((result (cl-count-if-not (lambda (x) t) '(1 2 3 4)))) + (let ((result (cl-count-if-not #'always '(1 2 3 4)))) (should (equal result 0))) - (let ((result (cl-count-if-not (lambda (x) nil) '(1 2 3 4)))) + (let ((result (cl-count-if-not #'ignore '(1 2 3 4)))) (should (equal result 4))) - (let ((result (cl-count-if-not #'(lambda (x) (> x 3)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-count-if-not (lambda (x) (> x 3)) '(1 2 3 4 5) :key #'identity))) (should (equal result 3))) (let ((result (cl-count-if-not #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 2))) @@ -424,11 +450,20 @@ Body are forms defining the test." (should (equal result 2))) (let ((result (cl-count-if-not #'cl-evenp '()))) (should (equal result 0))) - (let ((result (cl-count-if-not #'(lambda (x) (numberp x)) '(1 "two" 3 4 "five" 6)))) + (let ((result (cl-count-if-not #'numberp '(1 "two" 3 4 "five" 6)))) (should (equal result 2))) - (let ((result (cl-count-if-not (lambda (x) (and (numberp x) (> x 2))) '(1 2 3 4 5 6)))) + (let ((result (cl-count-if-not (lambda (x) (and (numberp x) (> x 2))) + '(1 2 3 4 5 6)))) (should (equal result 2)))) +(ert-deftest cl-lib-test-mismatch () + (should (eql (cl-mismatch "" "") nil)) + (should (eql (cl-mismatch "" "a") 0)) + (should (eql (cl-mismatch "a" "a") nil)) + (should (eql (cl-mismatch "ab" "a") 1)) + (should (eql (cl-mismatch "Aa" "aA") 0)) + (should (eql (cl-mismatch '(a b c) '(a b d)) 2))) + ;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end (ert-deftest cl-seq-mismatch-test () (let ((list '(1 2 3 4 5 2 6)) @@ -443,9 +478,9 @@ Body are forms defining the test." (should-not (cl-mismatch list list2 :end1 1 :end2 1)) (should-not (cl-mismatch list list2 :start1 1 :start2 2)) (should (= 1 (cl-mismatch list list2 :start1 1 :end1 2 :start2 4 :end2 4))) - (should (= -1 (cl-mismatch list list2 :key #'number-to-string + (should (= -1 (cl-mismatch list list2 :from-end t :key #'number-to-string :test (lambda (a b) - (and (stringp a) (stringp b))) :from-end t))) + (and (stringp a) (stringp b)))))) (should (= 7 (cl-mismatch list list2 :key #'number-to-string :test (lambda (a b) (and (stringp a) (stringp b)))))))) @@ -461,16 +496,17 @@ Body are forms defining the test." (should (= 0 (cl-search list list2 :end1 1))) (should (= 0 (cl-search nil list2))) (should (= 2 (cl-search list list2 :start1 1 :end1 2 :end2 3))) - (should (= 0 (cl-search list list2 :test (lambda (a b) (and (numberp a) (numberp b)))))) + (should (= 0 (cl-search list list2 :test (lambda (a b) + (and (numberp a) (numberp b)))))) (should (= 0 (cl-search list list2 :key (lambda (x) (and (numberp x) 'foo)) :test (lambda (a b) (and (eq a 'foo) (eq b 'foo)))))) (should (= 1 (cl-search (nthcdr 2 list) (nthcdr 2 list2)))) (should (= 3 (cl-search (nthcdr 2 list) list2))))) (ert-deftest cl-seq-test-bug24264 () - "Test for https://debbugs.gnu.org/24264 ." + "Test for bug#24264." :tags '(:expensive-test) - (let ((list (append (make-list 8000005 1) '(8))) + (let ((list (nconc (make-list 8000005 1) '(8))) (list2 (make-list 8000005 2))) (should (cl-position 8 list)) (should-not (equal '(8) (last (cl-remove 8 list)))) @@ -488,75 +524,82 @@ Body are forms defining the test." (should (eq (cl-rassoc x a) (cadr a)))))) (ert-deftest cl-sort-test () - (let ((result (cl-sort '(3 1 4 1 5 9 2 6 5 3 5) '<))) + (let ((result (cl-sort (list 3 1 4 1 5 9 2 6 5 3 5) #'<))) (should (equal result '(1 1 2 3 3 4 5 5 5 6 9)))) - (let ((result (cl-sort '(5 3 2 8 1 4) '>))) + (let ((result (cl-sort (list 5 3 2 8 1 4) #'>))) (should (equal result '(8 5 4 3 2 1)))) - (let ((result (cl-sort '("banana" "apple" "cherry") 'string<))) + (let ((result (cl-sort (list "banana" "apple" "cherry") #'string<))) (should (equal result '("apple" "banana" "cherry")))) - (let ((result (cl-sort '("banana" "fig" "apple" "kiwi") (lambda (x y) (< (length x) (length y))) :key 'identity))) + (let ((result (cl-sort (list "banana" "fig" "apple" "kiwi") + (lambda (x y) (length< x (length y))) + :key #'identity))) (should (equal result '("fig" "kiwi" "apple" "banana")))) - (let ((result (cl-sort (vector 3 1 4 1 5) '<))) - (should (equal result (vector 1 1 3 4 5)))) - (let ((result (cl-sort '(1 2 3 4 5) '<))) + (let ((result (cl-sort (vector 3 1 4 1 5) #'<))) + (should (equal result [1 1 3 4 5]))) + (let ((result (cl-sort (list 1 2 3 4 5) #'<))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-sort '(-3 1 4 -1 -5 9) '<))) + (let ((result (cl-sort (list -3 1 4 -1 -5 9) #'<))) (should (equal result '(-5 -3 -1 1 4 9)))) - (let ((result (cl-sort '(1 2 3 4 5) (lambda (x y) (> x y))))) + (let ((result (cl-sort (list 1 2 3 4 5) #'>))) (should (equal result '(5 4 3 2 1)))) - (let ((result (cl-sort '() '<))) + (let ((result (cl-sort '() #'<))) (should (equal result '()))) - (let ((result (cl-sort '("Banana" "apple" "cherry") 'string< :key 'downcase))) + (let ((result (cl-sort (list "Banana" "apple" "cherry") + #'string< :key #'downcase))) (should (equal result '("apple" "Banana" "cherry")))) ) (ert-deftest cl-stable-sort-test () - (let ((result (cl-stable-sort '(3 1 4 1 5 9 2 6 5 3 5) '<))) + (let ((result (cl-stable-sort (list 3 1 4 1 5 9 2 6 5 3 5) #'<))) (should (equal result '(1 1 2 3 3 4 5 5 5 6 9)))) - (let ((result (cl-stable-sort '(5 3 2 8 1 4) '>))) + (let ((result (cl-stable-sort (list 5 3 2 8 1 4) #'>))) (should (equal result '(8 5 4 3 2 1)))) - (let ((result (cl-stable-sort '("banana" "apple" "cherry") 'string<))) + (let ((result (cl-stable-sort (list "banana" "apple" "cherry") #'string<))) (should (equal result '("apple" "banana" "cherry")))) - (let ((result (cl-stable-sort '("banana" "fig" "apple" "kiwi") (lambda (x y) (< (length x) (length y))) :key 'identity))) + (let ((result (cl-stable-sort (list "banana" "fig" "apple" "kiwi") + (lambda (x y) (length< x (length y))) + :key #'identity))) (should (equal result '("fig" "kiwi" "apple" "banana")))) - (let ((result (cl-stable-sort (vector 3 1 4 1 5) '<))) - (should (equal result (vector 1 1 3 4 5)))) - (let ((result (cl-stable-sort '(1 2 3 4 5) '<))) + (let ((result (cl-stable-sort (vector 3 1 4 1 5) #'<))) + (should (equal result [1 1 3 4 5]))) + (let ((result (cl-stable-sort (list 1 2 3 4 5) #'<))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-stable-sort '(-3 1 4 -1 -5 9) '<))) + (let ((result (cl-stable-sort (list -3 1 4 -1 -5 9) #'<))) (should (equal result '(-5 -3 -1 1 4 9)))) - (let ((result (cl-stable-sort '(1 2 3 4 5) (lambda (x y) (> x y))))) + (let ((result (cl-stable-sort (list 1 2 3 4 5) #'>))) (should (equal result '(5 4 3 2 1)))) - (let ((result (cl-stable-sort '() '<))) + (let ((result (cl-stable-sort '() #'<))) (should (equal result '()))) - (let ((result (cl-stable-sort '("Banana" "apple" "cherry") 'string< :key 'downcase))) + (let ((result (cl-stable-sort (list "Banana" "apple" "cherry") + #'string< :key #'downcase))) (should (equal result '("apple" "Banana" "cherry")))) ) (ert-deftest cl-merge-test () - (let ((result (cl-merge 'list '(1 3 5) '(2 4 6) '<))) + (let ((result (cl-merge 'list (list 1 3 5) (list 2 4 6) #'<))) (should (equal result '(1 2 3 4 5 6)))) - (let ((result (cl-merge 'list '(1 3 3 5) '(2 3 4 6) '<))) + (let ((result (cl-merge 'list (list 1 3 3 5) (list 2 3 4 6) #'<))) (should (equal result '(1 2 3 3 3 4 5 6)))) - (let ((result (cl-merge 'list '() '(2 4 6) '<))) + (let ((result (cl-merge 'list '() (list 2 4 6) #'<))) (should (equal result '(2 4 6)))) - (let ((result (cl-merge 'list '(1 3 5) '() '<))) + (let ((result (cl-merge 'list (list 1 3 5) '() #'<))) (should (equal result '(1 3 5)))) - (let ((result (cl-merge 'list '() '() '<))) + (let ((result (cl-merge 'list '() '() #'<))) (should (equal result '()))) - (let ((result (cl-merge 'list '(1 4 6) '(2 3 5) '< :key (lambda (x) x)))) + (let ((result (cl-merge 'list (list 1 4 6) (list 2 3 5) #'< :key #'identity))) (should (equal result '(1 2 3 4 5 6)))) - (let ((result (cl-merge 'vector (vector 1 3 5) (vector 2 4 6) '<))) - (should (equal result (vector 1 2 3 4 5 6)))) - (let ((result (cl-merge 'list '(5 3 1) '(6 4 2) '>))) + (let ((result (cl-merge 'vector (vector 1 3 5) (vector 2 4 6) #'<))) + (should (equal result [1 2 3 4 5 6]))) + (let ((result (cl-merge 'list (list 5 3 1) (list 6 4 2) #'>))) (should (equal result '(6 5 4 3 2 1)))) - (let ((result (cl-merge 'list '(1 2 3) '(1 2 3) '>))) + (let ((result (cl-merge 'list (list 1 2 3) (list 1 2 3) #'>))) (should (equal result '(1 2 3 1 2 3)))) - (let ((result (cl-merge 'list '(1 2) '(3 4 5) '<))) + (let ((result (cl-merge 'list (list 1 2) (list 3 4 5) #'<))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-merge 'list '(4 5 6) '(1 2 3) '<))) + (let ((result (cl-merge 'list (list 4 5 6) (list 1 2 3) #'<))) (should (equal result '(1 2 3 4 5 6)))) - (let ((result (cl-merge 'list '(1 2 3) '(1.5 2.5 3.5) '<))) + (let ((result (cl-merge 'list (list 1 2 3) (list 1.5 2.5 3.5) #'<))) (should (equal result '(1 1.5 2 2.5 3 3.5)))) - (let ((result (cl-merge 'list '(1 2 3) '(10 20 30) '< :key (lambda (x) (* x 10))))) + (let ((result (cl-merge 'list (list 1 2 3) (list 10 20 30) + #'< :key (lambda (x) (* x 10))))) (should (equal result '(1 2 3 10 20 30))))) (ert-deftest cl-member-test () @@ -566,45 +609,49 @@ Body are forms defining the test." (should (equal result nil))) (let ((result (cl-member 'a '(a b a c d)))) (should (equal result '(a b a c d)))) - (let ((result (cl-member "test" '("test" "not-test" "test2") :test 'string=))) + (let ((result (cl-member "test" '("test" "not-test" "test2") :test #'string=))) (should (equal result '("test" "not-test" "test2")))) - (let ((result (cl-member 'x '(a b c d) :test-not 'eq))) + (let ((result (cl-member 'x '(a b c d) :test-not #'eq))) (should (equal result '(a b c d)))) - (let ((result (cl-member 3 '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-member 3 '(1 2 3 4 5) :key #'identity))) (should (equal result '(3 4 5)))) - (let ((result (cl-member 2.5 '(1 2 2.5 3) :test 'equal))) + (let ((result (cl-member 2.5 '(1 2 2.5 3) :test #'equal))) (should (equal result '(2.5 3)))) - (let ((result (cl-member 'a '(a a a a) :test 'eq))) + (let ((result (cl-member 'a '(a a a a) :test #'eq))) (should (equal result '(a a a a)))) (let ((result (cl-member 'a '()))) (should (equal result nil))) - (let ((result (cl-member 'b '(a c d) :test-not 'eq))) + (let ((result (cl-member 'b '(a c d) :test-not #'eq))) (should (equal result '(a c d)))) - (let ((result (cl-member 3 '(1 2 3 4 5) :key '1+))) + (let ((result (cl-member 3 '(1 2 3 4 5) :key #'1+))) (should (equal result '(2 3 4 5))))) (ert-deftest cl-member-if-test () (let ((result (cl-member-if #'cl-evenp '(1 2 3 4 5)))) (should (equal result '(2 3 4 5)))) - (let ((result (cl-member-if #'(lambda (x) nil) '(1 2 3 4 5)))) + (let ((result (cl-member-if #'ignore '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-member-if #'(lambda (x) t) '(1 2 3 4 5)))) + (let ((result (cl-member-if #'always '(1 2 3 4 5)))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-member-if #'(lambda (x) (= x 1)) '(1 2 3 4 5)))) + (let ((result (cl-member-if (lambda (x) (= x 1)) '(1 2 3 4 5)))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-member-if #'(lambda (x) (and (numberp x) (cl-evenp x))) '(1 3 5 4 2)))) + (let ((result (cl-member-if (lambda (x) (and (numberp x) (cl-evenp x))) + '(1 3 5 4 2)))) (should (equal result '(4 2)))) - (let ((result (cl-member-if (lambda (x) (string= (number-to-string x) "3")) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-member-if (lambda (x) (string= (number-to-string x) "3")) + '(1 2 3 4 5) :key #'identity))) (should (equal result '(3 4 5)))) - (let ((result (cl-member-if #'(lambda (x) (eq x 'a)) '(a a a a)))) + (let ((result (cl-member-if (lambda (x) (eq x 'a)) '(a a a a)))) (should (equal result '(a a a a)))) (let ((result (cl-member-if #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-member-if #'(lambda (x) (< x 0)) '(1 2 3 4 5)))) + (let ((result (cl-member-if #'cl-minusp '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-member-if (lambda (x) (and (numberp x) (<= x 2))) '(1 "two" 3 0)))) + (let ((result (cl-member-if (lambda (x) (and (numberp x) (<= x 2))) + '(1 "two" 3 0)))) (should (equal result '(1 "two" 3 0)))) - (let ((result (cl-member-if (lambda (x) (> x 5)) '(1 2 3 6 7 8) :key 'identity))) + (let ((result (cl-member-if (lambda (x) (> x 5)) '(1 2 3 6 7 8) + :key #'identity))) (should (equal result '(6 7 8))))) (ert-deftest cl-member-if-not-test () @@ -612,23 +659,27 @@ Body are forms defining the test." (should (equal result '(1 2 3 4 5)))) (let ((result (cl-member-if-not #'cl-evenp '(2 4 6 8 10 11)))) (should (equal result '(11)))) - (let ((result (cl-member-if-not #'(lambda (x) (> x 5)) '(1 2 3 4 5)))) + (let ((result (cl-member-if-not (lambda (x) (> x 5)) '(1 2 3 4 5)))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-member-if-not #'(lambda (x) t) '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'always '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-member-if-not #'(lambda (x) (= x 1)) '(1 2 3 4 5)))) + (let ((result (cl-member-if-not (lambda (x) (= x 1)) '(1 2 3 4 5)))) (should (equal result '(2 3 4 5)))) - (let ((result (cl-member-if-not (lambda (x) (string= (number-to-string x) "2")) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-member-if-not (lambda (x) (string= (number-to-string x) "2")) + '(1 2 3 4 5) :key #'identity))) (should (equal result '(1 2 3 4 5)))) (let ((result (cl-member-if-not #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-member-if-not #'(lambda (x) (eq x 'a)) '(a a a a)))) + (let ((result (cl-member-if-not (lambda (x) (eq x 'a)) '(a a a a)))) (should (equal result nil))) - (let ((result (cl-member-if-not #'(lambda (x) (< x 0)) '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'cl-minusp '(1 2 3 4 5)))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-member-if-not #'(lambda (x) (or (numberp x) (stringp x) (eq x 'b))) '(a "b" 3 nil)))) + (let ((result (cl-member-if-not + (lambda (x) (or (numberp x) (stringp x) (eq x 'b))) + '(a "b" 3 nil)))) (should (equal result '(a "b" 3 nil)))) - (let ((result (cl-member-if-not (lambda (x) (numberp x)) '(1 "two" 3 "four" 5) :key 'identity))) + (let ((result (cl-member-if-not #'numberp '(1 "two" 3 "four" 5) + :key #'identity))) (should (equal result '("two" 3 "four" 5))))) (ert-deftest cl-assoc-test () @@ -636,13 +687,13 @@ Body are forms defining the test." (should (equal result '(b . 2)))) (let ((result (cl-assoc 'x '((a . 1) (b . 2) (c . 3))))) (should (equal result nil))) - (let ((result (cl-assoc "key" '(("key" . 1) ("not-key" . 2)) :test 'string=))) + (let ((result (cl-assoc "key" '(("key" . 1) ("not-key" . 2)) :test #'string=))) (should (equal result '("key" . 1)))) - (let ((result (cl-assoc 'a '((a . 1) (b . 2) (c . 3)) :test-not 'eq))) + (let ((result (cl-assoc 'a '((a . 1) (b . 2) (c . 3)) :test-not #'eq))) (should (equal result '(b . 2)))) - (let ((result (cl-assoc '2 '((1 . 'a) (2 . 'b) (3 . 'c)) :key 'identity))) + (let ((result (cl-assoc '2 '((1 . 'a) (2 . 'b) (3 . 'c)) :key #'identity))) (should (equal result '(2 . 'b)))) - (let ((result (cl-assoc 'a '((a . 1) (a . 2) (a . 3)) :test 'eq))) + (let ((result (cl-assoc 'a '((a . 1) (a . 2) (a . 3)) :test #'eq))) (should (equal result '(a . 1)))) (let ((result (cl-assoc 'a '()))) (should (equal result nil))) @@ -650,107 +701,195 @@ Body are forms defining the test." (should (equal result '(b . 2))))) (ert-deftest cl-assoc-if-test () - (let ((result (cl-assoc-if #'cl-evenp '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))))) + (let ((result (cl-assoc-if #'cl-evenp + '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))))) (should (equal result '(2 . "even")))) - (let ((result (cl-assoc-if #'(lambda (x) (= x 5)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if (lambda (x) (= x 5)) + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result nil))) - (let ((result (cl-assoc-if #'(lambda (x) (= x 1)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if (lambda (x) (= x 1)) + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result '(1 . "one")))) - (let ((result (cl-assoc-if #'(lambda (x) (string= x "baz")) '((foo . 1) (bar . 2) (baz . 3))))) + (let ((result (cl-assoc-if (lambda (x) (string= x "baz")) + '((foo . 1) (bar . 2) (baz . 3))))) (should (equal result '(baz . 3)))) - (let ((result (cl-assoc-if (lambda (x) (and (numberp x) (> x 2))) '((1 . "one") (3 . "three") (4 . "four"))))) + (let ((result (cl-assoc-if (lambda (x) (and (numberp x) (> x 2))) + '((1 . "one") (3 . "three") (4 . "four"))))) (should (equal result '(3 . "three")))) - (let ((result (cl-assoc-if #'(lambda (x) (> x 1)) '((0 . "zero") (1 . "one") (2 . "two"))))) + (let ((result (cl-assoc-if (lambda (x) (> x 1)) + '((0 . "zero") (1 . "one") (2 . "two"))))) (should (equal result '(2 . "two")))) (let ((result (cl-assoc-if #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-assoc-if #'(lambda (x) (eq x 'a)) '((a . "first") (a . "second") (b . "third"))))) + (let ((result (cl-assoc-if (lambda (x) (eq x 'a)) + '((a . "first") (a . "second") (b . "third"))))) (should (equal result '(a . "first")))) - (let ((result (cl-assoc-if #'(lambda (x) (and (symbolp x) (not (eq x 'b)))) '((b . "b") (c . "c") (d . "d"))))) + (let ((result (cl-assoc-if (lambda (x) (and (symbolp x) (not (eq x 'b)))) + '((b . "b") (c . "c") (d . "d"))))) (should (equal result '(c . "c")))) - (let ((result (cl-assoc-if (lambda (x) (and (listp x) (> (length x) 1))) '(((1 2) . "pair 1") ((1) . "pair 2"))))) + (let ((result (cl-assoc-if #'cdr '(((1 2) . "pair 1") ((1) . "pair 2"))))) (should (equal result '((1 2) . "pair 1"))))) (ert-deftest cl-assoc-if-not-test () - (let ((result (cl-assoc-if-not #'cl-evenp '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))))) + (let* ((alist '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))) + (result (cl-assoc-if-not #'cl-evenp alist))) (should (equal result '(1 . "odd")))) - (let ((result (cl-assoc-if-not #'(lambda (x) (> x 0)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if-not #'cl-plusp + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result nil))) - (let ((result (cl-assoc-if-not #'(lambda (x) (< x 5)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if-not (lambda (x) (< x 5)) + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result nil))) - (let ((result (cl-assoc-if-not #'(lambda (x) (= x 1)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if-not (lambda (x) (= x 1)) + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result '(2 . "two")))) - (let ((result (cl-assoc-if-not #'(lambda (x) (string= x "baz")) '((foo . "first") (bar . "second") (baz . "third"))))) + (let ((result (cl-assoc-if-not + (lambda (x) (string= x "baz")) + '((foo . "first") (bar . "second") (baz . "third"))))) (should (equal result '(foo . "first")))) - (let ((result (cl-assoc-if-not (lambda (x) (and (numberp x) (> x 2))) '((1 . "one") (3 . "three") (4 . "four"))))) + (let ((result (cl-assoc-if-not (lambda (x) (and (numberp x) (> x 2))) + '((1 . "one") (3 . "three") (4 . "four"))))) (should (equal result '(1 . "one")))) - (let ((result (cl-assoc-if-not #'(lambda (x) (symbolp x)) '((1 . "one") (b . "bee") (2 . "two"))))) + (let ((result (cl-assoc-if-not #'symbolp + '((1 . "one") (b . "bee") (2 . "two"))))) (should (equal result '(1 . "one")))) (let ((result (cl-assoc-if-not #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-assoc-if-not #'(lambda (x) (eq x 'a)) '((a . "first") (a . "second") (b . "third"))))) + (let ((result (cl-assoc-if-not (lambda (x) (eq x 'a)) + '((a . "first") (a . "second") (b . "third"))))) (should (equal result '(b . "third"))))) (ert-deftest cl-rassoc-test () - (let ((result (cl-rassoc 2 '(( "one" . 1) ("two" . 2) ("three" . 3))))) - (should (equal result (cons "two" 2)))) - (let ((result (cl-rassoc 4 '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc 2 '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc 4 '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil))) - (let ((result (cl-rassoc 2 '(( "one" . 1) ("two" . 2) ("baz" . 2)) :test 'equal))) - (should (equal result (cons "two" 2)))) - (let ((result (cl-rassoc 2 '(( "one" . 1) ("two" . 2) ("three" . 3)) :test-not 'equal))) - (should (equal result (cons "one" 1)))) + (let ((result (cl-rassoc 2 '(("one" . 1) ("two" . 2) ("baz" . 2)) + :test #'equal))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc 2 '(("one" . 1) ("two" . 2) ("three" . 3)) + :test-not #'equal))) + (should (equal result '("one" . 1)))) (let ((result (cl-rassoc 1 '()))) (should (equal result nil))) - (let ((result (cl-rassoc 1 '(( "first" . 1) ("second" . 1) ("third" . 1))))) - (should (equal result (cons "first" 1)))) - (let ((result (cl-rassoc 3 '(( "one" . 1) ("two" . 2) ("three" . 3))))) - (should (equal result (cons "three" 3)))) - (let ((result (cl-rassoc 'found '((( "pair 1") . 1) ( "pair 2" . 2) ( "pair 3" . 3))))) + (let ((result (cl-rassoc 1 '(("first" . 1) ("second" . 1) ("third" . 1))))) + (should (equal result '("first" . 1)))) + (let ((result (cl-rassoc 3 '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("three" . 3)))) + (let ((result (cl-rassoc 'found + '((("pair 1") . 1) ("pair 2" . 2) ("pair 3" . 3))))) (should (equal result nil)))) (ert-deftest cl-rassoc-if-test () - (let ((result (cl-rassoc-if #'cl-evenp '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if #'cl-evenp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("two" . 2)))) - (let ((result (cl-rassoc-if #'cl-evenp '(( "one" . 1) ("three" . 3) ("five" . 5))))) + (let ((result (cl-rassoc-if #'cl-evenp + '(("one" . 1) ("three" . 3) ("five" . 5))))) (should (equal result nil))) - (let ((result (cl-rassoc-if #'(lambda (x) (= x 1)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if (lambda (x) (= x 1)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("one" . 1)))) - (let ((result (cl-rassoc-if (lambda (x) (> x 1)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if (lambda (x) (> x 1)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("two" . 2)))) - (let ((result (cl-rassoc-if #'(lambda (x) (and (numberp x) (< x 3))) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if (lambda (x) (and (numberp x) (< x 3))) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("one" . 1)))) (let ((result (cl-rassoc-if #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-rassoc-if #'(lambda (x) (> x 0)) '(( "first" . 1) ("second" . 2) ("third" . 3))))) + (let ((result (cl-rassoc-if #'cl-plusp + '(("first" . 1) ("second" . 2) ("third" . 3))))) (should (equal result '("first" . 1)))) - (let ((result (cl-rassoc-if #'(lambda (x) (string= (number-to-string x) "two")) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if (lambda (x) (string= (number-to-string x) "two")) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil))) - (let ((result (cl-rassoc-if #'(lambda (x) (stringp x)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if #'stringp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil)))) (ert-deftest cl-rassoc-if-not-test () - (let ((result (cl-rassoc-if-not #'cl-evenp '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not #'cl-evenp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("one" . 1)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (> x 0)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not #'cl-plusp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (< x 5)) '(( "one" . 1) ("two" . 2) ("six" . 6))))) - (should (equal result '( "six" . 6)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (= x 1)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not (lambda (x) (< x 5)) + '(("one" . 1) ("two" . 2) ("six" . 6))))) + (should (equal result '("six" . 6)))) + (let ((result (cl-rassoc-if-not (lambda (x) (= x 1)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("two" . 2)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (> x 2)) '(( "one" . 1) ("two" . 1) ("three" . 3))))) + (let ((result (cl-rassoc-if-not (lambda (x) (> x 2)) + '(("one" . 1) ("two" . 1) ("three" . 3))))) (should (equal result '("one" . 1)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (and (numberp x) (< x 3))) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not (lambda (x) (and (numberp x) (< x 3))) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("three" . 3)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (equal x 2)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not (lambda (x) (equal x 2)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("one" . 1)))) (let ((result (cl-rassoc-if-not #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (numberp x)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not #'numberp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil))) - (let ((result (cl-rassoc-if-not (lambda (x) (and (listp x) (= (length x) 1))) '(((1 2) . 1) ((3 4) . 2) ((5) . 2))))) + (let ((result (cl-rassoc-if-not (lambda (x) (eql (proper-list-p x) 1)) + '(((1 2) . 1) ((3 4) . 2) ((5) . 2))))) (should (equal result '((1 2) . 1))))) +(ert-deftest cl-lib-test-set-functions () + (let ((c1 (cons nil nil)) + (c2 (cons nil nil)) + (sym (make-symbol "a"))) + (let ((e '()) + (a (list 'a 'b sym nil "" "x" c1 c2)) + (b (list c1 'y 'b sym 'x))) + (should (equal (cl-set-difference e e) e)) + (should (equal (cl-set-difference a e) a)) + (should (equal (cl-set-difference e a) e)) + (should (equal (cl-set-difference a a) e)) + (should (equal (cl-set-difference b e) b)) + (should (equal (cl-set-difference e b) e)) + (should (equal (cl-set-difference b b) e)) + ;; Note: this test (and others) is sensitive to the order of the + ;; result, which is not documented. + (should (equal (cl-set-difference a b) (list 'a nil "" "x" c2))) + (should (equal (cl-set-difference b a) (list 'y 'x))) + + ;; We aren't testing whether this is really using `eq' rather than `eql'. + (should (equal (cl-set-difference e e :test 'eq) e)) + (should (equal (cl-set-difference a e :test 'eq) a)) + (should (equal (cl-set-difference e a :test 'eq) e)) + (should (equal (cl-set-difference a a :test 'eq) e)) + (should (equal (cl-set-difference b e :test 'eq) b)) + (should (equal (cl-set-difference e b :test 'eq) e)) + (should (equal (cl-set-difference b b :test 'eq) e)) + (should (equal (cl-set-difference a b :test 'eq) (list 'a nil "" "x" c2))) + (should (equal (cl-set-difference b a :test 'eq) (list 'y 'x))) + + (should (equal (cl-union e e) e)) + (should (equal (cl-union a e) a)) + (should (equal (cl-union e a) a)) + (should (equal (cl-union a a) a)) + (should (equal (cl-union b e) b)) + (should (equal (cl-union e b) b)) + (should (equal (cl-union b b) b)) + (should (equal (cl-union a b) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) + + (should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) + + (should (equal (cl-intersection e e) e)) + (should (equal (cl-intersection a e) e)) + (should (equal (cl-intersection e a) e)) + (should (equal (cl-intersection a a) a)) + (should (equal (cl-intersection b e) e)) + (should (equal (cl-intersection e b) e)) + (should (equal (cl-intersection b b) b)) + (should (equal (cl-intersection a b) (list sym 'b c1))) + (should (equal (cl-intersection b a) (list sym 'b c1)))))) + (ert-deftest cl-intersection-test () (let ((result (cl-intersection '(1 2 3 4) '(3 4 5 6)))) (should (equal result '(4 3)))) @@ -760,9 +899,9 @@ Body are forms defining the test." (should (equal result '(1 2 3)))) (let ((result (cl-intersection '(1 1 2 3) '(1 2 2 3 4)))) (should (equal result '(3 2 1 1)))) - (let ((result (cl-intersection '(1 "two" 3) '(3 "two" 4)))) + (let ((result (cl-intersection `(1 ,(copy-sequence "two") 3) '(3 "two" 4)))) (should (equal result '(3)))) - (let ((result (cl-intersection '(1 2 3) '(3 2 1) :test 'equal))) + (let ((result (cl-intersection '(1 2 3) '(3 2 1) :test #'equal))) (should (equal result '(1 2 3)))) (let ((result (cl-intersection '(1 2 3) '(3 4 5) :key #'identity))) (should (equal result '(3)))) @@ -774,56 +913,26 @@ Body are forms defining the test." (should (equal result '(5 4 3))))) (ert-deftest cl-nintersection-test () - (let ((list1 '(1 2 3 4)) - (list2 '(3 4 5 6))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '(4 3))) - (should (equal list1 '(1 2 3 4))) - (should (equal list2 '(3 4 5 6))))) - (let ((list1 '(1 2)) - (list2 '(3 4))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '())) - (should (equal list1 '(1 2))) - (should (equal list2 '(3 4))))) - (let ((list1 '(1 2 3)) - (list2 '(1 2 3))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '(1 2 3))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(1 2 3))))) - (let ((list1 '(1 1 2 2 3)) - (list2 '(2 2 3 4))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '(3 2 2))) - (should (equal list1 '(1 1 2 2 3))) - (should (equal list2 '(2 2 3 4))))) - (let ((list1 '(1 "two" 3)) - (list2 '(3 "two" 4))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '(3))) - (should (equal list1 '(1 "two" 3))) - (should (equal list2 '(3 "two" 4))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 1))) - (let ((result (cl-nintersection list1 list2 :test 'equal))) - (should (equal result '(1 2 3))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 1))))) - (let ((list1 '()) - (list2 '(1 2 3))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '())) - (should (equal list1 '())) - (should (equal list2 '(1 2 3))))) - (let ((list1 '()) - (list2 '())) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '()))))) + (should-not (cl-nintersection () ())) + (should-not (cl-nintersection () '(1 2 3))) + (should-not (cl-nintersection (list 1 2) '(3 4))) + (should (equal (cl-nintersection (list 1 2 3 4) '(3 4 5 6)) + '(4 3))) + (should (equal (cl-nintersection (list 1 2 3) '(1 2 3)) + '(1 2 3))) + (should (equal (cl-nintersection (list 1 1 2 2 3) '(2 2 3 4)) + '(3 2 2))) + (should (equal (cl-nintersection (list 1 (copy-sequence "two") 3) + '(3 "two" 4)) + '(3))) + (should (equal (cl-nintersection (list 1 2 3) '(3 2 1) :test #'equal) + '(1 2 3)))) (ert-deftest cl-set-difference-test () - (let ((result (cl-set-difference '(1 2 3 4) '(3 4 5 6)))) - (should (equal result '(1 2)))) + ;; Our set-difference preserves order, though it is not required to + ;; by CL standards. Nevertheless better keep that invariant. + (should (equal (cl-set-difference '(1 2 3 4) '(3 4 5 6)) + '(1 2))) (let ((result (cl-set-difference '(1 2 3) '()))) (should (equal result '(1 2 3)))) (let ((result (cl-set-difference '(1 2 3) '(1 2 3)))) @@ -832,11 +941,11 @@ Body are forms defining the test." (should (equal result '(1 1 2)))) (let ((result (cl-set-difference '(1 2 3) '(3 2 4)))) (should (equal result '(1)))) - (let ((result (cl-set-difference '(1 2 3) '(3 2 1) :test 'equal))) + (let ((result (cl-set-difference '(1 2 3) '(3 2 1) :test #'equal))) (should (equal result '()))) (let ((result (cl-set-difference '((1 . "one") (2 . "two") (3 . "three")) - '((1 . "uno") (2 . "dos")) - :key 'car))) + '((1 . "uno") (2 . "dos")) + :key #'car))) (should (equal result '((3 . "three"))))) (let ((result (cl-set-difference '() '(1 2 3)))) (should (equal result '()))) @@ -844,65 +953,58 @@ Body are forms defining the test." (should (equal result '(1 2 3)))) (let ((result (cl-set-difference '(1 2 3 4 5) '(3 4 5 6 7)))) (should (equal result '(1 2)))) - (let ((list1 '(1 2 3)) - (list2 '(2 3 4))) - (cl-set-difference list1 list2) + (let ((list1 (list 1 2 3)) + (list2 (list 2 3 4))) + (should (equal (cl-set-difference list1 list2) '(1))) (should (equal list1 '(1 2 3))) (should (equal list2 '(2 3 4))))) +(ert-deftest cl-nset-difference () + ;; Our nset-difference doesn't preserve order. + (let* ((l1 (list 1 2 3 4)) (l2 (list 3 4 5 6)) + (diff (cl-nset-difference l1 l2))) + (should (memq 1 diff)) + (should (memq 2 diff)) + (should (length= diff 2)) + (should (equal l2 '(3 4 5 6)))) + (let* ((l1 (list "1" "2" "3" "4")) (l2 (list "3" "4" "5" "6")) + (diff (cl-nset-difference l1 l2 :test #'equal))) + (should (member "1" diff)) + (should (member "2" diff)) + (should (length= diff 2)) + (should (equal l2 '("3" "4" "5" "6")))) + (let* ((l1 (list '(a . 1) '(b . 2) '(c . 3) '(d . 4))) + (l2 (list '(c . 3) '(d . 4) '(e . 5) '(f . 6))) + (diff (cl-nset-difference l1 l2 :key #'car))) + (should (member '(a . 1) diff)) + (should (member '(b . 2) diff)) + (should (length= diff 2)) + (should (equal l2 '((c . 3) (d . 4) (e . 5) (f . 6))))) + (let* ((l1 (list '("a" . 1) '("b" . 2) '("c" . 3) '("d" . 4))) + (l2 (list '("c" . 3) '("d" . 4) '("e" . 5) '("f" . 6))) + (diff (cl-nset-difference l1 l2 :key #'car :test #'string=))) + (should (member '("a" . 1) diff)) + (should (member '("b" . 2) diff)) + (should (length= diff 2)) + (should (equal l2 '(("c" . 3) ("d" . 4) ("e" . 5) ("f" . 6)))))) + (ert-deftest cl-nset-difference-test () - (let ((list1 '(1 2 3 4)) - (list2 '(3 4 5 6))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1 2))) - (should (equal list1 '(1 2 3 4))) - (should (equal list2 '(3 4 5 6))))) - (let ((list1 '(1 2 3)) - (list2 '())) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1 2 3))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '())))) - (let ((list1 '(1 2 3)) - (list2 '(1 2 3))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '())) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(1 2 3))))) - (let ((list1 '(1 1 2 2 3)) - (list2 '(3 4 5))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1 1 2 2))) - (should (equal list1 '(1 1 2 2 3))) - (should (equal list2 '(3 4 5))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 4))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 4))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 1))) - (let ((result (cl-nset-difference list1 list2 :test 'equal))) - (should (equal result '())) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 1))))) - (let ((list1 '()) - (list2 '(1 2 3))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '())) - (should (equal list1 '())) - (should (equal list2 '(1 2 3))))) - (let ((list1 '()) - (list2 '())) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '())))) - (let ((list1 '(1 2 3 4 5)) - (list2 '(3 4 5 6 7))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1 2))) - (should (equal list1 '(1 2 3 4 5))) - (should (equal list2 '(3 4 5 6 7)))))) + (should-not (cl-nset-difference () ())) + (should-not (cl-nset-difference () (list 1 2 3))) + (should-not (cl-nset-difference (list 1 2 3) '(1 2 3))) + (should-not (cl-nset-difference (list 1 2 3) '(3 2 1) :test #'equal)) + (should (equal (cl-nset-difference (list 1 2 3) ()) + '(1 2 3))) + (should (equal (cl-nset-difference (list 1 2 3 4) '(3 4 5 6)) + '(1 2))) + (should (equal (cl-nset-difference (list 1 1 2 2 3) '(3 4 5)) + '(1 1 2 2))) + (should (equal (cl-nset-difference (list 1 2 3) '(3 2 4)) + '(1))) + (should (equal (cl-nset-difference (list 1 2 3 4 5) '(3 4 5 6 7)) + '(1 2))) + (should (equal (cl-nset-difference (list 1 (copy-sequence "a")) '(1 "a")) + '("a")))) (ert-deftest cl-set-exclusive-or-test () (let ((result (cl-set-exclusive-or '(1 2 3) '(3 4 5)))) @@ -919,104 +1021,51 @@ Body are forms defining the test." (should (equal result '(1 2 4 5)))) (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 4)))) (should (equal result '(1 4)))) - (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 1) :test 'equal))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 1) :test #'equal))) (should (equal result '()))) (let ((result (cl-set-exclusive-or '() '()))) (should (equal result '()))) - (let ((result (cl-set-exclusive-or '(1 2 3 4 5) '(3 4 5 6 7))) - (list1 '(1 2 3 4 5)) - (list2 '(3 4 5 6 7))) - (should (equal result '(1 2 6 7))) + (let ((list1 (list 1 2 3 4 5)) + (list2 (list 3 4 5 6 7))) + (should (equal (cl-set-exclusive-or list1 list2) '(1 2 6 7))) (should (equal list1 '(1 2 3 4 5))) (should (equal list2 '(3 4 5 6 7))))) (ert-deftest cl-nset-exclusive-or-test () - (let ((list1 '(1 2 3)) - (list2 '(3 4 5))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 4 5))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 4 5))))) - (let ((list1 '(1 2 3)) - (list2 '())) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 3))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '())))) - (let ((list1 '(1 2 3)) - (list2 '(1 2 3))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result nil))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(1 2 3)))) - (let ((list1 '(1 1 2 2 3)) - (list2 '(3 4 5))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 1 2 2 4 5))) - (should (equal list1 '(1 1 2 2 3))) - (should (equal list2 '(3 4 5))))) - (let ((list1 '(1 2 3)) - (list2 '(3 3 4 5))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 4 5))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 3 4 5))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 4))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 4))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 4))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 1))) - (let ((result (cl-nset-exclusive-or list1 list2 :test 'equal))) - (should (equal result '())) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 1))))) - (let ((list1 '()) - (list2 '(1 2 3))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 3))) - (should (equal list1 '())) - (should (equal list2 '(1 2 3))))) - (let ((list1 '()) - (list2 '())) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '())))) - (let ((list1 '(1 2 3 4 5)) - (list2 '(3 4 5 6 7))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 6 7))) - (should (equal list1 '(1 2 3 4 5))) - (should (equal list2 '(3 4 5 6 7)))))) + (should-not (cl-nset-exclusive-or () ())) + (should-not (cl-nset-exclusive-or (list 1 2 3) (list 1 2 3))) + (should-not (cl-nset-exclusive-or (list 1 2 3) (list 3 2 1) :test #'equal)) + (should (equal (cl-nset-exclusive-or (list 1 2 3) (list 3 4 5)) + '(1 2 4 5))) + (should (equal (cl-nset-exclusive-or (list 1 2 3) ()) + '(1 2 3))) + (should (equal (cl-nset-exclusive-or (list 1 1 2 2 3) (list 3 4 5)) + '(1 1 2 2 4 5))) + (should (equal (cl-nset-exclusive-or (list 1 2 3) (list 3 3 4 5)) + '(1 2 4 5))) + (should (equal (cl-nset-exclusive-or (list 1 2 3) (list 3 2 4)) + '(1 4))) + (should (equal (cl-nset-exclusive-or () (list 1 2 3)) + '(1 2 3))) + (should (equal (cl-nset-exclusive-or (list 1 2 3 4 5) (list 3 4 5 6 7)) + '(1 2 6 7)))) (ert-deftest cl-subsetp-test () - (let ((result (cl-subsetp '(1 2) '(1 2 3 4)))) - (should (equal result t))) - (let ((result (cl-subsetp '() '(1 2 3 4)))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 2) '()))) - (should (equal result nil))) - (let ((result (cl-subsetp '(1 2 3) '(1 2 3)))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 1 2) '(1 2 3)))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 2) '(1 1 2 3 4)))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 "two" 3) '(3 "two" 1)))) - (should (equal result nil))) - (let ((result (cl-subsetp '(1 2) '(2 1) :test 'equal))) - (should (equal result t))) - (let ((result (cl-subsetp '((1 . "one") (2 . "two")) '((1 . "uno") (2 . "dos")) :key 'car))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 2) '(3 4 2 1) :test 'eq))) - (should (equal result t))) - (let ((result (cl-subsetp '((1 2) (3)) '((1 2 . "found") (3 . "found")) :key 'car))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 2) '(1 2 3 2)))) - (should (equal result t))) - (let ((result (cl-subsetp '() '()))) - (should (equal result t)))) + (should (cl-subsetp '(1 2) '(1 2 3 4))) + (should (cl-subsetp () '(1 2 3 4))) + (should-not (cl-subsetp '(1 2) ())) + (should (cl-subsetp '(1 2 3) '(1 2 3))) + (should (cl-subsetp '(1 1 2) '(1 2 3))) + (should (cl-subsetp '(1 2) '(1 1 2 3 4))) + (should-not (cl-subsetp '(1 "two" 3) '(3 "two" 1))) + (should (cl-subsetp '(1 2) '(2 1) :test #'equal)) + (should (cl-subsetp '((1 . "one") (2 . "two")) + '((1 . "uno") (2 . "dos")) + :key #'car)) + (should (cl-subsetp '(1 2) '(3 4 2 1) :test #'eq)) + (should (cl-subsetp '((1 2) (3)) '((1 2 . "found") (3 . "found")) :key #'car)) + (should (cl-subsetp '(1 2) '(1 2 3 2))) + (should (cl-subsetp () ()))) (provide 'cl-seq-tests) ;;; cl-seq-tests.el ends here diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 96e37114276..676d4f2ab4a 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -333,7 +333,7 @@ Here is some more text.\" (ert-deftest lisp-fill-paragraph-as-displayed () "Test bug#56197 -- more specifically, validate that a leading indentation for a string is preserved in the filled string." - (let ((lisp-fill-paragraph-as-displayed t) ;variable under test + (let ((lisp-fill-paragraphs-as-doc-string nil) ;variable under test ;; The following is a contrived example that demonstrates the ;; fill-column problem when the string to fill is indented. (source "\ diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index f13ac3fa8d8..b779dcee393 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -826,7 +826,8 @@ but with a different end of line convention (bug#48137)." ;;; Tests for package-x features. -(require 'package-x) +(with-suppressed-warnings ((obsolete package-x)) + (require 'package-x)) (defvar package-x-test--single-archive-entry-1-3 (cons 'simple-single diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el index 1bc8c90cad6..0237bc3f9e5 100644 --- a/test/lisp/emacs-lisp/rmc-tests.el +++ b/test/lisp/emacs-lisp/rmc-tests.el @@ -61,7 +61,7 @@ (ert-deftest test-read-multiple-choice () (dolist (char '(?y ?n)) - (cl-letf* (((symbol-function #'read-event) (lambda () char)) + (cl-letf* (((symbol-function #'read-key) (lambda () char)) (str (if (eq char ?y) "yes" "no"))) (should (equal (list char str) (read-multiple-choice "Do it? " '((?y "yes") (?n "no")))))))) @@ -69,7 +69,7 @@ (ert-deftest test-read-multiple-choice-help () (let ((chars '(?o ?a)) help) - (cl-letf* (((symbol-function #'read-event) + (cl-letf* (((symbol-function #'read-key) (lambda () (message "chars %S" chars) (when (= 1 (length chars)) diff --git a/test/lisp/emacs-lisp/shortdoc-tests.el b/test/lisp/emacs-lisp/shortdoc-tests.el index 14d757711be..560221f5533 100644 --- a/test/lisp/emacs-lisp/shortdoc-tests.el +++ b/test/lisp/emacs-lisp/shortdoc-tests.el @@ -56,7 +56,7 @@ (ert-deftest shortdoc-all-groups-work () "Test that all defined shortdoc groups display correctly." - (dolist (group (mapcar (lambda (x) (car x)) shortdoc--groups)) + (dolist (group (mapcar #'car shortdoc--groups)) (let ((buf-name (format "*Shortdoc %s*" group)) buf) (unwind-protect (progn diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el index 1e57fb83672..805c41e7023 100644 --- a/test/lisp/erc/erc-nicks-tests.el +++ b/test/lisp/erc/erc-nicks-tests.el @@ -615,6 +615,8 @@ (erc-tests-common-kill-buffers)) (ert-deftest erc-nicks-track-faces/prioritize () + :tags (and (null (getenv "CI")) '(:unstable)) + (should (eq erc-nicks-track-faces 'prioritize)) (erc-nicks-tests--track-faces (lambda (set-faces assert-result add-face bob-face alice-face) diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el index 71923cc11f2..1d670b8f508 100644 --- a/test/lisp/erc/erc-scenarios-base-local-modules.el +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -117,20 +117,25 @@ (erc-cmd-QUIT "") (funcall expect 10 "finished"))) - (ert-info ("Disabling works from a target buffer") + (ert-info ("Explicit disabling affects entire session") + ;; Even though the mode variable is nil (but locally bound) in + ;; this target buffer, disabling interactively with + ;; `erc-sasl-disable', deactivates the module session-wide. (with-current-buffer "#chan" - (should erc-sasl-mode) - (call-interactively #'erc-sasl-disable) (should-not erc-sasl-mode) (should (local-variable-p 'erc-sasl-mode)) + (should (buffer-local-value 'erc-sasl-mode (get-buffer "foonet"))) + (call-interactively #'erc-sasl-disable) (should-not (buffer-local-value 'erc-sasl-mode (get-buffer "foonet"))) + (should-not erc-sasl-mode) (erc-cmd-RECONNECT) (funcall expect 10 "Some enigma, some riddle") - (should-not erc-sasl-mode) ; regression + (should-not erc-sasl-mode) (should (local-variable-p 'erc-sasl-mode))) (with-current-buffer "foonet" (should (local-variable-p 'erc-sasl-mode)) + (should-not erc-sasl-mode) (funcall expect 10 "User modes for tester`") (erc-cmd-QUIT "") (funcall expect 10 "finished"))) @@ -139,7 +144,8 @@ (with-current-buffer "#chan" (call-interactively #'erc-sasl-enable) (should (local-variable-p 'erc-sasl-mode)) - (should erc-sasl-mode) + (should-not erc-sasl-mode) + (should (buffer-local-value 'erc-sasl-mode (get-buffer "foonet"))) (erc-cmd-RECONNECT) (funcall expect 10 "Well met; good morrow, Titus and Hortensius.") (erc-cmd-QUIT "")) diff --git a/test/lisp/erc/erc-scenarios-services-misc.el b/test/lisp/erc/erc-scenarios-services-misc.el index 823c97dd96b..13d66a54d3a 100644 --- a/test/lisp/erc/erc-scenarios-services-misc.el +++ b/test/lisp/erc/erc-scenarios-services-misc.el @@ -223,6 +223,31 @@ ;; Works with "given" `:id'. (should (and (erc-network) (not (eq (erc-network) 'ExampleNet))))))) +(ert-deftest erc-scenarios-services-misc--regain-command/oftc () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-server-flood-penalty 0.1) + (erc-scenarios-common-dialog "services/regain") + (dumb-server (erc-d-run "localhost" t 'taken-regain-oftc)) + (port (process-contact dumb-server :service)) + (erc-modules `(services-regain ,@erc-modules)) + (erc-services-regain-timeout-seconds 1) + (use-id-p (cl-evenp (truncate (float-time)))) + (erc-services-regain-alist (list (cons (if use-id-p 'oftc 'OFTC) + #'erc-services-issue-regain))) + (expect (erc-d-t-make-expecter))) + + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "dummy" + :user "tester" + :full-name "tester" + :id (and use-id-p 'oftc)) + (funcall expect 10 "Nickname dummy is already in use, trying dummy`") + (funcall expect 10 "-NickServ- REGAIN succeed on nickname") + (funcall expect 10 "*** Your new nickname is dummy") + (funcall expect 10 "*** dummy has changed mode for dummy to +R")))) + (ert-deftest erc-scenarios-services-misc--ghost-and-retry-nick () :tags '(:expensive-test) (erc-scenarios-common-with-cleanup diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index df9e4d52f77..2279496e600 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3558,12 +3558,23 @@ (should (eq (erc--normalize-module-symbol 'nickserv) 'services))) (defun erc-tests--assert-printed-in-subprocess (code expected) - (let ((proc (erc-tests-common-create-subprocess code '("-batch") nil))) - (while (accept-process-output proc 10)) - (goto-char (point-min)) - (unless (equal (read (current-buffer)) expected) - (message "Expected: %S\nGot: %s" expected (buffer-string)) - (ert-fail "Mismatch")))) + "Assert result emitted to standard output from CODE matches EXPECTED. +Expect CODE to print result using `prin1' as a list beginning with the +keyword :result." + (with-current-buffer + (get-buffer-create + (concat "*" (symbol-name (ert-test-name (ert-running-test))) "*")) + (unwind-protect + (let ((proc (erc-tests-common-create-subprocess code '("-batch") nil))) + (while (accept-process-output proc 10)) + (goto-char (point-min)) + (search-forward "(:result " nil t) + (unless (equal (ignore-errors (read (current-buffer))) expected) + (ert-fail (list "Mismatch" + :expected expected + :buffer-string (buffer-string))))) + (when noninteractive + (kill-buffer))))) ;; Worrying about which library a module comes from is mostly not ;; worth the hassle so long as ERC can find its minor mode. However, @@ -3573,25 +3584,25 @@ (ert-deftest erc--find-mode () (erc-tests--assert-printed-in-subprocess - `(let ((mods (mapcar #'cadddr (cdddr (get 'erc-modules 'custom-type)))) + '(let ((mods (mapcar #'cadddr (cdddr (get 'erc-modules 'custom-type)))) moded) (setq mods (sort mods (lambda (a b) (if (zerop (random 2)) a b)))) (dolist (mod mods) (unless (keywordp mod) (push (if-let* ((mode (erc--find-mode mod))) mod (list :missing mod)) moded))) - (message "%S" - (sort moded (lambda (a b) - (string< (symbol-name a) (symbol-name b)))))) + (prin1 (list :result + (sort moded (lambda (a b) + (string< (symbol-name a) (symbol-name b))))))) erc-tests--modules)) (ert-deftest erc--essential-hook-ordering () (erc-tests--assert-printed-in-subprocess '(progn (erc-update-modules) - (message "%S" - (list :erc-insert-modify-hook erc-insert-modify-hook - :erc-send-modify-hook erc-send-modify-hook))) + (prin1 (list :result + (list :erc-insert-modify-hook erc-insert-modify-hook + :erc-send-modify-hook erc-send-modify-hook)))) '( :erc-insert-modify-hook (erc-controls-highlight ; 0 erc-button-add-buttons ; 30 diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 236fac84132..eedea8c44de 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -356,15 +356,17 @@ interspersing \"-l\" between members." (require 'erc) (cl-assert (equal erc-version ,erc-version) t) ,code)) - (proc (apply #'start-process - (symbol-name (ert-test-name (ert-running-test))) - (current-buffer) - (concat invocation-directory invocation-name) - `(,@(or init '("-Q")) - ,@switches - ,@(mapcan (lambda (f) (list "-l" f)) libs) - "-eval" ,(format "%S" prog))))) - (set-process-query-on-exit-flag proc t) + (proc (make-process + :name (symbol-name (ert-test-name (ert-running-test))) + :buffer (current-buffer) + :command `(,(concat invocation-directory invocation-name) + ,@(or init '("-Q")) + ,@switches + ,@(mapcan (lambda (f) (list "-l" f)) libs) + "-eval" ,(format "%S" prog)) + :connection-type 'pipe + :stderr (messages-buffer) + :noquery t))) proc)) (declare-function erc-track--setup "erc-track" ()) diff --git a/test/lisp/erc/resources/services/regain/taken-regain-oftc.eld b/test/lisp/erc/resources/services/regain/taken-regain-oftc.eld new file mode 100644 index 00000000000..c6fa09dc45c --- /dev/null +++ b/test/lisp/erc/resources/services/regain/taken-regain-oftc.eld @@ -0,0 +1,42 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK dummy")) +((user 10 "USER tester 0 * :tester") + (0.09 ":reflection.oftc.net NOTICE AUTH :*** Looking up your hostname...") + (0.03 ":reflection.oftc.net NOTICE AUTH :*** Checking Ident") + (0.02 ":reflection.oftc.net NOTICE AUTH :*** Found your hostname") + (0.01 ":reflection.oftc.net NOTICE AUTH :*** No Ident response") + (0.01 ":reflection.oftc.net 433 * dummy :Nickname is already in use.")) +((nick 10 "NICK dummy`") + (0.09 ":reflection.oftc.net NOTICE dummy` :*** Connected securely via TLSv1.3 TLS_AES_256_GCM_SHA384-256") + (0.03 ":reflection.oftc.net NOTICE dummy` :*** Your client certificate fingerprint is 4F6DDB61A5CFFA42719D39E3819B45DC58E4E307") + (0.01 ":reflection.oftc.net 001 dummy` :Welcome to the OFTC Internet Relay Chat Network dummy`") + (0.01 ":reflection.oftc.net 002 dummy` :Your host is reflection.oftc.net[64.86.243.183/6697], running version hybrid-7.2.2+oftc1.7.3") + (0.01 ":reflection.oftc.net 003 dummy` :This server was created Nov 1 2023 at 10:10:46") + (0.00 ":reflection.oftc.net 004 dummy` reflection.oftc.net hybrid-7.2.2+oftc1.7.3 CDGPRSabcdfgijklnorsuwxyz bciklmnopstvzeIMRS bkloveI") + (0.01 ":reflection.oftc.net 005 dummy` CALLERID CASEMAPPING=rfc1459 DEAF=D KICKLEN=160 MODES=4 NICKLEN=30 PREFIX=(ov)@+ STATUSMSG=@+ TOPICLEN=391 NETWORK=OFTC MAXLIST=beI:100 MAXTARGETS=1 CHANTYPES=# :are supported by this server") + (0.03 ":reflection.oftc.net 005 dummy` CHANLIMIT=#:250 CHANNELLEN=50 CHANMODES=eIqb,k,l,cimnpstzMRS AWAYLEN=160 KNOCK ELIST=CMNTU SAFELIST EXCEPTS=e INVEX=I :are supported by this server") + (0.01 ":reflection.oftc.net 042 dummy` 8L3AAEM45 :your unique ID") + (0.00 ":reflection.oftc.net 251 dummy` :There are 31 users and 16297 invisible on 19 servers") + (0.00 ":reflection.oftc.net 252 dummy` 20 :IRC Operators online") + (0.00 ":reflection.oftc.net 253 dummy` 25 :unknown connection(s)") + (0.00 ":reflection.oftc.net 254 dummy` 4118 :channels formed") + (0.00 ":reflection.oftc.net 255 dummy` :I have 1245 clients and 1 servers") + (0.00 ":reflection.oftc.net 265 dummy` :Current local users: 1245 Max: 1782") + (0.00 ":reflection.oftc.net 266 dummy` :Current global users: 16328 Max: 19479") + (0.00 ":reflection.oftc.net 250 dummy` :Highest connection count: 1783 (1782 clients) (203288 connections received)") + (0.03 ":reflection.oftc.net 375 dummy` :- reflection.oftc.net Message of the Day - ") + (0.00 ":reflection.oftc.net 372 dummy` :- O") + (0.00 ":reflection.oftc.net 372 dummy` :- Thanks and enjoy your stay! The OFTC team.") + (0.00 ":reflection.oftc.net 376 dummy` :End of /MOTD command.") + (0.03 ":dummy`!~tester@static-198-54-134-141.cust.tzulo.com MODE dummy` :+i")) +((mode 10 "MODE dummy` +i") + (0.00 ":CTCPServ!services@services.oftc.net PRIVMSG dummy` :\1VERSION\1")) +((~notice 10 "NOTICE CTCPServ :\1VERSION \2ERC\2")) +((privmsg 10 "PRIVMSG NickServ :REGAIN dummy") + (0.01 ":NickServ!services@services.oftc.net NOTICE dummy` :REGAIN succeed on nickname \2dummy\2. You have been changed to your nickname.") + (0.05 ":dummy`!~tester@static-198-54-134-141.cust.tzulo.com NICK :dummy") + (0.01 ":dummy MODE dummy :+R") + (0.04 ":dummy MODE dummy :-R") + (0.01 ":dummy MODE dummy :+R")) +((quit 10 "QUIT :\2ERC\2 5") + (0.08 "ERROR :Closing Link: static-198-54-134-141.cust.tzulo.com ()")) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index e085d052e1c..7f06c37a408 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1680,6 +1680,22 @@ The door of all subtleties! (should-not (eq (files-tests--check-mode "gdbinit.5") #'gdb-script-mode)) (should-not (eq (files-tests--check-mode ".gdbinit.py.in") #'gdb-script-mode))) +(ert-deftest files-tests--bug75961 () + (let* ((auto-mode-alist (cons '("\\.text\\'" text-mode t) auto-mode-alist)) + (called-fun nil) + (fun (lambda () (setq called-fun t)))) + (with-temp-buffer + (setq buffer-file-name "foo.text") + (normal-mode) + (should (derived-mode-p 'text-mode)) + (add-hook 'text-mode-hook fun) + (setq buffer-file-name "foo.html.text") + (should (not called-fun)) + (normal-mode) + (remove-hook 'text-mode-hook fun) + (should called-fun) + (should (derived-mode-p 'html-mode))))) + (defvar sh-shell) (defun files-tests--check-shebang (shebang expected-mode &optional expected-dialect) @@ -1973,7 +1989,7 @@ FN-TEST is the function to test: either `save-some-buffers' or `save-some-buffers-default-predicate' let-bound to a value specified inside ARGS-RESULTS. -During the call to FN-TEST,`read-event' is overridden with a function that +During the call to FN-TEST,`read-key' is overridden with a function that just returns `n' and `kill-emacs' is overridden to do nothing. ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where @@ -2004,7 +2020,7 @@ CALLERS-DIR specifies the value to let-bind (setq nb-saved-buffers 0) (with-current-buffer (car buffers) (cl-letf - (((symbol-function 'read-event) + (((symbol-function 'read-key) ;; Increase counter and answer 'n' when prompted ;; to save a buffer. (lambda (&rest _) (cl-incf nb-saved-buffers) ?n)) diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 67fc9d96c9c..4f65db028e4 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -44,52 +44,56 @@ Return first line of the output of (describe-function-1 FUNC)." (ert-deftest help-fns-test-bug17410 () "Test for https://debbugs.gnu.org/17410 ." (let ((regexp "autoloaded Lisp macro") - (result (help-fns-tests--describe-function 'help-fns-test--macro))) + (result (help-fns-tests--describe-function #'help-fns-test--macro))) (should (string-match regexp result)))) (ert-deftest help-fns-test-built-in () (let ((regexp "a primitive-function in .C source code") - (result (help-fns-tests--describe-function 'mapcar))) + (result (help-fns-tests--describe-function #'mapcar))) (should (string-match regexp result)))) (ert-deftest help-fns-test-interactive-built-in () (let ((regexp "an interactive primitive-function in .C source code") - (result (help-fns-tests--describe-function 're-search-forward))) + (result (help-fns-tests--describe-function #'re-search-forward))) (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-macro () (let ((regexp "a Lisp macro in .+subr\\.el") - (result (help-fns-tests--describe-function 'when))) + (result (help-fns-tests--describe-function #'when))) (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-defun () (let ((regexp "a \\([^ ]+\\) in .+subr\\.el") - (result (help-fns-tests--describe-function 'last))) + (result (help-fns-tests--describe-function #'last))) (should (string-match regexp result)) (should (member (match-string 1 result) '("native-comp-function" "byte-code-function"))))) (ert-deftest help-fns-test-lisp-defsubst () (let ((regexp "a byte-code-function in .+subr\\.el") - (result (help-fns-tests--describe-function 'posn-window))) + (result (help-fns-tests--describe-function #'posn-window))) (should (string-match regexp result)))) (ert-deftest help-fns-test-alias-to-defun () (let ((regexp "an alias for .set-file-modes. in .+subr\\.el") - (result (help-fns-tests--describe-function 'chmod))) + (result (help-fns-tests--describe-function #'chmod))) (should (string-match regexp result)))) (ert-deftest help-fns-test-bug23887 () "Test for https://debbugs.gnu.org/23887 ." (let ((regexp "an alias for .re-search-forward. in .+subr\\.el") - (result (help-fns-tests--describe-function 'search-forward-regexp))) + (result (help-fns-tests--describe-function #'search-forward-regexp))) (should (string-match regexp result)))) -(ert-deftest help-fns-test-dangling-alias () - "Make sure we don't burp on bogus aliases." - (let ((f (make-symbol "bogus-alias"))) - (define-obsolete-function-alias f 'help-fns-test--undefined-function "past") - (describe-symbol f))) +(ert-deftest help-fns-test-bug76172 () + "No error when describing `menu-bar-open-mouse'." + (should (stringp (help-fns-tests--describe-function #'menu-bar-open-mouse)))) + +(ert-deftest help-fns-test-bug76179 () + "No error when describing `bindat--type'." + (require 'bindat) + (should (stringp (help-fns-tests--describe-function 'bindat--type)))) + ;;; Test describe-function over functions with funny names (defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x) @@ -127,12 +131,18 @@ Return first line of the output of (describe-function-1 FUNC)." (goto-char (point-min)) (should (looking-at "^font-lock-comment-face is ")))) -(defvar foo-test-map) -(defvar help-fns-test--describe-keymap-foo) +(ert-deftest help-fns-test-dangling-alias () + "Make sure we don't burp on bogus aliases." + (let ((f (make-symbol "bogus-alias"))) + (define-obsolete-function-alias f 'help-fns-test--undefined-function "past") + (describe-symbol f))) ;;; Tests for describe-keymap +(defvar foo-test-map) +(defvar help-fns-test--describe-keymap-foo) + (defvar-keymap help-fns-test-map "a" 'test-cmd-a "b" 'test-cmd-b diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1077b944f0a..3be81449c9c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -152,7 +152,8 @@ tramp-copy-size-limit nil tramp-error-show-message-timeout nil tramp-persistency-file-name nil - tramp-verbose 0) + tramp-verbose 0 + vc-handled-backends nil) (defconst tramp-test-name-prefix "tramp-test" "Prefix to use for temporary test files.") @@ -251,20 +252,20 @@ being the result.") (file-writable-p ert-remote-temporary-file-directory)))))) (when (cdr tramp--test-enabled-checked) - ;; Remove old test files. - (dolist (dir `(,temporary-file-directory - ,tramp-compat-temporary-file-directory - ,ert-remote-temporary-file-directory)) - (dolist (file (directory-files - dir 'full - (rx-to-string - `(: bos (? ".#") - (| ,tramp-test-name-prefix - ,(if (getenv "TRAMP_TEST_CLEANUP_TEMP_FILES") - tramp-temp-name-prefix 'unmatchable)))))) + (ignore-errors + ;; Remove old test files. + (dolist (dir `(,temporary-file-directory + ,tramp-compat-temporary-file-directory + ,ert-remote-temporary-file-directory)) + (dolist (file (directory-files + dir 'full + (rx-to-string + `(: bos (? ".#") + (| ,tramp-test-name-prefix + ,(if (getenv "TRAMP_TEST_CLEANUP_TEMP_FILES") + tramp-temp-name-prefix 'unmatchable)))))) - ;; Exclude sockets and FUSE mount points. - (ignore-errors + ;; Exclude sockets and FUSE mount points. (unless (or (string-prefix-p "srw" (file-attribute-modes (file-attributes file))) diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el index e24163c3884..ecf23c5d037 100644 --- a/test/lisp/proced-tests.el +++ b/test/lisp/proced-tests.el @@ -38,10 +38,10 @@ (defun proced--cpu-at-point () "Return as an integer the current CPU value at point." (if (string-suffix-p "nan" (thing-at-point 'sexp)) - (let ((pid (proced-pid-at-point))) - (ert-skip - (format - "Found NaN value for %%CPU at point for process with PID %d" pid))) + (ert-skip + (format + "Found NaN value for %%CPU at point for process with PID %s" + (substring-no-properties (thing-at-point 'sexp)))) (thing-at-point 'number))) (defun proced--assert-emacs-pid-in-buffer () @@ -61,6 +61,7 @@ (proced--move-to-column "%CPU") (condition-case err (>= (proced--cpu-at-point) cpu) + (ert-test-skipped (signal (car err) (cdr err))) (error (ert-fail (list err (proced--assert-process-valid-cpu-refinement-explainer cpu)))))) diff --git a/test/lisp/progmodes/go-ts-mode-resources/font-lock-package.go b/test/lisp/progmodes/go-ts-mode-resources/font-lock-package.go new file mode 100644 index 00000000000..7bee6848810 --- /dev/null +++ b/test/lisp/progmodes/go-ts-mode-resources/font-lock-package.go @@ -0,0 +1,4 @@ +replace gnu.org/go/package1 v1.0.0 => gnu.org/go/package2 v1.0.0 +// ^ font-lock-keyword-face +// ^ font-lock-number-face +// ^ font-lock-operator-face diff --git a/test/lisp/progmodes/go-ts-mode-resources/indent-mod.erts b/test/lisp/progmodes/go-ts-mode-resources/indent-mod.erts new file mode 100644 index 00000000000..2f7bfd9030b --- /dev/null +++ b/test/lisp/progmodes/go-ts-mode-resources/indent-mod.erts @@ -0,0 +1,16 @@ +Code: + (lambda () + (go-mod-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Basic + +=-= +require ( + gnu.org/go/package1 v1.0.0 + gnu.org/go/package2 v1.0.0 +) + +=-=-= diff --git a/test/lisp/progmodes/go-ts-mode-resources/indent-work.erts b/test/lisp/progmodes/go-ts-mode-resources/indent-work.erts new file mode 100644 index 00000000000..b210974cedc --- /dev/null +++ b/test/lisp/progmodes/go-ts-mode-resources/indent-work.erts @@ -0,0 +1,16 @@ +Code: + (lambda () + (go-work-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Basic + +=-= +use ( + ./package1 + ./package2 +) + +=-=-= diff --git a/test/lisp/progmodes/go-ts-mode-tests.el b/test/lisp/progmodes/go-ts-mode-tests.el index 2837d5d23d2..abd0f5f94eb 100644 --- a/test/lisp/progmodes/go-ts-mode-tests.el +++ b/test/lisp/progmodes/go-ts-mode-tests.el @@ -23,6 +23,8 @@ (require 'ert-x) (require 'treesit) +;; go-ts-mode + (ert-deftest go-ts-mode-test-indentation () (skip-unless (treesit-ready-p 'go)) (ert-test-erts-file (ert-resource-file "indent.erts"))) @@ -32,5 +34,27 @@ (let ((treesit-font-lock-level 4)) (ert-font-lock-test-file (ert-resource-file "font-lock.go") 'go-ts-mode))) +;; go-mod-ts-mode + +(ert-deftest go-mod-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'gomod)) + (ert-test-erts-file (ert-resource-file "indent-mod.erts"))) + +(ert-deftest go-mod-ts-test-font-lock () + (skip-unless (treesit-ready-p 'gomod)) + (let ((treesit-font-lock-level 4)) + (ert-font-lock-test-file (ert-resource-file "font-lock-package.go") 'go-mod-ts-mode))) + +;; go-work-ts-mode + +(ert-deftest go-work-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'gowork)) + (ert-test-erts-file (ert-resource-file "indent-work.erts"))) + +(ert-deftest go-work-ts-test-font-lock () + (skip-unless (treesit-ready-p 'gowork)) + (let ((treesit-font-lock-level 4)) + (ert-font-lock-test-file (ert-resource-file "font-lock-package.go") 'go-work-ts-mode))) + (provide 'go-ts-mode-tests) ;;; go-ts-mode-tests.el ends here diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index ec0a836cb8f..898e2b036e0 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -3204,6 +3204,30 @@ d = '''d''' (python-tests-look-at "c'") (pos-eol)))))) +(ert-deftest python-nav-end-of-statement-5 () + "Test long multi-line string (Bug#75387)." + (let* ((line (format "%s\n" (make-string 80 ?a))) + (lines (apply #'concat (make-list 50 line)))) + (python-tests-with-temp-buffer + (concat + " +s = ''' +" + lines + "\\'''" + lines + "''' +a = 1 +") + (python-tests-look-at "s = '''") + (should (= (save-excursion + (python-nav-end-of-statement) + (point)) + (save-excursion + (python-tests-look-at "a = 1") + (forward-line -1) + (pos-eol))))))) + (ert-deftest python-nav-forward-statement-1 () (python-tests-with-temp-buffer " diff --git a/test/lisp/savehist-tests.el b/test/lisp/savehist-tests.el new file mode 100644 index 00000000000..7e4437a75a9 --- /dev/null +++ b/test/lisp/savehist-tests.el @@ -0,0 +1,106 @@ +;;; savehist-tests.el --- Tests for savehist.el -*- lexical-binding:t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Stephane Marks + +;; 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 . + +;;; Commentary: + +;; These tests emulate what `read-from-minibuffer' would do via +;; `savehist-minibuffer-hook' without calling `read-from-minibuffer'. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'savehist) + +(ert-deftest savehist-test-saved-variables () + ;; These accommodate symbol-value. + (defvar savehist-tests--t1) + (defvar savehist-tests--t2) + (ert-with-temp-file tmpfile + (let* ((savehist-file tmpfile) + (savehist-save-minibuffer-history t) + (savehist-save-hook) + (savehist-loaded) + (savehist-minibuffer-history-variables) + (savehist-additional-variables '(savehist-tests--t2)) + (savehist-ignored-variables '(t3)) + (savehist-tests--t1 '("t1-value")) + (savehist-tests--t2 '("t2-value")) + (t3 '("t3-value")) + (t1-copy (copy-tree savehist-tests--t1)) + (t2-copy (copy-tree savehist-tests--t2)) + (_t3-copy (copy-tree t3)) + (save-var (lambda (x) + (let ((minibuffer-history-variable x)) + (savehist-minibuffer-hook))))) + (savehist-mode) + (funcall save-var 'savehist-tests--t1) + (funcall save-var 'savehist-tests--t2) + (funcall save-var 't3) ; should be ignored + (savehist-save) + (setq savehist-tests--t1 nil savehist-tests--t2 nil t3 nil) + (progn + ;; Force reloading the file. + (savehist-mode -1) + (setq savehist-loaded nil) + (savehist-mode)) + (should (equal savehist-tests--t1 t1-copy)) + (should (equal savehist-tests--t2 t2-copy)) + (should (equal t3 nil))))) + +(ert-deftest savehist-test-duplicated-saved-symbols () + (defvar savehist-tests--t1) + (defvar savehist-tests--t2) + (ert-with-temp-file tmpfile + (let* ((savehist-file tmpfile) + (savehist-save-minibuffer-history t) + (savehist-save-hook) + (savehist-loaded) + ;; Will be '(savehist-tests--t2 savehist-tests--t1) + (savehist-minibuffer-history-variables) + ;; `savehist-tests--t2' should not be saved twice. + (savehist-additional-variables '(savehist-tests--t2)) + (savehist-tests--t1 '("t1-value")) + (savehist-tests--t2 '("t2-value")) + (save-var (lambda (x) + (let ((minibuffer-history-variable x)) + (savehist-minibuffer-hook))))) + (savehist-mode) + (funcall save-var 'savehist-tests--t1) + (funcall save-var 'savehist-tests--t2) + (savehist-save) + (progn + ;; Force reloading the file. + (savehist-mode -1) + (setq savehist-loaded nil) + (savehist-mode)) + (let ((saved-variables)) + (with-temp-buffer + (insert-file-contents tmpfile) + (goto-char 1) + ;; alnum bypasses savehist-minibuffer-history-variables + (while (re-search-forward "(setq \\([[:alnum:]]+\\) " nil t 1) + (push (match-string 1) saved-variables))) + (should (= (length saved-variables) + (length (seq-uniq saved-variables #'equal)))))))) + +(provide 'savehist-tests) +;;; savehist-tests.el ends here diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index c59ae9f5356..f4fcce3e957 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -138,6 +138,31 @@ (iter-yield-from (time-stamp-test-pattern-sequential)) (iter-yield-from (time-stamp-test-pattern-multiply))) +(ert-deftest time-stamp-custom-start () + "Test that `time-stamp' isn't stuck by a start matching 0 characters." + (with-time-stamp-test-env + (with-time-stamp-test-time ref-time1 + (let ((time-stamp-pattern "^%Y-%m-%d<-TS")) ;start matches 0 chars + (with-temp-buffer + (insert "\n<-TS\n") + ;; we should advance to line 2 and find the template + (time-stamp) + (should (equal (buffer-string) "\n2006-01-02<-TS\n")))) + (let ((time-stamp-pattern "\\b%Y-%m-%d\\b") ;start and end match 0 chars + (time-stamp-count 2)) + (with-temp-buffer + (insert "..") + ;; the two time stamps should be in different places + (time-stamp) + (should (equal (buffer-string) "2006-01-02..2006-01-02")))) + (let ((time-stamp-pattern "::%S\\_>") ;end matches 0 chars + (time-stamp-count 2)) + (with-temp-buffer + (insert "::0::0") + ;; the second template should be found immediately after the first + (time-stamp) + (should (equal (buffer-string) "::05::05"))))))) + (ert-deftest time-stamp-custom-pattern () "Test that `time-stamp-pattern' is parsed correctly." (iter-do (pattern-parts (time-stamp-test-pattern-all)) @@ -246,17 +271,17 @@ (let ((time-stamp-start "TS: <") (time-stamp-format "%Y-%m-%d") (time-stamp-count 0) ;changed later in the test - (buffer-expected-once "TS: <2006-01-02>\nTS: <>") - (buffer-expected-twice "TS: <2006-01-02>\nTS: <2006-01-02>")) + (buffer-expected-once "TS: <2006-01-02>TS: <>") + (buffer-expected-twice "TS: <2006-01-02>TS: <2006-01-02>")) (with-time-stamp-test-time ref-time1 (with-temp-buffer - (insert "TS: <>\nTS: <>") + (insert "TS: <>TS: <>") (time-stamp) ;; even with count = 0, expect one time stamp (should (equal (buffer-string) buffer-expected-once))) (with-temp-buffer (setq time-stamp-count 1) - (insert "TS: <>\nTS: <>") + (insert "TS: <>TS: <>") (time-stamp) (should (equal (buffer-string) buffer-expected-once)) @@ -344,13 +369,12 @@ ;; broken in 2019, changed in 2024 (should (equal (time-stamp-string "%-A" ref-time1) Monday)) (should (equal (time-stamp-string "%_A" ref-time1) Monday)) - ;; allowed but not recommended since 2019 (warned 1997-2019) - (should (equal (time-stamp-string "%^A" ref-time1) MONDAY)) ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 (should (equal (time-stamp-string "%a" ref-time1) Mon)) (should (equal (time-stamp-string "%4a" ref-time1) p4-Mon)) (should (equal (time-stamp-string "%04a" ref-time1) p4-Mon)) (should (equal (time-stamp-string "%A" ref-time1) Monday)) + (should (equal (time-stamp-string "%^A" ref-time1) MONDAY)) ;; warned 1997-2019, changed in 2019 (should (equal (time-stamp-string "%^a" ref-time1) MON)) (should (equal (time-stamp-string "%^4a" ref-time1) p4-MON)) @@ -401,13 +425,12 @@ ;; broken in 2019, changed in 2024 (should (equal (time-stamp-string "%-B" ref-time1) January)) (should (equal (time-stamp-string "%_B" ref-time1) January)) - ;; allowed but not recommended since 2019 (warned 1997-2019) - (should (equal (time-stamp-string "%^B" ref-time1) JANUARY)) ;; warned 1997-2019, changed in 2019, recommended (with caveat) since 2024 (should (equal (time-stamp-string "%b" ref-time1) Jan)) (should (equal (time-stamp-string "%4b" ref-time1) p4-Jan)) (should (equal (time-stamp-string "%04b" ref-time1) p4-Jan)) (should (equal (time-stamp-string "%B" ref-time1) January)) + (should (equal (time-stamp-string "%^B" ref-time1) JANUARY)) ;; warned 1997-2019, changed in 2019 (should (equal (time-stamp-string "%^b" ref-time1) JAN)) (should (equal (time-stamp-string "%^4b" ref-time1) p4-JAN)) @@ -490,7 +513,7 @@ (should (equal (time-stamp-string "%:I" ref-time1) "3")) ;PM (should (equal (time-stamp-string "%:I" ref-time2) "12")) ;PM (should (equal (time-stamp-string "%:I" ref-time3) "6")) ;AM - ;; implemented since 1997, recommended since 2019 + ;; implemented since 1997, recommended 2019-2024 (should (equal (time-stamp-string "%1I" ref-time1) "3")) (should (equal (time-stamp-string "%1I" ref-time2) "12")) (should (equal (time-stamp-string "%1I" ref-time3) "6")) @@ -517,7 +540,7 @@ ;; recommended 1997-2019 (should (equal (time-stamp-string "%:m" ref-time1) "1")) (should (equal (time-stamp-string "%:m" ref-time2) "11")) - ;; implemented since 1997, recommended since 2019 + ;; implemented since 1997, recommended 2019-2024 (should (equal (time-stamp-string "%1m" ref-time1) "1")) (should (equal (time-stamp-string "%1m" ref-time2) "11")) ;; warned 1997-2019, allowed 2019, recommended (with caveat) since 2024 @@ -540,7 +563,7 @@ ;; recommended 1997-2019 (should (equal (time-stamp-string "%:M" ref-time1) "4")) (should (equal (time-stamp-string "%:M" ref-time2) "14")) - ;; implemented since 1997, recommended since 2019 + ;; implemented since 1997, recommended 2019-2024 (should (equal (time-stamp-string "%1M" ref-time1) "4")) (should (equal (time-stamp-string "%1M" ref-time2) "14")) ;; warned 1997-2019, allowed 2019, recommended (with caveat) since 2024 @@ -563,7 +586,7 @@ ;; recommended 1997-2019 (should (equal (time-stamp-string "%:S" ref-time1) "5")) (should (equal (time-stamp-string "%:S" ref-time2) "15")) - ;; implemented since 1997, recommended since 2019 + ;; implemented since 1997, recommended 2019-2024 (should (equal (time-stamp-string "%1S" ref-time1) "5")) (should (equal (time-stamp-string "%1S" ref-time2) "15")) ;; warned 1997-2019, allowed 2019, recommended (with caveat) since 2024 @@ -586,10 +609,12 @@ (should (equal (time-stamp-string "%:y" ref-time1) "2006"))) (time-stamp-should-warn (should (equal (time-stamp-string "%:y" ref-time2) "2016"))) - ;; warned 1997-2019, changed in 2019 - ;; (We don't expect the %-y or %_y form to be useful, - ;; but we test both so that we can confidently state that - ;; `-' and `_' affect all 2-digit conversions identically.) + ;; %-y and %_y warned 1997-2019, changed in 2019 + ;; (We don't expect these forms to be useful, + ;; but we test here so that we can confidently state that + ;; all 2-digit conversions behave identically.) + (should (equal (time-stamp-string "%1y" ref-time1) "6")) + (should (equal (time-stamp-string "%1y" ref-time2) "16")) (should (equal (time-stamp-string "%-y" ref-time1) "6")) (should (equal (time-stamp-string "%-y" ref-time2) "16")) (should (equal (time-stamp-string "%_y" ref-time1) " 6")) @@ -619,6 +644,8 @@ (am (format-time-string "%P" ref-time3 t)) (Pm (format-time-string "%p" ref-time1 t)) (Am (format-time-string "%p" ref-time3 t)) + (Pm-tc (capitalize (format-time-string "%p" ref-time1 t))) + (Am-tc (capitalize (format-time-string "%p" ref-time3 t))) (PM (format-time-string "%^p" ref-time1 t)) (AM (format-time-string "%^p" ref-time3 t))) ;; implemented and recommended since 1997 @@ -644,6 +671,11 @@ (should (equal (time-stamp-string "%^#P" ref-time3) am)) (should (equal (time-stamp-string "%^P" ref-time1) "")) (should (equal (time-stamp-string "%^P" ref-time3) "")) + ;; implemented since 2025 + (should (equal (time-stamp-string "%*p" ref-time1) Pm-tc)) + (should (equal (time-stamp-string "%*p" ref-time3) Am-tc)) + (should (equal (time-stamp-string "%*P" ref-time1) Pm-tc)) + (should (equal (time-stamp-string "%*P" ref-time3) Am-tc)) ;; reserved for possible adding or removing periods (dots) (should (equal (time-stamp-string "%:p" ref-time1) Pm)) (should (equal (time-stamp-string "%#:p" ref-time1) pm)) @@ -667,6 +699,7 @@ "Test `time-stamp' format %Z." (with-time-stamp-test-env (let ((UTC-abbr (format-time-string "%Z" ref-time1 t)) + (Utc-abbr (capitalize (format-time-string "%Z" ref-time1 t))) (utc-abbr (format-time-string "%#Z" ref-time1 t))) ;; implemented and recommended since 1995 (should (equal (time-stamp-string "%Z" ref-time1) UTC-abbr)) @@ -674,7 +707,10 @@ (should (equal (time-stamp-string "%#Z" ref-time1) utc-abbr)) ;; ^ accepted and ignored since 1995/1997, test for consistency with %p (should (equal (time-stamp-string "%^Z" ref-time1) UTC-abbr)) - (should (equal (time-stamp-string "%^#Z" ref-time1) utc-abbr))))) + (should (equal (time-stamp-string "%^#Z" ref-time1) utc-abbr)) + ;; implemented since 2025 + (should (equal (time-stamp-string "%*Z" ref-time1) Utc-abbr)) + ))) (ert-deftest time-stamp-format-time-zone-offset () "Test `time-stamp' legacy format %z and spot-test new offset format %5z." @@ -687,7 +723,7 @@ (should (equal (time-stamp-string "%5z" ref-time1) "+0000")) (let ((time-stamp-time-zone "PST8")) (should (equal (time-stamp-string "%5z" ref-time1) "-0800"))) - (let ((time-stamp-time-zone "HST10")) + (let ((time-stamp-time-zone '(-36000 "HST"))) (should (equal (time-stamp-string "%5z" ref-time1) "-1000"))) (let ((time-stamp-time-zone "CET-1")) (should (equal (time-stamp-string "%5z" ref-time1) "+0100"))) @@ -876,6 +912,7 @@ (should (safe-local-variable-p 'time-stamp-inserts-lines t)) (should-not (safe-local-variable-p 'time-stamp-inserts-lines 17)) (should (safe-local-variable-p 'time-stamp-count 2)) + (should-not (safe-local-variable-p 'time-stamp-count 100)) (should-not (safe-local-variable-p 'time-stamp-count t)) (should (safe-local-variable-p 'time-stamp-pattern "a string")) (should-not (safe-local-variable-p 'time-stamp-pattern 17))) diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index 06309160e52..cd3f613f532 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -389,26 +389,26 @@ baz")))) 124 127 (face diff-context)))) ;; Test diff-font-lock-syntax. - (should (equal (mapcar (lambda (o) - (list (- (overlay-start o) diff-beg) - (- (overlay-end o) diff-beg) - (append (and (overlay-get o 'diff-mode) - `(diff-mode ,(overlay-get o 'diff-mode))) - (and (overlay-get o 'face) - `(face ,(overlay-get o 'face)))))) + (should (equal + (delq nil + (mapcar (lambda (o) + (when (overlay-get o 'face) + (list (- (overlay-start o) diff-beg) + (- (overlay-end o) diff-beg) + `( diff-mode ,(overlay-get o 'diff-mode) + face ,(overlay-get o 'face))))) (sort (overlays-in (point-min) (point-max)) - (lambda (a b) (< (overlay-start a) (overlay-start b))))) - '((0 127 (diff-mode fine)) - (0 127 (diff-mode syntax)) - (17 25 (diff-mode syntax face font-lock-preprocessor-face)) - (26 35 (diff-mode syntax face font-lock-string-face)) - (37 40 (diff-mode syntax face font-lock-type-face)) - (41 45 (diff-mode syntax face font-lock-function-name-face)) - (61 78 (diff-mode syntax face font-lock-string-face)) - (69 74 (diff-mode fine face diff-refine-removed)) - (91 108 (diff-mode syntax face font-lock-string-face)) - (99 104 (diff-mode fine face diff-refine-added)) - (114 120 (diff-mode syntax face font-lock-keyword-face)))))))) + (lambda (a b) + (< (overlay-start a) (overlay-start b)))))) + '((17 25 (diff-mode syntax face font-lock-preprocessor-face)) + (26 35 (diff-mode syntax face font-lock-string-face)) + (37 40 (diff-mode syntax face font-lock-type-face)) + (41 45 (diff-mode syntax face font-lock-function-name-face)) + (61 78 (diff-mode syntax face font-lock-string-face)) + (69 74 (diff-mode fine face diff-refine-removed)) + (91 108 (diff-mode syntax face font-lock-string-face)) + (99 104 (diff-mode fine face diff-refine-added)) + (114 120 (diff-mode syntax face font-lock-keyword-face)))))))) (ert-deftest diff-mode-test-font-lock-syntax-one-line () "Check diff syntax highlighting for one line with no newline at end." diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el index c18e6d14c4c..e34aa64f8d1 100644 --- a/test/lisp/wid-edit-tests.el +++ b/test/lisp/wid-edit-tests.el @@ -430,4 +430,55 @@ return nil, even with a non-nil bubblep argument." (should-not (overlay-buffer field-overlay)) (should-not (overlay-buffer field-end-overlay))))) +;; The following two tests are for Bug#69941. Markers need to be prepared +;; against "inside" insertions at them. That is, a recreated child should +;; still be covered by the parent's :from and :to markers. +(ert-deftest widget-test-insertion-at-parent-markers () + "Test that recreating a child keeps the parent's markers covering it. + +Test the most common situation, where only one parent needs to be adjusted." + (with-temp-buffer + (let* ((group (widget-create 'group + :format "%v" + '(item :value 1 :format "%v"))) + (item (car (widget-get group :children))) + (ofrom (marker-position (widget-get group :from))) + (oto (marker-position (widget-get group :to)))) + (widget-insert "\n") + (widget-setup) + ;; Change item, without recreating the group. This causes changes + ;; right at the :from and :to markers, and if they don't have + ;; the right type, the group's :from-:to span won't include its + ;; child, the item widget, anymore. + (widget-value-set item 2) + ;; The positions should be the same as they were when the group + ;; widget was first created. + (should (= ofrom (widget-get group :from))) + (should (= oto (widget-get group :to)))))) + +(ert-deftest widget-test-insertion-at-parent-markers-2 () + "Test that recreating a child keeps the parent's marker covering it. + +Test the uncommon situation in which we might need to prepare the grandparent's +markers (and so on) as well." + (with-temp-buffer + (let* ((group (widget-create '(group + :format "%v" + (group + :format "%v" + (item :value 1 :format "%v"))))) + (group2 (car (widget-get group :children))) + (item (car (widget-get group2 :children))) + (ofrom (marker-position (widget-get group :from))) + (oto (marker-position (widget-get group :to))) + (ofrom2 (marker-position (widget-get group2 :from))) + (oto2 (marker-position (widget-get group2 :to)))) + (widget-insert "\n") + (widget-setup) + (widget-value-set item 2) + (should (= ofrom (widget-get group :from))) + (should (= oto (widget-get group :to))) + (should (= ofrom2 (widget-get group2 :from))) + (should (= oto2 (widget-get group2 :to)))))) + ;;; wid-edit-tests.el ends here diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 9fff4255b57..8d4e7bc48fa 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -534,4 +534,14 @@ 'utf-8 nil (current-buffer)) (should (null (sanity-check-change-functions-errors)))))) +(ert-deftest editfns-tests-styled-print () + "Test bug#75754." + (let* ((print-unreadable-function + (lambda (&rest _args) + (garbage-collect) + (make-string 100 ?Ā t))) + (str "\"[1] ĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀĀ\"")) + (should (string= (format "%S" (format "%S %S" [1] (symbol-function '+))) + str)))) + ;;; editfns-tests.el ends here