[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/positioned-lambdas ec0da344694 2/3: Merge branch 'master' into f
|
From: |
Alan Mackenzie |
|
Subject: |
feature/positioned-lambdas ec0da344694 2/3: Merge branch 'master' into feature/positioned-lambdas |
|
Date: |
Sun, 10 Mar 2024 14:53:05 -0400 (EDT) |
branch: feature/positioned-lambdas
commit ec0da3446945f56972ddd625ec5d2a055dfd44a6
Merge: 569fc297b85 d7071359522
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>
Merge branch 'master' into feature/positioned-lambdas
---
.dir-locals.el | 12 +-
.mailmap | 6 +-
BUGS | 4 +
CONTRIBUTE | 46 +-
ChangeLog.3 | 4 +-
GNUmakefile | 50 +-
Makefile.in | 2 +
admin/CPP-DEFINES | 15 +-
admin/authors.el | 3 +
admin/codespell/codespell.exclude | 2 +
admin/gitmerge.el | 8 +-
admin/merge-gnulib | 2 +-
admin/notes/kind-communication | 21 +
admin/notes/tree-sitter/build-module/build.sh | 2 +-
admin/syncdoc-type-hierarchy.el | 125 +
configure.ac | 16 +-
cross/verbose.mk.android | 13 +-
doc/emacs/android.texi | 309 ++-
doc/emacs/buffers.texi | 2 +-
doc/emacs/display.texi | 8 +
doc/emacs/help.texi | 5 +
doc/emacs/text.texi | 6 +
doc/lispref/Makefile.in | 10 +-
doc/lispref/abbrevs.texi | 2 +-
doc/lispref/control.texi | 10 +
doc/lispref/display.texi | 9 +-
doc/lispref/elisp.texi | 2 +
doc/lispref/elisp_type_hierarchy.jpg | Bin 0 -> 345570 bytes
doc/lispref/elisp_type_hierarchy.txt | 33 +
doc/lispref/functions.texi | 13 +-
doc/lispref/intro.texi | 6 +-
doc/lispref/minibuf.texi | 22 +-
doc/lispref/modes.texi | 140 +-
doc/lispref/objects.texi | 29 +-
doc/lispref/package.texi | 48 +
doc/lispref/parsing.texi | 33 +-
doc/lispref/symbols.texi | 82 +-
doc/lispref/windows.texi | 40 +-
doc/misc/epa.texi | 9 +
doc/misc/erc.texi | 33 +-
doc/misc/eshell.texi | 703 ++++--
doc/misc/eww.texi | 9 +
doc/misc/gnus.texi | 14 +-
doc/misc/texinfo.tex | 37 +-
doc/misc/tramp.texi | 56 +-
doc/translations/README | 211 ++
doc/{lang => translations}/fr/misc/ses-fr.texi | 0
etc/ERC-NEWS | 21 +-
etc/NEWS | 285 ++-
etc/NEWS.25 | 5 +
etc/PROBLEMS | 47 +-
etc/TODO | 16 -
etc/emacs_lldb.py | 1 +
etc/images/README | 7 +-
etc/images/conceal.pbm | Bin 0 -> 41 bytes
etc/images/conceal.svg | 4 +
etc/images/reveal.pbm | Bin 0 -> 41 bytes
etc/images/reveal.svg | 4 +
java/AndroidManifest.xml.in | 126 +
java/debug.sh | 13 +-
java/org/gnu/emacs/EmacsActivity.java | 36 +-
java/org/gnu/emacs/EmacsContextMenu.java | 17 +-
java/org/gnu/emacs/EmacsService.java | 90 +-
java/org/gnu/emacs/EmacsWindow.java | 101 +-
leim/Makefile.in | 6 +-
lib-src/Makefile.in | 4 +-
lib/gnulib.mk.in | 5 +-
lib/limits.in.h | 2 +-
lib/nstrftime.c | 1501 +-----------
lib/{nstrftime.c => strftime.c} | 575 ++++-
lib/strftime.h | 73 +-
lib/time.in.h | 6 +-
lib/time_r.c | 5 +
lib/warn-on-use.h | 4 +
lib/xalloc-oversized.h | 3 +-
lisp/abbrev.el | 5 +-
lisp/align.el | 9 +-
lisp/allout.el | 6 +-
lisp/auth-source.el | 2 +-
lisp/bind-key.el | 1 +
lisp/buff-menu.el | 115 +-
lisp/cedet/mode-local.el | 4 +-
lisp/cedet/semantic/lex-spp.el | 6 +-
lisp/cedet/semantic/lex.el | 4 +-
lisp/cedet/semantic/symref/grep.el | 6 -
lisp/comint.el | 2 +-
lisp/completion-preview.el | 24 +-
lisp/completion.el | 8 +-
lisp/cus-edit.el | 35 +
lisp/cus-start.el | 1 +
lisp/dired.el | 5 +
lisp/emacs-lisp/byte-opt.el | 3 +-
lisp/emacs-lisp/bytecomp.el | 40 +-
lisp/emacs-lisp/cconv.el | 12 +-
lisp/emacs-lisp/check-declare.el | 116 +-
lisp/emacs-lisp/checkdoc.el | 2 +-
lisp/emacs-lisp/cl-extra.el | 56 +-
lisp/emacs-lisp/cl-generic.el | 141 +-
lisp/emacs-lisp/cl-macs.el | 18 +-
lisp/emacs-lisp/cl-preloaded.el | 201 +-
lisp/emacs-lisp/comp-common.el | 7 +-
lisp/emacs-lisp/comp-cstr.el | 83 +-
lisp/emacs-lisp/comp-run.el | 34 +-
lisp/emacs-lisp/comp.el | 1069 ++++-----
lisp/emacs-lisp/compat.el | 92 +
lisp/emacs-lisp/disass.el | 39 +-
lisp/emacs-lisp/easy-mmode.el | 2 +-
lisp/emacs-lisp/edebug.el | 29 +-
lisp/emacs-lisp/eieio-core.el | 98 +-
lisp/emacs-lisp/eieio.el | 16 +-
lisp/emacs-lisp/eldoc.el | 4 +-
lisp/emacs-lisp/elint.el | 1 +
lisp/emacs-lisp/find-func.el | 1 +
lisp/emacs-lisp/lisp-mode.el | 1 -
lisp/emacs-lisp/loaddefs-gen.el | 73 +-
lisp/emacs-lisp/map.el | 28 +-
lisp/emacs-lisp/oclosure.el | 7 +-
lisp/emacs-lisp/package-vc.el | 19 +-
lisp/emacs-lisp/package.el | 3 +-
lisp/emacs-lisp/pcase.el | 57 +-
lisp/emacs-lisp/seq.el | 4 +-
lisp/emacs-lisp/shortdoc.el | 33 +-
lisp/emacs-lisp/shorthands.el | 34 +-
lisp/emacs-lisp/tabulated-list.el | 68 +-
lisp/emacs-lisp/trace.el | 2 +-
lisp/emulation/viper.el | 1 -
lisp/epa-ks.el | 3 -
lisp/epa.el | 34 +-
lisp/erc/erc-backend.el | 24 +-
lisp/erc/erc-common.el | 2 +-
lisp/erc/erc-compat.el | 48 +-
lisp/erc/erc-fill.el | 64 +-
lisp/erc/erc-speedbar.el | 5 +-
lisp/erc/erc-stamp.el | 1 +
lisp/erc/erc.el | 124 +-
lisp/eshell/em-glob.el | 36 +-
lisp/eshell/em-unix.el | 8 +-
lisp/eshell/esh-arg.el | 2 +-
lisp/eshell/esh-ext.el | 6 +-
lisp/eshell/esh-mode.el | 18 +-
lisp/eshell/esh-opt.el | 62 +-
lisp/eshell/esh-util.el | 51 +-
lisp/eshell/esh-var.el | 2 +-
lisp/ffap.el | 4 +-
lisp/files.el | 56 +-
lisp/filesets.el | 44 +-
lisp/follow.el | 1 +
lisp/forms.el | 2 +-
lisp/gnus/gnus-agent.el | 13 +-
lisp/gnus/gnus-art.el | 2 +-
lisp/gnus/gnus-dired.el | 9 +-
lisp/gnus/gnus-msg.el | 4 +-
lisp/gnus/gnus-score.el | 11 +-
lisp/gnus/gnus-util.el | 3 +-
lisp/gnus/gnus.el | 30 +-
lisp/gnus/nnheader.el | 2 +-
lisp/help-fns.el | 97 +-
lisp/help-mode.el | 12 +-
lisp/help.el | 33 +-
lisp/htmlfontify.el | 1 +
lisp/ielm.el | 29 +
lisp/iimage.el | 1 +
lisp/image.el | 75 +-
lisp/info-look.el | 5 +-
lisp/info.el | 35 +-
lisp/international/titdic-cnv.el | 119 +-
lisp/language/japan-util.el | 4 +-
lisp/language/japanese.el | 2 +-
lisp/ldefs-boot.el | 2466 ++++++++++----------
lisp/leim/quail/latin-post.el | 50 +
lisp/leim/quail/vnvni.el | 54 +-
lisp/loadup.el | 2 +
lisp/locate.el | 6 +-
lisp/mail/mail-extr.el | 2 +-
lisp/mail/mailabbrev.el | 12 +-
lisp/mail/rmail.el | 182 +-
lisp/mail/rmailkwd.el | 2 +-
lisp/menu-bar.el | 9 +
lisp/minibuffer.el | 19 +-
lisp/mouse.el | 14 +-
lisp/mpc.el | 13 +-
lisp/net/browse-url.el | 8 +-
lisp/net/dictionary.el | 44 +-
lisp/net/dns.el | 2 +-
lisp/net/eww.el | 125 +-
lisp/net/imap.el | 8 +-
lisp/net/tramp-adb.el | 45 +-
lisp/net/tramp-androidsu.el | 561 +++++
lisp/net/tramp-archive.el | 4 +-
lisp/net/tramp-cache.el | 105 +-
lisp/net/tramp-compat.el | 4 +-
lisp/net/tramp-container.el | 60 +-
lisp/net/tramp-gvfs.el | 7 +-
lisp/net/tramp-integration.el | 2 +-
lisp/net/tramp-message.el | 4 +
lisp/net/tramp-sh.el | 67 +-
lisp/net/tramp-sshfs.el | 4 +-
lisp/net/tramp-sudoedit.el | 2 +-
lisp/net/tramp.el | 87 +-
lisp/obarray.el | 25 +-
lisp/obsolete/eieio-compat.el | 5 +-
lisp/obsolete/iswitchb.el | 4 +-
lisp/obsolete/longlines.el | 14 +-
lisp/obsolete/pgg.el | 4 +-
lisp/obsolete/rcompile.el | 14 +-
lisp/org/org-macs.el | 2 +-
lisp/org/org.el | 2 +-
lisp/org/ox-beamer.el | 5 +-
lisp/org/ox-koma-letter.el | 4 +-
lisp/org/ox-latex.el | 7 +-
lisp/org/ox.el | 2 +-
lisp/outline.el | 28 +-
lisp/play/cookie1.el | 2 +-
lisp/proced.el | 2 +-
lisp/progmodes/c-ts-mode.el | 63 +-
lisp/progmodes/cc-defs.el | 4 +-
lisp/progmodes/cc-langs.el | 2 +-
lisp/progmodes/cc-mode.el | 22 +-
lisp/progmodes/cmake-ts-mode.el | 20 +-
lisp/progmodes/cperl-mode.el | 16 +-
lisp/progmodes/csharp-mode.el | 2 +
lisp/progmodes/dockerfile-ts-mode.el | 2 +
lisp/progmodes/eglot.el | 186 +-
lisp/progmodes/elisp-mode.el | 44 +-
lisp/progmodes/elixir-ts-mode.el | 58 +-
lisp/progmodes/etags.el | 7 +-
lisp/progmodes/flymake.el | 20 +-
lisp/progmodes/gdb-mi.el | 6 +-
lisp/progmodes/go-ts-mode.el | 6 +
lisp/progmodes/gud.el | 10 +-
lisp/progmodes/heex-ts-mode.el | 12 +
lisp/progmodes/hideif.el | 14 +-
lisp/progmodes/hideshow.el | 3 +
lisp/progmodes/idlw-shell.el | 4 +-
lisp/progmodes/java-ts-mode.el | 15 +-
lisp/progmodes/js.el | 2 +
lisp/progmodes/json-ts-mode.el | 2 +
lisp/progmodes/lua-ts-mode.el | 20 +-
lisp/progmodes/modula2.el | 47 +-
lisp/progmodes/opascal.el | 2 +-
lisp/progmodes/perl-mode.el | 11 +-
lisp/progmodes/project.el | 14 +-
lisp/progmodes/python.el | 252 +-
lisp/progmodes/ruby-ts-mode.el | 30 +-
lisp/progmodes/rust-ts-mode.el | 2 +
lisp/progmodes/sh-script.el | 2 +
lisp/progmodes/typescript-ts-mode.el | 366 +--
lisp/progmodes/verilog-mode.el | 114 +-
lisp/progmodes/vhdl-mode.el | 76 +-
lisp/progmodes/which-func.el | 4 +-
lisp/replace.el | 4 +-
lisp/server.el | 6 +-
lisp/simple.el | 81 +
lisp/speedbar.el | 2 +-
lisp/startup.el | 39 +-
lisp/subr.el | 63 +-
lisp/tab-bar.el | 13 +-
lisp/term/android-win.el | 58 +-
lisp/textmodes/css-mode.el | 2 +
lisp/textmodes/html-ts-mode.el | 13 +
lisp/textmodes/reftex-vars.el | 5 +-
lisp/textmodes/rst.el | 8 +-
lisp/textmodes/tex-mode.el | 61 +-
lisp/textmodes/text-mode.el | 2 +-
lisp/textmodes/toml-ts-mode.el | 2 +
lisp/textmodes/yaml-ts-mode.el | 2 +
lisp/thingatpt.el | 44 +-
lisp/touch-screen.el | 2 +-
lisp/transient.el | 1 -
lisp/treesit.el | 112 +-
lisp/url/url-cid.el | 11 +-
lisp/url/url-http.el | 2 +-
lisp/url/url-ldap.el | 10 +-
lisp/url/url-mailto.el | 17 +-
lisp/vc/diff-mode.el | 173 +-
lisp/vc/vc-git.el | 11 +-
lisp/vc/vc-hooks.el | 5 +-
lisp/vc/vc.el | 30 +-
lisp/vcursor.el | 2 +-
lisp/window.el | 65 +-
lisp/winner.el | 3 +-
m4/gnulib-common.m4 | 76 +-
m4/gnulib-comp.m4 | 3 +-
m4/nanosleep.m4 | 6 +-
m4/nstrftime.m4 | 5 +-
m4/utimens.m4 | 15 +-
m4/utimensat.m4 | 5 +-
nt/cmdproxy.c | 8 +
nt/gnulib-cfg.mk | 1 +
src/alloc.c | 36 +-
src/android.c | 210 +-
src/android.h | 9 +
src/androidfns.c | 106 +-
src/androidgui.h | 12 +-
src/androidselect.c | 20 +-
src/androidterm.c | 23 +-
src/androidvfs.c | 32 +-
src/bidi.c | 3 +-
src/buffer.c | 82 +-
src/buffer.h | 2 -
src/bytecode.c | 37 +-
src/ccl.c | 7 +-
src/comp.c | 6 +-
src/composite.c | 26 +-
src/conf_post.h | 4 +
src/data.c | 27 +-
src/editfns.c | 85 +-
src/emacs.c | 4 -
src/fileio.c | 10 +-
src/fns.c | 204 +-
src/inotify.c | 10 +
src/keyboard.c | 26 +-
src/lisp.h | 310 ++-
src/lread.c | 437 ++--
src/marker.c | 15 +-
src/minibuf.c | 110 +-
src/pdumper.c | 68 +-
src/pgtkterm.c | 4 +-
src/print.c | 10 +
src/process.c | 33 +-
src/sfnt.c | 10 +-
src/sfntfont.c | 6 +-
src/sysdep.c | 25 +-
src/textconv.c | 10 +-
src/thread.c | 39 +
src/thread.h | 11 +
src/timefns.c | 12 +-
src/treesit.c | 4 +-
src/verbose.mk.in | 29 +-
src/window.c | 82 +-
src/xdisp.c | 320 ++-
src/xfaces.c | 35 +-
test/Makefile.in | 4 +
test/infra/Dockerfile.emba | 2 +-
test/lisp/abbrev-tests.el | 4 +-
test/lisp/auth-source-tests.el | 139 +-
test/lisp/completion-preview-tests.el | 15 +
.../warn-wide-docstring-defun.el | 3 +-
test/lisp/emacs-lisp/bytecomp-tests.el | 19 +
test/lisp/emacs-lisp/cl-generic-tests.el | 14 +
test/lisp/emacs-lisp/comp-cstr-tests.el | 2 +-
test/lisp/emacs-lisp/edebug-tests.el | 22 +-
.../eieio-tests/eieio-test-methodinvoke.el | 2 +-
test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 28 +-
test/lisp/emacs-lisp/macroexp-resources/vk.el | 2 +-
test/lisp/emacs-lisp/tabulated-list-tests.el | 41 +
test/lisp/erc/erc-button-tests.el | 3 +-
test/lisp/erc/erc-fill-tests.el | 5 +-
test/lisp/erc/erc-goodies-tests.el | 4 +-
test/lisp/erc/erc-networks-tests.el | 1 +
test/lisp/erc/erc-scenarios-base-renick.el | 8 +-
test/lisp/erc/erc-scenarios-misc-commands.el | 90 +
test/lisp/erc/erc-stamp-tests.el | 6 +-
test/lisp/erc/erc-tests.el | 76 +-
test/lisp/erc/resources/commands/amsg-barnet.eld | 54 +
test/lisp/erc/resources/commands/amsg-foonet.eld | 56 +
test/lisp/erc/resources/erc-scenarios-common.el | 4 +-
test/lisp/eshell/em-glob-tests.el | 30 +
test/lisp/eshell/esh-opt-tests.el | 24 +-
test/lisp/eshell/eshell-tests.el | 2 +-
test/lisp/filenotify-tests.el | 53 +-
test/lisp/files-tests.el | 51 +-
test/lisp/info-tests.el | 16 +-
test/lisp/international/mule-tests.el | 4 +-
test/lisp/minibuffer-tests.el | 7 +
test/lisp/net/eww-tests.el | 180 ++
test/lisp/net/tramp-archive-tests.el | 4 +-
test/lisp/net/tramp-tests.el | 116 +-
test/lisp/obarray-tests.el | 31 +-
test/lisp/progmodes/cperl-mode-tests.el | 19 +
.../progmodes/java-ts-mode-resources/indent.erts | 31 +
test/lisp/progmodes/python-tests.el | 146 +-
test/lisp/thingatpt-tests.el | 9 +
test/src/comp-resources/comp-test-funcs.el | 4 +-
test/src/eval-tests.el | 37 +-
test/src/minibuf-tests.el | 14 +-
test/src/treesit-tests.el | 2 +-
377 files changed, 12177 insertions(+), 7156 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 1f08c882e0b..b34949ae961 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -23,16 +23,20 @@
(electric-quote-string . nil)
(indent-tabs-mode . t)
(mode . bug-reference-prog)))
+ (java-mode . ((c-file-style . "GNU")
+ (electric-quote-comment . nil)
+ (electric-quote-string . nil)
+ (indent-tabs-mode . t)
+ (mode . bug-reference-prog)))
(objc-mode . ((c-file-style . "GNU")
(electric-quote-comment . nil)
(electric-quote-string . nil)
(mode . bug-reference-prog)))
- (c-ts-mode . ((c-ts-mode-indent-style . gnu)
- (indent-tabs-mode . t)
- (mode . bug-reference-prog)))
+ (c-ts-mode . ((c-ts-mode-indent-style . gnu))) ;Inherits `c-mode' settings.
(log-edit-mode . ((log-edit-font-lock-gnu-style . t)
(log-edit-setup-add-author . t)
- (vc-git-log-edit-summary-target-len . 50)))
+ (vc-git-log-edit-summary-target-len . 50)
+ (fill-column . 64)))
(change-log-mode . ((add-log-time-zone-rule . t)
(fill-column . 74)
(mode . bug-reference)))
diff --git a/.mailmap b/.mailmap
index 18e55b0d1e7..c9bdede6c73 100644
--- a/.mailmap
+++ b/.mailmap
@@ -116,6 +116,7 @@ Lars Ingebrigtsen <larsi@gnus.org> <larsi@quimbies.gnus.org>
Lars Ingebrigtsen <larsi@gnus.org> <larsi@stories.gnus.org>
Laurence Warne <laurencewarne@gmail.com>
Lin Sun <lin.sun@zoom.us>
+Liu Hui <liuhui1610@gmail.com> <ilupin@users.noreply.github.com>
Ludovic Courtès <ludo@gnu.org>
Luke Lee <luke.yx.lee@gmail.com>
Martin Rudalics <rudalics@gmx.at>
@@ -129,7 +130,7 @@ Maxim Nikulin <manikulin@gmail.com>
Michael Albinus <michael.albinus@gmx.de> <albinus@detlef>
Michalis V <mvar.40k@gmail.com>
Miha Rihtaršič <miha@kamnitnik.top>
-Morgan J. Smith <Morgan.J.Smith@outlook.com>
+Morgan Smith <Morgan.J.Smith@outlook.com>
Nick Drozd <nicholasdrozd@gmail.com>
Nicolas Petton <nicolas@petton.fr> <petton.nicolas@gmail.com>
Nitish Chandra <nitishchandrachinta@gmail.com>
@@ -146,8 +147,7 @@ Philip Kaludercic <philipk@posteo.net>
Philip Kaludercic <philipk@posteo.net> <philip.kaludercic@fau.de>
Philip Kaludercic <philipk@posteo.net> <philip@icterid>
Philip Kaludercic <philipk@posteo.net> <philip@warpmail.net>
-Philipp Stephani <phst@google.com>
-Philipp Stephani <phst@google.com> Philipp Stephani <p.stephani2@gmail.com>
+Philipp Stephani <p.stephani2@gmail.com>
Phillip Lord <phillip.lord@russet.org.uk> <phillip.lord@newcastle.ac.uk>
Pierre Lorenzon <devel@pollock-nageoire.net>
Pieter van Oostrum <pieter@vanoostrum.org> <pieter-l@vanoostrum.org>
diff --git a/BUGS b/BUGS
index ee473213c89..f23faa7c756 100644
--- a/BUGS
+++ b/BUGS
@@ -21,6 +21,10 @@ If necessary, you can read the manual without an info
program:
cat info/emacs* | more "+/^File: emacs.*, Node: Bugs,"
+If you think you may have found a critical security issue that needs
+to be communicated privately, please contact the GNU Emacs maintainers
+directly. See admin/MAINTAINERS for their contact details.
+
Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to
make sure it isn't a known issue.
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 70b9760bb99..bdee16eeab4 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -115,9 +115,10 @@ mode after hiding the body of each entry.
Doc-strings should be updated together with the code.
-New defcustom's should always have a ':version' tag stating the first
-Emacs version in which they will appear. Likewise with defcustom's
-whose value is changed -- update their ':version' tag.
+New defcustom's and defface's should always have a ':version' tag
+stating the first Emacs version in which they will appear. Likewise
+with defcustom's or defface's whose value is changed -- update their
+':version' tag.
Think about whether your change requires updating the manuals. If you
know it does not, mark the NEWS entry with "---" before the entry. If
@@ -170,9 +171,9 @@ test 'out-of-tree' builds as well, i.e.:
** Commit messages
-Ordinarily, a change you commit should contain a log entry in its
-commit message and should not touch the repository's ChangeLog files.
-Here is an example commit message (indented):
+Ordinarily, a changeset you commit should contain a description of the
+changes in its commit message and should not touch the repository's
+ChangeLog files. Here is an example commit message (indented):
Deactivate shifted region
@@ -184,8 +185,9 @@ Here is an example commit message (indented):
Deactivate the mark.
Occasionally, commit messages are collected and prepended to a
-ChangeLog file, where they can be corrected. It saves time to get
-them right the first time, so here are guidelines for formatting them:
+generated ChangeLog file, where they can be corrected. It saves time
+to get them right the first time, so here are guidelines for
+formatting them:
- Start with a single unindented summary line explaining the change;
do not end this line with a period. If possible, try to keep the
@@ -194,9 +196,10 @@ them right the first time, so here are guidelines for
formatting them:
contexts.
If the summary line starts with a semicolon and a space "; ", the
- commit message will be ignored when generating the ChangeLog file.
- Use this for minor commits that do not need separate ChangeLog
- entries, such as changes in etc/NEWS.
+ commit message will be skipped and not added to the generated
+ ChangeLog file. Use this for minor commits that do not need to be
+ mentioned in the ChangeLog file, such as changes in etc/NEWS, typo
+ fixes, etc.
- After the summary line, there should be an empty line.
@@ -211,8 +214,9 @@ them right the first time, so here are guidelines for
formatting them:
enforced by a commit hook.
- If only a single file is changed, the summary line can be the normal
- file first line (starting with the asterisk). Then there is no
- individual files section.
+ first line of a ChangeLog entry (starting with the asterisk). Then
+ there will be no individual ChangeLog entries beyond the one in the
+ summary line.
- If the commit has more than one author, the commit message should
contain separate lines to mention the other authors, like the
@@ -243,12 +247,12 @@ them right the first time, so here are guidelines for
formatting them:
- Explaining the rationale for a design choice is best done in comments
in the source code. However, sometimes it is useful to describe just
the rationale for a change; that can be done in the commit message
- between the summary line and the file entries.
+ between the summary line and the following ChangeLog entries.
-- Emacs generally follows the GNU coding standards for ChangeLogs: see
- https://www.gnu.org/prep/standards/html_node/Change-Logs.html
- or run 'info "(standards)Change Logs"'. One exception is that
- commits still sometimes quote `like-this' (as the standards used to
+- Emacs follows the GNU coding standards for ChangeLog entries: see
+ https://www.gnu.org/prep/standards/html_node/Change-Logs.html or run
+ 'info "(standards)Change Logs"'. One exception is that commits
+ still sometimes quote `like-this' (as the standards used to
recommend) rather than 'like-this' or ‘like this’ (as they do now),
as `...' is so widely used elsewhere in Emacs.
@@ -261,9 +265,9 @@ them right the first time, so here are guidelines for
formatting them:
in Emacs; that includes spelling and leaving 2 blanks between
sentences.
- They are preserved indefinitely, and have a reasonable chance of
- being read in the future, so it's better that they have good
- presentation.
+ The ChangeLog entries are preserved indefinitely, and have a
+ reasonable chance of being read in the future, so it's better that
+ they have good presentation.
- Use the present tense; describe "what the change does", not "what
the change did".
diff --git a/ChangeLog.3 b/ChangeLog.3
index dc712df43ad..7db4986410d 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -137530,7 +137530,7 @@
Bind `enable-local-variables' in `hack-connection-local-variables'
* lisp/files-x.el (hack-connection-local-variables):
- Bind `enable-local-variables', instead of re-declaring
+ Bind `enable-local-variables', instead of redeclaring
`safe-local-variable-p'.
2019-03-23 Eli Zaretskii <eliz@gnu.org>
@@ -163179,7 +163179,7 @@
Quieten compilation of octave.el
- * lisp/progmodes/octave.el (compilation-forget-errors): Re-declare.
+ * lisp/progmodes/octave.el (compilation-forget-errors): Redeclare.
2018-02-28 Glenn Morris <rgm@gnu.org>
diff --git a/GNUmakefile b/GNUmakefile
index 16064672c65..58c0281e895 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -27,6 +27,8 @@
# newly-built Makefile. If the source tree is already configured,
# this file defers to the existing Makefile.
+. :=
+
# If you want non-default build options, or if you want to build in an
# out-of-source tree, you should run 'configure' before running 'make'.
# But run 'autogen.sh' first, if the source was checked out directly
@@ -36,30 +38,30 @@
ifeq (help,$(filter help,$(MAKECMDGOALS)))
help:
- $(info $ NOTE: This is a brief summary of some common make targets.)
- $(info $ For more detailed information, please read the files INSTALL,)
- $(info $ INSTALL.REPO, Makefile or visit this URL:)
- $(info $
https://www.gnu.org/prep/standards/html_node/Standard-Targets.html)
- $(info $ )
- $(info $ make all -- compile and build Emacs)
- $(info $ make install -- install Emacs)
- $(info $ make TAGS -- update tags tables)
- $(info $ make clean -- delete built files but preserve
configuration)
- $(info $ make mostlyclean -- like 'make clean', but leave those
files that)
- $(info $ usually do not need to be recompiled)
- $(info $ make distclean -- delete all build and configuration
files,)
- $(info $ leave only files included in source
distribution)
- $(info $ make maintainer-clean -- delete almost everything that can be
regenerated)
- $(info $ make extraclean -- like maintainer-clean, and also
delete)
- $(info $ backup and autosave files)
- $(info $ make bootstrap -- delete all compiled files to force a
new bootstrap)
- $(info $ from a clean slate, then build in the
normal way)
- $(info $ make uninstall -- remove files installed by 'make
install')
- $(info $ make check -- run the Emacs test suite)
- $(info $ make docs -- generate Emacs documentation in info
format)
- $(info $ make html -- generate documentation in html format)
- $(info $ make ps -- generate documentation in ps format)
- $(info $ make pdf -- generate documentation in pdf format )
+ $(info $.NOTE: This is a brief summary of some common make targets.)
+ $(info $.For more detailed information, please read the files INSTALL,)
+ $(info $.INSTALL.REPO, Makefile or visit this URL:)
+ $(info
$.https://www.gnu.org/prep/standards/html_node/Standard-Targets.html)
+ $(info $.)
+ $(info $.make all -- compile and build Emacs)
+ $(info $.make install -- install Emacs)
+ $(info $.make TAGS -- update tags tables)
+ $(info $.make clean -- delete built files but preserve
configuration)
+ $(info $.make mostlyclean -- like 'make clean', but leave those
files that)
+ $(info $. usually do not need to be recompiled)
+ $(info $.make distclean -- delete all build and configuration
files,)
+ $(info $. leave only files included in source
distribution)
+ $(info $.make maintainer-clean -- delete almost everything that can be
regenerated)
+ $(info $.make extraclean -- like maintainer-clean, and also
delete)
+ $(info $. backup and autosave files)
+ $(info $.make bootstrap -- delete all compiled files to force a
new bootstrap)
+ $(info $. from a clean slate, then build in the
normal way)
+ $(info $.make uninstall -- remove files installed by 'make
install')
+ $(info $.make check -- run the Emacs test suite)
+ $(info $.make docs -- generate Emacs documentation in info
format)
+ $(info $.make html -- generate documentation in html format)
+ $(info $.make ps -- generate documentation in ps format)
+ $(info $.make pdf -- generate documentation in pdf format )
@:
.PHONY: help
diff --git a/Makefile.in b/Makefile.in
index 5f3227a9ad5..20394cb333d 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -812,6 +812,7 @@ install-info: info
done; \
(cd "$${thisdir}"; \
${INSTALL_INFO} --info-dir="$(DESTDIR)${infodir}"
"$(DESTDIR)${infodir}/$$elt"); \
+ cp elisp_type_hierarchy* $(DESTDIR)${infodir}/; \
done; \
fi
@@ -954,6 +955,7 @@ uninstall: uninstall-$(NTDIR) uninstall-doc
uninstall-gsettings-schemas
ext=.gz; else ext=; fi; \
rm -f $$elt$$ext $$elt-[1-9]$$ext $$elt-[1-9][0-9]$$ext; \
done; \
+ rm -f elisp_type_hierarchy.jpg elisp_type_hierarchy.txt; \
fi)
(if [ -n "${GZIP_PROG}" ]; then \
ext=.gz; else ext=; fi; \
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index 06986ec8f48..c07fdc487ee 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -25,6 +25,9 @@ SOLARIS2
USG
USG5_4
HAIKU Compiling on Haiku.
+__ANDROID__ Compiling for the Android operating system.
+__ANDROID_API__ A numerical "API level" indicating the version of
+ Android being compiled for; see http://apilevels.com.
** Distinguishing GUIs **
@@ -35,10 +38,14 @@ NS_IMPL_COCOA Compile support for Cocoa (Apple)
implementation of NS GUI API.
HAVE_X11 Compile support for the X11 GUI.
HAVE_PGTK Compile support for using GTK itself without directly using X
Windows APIs.
HAVE_HAIKU Compile support for the Haiku window system.
-HAVE_X_WINDOWS Compile support for X Window system
- (It looks like, nowadays, if HAVE_X11 is set, HAVE_X_WINDOWS must
- be, and vice versa. At least, this is true for configure, and
- msdos; not sure about nt.)
+HAVE_X_WINDOWS Compile support for X Window system. Equivalent to HAVE_X11.
+HAVE_ANDROID Compiling the Android GUI interface. Enough of this
+ code is compiled for the build machine cross-compiling
+ the Android port to produce an Emacs binary that can
+ run Lisp code in batch mode, for the purpose of running
+ the byte-compiler.
+ANDROID_STUBIFY The Android GUI interface is being compiled for the build
+ machine, as above.
** X Windows features **
HAVE_X11R6 Whether or not the system has X11R6. (Always defined.)
diff --git a/admin/authors.el b/admin/authors.el
index 6c74f4dd7a1..8ea6064423f 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -175,6 +175,9 @@ files.")
("Michalis V" "^mvar")
("Miha Rihtaršič" "Miha Rihtarsic")
("Mikio Nakajima" "Nakajima Mikio")
+ (nil "montag451@laposte\\.net")
+ (nil "na@aisrntairetnraoitn")
+ ("Morgan Smith" "Morgan J\\. Smith")
("Nelson Jose dos Santos Ferreira" "Nelson Ferreira")
("Noah Peart" "noah\\.v\\.peart@gmail\\.com")
("Noorul Islam" "Noorul Islam K M")
diff --git a/admin/codespell/codespell.exclude
b/admin/codespell/codespell.exclude
index 416d79cf131..6413a73701b 100644
--- a/admin/codespell/codespell.exclude
+++ b/admin/codespell/codespell.exclude
@@ -1583,3 +1583,5 @@ VERY VERY LONG STRIN | VERY VERY LONG STRIN
(ert-info ("Joined by bouncer to #chan@foonet, pal persent")
(ert-info ("Joined by bouncer to #chan@barnet, pal persent")
.UE .
+ (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap,
yonder's my lord; I have sweat to see his honour.")
+ (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by
mercy, 'tis most just.")
diff --git a/admin/gitmerge.el b/admin/gitmerge.el
index 7c815c729e5..32d5c3c1bea 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -111,10 +111,10 @@ If nil, the function `gitmerge-default-branch' guesses.")
(defvar gitmerge-mode-font-lock-keywords
`((,gitmerge-log-regexp
- (1 font-lock-warning-face)
- (2 font-lock-constant-face)
- (3 font-lock-builtin-face)
- (4 font-lock-comment-face))))
+ (1 'font-lock-warning-face)
+ (2 'font-lock-constant-face)
+ (3 'font-lock-builtin-face)
+ (4 'font-lock-comment-face))))
(defvar gitmerge--commits nil)
(defvar gitmerge--from nil)
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 5246fb14e1e..41531d573b0 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -53,7 +53,7 @@ GNULIB_MODULES='
AVOIDED_MODULES='
access btowc chmod close crypto/af_alg dup fchdir fstat
- iswblank iswctype iswdigit iswxdigit langinfo lock
+ iswblank iswctype iswdigit iswxdigit langinfo localename-unsafe-limited lock
mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo
openat-die opendir pthread-h raise
save-cwd select setenv sigprocmask stat stdarg
diff --git a/admin/notes/kind-communication b/admin/notes/kind-communication
new file mode 100644
index 00000000000..80b2afb27b2
--- /dev/null
+++ b/admin/notes/kind-communication
@@ -0,0 +1,21 @@
+The GNU Project encourages contributions from anyone who wishes to
+advance the development of the GNU system, regardless of gender, race,
+ethnic group, physical appearance, religion, cultural background, and
+any other demographic characteristics, as well as personal political
+views.
+
+People are sometimes discouraged from participating in GNU development
+because of certain patterns of communication that strike them as
+unfriendly, unwelcoming, rejecting, or harsh. This discouragement
+particularly affects members of disprivileged demographics, but it is
+not limited to them. Therefore, we ask all contributors to make a
+conscious effort, in GNU Project discussions, to communicate in ways
+that avoid that outcome — to avoid practices that will predictably and
+unnecessarily risk putting some contributors off.
+
+The GNU Kind Communications Guidelines suggest specific ways to
+accomplish that goal. You can find the latest version at
+https://www.gnu.org/philosophy/kind-communication.html
+
+When sending messages to Emacs mailing lists, we ask you to read and
+respect these guidelines.
diff --git a/admin/notes/tree-sitter/build-module/build.sh
b/admin/notes/tree-sitter/build-module/build.sh
index 969187b7f92..9a567bb094d 100755
--- a/admin/notes/tree-sitter/build-module/build.sh
+++ b/admin/notes/tree-sitter/build-module/build.sh
@@ -43,7 +43,7 @@ case "${lang}" in
org="phoenixframework"
;;
"lua")
- org="MunifTanjim"
+ org="tree-sitter-grammars"
;;
"typescript")
sourcedir="tree-sitter-typescript/typescript/src"
diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el
new file mode 100644
index 00000000000..e14d7fb54e1
--- /dev/null
+++ b/admin/syncdoc-type-hierarchy.el
@@ -0,0 +1,125 @@
+;;; syncdoc-type-hierarchy.el--- -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
+
+;; Author: Andrea Corallo <acorallo@gnu.org>
+;; Keywords: documentation
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file is used to keep the type hierarchy representation present
+;; in the elisp manual in sync with the current type hierarchy. This
+;; is specified in `cl--direct-supertypes-of-type' in cl-preloaded.el, so each
+;; time `cl--direct-supertypes-of-type' is modified
+;; `syncdoc-update-type-hierarchy' must be run before the
+;; documentation is regenerated.
+
+;; We do not call this directly from make docs in order not to add a
+;; dependency on the tool "dot".
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'org-table)
+
+(defconst syncdoc-file (or (macroexp-file-name) buffer-file-name))
+
+(defconst syncdoc-emacs-repo-dir
+ (expand-file-name "../" (file-name-directory syncdoc-file)))
+
+(defconst syncdoc-lispref-dir
+ (expand-file-name "doc/lispref/" syncdoc-emacs-repo-dir))
+
+(defconst syncdoc-all-types
+ (let (res)
+ (mapatoms (lambda (type)
+ (when (cl-find-class type)
+ (push type res)))
+ obarray)
+ res)
+ "List of all types.")
+
+(declare-function 'comp--direct-supertypes "comp-cstr.el")
+
+(defconst syncdoc-hierarchy
+ (progn
+ ;; Require it here so we don't load it before `syncdoc-all-types' is
+ ;; computed.
+ (require 'comp-cstr)
+ (cl-loop
+ with comp-ctxt = (make-comp-cstr-ctxt)
+ with h = (make-hash-table :test #'eq)
+ for type in syncdoc-all-types
+ do (puthash type (comp--direct-supertypes type) h)
+ finally return h)))
+
+(defun syncdoc-insert-dot-content (rankdir)
+ (maphash (lambda (child parents)
+ (cl-loop for parent in parents
+ do (insert " \"" (symbol-name child) "\" -> \""
+ (symbol-name parent) "\";\n")))
+ syncdoc-hierarchy)
+ (sort-lines nil (point-min) (point-max))
+
+ (goto-char (point-min))
+ (insert "digraph {\n rankdir=\"" rankdir "\";\n")
+ (goto-char (point-max))
+ (insert "}\n"))
+
+(defun syncdoc-make-type-table (file)
+ (with-temp-file file
+ (insert "|Type| Derived Types|\n|-\n")
+ (let ((subtypes ()))
+ ;; First collect info from the "builtin" types.
+ (maphash (lambda (type parents)
+ (dolist (parent parents)
+ (push type (alist-get parent subtypes))))
+ syncdoc-hierarchy)
+ (cl-loop for (type . children) in (reverse subtypes)
+ do (insert "|" (symbol-name type) " |")
+ do (cl-loop with x = 0
+ for child in (reverse children)
+ for child-len = (length (symbol-name child))
+ when (> (+ x child-len 2) 60)
+ do (progn
+ (insert "|\n||")
+ (setq x 0))
+ do (insert (symbol-name child) " ")
+ do (cl-incf x (1+ child-len)) )
+ do (insert "\n")))
+ (org-table-align)))
+
+(defun syncdoc-update-type-hierarchy0 ()
+ "Update the type hierarchy representation used by the elisp manual."
+ (with-temp-buffer
+ (syncdoc-insert-dot-content "LR")
+ (with-demoted-errors "%S" ;In case "dot" is not found!
+ (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o"
+ (expand-file-name "elisp_type_hierarchy.jpg"
+ syncdoc-lispref-dir))))
+ (syncdoc-make-type-table (expand-file-name "elisp_type_hierarchy.txt"
+ syncdoc-lispref-dir)))
+
+(defun syncdoc-update-type-hierarchy ()
+ "Update the type hierarchy representation used by the elisp manual."
+ (interactive)
+ (call-process (expand-file-name "src/emacs" syncdoc-emacs-repo-dir)
+ nil t t "-Q" "--batch" "-l" syncdoc-file
+ "-f" "syncdoc-update-type-hierarchy0"))
+
+;;; syncdoc-type-hierarchy.el ends here
diff --git a/configure.ac b/configure.ac
index fa8b04ec685..452aa0838f1 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1231,6 +1231,7 @@ package will likely install on older systems but crash on
startup.])
passthrough="$passthrough --with-mailutils=$with_mailutils"
passthrough="$passthrough --with-pop=$with_pop"
passthrough="$passthrough --with-harfbuzz=$with_harfbuzz"
+ passthrough="$passthrough --with-threads=$with_threads"
# Now pass through some checking options.
emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type"
@@ -1321,6 +1322,7 @@ if test "$ANDROID" = "yes"; then
with_pop=no
with_harfbuzz=no
with_native_compilation=no
+ with_threads=no
fi
with_rsvg=no
@@ -1331,7 +1333,6 @@ if test "$ANDROID" = "yes"; then
with_gpm=no
with_dbus=no
with_gsettings=no
- with_threads=no
with_ns=no
# zlib is available in android.
@@ -2336,6 +2337,7 @@ fi
AC_DEFUN([AC_TYPE_SIZE_T])
# Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them.
AC_DEFUN([AC_TYPE_UID_T])
+ac_cv_type_gid_t=yes # AC_TYPE_GETGROUPS needs this in Autoconf 2.72.
# Check for all math.h functions that Emacs uses; on some platforms,
# -lm is needed for some of these functions.
@@ -4086,16 +4088,16 @@ case $with_file_notification,$opsys in
fi ;;
esac
-dnl inotify is available only on GNU/Linux.
+dnl inotify is available only on Linux-kernel based systems.
case $with_file_notification,$NOTIFY_OBJ in
inotify, | yes,)
AC_CHECK_HEADER([sys/inotify.h])
if test "$ac_cv_header_sys_inotify_h" = yes ; then
- AC_CHECK_FUNC([inotify_init1])
- if test "$ac_cv_func_inotify_init1" = yes; then
+ AC_CHECK_FUNCS([inotify_init inotify_init1])
+ if test "$ac_cv_func_inotify_init" = yes; then
AC_DEFINE([HAVE_INOTIFY], [1], [Define to 1 to use inotify.])
NOTIFY_OBJ=inotify.o
- NOTIFY_SUMMARY="yes -lglibc (inotify)"
+ NOTIFY_SUMMARY="yes (inotify)"
fi
fi ;;
esac
@@ -5905,13 +5907,15 @@ pthread_sigmask strsignal setitimer \
sendto recvfrom getsockname getifaddrs freeifaddrs \
gai_strerror sync \
endpwent getgrent endgrent \
-renameat2 \
cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np \
pthread_set_name_np])
# getpwent is not present in older versions of Android. (bug#65319)
gl_CHECK_FUNCS_ANDROID([getpwent], [[#include <pwd.h>]])
+# renameat2 is not present in older versions of Android.
+gl_CHECK_FUNCS_ANDROID([renameat2], [[#include <stdio.h>]])
+
if test "$ac_cv_func_cfmakeraw" != "yes"; then
# On some systems (Android), cfmakeraw is inline, so AC_CHECK_FUNCS
# cannot find it. Check if some code including termios.h and using
diff --git a/cross/verbose.mk.android b/cross/verbose.mk.android
index 958cf237c58..7b9af76404b 100644
--- a/cross/verbose.mk.android
+++ b/cross/verbose.mk.android
@@ -44,12 +44,13 @@ have_working_info = $(filter notintermediate,$(value
.FEATURES))
# The workaround is done only for AM_V_ELC and AM_V_ELN,
# since the bug is not annoying elsewhere.
-AM_V_AR = @$(info $ AR $@)
+. :=
+AM_V_AR = @$(info $. AR $@)
AM_V_at = @
-AM_V_CC = @$(info $ CC $@)
-AM_V_CXX = @$(info $ CXX $@)
-AM_V_CCLD = @$(info $ CCLD $@)
-AM_V_CXXLD = @$(info $ CXXLD $@)
-AM_V_GEN = @$(info $ GEN $@)
+AM_V_CC = @$(info $. CC $@)
+AM_V_CXX = @$(info $. CXX $@)
+AM_V_CCLD = @$(info $. CCLD $@)
+AM_V_CXXLD = @$(info $. CXXLD $@)
+AM_V_GEN = @$(info $. GEN $@)
AM_V_NO_PD = --no-print-directory
endif
diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi
index 0ea96d91492..a45ec84f3f0 100644
--- a/doc/emacs/android.texi
+++ b/doc/emacs/android.texi
@@ -474,33 +474,200 @@ version of Android being used:
@itemize @bullet
@item
Under more or less recent releases of Android, such as Android 6.0 and
-later, Emacs only receives the following permissions upon
-installation:
+later, Emacs only receives the following permissions upon installation,
+subject to the presence or absence of individual permissions in the
+version of Android installed:
@itemize @minus
@item
-@code{android.permission.VIBRATE}
+@code{android.permission.ACCESS_ADSERVICES_AD_ID}
+@item
+@code{android.permission.ACCESS_ADSERVICES_ATTRIBUTION}
+@item
+@code{android.permission.ACCESS_ADSERVICES_CUSTOM_AUDIENCE}
+@item
+@code{android.permission.ACCESS_ADSERVICES_TOPICS}
+@item
+@code{android.permission.ACCESS_LOCATION_EXTRA_COMMANDS}
@item
@code{android.permission.ACCESS_NETWORK_STATE}
@item
+@code{android.permission.ACCESS_NOTIFICATION_POLICY}
+@item
+@code{android.permission.ACCESS_WIFI_STATE}
+@item
+@code{android.permission.AUTHENTICATE_ACCOUNTS}
+@item
+@code{android.permission.BLUETOOTH}
+@item
+@code{android.permission.BLUETOOTH_ADMIN}
+@item
+@code{android.permission.BROADCAST_STICKY}
+@item
+@code{android.permission.CALL_COMPANION_APP}
+@item
+@code{android.permission.CHANGE_NETWORK_STATE}
+@item
+@code{android.permission.CHANGE_WIFI_MULTICAST_STATE}
+@item
+@code{android.permission.CHANGE_WIFI_STATE}
+@item
+@code{android.permission.CREDENTIAL_MANAGER_QUERY_CANDIDATE_CREDENTIALS}
+@item
+@code{android.permission.CREDENTIAL_MANAGER_SET_ALLOWED_PROVIDERS}
+@item
+@code{android.permission.CREDENTIAL_MANAGER_SET_ORIGIN}
+@item
+@code{android.permission.DELIVER_COMPANION_MESSAGES}
+@item
+@code{android.permission.DETECT_SCREEN_CAPTURE}
+@item
+@code{android.permission.DISABLE_KEYGUARD}
+@item
+@code{android.permission.ENFORCE_UPDATE_OWNERSHIP}
+@item
+@code{android.permission.EXPAND_STATUS_BAR}
+@item
+@code{android.permission.FLASHLIGHT}
+@item
+@code{android.permission.FOREGROUND_SERVICE}
+@item
+@code{android.permission.FOREGROUND_SERVICE_CAMERA}
+@item
+@code{android.permission.FOREGROUND_SERVICE_CONNECTED_DEVICE}
+@item
+@code{android.permission.FOREGROUND_SERVICE_DATA_SYNC}
+@item
+@code{android.permission.FOREGROUND_SERVICE_FILE_MANAGEMENT}
+@item
+@code{android.permission.FOREGROUND_SERVICE_HEALTH}
+@item
+@code{android.permission.FOREGROUND_SERVICE_LOCATION}
+@item
+@code{android.permission.FOREGROUND_SERVICE_MEDIA_PLAYBACK}
+@item
+@code{android.permission.FOREGROUND_SERVICE_MEDIA_PROJECTION}
+@item
+@code{android.permission.FOREGROUND_SERVICE_MICROPHONE}
+@item
+@code{android.permission.FOREGROUND_SERVICE_PHONE_CALL}
+@item
+@code{android.permission.FOREGROUND_SERVICE_REMOTE_MESSAGING}
+@item
+@code{android.permission.FOREGROUND_SERVICE_SPECIAL_USE}
+@item
+@code{android.permission.FOREGROUND_SERVICE_SYSTEM_EXEMPTED}
+@item
+@code{android.permission.GET_PACKAGE_SIZE}
+@item
+@code{android.permission.GET_TASKS}
+@item
+@code{android.permission.HIDE_OVERLAY_WINDOWS}
+@item
+@code{android.permission.HIGH_SAMPLING_RATE_SENSORS}
+@item
@code{android.permission.INTERNET}
@item
-@code{android.permission.SET_WALLPAPER}
+@code{android.permission.KILL_BACKGROUND_PROCESSES}
+@item
+@code{android.permission.MANAGE_ACCOUNTS}
+@item
+@code{android.permission.MANAGE_OWN_CALLS}
+@item
+@code{android.permission.MODIFY_AUDIO_SETTINGS}
@item
@code{android.permission.NFC}
@item
+@code{android.permission.NFC_PREFERRED_PAYMENT_INFO}
+@item
+@code{android.permission.NFC_TRANSACTION_EVENT}
+@item
+@code{android.permission.PERSISTENT_ACTIVITY}
+@item
+@code{android.permission.QUERY_ALL_PACKAGES}
+@item
+@code{android.permission.READ_BASIC_PHONE_STATE}
+@item
+@code{android.permission.READ_INSTALL_SESSIONS}
+@item
+@code{android.permission.READ_NEARBY_STREAMING_POLICY}
+@item
+@code{android.permission.READ_PROFILE}
+@item
+@code{android.permission.READ_SOCIAL_STREAM}
+@item
+@code{android.permission.READ_SYNC_SETTINGS}
+@item
+@code{android.permission.READ_SYNC_STATS}
+@item
+@code{android.permission.READ_USER_DICTIONARY}
+@item
+@code{android.permission.RECEIVE_BOOT_COMPLETED}
+@item
+@code{android.permission.REORDER_TASKS}
+@item
+@code{android.permission.REQUEST_COMPANION_PROFILE_GLASSES}
+@item
+@code{android.permission.REQUEST_COMPANION_PROFILE_WATCH}
+@item
+@code{android.permission.REQUEST_COMPANION_RUN_IN_BACKGROUND}
+@item
+@code{android.permission.REQUEST_COMPANION_START_FOREGROUND_SERVICES_FROM_BACKGROUND}
+@item
+@code{android.permission.REQUEST_COMPANION_USE_DATA_IN_BACKGROUND}
+@item
+@code{android.permission.REQUEST_DELETE_PACKAGES}
+@item
+@code{android.permission.REQUEST_IGNORE_BATTERY_OPTIMIZATIONS}
+@item
+@code{android.permission.REQUEST_OBSERVE_COMPANION_DEVICE_PRESENCE}
+@item
+@code{android.permission.REQUEST_PASSWORD_COMPLEXITY}
+@item
+@code{android.permission.RESTART_PACKAGES}
+@item
+@code{android.permission.RUN_USER_INITIATED_JOBS}
+@item
+@code{android.permission.SET_WALLPAPER}
+@item
+@code{android.permission.SET_WALLPAPER_HINTS}
+@item
+@code{android.permission.SUBSCRIBED_FEEDS_READ}
+@item
+@code{android.permission.SUBSCRIBED_FEEDS_WRITE}
+@item
@code{android.permission.TRANSMIT_IR}
@item
+@code{android.permission.UPDATE_PACKAGES_WITHOUT_USER_ACTION}
+@item
+@code{android.permission.USE_BIOMETRIC}
+@item
+@code{android.permission.USE_CREDENTIALS}
+@item
+@code{android.permission.USE_EXACT_ALARM}
+@item
+@code{android.permission.USE_FINGERPRINT}
+@item
+@code{android.permission.USE_FULL_SCREEN_INTENT}
+@item
+@code{android.permission.VIBRATE}
+@item
@code{android.permission.WAKE_LOCK}
@item
-@code{android.permission.FOREGROUND_SERVICE}
+@code{android.permission.WRITE_PROFILE}
@item
-@code{android.permission.FOREGROUND_SERVICE_SPECIAL_USE}
+@code{android.permission.WRITE_SMS}
+@item
+@code{android.permission.WRITE_SOCIAL_STREAM}
+@item
+@code{android.permission.WRITE_SYNC_SETTINGS}
+@item
+@code{android.permission.WRITE_USER_DICTIONARY}
@end itemize
-Other permissions must be granted by the user through the system
-settings application. Consult the manufacturer of your device for
-more details, as how to do this varies by device.
+Other permissions must be granted by the user from the system settings
+application. Consult the manufacturer of your device for more details,
+as how to do this varies by device.
@item
On Android 5.1 and earlier, Emacs automatically receives the following
@@ -508,59 +675,139 @@ permissions it has requested upon being installed:
@itemize @minus
@item
-@code{android.permission.READ_CONTACTS}
+@code{android.permission.ACCESS_COARSE_LOCATION}
@item
-@code{android.permission.WRITE_CONTACTS}
+@code{android.permission.ACCESS_FINE_LOCATION}
@item
-@code{android.permission.VIBRATE}
+@code{android.permission.BODY_SENSORS}
@item
-@code{android.permission.ACCESS_COARSE_LOCATION}
+@code{android.permission.CALL_PHONE}
@item
-@code{android.permission.ACCESS_NETWORK_STATE}
+@code{android.permission.CAMERA}
@item
-@code{android.permission.INTERNET}
+@code{android.permission.CAPTURE_CONSENTLESS_BUGREPORT_ON_USERDEBUG_BUILD}
@item
-@code{android.permission.SET_WALLPAPER}
+@code{android.permission.GET_ACCOUNTS}
+@item
+@code{android.permission.POST_NOTIFICATIONS}
+@item
+@code{android.permission.PROCESS_OUTGOING_CALLS}
@item
@code{android.permission.READ_CALENDAR}
@item
-@code{android.permission.WRITE_CALENDAR}
+@code{android.permission.READ_CALL_LOG}
+@item
+@code{android.permission.READ_CELL_BROADCASTS}
+@item
+@code{android.permission.READ_CONTACTS}
@item
@code{android.permission.READ_EXTERNAL_STORAGE}
@item
-@code{android.permission.WRITE_EXTERNAL_STORAGE}
+@code{android.permission.READ_PHONE_NUMBERS}
@item
-@code{android.permission.SEND_SMS}
+@code{android.permission.READ_PHONE_STATE}
@item
-@code{android.permission.RECEIVE_SMS}
+@code{android.permission.READ_SMS}
@item
@code{android.permission.RECEIVE_MMS}
@item
-@code{android.permission.WRITE_SMS}
+@code{android.permission.RECEIVE_SMS}
@item
-@code{android.permission.READ_SMS}
+@code{android.permission.RECEIVE_WAP_PUSH}
+@item
+@code{android.permission.RECORD_AUDIO}
+@item
+@code{android.permission.REQUEST_INSTALL_PACKAGES}
+@item
+@code{android.permission.SEND_SMS}
+@item
+@code{android.permission.SMS_FINANCIAL_TRANSACTIONS}
+@item
+@code{android.permission.SYSTEM_ALERT_WINDOW}
+@item
+@code{android.permission.WRITE_CALENDAR}
+@item
+@code{android.permission.WRITE_CALL_LOG}
+@item
+@code{android.permission.WRITE_CONTACTS}
+@item
+@code{android.permission.WRITE_EXTERNAL_STORAGE}
+@item
+@code{android.permission.WRITE_SETTINGS}
+@item
+@code{android.permission.ACCESS_LOCATION_EXTRA_COMMANDS}
+@item
+@code{android.permission.ACCESS_NETWORK_STATE}
+@item
+@code{android.permission.ACCESS_WIFI_STATE}
+@item
+@code{android.permission.BLUETOOTH}
+@item
+@code{android.permission.BLUETOOTH_ADMIN}
+@item
+@code{android.permission.BROADCAST_STICKY}
+@item
+@code{android.permission.CHANGE_NETWORK_STATE}
+@item
+@code{android.permission.CHANGE_WIFI_MULTICAST_STATE}
+@item
+@code{android.permission.CHANGE_WIFI_STATE}
+@item
+@code{android.permission.DISABLE_KEYGUARD}
+@item
+@code{android.permission.EXPAND_STATUS_BAR}
+@item
+@code{android.permission.FLASHLIGHT}
+@item
+@code{android.permission.GET_PACKAGE_SIZE}
+@item
+@code{android.permission.GET_TASKS}
+@item
+@code{android.permission.INTERNET}
+@item
+@code{android.permission.KILL_BACKGROUND_PROCESSES}
+@item
+@code{android.permission.MODIFY_AUDIO_SETTINGS}
@item
@code{android.permission.NFC}
@item
-@code{android.permission.TRANSMIT_IR}
+@code{android.permission.PERSISTENT_ACTIVITY}
@item
-@code{android.permission.READ_PHONE_STATE}
+@code{android.permission.QUERY_ALL_PACKAGES}
@item
-@code{android.permission.WAKE_LOCK}
+@code{android.permission.READ_BASIC_PHONE_STATE}
@item
-@code{android.permission.FOREGROUND_SEVICE}
+@code{android.permission.READ_SYNC_SETTINGS}
@item
-@code{android.permission.REQUEST_INSTALL_PACKAGES}
+@code{android.permission.READ_SYNC_STATS}
+@item
+@code{android.permission.READ_USER_DICTIONARY}
+@item
+@code{android.permission.RECEIVE_BOOT_COMPLETED}
+@item
+@code{android.permission.REORDER_TASKS}
@item
@code{android.permission.REQUEST_DELETE_PACKAGES}
@item
-@code{android.permission.SYSTEM_ALERT_WINDOW}
+@code{android.permission.REQUEST_IGNORE_BATTERY_OPTIMIZATIONS}
@item
-@code{android.permission.RECORD_AUDIO}
+@code{android.permission.REQUEST_OBSERVE_COMPANION_DEVICE_PRESENCE}
@item
-@code{android.permission.CAMERA}
+@code{android.permission.RESTART_PACKAGES}
@item
-@code{android.permission.POST_NOTIFICATIONS}
+@code{android.permission.SET_WALLPAPER}
+@item
+@code{android.permission.SET_WALLPAPER_HINTS}
+@item
+@code{android.permission.TRANSMIT_IR}
+@item
+@code{android.permission.VIBRATE}
+@item
+@code{android.permission.WAKE_LOCK}
+@item
+@code{android.permission.WRITE_SYNC_SETTINGS}
+@item
+@code{android.permission.WRITE_USER_DICTIONARY}
@end itemize
While most of these permissions are left unused by Emacs itself, they
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index d9113a6811a..00160afd844 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -205,7 +205,7 @@ Here is an example of a buffer list:
@smallexample
CRM Buffer Size Mode File
-. * .emacs 3294 Emacs-Lisp ~/.emacs
+. * .emacs 3294 ELisp/l ~/.emacs
% *Help* 101 Help
search.c 86055 C ~/cvs/emacs/src/search.c
% src 20959 Dired by name ~/cvs/emacs/src/
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 6db9e8344c6..bda57d2b30e 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -2210,6 +2210,14 @@ keys; its value is the number of seconds of pause
required to cause echoing
to start, or zero, meaning don't echo at all. The value takes effect when
there is something to echo. @xref{Echo Area}.
+@vindex echo-keystrokes-help
+ If the variable @code{echo-keystrokes-help} is non-@code{nil} (the
+default), the multi-character key sequence echo shown according to
+@code{echo-keystrokes} will include a short help text about keys which
+will invoke @code{describe-prefix-bindings} (@pxref{Misc Help}) to show
+the list of commands for the prefix you already typed. For a related
+help facility, see @ref{which-key}.
+
@cindex mouse pointer
@cindex hourglass pointer display
@vindex display-hourglass
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 99a4173ac29..05457a3f34f 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -260,6 +260,11 @@ by these buttons, Emacs provides the
@code{button-describe} and
@code{widget-describe} commands, that should be run with point over
the button.
+@anchor{which-key}
+@kbd{M-x which-key} is a global minor mode which helps in discovering
+ keymaps. It displays keybindings following your currently entered
+ incomplete command (prefix), in a popup.
+
@node Name Help
@section Help by Command or Variable Name
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 338bf014208..cb347d59948 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -1097,6 +1097,12 @@ so that Outline mode will know that sections are
contained in
chapters. This works as long as no other command starts with
@samp{@@chap}.
+@vindex outline-search-function
+ Instead of setting the variable @code{outline-regexp}, you can set
+the variable @code{outline-search-function} to a function that
+matches the current heading and searches for the next one
+(@pxref{Outline Minor Mode,,,elisp, the Emacs Lisp Reference Manual}).
+
@vindex outline-level
You can explicitly specify a rule for calculating the level of a
heading line by setting the variable @code{outline-level}. The value
diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in
index 476b8cf8fe6..9b7b6d8ea9d 100644
--- a/doc/lispref/Makefile.in
+++ b/doc/lispref/Makefile.in
@@ -144,7 +144,15 @@ ps: $(PS_TARGETS)
${buildinfodir}:
${MKDIR_P} $@
-$(buildinfodir)/elisp.info: $(srcs) | ${buildinfodir}
+auxfiles: $(buildinfodir)/elisp_type_hierarchy.txt
$(buildinfodir)/elisp_type_hierarchy.jpg
+
+$(buildinfodir)/elisp_type_hierarchy.txt: $(srcdir)/elisp_type_hierarchy.txt |
${buildinfodir}
+ cp $< $@
+
+$(buildinfodir)/elisp_type_hierarchy.jpg: $(srcdir)/elisp_type_hierarchy.jpg |
${buildinfodir}
+ cp $< $@
+
+$(buildinfodir)/elisp.info: $(srcs) auxfiles | ${buildinfodir}
$(AM_V_GEN)$(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $<
elisp.dvi: $(srcs)
diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi
index 9b719145584..d89cec4bc2b 100644
--- a/doc/lispref/abbrevs.texi
+++ b/doc/lispref/abbrevs.texi
@@ -65,7 +65,7 @@ expanded in the buffer. For the user-level commands for
abbrevs, see
@defun make-abbrev-table &optional props
This function creates and returns a new, empty abbrev table---an
-obarray containing no symbols. It is a vector filled with zeros.
+obarray containing no symbols.
@var{props} is a property list that is applied to the new table
(@pxref{Abbrev Table Properties}).
@end defun
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 0c6895332a0..78ad5b68a51 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -638,6 +638,16 @@ with @var{n} arguments (the other elements) and an
additional
Example: @code{(= 42)}@*
In this example, the function is @code{=}, @var{n} is one, and
the actual function call becomes: @w{@code{(= 42 @var{expval})}}.
+
+@item function call with an @code{_} arg
+Call the function (the first element of the function call)
+with the specified arguments (the other elements) and replacing
+@code{_} with @var{expval}.
+
+Example: @code{(gethash _ memo-table)}
+In this example, the function is @code{gethash}, and
+the actual function call becomes: @w{@code{(gethash @var{expval}
+memo-table)}}.
@end table
@item (app @var{function} @var{pattern})
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 10cf5ce89e2..beca470d68a 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6048,6 +6048,7 @@ event is composed by combining the @var{id} of the
hot-spot with the
mouse event; for instance, @code{[area4 mouse-1]} if the hot-spot's
@var{id} is @code{area4}.
+@findex image-compute-scaling-factor
Note that the map's coordinates should reflect the displayed image
after all transforms have been done (rotation, scaling and so on), and
also note that Emacs (by default) performs auto-scaling of images, so
@@ -6766,11 +6767,15 @@ from the file's name.
The remaining arguments, @var{props}, specify additional image
properties---for example,
-@c ':heuristic-mask' is not documented?
@example
-(create-image "foo.xpm" 'xpm nil :heuristic-mask t)
+(create-image "foo.xpm" 'xpm nil :mask 'heuristic)
@end example
+@noindent
+@xref{Image Descriptors}, for the list of supported properties. Some
+properties are specific to certain image types, and are described in
+subsections specific to those types.
+
The function returns @code{nil} if images of this type are not
supported. Otherwise it returns an image descriptor.
@end defun
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index cab1622337e..71139db4359 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -300,6 +300,7 @@ Lisp Data Types
* Type Predicates:: Tests related to types.
* Equality Predicates:: Tests of equality between any two objects.
* Mutability:: Some objects should not be modified.
+* Type Hierarchy:: Type Hierarchy of Emacs Lisp objects.
Programming Types
@@ -883,6 +884,7 @@ Major and Minor Modes
* Minor Modes:: Defining minor modes.
* Mode Line Format:: Customizing the text that appears in the mode line.
* Imenu:: Providing a menu of definitions made in a buffer.
+* Outline Minor Mode:: Outline mode to use with other major modes.
* Font Lock Mode:: How modes can highlight text according to syntax.
* Auto-Indentation:: How to teach Emacs to indent for a major mode.
* Desktop Save Mode:: How modes can have buffer state saved between
diff --git a/doc/lispref/elisp_type_hierarchy.jpg
b/doc/lispref/elisp_type_hierarchy.jpg
new file mode 100644
index 00000000000..a2e14490dfa
Binary files /dev/null and b/doc/lispref/elisp_type_hierarchy.jpg differ
diff --git a/doc/lispref/elisp_type_hierarchy.txt
b/doc/lispref/elisp_type_hierarchy.txt
new file mode 100644
index 00000000000..d1be8f56c72
--- /dev/null
+++ b/doc/lispref/elisp_type_hierarchy.txt
@@ -0,0 +1,33 @@
+| Type | Derived Types
|
+|---------------------+------------------------------------------------------------|
+| atom | mutex record font-spec frame number-or-marker
|
+| | tree-sitter-compiled-query tree-sitter-node
font-entity |
+| | tree-sitter-parser hash-table window-configuration
|
+| | function user-ptr overlay array process font-object
symbol |
+| | obarray condvar buffer terminal thread window
|
+| | native-comp-unit
|
+| cl-structure-object | xref-elisp-location org-cite-processor
cl--generic-method |
+| | cl--random-state register-preview-info cl--generic
|
+| | cl--class cl-slot-descriptor uniquify-item registerv
|
+| | isearch--state cl--generic-generalizer
lisp-indent-state |
+| t | sequence atom
|
+| compiled-function | subr byte-code-function
|
+| integer | fixnum bignum
|
+| symbol | symbol-with-pos keyword boolean
|
+| accessor | oclosure-accessor
|
+| oclosure | advice cconv--interactive-helper advice--forward
accessor |
+| | save-some-buffers-function cl--generic-nnm
|
+| cons | ppss decoded-time
|
+| cl--class | cl-structure-class oclosure--class built-in-class
|
+| subr | subr-primitive subr-native-elisp
|
+| array | string vector bool-vector char-table
|
+| number | float integer
|
+| number-or-marker | integer-or-marker number
|
+| function | oclosure compiled-function interpreted-function
|
+| | module-function
|
+| sequence | list array
|
+| integer-or-marker | integer marker
|
+| boolean | null
|
+| list | null cons
|
+| record | cl-structure-object
|
+| vector | timer
|
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 4b34e75f055..8feda2784ca 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -498,13 +498,12 @@ indentation of the following lines is inside the string;
what looks
nice in the source code will look ugly when displayed by the help
commands.
- You may wonder how the documentation string could be optional, since
-there are required components of the function that follow it (the body).
-Since evaluation of a string returns that string, without any side effects,
-it has no effect if it is not the last form in the body. Thus, in
-practice, there is no confusion between the first form of the body and the
-documentation string; if the only body form is a string then it serves both
-as the return value and as the documentation.
+ A documentation string must always be followed by at least one Lisp
+expression; otherwise, it is not a documentation string at all but the
+single expression of the body and used as the return value.
+When there is no meaningful value to return from a function, it is
+standard practice to return @code{nil} by adding it after the
+documentation string.
The last line of the documentation string can specify calling
conventions different from the actual function arguments. Write
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 2062ae64866..486125acb0d 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -89,9 +89,9 @@ you are criticizing.
@cindex bugs
@cindex suggestions
-Please send comments and corrections using @kbd{M-x
-report-emacs-bug}. If you wish to contribute new code (or send a
-patch to fix a problem), use @kbd{M-x submit-emacs-patch}.
+Please send comments and corrections using @kbd{M-x report-emacs-bug}.
+For more details, @xref{Bugs,, Reporting Bugs, emacs, The GNU Emacs
+Manual}.
@node Lisp History
@section Lisp History
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index aa27de72ba0..8f2d0d702f9 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -187,7 +187,8 @@ History}.
If the variable @code{minibuffer-allow-text-properties} is
non-@code{nil}, then the string that is returned includes whatever text
properties were present in the minibuffer. Otherwise all the text
-properties are stripped when the value is returned.
+properties are stripped when the value is returned. (By default this
+variable is @code{nil}.)
@vindex minibuffer-prompt-properties
The text properties in @code{minibuffer-prompt-properties} are applied
@@ -350,14 +351,15 @@ See @code{read-regexp} above for details of how these
values are used.
@end defopt
@defvar minibuffer-allow-text-properties
-If this variable is @code{nil}, then @code{read-from-minibuffer}
-and @code{read-string} strip all text properties from the minibuffer
-input before returning it. However,
+If this variable is @code{nil}, the default, then
+@code{read-from-minibuffer} and @code{read-string} strip all text
+properties from the minibuffer input before returning it. However,
@code{read-no-blanks-input} (see below), as well as
@code{read-minibuffer} and related functions (@pxref{Object from
Minibuffer,, Reading Lisp Objects With the Minibuffer}), and all
-functions that do minibuffer input with completion, remove the @code{face}
-property unconditionally, regardless of the value of this variable.
+functions that do minibuffer input with completion, remove the
+@code{face} property unconditionally, regardless of the value of this
+variable.
If this variable is non-@code{nil}, most text properties on strings
from the completion table are preserved---but only on the part of the
@@ -2562,6 +2564,14 @@ times match.
The optional argument @var{default} specifies the default password to
return if the user enters empty input. If @var{default} is @code{nil},
then @code{read-passwd} returns the null string in that case.
+
+This function uses @code{read-passwd-mode}, a minor mode. It binds two
+keys in the minbuffer: @kbd{C-u} (@code{delete-minibuffer-contents})
+deletes the password, and @kbd{TAB}
+(@code{read-passwd--toggle-visibility}) toggles the visibility of the
+password. There is also an additional icon in the mode-line. Clicking
+on this icon with @key{mouse-1} toggles the visibility of the password
+as well.
@end defun
@node Minibuffer Commands
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 1d961249633..b034fecd77b 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -25,6 +25,7 @@ user. For related topics such as keymaps and syntax tables,
see
* Minor Modes:: Defining minor modes.
* Mode Line Format:: Customizing the text that appears in the mode line.
* Imenu:: Providing a menu of definitions made in a buffer.
+* Outline Minor Mode:: Outline mode to use with other major modes.
* Font Lock Mode:: How modes can highlight text according to syntax.
* Auto-Indentation:: How to teach Emacs to indent for a major mode.
* Desktop Save Mode:: How modes can have buffer state saved between
@@ -507,6 +508,12 @@ variable @code{imenu-generic-expression}, for the two
variables
@code{imenu-extract-index-name-function}, or for the variable
@code{imenu-create-index-function} (@pxref{Imenu}).
+@item
+The mode should specify how Outline minor mode should find the
+heading lines, by setting up a buffer-local value for the variables
+@code{outline-regexp} or @code{outline-search-function}, and also
+for the variable @code{outline-level} (@pxref{Outline Minor Mode}).
+
@item
The mode can tell ElDoc mode how to retrieve different types of
documentation for whatever is at point, by adding one or more
@@ -784,6 +791,39 @@ init file.)
@end smallexample
@end defvar
+@defvar major-mode-remap-defaults
+This variable contains an association list indicating which function
+to call to activate a given major mode. This is used for file formats
+that can be supported by various major modes, where this variable can be
+used to indicate which alternative should be used by default.
+
+For example, a third-party package providing a much improved Pascal
+major mode, can use the following to tell @code{normal-mode} to use
+@code{spiffy-pascal-mode} for all the files that would normally use
@code{pascal-mode}:
+
+@smallexample
+@group
+(add-to-list 'major-mode-remap-defaults '(pascal-mode . spiffy-pascal-mode))
+@end group
+@end smallexample
+
+This variable has the same format as @code{major-mode-remap-alist}.
+If both lists match a major mode, the entry in
+@code{major-mode-remap-alist} takes precedence.
+@end defvar
+
+@defun major-mode-remap mode
+This function returns the major mode to use instead of @var{mode}
+according to @code{major-mode-remap-alist} and
+@code{major-mode-remap-defaults}. It returns @var{mode} if the mode
+is not remapped by those variables.
+
+When a package wants to activate a major mode for a particular file
+format, it should use this function, passing as @code{mode} argument the
+canonical major mode for that file format, to find which specific major
+mode to activate, so as to take into account the user's preferences.
+@end defun
+
@node Mode Help
@subsection Getting Help about a Major Mode
@cindex mode help
@@ -1182,7 +1222,7 @@ column is sorted in the descending order.
This buffer-local variable specifies the format of the Tabulated List
data. Its value should be a vector. Each element of the vector
represents a data column, and should be a list @code{(@var{name}
-@var{width} @var{sort})}, where
+@var{width} @var{sort} . @var{props})}, where
@itemize
@item
@@ -1199,6 +1239,13 @@ sorted by comparing string values. Otherwise, this
should be a
predicate function for @code{sort} (@pxref{Rearrangement}), which
accepts two arguments with the same form as the elements of
@code{tabulated-list-entries} (see below).
+
+@item
+@var{props} is a plist (@pxref{Property Lists}) of additional column
+properties. If the value of the property @code{:right-align} is
+non-@code{nil} then the column should be right-aligned. And the
+property @code{:pad-right} specifies the number of additional padding
+spaces to the right of the column (by default 1 if omitted).
@end itemize
@end defvar
@@ -1232,6 +1279,42 @@ Otherwise, the value should be a function which returns
a list of the
above form when called with no arguments.
@end defvar
+@defvar tabulated-list-groups
+This buffer-local variable specifies the groups of entries displayed in
+the Tabulated List buffer. Its value should be either a list or a
+function.
+
+If the value is a list, each list element corresponds to one group, and
+should have the form @w{@code{(@var{group-name} @var{entries})}}, where
+@var{group-name} is a string inserted before all group entries, and
+@var{entries} have the same format as @code{tabulated-list-entries}
+(see above).
+
+Otherwise, the value should be a function which returns a list of the
+above form when called with no arguments.
+
+You can use @code{seq-group-by} to create @code{tabulated-list-groups}
+from @code{tabulated-list-entries}. For example:
+
+@smallexample
+@group
+(setq tabulated-list-groups
+ (seq-group-by 'Buffer-menu-group-by-mode
+ tabulated-list-entries))
+@end group
+@end smallexample
+
+@noindent
+where you can define @code{Buffer-menu-group-by-mode} like this:
+
+@smallexample
+@group
+(defun Buffer-menu-group-by-mode (entry)
+ (concat "* " (aref (cadr entry) 5)))
+@end group
+@end smallexample
+@end defvar
+
@defvar tabulated-list-revert-hook
This normal hook is run prior to reverting a Tabulated List buffer. A
derived mode can add a function to this hook to recompute
@@ -2994,6 +3077,61 @@ instead.
automatically sets up Imenu if this variable is non-@code{nil}.
@end defvar
+@node Outline Minor Mode
+@section Outline Minor Mode
+
+@cindex Outline minor mode
+ @dfn{Outline minor mode} is a buffer-local minor mode that hides
+parts of the buffer and leaves only heading lines visible.
+This minor mode can be used in conjunction with other major modes
+(@pxref{Outline Minor Mode,, Outline Minor Mode, emacs, the Emacs Manual}).
+
+ There are two ways to define which lines are headings: with the
+variable @code{outline-regexp} or @code{outline-search-function}.
+
+@defvar outline-regexp
+This variable is a regular expression.
+Any line whose beginning has a match for this regexp is considered a
+heading line. Matches that start within a line (not at the left
+margin) do not count.
+@end defvar
+
+@defvar outline-search-function
+Alternatively, when it's impossible to create a regexp that
+matches heading lines, you can define a function that helps
+Outline minor mode to find heading lines.
+
+The variable @code{outline-search-function} specifies the function with
+four arguments: @var{bound}, @var{move}, @var{backward}, and
+@var{looking-at}. The function completes two tasks: to match the
+current heading line, and to find the next or the previous heading line.
+If the argument @var{looking-at} is non-@code{nil}, it should return
+non-@code{nil} when point is at the beginning of the outline header line.
+If the argument @var{looking-at} is @code{nil}, the first three arguments
+are used. The argument @var{bound} is a buffer position that bounds
+the search. The match found must not end after that position. A
+value of nil means search to the end of the accessible portion of
+the buffer. If the argument @var{move} is non-@code{nil}, the
+failed search should move to the limit of search and return nil.
+If the argument @var{backward} is non-@code{nil}, this function
+should search for the previous heading backward.
+@end defvar
+
+@defvar outline-level
+This variable is a function that takes no arguments
+and should return the level of the current heading.
+It's required in both cases: whether you define
+@code{outline-regexp} or @code{outline-search-function}.
+@end defvar
+
+If built with tree-sitter, Emacs can automatically use
+Outline minor mode if the major mode sets the following variable.
+
+@defvar treesit-outline-predicate
+This variable instructs Emacs how to find lines with outline headings.
+It should be a predicate that matches the node on the heading line.
+@end defvar
+
@node Font Lock Mode
@section Font Lock Mode
@cindex Font Lock mode
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index b8fd5ed4345..41171bcaafc 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -60,6 +60,7 @@ to use these types can be found in later chapters.
* Type Predicates:: Tests related to types.
* Equality Predicates:: Tests of equality between any two objects.
* Mutability:: Some objects should not be modified.
+* Type Hierarchy:: Type Hierarchy of Emacs Lisp objects.
@end menu
@node Printed Representation
@@ -2121,6 +2122,9 @@ with references to further information.
@item numberp
@xref{Predicates on Numbers, numberp}.
+@item obarrayp
+@xref{Creating Symbols, obarrayp}.
+
@item overlayp
@xref{Overlays, overlayp}.
@@ -2181,7 +2185,7 @@ This function returns a symbol naming the primitive type
of
@code{condition-variable}, @code{cons}, @code{finalizer},
@code{float}, @code{font-entity}, @code{font-object},
@code{font-spec}, @code{frame}, @code{hash-table}, @code{integer},
-@code{marker}, @code{mutex}, @code{overlay}, @code{process},
+@code{marker}, @code{mutex}, @code{obarray}, @code{overlay}, @code{process},
@code{string}, @code{subr}, @code{symbol}, @code{thread},
@code{vector}, @code{window}, or @code{window-configuration}.
However, if @var{object} is a record, the type specified by its first
@@ -2493,3 +2497,26 @@ their components. For example, @code{(eq "abc" "abc")}
returns
literal @code{"abc"}, and returns @code{nil} if it creates two
instances. Lisp programs should be written so that they work
regardless of whether this optimization is in use.
+
+@node Type Hierarchy
+@section Type Hierarchy of Emacs Lisp Objects
+
+Lisp object types are organized in a hierarchy, which means that types
+can derive from other types. Objects of type B (which derives from type
+A) inherit all the characteristics of type A@. This also means that
+every object of type B is at the same time an object of type A from
+which it derives.
+
+Every type derives from type @code{t}.
+
+New types can be defined by the user through @code{defclass} or
+@code{cl-defstruct}.
+
+The Lisp Type Hierarchy for primitive types can be represented as
+follows:
+
+@noindent
+@image{elisp_type_hierarchy,,,,.jpg}
+
+For example type @code{list} derives from (is a special kind of) type
+@code{sequence} which itself derives from @code{t}.
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index f75023d4039..421e64dd5d1 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -28,6 +28,7 @@ these archives).
* Multi-file Packages:: How to package multiple files.
* Package Archives:: Maintaining package archives.
* Archive Web Server:: Interfacing to an archive web server.
+* Forwards-Compatibility:: Supporting older versions of Emacs.
@end menu
@node Packaging Basics
@@ -399,3 +400,50 @@ Return the file. This will be the tarball for a multi-file
package, or the single file for a simple package.
@end table
+
+@node Forwards-Compatibility
+@section Supporting older versions of Emacs
+@cindex compatibility compat
+
+Packages that wish to support older releases of Emacs, without giving
+up on newer functionality from recent Emacs releases, one can make use
+of the Compat package on GNU ELPA. By depending on the package, Emacs
+can provide compatibility definitions for missing functionality.
+
+The versioning of Compat follows that of Emacs, so next to the oldest
+version that a package relies on (via the @code{emacs}-package), one
+can also indicate what the newest version of Emacs is, that a package
+wishes to use definitions from:
+
+@example
+;; Package-Requires: ((emacs "27.2") (compat "29.1"))
+@end example
+
+Note that Compat provides replacement functions with extended
+functionality for functions that are already defined (@code{sort},
+@code{assoc}, @dots{}). These functions may have changed their
+calling convention (additional optional arguments) or may have changed
+their behavior. These functions must be looked up explicitly with
+@code{compat-function} or called explicitly with @code{compat-call}.
+We call them @dfn{Extended Definitions}. In contrast, newly @dfn{Added
+Definitions} can be called as usual.
+
+@defmac compat-call fun &rest args
+This macro calls the compatibility function @var{fun} with @var{args}.
+Many functions provided by Compat can be called directly without this
+macro. However in the case where Compat provides an alternative
+version of an existing function, the function call has to go through
+@code{compat-call}.
+@end defmac
+
+@defmac compat-function fun
+This macro returns the compatibility function symbol for @var{fun}.
+See @code{compat-call} for a more convenient macro to directly call
+compatibility functions.
+@end defmac
+
+For further details on how to make use of the package, see
+@ref{Usage,, Usage, compat, "Compat" Manual}. In case you don't have
+the manual installed, you can also read the
+@url{https://elpa.gnu.org/packages/doc/compat.html#Usage, Online
+Compat manual}.
diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi
index 5d79c4b27f4..3d2192ace64 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -794,7 +794,7 @@ that comes after it in the buffer position order, i.e.,
nodes with
start positions greater than the end position of @var{start}.
In the tree shown above, @code{treesit-search-subtree} traverses node
-@samp{S} (@var{start}) and nodes marked with @code{o}, where this
+@samp{S} (@var{start}) and nodes marked with @code{o}, whereas this
function traverses the nodes marked with numbers. This function is
useful for answering questions like ``what is the first node after
@var{start} in the buffer that satisfies some condition?''
@@ -916,32 +916,37 @@ nodes.
@defun treesit-parent-until node predicate &optional include-node
This function repeatedly finds the parents of @var{node}, and returns
-the parent that satisfies @var{pred}, a function that takes a node as
-argument and returns a boolean that indicates a match. If no parent
-satisfies @var{pred}, this function returns @code{nil}.
+the parent that satisfies @var{predicate}. @var{predicate} can be
+either a function that takes a node as argument and returns @code{t}
+or @code{nil}, or a regexp matching node type names, or other valid
+predicates described in @var{treesit-thing-settings}. If no parent
+satisfies @var{predicates}, this function returns @code{nil}.
Normally this function only looks at the parents of @var{node} but not
@var{node} itself. But if @var{include-node} is non-@code{nil}, this
-function returns @var{node} if @var{node} satisfies @var{pred}.
+function returns @var{node} if @var{node} satisfies @var{predicate}.
@end defun
-@defun treesit-parent-while node pred
+@defun treesit-parent-while node predicate
This function goes up the tree starting from @var{node}, and keeps
-doing so as long as the nodes satisfy @var{pred}, a function that
+doing so as long as the nodes satisfy @var{predicate}, a function that
takes a node as argument. That is, this function returns the highest
-parent of @var{node} that still satisfies @var{pred}. Note that if
-@var{node} satisfies @var{pred} but its immediate parent doesn't,
+parent of @var{node} that still satisfies @var{predicate}. Note that if
+@var{node} satisfies @var{predicate} but its immediate parent doesn't,
@var{node} itself is returned.
@end defun
-@defun treesit-node-top-level node &optional type
+@defun treesit-node-top-level node &optional predicate include-node
This function returns the highest parent of @var{node} that has the
same type as @var{node}. If no such parent exists, it returns
@code{nil}. Therefore this function is also useful for testing
whether @var{node} is top-level.
-If @var{type} is non-@code{nil}, this function matches each parent's
-type with @var{type} as a regexp, rather than using @var{node}'s type.
+If @var{predicate} is @code{nil}, this function uses @var{node}'s type
+to find the parent. If @var{predicate} is non-@code{nil}, this
+function searches the parent that satisfies @var{predicate}. If
+@var{include-node} is non-@code{nil}, this function returns @var{node}
+if @var{node} satisfies @var{predicate}.
@end defun
@node Accessing Node Information
@@ -1892,6 +1897,10 @@ add-log functions used by @code{add-log-current-defun}.
@item
If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is
non-@code{nil}, it sets up Imenu.
+
+@item
+If @code{treesit-outline-predicate} (@pxref{Outline Minor Mode}) is
+non-@code{nil}, it sets up Outline minor mode.
@end itemize
@c TODO: Add treesit-thing-settings stuff once we finalize it.
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index 367bd195f16..6f9b1ef0ec7 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -177,34 +177,16 @@ know how Lisp reads them. Lisp must ensure that it finds
the same
symbol every time it reads the same sequence of characters in the same
context. Failure to do so would cause complete confusion.
-@cindex symbol name hashing
-@cindex hashing
@cindex obarray
-@cindex bucket (in obarray)
When the Lisp reader encounters a name that references a symbol in
-the source code, it reads all the characters of that name. Then it
-looks up that name in a table called an @dfn{obarray} to find the
-symbol that the programmer meant. The technique used in this lookup
-is called ``hashing'', an efficient method of looking something up by
-converting a sequence of characters to a number, known as a ``hash
-code''. For example, instead of searching a telephone book cover to
-cover when looking up Jan Jones, you start with the J's and go from
-there. That is a simple version of hashing. Each element of the
-obarray is a @dfn{bucket} which holds all the symbols with a given
-hash code; to look for a given name, it is sufficient to look through
-all the symbols in the bucket for that name's hash code. (The same
-idea is used for general Emacs hash tables, but they are a different
-data type; see @ref{Hash Tables}.)
-
-When looking up names, the Lisp reader also considers ``shorthands''.
+the source code, it looks up that name in a table called an @dfn{obarray}
+to find the symbol that the programmer meant. An obarray is an unordered
+container of symbols, indexed by name.
+
+The Lisp reader also considers ``shorthands''.
If the programmer supplied them, this allows the reader to find a
symbol even if its name isn't present in its full form in the source
-code. Of course, the reader needs to be aware of some pre-established
-context about such shorthands, much as one needs context to be to able
-to refer uniquely to Jan Jones by just the name ``Jan'': it's probably
-fine when amongst the Joneses, or when Jan has been mentioned
-recently, but very ambiguous in any other situation.
-@xref{Shorthands}.
+code. @xref{Shorthands}.
@cindex interning
If a symbol with the desired name is found, the reader uses that
@@ -236,23 +218,6 @@ to gain access to it is by finding it in some other object
or as the
value of a variable. Uninterned symbols are sometimes useful in
generating Lisp code, see below.
- In Emacs Lisp, an obarray is actually a vector. Each element of the
-vector is a bucket; its value is either an interned symbol whose name
-hashes to that bucket, or 0 if the bucket is empty. Each interned
-symbol has an internal link (invisible to the user) to the next symbol
-in the bucket. Because these links are invisible, there is no way to
-find all the symbols in an obarray except using @code{mapatoms} (below).
-The order of symbols in a bucket is not significant.
-
- In an empty obarray, every element is 0, so you can create an obarray
-with @code{(make-vector @var{length} 0)}. @strong{This is the only
-valid way to create an obarray.} Prime numbers as lengths tend
-to result in good hashing; lengths one less than a power of two are also
-good.
-
- @strong{Do not try to put symbols in an obarray yourself.} This does
-not work---only @code{intern} can enter a symbol in an obarray properly.
-
@cindex CL note---symbol in obarrays
@quotation
@b{Common Lisp note:} Unlike Common Lisp, Emacs Lisp does not provide
@@ -262,9 +227,21 @@ Emacs Lisp provides a different namespacing system called
``shorthands'' (@pxref{Shorthands}).
@end quotation
+@defun obarray-make &optional size
+This function creates and returns a new obarray.
+The optional @var{size} may be used to specify the number of symbols
+that it is expected to hold, but since obarrays grow automatically
+as needed, this rarely provides any benefit.
+@end defun
+
+@defun obarrayp object
+This function returns @code{t} if @var{object} is an obarray,
+@code{nil} otherwise.
+@end defun
+
Most of the functions below take a name and sometimes an obarray as
arguments. A @code{wrong-type-argument} error is signaled if the name
-is not a string, or if the obarray is not a vector.
+is not a string, or if the obarray is not an obarray object.
@defun symbol-name symbol
This function returns the string that is @var{symbol}'s name. For example:
@@ -416,6 +393,10 @@ If @code{unintern} does delete a symbol, it returns
@code{t}. Otherwise
it returns @code{nil}.
@end defun
+@defun obarray-clear obarray
+This function removes all symbols from @var{obarray}.
+@end defun
+
@node Symbol Properties
@section Symbol Properties
@cindex symbol property
@@ -761,6 +742,23 @@ instead of @code{snu-}.
;; End:
@end example
+Note that if you have two shorthands in the same file where one is the
+prefix of the other, the longer shorthand will be attempted first.
+This happens regardless of the order you specify shorthands in the
+local variables section of your file.
+
+@example
+'(
+ t//foo ; reads to 'my-tricks--foo', not 'my-tricks-/foo'
+ t/foo ; reads to 'my-tricks-foo'
+ )
+
+;; Local Variables:
+;; read-symbol-shorthands: (("t/" . "my-tricks-")
+;; ("t//" . "my-tricks--")
+;; End:
+@end example
+
@subsection Exceptions
There are two exceptions to rules governing Shorthand transformations:
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index f14e74bc785..fe3dc573df5 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -6266,9 +6266,13 @@ this function does is to restore the value of the
variable
If the buffer of a window of @var{configuration} has been killed since
@var{configuration} was made, that window is, as a rule, removed from
-the restored configuration. However, if that window is the last
-window remaining in the restored configuration, another live buffer is
-shown in it.
+the restored configuration. However, if that window is the last window
+remaining in the restored configuration, another live buffer is shown in
+it. Also, if the variable @var{window-kept-windows-functions} is
+non-@code{nil}, any window whose buffer is now dead is not deleted.
+Rather, this function will show another live buffer in that window and
+include an entry for that window when calling any function in
+@var{window-kept-windows-functions} (@pxref{Window Hooks}).
Here is a way of using this function to get the same effect as
@code{save-window-excursion}:
@@ -6357,6 +6361,15 @@ a live window, it is replaced by a new live window
created on the same
frame before putting @var{state} into it. If @var{window} is @code{nil},
it puts the window state into a new window.
+If the buffer of any window recorded in @var{state} has been killed
+since @var{state} was made, that window is, as a rule, not restored.
+However, if that window is the only window in @var{state}, another live
+buffer will be shown in it. Also, if the variable
+@var{window-kept-windows-functions} is non-@code{nil}, any window whose
+buffer is now dead is restored. This function will show another live
+buffer in it and include an entry for that window when calling a
+function in @var{window-kept-windows-functions} (@pxref{Window Hooks}).
+
If the optional argument @var{ignore} is non-@code{nil}, it means to ignore
minimum window sizes and fixed-size restrictions. If @var{ignore}
is @code{safe}, this means windows can get as small as one line
@@ -6623,6 +6636,27 @@ Lock fontification function, which will be called
whenever parts of a
buffer are (re)fontified because a window was scrolled or its size
changed. @xref{Other Font Lock Variables}.
+@cindex window kept windows functions
+@defvar window-kept-windows-functions
+ This variable holds a list of functions that Emacs will call after
+restoring a window configuration via @code{set-window-configuration} or
+state via @code{window-state-put} (@pxref{Window Configurations}). When
+the value of this variable is non-@code{nil}, these functions will not
+delete any window whose buffer has been killed since the corresponding
+configuration or state was saved, but show some live buffer in it.
+
+The value should be a list of functions that take two arguments. The
+first argument specifies the frame whose windows have been restored.
+The second argument specifies a list of entries for each window whose
+buffer has been found dead at the time @code{set-window-configuration}
+or @code{window-state-put} tried to restore it. Each entry is a list of
+four values - the window whose buffer was found dead, the dead buffer,
+and the last known positions of start and point of the buffer in that
+window. Any function run by this hook should check that the window is
+live since another function run by this hook may have deleted it in the
+meantime.
+@end defvar
+
@cindex window change functions
The remainder of this section covers six hooks that are called
during redisplay provided a significant, non-scrolling change of a
diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi
index 27a9e2b0ebb..f450b9cbdd9 100644
--- a/doc/misc/epa.texi
+++ b/doc/misc/epa.texi
@@ -289,6 +289,15 @@ also ask you whether or not to sign the text before
encryption and if
you answered yes, it will let you select the signing keys.
@end deffn
+@defvar epa-keys-select-method
+This variable controls the method used for key selection in
+@code{epa-select-keys}. The default value @code{buffer} pops up a
+special buffer where you can select the keys. If the value is
+@code{minibuffer}, @code{epa-select-keys} will instead prompt for the
+keys in the minibuffer, where you should type the keys separated by
+commas.
+@end defvar
+
@node Cryptographic operations on files
@section Cryptographic Operations on Files
@cindex cryptographic operations on files
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index f877fb681fe..c7ab7e7bf21 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -1230,25 +1230,30 @@ machine Example.Net login aph-bot password sesame
(defun my-erc-up (network)
(interactive "Snetwork: ")
-
- (pcase network
- ('libera
- (let ((erc-sasl-mechanism 'external))
- (erc-tls :server "irc.libera.chat" :port 6697
- :client-certificate t)))
- ('example
- (let ((erc-sasl-auth-source-function
- #'erc-sasl-auth-source-password-as-host))
- (erc-tls :server "irc.example.net" :port 6697
- :user "alyssa"
- :password "Example.Net")))))
+ (require 'erc-sasl)
+ (or (let ((erc-modules (cons 'sasl erc-modules)))
+ (pcase network
+ ('libera
+ (let ((erc-sasl-mechanism 'external))
+ (erc-tls :server "irc.libera.chat"
+ :client-certificate t)))
+ ('example
+ (let ((erc-sasl-auth-source-function
+ #'erc-sasl-auth-source-password-as-host))
+ (erc-tls :server "irc.example.net"
+ :user "alyssa"
+ :password "Example.Net")))))
+ ;; Non-SASL
+ (call-interactively #'erc-tls)))
@end lisp
You've started storing your credentials with auth-source and have
decided to try SASL on another network as well. But there's a catch:
this network doesn't support @samp{EXTERNAL}. You use
-@code{let}-binding to get around this and successfully authenticate to
-both networks.
+@code{let}-binding to work around this and successfully authenticate
+to both networks. (Note that this example assumes you've removed
+@code{sasl} from @code{erc-modules} globally and have instead opted to
+add it locally when connecting to preconfigured networks.)
@end itemize
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index da5e1ef1d03..30c85da795b 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -3,7 +3,7 @@
@setfilename ../../info/eshell.info
@settitle Eshell: The Emacs Shell
@include docstyle.texi
-@defindex cm
+@defcodeindex cm
@syncodeindex vr fn
@c %**end of header
@@ -416,7 +416,7 @@ elisp, The Emacs Lisp Reference Manual}).
@end table
@node Built-ins
-@section Built-in commands
+@section Built-in Commands
Eshell provides a number of built-in commands, many of them
implementing common command-line utilities, but enhanced for Eshell.
(These built-in commands are just ordinary Lisp functions whose names
@@ -477,98 +477,133 @@ default target for the commands @command{cp},
@command{mv}, and
@command{ln} is the current directory.
A few commands are wrappers for more niche Emacs features, and can be
-loaded as part of the eshell-xtra module. @xref{Extension modules}.
+loaded as part of the @code{eshell-xtra} module. @xref{Extra built-in
+commands}.
+
+@menu
+* List of Built-ins::
+* Defining New Built-ins::
+@end menu
+
+@node List of Built-ins
+@subsection List of Built-in Commands
@table @code
-@item .
@cmindex .
-Source an Eshell file in the current environment. This is not to be
-confused with the command @command{source}, which sources a file in a
-subshell environment.
+@item . @var{file} [@var{argument}]@dots{}
+Source an Eshell script named @var{file} in the current environment,
+passing any @var{arguments} to the script (@pxref{Scripts}). This is
+not to be confused with the command @command{source}, which sources a
+file in a subshell environment.
-@item addpath
@cmindex addpath
-Adds a given path or set of paths to the PATH environment variable, or,
-with no arguments, prints the current paths in this variable.
+@item addpath
+@itemx addpath [-b] @var{directory}@dots{}
+Adds each specified @var{directory} to the @code{$PATH} environment
+variable. By default, this adds the directories to the end of
+@code{$PATH}, in the order they were passed on the command line; by
+passing @code{-b} or @code{--begin}, Eshell will instead add the
+directories to the beginning.
+
+With no directories, print the list of directories currently stored in
+@code{$PATH}.
-@item alias
@cmindex alias
-Define an alias (@pxref{Aliases}). This adds it to the aliases file.
+@item alias
+@itemx alias @var{name} [@var{command}]
+Define an alias named @var{name} and expanding to @var{command},
+adding it to the aliases file (@pxref{Aliases}). If @var{command} is
+omitted, delete the alias named @var{name}. With no arguments at all,
+list all the currently-defined aliases.
-@item basename
@cmindex basename
-Return a file name without its directory.
+@item basename @var{filename}
+Return @var{filename} without its directory.
-@item cat
@cmindex cat
-Concatenate file contents into standard output. If in a pipeline, or
-if the file is not a regular file, directory, or symlink, then this
-command reverts to the system's definition of @command{cat}.
+@item cat @var{file}@dots{}
+Concatenate the contents of @var{file}s to standard output. If in a
+pipeline, or if any of the files is not a regular file, directory, or
+symlink, then this command reverts to the system's definition of
+@command{cat}.
-@item cd
@cmindex cd
-This command changes the current working directory. Usually, it is
-invoked as @kbd{cd @var{dir}} where @file{@var{dir}} is the new
-working directory. But @command{cd} knows about a few special
-arguments:
+@cindex directories, changing
+@item cd
+@itemx cd @var{directory}
+@itemx cd -[@var{n}]
+@itemx cd =[@var{regexp}]
+Change the current working directory. This command can take several
+forms:
-@itemize @minus{}
-@item
-When it receives no argument at all, it changes to the home directory.
+@table @code
-@item
-Giving the command @kbd{cd -} changes back to the previous working
-directory (this is the same as @kbd{cd $-}).
+@item cd
+Change to the user's home directory.
-@item
-The command @kbd{cd =} shows the directory ring. Each line is
-numbered.
+@item cd @var{directory}
+Change to the specified @var{directory}.
-@item
-With @kbd{cd =foo}, Eshell searches the directory ring for a directory
-matching the regular expression @samp{foo}, and changes to that
-directory.
+@item cd -
+Change back to the previous working directory (this is the same as
+@kbd{cd $-}).
-@item
-With @kbd{cd -42}, you can access the directory stack slots by number.
+@item cd -@var{n}
+Change to the directory in the @var{nth} slot of the directory stack.
+
+@item cd =
+Show the directory ring. Each line is numbered.
+
+@item cd =@var{regexp}
+Search the directory ring for a directory matching the regular
+expression @var{regexp} and change to that directory.
+
+@end table
-@item
@vindex eshell-cd-shows-directory
@vindex eshell-list-files-after-cd
If @code{eshell-cd-shows-directory} is non-@code{nil}, @command{cd}
will report the directory it changes to. If
@code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls}
is called with any remaining arguments after changing directories.
-@end itemize
-@item clear
@cmindex clear
+@item clear [@var{scrollback}]
Scrolls the contents of the Eshell window out of sight, leaving a
-blank window. If provided with an optional non-@code{nil} argument,
-the scrollback contents are cleared instead.
+blank window. If @var{scrollback} is non-@code{nil}, the scrollback
+contents are cleared instead, as with @command{clear-scrollback}.
-@item clear-scrollback
@cmindex clear-scrollback
+@item clear-scrollback
Clear the scrollback contents of the Eshell window. Unlike the
command @command{clear}, this command deletes content in the Eshell
buffer.
-@item compile
@cmindex compile
+@item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{}
Run an external command, sending its output to a compilation buffer if
the command would output to the screen and is not part of a pipeline
-or subcommand. This is particularly useful when defining aliases, so
+or subcommand.
+
+With the @code{-p} or @code{--plain} options, always send the output
+to the Eshell buffer; similarly, with @code{-i} or
+@code{--interactive}, always send the output to a compilation buffer.
+You can also set the mode of the compilation buffer with @code{-m
+@var{mode-name}} or @code{--mode @var{mode-name}}.
+
+@command{compile} is particularly useful when defining aliases, so
that interactively, the output shows up in a compilation buffer, but
you can still pipe the output elsewhere if desired. For example, if
you have a grep-like command on your system, you might define an alias
for it like so: @samp{alias mygrep 'compile --mode=grep-mode -- mygrep
$*'}.
-@item cp
@cmindex cp
-Copy a file to a new location or copy multiple files to the same
-directory.
+@item cp [@var{option}@dots{}] @var{source} @var{dest}
+@item cp [@var{option}@dots{}] @var{source}@dots{} @var{directory}
+Copy the file @var{source} to @var{dest} or @var{source} into
+@var{directory}.
@vindex eshell-cp-overwrite-files
@vindex eshell-cp-interactive-query
@@ -577,61 +612,145 @@ If @code{eshell-cp-overwrite-files} is non-@code{nil},
then
@code{eshell-cp-interactive-query} is non-@code{nil}, then
@command{cp} will ask before overwriting anything.
-@item date
+@command{cp} accepts the following options:
+
+@table @asis
+
+@item @code{-a}, @code{--archive}
+Equivalent to @code{--no-dereference --preserve --recursive}.
+
+@item @code{-d}, @code{--no-dereference}
+Don't dereference symbolic links when copying; instead, copy the link
+itself.
+
+@item @code{-f}, @code{--force}
+Never prompt for confirmation before copying a file.
+
+@item @code{-i}, @code{--interactive}
+Prompt for confirmation before copying a file if the target already
+exists.
+
+@item @code{-n}, @code{--preview}
+Run the command, but don't copy anything. This is useful if you
+want to preview what would be removed when calling @command{cp}.
+
+@item @code{-p}, @code{--preserve}
+Attempt to preserve file attributes when copying.
+
+@item @code{-r}, @code{-R}, @code{--recursive}
+Copy any specified directories and their contents recursively.
+
+@item @code{-v}, @code{--verbose}
+Print the name of each file before copying it.
+
+@end table
+
@cmindex date
+@item date [@var{specified-time} [@var{zone}]]
Print the current local time as a human-readable string. This command
-is similar to, but slightly different from, the GNU Coreutils
-@command{date} command.
+is an alias to the Emacs Lisp function @code{current-time-string}
+(@pxref{Time of Day,,, elisp, GNU Emacs Lisp Reference Manual}).
-@item diff
@cmindex diff
-Compare files using Emacs's internal @code{diff} (not to be confused
-with @code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs
-Manual}.
+@item diff [@var{option}]@dots{} @var{old} @var{new}
+Compare the files @var{old} and @var{new} using Emacs's internal
+@code{diff} (not to be confused with @code{ediff}). @xref{Comparing
+Files, , , emacs, The GNU Emacs Manual}.
@vindex eshell-plain-diff-behavior
If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this
command does not use Emacs's internal @code{diff}. This is the same
as using @samp{alias diff '*diff $@@*'}.
-@item dirname
@cmindex dirname
-Return the directory component of a file name.
+@item dirname @var{filename}
+Return the directory component of @var{filename}.
-@item dirs
@cmindex dirs
+@cindex directory stack, listing
+@item dirs
Prints the directory stack. Directories can be added or removed from
the stack using the commands @command{pushd} and @command{popd},
respectively.
-@item du
@cmindex du
-Summarize disk usage for each file.
+@item du [@var{option}]@dots{} @var{file}@dots{}
+Summarize disk usage for each file, recursing into directories.
+
+@command{du} accepts the following options:
+
+@table @asis
+
+@item @code{-a}, @code{--all}
+Print sizes for files, not just directories.
+
+@item @code{--block-size=@var{size}}
+Print sizes as number of blocks of size @var{size}.
+
+@item @code{-b}, @code{--bytes}
+Print file sizes in bytes.
+
+@item @code{-c}, @code{--total}
+Print a grand total of the sizes at the end.
+
+@item @code{-d}, @code{--max-depth=@var{depth}}
+Only print sizes for directories (or files with @code{--all}) that are
+@var{depth} or fewer levels below the command line arguments.
+
+@item @code{-h}, @code{--human-readable}
+Print sizes in human-readable format, with binary prefixes (so 1 KB is
+1024 bytes).
+
+@item @code{-H}, @code{--si}
+Print sizes in human-readable format, with decimal prefixes (so 1 KB
+is 1000 bytes).
+
+@item @code{-k}, @code{--kilobytes}
+Print file sizes in kilobytes (like @code{--block-size=1024}).
+
+@item @code{-L}, @code{--dereference}
+Follow symbolic links when traversing files.
+
+@item @code{-m}, @code{--megabytes}
+Print file sizes in megabytes (like @code{--block-size=1048576}).
+
+@item @code{-s}, @code{--summarize}
+Don't recurse into subdirectories (like @code{--max-depth=0}).
+
+@item @code{-x}, @code{--one-file-system}
+Skip any directories that reside on different filesystems.
+
+@end table
-@item echo
@cmindex echo
-Echoes its input. By default, this prints in a Lisp-friendly fashion
-(so that the value is useful to a Lisp command using the result of
-@command{echo} as an argument). If a single argument is passed,
-@command{echo} prints that; if multiple arguments are passed, it
-prints a list of all the arguments; otherwise, it prints the empty
-string.
+@item echo [-n | -N] [@var{arg}]@dots{}
+Prints the value of each @var{arg}. By default, this prints in a
+Lisp-friendly fashion (so that the value is useful to a Lisp command
+using the result of @command{echo} as an argument). If a single
+argument is passed, @command{echo} prints that; if multiple arguments
+are passed, it prints a list of all the arguments; otherwise, it
+prints the empty string.
@vindex eshell-plain-echo-behavior
If @code{eshell-plain-echo-behavior} is non-@code{nil}, @command{echo}
will try to behave more like a plain shell's @command{echo}, printing
each argument as a string, separated by a space.
-@item env
+You can control whether @command{echo} outputs a trailing newline
+using @code{-n} to disable the trailing newline (the default behavior)
+or @code{-N} to enable it (the default when
+@code{eshell-plain-echo-behavior} is non-@code{nil}).
+
@cmindex env
+@item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{}
With no arguments, print the current environment variables. If you
pass arguments to this command, then @command{env} will execute the
arguments as a command. If you pass any initial arguments of the form
@samp{@var{var}=@var{value}}, @command{env} will first set @var{var}
to @var{value} before running the command.
-@item eshell-debug
@cmindex eshell-debug
+@item eshell-debug [error | form | process]@dots{}
Toggle debugging information for Eshell itself. You can pass this
command one or more of the following arguments:
@@ -651,72 +770,95 @@ buffer @code{*eshell last cmd*}; or
@end itemize
-@item exit
@cmindex exit
+@item exit
@vindex eshell-kill-on-exit
Exit Eshell and save the history. By default, this command kills the
Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then
the buffer is merely buried instead.
-@item export
@cmindex export
+@item export [@var{name}=@var{value}]@dots{}
Set environment variables using input like Bash's @command{export}, as
in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}.
-@item grep
@cmindex grep
-@itemx agrep
+@item grep [@var{arg}]@dots{}
@cmindex agrep
-@itemx egrep
+@itemx agrep [@var{arg}]@dots{}
@cmindex egrep
-@itemx fgrep
+@itemx egrep [@var{arg}]@dots{}
@cmindex fgrep
-@itemx rgrep
+@itemx fgrep [@var{arg}]@dots{}
@cmindex rgrep
-@itemx glimpse
+@itemx rgrep [@var{arg}]@dots{}
@cmindex glimpse
+@itemx glimpse [@var{arg}]@dots{}
The @command{grep} commands are compatible with GNU @command{grep},
-but use Emacs's internal @code{grep} instead.
+but open a compilation buffer in @code{grep-mode} instead.
@xref{Grep Searching, , , emacs, The GNU Emacs Manual}.
@vindex eshell-plain-grep-behavior
If @code{eshell-plain-grep-behavior} is non-@code{nil}, then these
-commands do not use Emacs's internal @code{grep}. This is the same as
-using @samp{alias grep '*grep $@@*'}, though this setting applies to
-all of the built-in commands for which you would need to create a
-separate alias.
+commands do not use open a compilation buffer, instead printing output
+to Eshell's buffer. This is the same as using @samp{alias grep '*grep
+$@@*'}, though this setting applies to all of the built-in commands
+for which you would need to create a separate alias.
-@item history
@cmindex history
-Prints Eshell's input history. With a numeric argument @var{N}, this
-command prints the @var{N} most recent items in the history.
+@item history [@var{n}]
+@itemx history [-arw] [@var{filename}]
+Prints Eshell's input history. With a numeric argument @var{n}, this
+command prints the @var{n} most recent items in the history.
+Alternately, you can specify the following options:
+
+@table @asis
+
+@item @code{-a}, @code{--append}
+Append new history items to the history file.
+
+@item @code{-r}, @code{--read}
+Read history items from the history file and append them to the
+current shell's history.
+
+@item @code{-w}, @code{--write}
+Write the current history list to the history file.
+
+@end table
-@item info
@cmindex info
-Browse the available Info documentation. This command is the same as
-the external @command{info} command, but uses Emacs's internal Info
-reader.
-@xref{Misc Help, , , emacs, The GNU Emacs Manual}.
+@item info [@var{manual} [@var{item}]@dots{}]
+Browse the available Info documentation. With no arguments, browse
+the top-level menu. Otherwise, show the manual for @var{manual},
+selecting the menu entry for @var{item}.
+
+This command is the same as the external @command{info} command, but
+uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The
+GNU Emacs Manual}.
-@item jobs
@cmindex jobs
+@cindex processes, listing
+@item jobs
List subprocesses of the Emacs process, if any, using the function
@code{list-processes}.
-@item kill
@cmindex kill
+@cindex processes, signaling
+@item kill [-@var{signal}] [@var{pid} | @var{process}]
Kill processes. Takes a PID or a process object and an optional
-signal specifier which can either be a number or a signal name.
+@var{signal} specifier which can either be a number or a signal name.
-@item listify
@cmindex listify
-Eshell version of @code{list}. Allows you to create a list using Eshell
-syntax, rather than Elisp syntax. For example, @samp{listify foo bar}
-and @code{("foo" "bar")} both evaluate to @code{("foo" "bar")}.
+@item listify [@var{arg}]@dots{}
+Return the arguments as a single list. With a single argument, return
+it as-is if it's already a list, or otherwise wrap it in a list. With
+multiple arguments, return a list of all of them.
-@item ln
@cmindex ln
-Create links to files.
+@item ln [@var{option}]@dots{} @var{target} [@var{link-name}]
+@itemx ln [@var{option}]@dots{} @var{target}@dots{} @var{directory}
+Create a link to the specified @var{target} named @var{link-name} or
+create links to multiple @var{targets} in @var{directory}.
@vindex eshell-ln-overwrite-files
@vindex eshell-ln-interactive-query
@@ -725,8 +867,31 @@ will overwrite files without warning. If
@code{eshell-ln-interactive-query} is non-@code{nil}, then
@command{ln} will ask before overwriting files.
-@item locate
+@command{ln} accepts the following options:
+
+@table @asis
+
+@item @code{-f}, @code{--force}
+Never prompt for confirmation before linking a target.
+
+@item @code{-i}, @code{--interactive}
+Prompt for confirmation before linking to an item if the source
+already exists.
+
+@item @code{-n}, @code{--preview}
+Run the command, but don't move anything. This is useful if you
+want to preview what would be linked when calling @command{ln}.
+
+@item @code{-s}, @code{--symbolic}
+Make symbolic links instead of hard links.
+
+@item @code{-v}, @code{--verbose}
+Print the name of each file before linking it.
+
+@end table
+
@cmindex locate
+@item locate @var{arg}@dots{}
Alias to Emacs's @code{locate} function, which simply runs the external
@command{locate} command and parses the results.
@xref{Dired and Find, , , emacs, The GNU Emacs Manual}.
@@ -736,51 +901,129 @@ If @code{eshell-plain-locate-behavior} is
non-@code{nil}, then Emacs's
internal @code{locate} is not used. This is the same as using
@samp{alias locate '*locate $@@*'}.
-@item ls
@cmindex ls
-Lists the contents of directories.
+@item ls [@var{option}]@dots{} [@var{file}]@dots{}
+List information about each @var{file}, including the contents of any
+specified directories. If @var{file} is unspecified, list the
+contents of the current directory.
+
+@vindex eshell-ls-initial-args
+The user option @code{eshell-ls-initial-args} contains a list of
+arguments to include with any call to @command{ls}. For example, you
+can include the option @option{-h} to always use a more human-readable
+format.
@vindex eshell-ls-use-colors
If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a
directory is color-coded according to file type and status. These
colors and the regexps used to identify their corresponding files can
-be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls @key{RET}}}.
+be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls
+@key{RET}}}.
+
+@command{ls} supports the following options:
+
+@table @asis
+
+@item @code{-a}, @code{--all}
+List all files, including ones starting with @samp{.}.
+
+@item @code{-A}, @code{--almost-all}
+Like @code{--all}, but don't list the current directory (@file{.}) or
+the parent directory (@file{..}).
+
+@item @code{-c}, @code{--by-ctime}
+Sort files by last status change time, with newest files first.
+
+@item @code{-C}
+List entries by columns.
+
+@item @code{-d}, @code{--directory}
+List directory entries instead of their contents.
+
+@item @code{-h}, @code{--human-readable}
+Print sizes in human-readable format, with binary prefixes (so 1 KB is
+1024 bytes).
+
+@item @code{-H}, @code{--si}
+Print sizes in human-readable format, with decimal prefixes (so 1 KB
+is 1000 bytes).
+
+@item @code{-I@var{pattern}}, @code{--ignore=@var{pattern}}
+Don't list directory entries matching @var{pattern}.
+
+@item @code{-k}, @code{--kilobytes}
+Print sizes as 1024-byte kilobytes.
@vindex eshell-ls-date-format
-The user option @code{eshell-ls-date-format} determines how the date
-is displayed when using the @option{-l} option. The date is produced
-using the function @code{format-time-string} (@pxref{Time Parsing,,,
-elisp, GNU Emacs Lisp Reference Manual}).
+@item @code{-l}
+Use a long listing format showing details for each file. The user
+option @code{eshell-ls-date-format} determines how the date is
+displayed when using this option. The date is produced using the
+function @code{format-time-string} (@pxref{Time Parsing,,, elisp, GNU
+Emacs Lisp Reference Manual}).
-@vindex eshell-ls-initial-args
-The user option @code{eshell-ls-initial-args} contains a list of
-arguments to include with any call to @command{ls}. For example, you
-can include the option @option{-h} to always use a more human-readable
-format.
+@item @code{-L}, @code{--dereference}
+Follow symbolic links when listing entries.
+
+@item @code{-n}, @code{--numeric-uid-gid}
+Show UIDs and GIDs numerically, instead of using their names.
+
+@item @code{-r}, @code{--reverse}
+Reverse order when sorting.
+
+@item @code{-R}, @code{--recursive}
+List subdirectories recursively.
+
+@item @code{-s}, @code{--size}
+Show the size of each file in blocks.
@vindex eshell-ls-default-blocksize
-The user option @code{eshell-ls-default-blocksize} determines the
-default blocksize used when displaying file sizes with the option
-@option{-s}.
+@item @code{-S}
+Sort by file size, with largest files first. The user option
+@code{eshell-ls-default-blocksize} determines the default blocksize
+used when displaying file sizes with this option.
+
+@item @code{-t}
+Sort by modification time, with newest files first.
+
+@item @code{-u}
+Sort by last access time, with newest files first.
+
+@item @code{-U}
+Do not sort results. Instead, list entries in their directory order.
+
+@item @code{-x}
+List entries by lines instead of by columns.
+
+@item @code{-X}
+Sort alphabetically by file extension.
+
+@item @code{-1}
+List one file per line.
+
+@end table
-@item make
@cmindex make
+@item make [@var{arg}]@dots{}
Run @command{make} through @code{compile} when run asynchronously
(e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs
Manual}. Otherwise call the external @command{make} command.
-@item man
@cmindex man
+@item man [@var{arg}]@dots{}
Display Man pages using the Emacs @code{man} command.
@xref{Man Page, , , emacs, The GNU Emacs Manual}.
-@item mkdir
@cmindex mkdir
-Make new directories.
+@item mkdir [-p] @var{directory}@dots{}
+Make new directories. With @code{-p} or @code{--parents},
+automatically make any necessary parent directories as well.
-@item mv
@cmindex mv
-Move or rename files.
+@item mv [@var{option}]@dots{} @var{source} @var{dest}
+@itemx mv [@var{option}]@dots{} @var{source}@dots{} @var{directory}
+Rename the file @var{source} to @var{dest} or move @var{source} into
+@var{directory}.
@vindex eshell-mv-overwrite-files
@vindex eshell-mv-interactive-query
@@ -789,40 +1032,95 @@ will overwrite files without warning. If
@code{eshell-mv-interactive-query} is non-@code{nil}, @command{mv}
will prompt before overwriting anything.
-@item occur
+@command{mv} accepts the following options:
+
+@table @asis
+
+@item @code{-f}, @code{--force}
+Never prompt for confirmation before moving an item.
+
+@item @code{-i}, @code{--interactive}
+Prompt for confirmation before moving an item if the target already
+exists.
+
+@item @code{-n}, @code{--preview}
+Run the command, but don't move anything. This is useful if you
+want to preview what would be moved when calling @command{mv}.
+
+@item @code{-v}, @code{--verbose}
+Print the name of each item before moving it.
+
+@end table
+
@cmindex occur
+@item occur @var{regexp} [@var{nlines}]
Alias to Emacs's @code{occur}.
@xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}.
-@item popd
@cmindex popd
+@cindex directory stack, removing from
+@item popd
+@item popd +@var{n}
Pop a directory from the directory stack and switch to a another place
-in the stack.
+in the stack. This command can take the following forms:
+
+@table @code
+
+@item popd
+Remove the current directory from the directory stack and change to
+the directory beneath it.
+
+@item popd +@var{n}
+Remove the current directory from the directory stack and change to
+the @var{nth} directory in the stack (counting from zero).
+
+@end table
-@item printnl
@cmindex printnl
-Print the arguments separated by newlines.
+@item printnl [@var{arg}]@dots{}
+Print all the @var{arg}s separated by newlines.
-@item pushd
@cmindex pushd
+@cindex directory stack, adding to
+@item pushd
+@itemx pushd @var{directory}
+@itemx pushd +@var{n}
Push the current directory onto the directory stack, then change to
-another directory.
+another directory. This command can take the following forms:
+
+@table @code
+
+@vindex eshell-pushd-tohome
+@item pushd
+Swap the current directory with the directory on the top of the stack.
+If @code{eshell-pushd-tohome} is non-@code{nil}, push the current
+directory onto the stack and change to the user's home directory (like
+@samp{pushd ~}).
@vindex eshell-pushd-dunique
+@item pushd @var{directory}
+Push the current directory onto the stack and change to
+@var{directory}. If @code{eshell-pushd-dunique} is non-@code{nil},
+then only unique directories will be added to the stack.
+
@vindex eshell-pushd-dextract
-If @code{eshell-pushd-dunique} is non-@code{nil}, then only unique
-directories will be added to the stack. If
-@code{eshell-pushd-dextract} is non-@code{nil}, then @samp{pushd
-+@var{n}} will pop the @var{n}th directory to the top of the stack.
+@item pushd +@var{n}
+Change to the @var{nth} directory in the directory stack (counting
+from zero), and ``rotate'' the stack by moving any elements before the
+@var{nth} to the bottom. If @code{eshell-pushd-dextract} is
+non-@code{nil}, then @samp{pushd +@var{n}} will instead pop the
+@var{n}th directory to the top of the stack.
+
+@end table
-@item pwd
@cmindex pwd
+@item pwd
Prints the current working directory.
-@item rm
@cmindex rm
+@item rm [@var{option}]@dots{} @var{item}@dots{}
Removes files, buffers, processes, or Emacs Lisp symbols, depending on
-the argument.
+the type of each @var{item}.
@vindex eshell-rm-interactive-query
@vindex eshell-rm-removes-directories
@@ -832,59 +1130,89 @@ will prompt before removing anything. If
@command{rm} can also remove directories. Otherwise, @command{rmdir}
is required.
-@item rmdir
+@command{rm} accepts the following options:
+
+@table @asis
+
+@item @code{-f}, @code{--force}
+Never prompt for confirmation before removing an item.
+
+@item @code{-i}, @code{--interactive}
+Prompt for confirmation before removing each item.
+
+@item @code{-n}, @code{--preview}
+Run the command, but don't remove anything. This is useful if you
+want to preview what would be removed when calling @command{rm}.
+
+@item @code{-r}, @code{-R}, @code{--recursive}
+Remove any specified directories and their contents recursively.
+
+@item @code{-v}, @code{--verbose}
+Print the name of each item before removing it.
+
+@end table
+
@cmindex rmdir
+@item rmdir @var{directory}@dots{}
Removes directories if they are empty.
-@item set
@cmindex set
+@item set [@var{var} @var{value}]@dots{}
Set variable values, using the function @code{set} like a command
(@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}).
-A variable name can be a symbol, in which case it refers to a Lisp
-variable, or a string, referring to an environment variable
+The value of @var{var} can be a symbol, in which case it refers to a
+Lisp variable, or a string, referring to an environment variable
(@pxref{Arguments}).
-@item setq
@cmindex setq
+@item setq [@var{symbol} @var{value}]@dots{}
Set variable values, using the function @code{setq} like a command
(@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}).
-@item source
@cmindex source
-Source an Eshell file in a subshell environment. This is not to be
-confused with the command @command{.}, which sources a file in the
-current environment.
+@item source @var{file} [@var{argument}]@dots{}
+Source an Eshell script named @var{file} in a subshell environment,
+passing any @var{argument}s to the script (@pxref{Scripts}). This is
+not to be confused with the command @command{.}, which sources a file
+in the current environment.
-@item time
@cmindex time
-Show the time elapsed during a command's execution.
+@item time @var{command}@dots{}
+Show the time elapsed during the execution of @var{command}.
-@item umask
@cmindex umask
-Set or view the default file permissions for newly created files and
-directories.
+@item umask [-S]
+@itemx umask @var{mode}
+View the default file permissions for newly created files and
+directories. If you pass @code{-S} or @code{--symbolic}, view the
+mode symbolically. With @var{mode}, set the default permissions to
+this value.
-@item unset
@cmindex unset
-Unset one or more variables. As with @command{set}, a variable name
-can be a symbol, in which case it refers to a Lisp variable, or a
-string, referring to an environment variable.
+@item unset [@var{var}]@dots{}
+Unset one or more variables. As with @command{set}, the value of
+@var{var} can be a symbol, in which case it refers to a Lisp variable,
+or a string, referring to an environment variable.
-@item wait
@cmindex wait
-Wait until a process has successfully completed.
+@cindex processes, waiting for
+@item wait [@var{process}]@dots{}
+Wait until each specified @var{process} has exited.
-@item which
@cmindex which
-Identify a command and its location.
+@item which @var{command}@dots{}
+For each @var{command}, identify what kind of command it is and its
+location.
-@item whoami
@cmindex whoami
-Print the current user. This Eshell version of @command{whoami}
-supports Tramp.
+@item whoami
+Print the current user. This Eshell version of @command{whoami} is
+connection-aware, so for remote directories, it will print the user
+associated with that connection.
@end table
-@subsection Defining new built-in commands
+@node Defining New Built-ins
+@subsection Defining New Built-in Commands
While Eshell can run Lisp functions directly as commands, it may be
more convenient to provide a special built-in command for
Eshell. Built-in commands are just ordinary Lisp functions designed
@@ -1180,7 +1508,7 @@ create and switch to a directory called @samp{foo}.
@node Remote Access
@section Remote Access
-@cmindex remote access
+@cindex remote access
Since Eshell uses Emacs facilities for most of its functionality, you
can access remote hosts transparently. To connect to a remote host,
@@ -1353,6 +1681,11 @@ sequence of commands, as with almost any other shell
script. Scripts
are invoked from Eshell with @command{source}, or from anywhere in Emacs
with @code{eshell-source-file}.
+Like with aliases (@pxref{Aliases}), Eshell scripts can accept any
+number of arguments. Within the script, you can refer to these with
+the special variables @code{$0}, @code{$1}, @dots{}, @code{$9}, and
+@code{$*}.
+
@cmindex .
If you wish to load a script into your @emph{current} environment,
rather than in a subshell, use the @code{.} command.
@@ -1452,7 +1785,7 @@ As with @samp{$@{@var{command}@}}, evaluates the Eshell
command invocation
@command{@var{command}}, but writes the output to a temporary file and
returns the file name.
-@item $@var{expr}[@var{i...}]
+@item $@var{expr}[@var{i@dots{}}]
Expands to the @var{i}th element of the result of @var{expr}, an
expression in one of the above forms listed here. If multiple indices
are supplied, this will return a list containing the elements for each
@@ -1501,7 +1834,7 @@ Multiple sets of indices can also be specified. For
example, if
expand to @code{2}, i.e.@: the second element of the first list member
(all indices are zero-based).
-@item $@var{expr}[@var{regexp} @var{i...}]
+@item $@var{expr}[@var{regexp} @var{i@dots{}}]
As above (when @var{expr} expands to a string), but use @var{regexp}
to split the string. @var{regexp} can be any form other than a
number. For example, @samp{$@var{var}[: 0]} will return the first
@@ -2275,15 +2608,23 @@ external commands. To enable it, add
@code{eshell-tramp} to
@table @code
-@item su
@cmindex su
-@itemx sudo
+@item su [- | -l] [@var{user}]
+Uses TRAMP's @command{su} method (@pxref{Inline methods, , , tramp,
+The Tramp Manual}) to change the current user to @var{user} (or root
+if unspecified). With @code{-}, @code{-l}, or @code{--login}, provide
+a login environment.
+
@cmindex sudo
-@itemx doas
+@item sudo [-u @var{user}] [-s | @var{command}@dots{}]
@cmindex doas
-Uses TRAMP's @command{su}, @command{sudo}, or @command{doas} method
-(@pxref{Inline methods, , , tramp, The Tramp Manual}) to run a command
-via @command{su}, @command{sudo}, or @command{doas}.
+@itemx doas [-u @var{user}] [-s | @var{command}@dots{}]
+Uses TRAMP's @command{sudo} or @command{doas} method (@pxref{Inline
+methods, , , tramp, The Tramp Manual}) to run @var{command} as root
+via @command{sudo} or @command{doas}. When specifying @code{-u
+@var{user}} or @code{--user @var{user}}, run the command as @var{user}
+instead. With @code{-s} or @code{--shell}, start a shell instead of
+running @var{command}.
@end table
@@ -2296,59 +2637,59 @@ add @code{eshell-xtra} to @code{eshell-modules-list}.
@table @code
-@item count
@cmindex count
+@item count @var{item} @var{seq} [@var{option}]@dots{}
A wrapper around the function @code{cl-count} (@pxref{Searching
Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can
be used for comparing lists of strings.
-@item expr
@cmindex expr
+@item expr @var{str} [@var{separator}] [@var{arg}]@dots{}
An implementation of @command{expr} using the Calc package.
@xref{Top,,, calc, The GNU Emacs Calculator}.
-@item ff
@cmindex ff
+@item ff @var{directory} @var{pattern}
Shorthand for the the function @code{find-name-dired} (@pxref{Dired
and Find, , , emacs, The Emacs Editor}).
-@item gf
@cmindex gf
+@item gf @var{directory} @var{regexp}
Shorthand for the the function @code{find-grep-dired} (@pxref{Dired
and Find, , , emacs, The Emacs Editor}).
-@item intersection
@cmindex intersection
+@item intersection @var{list1} @var{list2} [@var{option}]@dots{}
A wrapper around the function @code{cl-intersection} (@pxref{Lists as
Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command
can be used for comparing lists of strings.
-@item mismatch
@cmindex mismatch
+@item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{}
A wrapper around the function @code{cl-mismatch} (@pxref{Searching
Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can
be used for comparing lists of strings.
-@item set-difference
@cmindex set-difference
+@item set-difference @var{list1} @var{list2} [@var{option}]@dots{}
A wrapper around the function @code{cl-set-difference} (@pxref{Lists
as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be
used for comparing lists of strings.
-@item set-exclusive-or
@cmindex set-exclusive-or
+@item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{}
A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists
as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be
used for comparing lists of strings.
-@item substitute
@cmindex substitute
+@item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{}
A wrapper around the function @code{cl-substitute} (@pxref{Sequence
Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can
be used for comparing lists of strings.
-@item union
@cmindex union
+@item union @var{list1} @var{list2} [@var{option}]@dots{}
A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,,
cl, GNU Emacs Common Lisp Emulation}). This command can be used for
comparing lists of strings.
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 5e69b11d347..d31fcf1802b 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -192,6 +192,15 @@ history press @kbd{H} (@code{eww-list-histories}) to open
the history
buffer @file{*eww history*}. The history is lost when EWW is quit.
If you want to remember websites you can use bookmarks.
+@vindex eww-before-browse-history-function
+ By default, when browsing to a new page from a ``historical'' one
+(i.e.@: a page loaded by navigating back via @code{eww-back-url}), EWW
+will first delete any history entries newer than the current page. This
+is the same behavior as most other web browsers. You can change this by
+customizing @code{eww-before-browse-history-function} to another value.
+For example, setting it to @code{ignore} will preserve the existing
+history entries and simply prepend the new page to the history list.
+
@vindex eww-history-limit
Along with the URLs visited, EWW also remembers both the rendered
page (as it appears in the buffer) and its source. This can take a
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 08554d0d9b9..419a5390374 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -5832,10 +5832,11 @@ message to the mailing list, and include the original
message
@kindex S v @r{(Summary)}
@findex gnus-summary-very-wide-reply
Mail a very wide reply to the author of the current article
-(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a reply
-that goes out to all people listed in the @code{To}, @code{From} (or
-@code{Reply-To}) and @code{Cc} headers in all the process/prefixed
-articles. This command uses the process/prefix convention.
+(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a
+reply that goes out to all people listed in the @code{To}, @code{From}
+(or @code{Reply-To}) and @code{Cc} headers in all the process/prefixed
+articles. This command uses the process/prefix convention. If given a
+prefix argument, the body of the current article will also be yanked.
@item S V
@kindex S V @r{(Summary)}
@@ -26694,9 +26695,12 @@ buffers. It is enabled with
@table @kbd
@item C-c C-m C-a
@findex gnus-dired-attach
+@vindex gnus-dired-attach-at-end
@cindex attachments, selection via dired
Send dired's marked files as an attachment (@code{gnus-dired-attach}).
-You will be prompted for a message buffer.
+The function prompts for a message buffer, and by default attaches files
+to the end of that buffer; customize @code{gnus-dired-attach-at-end} to
+place the attachments at point instead.
@item C-c C-m C-l
@findex gnus-dired-find-file-mailcap
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index e8c382f5967..93d592193a0 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{2023-09-19.19}
+\def\texinfoversion{2024-02-10.22}
%
-% Copyright 1985, 1986, 1988, 1990-2023 Free Software Foundation, Inc.
+% Copyright 1985, 1986, 1988, 1990-2024 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
@@ -5238,14 +5238,14 @@ $$%
% the current value of \escapechar.
\def\escapeisbackslash{\escapechar=`\\}
-% Use \ in index files by default. texi2dvi didn't support @ as the escape
-% character (as it checked for "\entry" in the files, and not "@entry"). When
-% the new version of texi2dvi has had a chance to become more prevalent, then
-% the escape character can change back to @ again. This should be an easy
-% change to make now because both @ and \ are only used as escape characters in
-% index files, never standing for themselves.
+% Uncomment to use \ in index files by default. Old texi2dvi (before 2019)
+% didn't support @ as the escape character (as it checked for "\entry" in
+% the files, and not "@entry").
+% In the future we can remove this flag and simplify the code for
+% index files and backslashes, once the support is no longer likely to be
+% useful.
%
-\set txiindexescapeisbackslash
+% \set txiindexescapeisbackslash
% Write the entry in \indextext to the index file.
%
@@ -6137,8 +6137,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% normally unnmhead0 calls unnumberedzzz:
\outer\parseargdef\unnumbered{\unnmhead0{#1}}
\def\unnumberedzzz#1{%
- \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
- \global\advance\unnumberedno by 1
+ \global\advance\unnumberedno by 1
%
% Since an unnumbered has no number, no prefix for figures.
\global\let\chaplevelprefix = \empty
@@ -6194,8 +6193,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% normally calls unnumberedseczzz:
\outer\parseargdef\unnumberedsec{\unnmhead1{#1}}
\def\unnumberedseczzz#1{%
- \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1
- \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}%
+ \global\advance\unnumberedno by 1
+ \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno}%
}
% Subsections.
@@ -6218,9 +6217,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% normally calls unnumberedsubseczzz:
\outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}}
\def\unnumberedsubseczzz#1{%
- \global\subsubsecno=0 \global\advance\subsecno by 1
- \sectionheading{#1}{subsec}{Ynothing}%
- {\the\unnumberedno.\the\secno.\the\subsecno}%
+ \global\advance\unnumberedno by 1
+ \sectionheading{#1}{subsec}{Ynothing}{\the\unnumberedno}%
}
% Subsubsections.
@@ -6244,9 +6242,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% normally unnumberedsubsubseczzz:
\outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}}
\def\unnumberedsubsubseczzz#1{%
- \global\advance\subsubsecno by 1
- \sectionheading{#1}{subsubsec}{Ynothing}%
- {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}%
+ \global\advance\unnumberedno by 1
+ \sectionheading{#1}{subsubsec}{Ynothing}{\the\unnumberedno}%
}
% These macros control what the section commands do, according
@@ -8205,8 +8202,6 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\let\commondummyword\unmacrodo
\xdef\macrolist{\macrolist}%
\endgroup
- \else
- \errmessage{Macro #1 not defined}%
\fi
}
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 56945d3071c..131a23b7423 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -488,24 +488,28 @@ an @command{ssh} server:
@file{@trampfn{plink,user@@host,/path/to/file}}.
-@anchor{Quick Start Guide su, sudo, doas and sg methods}
-@section Using @option{su}, @option{sudo}, @option{doas} and @option{sg}
+@anchor{Quick Start Guide su, sudo, doas, androidsu and sg methods}
+@section Using @option{su}, @option{sudo}, @option{doas}, @option{androidsu}
and @option{sg}
@cindex method @option{su}
@cindex @option{su} method
@cindex method @option{sudo}
@cindex @option{sudo} method
@cindex method @option{doas}
@cindex @option{doas} method
+@cindex method @option{androidsu}
+@cindex @option{androidsu} method
@cindex method @option{sg}
@cindex @option{sg} method
Sometimes, it is necessary to work on your local host under different
permissions. For this, you can use the @option{su} or @option{sudo}
connection method. On OpenBSD systems, the @option{doas} connection
-method offers the same functionality. These methods use @samp{root}
-as default user name and the return value of @code{(system-name)} as
-default host name. Therefore, it is convenient to open a file as
-@file{@trampfn{sudo,,/path/to/file}}.
+method offers the same functionality. If your local system is
+Android, use the method @option{androidsu} instead of @option{su}.
+
+These methods use @samp{root} as default user name and the return
+value of @code{(system-name)} as default host name. Therefore, it is
+convenient to open a file as @file{@trampfn{sudo,,/path/to/file}}.
The method @option{sg} stands for ``switch group''; here the user name
is used as the group to change to. The default host name is the same.
@@ -525,7 +529,7 @@ is used as the group to change to. The default host name
is the same.
@cindex @option{doas} method
If the @option{su}, @option{sudo} or @option{doas} option should be
-performed on another host, it can be comnbined with a leading
+performed on another host, it can be combined with a leading
@option{ssh} or @option{plink} option. That means that @value{tramp}
connects first to the other host with non-administrative credentials,
and changes to administrative credentials on that host afterwards. In
@@ -819,6 +823,17 @@ editing as another user. The host can be either
@samp{localhost} or
the host returned by the function @command{(system-name)}. See
@ref{Multi-hops} for an exception to this behavior.
+@item @option{androidsu}
+@cindex method @option{androidsu}
+@cindex @option{androidsu} method
+Because the default implementation of the @option{su} method and other
+shell-based methods conflict with non-standard @command{su}
+implementations popular among Android users and the restricted
+command-line utilities distributed with that system, a largely
+equivalent @option{androidsu} method is provided for that system with
+workarounds for its many idiosyncrasies, with the exception that
+multi-hops are unsupported.
+
@item @option{sudo}
@cindex method @option{sudo}
@cindex @option{sudo} method
@@ -1059,6 +1074,20 @@ session.
These methods support the @samp{-P} argument.
+@item @option{dockercp}
+@item @option{podmancp}
+@cindex method @option{dockercp}
+@cindex @option{dockercp} method
+@cindex method @option{podmancp}
+@cindex @option{podmancp} method
+
+These methods are similar to @option{docker} or @option{podman}, but
+they use the command @command{docker cp} or @command{podman cp} for
+transferring large files.
+
+These copy commands do not support file globs, and they ignore a user
+name.
+
@item @option{fcp}
@cindex method @option{fcp}
@cindex @option{fcp} method
@@ -2036,7 +2065,7 @@ machine @var{host} port sudo login @var{user} password
secret
@var{user} and @var{host} are the strings returned by
@code{(user-login-name)} and @code{(system-name)}. If one of these
-methods is connected via a multi hop (@pxref{Multi-hops}), the
+methods is connected via a multi-hop (@pxref{Multi-hops}), the
credentials of the previous hop are used.
@vindex auth-source-save-behavior
@@ -5238,9 +5267,14 @@ Does @value{tramp} support @acronym{SSH} security keys?
Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware
devices via special key types @option{*-sk}. @value{tramp} supports
the additional handshaking messages for them. This requires at least
-@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible
-security key, like yubikey, solokey, nitrokey, or titankey.
-
+@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} or
+@acronym{FIDO2} compatible security key, like yubikey, solokey,
+nitrokey, or titankey.
+@c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/}
+
+@strong{Note} that there are reports on problems of handling FIDO2
+(residential) keys by @command{ssh-agent}. As workaround, you might
+disable @command{ssh-agent} for such keys.
@item
@value{tramp} does not connect to Samba or MS Windows hosts running
diff --git a/doc/translations/README b/doc/translations/README
new file mode 100644
index 00000000000..02edb829dcf
--- /dev/null
+++ b/doc/translations/README
@@ -0,0 +1,211 @@
+* Translating the Emacs manuals
+
+** Copyright assignment
+
+People who contribute translated documents should provide a copyright
+assignment to the Free Software Foundation. See the "Copyright
+Assignment" section in the Emacs manual.
+
+
+** Translated documents license
+
+The translated documents are distributed under the same license as the
+original documents: the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation.
+
+See https://www.gnu.org/licenses/fdl-1.3.html for more information.
+
+If you have any questions regarding the use of the FDL license in your
+translation work that do not appear in the FAQ, feel free to contact the
+GNU project.
+
+See https://www.gnu.org/contact/ for more information.
+
+** Location of the translated files
+
+*** Texinfo source files
+
+The source files of the translated manuals are located in the
+doc/translations directory, under the sub-directory corresponding to the
+translated language.
+
+ E.g., French manual sources are found under doc/translations/fr.
+
+The structure of each language's folder should match that of the English
+manuals (i.e. include misc, man, lispref, lispintro, emacs).
+
+*** Built files
+
+Translated deliverables in Info format are built at release time and are
+made available for local installation.
+
+
+** Source files format
+
+The manuals and their translations are written in the Texinfo format
+(with the exception of the org-mode manual, which is written in Org, and
+illustrations for the Introduction to Emacs Lisp Programming, which are
+EPS files).
+
+See https://www.gnu.org/software/Texinfo/ for more information.
+
+You must install the Texinfo package in order to verify the translated
+files, and refer to the Texinfo manual for information on the various
+Texinfo features.
+
+Emacs has a Texinfo mode that highlights the parts of the Texinfo code
+to be translated for easy reference.
+
+
+*** Texinfo specific issues
+
+Until the Emacs/Texinfo projects provide better solutions, here are a
+few rules to follow:
+
+- Under each @node, add an @anchor that has the same content as the
+ original English @node.
+
+- Translate the @node content but leave the @anchor in English.
+
+- Most Emacs manuals are set to include the docstyle.Texi file. This
+ file adds the "@documentencoding UTF-8" directive to the targeted
+ manual. There is no need to add this directive in a manual that
+ includes docstyle.texi.
+
+- Add a @documentlanguage directive that includes your language.
+
+ E.g., @documentlanguage zh
+
+This directive currently has little effect but will be useful in the
+future.
+
+- The @author directive can be used for the translator's name.
+
+ E.g., @author traduit en français par Achile Talon
+
+
+** Fixing the original document
+
+During the course of the translation, you might encounter passages in
+the original document that need to be updated or otherwise corrected, or
+even run into a bug in Emacs. If you cannot immediately correct the
+problem, please file a bug report promptly.
+
+See the 'Bugs' section in the Emacs manual.
+
+** Sending your contributions
+
+Send your contributions (files or revisions) for review to the Emacs
+development list at emacs-devel@gnu.org. Subscribing to the list is not
+obligatory.
+
+Always send contributions in the format of the original document. Most
+of the content in the Emacs manuals is in Texinfo format, so please do
+not send contributions in derivative formats (e.g. info, html, docbook,
+plain text, etc.)
+
+Before sending files for review, please ensure that they have been
+thoroughly checked for spelling/grammar/typography by at least using the
+tools provided by Emacs.
+
+Please also make sure that the Texinfo files build properly on your
+system.
+
+Send your contributions as patches (git diff -p --stat), and prefer the
+git format-patch form, since that format allows for easier review and
+easier installation of the changes by the persons with write access to
+the repository.
+
+The Emacs project has a lot of coding, documentation and commenting
+conventions. Sending such patches allows the project managers to make
+sure that the contributions comply with the various conventions.
+
+
+** Discussing translation issues
+
+Translation-related discussions are welcome on the emacs development
+list. Discussions specific to your language do not have to be in
+English.
+
+
+** Translation teams
+
+The number of words in the Emacs manuals is over 2,000,000 words and
+growing. While one individual could theoretically translate all the
+files, it is more practical to work in language teams.
+
+If you have a small group of translators willing to help, please make
+sure that the files are properly reviewed before sending them to the
+Emacs development list (see above).
+
+Please refer to the translation-related documents maintained by the GNU
+Project, and contact your language translation team to learn the
+practices they have developed over the years.
+
+See https://www.gnu.org/server/standards/README.translations.html for
+more information.
+
+
+** Translation processes
+
+Emacs does not yet provide tools that significantly help the translation
+process. A few useful functions would be:
+
+- automatic lookup of a list of glossary items when starting to work on
+ a translation "unit" (paragraph or otherwise); such glossary terms
+ should be easily insertable at point,
+
+- automatic lookup of past translations to check for similarity and
+ improve homogeneity over the whole document set; such past translation
+ matches should be easily insertable at point, etc.
+
+
+*** Using the PO format as an intermediate translation format
+
+Although the PO format has not been developed with documentation in
+mind, it is well-known among free software translation teams, and you
+can easily use the po4a utility to convert Texinfo to PO for work in
+translation tools that support the PO format.
+
+See https://po4a.org for more information.
+
+However, regardless of the intermediate file format that you might use,
+you should only send files in the original format (Texinfo, org-mode,
+eps) for review and installation.
+
+
+*** Free tools that you can use in your processes
+
+A number of free software tools are available outside the Emacs project,
+to help translators (both amateur and professional) in the translation
+process.
+
+If they have any features that you think Emacs should implement, you are
+welcome to provide patches to the Emacs project.
+
+Such tools include:
+
+- the GNOME Translation Editor, https://wiki.gnome.org/Apps/Gtranslator/
+- KDE's Lokalize, https://apps.kde.org/lokalize/
+- OmegaT, https://omegat.org
+- the Okapi Framework, https://www.okapiframework.org
+- pootle, https://pootle.translatehouse.org
+
+etc.
+
+
+* Licence of this document
+
+Copyright (C) 2024 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification, are
+permitted in any medium without royalty provided the copyright notice
+and this notice are preserved. This file is offered as-is, without any
+warranty.
+
+
+Local Variables:
+mode: outline
+paragraph-separate: "[ ]*$"
+coding: utf-8
+End:
diff --git a/doc/lang/fr/misc/ses-fr.texi b/doc/translations/fr/misc/ses-fr.texi
similarity index 100%
rename from doc/lang/fr/misc/ses-fr.texi
rename to doc/translations/fr/misc/ses-fr.texi
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 1e88500d169..d7f513addfb 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -334,6 +334,11 @@ has changed in some way. At present, ERC does not perform
this step
automatically on your behalf, even if a change was made in a
'Custom-mode' buffer or via 'setopt'.
+** New broadcast-oriented slash commands /AME, /GME, and /GMSG.
+Also available as the library functions 'erc-cmd-AME', 'erc-cmd-GME',
+and 'erc-cmd-GMSG', these new slash commands can prove handy in test
+environments.
+
** Miscellaneous UX changes.
Some minor quality-of-life niceties have finally made their way to
ERC. For example, fool visibility has become togglable with the new
@@ -502,6 +507,16 @@ encouraged to keep a module's name aligned with its
group's as well as
the provided feature of its containing library, if only for the usual
reasons of namespace hygiene and discoverability.
+*** The function 'erc-open' no longer uses the 'TGT-LIST' parameter.
+ERC has always used the parameter to initialize the local variable
+'erc-default-recipients', which stores a list of routing targets with
+the topmost considered "active." However, since at least ERC 5.1, a
+buffer and its active target effectively mate for life, making
+'TGT-LIST', in practice, a read-only list of a single target. And
+because that target must also appear as the 'CHANNEL' parameter,
+'TGT-LIST' mainly serves to reinforce 'erc-open's reputation of being
+unruly.
+
*** ERC supports arbitrary CHANTYPES.
Specifically, channels can be prefixed with any predesignated
character, mainly to afford more flexibility to specialty services,
@@ -684,8 +699,6 @@ by toggling a provided compatibility switch. See source
code around
the function 'erc-send-action' for details.
*** Miscellaneous changes
-Two helper macros from GNU ELPA's Compat library are now available to
-third-party modules as 'erc-compat-call' and 'erc-compat-function'.
In 'erc-button-alist', 'Info-goto-node' has been supplanted by plain
old 'info', and the "<URL:...>" entry has been removed because it was
more or less redundant. In all ERC buffers, the "<TAB>" key is now
@@ -1367,7 +1380,7 @@ reconnection attempts that ERC will make per server.
in seconds, that ERC will wait between successive reconnect attempts.
*** erc-server-send-ping-timeout: Determines when to consider a connection
-stalled and restart it. The default is after 120 seconds.
+stalled and restart it. The default is after 120 seconds.
*** erc-system-name: Determines the system name to use when logging in.
The default is to figure this out by calling `system-name'.
@@ -2328,7 +2341,7 @@ in XEmacs.
Please use M-x customize-variable RET erc-modules RET to change the
default if it does not suite your needs.
-** THe symbol used in `erc-nickserv-passwords' for debian.org IRC servers
+** The symbol used in `erc-nickserv-passwords' for debian.org IRC servers
(formerly called OpenProjects, now FreeNode) has changed from
openprojects to freenode. You may need to update your configuration
for a successful automatic nickserv identification.
diff --git a/etc/NEWS b/etc/NEWS
index 816613de4ec..2e51c0490fe 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -62,6 +62,16 @@ more details.
* 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
+additional parent.
+This way, things like `.dir-locals.el` settings, and YASnippet
+collections of snippets automatically apply to the new Tree-Sitter modes.
+
+Note that those modes still do not inherit from the non-TS mode, so
+configuration settings installed via mode hooks are not affected.
+
+++
** URL now never sends user email addresses in HTTP requests.
Emacs never sent email addresses by default, but it used to be
@@ -76,7 +86,7 @@ see the variable 'url-request-extra-headers'.
+++
** 'completion-auto-help' now affects 'icomplete-in-buffer'.
-Previously, completion-auto-help mostly affected only minibuffer
+Previously, 'completion-auto-help' mostly affected only minibuffer
completion. Now, if 'completion-auto-help' has the value 'lazy', then
Icomplete's in-buffer display of possible completions will only appear
after the 'completion-at-point' command has been invoked twice, and if
@@ -85,12 +95,12 @@ 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 when the *Completions* buffer would
-appear when using 'icomplete-in-buffer'. Now the *Completions* buffer
+** 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
and Icomplete's in-buffer display of possible completions always
appear together. If you would prefer to see only Icomplete's
-in-buffer display, and not the *Completions* buffer, you can add this
+in-buffer display, and not the "*Completions*" buffer, you can add this
to your init:
(advice-add 'completion-at-point :after #'minibuffer-hide-completions)
@@ -130,6 +140,17 @@ the signature) the automatically inferred function type as
well.
This user option controls outline visibility in the output buffer of
'describe-bindings' when 'describe-bindings-outline' is non-nil.
+---
+*** 'C-h m' ('describe-mode') uses outlining by default.
+Set 'describe-mode-outline' to nil to get back the old behavior.
+
+** Outline Mode
+
++++
+*** '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'.
+
** 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
@@ -258,16 +279,20 @@ right-aligned to is controlled by the new user option
** Windows
-*** New action alist entry 'post-command-select-window' for display-buffer.
+*** 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.
** Tab Bars and Tab Lines
+---
*** 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 optional argument for modifying directory-local variables.
The commands 'add-dir-local-variable', 'delete-dir-local-variable' and
@@ -305,8 +330,17 @@ between the auto save file and the current file.
---
** 'ffap-lax-url' now defaults to nil.
-Previously, it was set to 'ffap-lax-url' to t but this broke remote file
-name detection.
+Previously, it was set to t but this broke remote file name detection.
+
++++
+** Multi-character key echo now ends with a suggestion to use Help.
+Customize 'echo-keystrokes-help' to nil to prevent that.
+
++++
+** 'read-passwd' can toggle the visibility of passwords.
+Use 'TAB' in the minibuffer to show or hide the password. Likewise,
+there is an icon on the mode-line, which toggles the visibility of the
+password when clicking with 'mouse-1'.
* Editing Changes in Emacs 30.1
@@ -412,6 +446,10 @@ 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
@@ -420,6 +458,11 @@ respectively, in addition to the existing translations
'C-x 8 / e' and
* Changes in Specialized Modes and Packages in Emacs 30.1
+---
+** Titdic-cnv
+Most of the variables and functions in the file have been renamed to
+make sure they all use a 'tit-' namespace prefix.
+
---
** Trace
In batch mode, tracing now sends the trace to stdout.
@@ -433,7 +476,7 @@ configurations such as X11 when the X server does not
support at least
version 2.1 of the X Input Extension, and 'xterm-mouse-mode'.
** 'xterm-mouse-mode'
-This mode now emits `wheel-up/down/right/left' events instead of
+This mode now emits 'wheel-up/down/right/left' events instead of
'mouse-4/5/6/7' events for the mouse wheel.
It uses the 'mouse-wheel-up/down/left/right-event'
variables to decide which button maps to which wheel event (if any).
@@ -442,11 +485,14 @@ variables to decide which button maps to which wheel
event (if any).
---
*** New user option 'Info-url-alist'.
-This user option associates manual-names with URLs. It affects the
+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.
+
+++
** New command 'lldb'.
Run the LLDB debugger, analogous to the 'gud-gdb' command.
@@ -574,6 +620,14 @@ It allows tweaking the thresholds for rename and copy
detection.
** Diff mode
+---
+*** New user option 'diff-refine-nonmodified'.
+When this is non-nil, 'diff-refine' will highlight lines that were added
+or removed in their entirety (as opposed to modified lines, where 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,
@@ -691,7 +745,7 @@ arguments of the form 'VAR=VALUE', 'env' will first set
'VAR' to
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
files and deny read permission for users who are not members of the
-file's group. See the Info node '(coreutils)File permissions' for
+file's group. See the Info node "(coreutils) File permissions" for
more information on this notation.
+++
@@ -810,14 +864,14 @@ 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',
-'group-function'. You can now customize them for any category in
+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', 'cycle-sort-function'.
+'group-function', 'display-sort-function', and 'cycle-sort-function'.
** Pcomplete
@@ -866,6 +920,16 @@ mode line. 'header' will display in the header line;
** Tramp
++++
+*** New 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 connection methods "dockercp" and "podmancp".
+These are the external methods counterparts of "docker" and "podman".
+
+++
*** New connection methods "toolbox" and "flatpak".
They allow accessing system containers provided by Toolbox or
@@ -964,6 +1028,19 @@ When invoked with the prefix argument ('C-u'),
This is useful for continuing reading the URL in the current buffer
when the new URL is fetched.
+---
+*** History navigation in EWW now works like 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.
+This made it impossible to navigate to the "end" of the history list.
+Now, navigating through history in EWW simply changes your position in
+the history list, allowing you to reach the end as expected. In
+addition, when browsing to a new page from a "historical" one (i.e. a
+page loaded by navigating back through history), EWW deletes the history
+entries newer than the current page. To change the behavior when
+browsing from "historical" pages, you can customize
+'eww-before-browse-history-function'.
+
** go-ts-mode
+++
@@ -1059,8 +1136,8 @@ 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
+** 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
buffers contain Javascript code.
@@ -1099,6 +1176,12 @@ 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 user option '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.
+
** Rmail
---
@@ -1195,8 +1278,8 @@ 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 option with the same name or
-use the command cperl-set-style.
+change the default style, either use the user option with the same name
+or use the command 'cperl-set-style'.
*** Commands using the Perl info page are obsolete.
The Perl documentation in info format is no longer distributed with
@@ -1304,21 +1387,56 @@ will return the URL for that bug.
This allows for rcirc logs to use a custom timestamp format, than the
chat buffers use by default.
+---
+*** New user option 'Buffer-menu-group-by'.
+It controls how buffers are divided into groups that are displayed with
+headings using Outline minor mode.
+
+---
+*** 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.
+Previously, such buffers were never shown. This command is bound to 'I'
+in Buffer Menu mode.
+
** 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.
+
** 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
+*** 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
and U+002F SOLIDUS, which result in division rather than a rational
-fraction. You may also be interested to know that precomposed
-fraction characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are
-also recognized as rational fractions. They have been since 2004, but
-it looks like it was never mentioned in the NEWS, or even the manual.
+fraction. You may also be interested to know that precomposed fraction
+characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are also
+recognized as rational fractions. They have been since 2004, but it
+looks like it was never mentioned in the NEWS, or even the 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
+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
+buffer method is the default, which preserves previous behavior.
+
* New Modes and Packages in Emacs 30.1
@@ -1374,23 +1492,30 @@ 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 Compat.
+Emacs now comes with a stub implementation of the
+forwards-compatibility Compat package from GNU ELPA. This allows
+built-in packages to use the library more effectively, and helps
+preventing the installation of Compat if unnecessary.
+
* Incompatible Lisp Changes in Emacs 30.1
---
-** Old 'derived.el' functions removed.
+** Old derived.el functions removed.
The following functions have been deleted because they were only used
by code compiled with Emacs<21:
-'derived-mode-setup-function-name', 'derived-mode-init-mode-variables',
-'derived-mode-set-keymap', 'derived-mode-set-syntax-table',
-'derived-mode-set-abbrev-table', 'derived-mode-run-hooks',
+'derived-mode-init-mode-variables', 'derived-mode-merge-abbrev-tables',
'derived-mode-merge-keymaps', 'derived-mode-merge-syntax-tables',
-'derived-mode-merge-abbrev-tables'.
+'derived-mode-run-hooks', 'derived-mode-set-abbrev-table',
+'derived-mode-set-keymap', 'derived-mode-set-syntax-table',
+'derived-mode-setup-function-name'.
+++
** 'M-TAB' now invokes 'completion-at-point' also in Text mode.
By default, Text mode no longer binds 'M-TAB' to
-'ispell-complete-word'. Instead this mode arranges for
+'ispell-complete-word'. Instead, this mode arranges for
'completion-at-point', globally bound to 'M-TAB', to perform word
completion as well. You can have Text mode bind 'M-TAB' to
'ispell-complete-word' as it did in previous Emacs versions, or
@@ -1497,9 +1622,22 @@ values.
* Lisp Changes in Emacs 30.1
+** Built-in types have now corresponding classes.
+At the Lisp level, this means that things like (cl-find-class 'integer)
+will now return a class object, and at the UI level it means that
+things like 'C-h o integer RET' will show some information about that type.
+
+** New var '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 advice defined with 'define-advice' can now be removed with
+** '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)'.
@@ -1516,10 +1654,10 @@ It puts a limit to the amount by which Emacs can
temporarily increase
+++
** New special form 'handler-bind'.
-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".
+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 'pop-up-frames' action alist entry for 'display-buffer'.
@@ -1695,6 +1833,22 @@ Tree-sitter conditionally sets 'forward-sexp-function'
for major modes
that have defined 'sexp' in 'treesit-thing-settings' to enable
sexp-related motion commands.
++++
+** Returned strings are never docstrings.
+Functions and macros whose bodies consist of a single string literal now
+only return that string; it is not used as a docstring. Example:
+
+ (defun sing-a-song ()
+ "Sing a song.")
+
+The above function returns the string '"Sing a song."' but has no
+docstring. Previously, that string was used as both a docstring and
+return value, which was never what the programmer wanted. If you want
+the string to be a docstring, add an explicit return value.
+
+This change applies to 'defun', 'defsubst', 'defmacro' and 'lambda'
+forms; other defining forms such as 'cl-defun' already worked this way.
+
** New or changed byte-compilation warnings
---
@@ -1848,10 +2002,34 @@ 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.
+Example:
+
+ (defun my-fun ()
+ "Uses c:\remote\dir\files and the key \C-x."
+ ...)
+
+where the docstring contains the four control characters 'CR', 'DEL',
+'FF' and 'C-x'.
+
+The warning name is 'docstrings-control-chars'.
+
---
*** The warning about wide docstrings can now be disabled separately.
Its warning name is 'docstrings-wide'.
+---
+** 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
+default is to report all errors and only important warnings. If you
+were used to customizing 'native-comp-async-report-warnings-errors' to
+nil or 'silent', we suggest that you now leave it at its default value,
+and see if you get only warnings that matter.
+
+++
** New function declaration and property 'important-return-value'.
The declaration '(important-return-value t)' sets the
@@ -1920,6 +2098,31 @@ The 'test' parameter is omitted if it is 'eql' (the
default), as is
'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are
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
+automatically, which means that the size parameter to 'obarray-make' can
+safely be omitted. That is, they do not become slower as they fill up.
+
+The old vector representation is still accepted by functions operating
+on obarrays, but 'obarrayp' only returns t for obarray objects.
+'type-of' now returns 'obarray' for obarray objects.
+
+Old code which (incorrectly) created "obarrays" as Lisp vectors filled
+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
@@ -1928,6 +2131,16 @@ 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.
+
+---
+** 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.
+
* Changes in Emacs 30.1 on Non-Free Operating Systems
diff --git a/etc/NEWS.25 b/etc/NEWS.25
index 3c5e9569b49..f647809074b 100644
--- a/etc/NEWS.25
+++ b/etc/NEWS.25
@@ -1158,6 +1158,11 @@ few or no entries have changed.
* New Modes and Packages in Emacs 25.1
+** New preloaded package 'obarray'
+
+Provides obarray operations under the 'obarray-' prefix, such as
+'obarray-make', 'obarrayp', and 'obarray-map'.
+
** pinentry.el allows GnuPG passphrase to be prompted through the
minibuffer instead of a graphical dialog, depending on whether the gpg
command is called from Emacs (i.e., INSIDE_EMACS environment variable
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 048c56baa1a..19456640299 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -432,7 +432,7 @@ than the corresponding .el file.
Alternatively, if you set the option 'load-prefer-newer' non-nil,
Emacs will load whichever version of a file is the newest.
-*** Watch out for the EMACSLOADPATH environment variable
+*** Watch out for the EMACSLOADPATH environment variable.
EMACSLOADPATH overrides which directories the function "load" will search.
@@ -441,7 +441,7 @@ environment.
** Keyboard problems
-*** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier
+*** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier.
If you arrange for the Wayland compositor to send the Hyper key
modifier (e.g., via XKB customizations), the Hyper modifier will still
@@ -452,6 +452,17 @@ Since GDK 3.x is no longer developed, this bug in GDK will
probably
never be solved. And the Emacs PGTK build cannot yet support GTK4,
where this problem is reportedly solved.
+*** Emacs built with GTK lags in its response to keyboard input.
+This can happen when input methods are used. It happens because Emacs
+behaves in an unconventional way with respect to GTK input methods: it
+registers to receive keyboard input as unprocessed key events with
+metadata (as opposed to receiving them as text strings). Most GTK
+programs use the latter approach, so some modern input methods have
+bugs and misbehave when faced with the way Emacs does it.
+
+A workaround is to set GTK_IM_MODULE=none in the environment, or maybe
+find a different input method without these problems.
+
*** Unable to enter the M-| key on some German keyboards.
Some users have reported that M-| suffers from "keyboard ghosting".
This can't be fixed by Emacs, as the keypress never gets passed to it
@@ -476,6 +487,29 @@ You are probably using a shell that doesn't support job
control, even
though the system itself is capable of it. Either use a different shell,
or set the variable 'cannot-suspend' to a non-nil value.
+*** Emacs running on WSL receives stray characters as input.
+
+For example, you could see Emacs inserting 'z' characters even though
+nothing is typed on the keyboard, and even if you unplug the keyboard.
+
+The reason is a bug in the WSL X server's handling of key-press and
+key-repeat events. A workaround is to use the Cygwin or native
+MS-Windows build of Emacs instead.
+
+*** On MS-Windows, the Windows key gets "stuck".
+When this problem happens, Windows behaves as if the Windows key were
+permanently pressed down. This could be a side effect of Emacs on
+MS-Windows hooking keyboard input on a low level, in order to support
+registering the Windows keys as hot keys. If that hook takes too much
+time for some reason, Windows can decide to remove the hook, which
+then has this effect.
+
+This is arguably a bug in Emacs, for which we don't yet have a
+solution. To work around, set the 'LowLevelHooksTimeout' value in the
+registry key "HKEY_CURRENT_USER\Control Panel\Desktop" to a number
+higher than 200 msec; the maximum allowed value is 1000 msec (create
+the value if it doesn't exist under that key).
+
** Mailers and other helper programs
*** movemail compiled with POP support can't connect to the POP server.
@@ -545,15 +579,6 @@ As a workaround, input the passphrase with a GUI-capable
pinentry
program like 'pinentry-gnome' or 'pinentry-qt5'. Alternatively, you
can use the 'pinentry' package from Emacs 25.
-*** Emacs running on WSL receives stray characters as input.
-
-For example, you could see Emacs inserting 'z' characters even though
-nothing is typed on the keyboard, and even if you unplug the keyboard.
-
-The reason is a bug in the WSL X server's handling of key-press and
-key-repeat events. A workaround is to use the Cygwin or native
-MS-Windows build of Emacs instead.
-
** Problems with hostname resolution
*** Emacs does not know your host's fully-qualified domain name.
diff --git a/etc/TODO b/etc/TODO
index 0152cf9303e..52c77ccc28d 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -910,22 +910,6 @@ restore the redirection through funcall.
*** Features to be improved or missing
-**** Diagnostic
-
-***** Filtering async warnings
-
-Add a new 'native-comp-async-report-warnings-errors' value such that
-we filter out all the uninteresting warnings (that the programmer
-already got during byte compilation) but we still report the important
-ones ('the function ‘xxx’ is not known to be defined.').
-
-This way even if the package developer doesn't use native compilation
-it can get the bug report for the issue and
-'*Async-native-compile-log*' is not too crowded.
-
-This new value for 'native-comp-async-report-warnings-errors' should
-be default.
-
**** Fix portable dumping so that you can redump without using -batch
***** Redumps and native compiler "preloaded" sub-folder.
diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py
index fdf4314e2d0..9865fe391a2 100644
--- a/etc/emacs_lldb.py
+++ b/etc/emacs_lldb.py
@@ -56,6 +56,7 @@ class Lisp_Object:
"PVEC_BOOL_VECTOR": "struct Lisp_Bool_Vector",
"PVEC_BUFFER": "struct buffer",
"PVEC_HASH_TABLE": "struct Lisp_Hash_Table",
+ "PVEC_OBARRAY": "struct Lisp_Obarray",
"PVEC_TERMINAL": "struct terminal",
"PVEC_WINDOW_CONFIGURATION": "struct save_window_data",
"PVEC_SUBR": "struct Lisp_Subr",
diff --git a/etc/images/README b/etc/images/README
index a778d9ce6c3..8e112448373 100644
--- a/etc/images/README
+++ b/etc/images/README
@@ -125,7 +125,7 @@ For more information see the adwaita-icon-theme repository
at:
https://gitlab.gnome.org/GNOME/adwaita-icon-theme
-Emacs images and their source in the Adwaita/scalable directory:
+Emacs images and their source in the Adwaita/symbolic directory:
checked.svg ui/checkbox-checked-symbolic.svg
unchecked.svg ui/checkbox-symbolic.svg
@@ -137,3 +137,8 @@ Emacs images and their source in the Adwaita/scalable
directory:
left.svg ui/pan-start-symbolic.svg
right.svg ui/pan-end-symbolic.svg
up.svg ui/pan-up-symbolic.svg
+ conceal.svg actions/view-conceal-symbolic.svg
+ reveal.svg actions/view-reveal-symbolic.svg
+
+conceal.pbm and reveal.pbm are generated from the respective *.svg
+files, using the ImageMagick converter tool.
diff --git a/etc/images/conceal.pbm b/etc/images/conceal.pbm
new file mode 100644
index 00000000000..3df787d6fd6
Binary files /dev/null and b/etc/images/conceal.pbm differ
diff --git a/etc/images/conceal.svg b/etc/images/conceal.svg
new file mode 100644
index 00000000000..172b73ed3d3
--- /dev/null
+++ b/etc/images/conceal.svg
@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<svg height="16px" viewBox="0 0 16 16" width="16px"
xmlns="http://www.w3.org/2000/svg";>
+ <path d="m 1.53125 0.46875 l -1.0625 1.0625 l 14 14 l 1.0625 -1.0625 l
-2.382812 -2.382812 c 1.265624 -1.0625 2.171874 -2.496094 2.589843 -4.097657 c
-0.914062 -3.523437 -4.097656 -5.984375 -7.738281 -5.988281 c -1.367188
0.011719 -2.707031 0.371094 -3.894531 1.042969 z m 6.46875 3.53125 c 2.210938 0
4 1.789062 4 4 c -0.003906 0.800781 -0.246094 1.578125 -0.699219 2.238281 l
-1.46875 -1.46875 c 0.105469 -0.242187 0.164063 -0.503906 0.167969 -0.769531 c
0 -1.105469 -0.894531 -2 -2 -2 [...]
+</svg>
diff --git a/etc/images/reveal.pbm b/etc/images/reveal.pbm
new file mode 100644
index 00000000000..79d2f1f3307
Binary files /dev/null and b/etc/images/reveal.pbm differ
diff --git a/etc/images/reveal.svg b/etc/images/reveal.svg
new file mode 100644
index 00000000000..41ae3733a53
--- /dev/null
+++ b/etc/images/reveal.svg
@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<svg height="16px" viewBox="0 0 16 16" width="16px"
xmlns="http://www.w3.org/2000/svg";>
+ <path d="m 8 2 c -3.648438 0.003906 -6.832031 2.476562 -7.738281 6.007812
c 0.914062 3.527344 4.097656 5.988282 7.738281 5.992188 c 3.648438 -0.003906
6.832031 -2.476562 7.738281 -6.011719 c -0.914062 -3.523437 -4.097656 -5.984375
-7.738281 -5.988281 z m 0 2 c 2.210938 0 4 1.789062 4 4 s -1.789062 4 -4 4 s -4
-1.789062 -4 -4 s 1.789062 -4 4 -4 z m 0 2 c -1.105469 0 -2 0.894531 -2 2 s
0.894531 2 2 2 s 2 -0.894531 2 -2 s -0.894531 -2 -2 -2 z m 0 0" fill="#2e3436"/>
+</svg>
diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in
index b18446bece0..27af9c912fe 100644
--- a/java/AndroidManifest.xml.in
+++ b/java/AndroidManifest.xml.in
@@ -64,6 +64,132 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. -->
<uses-permission android:name="android.permission.RECORD_AUDIO" />
<uses-permission android:name="android.permission.CAMERA" />
+ <uses-permission android:name="android.permission.ACCEPT_HANDOVER" />
+ <uses-permission
android:name="android.permission.ACCESS_BACKGROUND_LOCATION" />
+ <uses-permission android:name="android.permission.ACCESS_FINE_LOCATION" />
+ <uses-permission android:name="android.permission.ACCESS_MEDIA_LOCATION" />
+ <uses-permission android:name="android.permission.ACCESS_NOTIFICATIONS" />
+ <uses-permission android:name="android.permission.ACTIVITY_RECOGNITION" />
+ <uses-permission android:name="android.permission.ANSWER_PHONE_CALLS" />
+ <uses-permission android:name="android.permission.BLUETOOTH_ADVERTISE" />
+ <uses-permission android:name="android.permission.BLUETOOTH_CONNECT" />
+ <uses-permission android:name="android.permission.BLUETOOTH_SCAN" />
+ <uses-permission android:name="android.permission.BODY_SENSORS" />
+ <uses-permission android:name="android.permission.BODY_SENSORS_BACKGROUND" />
+ <uses-permission android:name="android.permission.CALL_PHONE" />
+ <uses-permission
android:name="android.permission.CAPTURE_CONSENTLESS_BUGREPORT_ON_USERDEBUG_BUILD"
/>
+ <uses-permission android:name="android.permission.GET_ACCOUNTS" />
+ <uses-permission
android:name="android.permission.INSTANT_APP_FOREGROUND_SERVICE" />
+ <uses-permission android:name="android.permission.INTERACT_ACROSS_PROFILES"
/>
+ <uses-permission android:name="android.permission.LOADER_USAGE_STATS" />
+ <uses-permission android:name="android.permission.MANAGE_IPSEC_TUNNELS" />
+ <uses-permission android:name="android.permission.MANAGE_MEDIA" />
+ <uses-permission android:name="android.permission.MANAGE_ONGOING_CALLS" />
+ <uses-permission android:name="android.permission.NEARBY_WIFI_DEVICES" />
+ <uses-permission android:name="android.permission.PACKAGE_USAGE_STATS" />
+ <uses-permission android:name="android.permission.PROCESS_OUTGOING_CALLS" />
+ <uses-permission android:name="android.permission.READ_CALL_LOG" />
+ <uses-permission android:name="android.permission.READ_CELL_BROADCASTS" />
+ <uses-permission android:name="android.permission.READ_MEDIA_AUDIO" />
+ <uses-permission android:name="android.permission.READ_MEDIA_IMAGES" />
+ <uses-permission android:name="android.permission.READ_MEDIA_VIDEO" />
+ <uses-permission
android:name="android.permission.READ_MEDIA_VISUAL_USER_SELECTED" />
+ <uses-permission android:name="android.permission.READ_PHONE_NUMBERS" />
+ <uses-permission android:name="android.permission.READ_SMS" />
+ <uses-permission android:name="android.permission.RECEIVE_MMS" />
+ <uses-permission android:name="android.permission.RECEIVE_WAP_PUSH" />
+ <uses-permission android:name="android.permission.SCHEDULE_EXACT_ALARM" />
+ <uses-permission
android:name="android.permission.SMS_FINANCIAL_TRANSACTIONS" />
+ <uses-permission android:name="android.permission.TURN_SCREEN_ON" />
+ <uses-permission android:name="android.permission.USE_FULL_SCREEN_INTENT" />
+ <uses-permission
android:name="android.permission.USE_ICC_AUTH_WITH_DEVICE_IDENTIFIER" />
+ <uses-permission android:name="android.permission.USE_SIP" />
+ <uses-permission android:name="android.permission.UWB_RANGING" />
+ <uses-permission
android:name="android.permission.WIFI_ACCESS_COEX_UNSAFE_CHANNELS" />
+ <uses-permission android:name="android.permission.WRITE_CALL_LOG" />
+ <uses-permission android:name="android.permission.WRITE_SETTINGS" />
+
+ <uses-permission android:name="android.permission.ACCESS_ADSERVICES_AD_ID" />
+ <uses-permission
android:name="android.permission.ACCESS_ADSERVICES_ATTRIBUTION" />
+ <uses-permission
android:name="android.permission.ACCESS_ADSERVICES_CUSTOM_AUDIENCE" />
+ <uses-permission android:name="android.permission.ACCESS_ADSERVICES_TOPICS"
/>
+ <uses-permission
android:name="android.permission.ACCESS_LOCATION_EXTRA_COMMANDS" />
+ <uses-permission
android:name="android.permission.ACCESS_NOTIFICATION_POLICY" />
+ <uses-permission android:name="android.permission.ACCESS_WIFI_STATE" />
+ <uses-permission android:name="android.permission.AUTHENTICATE_ACCOUNTS" />
+ <uses-permission android:name="android.permission.BLUETOOTH" />
+ <uses-permission android:name="android.permission.BLUETOOTH_ADMIN" />
+ <uses-permission android:name="android.permission.BROADCAST_STICKY" />
+ <uses-permission android:name="android.permission.CHANGE_NETWORK_STATE" />
+ <uses-permission
android:name="android.permission.CHANGE_WIFI_MULTICAST_STATE" />
+ <uses-permission android:name="android.permission.CHANGE_WIFI_STATE" />
+ <uses-permission
android:name="android.permission.CREDENTIAL_MANAGER_QUERY_CANDIDATE_CREDENTIALS"
/>
+ <uses-permission
android:name="android.permission.CREDENTIAL_MANAGER_SET_ALLOWED_PROVIDERS" />
+ <uses-permission
android:name="android.permission.CREDENTIAL_MANAGER_SET_ORIGIN" />
+ <uses-permission
android:name="android.permission.DELIVER_COMPANION_MESSAGES" />
+ <uses-permission android:name="android.permission.DETECT_SCREEN_CAPTURE" />
+ <uses-permission android:name="android.permission.DISABLE_KEYGUARD" />
+ <uses-permission android:name="android.permission.ENFORCE_UPDATE_OWNERSHIP"
/>
+ <uses-permission android:name="android.permission.EXPAND_STATUS_BAR" />
+ <uses-permission android:name="android.permission.FLASHLIGHT" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_CAMERA"
/>
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_CONNECTED_DEVICE" />
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_DATA_SYNC" />
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_FILE_MANAGEMENT" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_HEALTH"
/>
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_LOCATION" />
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_MEDIA_PLAYBACK" />
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_MEDIA_PROJECTION" />
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_MICROPHONE" />
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_PHONE_CALL" />
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_REMOTE_MESSAGING" />
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_SYSTEM_EXEMPTED" />
+ <uses-permission android:name="android.permission.GET_PACKAGE_SIZE" />
+ <uses-permission android:name="android.permission.GET_TASKS" />
+ <uses-permission android:name="android.permission.HIDE_OVERLAY_WINDOWS" />
+ <uses-permission
android:name="android.permission.HIGH_SAMPLING_RATE_SENSORS" />
+ <uses-permission android:name="android.permission.KILL_BACKGROUND_PROCESSES"
/>
+ <uses-permission android:name="android.permission.MANAGE_ACCOUNTS" />
+ <uses-permission android:name="android.permission.MANAGE_OWN_CALLS" />
+ <uses-permission android:name="android.permission.MODIFY_AUDIO_SETTINGS" />
+ <uses-permission
android:name="android.permission.NFC_PREFERRED_PAYMENT_INFO" />
+ <uses-permission android:name="android.permission.NFC_TRANSACTION_EVENT" />
+ <uses-permission android:name="android.permission.PERSISTENT_ACTIVITY" />
+ <uses-permission android:name="android.permission.QUERY_ALL_PACKAGES" />
+ <uses-permission android:name="android.permission.READ_BASIC_PHONE_STATE" />
+ <uses-permission android:name="android.permission.READ_INSTALL_SESSIONS" />
+ <uses-permission
android:name="android.permission.READ_NEARBY_STREAMING_POLICY" />
+ <uses-permission android:name="android.permission.READ_PROFILE" />
+ <uses-permission android:name="android.permission.READ_SOCIAL_STREAM" />
+ <uses-permission android:name="android.permission.READ_SYNC_SETTINGS" />
+ <uses-permission android:name="android.permission.READ_SYNC_STATS" />
+ <uses-permission android:name="android.permission.READ_USER_DICTIONARY" />
+ <uses-permission android:name="android.permission.RECEIVE_BOOT_COMPLETED" />
+ <uses-permission android:name="android.permission.REORDER_TASKS" />
+ <uses-permission
android:name="android.permission.REQUEST_COMPANION_PROFILE_GLASSES" />
+ <uses-permission
android:name="android.permission.REQUEST_COMPANION_PROFILE_WATCH" />
+ <uses-permission
android:name="android.permission.REQUEST_COMPANION_RUN_IN_BACKGROUND" />
+ <uses-permission
android:name="android.permission.REQUEST_COMPANION_START_FOREGROUND_SERVICES_FROM_BACKGROUND"
/>
+ <uses-permission
android:name="android.permission.REQUEST_COMPANION_USE_DATA_IN_BACKGROUND" />
+ <uses-permission
android:name="android.permission.REQUEST_IGNORE_BATTERY_OPTIMIZATIONS" />
+ <uses-permission
android:name="android.permission.REQUEST_OBSERVE_COMPANION_DEVICE_PRESENCE" />
+ <uses-permission
android:name="android.permission.REQUEST_PASSWORD_COMPLEXITY" />
+ <uses-permission android:name="android.permission.RESTART_PACKAGES" />
+ <uses-permission android:name="android.permission.RUN_USER_INITIATED_JOBS" />
+ <uses-permission android:name="android.permission.SET_WALLPAPER_HINTS" />
+ <uses-permission android:name="android.permission.SUBSCRIBED_FEEDS_READ" />
+ <uses-permission android:name="android.permission.SUBSCRIBED_FEEDS_WRITE" />
+ <uses-permission
android:name="android.permission.UPDATE_PACKAGES_WITHOUT_USER_ACTION" />
+ <uses-permission android:name="android.permission.USE_BIOMETRIC" />
+ <uses-permission android:name="android.permission.USE_CREDENTIALS" />
+ <uses-permission android:name="android.permission.USE_EXACT_ALARM" />
+ <uses-permission android:name="android.permission.USE_FINGERPRINT" />
+ <uses-permission android:name="android.permission.WRITE_PROFILE" />
+ <uses-permission android:name="android.permission.WRITE_SMS" />
+ <uses-permission android:name="android.permission.WRITE_SOCIAL_STREAM" />
+ <uses-permission android:name="android.permission.WRITE_SYNC_SETTINGS" />
+ <uses-permission android:name="android.permission.WRITE_USER_DICTIONARY" />
+
<!-- This is required on Android 11 or later to access /sdcard. -->
<uses-permission android:name="android.permission.MANAGE_EXTERNAL_STORAGE"/>
diff --git a/java/debug.sh b/java/debug.sh
index 8fc03d014cf..c5d40141355 100755
--- a/java/debug.sh
+++ b/java/debug.sh
@@ -104,13 +104,14 @@ if [ -z "$devices" ]; then
exit 1
fi
-if [ -z $device ]; then
- device=$devices
+if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z $device ]; then
+ echo "Multiple devices are available. Please specify one with"
+ echo "the option --device and try again."
+ exit 1
fi
-if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z device ]; then
- echo "Multiple devices are available. Please pick one using"
- echo "--device and try again."
+if [ -z $device ]; then
+ device=$devices
fi
echo "Looking for $package on device $device"
@@ -189,6 +190,8 @@ if [ "$attach_existing" != "yes" ]; then
package_pids=`awk -f tmp.awk <<< $package_pids`
fi
+rm tmp.awk
+
pid=$package_pids
num_pids=`wc -w <<< "$package_pids"`
diff --git a/java/org/gnu/emacs/EmacsActivity.java
b/java/org/gnu/emacs/EmacsActivity.java
index 3237f650240..66a1e41d84c 100644
--- a/java/org/gnu/emacs/EmacsActivity.java
+++ b/java/org/gnu/emacs/EmacsActivity.java
@@ -97,7 +97,7 @@ public class EmacsActivity extends Activity
}
public static void
- invalidateFocus ()
+ invalidateFocus (int whence)
{
EmacsWindow oldFocus;
@@ -144,7 +144,7 @@ public class EmacsActivity extends Activity
layout.removeView (window.view);
window = null;
- invalidateFocus ();
+ invalidateFocus (0);
}
}
@@ -172,8 +172,17 @@ public class EmacsActivity extends Activity
if (isPaused)
window.noticeIconified ();
- /* Invalidate the focus. */
- invalidateFocus ();
+ /* Invalidate the focus. Since attachWindow may be called from
+ either the main or the UI thread, post this to the UI thread. */
+
+ runOnUiThread (new Runnable () {
+ @Override
+ public void
+ run ()
+ {
+ invalidateFocus (1);
+ }
+ });
}
@Override
@@ -238,6 +247,10 @@ public class EmacsActivity extends Activity
}
super.onCreate (savedInstanceState);
+
+ /* Call `onWindowFocusChanged' to read the focus state, which fails
+ to be called after an activity is recreated. */
+ onWindowFocusChanged (false);
}
@Override
@@ -261,7 +274,7 @@ public class EmacsActivity extends Activity
isMultitask = this instanceof EmacsMultitaskActivity;
manager.removeWindowConsumer (this, isMultitask || isFinishing ());
focusedActivities.remove (this);
- invalidateFocus ();
+ invalidateFocus (2);
/* Remove this activity from the static field, lest it leak. */
if (lastFocusedActivity == this)
@@ -274,9 +287,16 @@ public class EmacsActivity extends Activity
public final void
onWindowFocusChanged (boolean isFocused)
{
- if (isFocused && !focusedActivities.contains (this))
+ /* At times and on certain versions of Android ISFOCUSED does not
+ reflect whether the window actually holds focus, so replace it
+ with the value of `hasWindowFocus'. */
+ isFocused = hasWindowFocus ();
+
+ if (isFocused)
{
- focusedActivities.add (this);
+ if (!focusedActivities.contains (this))
+ focusedActivities.add (this);
+
lastFocusedActivity = this;
/* Update the window insets as the focus change may have
@@ -291,7 +311,7 @@ public class EmacsActivity extends Activity
else
focusedActivities.remove (this);
- invalidateFocus ();
+ invalidateFocus (3);
}
@Override
diff --git a/java/org/gnu/emacs/EmacsContextMenu.java
b/java/org/gnu/emacs/EmacsContextMenu.java
index 17e6033377d..2bbf2a313d6 100644
--- a/java/org/gnu/emacs/EmacsContextMenu.java
+++ b/java/org/gnu/emacs/EmacsContextMenu.java
@@ -361,8 +361,23 @@ public final class EmacsContextMenu
public Boolean
call ()
{
+ boolean rc;
+
lastMenuEventSerial = serial;
- return display1 (window, xPosition, yPosition);
+ rc = display1 (window, xPosition, yPosition);
+
+ /* Android 3.0 to Android 7.0 perform duplicate calls to
+ onContextMenuClosed the second time a context menu is
+ dismissed. Since the second call after such a dismissal is
+ otherwise liable to prematurely cancel any context menu
+ displayed immediately afterwards, ignore calls received
+ within 150 milliseconds of this menu's being displayed. */
+
+ if (rc && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB
+ && Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
+ wasSubmenuSelected = System.currentTimeMillis () - 150;
+
+ return rc;
}
});
diff --git a/java/org/gnu/emacs/EmacsService.java
b/java/org/gnu/emacs/EmacsService.java
index 5cb1ceca0aa..d17ba597d8e 100644
--- a/java/org/gnu/emacs/EmacsService.java
+++ b/java/org/gnu/emacs/EmacsService.java
@@ -60,6 +60,7 @@ import android.content.UriPermission;
import android.content.pm.PackageManager;
import android.content.res.AssetManager;
+import android.content.res.Configuration;
import android.hardware.input.InputManager;
@@ -135,6 +136,10 @@ public final class EmacsService extends Service
been created yet. */
private EmacsSafThread storageThread;
+ /* The Thread object representing the Android user interface
+ thread. */
+ private Thread mainThread;
+
static
{
servicingQuery = new AtomicInteger ();
@@ -235,6 +240,7 @@ public final class EmacsService extends Service
/ metrics.density)
* pixelDensityX);
resolver = getContentResolver ();
+ mainThread = Thread.currentThread ();
/* If the density used to compute the text size is lesser than
160, there's likely a bug with display density computation.
@@ -383,7 +389,13 @@ public final class EmacsService extends Service
{
if (DEBUG_THREADS)
{
- if (Thread.currentThread () instanceof EmacsThread)
+ /* When SERVICE is NULL, Emacs is being executed non-interactively. */
+ if (SERVICE == null
+ /* It was previously assumed that only instances of
+ `EmacsThread' were valid for graphics calls, but this is
+ no longer true now that Lisp threads can be attached to
+ the JVM. */
+ || (Thread.currentThread () != SERVICE.mainThread))
return;
throw new RuntimeException ("Emacs thread function"
@@ -437,21 +449,6 @@ public final class EmacsService extends Service
EmacsDrawPoint.perform (drawable, gc, x, y);
}
- public void
- clearWindow (EmacsWindow window)
- {
- checkEmacsThread ();
- window.clearWindow ();
- }
-
- public void
- clearArea (EmacsWindow window, int x, int y, int width,
- int height)
- {
- checkEmacsThread ();
- window.clearArea (x, y, width, height);
- }
-
@SuppressWarnings ("deprecation")
public void
ringBell (int duration)
@@ -581,6 +578,15 @@ public final class EmacsService extends Service
return false;
}
+ public boolean
+ detectKeyboard ()
+ {
+ Configuration configuration;
+
+ configuration = getResources ().getConfiguration ();
+ return configuration.keyboard != Configuration.KEYBOARD_NOKEYS;
+ }
+
public String
nameKeysym (int keysym)
{
@@ -905,48 +911,6 @@ public final class EmacsService extends Service
/* Content provider functions. */
- /* Return a ContentResolver capable of accessing as many files as
- possible, namely the content resolver of the last selected
- activity if available: only they posses the rights to access drag
- and drop files. */
-
- public ContentResolver
- getUsefulContentResolver ()
- {
- EmacsActivity activity;
-
- if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
- /* Since the system predates drag and drop, return this resolver
- to avoid any unforeseen difficulties. */
- return resolver;
-
- activity = EmacsActivity.lastFocusedActivity;
- if (activity == null)
- return resolver;
-
- return activity.getContentResolver ();
- }
-
- /* Return a context whose ContentResolver is granted access to most
- files, as in `getUsefulContentResolver'. */
-
- public Context
- getContentResolverContext ()
- {
- EmacsActivity activity;
-
- if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
- /* Since the system predates drag and drop, return this resolver
- to avoid any unforeseen difficulties. */
- return this;
-
- activity = EmacsActivity.lastFocusedActivity;
- if (activity == null)
- return this;
-
- return activity;
- }
-
/* Open a content URI described by the bytes BYTES, a non-terminated
string; make it writable if WRITABLE, and readable if READABLE.
Truncate the file if TRUNCATE.
@@ -960,9 +924,6 @@ public final class EmacsService extends Service
String name, mode;
ParcelFileDescriptor fd;
int i;
- ContentResolver resolver;
-
- resolver = getUsefulContentResolver ();
/* Figure out the file access mode. */
@@ -1024,12 +985,8 @@ public final class EmacsService extends Service
ParcelFileDescriptor fd;
Uri uri;
int rc, flags;
- Context context;
- ContentResolver resolver;
ParcelFileDescriptor descriptor;
- context = getContentResolverContext ();
-
uri = Uri.parse (name);
flags = 0;
@@ -1039,7 +996,7 @@ public final class EmacsService extends Service
if (writable)
flags |= Intent.FLAG_GRANT_WRITE_URI_PERMISSION;
- rc = context.checkCallingUriPermission (uri, flags);
+ rc = checkCallingUriPermission (uri, flags);
if (rc == PackageManager.PERMISSION_GRANTED)
return true;
@@ -1053,7 +1010,6 @@ public final class EmacsService extends Service
try
{
- resolver = context.getContentResolver ();
descriptor = resolver.openFileDescriptor (uri, "r");
return true;
}
diff --git a/java/org/gnu/emacs/EmacsWindow.java
b/java/org/gnu/emacs/EmacsWindow.java
index 304304a328b..6e8bdaf7401 100644
--- a/java/org/gnu/emacs/EmacsWindow.java
+++ b/java/org/gnu/emacs/EmacsWindow.java
@@ -27,6 +27,8 @@ import java.util.HashMap;
import java.util.LinkedHashMap;
import java.util.Map;
+import android.app.Activity;
+
import android.content.ClipData;
import android.content.ClipDescription;
import android.content.Context;
@@ -240,7 +242,7 @@ public final class EmacsWindow extends EmacsHandleObject
}
}
- EmacsActivity.invalidateFocus ();
+ EmacsActivity.invalidateFocus (4);
if (!children.isEmpty ())
throw new IllegalStateException ("Trying to destroy window with "
@@ -362,6 +364,9 @@ public final class EmacsWindow extends EmacsHandleObject
requestViewLayout ();
}
+ /* Return WM layout parameters for an override redirect window with
+ the geometry provided here. */
+
private WindowManager.LayoutParams
getWindowLayoutParams ()
{
@@ -384,15 +389,15 @@ public final class EmacsWindow extends EmacsHandleObject
return params;
}
- private Context
+ private Activity
findSuitableActivityContext ()
{
/* Find a recently focused activity. */
if (!EmacsActivity.focusedActivities.isEmpty ())
return EmacsActivity.focusedActivities.get (0);
- /* Return the service context, which probably won't work. */
- return EmacsService.SERVICE;
+ /* Resort to the last activity to be focused. */
+ return EmacsActivity.lastFocusedActivity;
}
public synchronized void
@@ -416,7 +421,7 @@ public final class EmacsWindow extends EmacsHandleObject
{
EmacsWindowAttachmentManager manager;
WindowManager windowManager;
- Context ctx;
+ Activity ctx;
Object tem;
WindowManager.LayoutParams params;
@@ -447,11 +452,23 @@ public final class EmacsWindow extends EmacsHandleObject
activity using the system window manager. */
ctx = findSuitableActivityContext ();
+
+ if (ctx == null)
+ {
+ Log.w (TAG, "failed to attach override-redirect window"
+ + " for want of activity");
+ return;
+ }
+
tem = ctx.getSystemService (Context.WINDOW_SERVICE);
windowManager = (WindowManager) tem;
- /* Calculate layout parameters. */
+ /* Calculate layout parameters and propagate the
+ activity's token into it. */
+
params = getWindowLayoutParams ();
+ params.token = (ctx.findViewById (android.R.id.content)
+ .getWindowToken ());
view.setLayoutParams (params);
/* Attach the view. */
@@ -644,7 +661,7 @@ public final class EmacsWindow extends EmacsHandleObject
public void
onKeyDown (int keyCode, KeyEvent event)
{
- int state, state_1, num_lock_flag;
+ int state, state_1, extra_ignored;
long serial;
String characters;
@@ -665,23 +682,37 @@ public final class EmacsWindow extends EmacsHandleObject
state = eventModifiers (event);
- /* Num Lock and Scroll Lock aren't supported by systems older than
- Android 3.0. */
+ /* Num Lock, Scroll Lock and Meta aren't supported by systems older
+ than Android 3.0. */
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
- num_lock_flag = (KeyEvent.META_NUM_LOCK_ON
- | KeyEvent.META_SCROLL_LOCK_ON);
+ extra_ignored = (KeyEvent.META_NUM_LOCK_ON
+ | KeyEvent.META_SCROLL_LOCK_ON
+ | KeyEvent.META_META_MASK);
else
- num_lock_flag = 0;
+ extra_ignored = 0;
/* Ignore meta-state understood by Emacs for now, or key presses
- such as Ctrl+C and Meta+C will not be recognized as an ASCII
- key press event. */
+ such as Ctrl+C and Meta+C will not be recognized as ASCII key
+ press events. */
state_1
= state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK
- | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK
- | num_lock_flag);
+ | KeyEvent.META_SYM_ON | extra_ignored);
+
+ /* There's no distinction between Right Alt and Alt Gr on Android,
+ so restore META_ALT_RIGHT_ON if set in state to enable composing
+ characters. (bug#69321) */
+
+ if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0)
+ {
+ state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON;
+
+ /* If Alt is also not depressed, remove its bit from the mask
+ reported to Emacs. */
+ if ((state & KeyEvent.META_ALT_LEFT_ON) == 0)
+ state &= ~KeyEvent.META_ALT_MASK;
+ }
synchronized (eventStrings)
{
@@ -702,29 +733,43 @@ public final class EmacsWindow extends EmacsHandleObject
public void
onKeyUp (int keyCode, KeyEvent event)
{
- int state, state_1, unicode_char, num_lock_flag;
+ int state, state_1, unicode_char, extra_ignored;
long time;
/* Compute the event's modifier mask. */
state = eventModifiers (event);
- /* Num Lock and Scroll Lock aren't supported by systems older than
- Android 3.0. */
+ /* Num Lock, Scroll Lock and Meta aren't supported by systems older
+ than Android 3.0. */
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
- num_lock_flag = (KeyEvent.META_NUM_LOCK_ON
- | KeyEvent.META_SCROLL_LOCK_ON);
+ extra_ignored = (KeyEvent.META_NUM_LOCK_ON
+ | KeyEvent.META_SCROLL_LOCK_ON
+ | KeyEvent.META_META_MASK);
else
- num_lock_flag = 0;
+ extra_ignored = 0;
/* Ignore meta-state understood by Emacs for now, or key presses
- such as Ctrl+C and Meta+C will not be recognized as an ASCII
- key press event. */
+ such as Ctrl+C and Meta+C will not be recognized as ASCII key
+ press events. */
state_1
= state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK
- | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK
- | num_lock_flag);
+ | KeyEvent.META_SYM_ON | extra_ignored);
+
+ /* There's no distinction between Right Alt and Alt Gr on Android,
+ so restore META_ALT_RIGHT_ON if set in state to enable composing
+ characters. */
+
+ if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0)
+ {
+ state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON;
+
+ /* If Alt is also not depressed, remove its bit from the mask
+ reported to Emacs. */
+ if ((state & KeyEvent.META_ALT_LEFT_ON) == 0)
+ state &= ~KeyEvent.META_ALT_MASK;
+ }
unicode_char = getEventUnicodeChar (event, state_1);
@@ -760,7 +805,7 @@ public final class EmacsWindow extends EmacsHandleObject
public void
onFocusChanged (boolean gainFocus)
{
- EmacsActivity.invalidateFocus ();
+ EmacsActivity.invalidateFocus (gainFocus ? 6 : 5);
}
/* Notice that the activity has been detached or destroyed.
@@ -1746,7 +1791,7 @@ public final class EmacsWindow extends EmacsHandleObject
/* Attempt to acquire permissions for this URI;
failing which, insert it as text instead. */
-
+
if (uri != null
&& uri.getScheme () != null
&& uri.getScheme ().equals ("content")
diff --git a/leim/Makefile.in b/leim/Makefile.in
index f7a23178919..bc1eeb5e634 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -101,11 +101,11 @@ ${leimdir}/quail ${leimdir}/ja-dic:
## All of TIT_GB and TIT_BIG5.
${leimdir}/quail/%.el: ${srcdir}/CXTERM-DIC/%.tit
$(AM_V_GEN)${RUN_EMACS} -l titdic-cnv \
- -f batch-titdic-convert -dir ${leimdir}/quail $<
+ -f batch-tit-dic-convert -dir ${leimdir}/quail $<
misc_convert = $(AM_V_GEN)${RUN_EMACS} \
- -l titdic-cnv -f batch-miscdic-convert -dir ${leimdir}/quail
+ -l titdic-cnv -f batch-tit-miscdic-convert -dir ${leimdir}/quail
## CTLau.el, CTLau-b5.el.
${leimdir}/quail/CT%.el: ${srcdir}/MISC-DIC/CT%.html
@@ -148,7 +148,7 @@ ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L
small-ja-dic-option
-f batch-skkdic-convert -dir "$(leimdir)/ja-dic"
$(JA_DIC_NO_REDUCTION_OPTION) "$<"
${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map
- $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f pinyin-convert $< $@
+ $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f tit-pinyin-convert $< $@
.PHONY: bootstrap-clean distclean maintainer-clean gen-clean
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 7c059640862..3cdf1620781 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -319,7 +319,7 @@ maybe-blessmail: $(BLESSMAIL_TARGET)
## up if chown or chgrp fails, as the package responsible for
## installing Emacs can fix this problem later.
$(DESTDIR)${archlibdir}: all
- $(info $ )
+ $(info $.)
$(info Installing utilities run internally by Emacs.)
umask 022 && ${MKDIR_P} "$(DESTDIR)${archlibdir}"
exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && pwd -P` && \
@@ -361,7 +361,7 @@ $(DESTDIR)${archlibdir}: all
.PHONY: bootstrap-clean check tags
install: $(DESTDIR)${archlibdir}
- $(info $ )
+ $(info $.)
$(info Installing utilities for users to run.)
umask 022 && ${MKDIR_P} "$(DESTDIR)${bindir}"
for file in ${INSTALLABLES} ; do \
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index e10aab5fc8d..711ddcf1260 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -47,6 +47,7 @@
# --avoid=iswdigit \
# --avoid=iswxdigit \
# --avoid=langinfo \
+# --avoid=localename-unsafe-limited \
# --avoid=lock \
# --avoid=mbrtowc \
# --avoid=mbsinit \
@@ -2745,7 +2746,9 @@ ifeq (,$(OMIT_GNULIB_MODULE_nstrftime))
libgnu_a_SOURCES += nstrftime.c
-EXTRA_DIST += strftime.h
+EXTRA_DIST += strftime.c strftime.h
+
+EXTRA_libgnu_a_SOURCES += strftime.c
endif
## end gnulib module nstrftime
diff --git a/lib/limits.in.h b/lib/limits.in.h
index 236fc58e525..c65eb4c1cfe 100644
--- a/lib/limits.in.h
+++ b/lib/limits.in.h
@@ -130,7 +130,7 @@
# define BOOL_WIDTH 1
# define BOOL_MAX 1
# elif ! defined BOOL_MAX
-# define BOOL_MAX ((((1U << (BOOL_WIDTH - 1)) - 1) << 1) + 1)
+# define BOOL_MAX 1
# endif
#endif
diff --git a/lib/nstrftime.c b/lib/nstrftime.c
index 69e4164dc0c..88490064297 100644
--- a/lib/nstrftime.c
+++ b/lib/nstrftime.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1991-2024 Free Software Foundation, Inc.
- This file is part of the GNU C Library.
+/* Generate time strings.
+
+ Copyright (C) 2024 Free Software Foundation, Inc.
This file is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
@@ -14,1497 +15,5 @@
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. */
-#ifdef _LIBC
-# define USE_IN_EXTENDED_LOCALE_MODEL 1
-# define HAVE_STRUCT_ERA_ENTRY 1
-# define HAVE_TM_GMTOFF 1
-# define HAVE_STRUCT_TM_TM_ZONE 1
-# define HAVE_TZNAME 1
-# include "../locale/localeinfo.h"
-#else
-# include <libc-config.h>
-# if FPRINTFTIME
-# include "fprintftime.h"
-# else
-# include "strftime.h"
-# endif
-# include "time-internal.h"
-#endif
-
-#include <ctype.h>
-#include <errno.h>
-#include <time.h>
-
-#if HAVE_TZNAME && !HAVE_DECL_TZNAME
-extern char *tzname[];
-#endif
-
-/* Do multibyte processing if multibyte encodings are supported, unless
- multibyte sequences are safe in formats. Multibyte sequences are
- safe if they cannot contain byte sequences that look like format
- conversion specifications. The multibyte encodings used by the
- C library on the various platforms (UTF-8, GB2312, GBK, CP936,
- GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949,
- SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%'
- cannot occur in a multibyte character except in the first byte.
-
- The DEC-HANYU encoding used on OSF/1 is not safe for formats, but
- this encoding has never been seen in real-life use, so we ignore
- it. */
-#if !(defined __osf__ && 0)
-# define MULTIBYTE_IS_FORMAT_SAFE 1
-#endif
-#define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE)
-
-#if DO_MULTIBYTE
-# include <wchar.h>
- static const mbstate_t mbstate_zero;
-#endif
-
-#include <limits.h>
-#include <stdckdint.h>
-#include <stddef.h>
-#include <stdlib.h>
-#include <string.h>
-
-#include "attribute.h"
-#include <intprops.h>
-
-#ifdef COMPILE_WIDE
-# include <endian.h>
-# define CHAR_T wchar_t
-# define UCHAR_T unsigned int
-# define L_(Str) L##Str
-# define NLW(Sym) _NL_W##Sym
-
-# define MEMCPY(d, s, n) __wmemcpy (d, s, n)
-# define STRLEN(s) __wcslen (s)
-
-#else
-# define CHAR_T char
-# define UCHAR_T unsigned char
-# define L_(Str) Str
-# define NLW(Sym) Sym
-# define ABALTMON_1 _NL_ABALTMON_1
-
-# define MEMCPY(d, s, n) memcpy (d, s, n)
-# define STRLEN(s) strlen (s)
-
-#endif
-
-/* Shift A right by B bits portably, by dividing A by 2**B and
- truncating towards minus infinity. A and B should be free of side
- effects, and B should be in the range 0 <= B <= INT_BITS - 2, where
- INT_BITS is the number of useful bits in an int. GNU code can
- assume that INT_BITS is at least 32.
-
- ISO C99 says that A >> B is implementation-defined if A < 0. Some
- implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift
- right in the usual way when A < 0, so SHR falls back on division if
- ordinary A >> B doesn't seem to be the usual signed shift. */
-#define SHR(a, b) \
- (-1 >> 1 == -1 \
- ? (a) >> (b) \
- : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0))
-
-#define TM_YEAR_BASE 1900
-
-#ifndef __isleap
-/* Nonzero if YEAR is a leap year (every 4 years,
- except every 100th isn't, and every 400th is). */
-# define __isleap(year) \
- ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0))
-#endif
-
-
-#ifdef _LIBC
-# define mktime_z(tz, tm) mktime (tm)
-# define tzname __tzname
-# define tzset __tzset
-#endif
-
-#ifndef FPRINTFTIME
-# define FPRINTFTIME 0
-#endif
-
-#if FPRINTFTIME
-# define STREAM_OR_CHAR_T FILE
-# define STRFTIME_ARG(x) /* empty */
-#else
-# define STREAM_OR_CHAR_T CHAR_T
-# define STRFTIME_ARG(x) x,
-#endif
-
-#if FPRINTFTIME
-# define memset_byte(P, Len, Byte) \
- do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0)
-# define memset_space(P, Len) memset_byte (P, Len, ' ')
-# define memset_zero(P, Len) memset_byte (P, Len, '0')
-#elif defined COMPILE_WIDE
-# define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len))
-# define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len))
-#else
-# define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len))
-# define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len))
-#endif
-
-#if FPRINTFTIME
-# define advance(P, N)
-#else
-# define advance(P, N) ((P) += (N))
-#endif
-
-#define add(n, f) width_add (width, n, f)
-#define width_add(width, n, f) \
- do \
- { \
- size_t _n = (n); \
- size_t _w = pad == L_('-') || width < 0 ? 0 : width; \
- size_t _incr = _n < _w ? _w : _n; \
- if (_incr >= maxsize - i) \
- { \
- errno = ERANGE; \
- return 0; \
- } \
- if (p) \
- { \
- if (_n < _w) \
- { \
- size_t _delta = _w - _n; \
- if (pad == L_('0') || pad == L_('+')) \
- memset_zero (p, _delta); \
- else \
- memset_space (p, _delta); \
- } \
- f; \
- advance (p, _n); \
- } \
- i += _incr; \
- } while (0)
-
-#define add1(c) width_add1 (width, c)
-#if FPRINTFTIME
-# define width_add1(width, c) width_add (width, 1, fputc (c, p))
-#else
-# define width_add1(width, c) width_add (width, 1, *p = c)
-#endif
-
-#define cpy(n, s) width_cpy (width, n, s)
-#if FPRINTFTIME
-# define width_cpy(width, n, s) \
- width_add (width, n, \
- do \
- { \
- if (to_lowcase) \
- fwrite_lowcase (p, (s), _n); \
- else if (to_uppcase) \
- fwrite_uppcase (p, (s), _n); \
- else \
- { \
- /* Ignore the value of fwrite. The caller can determine whether \
- an error occurred by inspecting ferror (P). All known fwrite \
- implementations set the stream's error indicator when they \
- fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \
- not require this. */ \
- fwrite (s, _n, 1, p); \
- } \
- } \
- while (0) \
- )
-#else
-# define width_cpy(width, n, s) \
- width_add (width, n, \
- if (to_lowcase) \
- memcpy_lowcase (p, (s), _n LOCALE_ARG); \
- else if (to_uppcase) \
- memcpy_uppcase (p, (s), _n LOCALE_ARG); \
- else \
- MEMCPY ((void *) p, (void const *) (s), _n))
-#endif
-
-#ifdef COMPILE_WIDE
-# ifndef USE_IN_EXTENDED_LOCALE_MODEL
-# undef __mbsrtowcs_l
-# define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st)
-# endif
-#endif
-
-
-#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL
-/* We use this code also for the extended locale handling where the
- function gets as an additional argument the locale which has to be
- used. To access the values we have to redefine the _NL_CURRENT
- macro. */
-# define strftime __strftime_l
-# define wcsftime __wcsftime_l
-# undef _NL_CURRENT
-# define _NL_CURRENT(category, item) \
- (current->values[_NL_ITEM_INDEX (item)].string)
-# define LOCALE_PARAM , locale_t loc
-# define LOCALE_ARG , loc
-# define HELPER_LOCALE_ARG , current
-#else
-# define LOCALE_PARAM
-# define LOCALE_ARG
-# ifdef _LIBC
-# define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME)
-# else
-# define HELPER_LOCALE_ARG
-# endif
-#endif
-
-#ifdef COMPILE_WIDE
-# ifdef USE_IN_EXTENDED_LOCALE_MODEL
-# define TOUPPER(Ch, L) __towupper_l (Ch, L)
-# define TOLOWER(Ch, L) __towlower_l (Ch, L)
-# else
-# define TOUPPER(Ch, L) towupper (Ch)
-# define TOLOWER(Ch, L) towlower (Ch)
-# endif
-#else
-# ifdef USE_IN_EXTENDED_LOCALE_MODEL
-# define TOUPPER(Ch, L) __toupper_l (Ch, L)
-# define TOLOWER(Ch, L) __tolower_l (Ch, L)
-# else
-# define TOUPPER(Ch, L) toupper (Ch)
-# define TOLOWER(Ch, L) tolower (Ch)
-# endif
-#endif
-/* We don't use 'isdigit' here since the locale dependent
- interpretation is not what we want here. We only need to accept
- the arabic digits in the ASCII range. One day there is perhaps a
- more reliable way to accept other sets of digits. */
-#define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9)
-
-/* Avoid false GCC warning "'memset' specified size 18446744073709551615
exceeds
- maximum object size 9223372036854775807", caused by insufficient data flow
- analysis and value propagation of the 'width_add' expansion when GCC is not
- optimizing. Cf. <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88443>. */
-#if __GNUC__ >= 7 && !__OPTIMIZE__
-# pragma GCC diagnostic ignored "-Wstringop-overflow"
-#endif
-
-#if FPRINTFTIME
-static void
-fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len)
-{
- while (len-- > 0)
- {
- fputc (TOLOWER ((UCHAR_T) *src, loc), fp);
- ++src;
- }
-}
-
-static void
-fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len)
-{
- while (len-- > 0)
- {
- fputc (TOUPPER ((UCHAR_T) *src, loc), fp);
- ++src;
- }
-}
-#else
-static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src,
- size_t len LOCALE_PARAM);
-
-static CHAR_T *
-memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM)
-{
- while (len-- > 0)
- dest[len] = TOLOWER ((UCHAR_T) src[len], loc);
- return dest;
-}
-
-static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src,
- size_t len LOCALE_PARAM);
-
-static CHAR_T *
-memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM)
-{
- while (len-- > 0)
- dest[len] = TOUPPER ((UCHAR_T) src[len], loc);
- return dest;
-}
-#endif
-
-
-#if ! HAVE_TM_GMTOFF
-/* Yield the difference between *A and *B,
- measured in seconds, ignoring leap seconds. */
-# define tm_diff ftime_tm_diff
-static int tm_diff (const struct tm *, const struct tm *);
-static int
-tm_diff (const struct tm *a, const struct tm *b)
-{
- /* Compute intervening leap days correctly even if year is negative.
- Take care to avoid int overflow in leap day calculations,
- but it's OK to assume that A and B are close to each other. */
- int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3);
- int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3);
- int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0);
- int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0);
- int a400 = SHR (a100, 2);
- int b400 = SHR (b100, 2);
- int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
- int years = a->tm_year - b->tm_year;
- int days = (365 * years + intervening_leap_days
- + (a->tm_yday - b->tm_yday));
- return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
- + (a->tm_min - b->tm_min))
- + (a->tm_sec - b->tm_sec));
-}
-#endif /* ! HAVE_TM_GMTOFF */
-
-
-
-/* The number of days from the first day of the first ISO week of this
- year to the year day YDAY with week day WDAY. ISO weeks start on
- Monday; the first ISO week has the year's first Thursday. YDAY may
- be as small as YDAY_MINIMUM. */
-#define ISO_WEEK_START_WDAY 1 /* Monday */
-#define ISO_WEEK1_WDAY 4 /* Thursday */
-#define YDAY_MINIMUM (-366)
-static int iso_week_days (int, int);
-static __inline int
-iso_week_days (int yday, int wday)
-{
- /* Add enough to the first operand of % to make it nonnegative. */
- int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7;
- return (yday
- - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7
- + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY);
-}
-
-
-/* When compiling this file, GNU applications can #define my_strftime
- to a symbol (typically nstrftime) to get an extended strftime with
- extra arguments TZ and NS. */
-
-#if FPRINTFTIME
-# undef my_strftime
-# define my_strftime fprintftime
-#endif
-
-#ifdef my_strftime
-# define extra_args , tz, ns
-# define extra_args_spec , timezone_t tz, int ns
-#else
-# if defined COMPILE_WIDE
-# define my_strftime wcsftime
-# define nl_get_alt_digit _nl_get_walt_digit
-# else
-# define my_strftime strftime
-# define nl_get_alt_digit _nl_get_alt_digit
-# endif
-# define extra_args
-# define extra_args_spec
-/* We don't have this information in general. */
-# define tz 1
-# define ns 0
-#endif
-
-static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t)
- const CHAR_T *, const struct tm *,
- bool, int, int, bool *
- extra_args_spec LOCALE_PARAM);
-
-/* Write information from TP into S according to the format
- string FORMAT, writing no more that MAXSIZE characters
- (including the terminating '\0') and returning number of
- characters written. If S is NULL, nothing will be written
- anywhere, so to determine how many characters would be
- written, use NULL for S and (size_t) -1 for MAXSIZE. */
-size_t
-my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
- const CHAR_T *format,
- const struct tm *tp extra_args_spec LOCALE_PARAM)
-{
- bool tzset_called = false;
- return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false,
- 0, -1, &tzset_called extra_args LOCALE_ARG);
-}
-libc_hidden_def (my_strftime)
-
-/* Just like my_strftime, above, but with more parameters.
- UPCASE indicates that the result should be converted to upper case.
- YR_SPEC and WIDTH specify the padding and width for the year.
- *TZSET_CALLED indicates whether tzset has been called here. */
-static size_t
-__strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
- const CHAR_T *format,
- const struct tm *tp, bool upcase,
- int yr_spec, int width, bool *tzset_called
- extra_args_spec LOCALE_PARAM)
-{
-#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL
- struct __locale_data *const current = loc->__locales[LC_TIME];
-#endif
-#if FPRINTFTIME
- size_t maxsize = (size_t) -1;
-#endif
-
- int saved_errno = errno;
- int hour12 = tp->tm_hour;
-#ifdef _NL_CURRENT
- /* We cannot make the following values variables since we must delay
- the evaluation of these values until really needed since some
- expressions might not be valid in every situation. The 'struct tm'
- might be generated by a strptime() call that initialized
- only a few elements. Dereference the pointers only if the format
- requires this. Then it is ok to fail if the pointers are invalid. */
-# define a_wkday \
- ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(ABDAY_1) +
tp->tm_wday)))
-# define f_wkday \
- ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday)))
-# define a_month \
- ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon)))
-# define f_month \
- ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon)))
-# define a_altmonth \
- ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(ABALTMON_1) +
tp->tm_mon)))
-# define f_altmonth \
- ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(ALTMON_1) +
tp->tm_mon)))
-# define ampm \
- ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \
- ? NLW(PM_STR) : NLW(AM_STR)))
-
-# define aw_len STRLEN (a_wkday)
-# define am_len STRLEN (a_month)
-# define aam_len STRLEN (a_altmonth)
-# define ap_len STRLEN (ampm)
-#endif
-#if HAVE_TZNAME
- char **tzname_vec = tzname;
-#endif
- const char *zone;
- size_t i = 0;
- STREAM_OR_CHAR_T *p = s;
- const CHAR_T *f;
-#if DO_MULTIBYTE && !defined COMPILE_WIDE
- const char *format_end = NULL;
-#endif
-
- zone = NULL;
-#if HAVE_STRUCT_TM_TM_ZONE
- /* The POSIX test suite assumes that setting
- the environment variable TZ to a new value before calling strftime()
- will influence the result (the %Z format) even if the information in
- TP is computed with a totally different time zone.
- This is bogus: though POSIX allows bad behavior like this,
- POSIX does not require it. Do the right thing instead. */
- zone = (const char *) tp->tm_zone;
-#endif
-#if HAVE_TZNAME
- if (!tz)
- {
- if (! (zone && *zone))
- zone = "GMT";
- }
- else
- {
-# if !HAVE_STRUCT_TM_TM_ZONE
- /* Infer the zone name from *TZ instead of from TZNAME. */
- tzname_vec = tz->tzname_copy;
-# endif
- }
- /* The tzset() call might have changed the value. */
- if (!(zone && *zone) && tp->tm_isdst >= 0)
- {
- /* POSIX.1 requires that local time zone information be used as
- though strftime called tzset. */
-# ifndef my_strftime
- if (!*tzset_called)
- {
- tzset ();
- *tzset_called = true;
- }
-# endif
- zone = tzname_vec[tp->tm_isdst != 0];
- }
-#endif
- if (! zone)
- zone = "";
-
- if (hour12 > 12)
- hour12 -= 12;
- else
- if (hour12 == 0)
- hour12 = 12;
-
- for (f = format; *f != '\0'; width = -1, f++)
- {
- int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */
- int modifier; /* Field modifier ('E', 'O', or 0). */
- int digits = 0; /* Max digits for numeric format. */
- int number_value; /* Numeric value to be printed. */
- unsigned int u_number_value; /* (unsigned int) number_value. */
- bool negative_number; /* The number is negative. */
- bool always_output_a_sign; /* +/- should always be output. */
- int tz_colon_mask; /* Bitmask of where ':' should appear. */
- const CHAR_T *subfmt;
- CHAR_T *bufp;
- CHAR_T buf[1
- + 2 /* for the two colons in a %::z or %:::z time zone */
- + (sizeof (int) < sizeof (time_t)
- ? INT_STRLEN_BOUND (time_t)
- : INT_STRLEN_BOUND (int))];
- bool to_lowcase = false;
- bool to_uppcase = upcase;
- size_t colons;
- bool change_case = false;
- int format_char;
- int subwidth;
-
-#if DO_MULTIBYTE && !defined COMPILE_WIDE
- switch (*f)
- {
- case L_('%'):
- break;
-
- case L_('\b'): case L_('\t'): case L_('\n'):
- case L_('\v'): case L_('\f'): case L_('\r'):
- case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'):
- case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'):
- case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'):
- case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'):
- case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'):
- case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'):
- case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'):
- case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'):
- case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'):
- case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'):
- case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'):
- case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'):
- case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'):
- case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'):
- case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'):
- case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'):
- case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'):
- case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'):
- case L_('~'):
- /* The C Standard requires these 98 characters (plus '%') to
- be in the basic execution character set. None of these
- characters can start a multibyte sequence, so they need
- not be analyzed further. */
- add1 (*f);
- continue;
-
- default:
- /* Copy this multibyte sequence until we reach its end, find
- an error, or come back to the initial shift state. */
- {
- mbstate_t mbstate = mbstate_zero;
- size_t len = 0;
- size_t fsize;
-
- if (! format_end)
- format_end = f + strlen (f) + 1;
- fsize = format_end - f;
-
- do
- {
- size_t bytes = mbrlen (f + len, fsize - len, &mbstate);
-
- if (bytes == 0)
- break;
-
- if (bytes == (size_t) -2)
- {
- len += strlen (f + len);
- break;
- }
-
- if (bytes == (size_t) -1)
- {
- len++;
- break;
- }
-
- len += bytes;
- }
- while (! mbsinit (&mbstate));
-
- cpy (len, f);
- f += len - 1;
- continue;
- }
- }
-
-#else /* ! DO_MULTIBYTE */
-
- /* Either multibyte encodings are not supported, they are
- safe for formats, so any non-'%' byte can be copied through,
- or this is the wide character version. */
- if (*f != L_('%'))
- {
- add1 (*f);
- continue;
- }
-
-#endif /* ! DO_MULTIBYTE */
-
- char const *percent = f;
-
- /* Check for flags that can modify a format. */
- while (1)
- {
- switch (*++f)
- {
- /* This influences the number formats. */
- case L_('_'):
- case L_('-'):
- case L_('+'):
- case L_('0'):
- pad = *f;
- continue;
-
- /* This changes textual output. */
- case L_('^'):
- to_uppcase = true;
- continue;
- case L_('#'):
- change_case = true;
- continue;
-
- default:
- break;
- }
- break;
- }
-
- if (ISDIGIT (*f))
- {
- width = 0;
- do
- {
- if (ckd_mul (&width, width, 10)
- || ckd_add (&width, width, *f - L_('0')))
- width = INT_MAX;
- ++f;
- }
- while (ISDIGIT (*f));
- }
-
- /* Check for modifiers. */
- switch (*f)
- {
- case L_('E'):
- case L_('O'):
- modifier = *f++;
- break;
-
- default:
- modifier = 0;
- break;
- }
-
- /* Now do the specified format. */
- format_char = *f;
- switch (format_char)
- {
-#define DO_NUMBER(d, v) \
- do \
- { \
- digits = d; \
- number_value = v; \
- goto do_number; \
- } \
- while (0)
-#define DO_SIGNED_NUMBER(d, negative, v) \
- DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_signed_number)
-#define DO_YEARISH(d, negative, v) \
- DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_yearish)
-#define DO_MAYBE_SIGNED_NUMBER(d, negative, v, label) \
- do \
- { \
- digits = d; \
- negative_number = negative; \
- u_number_value = v; \
- goto label; \
- } \
- while (0)
-
- /* The mask is not what you might think.
- When the ordinal i'th bit is set, insert a colon
- before the i'th digit of the time zone representation. */
-#define DO_TZ_OFFSET(d, mask, v) \
- do \
- { \
- digits = d; \
- tz_colon_mask = mask; \
- u_number_value = v; \
- goto do_tz_offset; \
- } \
- while (0)
-#define DO_NUMBER_SPACEPAD(d, v) \
- do \
- { \
- digits = d; \
- number_value = v; \
- goto do_number_spacepad; \
- } \
- while (0)
-
- case L_('%'):
- if (f - 1 != percent)
- goto bad_percent;
- add1 (*f);
- break;
-
- case L_('a'):
- if (modifier != 0)
- goto bad_format;
- if (change_case)
- {
- to_uppcase = true;
- to_lowcase = false;
- }
-#ifdef _NL_CURRENT
- cpy (aw_len, a_wkday);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case 'A':
- if (modifier != 0)
- goto bad_format;
- if (change_case)
- {
- to_uppcase = true;
- to_lowcase = false;
- }
-#ifdef _NL_CURRENT
- cpy (STRLEN (f_wkday), f_wkday);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('b'):
- case L_('h'):
- if (change_case)
- {
- to_uppcase = true;
- to_lowcase = false;
- }
- if (modifier == L_('E'))
- goto bad_format;
-#ifdef _NL_CURRENT
- if (modifier == L_('O'))
- cpy (aam_len, a_altmonth);
- else
- cpy (am_len, a_month);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('B'):
- if (modifier == L_('E'))
- goto bad_format;
- if (change_case)
- {
- to_uppcase = true;
- to_lowcase = false;
- }
-#ifdef _NL_CURRENT
- if (modifier == L_('O'))
- cpy (STRLEN (f_altmonth), f_altmonth);
- else
- cpy (STRLEN (f_month), f_month);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('c'):
- if (modifier == L_('O'))
- goto bad_format;
-#ifdef _NL_CURRENT
- if (! (modifier == L_('E')
- && (*(subfmt =
- (const CHAR_T *) _NL_CURRENT (LC_TIME,
- NLW(ERA_D_T_FMT)))
- != '\0')))
- subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT));
-#else
- goto underlying_strftime;
-#endif
-
- subformat:
- subwidth = -1;
- subformat_width:
- {
- size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1)
- subfmt, tp, to_uppcase,
- pad, subwidth, tzset_called
- extra_args LOCALE_ARG);
- add (len, __strftime_internal (p,
- STRFTIME_ARG (maxsize - i)
- subfmt, tp, to_uppcase,
- pad, subwidth, tzset_called
- extra_args LOCALE_ARG));
- }
- break;
-
-#if !(defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY)
- underlying_strftime:
- {
- /* The relevant information is available only via the
- underlying strftime implementation, so use that. */
- char ufmt[5];
- char *u = ufmt;
- char ubuf[1024]; /* enough for any single format in practice */
- size_t len;
- /* Make sure we're calling the actual underlying strftime.
- In some cases, config.h contains something like
- "#define strftime rpl_strftime". */
-# ifdef strftime
-# undef strftime
- size_t strftime ();
-# endif
-
- /* The space helps distinguish strftime failure from empty
- output. */
- *u++ = ' ';
- *u++ = '%';
- if (modifier != 0)
- *u++ = modifier;
- *u++ = format_char;
- *u = '\0';
- len = strftime (ubuf, sizeof ubuf, ufmt, tp);
- if (len != 0)
- cpy (len - 1, ubuf + 1);
- }
- break;
-#endif
-
- case L_('C'):
- if (modifier == L_('E'))
- {
-#if HAVE_STRUCT_ERA_ENTRY
- struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG);
- if (era)
- {
-# ifdef COMPILE_WIDE
- size_t len = __wcslen (era->era_wname);
- cpy (len, era->era_wname);
-# else
- size_t len = strlen (era->era_name);
- cpy (len, era->era_name);
-# endif
- break;
- }
-#else
- goto underlying_strftime;
-#endif
- }
-
- {
- bool negative_year = tp->tm_year < - TM_YEAR_BASE;
- bool zero_thru_1899 = !negative_year & (tp->tm_year < 0);
- int century = ((tp->tm_year - 99 * zero_thru_1899) / 100
- + TM_YEAR_BASE / 100);
- DO_YEARISH (2, negative_year, century);
- }
-
- case L_('x'):
- if (modifier == L_('O'))
- goto bad_format;
-#ifdef _NL_CURRENT
- if (! (modifier == L_('E')
- && (*(subfmt =
- (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_D_FMT)))
- != L_('\0'))))
- subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT));
- goto subformat;
-#else
- goto underlying_strftime;
-#endif
- case L_('D'):
- if (modifier != 0)
- goto bad_format;
- subfmt = L_("%m/%d/%y");
- goto subformat;
-
- case L_('d'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, tp->tm_mday);
-
- case L_('e'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER_SPACEPAD (2, tp->tm_mday);
-
- /* All numeric formats set DIGITS and NUMBER_VALUE (or
U_NUMBER_VALUE)
- and then jump to one of these labels. */
-
- do_tz_offset:
- always_output_a_sign = true;
- goto do_number_body;
-
- do_yearish:
- if (pad == 0)
- pad = yr_spec;
- always_output_a_sign
- = (pad == L_('+')
- && ((digits == 2 ? 99 : 9999) < u_number_value
- || digits < width));
- goto do_maybe_signed_number;
-
- do_number_spacepad:
- if (pad == 0)
- pad = L_('_');
-
- do_number:
- /* Format NUMBER_VALUE according to the MODIFIER flag. */
- negative_number = number_value < 0;
- u_number_value = number_value;
-
- do_signed_number:
- always_output_a_sign = false;
-
- do_maybe_signed_number:
- tz_colon_mask = 0;
-
- do_number_body:
- /* Format U_NUMBER_VALUE according to the MODIFIER flag.
- NEGATIVE_NUMBER is nonzero if the original number was
- negative; in this case it was converted directly to
- unsigned int (i.e., modulo (UINT_MAX + 1)) without
- negating it. */
- if (modifier == L_('O') && !negative_number)
- {
-#ifdef _NL_CURRENT
- /* Get the locale specific alternate representation of
- the number. If none exist NULL is returned. */
- const CHAR_T *cp = nl_get_alt_digit (u_number_value
- HELPER_LOCALE_ARG);
-
- if (cp != NULL)
- {
- size_t digitlen = STRLEN (cp);
- if (digitlen != 0)
- {
- cpy (digitlen, cp);
- break;
- }
- }
-#else
- goto underlying_strftime;
-#endif
- }
-
- bufp = buf + sizeof (buf) / sizeof (buf[0]);
-
- if (negative_number)
- u_number_value = - u_number_value;
-
- do
- {
- if (tz_colon_mask & 1)
- *--bufp = ':';
- tz_colon_mask >>= 1;
- *--bufp = u_number_value % 10 + L_('0');
- u_number_value /= 10;
- }
- while (u_number_value != 0 || tz_colon_mask != 0);
-
- do_number_sign_and_padding:
- if (pad == 0)
- pad = L_('0');
- if (width < 0)
- width = digits;
-
- {
- CHAR_T sign_char = (negative_number ? L_('-')
- : always_output_a_sign ? L_('+')
- : 0);
- int numlen = buf + sizeof buf / sizeof buf[0] - bufp;
- int shortage = width - !!sign_char - numlen;
- int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage;
-
- if (sign_char)
- {
- if (pad == L_('_'))
- {
- if (p)
- memset_space (p, padding);
- i += padding;
- width -= padding;
- }
- width_add1 (0, sign_char);
- width--;
- }
-
- cpy (numlen, bufp);
- }
- break;
-
- case L_('F'):
- if (modifier != 0)
- goto bad_format;
- if (pad == 0 && width < 0)
- {
- pad = L_('+');
- subwidth = 4;
- }
- else
- {
- subwidth = width - 6;
- if (subwidth < 0)
- subwidth = 0;
- }
- subfmt = L_("%Y-%m-%d");
- goto subformat_width;
-
- case L_('H'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, tp->tm_hour);
-
- case L_('I'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, hour12);
-
- case L_('k'): /* GNU extension. */
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER_SPACEPAD (2, tp->tm_hour);
-
- case L_('l'): /* GNU extension. */
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER_SPACEPAD (2, hour12);
-
- case L_('j'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U);
-
- case L_('M'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, tp->tm_min);
-
- case L_('m'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U);
-
-#ifndef _LIBC
- case L_('N'): /* GNU extension. */
- if (modifier == L_('E'))
- goto bad_format;
- {
- int n = ns, ns_digits = 9;
- if (width <= 0)
- width = ns_digits;
- int ndigs = ns_digits;
- while (width < ndigs || (1 < ndigs && n % 10 == 0))
- ndigs--, n /= 10;
- for (int j = ndigs; 0 < j; j--)
- buf[j - 1] = n % 10 + L_('0'), n /= 10;
- if (!pad)
- pad = L_('0');
- width_cpy (0, ndigs, buf);
- width_add (width - ndigs, 0, (void) 0);
- }
- break;
-#endif
-
- case L_('n'):
- add1 (L_('\n'));
- break;
-
- case L_('P'):
- to_lowcase = true;
-#ifndef _NL_CURRENT
- format_char = L_('p');
-#endif
- FALLTHROUGH;
- case L_('p'):
- if (change_case)
- {
- to_uppcase = false;
- to_lowcase = true;
- }
-#ifdef _NL_CURRENT
- cpy (ap_len, ampm);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('q'): /* GNU extension. */
- DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1);
-
- case L_('R'):
- subfmt = L_("%H:%M");
- goto subformat;
-
- case L_('r'):
-#ifdef _NL_CURRENT
- if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME,
- NLW(T_FMT_AMPM)))
- == L_('\0'))
- subfmt = L_("%I:%M:%S %p");
- goto subformat;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('S'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, tp->tm_sec);
-
- case L_('s'): /* GNU extension. */
- {
- struct tm ltm;
- time_t t;
-
- ltm = *tp;
- ltm.tm_yday = -1;
- t = mktime_z (tz, <m);
- if (ltm.tm_yday < 0)
- {
- errno = EOVERFLOW;
- return 0;
- }
-
- /* Generate string value for T using time_t arithmetic;
- this works even if sizeof (long) < sizeof (time_t). */
-
- bufp = buf + sizeof (buf) / sizeof (buf[0]);
- negative_number = t < 0;
-
- do
- {
- int d = t % 10;
- t /= 10;
- *--bufp = (negative_number ? -d : d) + L_('0');
- }
- while (t != 0);
-
- digits = 1;
- always_output_a_sign = false;
- goto do_number_sign_and_padding;
- }
-
- case L_('X'):
- if (modifier == L_('O'))
- goto bad_format;
-#ifdef _NL_CURRENT
- if (! (modifier == L_('E')
- && (*(subfmt =
- (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT)))
- != L_('\0'))))
- subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT));
- goto subformat;
-#else
- goto underlying_strftime;
-#endif
- case L_('T'):
- subfmt = L_("%H:%M:%S");
- goto subformat;
-
- case L_('t'):
- add1 (L_('\t'));
- break;
-
- case L_('u'):
- DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1);
-
- case L_('U'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7);
-
- case L_('V'):
- case L_('g'):
- case L_('G'):
- if (modifier == L_('E'))
- goto bad_format;
- {
- /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE)
- is a leap year, except that YEAR and YEAR - 1 both work
- correctly even when (tp->tm_year + TM_YEAR_BASE) would
- overflow. */
- int year = (tp->tm_year
- + (tp->tm_year < 0
- ? TM_YEAR_BASE % 400
- : TM_YEAR_BASE % 400 - 400));
- int year_adjust = 0;
- int days = iso_week_days (tp->tm_yday, tp->tm_wday);
-
- if (days < 0)
- {
- /* This ISO week belongs to the previous year. */
- year_adjust = -1;
- days = iso_week_days (tp->tm_yday + (365 + __isleap (year -
1)),
- tp->tm_wday);
- }
- else
- {
- int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)),
- tp->tm_wday);
- if (0 <= d)
- {
- /* This ISO week belongs to the next year. */
- year_adjust = 1;
- days = d;
- }
- }
-
- switch (*f)
- {
- case L_('g'):
- {
- int yy = (tp->tm_year % 100 + year_adjust) % 100;
- DO_YEARISH (2, false,
- (0 <= yy
- ? yy
- : tp->tm_year < -TM_YEAR_BASE - year_adjust
- ? -yy
- : yy + 100));
- }
-
- case L_('G'):
- DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE - year_adjust,
- (tp->tm_year + (unsigned int) TM_YEAR_BASE
- + year_adjust));
-
- default:
- DO_NUMBER (2, days / 7 + 1);
- }
- }
-
- case L_('W'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7);
-
- case L_('w'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (1, tp->tm_wday);
-
- case L_('Y'):
- if (modifier == L_('E'))
- {
-#if HAVE_STRUCT_ERA_ENTRY
- struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG);
- if (era)
- {
-# ifdef COMPILE_WIDE
- subfmt = era->era_wformat;
-# else
- subfmt = era->era_format;
-# endif
- if (pad == 0)
- pad = yr_spec;
- goto subformat;
- }
-#else
- goto underlying_strftime;
-#endif
- }
- if (modifier == L_('O'))
- goto bad_format;
-
- DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE,
- tp->tm_year + (unsigned int) TM_YEAR_BASE);
-
- case L_('y'):
- if (modifier == L_('E'))
- {
-#if HAVE_STRUCT_ERA_ENTRY
- struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG);
- if (era)
- {
- int delta = tp->tm_year - era->start_date[0];
- if (pad == 0)
- pad = yr_spec;
- DO_NUMBER (2, (era->offset
- + delta * era->absolute_direction));
- }
-#else
- goto underlying_strftime;
-#endif
- }
-
- {
- int yy = tp->tm_year % 100;
- if (yy < 0)
- yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100;
- DO_YEARISH (2, false, yy);
- }
-
- case L_('Z'):
- if (change_case)
- {
- to_uppcase = false;
- to_lowcase = true;
- }
-
-#ifdef COMPILE_WIDE
- {
- /* The zone string is always given in multibyte form. We have
- to convert it to wide character. */
- size_t w = pad == L_('-') || width < 0 ? 0 : width;
- char const *z = zone;
- mbstate_t st = {0};
- size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc);
- if (len == (size_t) -1)
- return 0;
- size_t incr = len < w ? w : len;
- if (incr >= maxsize - i)
- {
- errno = ERANGE;
- return 0;
- }
- if (p)
- {
- if (len < w)
- {
- size_t delta = w - len;
- __wmemmove (p + delta, p, len);
- wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L'
';
- wmemset (p, wc, delta);
- }
- p += incr;
- }
- i += incr;
- }
-#else
- cpy (strlen (zone), zone);
-#endif
- break;
-
- case L_(':'):
- /* :, ::, and ::: are valid only just before 'z'.
- :::: etc. are rejected later. */
- for (colons = 1; f[colons] == L_(':'); colons++)
- continue;
- if (f[colons] != L_('z'))
- goto bad_format;
- f += colons;
- goto do_z_conversion;
-
- case L_('z'):
- colons = 0;
-
- do_z_conversion:
- if (tp->tm_isdst < 0)
- break;
-
- {
- int diff;
- int hour_diff;
- int min_diff;
- int sec_diff;
-#if HAVE_TM_GMTOFF
- diff = tp->tm_gmtoff;
-#else
- if (!tz)
- diff = 0;
- else
- {
- struct tm gtm;
- struct tm ltm;
- time_t lt;
-
- /* POSIX.1 requires that local time zone information be used as
- though strftime called tzset. */
-# ifndef my_strftime
- if (!*tzset_called)
- {
- tzset ();
- *tzset_called = true;
- }
-# endif
-
- ltm = *tp;
- ltm.tm_wday = -1;
- lt = mktime_z (tz, <m);
- if (ltm.tm_wday < 0 || ! localtime_rz (0, <, >m))
- break;
- diff = tm_diff (<m, >m);
- }
-#endif
-
- negative_number = diff < 0 || (diff == 0 && *zone == '-');
- hour_diff = diff / 60 / 60;
- min_diff = diff / 60 % 60;
- sec_diff = diff % 60;
-
- switch (colons)
- {
- case 0: /* +hhmm */
- DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff);
-
- case 1: tz_hh_mm: /* +hh:mm */
- DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff);
-
- case 2: tz_hh_mm_ss: /* +hh:mm:ss */
- DO_TZ_OFFSET (9, 024,
- hour_diff * 10000 + min_diff * 100 + sec_diff);
-
- case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */
- if (sec_diff != 0)
- goto tz_hh_mm_ss;
- if (min_diff != 0)
- goto tz_hh_mm;
- DO_TZ_OFFSET (3, 0, hour_diff);
-
- default:
- goto bad_format;
- }
- }
-
- case L_('\0'): /* GNU extension: % at end of format. */
- bad_percent:
- --f;
- FALLTHROUGH;
- default:
- /* Unknown format; output the format, including the '%',
- since this is most likely the right thing to do if a
- multibyte string has been misparsed. */
- bad_format:
- cpy (f - percent + 1, percent);
- break;
- }
- }
-
-#if ! FPRINTFTIME
- if (p && maxsize != 0)
- *p = L_('\0');
-#endif
-
- errno = saved_errno;
- return i;
-}
+#define my_strftime nstrftime
+#include "strftime.c"
diff --git a/lib/nstrftime.c b/lib/strftime.c
similarity index 75%
copy from lib/nstrftime.c
copy to lib/strftime.c
index 69e4164dc0c..128176cad40 100644
--- a/lib/nstrftime.c
+++ b/lib/strftime.c
@@ -14,6 +14,14 @@
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. */
+#ifndef FPRINTFTIME
+# define FPRINTFTIME 0
+#endif
+
+#ifndef USE_C_LOCALE
+# define USE_C_LOCALE 0
+#endif
+
#ifdef _LIBC
# define USE_IN_EXTENDED_LOCALE_MODEL 1
# define HAVE_STRUCT_ERA_ENTRY 1
@@ -31,7 +39,24 @@
# include "time-internal.h"
#endif
-#include <ctype.h>
+/* Whether to require GNU behavior for AM and PM indicators, even on
+ other platforms. This matters only in non-C locales.
+ The default is to require it; you can override this via
+ AC_DEFINE([REQUIRE_GNUISH_STRFTIME_AM_PM], 1) and if you do that
+ you may be able to omit Gnulib's localename module and its dependencies. */
+#ifndef REQUIRE_GNUISH_STRFTIME_AM_PM
+# define REQUIRE_GNUISH_STRFTIME_AM_PM true
+#endif
+#if USE_C_LOCALE
+# undef REQUIRE_GNUISH_STRFTIME_AM_PM
+# define REQUIRE_GNUISH_STRFTIME_AM_PM false
+#endif
+
+#if USE_C_LOCALE
+# include "c-ctype.h"
+#else
+# include <ctype.h>
+#endif
#include <errno.h>
#include <time.h>
@@ -67,6 +92,15 @@ extern char *tzname[];
#include <stdlib.h>
#include <string.h>
+#if USE_C_LOCALE && HAVE_STRFTIME_L
+# include <locale.h>
+#endif
+
+#if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM
+# include <locale.h>
+# include "localename.h"
+#endif
+
#include "attribute.h"
#include <intprops.h>
@@ -121,10 +155,10 @@ extern char *tzname[];
# define mktime_z(tz, tm) mktime (tm)
# define tzname __tzname
# define tzset __tzset
-#endif
-#ifndef FPRINTFTIME
-# define FPRINTFTIME 0
+# define time_t __time64_t
+# define __gmtime_r(t, tp) __gmtime64_r (t, tp)
+# define mktime(tp) __mktime64 (tp)
#endif
#if FPRINTFTIME
@@ -266,8 +300,13 @@ extern char *tzname[];
# define TOUPPER(Ch, L) __toupper_l (Ch, L)
# define TOLOWER(Ch, L) __tolower_l (Ch, L)
# else
-# define TOUPPER(Ch, L) toupper (Ch)
-# define TOLOWER(Ch, L) tolower (Ch)
+# if USE_C_LOCALE
+# define TOUPPER(Ch, L) c_toupper (Ch)
+# define TOLOWER(Ch, L) c_tolower (Ch)
+# else
+# define TOUPPER(Ch, L) toupper (Ch)
+# define TOLOWER(Ch, L) tolower (Ch)
+# endif
# endif
#endif
/* We don't use 'isdigit' here since the locale dependent
@@ -329,6 +368,376 @@ memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t
len LOCALE_PARAM)
#endif
+#if USE_C_LOCALE && HAVE_STRFTIME_L
+
+/* Cache for the C locale object.
+ Marked volatile so that different threads see the same value
+ (avoids locking). */
+static volatile locale_t c_locale_cache;
+
+/* Return the C locale object, or (locale_t) 0 with errno set
+ if it cannot be created. */
+static locale_t
+c_locale (void)
+{
+ if (!c_locale_cache)
+ c_locale_cache = newlocale (LC_ALL_MASK, "C", (locale_t) 0);
+ return c_locale_cache;
+}
+
+#endif
+
+
+#if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM
+
+/* Return true if an AM/PM indicator should be removed. */
+static bool
+should_remove_ampm (void)
+{
+ /* According to glibc's 'am_pm' attribute in the locale database, an AM/PM
+ indicator should be absent in the locales for the following languages:
+ ab an ast az be ber bg br bs ce cs csb cv da de dsb eo et eu fa fi fo fr
+ fur fy ga gl gv hr hsb ht hu hy it ka kk kl ku kv kw ky lb lg li lij ln
+ lt lv mg mhr mi mk mn ms mt nb nds nhn nl nn nr nso oc os pap pl pt ro
+ ru rw sah sc se sgs sk sl sm sr ss st su sv szl tg tk tn ts tt ug uk unm
+ uz ve wae wo xh zu */
+ const char *loc = gl_locale_name_unsafe (LC_TIME, "LC_TIME");
+ bool remove_ampm = false;
+ switch (loc[0])
+ {
+ case 'a':
+ switch (loc[1])
+ {
+ case 'b': case 'n': case 'z':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == 't' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'b':
+ switch (loc[1])
+ {
+ case 'e':
+ if (loc[2] == '\0' || loc[2] == '_'
+ || (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_')))
+ remove_ampm = true;
+ break;
+ case 'g': case 'r': case 's':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'c':
+ switch (loc[1])
+ {
+ case 'e': case 'v':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == '\0' || loc[2] == '_'
+ || (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_')))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'd':
+ switch (loc[1])
+ {
+ case 'a': case 'e':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'e':
+ switch (loc[1])
+ {
+ case 'o': case 't': case 'u':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'f':
+ switch (loc[1])
+ {
+ case 'a': case 'i': case 'o': case 'r': case 'y':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'u':
+ if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'g':
+ switch (loc[1])
+ {
+ case 'a': case 'l': case 'v':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'h':
+ switch (loc[1])
+ {
+ case 'r': case 't': case 'u': case 'y':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'i':
+ switch (loc[1])
+ {
+ case 't':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'k':
+ switch (loc[1])
+ {
+ case 'a': case 'k': case 'l': case 'u': case 'v': case 'w': case 'y':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'l':
+ switch (loc[1])
+ {
+ case 'b': case 'g': case 'n': case 't': case 'v':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'i':
+ if (loc[2] == 'j' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'm':
+ switch (loc[1])
+ {
+ case 'g': case 'i': case 'k': case 'n': case 's': case 't':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'h':
+ if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'n':
+ switch (loc[1])
+ {
+ case 'b': case 'l': case 'n': case 'r':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'd':
+ if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 'h':
+ if (loc[2] == 'n' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == 'o' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'o':
+ switch (loc[1])
+ {
+ case 'c': case 's':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'p':
+ switch (loc[1])
+ {
+ case 'l': case 't':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'a':
+ if (loc[2] == 'p' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'r':
+ switch (loc[1])
+ {
+ case 'o': case 'u': case 'w':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 's':
+ switch (loc[1])
+ {
+ case 'c': case 'e': case 'k': case 'l': case 'm': case 'r': case 's':
+ case 't': case 'u': case 'v':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'a':
+ if (loc[2] == 'h' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 'g':
+ if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 'z':
+ if (loc[2] == 'l' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 't':
+ switch (loc[1])
+ {
+ case 'g': case 'k': case 'n': case 's': case 't':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'u':
+ switch (loc[1])
+ {
+ case 'g': case 'k': case 'z':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'n':
+ if (loc[2] == 'm'&& (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'v':
+ switch (loc[1])
+ {
+ case 'e':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'w':
+ switch (loc[1])
+ {
+ case 'a':
+ if (loc[2] == 'e' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 'o':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'x':
+ switch (loc[1])
+ {
+ case 'h':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'z':
+ switch (loc[1])
+ {
+ case 'u':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ default:
+ break;
+ }
+ return remove_ampm;
+}
+
+#endif
+
+
#if ! HAVE_TM_GMTOFF
/* Yield the difference between *A and *B,
measured in seconds, ignoring leap seconds. */
@@ -377,15 +786,25 @@ iso_week_days (int yday, int wday)
}
+#if !defined _NL_CURRENT && (USE_C_LOCALE && !HAVE_STRFTIME_L)
+static CHAR_T const c_weekday_names[][sizeof "Wednesday"] =
+ {
+ L_("Sunday"), L_("Monday"), L_("Tuesday"), L_("Wednesday"),
+ L_("Thursday"), L_("Friday"), L_("Saturday")
+ };
+static CHAR_T const c_month_names[][sizeof "September"] =
+ {
+ L_("January"), L_("February"), L_("March"), L_("April"), L_("May"),
+ L_("June"), L_("July"), L_("August"), L_("September"), L_("October"),
+ L_("November"), L_("December")
+ };
+#endif
+
+
/* When compiling this file, GNU applications can #define my_strftime
to a symbol (typically nstrftime) to get an extended strftime with
extra arguments TZ and NS. */
-#if FPRINTFTIME
-# undef my_strftime
-# define my_strftime fprintftime
-#endif
-
#ifdef my_strftime
# define extra_args , tz, ns
# define extra_args_spec , timezone_t tz, int ns
@@ -479,6 +898,24 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
# define am_len STRLEN (a_month)
# define aam_len STRLEN (a_altmonth)
# define ap_len STRLEN (ampm)
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+/* The English abbreviated weekday names are just the first 3 characters of the
+ English full weekday names. */
+# define a_wkday \
+ (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday])
+# define aw_len 3
+# define f_wkday \
+ (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday])
+/* The English abbreviated month names are just the first 3 characters of the
+ English full month names. */
+# define a_month \
+ (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon])
+# define am_len 3
+# define f_month \
+ (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon])
+/* The English AM/PM strings happen to have the same length, namely 2. */
+# define ampm (L_("AMPM") + 2 * (tp->tm_hour > 11))
+# define ap_len 2
#endif
#if HAVE_TZNAME
char **tzname_vec = tzname;
@@ -766,7 +1203,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
to_uppcase = true;
to_lowcase = false;
}
-#ifdef _NL_CURRENT
+#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L)
cpy (aw_len, a_wkday);
break;
#else
@@ -781,7 +1218,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
to_uppcase = true;
to_lowcase = false;
}
-#ifdef _NL_CURRENT
+#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L)
cpy (STRLEN (f_wkday), f_wkday);
break;
#else
@@ -803,6 +1240,9 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
else
cpy (am_len, a_month);
break;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ cpy (am_len, a_month);
+ break;
#else
goto underlying_strftime;
#endif
@@ -821,6 +1261,9 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
else
cpy (STRLEN (f_month), f_month);
break;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ cpy (STRLEN (f_month), f_month);
+ break;
#else
goto underlying_strftime;
#endif
@@ -835,6 +1278,8 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
NLW(ERA_D_T_FMT)))
!= '\0')))
subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT));
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ subfmt = L_("%a %b %e %H:%M:%S %Y");
#else
goto underlying_strftime;
#endif
@@ -855,7 +1300,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
}
break;
-#if !(defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY)
+#if !((defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY) || (USE_C_LOCALE &&
!HAVE_STRFTIME_L))
underlying_strftime:
{
/* The relevant information is available only via the
@@ -869,7 +1314,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
"#define strftime rpl_strftime". */
# ifdef strftime
# undef strftime
- size_t strftime ();
+ size_t strftime (char *, size_t, const char *, struct tm const *);
# endif
/* The space helps distinguish strftime failure from empty
@@ -880,9 +1325,88 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
*u++ = modifier;
*u++ = format_char;
*u = '\0';
+
+# if USE_C_LOCALE /* implies HAVE_STRFTIME_L */
+ locale_t locale = c_locale ();
+ if (!locale)
+ return 0; /* errno is set here */
+ len = strftime_l (ubuf, sizeof ubuf, ufmt, tp, locale);
+# else
len = strftime (ubuf, sizeof ubuf, ufmt, tp);
+# endif
if (len != 0)
- cpy (len - 1, ubuf + 1);
+ {
+# if defined __NetBSD__ || defined __sun /* NetBSD, Solaris */
+ if (format_char == L_('c'))
+ {
+ /* The output of the strftime %c directive consists of the
+ date, the time, and the time zone. But the time zone is
+ wrong, since neither TZ nor ZONE was passed as argument.
+ Therefore, remove the the last space-delimited word.
+ In order not to accidentally remove a date or a year
+ (that contains no letter) or an AM/PM indicator (that
has
+ length 2), remove that last word only if it contains a
+ letter and has length >= 3. */
+ char *space;
+ for (space = ubuf + len - 1; *space != ' '; space--)
+ ;
+ if (space > ubuf)
+ {
+ /* Found a space. */
+ if (strlen (space + 1) >= 3)
+ {
+ /* The last word has length >= 3. */
+ bool found_letter = false;
+ const char *p;
+ for (p = space + 1; *p != '\0'; p++)
+ if ((*p >= 'A' && *p <= 'Z')
+ || (*p >= 'a' && *p <= 'z'))
+ {
+ found_letter = true;
+ break;
+ }
+ if (found_letter)
+ {
+ /* The last word contains a letter. */
+ *space = '\0';
+ len = space - ubuf;
+ }
+ }
+ }
+ }
+# if REQUIRE_GNUISH_STRFTIME_AM_PM
+ /* The output of the strftime %p and %r directives contains
+ an AM/PM indicator even for locales where it is not
+ suitable, such as French. Remove this indicator. */
+ else if (format_char == L_('p'))
+ {
+ bool found_ampm = (len > 1);
+ if (found_ampm && should_remove_ampm ())
+ {
+ ubuf[1] = '\0';
+ len = 1;
+ }
+ }
+ else if (format_char == L_('r'))
+ {
+ char last_char = ubuf[len - 1];
+ bool found_ampm = !(last_char >= '0' && last_char <= '9');
+ if (found_ampm && should_remove_ampm ())
+ {
+ char *space;
+ for (space = ubuf + len - 1; *space != ' '; space--)
+ ;
+ if (space > ubuf)
+ {
+ *space = '\0';
+ len = space - ubuf;
+ }
+ }
+ }
+# endif
+# endif
+ cpy (len - 1, ubuf + 1);
+ }
}
break;
#endif
@@ -903,6 +1427,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
# endif
break;
}
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#else
goto underlying_strftime;
#endif
@@ -926,6 +1451,9 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
!= L_('\0'))))
subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT));
goto subformat;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ subfmt = L_("%m/%d/%y");
+ goto subformat;
#else
goto underlying_strftime;
#endif
@@ -1001,6 +1529,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
break;
}
}
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#else
goto underlying_strftime;
#endif
@@ -1148,7 +1677,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
to_uppcase = false;
to_lowcase = true;
}
-#ifdef _NL_CURRENT
+#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L)
cpy (ap_len, ampm);
break;
#else
@@ -1169,6 +1698,13 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
== L_('\0'))
subfmt = L_("%I:%M:%S %p");
goto subformat;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ subfmt = L_("%I:%M:%S %p");
+ goto subformat;
+#elif (defined __APPLE__ && defined __MACH__) || defined __FreeBSD__
+ /* macOS, FreeBSD strftime() may produce empty output for "%r". */
+ subfmt = L_("%I:%M:%S %p");
+ goto subformat;
#else
goto underlying_strftime;
#endif
@@ -1222,6 +1758,9 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
!= L_('\0'))))
subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT));
goto subformat;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ subfmt = L_("%H:%M:%S");
+ goto subformat;
#else
goto underlying_strftime;
#endif
@@ -1329,6 +1868,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
pad = yr_spec;
goto subformat;
}
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#else
goto underlying_strftime;
#endif
@@ -1352,6 +1892,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
DO_NUMBER (2, (era->offset
+ delta * era->absolute_direction));
}
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#else
goto underlying_strftime;
#endif
diff --git a/lib/strftime.h b/lib/strftime.h
index d6efdb848a3..8ce62cdb6d7 100644
--- a/lib/strftime.h
+++ b/lib/strftime.h
@@ -21,17 +21,68 @@
extern "C" {
#endif
-/* Just like strftime, but with two more arguments:
- POSIX requires that strftime use the local timezone information.
- Use the timezone __TZ instead. Use __NS as the number of
- nanoseconds in the %N directive.
-
- On error, set errno and return 0. Otherwise, return the number of
- bytes generated (not counting the trailing NUL), preserving errno
- if the number is 0. This errno behavior is in draft POSIX 202x
- plus some requested changes to POSIX. */
-size_t nstrftime (char *restrict, size_t, char const *, struct tm const *,
- timezone_t __tz, int __ns);
+/* Formats the broken-down time *__TP, with additional __NS nanoseconds,
+ into the buffer __S of size __MAXSIZE, according to the rules of the
+ LC_TIME category of the current locale.
+
+ Uses the time zone __TZ.
+ If *__TP represents local time, __TZ should be set to
+ tzalloc (getenv ("TZ")).
+ If *__TP represents universal time (a.k.a. GMT), __TZ should be set to
+ (timezone_t) 0.
+
+ The format string __FORMAT, including GNU extensions, is described in
+ the GNU libc's strftime() documentation:
+
<https://www.gnu.org/software/libc/manual/html_node/Formatting-Calendar-Time.html>
+ Additionally, the following conversion is supported:
+ %N The number of nanoseconds, passed as __NS argument.
+ Here's a summary of the available conversions (= format directives):
+ literal characters %n %t %%
+ date:
+ century %C
+ year %Y %y
+ week-based year %G %g
+ month (in year) %m %B %b %h
+ week in year %U %W %V
+ day in year %j
+ day (in month) %d %e
+ day in week %u %w %A %a
+ year, month, day %x %F %D
+ time:
+ half-day %p %P
+ hour %H %k %I %l
+ minute (in hour) %M
+ hour, minute %R
+ second (in minute) %S
+ hour, minute, second %r %T %X
+ second (since epoch) %s
+ date and time: %c
+ time zone: %z %Z
+ nanosecond %N
+
+ Stores the result, as a string with a trailing NUL character, at the
+ beginning of the array __S[0..__MAXSIZE-1], if it fits, and returns
+ the length of that string, not counting the trailing NUL. In this case,
+ errno is preserved if the return value is 0.
+ If it does not fit, this function sets errno to ERANGE and returns 0.
+ Upon other errors, this function sets errno and returns 0 as well.
+
+ Note: The errno behavior is in draft POSIX 202x plus some requested
+ changes to POSIX.
+
+ This function is like strftime, but with two more arguments:
+ * __TZ instead of the local timezone information,
+ * __NS as the number of nanoseconds in the %N directive.
+ */
+size_t nstrftime (char *restrict __s, size_t __maxsize,
+ char const *__format,
+ struct tm const *__tp, timezone_t __tz, int __ns);
+
+/* Like nstrftime, except that it uses the "C" locale instead of the
+ current locale. */
+size_t c_nstrftime (char *restrict __s, size_t __maxsize,
+ char const *__format,
+ struct tm const *__tp, timezone_t __tz, int __ns);
#ifdef __cplusplus
}
diff --git a/lib/time.in.h b/lib/time.in.h
index ce28f1af25d..df99c8abca9 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -438,11 +438,7 @@ _GL_CXXALIAS_SYS (ctime, char *, (time_t const *__tp));
_GL_CXXALIASWARN (ctime);
# endif
# elif defined GNULIB_POSIXCHECK
-# undef ctime
-# if HAVE_RAW_DECL_CTIME
-_GL_WARN_ON_USE (ctime, "ctime has portability problems - "
- "use gnulib module ctime for portability");
-# endif
+/* No need to warn about portability, as a more serious warning is below. */
# endif
/* Convert *TP to a date and time string. See
diff --git a/lib/time_r.c b/lib/time_r.c
index 3ef0b36802c..b724f3b38de 100644
--- a/lib/time_r.c
+++ b/lib/time_r.c
@@ -21,6 +21,11 @@
#include <time.h>
+/* The replacement functions in this file are only used on native Windows.
+ They are multithread-safe, because the gmtime() and localtime() functions
+ on native Windows — both in the ucrt and in the older MSVCRT — return a
+ pointer to a 'struct tm' in thread-local memory. */
+
static struct tm *
copy_tm_result (struct tm *dest, struct tm const *src)
{
diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h
index 8f4d40dcbeb..701013a07f4 100644
--- a/lib/warn-on-use.h
+++ b/lib/warn-on-use.h
@@ -32,6 +32,10 @@
_GL_WARN_ON_USE_ATTRIBUTE is for functions with 'static' or 'inline'
linkage.
+ _GL_WARN_ON_USE should not be used more than once for a given function
+ in a given compilation unit (because this may generate a warning even
+ if the function is never called).
+
However, one of the reasons that a function is a portability trap is
if it has the wrong signature. Declaring FUNCTION with a different
signature in C is a compilation error, so this macro must use the
diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h
index 0b7bb2cee85..7f30f83e769 100644
--- a/lib/xalloc-oversized.h
+++ b/lib/xalloc-oversized.h
@@ -29,8 +29,7 @@
is SIZE_MAX - 1. */
#define __xalloc_oversized(n, s) \
((s) != 0 \
- && ((size_t) (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) \
- < (n)))
+ && (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) < (n))
/* Return 1 if and only if an array of N objects, each of size S,
cannot exist reliably because its total size in bytes would exceed
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 2bd9faad69d..188eeb720c0 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -602,8 +602,7 @@ It is nil if the abbrev has already been unexpanded.")
"Undefine all abbrevs in abbrev table TABLE, leaving TABLE empty."
(setq abbrevs-changed t)
(let* ((sym (obarray-get table "")))
- (dotimes (i (length table))
- (aset table i 0))
+ (obarray-clear table)
;; Preserve the table's properties.
(cl-assert sym)
(let ((newsym (obarray-put table "")))
@@ -721,7 +720,7 @@ either a single abbrev table or a list of abbrev tables."
;; to treat the distinction between a single table and a list of tables.
(cond
((consp tables) tables)
- ((vectorp tables) (list tables))
+ ((obarrayp tables) (list tables))
(t
(let ((tables (if (listp local-abbrev-table)
(append local-abbrev-table
diff --git a/lisp/align.el b/lisp/align.el
index fa95f24fa02..81ccc4b5e2d 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -181,13 +181,12 @@ If nil, then no messages will ever be printed to the
minibuffer."
:type '(choice (const :tag "Align a large region silently" nil) integer)
:group 'align)
-(defcustom align-c++-modes '( c++-mode c-mode java-mode
- c-ts-mode c++-ts-mode)
+(defcustom align-c++-modes '( c++-mode c-mode java-mode)
"A list of modes whose syntax resembles C/C++."
:type '(repeat symbol)
:group 'align)
-(defcustom align-perl-modes '(perl-mode cperl-mode)
+(defcustom align-perl-modes '(perl-mode)
"A list of modes where Perl syntax is to be seen."
:type '(repeat symbol)
:group 'align)
@@ -576,13 +575,13 @@ The possible settings for `align-region-separate' are:
"="
(group (zero-or-more (syntax whitespace)))))
(group . (1 2))
- (modes . '(conf-toml-mode toml-ts-mode lua-mode lua-ts-mode)))
+ (modes . '(conf-toml-mode lua-mode)))
(double-dash-comment
(regexp . ,(rx (group (zero-or-more (syntax whitespace)))
"--"
(zero-or-more nonl)))
- (modes . '(lua-mode lua-ts-mode))
+ (modes . '(lua-mode))
(column . comment-column)
(valid . ,(lambda ()
(save-excursion
diff --git a/lisp/allout.el b/lisp/allout.el
index a7121efb14a..e3fe8d08841 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -161,9 +161,9 @@ respective `allout-mode' keybinding variables,
`allout-command-prefix',
(defcustom allout-command-prefix "\C-c "
"Key sequence to be used as prefix for outline mode command key bindings.
-Default is `\C-c<space>'; just `\C-c' is more short-and-sweet, if you're
-willing to let allout use a bunch of \C-c keybindings."
- :type 'string
+Default is \\`C-c SPC'; just \\`C-c' is more short-and-sweet, if you're
+willing to let allout use a bunch of \\`C-c' keybindings."
+ :type 'key-sequence
:group 'allout-keybindings
:set #'allout-compose-and-institute-keymap)
;;;_ = allout-keybindings-binding
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 1f233f9f60f..5f5629d9cfc 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -1985,7 +1985,7 @@ entries for git.gnus.org:
(defun auth-source--decode-octal-string (string)
- "Convert octal STRING to utf-8 string. E.g: \"a\134b\" to \"a\b\"."
+ "Convert octal STRING to utf-8 string. E.g.: \"a\\134b\" to \"a\\b\"."
(let ((list (string-to-list string))
(size (length string)))
(decode-coding-string
diff --git a/lisp/bind-key.el b/lisp/bind-key.el
index 94a39f795cd..378ad69b2bc 100644
--- a/lisp/bind-key.el
+++ b/lisp/bind-key.el
@@ -155,6 +155,7 @@ add keys to that keymap."
(add-to-list 'emulation-mode-map-alists
`((override-global-mode . ,override-global-map)))
+;;;###autoload
(defvar personal-keybindings nil
"List of bindings performed by `bind-key'.
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 5796544c534..ec5337e3fda 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -95,11 +95,35 @@ as it is by default."
:group 'Buffer-menu
:version "22.1")
+(defcustom Buffer-menu-group-by nil
+ "If non-nil, a function to call to divide buffer-menu buffers into groups.
+This function is called with one argument: a list of entries in the same
+format as in `tabulated-list-entries', and should return a list in the
+format suitable for `tabulated-list-groups'. Also, when this variable
+is non-nil, `outline-minor-mode' is enabled in the Buffer Menu and you
+can use Outline minor mode commands to show/hide groups of buffers,
+according to the value of `outline-regexp'.
+The default options can group by a mode, and by a root directory of
+a project or just `default-directory'.
+If this is nil, buffers are not divided into groups."
+ :type '(choice (const :tag "No grouping" nil)
+ (function-item :tag "Group by mode"
+ Buffer-menu-group-by-mode)
+ (function-item :tag "Group by project root or directory"
+ Buffer-menu-group-by-root)
+ (function :tag "Custom function"))
+ :group 'Buffer-menu
+ :version "30.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
commands.")
+(defvar-local Buffer-menu-show-internal nil
+ "Non-nil if the current Buffer Menu lists internal buffers.
+Internal buffers are those whose names start with a space.")
+
(defvar-local Buffer-menu-filter-predicate nil
"Function to filter out buffers in the buffer list.
Buffers that don't satisfy the predicate will be skipped.
@@ -140,6 +164,7 @@ then the buffer will be displayed in the buffer list.")
"V" #'Buffer-menu-view
"O" #'Buffer-menu-view-other-window
"T" #'Buffer-menu-toggle-files-only
+ "I" #'Buffer-menu-toggle-internal
"M-s a C-s" #'Buffer-menu-isearch-buffers
"M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp
"M-s a C-o" #'Buffer-menu-multi-occur
@@ -197,6 +222,10 @@ then the buffer will be displayed in the buffer list.")
:help "Toggle whether the current buffer-menu displays only file buffers"
:style toggle
:selected Buffer-menu-files-only]
+ ["Show Internal Buffers" Buffer-menu-toggle-internal
+ :help "Toggle whether the current buffer-menu displays internal buffers"
+ :style toggle
+ :selected Buffer-menu-show-internal]
"---"
["Refresh" revert-buffer
:help "Refresh the *Buffer List* buffer contents"]
@@ -317,6 +346,11 @@ ARG, show only buffers that are visiting files."
(interactive "P")
(display-buffer (list-buffers-noselect arg)))
+(defun Buffer-menu--selection-message ()
+ (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.")
+ (Buffer-menu-show-internal "Showing all buffers.")
+ (t "Showing all buffers except internal ones."))))
+
(defun Buffer-menu-toggle-files-only (arg)
"Toggle whether the current `buffer-menu' displays only file buffers.
With a positive ARG, display only file buffers. With zero or
@@ -325,9 +359,18 @@ negative ARG, display other buffers as well."
(setq Buffer-menu-files-only
(cond ((not arg) (not Buffer-menu-files-only))
((> (prefix-numeric-value arg) 0) t)))
- (message (if Buffer-menu-files-only
- "Showing only file-visiting buffers."
- "Showing all non-internal buffers."))
+ (Buffer-menu--selection-message)
+ (revert-buffer))
+
+(defun Buffer-menu-toggle-internal (arg)
+ "Toggle whether the current `buffer-menu' displays internal buffers.
+With a positive ARG, don't show internal buffers. With zero or
+negative ARG, display internal buffers as well."
+ (interactive "P" Buffer-menu-mode)
+ (setq Buffer-menu-show-internal
+ (cond ((not arg) (not Buffer-menu-show-internal))
+ ((> (prefix-numeric-value arg) 0) t)))
+ (Buffer-menu--selection-message)
(revert-buffer))
(define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort
@@ -385,14 +428,12 @@ When called interactively prompt for MARK; RET remove
all marks."
(interactive "cRemove marks (RET means all):" Buffer-menu-mode)
(save-excursion
(goto-char (point-min))
- (when (tabulated-list-header-overlay-p)
- (forward-line))
(while (not (eobp))
- (let ((xmarks (list (aref (tabulated-list-get-entry) 0)
- (aref (tabulated-list-get-entry) 2))))
- (when (or (char-equal mark ?\r)
- (member (char-to-string mark) xmarks))
- (Buffer-menu--unmark)))
+ (when-let ((entry (tabulated-list-get-entry)))
+ (let ((xmarks (list (aref entry 0) (aref entry 2))))
+ (when (or (char-equal mark ?\r)
+ (member (char-to-string mark) xmarks))
+ (Buffer-menu--unmark))))
(forward-line))))
(defun Buffer-menu-unmark-all ()
@@ -515,15 +556,16 @@ in the selected frame, and will remove any marks."
(defun Buffer-menu-marked-buffers (&optional unmark)
"Return the list of buffers marked with `Buffer-menu-mark'.
If UNMARK is non-nil, unmark them."
- (let (buffers)
- (Buffer-menu-beginning)
- (while (re-search-forward "^>" nil t)
- (let ((buffer (Buffer-menu-buffer)))
- (if (and buffer unmark)
- (tabulated-list-set-col 0 " " t))
- (if (buffer-live-p buffer)
- (push buffer buffers))))
- (nreverse buffers)))
+ (save-excursion
+ (let (buffers)
+ (Buffer-menu-beginning)
+ (while (re-search-forward "^>" nil t)
+ (let ((buffer (Buffer-menu-buffer)))
+ (if (and buffer unmark)
+ (tabulated-list-set-col 0 " " t))
+ (if (buffer-live-p buffer)
+ (push buffer buffers))))
+ (nreverse buffers))))
(defun Buffer-menu-isearch-buffers ()
"Search for a string through all marked buffers using Isearch."
@@ -569,13 +611,17 @@ If UNMARK is non-nil, unmark them."
(defun Buffer-menu-other-window ()
"Select this line's buffer in other window, leaving buffer menu visible."
(interactive nil Buffer-menu-mode)
- (switch-to-buffer-other-window (Buffer-menu-buffer t)))
+ (let ((display-buffer-overriding-action
+ '(nil (inhibit-same-window . t))))
+ (switch-to-buffer-other-window (Buffer-menu-buffer t))))
(defun Buffer-menu-switch-other-window ()
"Make the other window select this line's buffer.
The current window remains selected."
(interactive nil Buffer-menu-mode)
- (display-buffer (Buffer-menu-buffer t) t))
+ (let ((display-buffer-overriding-action
+ '(nil (inhibit-same-window . t))))
+ (display-buffer (Buffer-menu-buffer t) t)))
(defun Buffer-menu-2-window ()
"Select this line's buffer, with previous buffer in second window."
@@ -647,7 +693,12 @@ See more at `Buffer-menu-filter-predicate'."
(setq Buffer-menu-buffer-list buffer-list)
(setq Buffer-menu-filter-predicate filter-predicate)
(list-buffers--refresh buffer-list old-buffer)
- (tabulated-list-print))
+ (tabulated-list-print)
+ (when tabulated-list-groups
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight t
+ outline-minor-mode-use-buttons 'in-margins)
+ (outline-minor-mode 1)))
buffer))
(defun Buffer-menu-mouse-select (event)
@@ -667,6 +718,7 @@ See more at `Buffer-menu-filter-predicate'."
(marked-buffers (Buffer-menu-marked-buffers))
(buffer-menu-buffer (current-buffer))
(show-non-file (not Buffer-menu-files-only))
+ (show-internal Buffer-menu-show-internal)
(filter-predicate (and (functionp Buffer-menu-filter-predicate)
Buffer-menu-filter-predicate))
entries name-width)
@@ -686,7 +738,8 @@ See more at `Buffer-menu-filter-predicate'."
(file buffer-file-name))
(when (and (buffer-live-p buffer)
(or buffer-list
- (and (or (not (string= (substring name 0 1) " "))
+ (and (or show-internal
+ (not (string= (substring name 0 1) " "))
file)
(not (eq buffer buffer-menu-buffer))
(or file show-non-file)
@@ -721,7 +774,11 @@ See more at `Buffer-menu-filter-predicate'."
`("Mode" ,Buffer-menu-mode-width t)
'("File" 1 t)))
(setq tabulated-list-use-header-line Buffer-menu-use-header-line)
- (setq tabulated-list-entries (nreverse entries)))
+ (setq tabulated-list-entries (nreverse entries))
+ (when Buffer-menu-group-by
+ (setq tabulated-list-groups
+ (seq-group-by Buffer-menu-group-by
+ tabulated-list-entries))))
(tabulated-list-init-header))
(defun tabulated-list-entry-size-> (entry1 entry2)
@@ -740,4 +797,14 @@ See more at `Buffer-menu-filter-predicate'."
(abbreviate-file-name list-buffers-directory))
(t "")))
+(defun Buffer-menu-group-by-mode (entry)
+ (concat "* " (aref (cadr entry) 5)))
+
+(declare-function project-root "project" (project))
+(defun Buffer-menu-group-by-root (entry)
+ (concat "* " (with-current-buffer (car entry)
+ (if-let ((project (project-current)))
+ (project-root project)
+ default-directory))))
+
;;; buff-menu.el ends here
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index 5754d725272..b3f51dd8018 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -1,6 +1,6 @@
;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t
-*-
;;
-;; Copyright (C) 2004-2005, 2007-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2024 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Created: 27 Apr 2004
@@ -84,7 +84,7 @@ MODES can be a symbol or a list of symbols.
FUNCTION does not have arguments."
(setq modes (ensure-list modes))
(mode-local-map-file-buffers
- function (lambda () (apply #'derived-mode-p modes))))
+ function (lambda () (derived-mode-p modes))))
;;; Hook machinery
;;
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 053f583a60e..fdd1406848a 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -153,13 +153,13 @@ The search priority is:
"Return the dynamic macro map for the current buffer."
(or semantic-lex-spp-dynamic-macro-symbol-obarray
(setq semantic-lex-spp-dynamic-macro-symbol-obarray
- (make-vector 13 0))))
+ (obarray-make 13))))
(defsubst semantic-lex-spp-dynamic-map-stack ()
"Return the dynamic macro map for the current buffer."
(or semantic-lex-spp-dynamic-macro-symbol-obarray-stack
(setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack
- (make-vector 13 0))))
+ (obarray-make 13))))
(defun semantic-lex-spp-value-valid-p (value)
"Return non-nil if VALUE is valid."
@@ -260,7 +260,7 @@ NAME is the name of the spp macro symbol to define.
REPLACEMENT a string that would be substituted in for NAME."
;; Create the symbol hash table
- (let ((semantic-lex-spp-macro-symbol-obarray (make-vector 13 0))
+ (let ((semantic-lex-spp-macro-symbol-obarray (obarray-make 13))
spec)
;; fill it with stuff
(while specs
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 144ebcd64f8..fda35bd0199 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -259,7 +259,7 @@ If optional argument PROPSPECS is non-nil, then interpret
it, and
apply those properties.
PROPSPECS must be a list of (NAME PROPERTY VALUE) elements."
;; Create the symbol hash table
- (let ((semantic-flex-keywords-obarray (make-vector 13 0))
+ (let ((semantic-flex-keywords-obarray (obarray-make 13))
spec)
;; fill it with stuff
(while specs
@@ -416,7 +416,7 @@ If optional argument PROPSPECS is non-nil, then interpret
it, and
apply those properties.
PROPSPECS must be a list of (TYPE PROPERTY VALUE)."
;; Create the symbol hash table
- (let* ((semantic-lex-types-obarray (make-vector 13 0))
+ (let* ((semantic-lex-types-obarray (obarray-make 13))
spec type tokens token alist default)
;; fill it with stuff
(while specs
diff --git a/lisp/cedet/semantic/symref/grep.el
b/lisp/cedet/semantic/symref/grep.el
index 83e3bc36073..cc4d1546c85 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -44,9 +44,7 @@ those hits returned.")
(defvar semantic-symref-filepattern-alist
'((c-mode "*.[ch]")
- (c-ts-mode "*.[ch]")
(c++-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh")
- (c++-ts-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh")
(html-mode "*.html" "*.shtml" "*.php")
(mhtml-mode "*.html" "*.shtml" "*.php") ; FIXME: remove
; duplication of
@@ -55,12 +53,8 @@ those hits returned.")
; major mode definition?
(ruby-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml"
"Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile")
- (ruby-ts-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml"
- "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile")
(python-mode "*.py" "*.pyi" "*.pyw")
- (python-ts-mode "*.py" "*.pyi" "*.pyw")
(perl-mode "*.pl" "*.PL")
- (cperl-mode "*.pl" "*.PL")
(lisp-interaction-mode "*.el" "*.ede" ".emacs" "_emacs")
)
"List of major modes and file extension pattern.
diff --git a/lisp/comint.el b/lisp/comint.el
index 0a9cdb44bef..655ff30469c 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -254,7 +254,7 @@ This variable is buffer-local."
See also `comint-read-input-ring' and `comint-write-input-ring'.
`comint-mode' makes this a buffer-local variable. You probably want
to set this in a mode hook, rather than customize the default value."
- :type '(choice (const :tag "nil" nil)
+ :type '(choice (const :tag "Disable input history" nil)
file)
:group 'comint)
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 6fd60f3c416..e827da43a08 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -302,21 +302,21 @@ point, otherwise hide it."
;; never display a stale preview and that the preview doesn't
;; flicker, even with slow completion backends.
(let* ((beg (completion-preview--get 'completion-preview-beg))
+ (end (max (point) (overlay-start completion-preview--overlay)))
(cands (completion-preview--get 'completion-preview-cands))
(index (completion-preview--get 'completion-preview-index))
(cand (nth index cands))
- (len (length cand))
- (end (+ beg len))
- (cur (point))
- (face (get-text-property 0 'face (completion-preview--get
'after-string))))
- (if (and (< beg cur end) (string-prefix-p (buffer-substring beg cur)
cand))
+ (after (completion-preview--get 'after-string))
+ (face (get-text-property 0 'face after)))
+ (if (and (<= beg (point) end (1- (+ beg (length cand))))
+ (string-prefix-p (buffer-substring beg end) cand))
;; The previous preview is still applicable, update it.
(overlay-put (completion-preview--make-overlay
- cur (propertize (substring cand (- cur beg))
+ end (propertize (substring cand (- end beg))
'face face
'mouse-face
'completion-preview-highlight
'keymap completion-preview--mouse-map))
- 'completion-preview-end cur)
+ 'completion-preview-end end)
;; The previous preview is no longer applicable, hide it.
(completion-preview-active-mode -1))))
;; Run `completion-at-point-functions' to get a new candidate.
@@ -366,16 +366,16 @@ prefix argument and defaults to 1."
(interactive "p")
(when completion-preview-active-mode
(let* ((beg (completion-preview--get 'completion-preview-beg))
+ (end (completion-preview--get 'completion-preview-end))
(all (completion-preview--get 'completion-preview-cands))
(cur (completion-preview--get 'completion-preview-index))
(len (length all))
(new (mod (+ cur direction) len))
- (str (nth new all))
- (pos (point)))
- (while (or (<= (+ beg (length str)) pos)
- (not (string-prefix-p (buffer-substring beg pos) str)))
+ (str (nth new all)))
+ (while (or (<= (+ beg (length str)) end)
+ (not (string-prefix-p (buffer-substring beg end) str)))
(setq new (mod (+ new direction) len) str (nth new all)))
- (let ((aft (propertize (substring str (- pos beg))
+ (let ((aft (propertize (substring str (- end beg))
'face (if (< 1 len)
'completion-preview
'completion-preview-exact)
diff --git a/lisp/completion.el b/lisp/completion.el
index ab7f2a7bc52..6c758e56eab 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -875,11 +875,11 @@ This is sensitive to `case-fold-search'."
;; GNU implements obarrays
(defconst cmpl-obarray-length 511)
-(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)
+(defvar cmpl-prefix-obarray (obarray-make cmpl-obarray-length)
"An obarray used to store the downcased completion prefixes.
Each symbol is bound to a list of completion entries.")
-(defvar cmpl-obarray (make-vector cmpl-obarray-length 0)
+(defvar cmpl-obarray (obarray-make cmpl-obarray-length)
"An obarray used to store the downcased completions.
Each symbol is bound to a single completion entry.")
@@ -962,8 +962,8 @@ Each symbol is bound to a single completion entry.")
(defun clear-all-completions ()
"Initialize the completion storage. All existing completions are lost."
(interactive)
- (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
- (setq cmpl-obarray (make-vector cmpl-obarray-length 0)))
+ (setq cmpl-prefix-obarray (obarray-make cmpl-obarray-length))
+ (setq cmpl-obarray (obarray-make cmpl-obarray-length)))
(defun list-all-completions ()
"Return a list of all the known completion entries."
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 38b6ec984ab..8fad51dc116 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1227,6 +1227,41 @@ If OTHER-WINDOW is non-nil, display in another window."
(unless (eq symbol basevar)
(message "`%s' is an alias for `%s'" symbol basevar))))
+;;;###autoload
+(defun customize-toggle-option (symbol)
+ "Toggle the value of boolean option SYMBOL for this session."
+ (interactive (let ((prompt "Toggle boolean option: ") opts)
+ (mapatoms
+ (lambda (sym)
+ (when (eq (get sym 'custom-type) 'boolean)
+ (push sym opts))))
+ (list (intern (completing-read prompt opts nil nil nil nil
+ (symbol-at-point))))))
+ (let* ((setter (or (get symbol 'custom-set) #'set-default))
+ (getter (or (get symbol 'custom-get) #'symbol-value))
+ (value (condition-case nil
+ (funcall getter symbol)
+ (void-variable (error "`%s' is not bound" symbol))))
+ (type (get symbol 'custom-type)))
+ (cond
+ ((eq type 'boolean))
+ ((and (null type)
+ (yes-or-no-p
+ (format "`%s' doesn't have a type, and has the value %S. \
+Proceed to toggle?" symbol value))))
+ ((yes-or-no-p
+ (format "`%s' is of type %s, and has the value %S. \
+Proceed to toggle?"
+ symbol type value)))
+ ((error "Abort toggling of option `%s'" symbol)))
+ (message "%s user options `%s'."
+ (if (funcall setter symbol (not value))
+ "Enabled" "Disabled")
+ symbol)))
+
+;;;###autoload
+(defalias 'toggle-option #'customize-toggle-option)
+
;;;###autoload
(defalias 'customize-variable-other-window 'customize-option-other-window)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 7e0b64e9067..3fe62c8d0da 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -371,6 +371,7 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
(auto-save-timeout auto-save (choice (const :tag "off" nil)
(integer :format "%v")))
(echo-keystrokes minibuffer number)
+ (echo-keystrokes-help minibuffer boolean "30.1")
(polling-period keyboard float)
(double-click-time mouse (restricted-sexp
:match-alternatives (integerp 'nil 't)))
diff --git a/lisp/dired.el b/lisp/dired.el
index cef93ab757c..9e3b888df14 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -4321,6 +4321,11 @@ this subdir."
(prefix-numeric-value arg)
(lambda ()
(when (or (not (looking-at-p dired-re-dot))
+ ;; Don't skip symlinks to ".", "..", etc.
+ (save-excursion
+ (re-search-forward
+ dired-permission-flags-regexp nil t)
+ (eq (char-after (match-beginning 1)) ?l))
(not (equal dired-marker-char dired-del-marker)))
(delete-char 1)
(insert dired-marker-char))))))))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 80ca8fc177e..930e273a3be 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1450,7 +1450,8 @@ See Info node `(elisp) Integer Basics'."
(defun byte-optimize-apply (form)
(let ((len (length form)))
- (if (>= len 2)
+ ;; Single-arg `apply' is an abomination that we don't bother optimizing.
+ (if (> len 2)
(let ((fn (nth 1 form))
(last (nth (1- len) form)))
(cond
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b936cfb4a1f..6e040346988 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -285,6 +285,7 @@ The information is logged to `byte-compile-log-buffer'."
(defconst byte-compile-warning-types
'( callargs constants
docstrings docstrings-non-ascii-quotes docstrings-wide
+ docstrings-control-chars
empty-body free-vars ignored-return-value interactive-only
lexical lexical-dynamic make-local
mapcar ; obsolete
@@ -307,6 +308,8 @@ Elements of the list may be:
docstrings that are too wide, containing lines longer than both
`byte-compile-docstring-max-column' and `fill-column' characters.
Only enabled when `docstrings' also is.
+ docstrings-control-chars
+ docstrings that contain control characters other than NL and TAB
empty-body body argument to a special form or macro is empty.
free-vars references to variables not in the current lexical scope.
ignored-return-value
@@ -1776,6 +1779,24 @@ It is too wide if it has any lines longer than the
largest of
(byte-compile-warn-x
name
"%sdocstring wider than %s characters" (funcall prefix) col)))
+
+ (when (byte-compile-warning-enabled-p 'docstrings-control-chars)
+ (let ((start 0)
+ (len (length docs)))
+ (while (and (< start len)
+ (string-match (rx (intersection (in (0 . 31) 127)
+ (not (in "\n\t"))))
+ docs start))
+ (let* ((ofs (match-beginning 0))
+ (c (aref docs ofs)))
+ ;; FIXME: it should be possible to use the exact source position
+ ;; of the control char in most cases, and it would be helpful
+ (byte-compile-warn-x
+ name
+ "%sdocstring contains control char #x%02x (position %d)"
+ (funcall prefix) c ofs)
+ (setq start (1+ ofs))))))
+
;; There's a "naked" ' character before a symbol/list, so it
;; should probably be quoted with \=.
(when (string-match-p (rx (| (in " \t") bol)
@@ -3052,12 +3073,11 @@ lambda-expression."
(append (if (not lexical-binding) arglistvars)
byte-compile-bound-variables))
(body (cdr (cdr fun)))
- (doc (if (stringp (car body))
+ ;; Treat a final string literal as a value, not a doc string.
+ (doc (if (and (cdr body) (stringp (car body)))
(prog1 (car body)
- ;; Discard the doc string from the body
- ;; unless it is the last element of the body.
- (if (cdr body)
- (setq body (cdr body))))))
+ ;; Discard the doc string from the body.
+ (setq body (cdr body)))))
(int (assq 'interactive body))
command-modes)
(when lexical-binding
@@ -5762,6 +5782,16 @@ and corresponding effects."
(eval form)
form)))
+;; Report comma operator used outside of backquote.
+;; Inside backquote, backquote will transform it before it gets here.
+
+(put '\, 'compiler-macro #'bytecomp--report-comma)
+(defun bytecomp--report-comma (form &rest _ignore)
+ (macroexp-warn-and-return
+ (format-message "`%s' called -- perhaps used not within backquote"
+ (car form))
+ form (list 'suspicious (car form)) t))
+
;; Check for (in)comparable constant values in calls to `eq', `memq' etc.
(defun bytecomp--dodgy-eq-arg-p (x number-ok)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 0168b86e2ba..38f3a270fd1 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -632,12 +632,16 @@ places where they originally did not directly appear."
(cconv-convert exp env extend))
(`(,func . ,forms)
- (if (symbolp func)
+ (if (or (symbolp func) (functionp func))
;; First element is function or whatever function-like forms are:
;; or, and, if, catch, progn, prog1, while, until
- `(,func . ,(mapcar (lambda (form)
- (cconv-convert form env extend))
- forms))
+ (let ((args (mapcar (lambda (form) (cconv-convert form env extend))
+ forms)))
+ (unless (symbolp func)
+ (byte-compile-warn-x
+ form
+ "Use `funcall' instead of `%s' in the function position" func))
+ `(,func . ,args))
(byte-compile-warn-x form "Malformed function `%S'" func)
nil))
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index 8e40b227b65..faa7824c8bd 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -85,6 +85,9 @@ don't know how to recognize (e.g. some macros)."
(let (alist)
(with-temp-buffer
(insert-file-contents file)
+ ;; Ensure shorthands available, as we will be `read'ing Elisp
+ ;; (bug#67523)
+ (let (enable-local-variables) (hack-local-variables))
;; FIXME we could theoretically be inside a string.
(while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t)
(let ((pos (match-beginning 1)))
@@ -145,64 +148,70 @@ is a string giving details of the error."
(if (file-regular-p fnfile)
(with-temp-buffer
(insert-file-contents fnfile)
+ (unless cflag
+ ;; If in Elisp, ensure syntax and shorthands available
+ ;; (bug#67523)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (let (enable-local-variables) (hack-local-variables)))
;; defsubst's don't _have_ to be known at compile time.
- (setq re (format (if cflag
- "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
- "^[ \t]*(\\(fset[ \t]+'\\|\
+ (setq re (if cflag
+ (format "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
+ (regexp-opt (mapcar 'cadr fnlist) t))
+ "^[ \t]*(\\(fset[ \t]+'\\|\
cl-def\\(?:generic\\|method\\|un\\)\\|\
def\\(?:un\\|subst\\|foo\\|method\\|class\\|\
ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\
\\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\
ine-overloadable-function\\)\\)\
-[ \t]*%s\\([ \t;]+\\|$\\)")
- (regexp-opt (mapcar 'cadr fnlist) t)))
+[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\([ \t;]+\\|$\\)"))
(while (re-search-forward re nil t)
(skip-chars-forward " \t\n")
- (setq fn (match-string 2)
- type (match-string 1)
- ;; (min . max) for a fixed number of arguments, or
- ;; arglists with optional elements.
- ;; (min) for arglists with &rest.
- ;; sig = 'err means we could not find an arglist.
- sig (cond (cflag
- (or
- (when (search-forward "," nil t 3)
- (skip-chars-forward " \t\n")
- ;; Assuming minargs and maxargs on same line.
- (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\
+ (setq fn (symbol-name (car (read-from-string (match-string 2)))))
+ (when (member fn (mapcar 'cadr fnlist))
+ (setq type (match-string 1)
+ ;; (min . max) for a fixed number of arguments, or
+ ;; arglists with optional elements.
+ ;; (min) for arglists with &rest.
+ ;; sig = 'err means we could not find an arglist.
+ sig (cond (cflag
+ (or
+ (when (search-forward "," nil t 3)
+ (skip-chars-forward " \t\n")
+ ;; Assuming minargs and maxargs on same line.
+ (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\
\\([0-9]+\\|MANY\\|UNEVALLED\\)")
- (setq minargs (string-to-number
- (match-string 1))
- maxargs (match-string 2))
- (cons minargs (unless (string-match "[^0-9]"
- maxargs)
- (string-to-number
- maxargs)))))
- 'err))
- ((string-match
- "\\`define-\\(derived\\|generic\\)-mode\\'"
- type)
- '(0 . 0))
- ((string-match
-
"\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'"
- type)
- '(0 . 1))
- ;; Prompt to update.
- ((string-match
- "\\`define-obsolete-function-alias\\>"
- type)
- 'obsolete)
- ;; Can't easily check arguments in these cases.
- ((string-match "\\`\\(def\\(alias\\|class\\)\\|\
+ (setq minargs (string-to-number
+ (match-string 1))
+ maxargs (match-string 2))
+ (cons minargs (unless (string-match
"[^0-9]"
+
maxargs)
+ (string-to-number
+ maxargs)))))
+ 'err))
+ ((string-match
+ "\\`define-\\(derived\\|generic\\)-mode\\'"
+ type)
+ '(0 . 0))
+ ((string-match
+
"\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'"
+ type)
+ '(0 . 1))
+ ;; Prompt to update.
+ ((string-match
+ "\\`define-obsolete-function-alias\\>"
+ type)
+ 'obsolete)
+ ;; Can't easily check arguments in these cases.
+ ((string-match "\\`\\(def\\(alias\\|class\\)\\|\
fset\\|\\(?:cl-\\)?defmethod\\)\\>" type)
- t)
- ((looking-at "\\((\\|nil\\)")
- (byte-compile-arglist-signature
- (read (current-buffer))))
- (t
- 'err))
- ;; alist of functions and arglist signatures.
- siglist (cons (cons fn sig) siglist)))))
+ t)
+ ((looking-at "\\((\\|nil\\)")
+ (byte-compile-arglist-signature
+ (read (current-buffer))))
+ (t
+ 'err))
+ ;; alist of functions and arglist signatures.
+ siglist (cons (cons fn sig) siglist))))))
(dolist (e fnlist)
(setq arglist (nth 2 e)
type
@@ -319,9 +328,14 @@ Returns non-nil if any false statements are found."
(setq root (directory-file-name (file-relative-name root)))
(or (file-directory-p root)
(error "Directory `%s' not found" root))
- (let ((files (directory-files-recursively root "\\.el\\'")))
- (when files
- (apply #'check-declare-files files))))
+ (when-let* ((files (directory-files-recursively root "\\.el\\'"))
+ (files (mapcan (lambda (file)
+ ;; Filter out lock files.
+ (and (not (string-prefix-p
+ ".#" (file-name-nondirectory file)))
+ (list file)))
+ files)))
+ (apply #'check-declare-files files)))
(provide 'check-declare)
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 82c6c03a592..02c11cae573 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1994,7 +1994,7 @@ from the comment."
(defun-depth (ppss-depth (syntax-ppss)))
(lst nil)
(ret nil)
- (oo (make-vector 3 0))) ;substitute obarray for `read'
+ (oo (obarray-make 3))) ;substitute obarray for `read'
(forward-char 1)
(forward-sexp 1)
(skip-chars-forward " \n\t")
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 9281cd9821e..c8eaca9a77c 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -714,7 +714,9 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
;; FIXME: We could go crazy and add another entry so describe-symbol can be
;; used with the slot names of CL structs (and/or EIEIO objects).
(add-to-list 'describe-symbol-backends
- `(nil ,#'cl-find-class ,(lambda (s _b _f) (cl-describe-type s))))
+ `(nil ,#'cl-find-class ,#'cl-describe-type)
+ ;; Document the `cons` function before the `cons` type.
+ t)
(defconst cl--typedef-regexp
(concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct"
@@ -744,7 +746,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(cl--find-class type))
;;;###autoload
-(defun cl-describe-type (type)
+(defun cl-describe-type (type &optional _buf _frame)
"Display the documentation for type TYPE (a symbol)."
(interactive
(let ((str (completing-read "Describe type: " obarray #'cl-find-class t)))
@@ -766,6 +768,15 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
;; Return the text we displayed.
(buffer-string)))))
+(defun cl--class-children (class)
+ (let ((children '()))
+ (mapatoms
+ (lambda (sym)
+ (let ((sym-class (cl--find-class sym)))
+ (and sym-class (memq class (cl--class-parents sym-class))
+ (push sym children)))))
+ children))
+
(defun cl--describe-class (type &optional class)
(unless class (setq class (cl--find-class type)))
(let ((location (find-lisp-object-file-name type 'define-type))
@@ -796,10 +807,8 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(insert (substitute-command-keys (if pl "', " "'"))))
(insert ".\n")))
- ;; Children, if available. ¡For EIEIO!
- (let ((ch (condition-case nil
- (cl-struct-slot-value metatype 'children class)
- (cl-struct-unknown-slot nil)))
+ ;; Children.
+ (let ((ch (cl--class-children class))
cur)
(when ch
(insert " Children ")
@@ -903,22 +912,25 @@ Outputs to the current buffer."
(cslots (condition-case nil
(cl-struct-slot-value metatype 'class-slots class)
(cl-struct-unknown-slot nil))))
- (insert (propertize "Instance Allocated Slots:\n\n"
- 'face 'bold))
- (let* ((has-doc nil)
- (slots-strings
- (mapcar
- (lambda (slot)
- (list (cl-prin1-to-string (cl--slot-descriptor-name slot))
- (cl-prin1-to-string (cl--slot-descriptor-type slot))
- (cl-prin1-to-string (cl--slot-descriptor-initform slot))
- (let ((doc (alist-get :documentation
- (cl--slot-descriptor-props slot))))
- (if (not doc) ""
- (setq has-doc t)
- (substitute-command-keys doc)))))
- slots)))
- (cl--print-table `("Name" "Type" "Default") slots-strings has-doc))
+ (if (and (null slots) (eq metatype 'built-in-class))
+ (insert "This is a built-in type.\n")
+
+ (insert (propertize "Instance Allocated Slots:\n\n"
+ 'face 'bold))
+ (let* ((has-doc nil)
+ (slots-strings
+ (mapcar
+ (lambda (slot)
+ (list (cl-prin1-to-string (cl--slot-descriptor-name slot))
+ (cl-prin1-to-string (cl--slot-descriptor-type slot))
+ (cl-prin1-to-string (cl--slot-descriptor-initform slot))
+ (let ((doc (alist-get :documentation
+ (cl--slot-descriptor-props
slot))))
+ (if (not doc) ""
+ (setq has-doc t)
+ (substitute-command-keys doc)))))
+ slots)))
+ (cl--print-table `("Name" "Type" "Default") slots-strings has-doc)))
(insert "\n")
(when (> (length cslots) 0)
(insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 1168d8e3184..234ce9c1681 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1175,12 +1175,8 @@ MET-NAME is as returned by
`cl--generic-load-hist-format'."
(add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
(defun cl--generic-describe (function)
- ;; Supposedly this is called from help-fns, so help-fns should be loaded at
- ;; this point.
- (declare-function help-fns-short-filename "help-fns" (filename))
(let ((generic (if (symbolp function) (cl--generic function))))
(when generic
- (require 'help-mode) ;Needed for `help-function-def' button!
(save-excursion
;; Ensure that we have two blank lines (but not more).
(unless (looking-back "\n\n" (- (point) 2))
@@ -1188,33 +1184,49 @@ MET-NAME is as returned by
`cl--generic-load-hist-format'."
(insert "This is a generic function.\n\n")
(insert (propertize "Implementations:\n\n" 'face 'bold))
;; Loop over fanciful generics
- (dolist (method (cl--generic-method-table generic))
- (pcase-let*
- ((`(,qualifiers ,args ,doc) (cl--generic-method-info method)))
- ;; FIXME: Add hyperlinks for the types as well.
- (let ((print-quoted nil)
- (quals (if (length> qualifiers 0)
- (concat (substring qualifiers
- 0 (string-match " *\\'"
- qualifiers))
- "\n")
- "")))
- (insert (format "%s%S"
- quals
- (cons function
- (cl--generic-upcase-formal-args args)))))
- (let* ((met-name (cl--generic-load-hist-format
- function
- (cl--generic-method-qualifiers method)
- (cl--generic-method-specializers method)))
- (file (find-lisp-object-file-name met-name 'cl-defmethod)))
- (when file
- (insert (substitute-command-keys " in `"))
- (help-insert-xref-button (help-fns-short-filename file)
- 'help-function-def met-name file
- 'cl-defmethod)
- (insert (substitute-command-keys "'.\n"))))
- (insert "\n" (or doc "Undocumented") "\n\n")))))))
+ (cl--map-methods-documentation
+ function
+ (lambda (quals signature file doc)
+ (insert (format "%s%S%s\n\n%s\n\n"
+ quals signature
+ (if file (format-message " in `%s'." file) "")
+ (or doc "Undocumented")))))))))
+
+(defun cl--map-methods-documentation (funname metname-printer)
+ "Iterate on FUNNAME's methods documentation at point."
+ ;; Supposedly this is called from help-fns, so help-fns should be loaded at
+ ;; this point.
+ (require 'help-fns)
+ (declare-function help-fns-short-filename "help-fns" (filename))
+ (let ((generic (if (symbolp funname) (cl--generic funname))))
+ (when generic
+ (require 'help-mode) ;Needed for `help-function-def' button!
+ ;; Loop over fanciful generics
+ (dolist (method (cl--generic-method-table generic))
+ (pcase-let*
+ ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))
+ ;; FIXME: Add hyperlinks for the types as well.
+ (quals (if (length> qualifiers 0)
+ (concat (substring qualifiers
+ 0 (string-match " *\\'"
+ qualifiers))
+ "\n")
+ ""))
+ (met-name (cl--generic-load-hist-format
+ funname
+ (cl--generic-method-qualifiers method)
+ (cl--generic-method-specializers method)))
+ (file (find-lisp-object-file-name met-name 'cl-defmethod)))
+ (funcall metname-printer
+ quals
+ (cons funname
+ (cl--generic-upcase-formal-args args))
+ (when file
+ (make-text-button (help-fns-short-filename file) nil
+ 'type 'help-function-def
+ 'help-args
+ (list met-name file 'cl-defmethod)))
+ doc))))))
(defun cl--generic-specializers-apply-to-type-p (specializers type)
"Return non-nil if a method with SPECIALIZERS applies to TYPE."
@@ -1353,62 +1365,31 @@ These match if the argument is `eql' to VAL."
(cl--generic-prefill-dispatchers (terminal-parameter nil 'xterm--set-selection)
(eql nil))
-;;; Support for cl-defstructs specializers.
-
-(defun cl--generic-struct-tag (name &rest _)
- ;; Use exactly the same code as for `typeof'.
- `(if ,name (type-of ,name) 'null))
+;;; Dispatch on "normal types".
-(defun cl--generic-struct-specializers (tag &rest _)
+(defun cl--generic-type-specializers (tag &rest _)
(and (symbolp tag)
- (let ((class (get tag 'cl--class)))
- (when (cl-typep class 'cl-structure-class)
+ (let ((class (cl--find-class tag)))
+ (when class
(cl--class-allparents class)))))
-(cl-generic-define-generalizer cl--generic-struct-generalizer
- 50 #'cl--generic-struct-tag
- #'cl--generic-struct-specializers)
-
-(cl-defmethod cl-generic-generalizers :extra "cl-struct" (type)
- "Support for dispatch on types defined by `cl-defstruct'."
- (or
- (when (symbolp type)
- ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than
- ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can
- ;; take place without requiring cl-lib.
- (let ((class (cl--find-class type)))
- (and (cl-typep class 'cl-structure-class)
- (or (null (cl--struct-class-type class))
- (error "Can't dispatch on cl-struct %S: type is %S"
- type (cl--struct-class-type class)))
- (progn (cl-assert (null (cl--struct-class-named class))) t)
- (list cl--generic-struct-generalizer))))
- (cl-call-next-method)))
-
-(cl--generic-prefill-dispatchers 0 cl--generic-generalizer)
-
-;;; Dispatch on "system types".
-
(cl-generic-define-generalizer cl--generic-typeof-generalizer
;; FIXME: We could also change `type-of' to return `null' for nil.
10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null))
- (lambda (tag &rest _)
- (and (symbolp tag) (assq tag cl--typeof-types))))
+ #'cl--generic-type-specializers)
(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
- "Support for dispatch on builtin types.
-See the full list and their hierarchy in `cl--typeof-types'."
+ "Support for dispatch on types.
+This currently works for built-in types and types built on top of records."
;; FIXME: Add support for other types accepted by `cl-typep' such
;; as `character', `face', `function', ...
(or
- (and (memq type cl--all-builtin-types)
- (progn
- ;; FIXME: While this wrinkle in the semantics can be occasionally
- ;; problematic, this warning is more often annoying than helpful.
- ;;(if (memq type '(vector array sequence))
- ;; (message "`%S' also matches CL structs and EIEIO classes"
- ;; type))
- (list cl--generic-typeof-generalizer)))
+ (and (symbolp type)
+ (not (eq type t)) ;; Handled by the `t-generalizer'.
+ (let ((class (cl--find-class type)))
+ (memq (type-of class)
+ '(built-in-class cl-structure-class eieio--class)))
+ (list cl--generic-typeof-generalizer))
(cl-call-next-method)))
(cl--generic-prefill-dispatchers 0 integer)
@@ -1416,6 +1397,8 @@ See the full list and their hierarchy in
`cl--typeof-types'."
(cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer)
(cl--generic-prefill-dispatchers 0 (eql 'x) integer)
+(cl--generic-prefill-dispatchers 0 cl--generic-generalizer)
+
;;; Dispatch on major mode.
;; Two parts:
@@ -1453,19 +1436,13 @@ Used internally for the (major-mode MODE) context
specializers."
(defun cl--generic-oclosure-tag (name &rest _)
`(oclosure-type ,name))
-(defun cl-generic--oclosure-specializers (tag &rest _)
- (and (symbolp tag)
- (let ((class (cl--find-class tag)))
- (when (cl-typep class 'oclosure--class)
- (oclosure--class-allparents class)))))
-
(cl-generic-define-generalizer cl--generic-oclosure-generalizer
;; Give slightly higher priority than the struct specializer, so that
;; for a generic function with methods dispatching structs and on OClosures,
;; we first try `oclosure-type' before `type-of' since `type-of' will return
;; non-nil for an OClosure as well.
51 #'cl--generic-oclosure-tag
- #'cl-generic--oclosure-specializers)
+ #'cl--generic-type-specializers)
(cl-defmethod cl-generic-generalizers :extra "oclosure-struct" (type)
"Support for dispatch on types defined by `oclosure-define'."
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index ed86daad828..1a6d61b454e 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3349,14 +3349,14 @@ Elements of FIELDS can be of the form (NAME PAT) in
which case the
contents of field NAME is matched against PAT, or they can be of
the form NAME which is a shorthand for (NAME NAME)."
(declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp])))
- `(and (pred (pcase--flip cl-typep ',type))
+ `(and (pred (cl-typep _ ',type))
,@(mapcar
(lambda (field)
(let* ((name (if (consp field) (car field) field))
(pat (if (consp field) (cadr field) field)))
`(app ,(if (eq (cl-struct-sequence-type type) 'list)
`(nth ,(cl-struct-slot-offset type name))
- `(pcase--flip aref ,(cl-struct-slot-offset type name)))
+ `(aref _ ,(cl-struct-slot-offset type name)))
,pat)))
fields)))
@@ -3373,13 +3373,13 @@ the form NAME which is a shorthand for (NAME NAME)."
"Extra special cases for `cl-typep' predicates."
(let* ((x1 pred1) (x2 pred2)
(t1
- (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1))
- (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1))
+ (and (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1))
+ (eq '_ (car-safe x1)) (setq x1 (cdr x1))
(null (cdr-safe x1)) (setq x1 (car x1))
(eq 'quote (car-safe x1)) (cadr x1)))
(t2
- (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2))
- (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2))
+ (and (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2))
+ (eq '_ (car-safe x2)) (setq x2 (cdr x2))
(null (cdr-safe x2)) (setq x2 (car x2))
(eq 'quote (car-safe x2)) (cadr x2))))
(or
@@ -3465,6 +3465,7 @@ Of course, we really can't know that for sure, so it's
just a heuristic."
(or (cdr (assq sym byte-compile-function-environment))
(cdr (assq sym macroexpand-all-environment))))))
+;; Please keep it in sync with `comp-known-predicates'.
(pcase-dolist (`(,type . ,pred)
;; Mostly kept in alphabetical order.
'((array . arrayp)
@@ -3492,6 +3493,7 @@ Of course, we really can't know that for sure, so it's
just a heuristic."
(natnum . natnump)
(number . numberp)
(null . null)
+ (obarray . obarrayp)
(overlay . overlayp)
(process . processp)
(real . numberp)
@@ -3499,6 +3501,7 @@ Of course, we really can't know that for sure, so it's
just a heuristic."
(subr . subrp)
(string . stringp)
(symbol . symbolp)
+ (symbol-with-pos . symbol-with-pos-p)
(vector . vectorp)
(window . windowp)
;; FIXME: Do we really want to consider these types?
@@ -3824,7 +3827,8 @@ STRUCT-TYPE and SLOT-NAME are symbols. INST is a
structure instance."
(pcase-defmacro cl-type (type)
"Pcase pattern that matches objects of TYPE.
TYPE is a type descriptor as accepted by `cl-typep', which see."
- `(pred (pcase--flip cl-typep ',type)))
+ `(pred (cl-typep _ ',type)))
+
;; Local variables:
;; generated-autoload-file: "cl-loaddefs.el"
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 20e68555578..5743684fa89 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -50,51 +50,16 @@
(apply #'error string (append sargs args))
(signal 'cl-assertion-failed `(,form ,@sargs)))))
-(defconst cl--typeof-types
- ;; Hand made from the source code of `type-of'.
- '((integer number integer-or-marker number-or-marker atom)
- (symbol-with-pos symbol atom) (symbol atom) (string array sequence atom)
- (cons list sequence)
- ;; Markers aren't `numberp', yet they are accepted wherever integers are
- ;; accepted, pretty much.
- (marker integer-or-marker number-or-marker atom)
- (overlay atom) (float number number-or-marker atom)
- (window-configuration atom) (process atom) (window atom)
- ;; FIXME: We'd want to put `function' here, but that's only true
- ;; for those `subr's which aren't special forms!
- (subr atom)
- ;; FIXME: We should probably reverse the order between
- ;; `compiled-function' and `byte-code-function' since arguably
- ;; `subr' is also "compiled functions" but not "byte code functions",
- ;; but it would require changing the value returned by `type-of' for
- ;; byte code objects, which risks breaking existing code, which doesn't
- ;; seem worth the trouble.
- (compiled-function byte-code-function function atom)
- (module-function function atom)
- (buffer atom) (char-table array sequence atom)
- (bool-vector array sequence atom)
- (frame atom) (hash-table atom) (terminal atom)
- (thread atom) (mutex atom) (condvar atom)
- (font-spec atom) (font-entity atom) (font-object atom)
- (vector array sequence atom)
- (user-ptr atom)
- (tree-sitter-parser atom)
- (tree-sitter-node atom)
- (tree-sitter-compiled-query atom)
- ;; Plus, really hand made:
- (null symbol list sequence atom))
- "Alist of supertypes.
-Each element has the form (TYPE . SUPERTYPES) where TYPE is one of
-the symbols returned by `type-of', and SUPERTYPES is the list of its
-supertypes from the most specific to least specific.")
-
-(defconst cl--all-builtin-types
- (delete-dups (copy-sequence (apply #'append cl--typeof-types))))
+(defun cl--builtin-type-p (name)
+ (if (not (fboundp 'built-in-class-p)) ;; Early bootstrap
+ nil
+ (let ((class (and (symbolp name) (get name 'cl--class))))
+ (and class (built-in-class-p class)))))
(defun cl--struct-name-p (name)
"Return t if NAME is a valid structure name for `cl-defstruct'."
(and name (symbolp name) (not (keywordp name))
- (not (memq name cl--all-builtin-types))))
+ (not (cl--builtin-type-p name))))
;; When we load this (compiled) file during pre-loading, the cl--struct-class
;; code below will need to access the `cl-struct' info, since it's considered
@@ -147,7 +112,7 @@ supertypes from the most specific to least specific.")
(defun cl--struct-register-child (parent tag)
;; Can't use (cl-typep parent 'cl-structure-class) at this stage
;; because `cl-structure-class' is defined later.
- (while (recordp parent)
+ (while (cl--struct-class-p parent)
(add-to-list (cl--struct-class-children-sym parent) tag)
;; Only register ourselves as a child of the leftmost parent since structs
;; can only have one parent.
@@ -162,9 +127,14 @@ supertypes from the most specific to least specific.")
(with-suppressed-warnings ((obsolete cl-old-struct-compat-mode))
(message "cl-old-struct-compat-mode is obsolete!")
(cl-old-struct-compat-mode 1)))
- (if (eq type 'record)
- ;; Defstruct using record objects.
- (setq type nil))
+ (when (eq type 'record)
+ ;; Defstruct using record objects.
+ (setq type nil)
+ ;; `cl-structure-class' and `cl-structure-object' are allowed to be
+ ;; defined without specifying the parent, because their parent
+ ;; doesn't exist yet when they're defined.
+ (cl-assert (or parent (memq name '(cl-structure-class
+ cl-structure-object)))))
(cl-assert (or type (not named)))
(if (boundp children-sym)
(add-to-list children-sym tag)
@@ -172,7 +142,9 @@ supertypes from the most specific to least specific.")
(and (null type) (eq (caar slots) 'cl-tag-slot)
;; Hide the tag slot from "standard" (i.e. non-`type'd) structs.
(setq slots (cdr slots)))
- (let* ((parent-class (when parent (cl--struct-get-class parent)))
+ (let* ((parent-class (if parent (cl--struct-get-class parent)
+ (cl--find-class (if (eq type 'list) 'cons
+ (or type 'record)))))
(n (length slots))
(index-table (make-hash-table :test 'eq :size n))
(vslots (let ((v (make-vector n nil))
@@ -195,7 +167,9 @@ supertypes from the most specific to least specific.")
name docstring
(unless (symbolp parent-class) (list parent-class))
type named vslots index-table children-sym tag print)))
- (unless (symbolp parent-class)
+ (cl-assert (or (not (symbolp parent-class))
+ (memq name '(cl-structure-class cl-structure-object))))
+ (when (cl--struct-class-p parent-class)
(let ((pslots (cl--struct-class-slots parent-class)))
(or (>= n (length pslots))
(let ((ok t))
@@ -327,8 +301,137 @@ supertypes from the most specific to least specific.")
(merge-ordered-lists (mapcar #'cl--class-allparents
(cl--class-parents class)))))
-(eval-and-compile
- (cl-assert (null (cl--class-parents (cl--find-class 'cl-structure-object)))))
+(cl-defstruct (built-in-class
+ (:include cl--class)
+ (:constructor nil)
+ (:constructor built-in-class--make (name docstring parents))
+ (:copier nil))
+ )
+
+(defmacro cl--define-built-in-type (name parents &optional docstring &rest
_slots)
+ ;; `slots' is currently unused, but we could make it take
+ ;; a list of "slot like properties" together with the corresponding
+ ;; accessor, and then we could maybe even make `slot-value' work
+ ;; on some built-in types :-)
+ (declare (indent 2) (doc-string 3))
+ (unless (listp parents) (setq parents (list parents)))
+ (unless (or parents (eq name t))
+ (error "Missing parents for %S: %S" name parents))
+ `(progn
+ (put ',name 'cl--class
+ (built-in-class--make ',name ,docstring
+ (mapcar (lambda (type)
+ (let ((class (get type 'cl--class)))
+ (unless class
+ (error "Unknown type: %S" type))
+ class))
+ ',parents)))))
+
+;; FIXME: Our type DAG has various quirks:
+;; - `subr' says it's a `compiled-function' but that's not true
+;; for those subrs that are special forms!
+;; - Some `keyword's are also `symbol-with-pos' but that's not reflected
+;; in the DAG.
+;; - An OClosure can be an interpreted function or a `byte-code-function',
+;; so the DAG of OClosure types is "orthogonal" to the distinction
+;; between interpreted and compiled functions.
+
+(cl--define-built-in-type t nil "The type of everything.")
+(cl--define-built-in-type atom t "The type of anything but cons cells.")
+
+(cl--define-built-in-type tree-sitter-compiled-query atom)
+(cl--define-built-in-type tree-sitter-node atom)
+(cl--define-built-in-type tree-sitter-parser atom)
+(cl--define-built-in-type user-ptr atom)
+(cl--define-built-in-type font-object atom)
+(cl--define-built-in-type font-entity atom)
+(cl--define-built-in-type font-spec atom)
+(cl--define-built-in-type condvar atom)
+(cl--define-built-in-type mutex atom)
+(cl--define-built-in-type thread atom)
+(cl--define-built-in-type terminal atom)
+(cl--define-built-in-type hash-table atom)
+(cl--define-built-in-type frame atom)
+(cl--define-built-in-type buffer atom)
+(cl--define-built-in-type window atom)
+(cl--define-built-in-type process atom)
+(cl--define-built-in-type window-configuration atom)
+(cl--define-built-in-type overlay atom)
+(cl--define-built-in-type number-or-marker atom
+ "Abstract super type of both `number's and `marker's.")
+(cl--define-built-in-type symbol atom
+ "Type of symbols."
+ ;; Example of slots we could document. It would be desirable to
+ ;; have some way to extract this from the C code, or somehow keep it
+ ;; in sync (probably not for `cons' and `symbol' but for things like
+ ;; `font-entity').
+ (name symbol-name)
+ (value symbol-value)
+ (function symbol-function)
+ (plist symbol-plist))
+
+(cl--define-built-in-type obarray atom)
+(cl--define-built-in-type native-comp-unit atom)
+
+(cl--define-built-in-type sequence t "Abstract super type of sequences.")
+(cl--define-built-in-type list sequence)
+(cl--define-built-in-type array (sequence atom) "Abstract super type of
arrays.")
+(cl--define-built-in-type number (number-or-marker)
+ "Abstract super type of numbers.")
+(cl--define-built-in-type float (number))
+(cl--define-built-in-type integer-or-marker (number-or-marker)
+ "Abstract super type of both `integer's and `marker's.")
+(cl--define-built-in-type integer (number integer-or-marker))
+(cl--define-built-in-type marker (integer-or-marker))
+(cl--define-built-in-type bignum (integer)
+ "Type of those integers too large to fit in a `fixnum'.")
+(cl--define-built-in-type fixnum (integer)
+ (format "Type of small (fixed-size) integers.
+The size depends on the Emacs version and compilation options.
+For this build of Emacs it's %dbit."
+ (1+ (logb (1+ most-positive-fixnum)))))
+(cl--define-built-in-type keyword (symbol)
+ "Type of those symbols whose first char is `:'.")
+(cl--define-built-in-type boolean (symbol)
+ "Type of the canonical boolean values, i.e. either nil or t.")
+(cl--define-built-in-type symbol-with-pos (symbol)
+ "Type of symbols augmented with source-position information.")
+(cl--define-built-in-type vector (array))
+(cl--define-built-in-type record (atom)
+ "Abstract type of objects with slots.")
+(cl--define-built-in-type bool-vector (array) "Type of bitvectors.")
+(cl--define-built-in-type char-table (array)
+ "Type of special arrays that are indexed by characters.")
+(cl--define-built-in-type string (array))
+(cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before
`list'?
+ "Type of the nil value.")
+(cl--define-built-in-type cons (list)
+ "Type of cons cells."
+ ;; Example of slots we could document.
+ (car car) (cdr cdr))
+(cl--define-built-in-type function (atom)
+ "Abstract super type of function values.")
+(cl--define-built-in-type compiled-function (function)
+ "Abstract type of functions that have been compiled.")
+(cl--define-built-in-type byte-code-function (compiled-function)
+ "Type of functions that have been byte-compiled.")
+(cl--define-built-in-type subr (compiled-function)
+ "Abstract type of functions compiled to machine code.")
+(cl--define-built-in-type module-function (function)
+ "Type of functions provided via the module API.")
+(cl--define-built-in-type interpreted-function (function)
+ "Type of functions that have not been compiled.")
+(cl--define-built-in-type subr-native-elisp (subr)
+ "Type of function that have been compiled by the native compiler.")
+(cl--define-built-in-type subr-primitive (subr)
+ "Type of functions hand written in C.")
+
+(unless (cl--class-parents (cl--find-class 'cl-structure-object))
+ ;; When `cl-structure-object' is created, built-in classes didn't exist
+ ;; yet, so we couldn't put `record' as the parent.
+ ;; Fix it now to close the recursion.
+ (setf (cl--class-parents (cl--find-class 'cl-structure-object))
+ (list (cl--find-class 'record))))
;; Make sure functions defined with cl-defsubst can be inlined even in
;; packages which do not require CL. We don't put an autoload cookie
diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el
index 6ba9664ea5c..4edfe811586 100644
--- a/lisp/emacs-lisp/comp-common.el
+++ b/lisp/emacs-lisp/comp-common.el
@@ -119,7 +119,7 @@ Used to modify the compiler environment."
(function ((or integer marker) (or integer marker)) string))
(bufferp (function (t) boolean))
(byte-code-function-p (function (t) boolean))
- (capitalize (function (or integer string) (or integer string)))
+ (capitalize (function ((or integer string)) (or integer string)))
(car (function (list) t))
(car-less-than-car (function (list list) boolean))
(car-safe (function (t) t))
@@ -240,7 +240,8 @@ Used to modify the compiler environment."
(integer-or-marker-p (function (t) boolean))
(integerp (function (t) boolean))
(interactive-p (function () boolean))
- (intern-soft (function ((or string symbol) &optional vector) symbol))
+ (intern-soft (function ((or string symbol) &optional (or obarray vector))
+ symbol))
(invocation-directory (function () string))
(invocation-name (function () string))
(isnan (function (float) boolean))
@@ -309,7 +310,7 @@ Used to modify the compiler environment."
(numberp (function (t) boolean))
(one-window-p (function (&optional t t) boolean))
(overlayp (function (t) boolean))
- (parse-colon-path (function (string) cons))
+ (parse-colon-path (function (string) list))
(plist-get (function (list t &optional t) t))
(plist-member (function (list t &optional t) list))
(point (function () integer))
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 2984bedb1dd..5922a8caf12 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -38,13 +38,7 @@
(require 'cl-lib)
(require 'cl-extra) ;HACK: For `cl-find-class' when `cl-loaddefs' is missing.
-(defconst comp--typeof-builtin-types (mapcar (lambda (x)
- (append x '(t)))
- cl--typeof-types)
- ;; TODO can we just add t in `cl--typeof-types'?
- "Like `cl--typeof-types' but with t as common supertype.")
-
-(cl-defstruct (comp-cstr (:constructor comp-type-to-cstr
+(cl-defstruct (comp-cstr (:constructor comp--type-to-cstr
(type &aux
(null (eq type 'null))
(integer (eq type 'integer))
@@ -55,7 +49,7 @@
'(nil)))
(range (when integer
'((- . +))))))
- (:constructor comp-value-to-cstr
+ (:constructor comp--value-to-cstr
(value &aux
(integer (integerp value))
(valset (unless integer
@@ -63,7 +57,7 @@
(range (when integer
`((,value . ,value))))
(typeset ())))
- (:constructor comp-irange-to-cstr
+ (:constructor comp--irange-to-cstr
(irange &aux
(range (list irange))
(typeset ())))
@@ -89,12 +83,7 @@ Integer values are handled in the `range' slot.")
(defun comp--cl-class-hierarchy (x)
"Given a class name `x' return its hierarchy."
- `(,@(cl--class-allparents (cl--struct-get-class x))
- ;; FIXME: AFAICT, `comp--all-classes' will also find those struct types
- ;; which use :type and can thus be either `vector' or `cons' (the latter
- ;; isn't `atom').
- atom
- t))
+ (cl--class-allparents (cl--find-class x)))
(defun comp--all-classes ()
"Return all non built-in type names currently defined."
@@ -106,15 +95,14 @@ Integer values are handled in the `range' slot.")
res))
(defun comp--compute-typeof-types ()
- (append comp--typeof-builtin-types
- (mapcar #'comp--cl-class-hierarchy (comp--all-classes))))
+ (mapcar #'comp--cl-class-hierarchy (comp--all-classes)))
(defun comp--compute--pred-type-h ()
(cl-loop with h = (make-hash-table :test #'eq)
for class-name in (comp--all-classes)
for pred = (get class-name 'cl-deftype-satisfies)
when pred
- do (puthash pred class-name h)
+ do (puthash pred (comp--type-to-cstr class-name) h)
finally return h))
(cl-defstruct comp-cstr-ctxt
@@ -229,10 +217,10 @@ Return them as multiple value."
;; builds.
(defvar comp-ctxt nil)
-(defvar comp-cstr-one (comp-value-to-cstr 1)
+(defvar comp-cstr-one (comp--value-to-cstr 1)
"Represent the integer immediate one.")
-(defvar comp-cstr-t (comp-type-to-cstr t)
+(defvar comp-cstr-t (comp--type-to-cstr t)
"Represent the superclass t.")
@@ -249,6 +237,8 @@ Return them as multiple value."
t)
((and (not (symbolp x)) (symbolp y))
nil)
+ ((or (consp x) (consp y)
+ nil))
(t
(< (sxhash-equal x)
(sxhash-equal y)))))))
@@ -270,18 +260,10 @@ Return them as multiple value."
(symbol-name y)))
(defun comp--direct-supertypes (type)
- "Return the direct supertypes of TYPE."
- (let ((supers (comp-supertypes type)))
- (cl-assert (eq type (car supers)))
- (cl-loop
- with notdirect = nil
- with direct = nil
- for parent in (cdr supers)
- unless (memq parent notdirect)
- do (progn
- (push parent direct)
- (setq notdirect (append notdirect (comp-supertypes parent))))
- finally return direct)))
+ (when (symbolp type) ;; FIXME: Can this test ever fail?
+ (let* ((class (cl--find-class type))
+ (parents (if class (cl--class-parents class))))
+ (mapcar #'cl--class-name parents))))
(defsubst comp-subtype-p (type1 type2)
"Return t if TYPE1 is a subtype of TYPE2 or nil otherwise."
@@ -353,23 +335,8 @@ Return them as multiple value."
(defun comp-supertypes (type)
"Return the ordered list of supertypes of TYPE."
- ;; FIXME: We should probably keep the results in
- ;; `comp-cstr-ctxt-typeof-types' (or maybe even precompute them
- ;; and maybe turn `comp-cstr-ctxt-typeof-types' into a hash-table).
- ;; Or maybe we shouldn't keep structs and defclasses in it,
- ;; and just use `cl--class-allparents' when needed (and refuse to
- ;; compute their direct subtypes since we can't know them).
- (cl-loop
- named loop
- with above
- for lane in (comp-cstr-ctxt-typeof-types comp-ctxt)
- do (let ((x (memq type lane)))
- (cond
- ((null x) nil)
- ((eq x lane) (cl-return-from loop x)) ;A base type: easy case.
- (t (setq above
- (if above (comp--intersection x above) x)))))
- finally return above))
+ (or (assq type (comp-cstr-ctxt-typeof-types comp-ctxt))
+ (error "Type %S missing from typeof-types!" type)))
(defun comp-union-typesets (&rest typesets)
"Union types present into TYPESETS."
@@ -1210,14 +1177,14 @@ FN non-nil indicates we are parsing a function lambda
list."
('nil
(make-comp-cstr :typeset ()))
('fixnum
- (comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum)))
+ (comp--irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum)))
('boolean
(comp-type-spec-to-cstr '(member t nil)))
('integer
- (comp-irange-to-cstr '(- . +)))
- ('null (comp-value-to-cstr nil))
+ (comp--irange-to-cstr '(- . +)))
+ ('null (comp--value-to-cstr nil))
((pred atom)
- (comp-type-to-cstr type-spec))
+ (comp--type-to-cstr type-spec))
(`(or . ,rest)
(apply #'comp-cstr-union-make
(mapcar #'comp-type-spec-to-cstr rest)))
@@ -1227,16 +1194,16 @@ FN non-nil indicates we are parsing a function lambda
list."
(`(not ,cstr)
(comp-cstr-negation-make (comp-type-spec-to-cstr cstr)))
(`(integer ,(and (pred integerp) l) ,(and (pred integerp) h))
- (comp-irange-to-cstr `(,l . ,h)))
+ (comp--irange-to-cstr `(,l . ,h)))
(`(integer * ,(and (pred integerp) h))
- (comp-irange-to-cstr `(- . ,h)))
+ (comp--irange-to-cstr `(- . ,h)))
(`(integer ,(and (pred integerp) l) *)
- (comp-irange-to-cstr `(,l . +)))
+ (comp--irange-to-cstr `(,l . +)))
(`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p))
;; No float range support :/
- (comp-type-to-cstr 'float))
+ (comp--type-to-cstr 'float))
(`(member . ,rest)
- (apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest)))
+ (apply #'comp-cstr-union-make (mapcar #'comp--value-to-cstr rest)))
(`(function ,args ,ret)
(make-comp-cstr-f
:args (mapcar (lambda (x)
diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el
index 5d1a193269d..057760322ab 100644
--- a/lisp/emacs-lisp/comp-run.el
+++ b/lisp/emacs-lisp/comp-run.el
@@ -25,7 +25,7 @@
;; While the main native compiler is implemented in comp.el, when
;; commonly used as a jit compiler it is only loaded by Emacs sub
-;; processes performing async compilation. This files contains all
+;; processes performing async compilation. This file contains all
;; the code needed to drive async compilations and any Lisp code
;; needed at runtime to run native code.
@@ -72,11 +72,23 @@ Set this variable to nil to suppress warnings altogether,
or to
the symbol `silent' to log warnings but not pop up the *Warnings*
buffer."
:type '(choice
- (const :tag "Do not report warnings" nil)
- (const :tag "Report and display warnings" t)
- (const :tag "Report but do not display warnings" silent))
+ (const :tag "Do not report warnings/errors" nil)
+ (const :tag "Report and display warnings/errors" t)
+ (const :tag "Report but do not display warnings/errors" silent))
:version "28.1")
+(defcustom native-comp-async-warnings-errors-kind 'important
+ "Which kind of warnings and errors to report from async native compilation.
+
+Setting this variable to `important' (the default) will report
+only important warnings and all errors.
+Setting this variable to `all' will report all warnings and
+errors."
+ :type '(choice
+ (const :tag "Report all warnings/errors" all)
+ (const :tag "Report important warnings and all errors" important))
+ :version "30.1")
+
(defcustom native-comp-always-compile nil
"Non-nil means unconditionally (re-)compile all files."
:type 'boolean
@@ -184,13 +196,21 @@ processes from `comp-async-compilations'"
(let ((warning-suppress-types
(if (eq native-comp-async-report-warnings-errors 'silent)
(cons '(comp) warning-suppress-types)
- warning-suppress-types)))
+ warning-suppress-types))
+ (regexp (if (eq native-comp-async-warnings-errors-kind 'all)
+ "^.*?\\(?:Error\\|Warning\\): .*$"
+ (rx bol
+ (*? nonl)
+ (or
+ (seq "Error: " (*? nonl))
+ (seq "Warning: the function ‘" (1+ (not "’"))
+ "’ is not known to be defined."))
+ eol))))
(with-current-buffer (process-buffer process)
(save-excursion
(accept-process-output process)
(goto-char (or comp-last-scanned-async-output (point-min)))
- (while (re-search-forward "^.*?\\(?:Error\\|Warning\\): .*$"
- nil t)
+ (while (re-search-forward regexp nil t)
(display-warning 'comp (match-string 0)))
(setq comp-last-scanned-async-output (point-max)))))
(accept-process-output process)))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 1203d72e41c..7f31c739ee9 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -43,7 +43,7 @@
(defvar native-comp-eln-load-path)
(defvar native-comp-enable-subr-trampolines)
-(declare-function comp--compile-ctxt-to-file "comp.c")
+(declare-function comp--compile-ctxt-to-file0 "comp.c")
(declare-function comp--init-ctxt "comp.c")
(declare-function comp--release-ctxt "comp.c")
(declare-function comp-el-to-eln-filename "comp.c")
@@ -68,7 +68,7 @@
:safe #'integerp
:version "28.1")
-(defcustom native-comp-debug 0
+(defcustom native-comp-debug 0
"Debug level for native compilation, a number between 0 and 3.
This is intended for debugging the compiler itself.
0 no debug output.
@@ -155,17 +155,18 @@ native compilation runs.")
"Current allocation class.
Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.")
-(defconst comp-passes '(comp-spill-lap
- comp-limplify
- comp-fwprop
- comp-call-optim
- comp-ipa-pure
- comp-add-cstrs
- comp-fwprop
- comp-tco
- comp-fwprop
- comp-remove-type-hints
- comp-final)
+(defconst comp-passes '(comp--spill-lap
+ comp--limplify
+ comp--fwprop
+ comp--call-optim
+ comp--ipa-pure
+ comp--add-cstrs
+ comp--fwprop
+ comp--tco
+ comp--fwprop
+ comp--remove-type-hints
+ comp--compute-function-types
+ comp--final)
"Passes to be executed in order.")
(defvar comp-disabled-passes '()
@@ -187,31 +188,42 @@ Useful to hook into pass checkers.")
finally return h)
"Hash table function -> `comp-constraint'.")
+;; Keep it in sync with the `cl-deftype-satisfies' property set in
+;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the
+;; relation type <-> predicate is not bijective (bug#45576).
(defconst comp-known-predicates
'((arrayp . array)
(atom . atom)
- (characterp . fixnum)
- (booleanp . boolean)
(bool-vector-p . bool-vector)
+ (booleanp . boolean)
(bufferp . buffer)
- (natnump . (integer 0 *))
(char-table-p . char-table)
- (hash-table-p . hash-table)
+ (characterp . fixnum)
(consp . cons)
- (integerp . integer)
(floatp . float)
+ (framep . frame)
(functionp . (or function symbol))
+ (hash-table-p . hash-table)
+ (integer-or-marker-p . integer-or-marker)
(integerp . integer)
(keywordp . keyword)
(listp . list)
- (numberp . number)
+ (markerp . marker)
+ (natnump . (integer 0 *))
(null . null)
+ (number-or-marker-p . number-or-marker)
(numberp . number)
+ (numberp . number)
+ (obarrayp . obarray)
+ (overlayp . overlay)
+ (processp . process)
(sequencep . sequence)
(stringp . string)
+ (subrp . subr)
+ (symbol-with-pos-p . symbol-with-pos)
(symbolp . symbol)
(vectorp . vector)
- (integer-or-marker-p . integer-or-marker))
+ (windowp . window))
"Alist predicate -> matched type specifier.")
(defconst comp-known-predicates-h
@@ -388,7 +400,7 @@ This is typically for top-level forms other than defun.")
(closed nil :type boolean
:documentation "t if closed.")
;; All the following are for SSA and CGF analysis.
- ;; Keep in sync with `comp-clean-ssa'!!
+ ;; Keep in sync with `comp--clean-ssa'!!
(in-edges () :type list
:documentation "List of incoming edges.")
(out-edges () :type list
@@ -416,7 +428,7 @@ into it.")
:documentation "Start block LAP address.")
(non-ret-insn nil :type list
:documentation "Insn known to perform a non local exit.
-`comp-fwprop' may identify and store here basic blocks performing
+`comp--fwprop' may identify and store here basic blocks performing
non local exits and mark it rewrite it later.")
(no-ret nil :type boolean
:documentation "t when the block is known to perform a
@@ -507,7 +519,7 @@ CFG is mutated by a pass.")
(lambda-list nil :type list
:documentation "Original lambda-list."))
-(cl-defstruct (comp-mvar (:constructor make--comp-mvar)
+(cl-defstruct (comp-mvar (:constructor make--comp-mvar0)
(:include comp-cstr))
"A meta-variable being a slot in the meta-stack."
(id nil :type (or null number)
@@ -516,6 +528,7 @@ CFG is mutated by a pass.")
:documentation "Slot number in the array if a number or
`scratch' for scratch slot."))
+;; In use by comp.c.
(defun comp-mvar-type-hint-match-p (mvar type-hint)
"Match MVAR against TYPE-HINT.
In use by the back-end."
@@ -636,7 +649,7 @@ VERBOSITY is a number between 0 and 3."
-(defmacro comp-loop-insn-in-block (basic-block &rest body)
+(defmacro comp--loop-insn-in-block (basic-block &rest body)
"Loop over all insns in BASIC-BLOCK executing BODY.
Inside BODY, `insn' and `insn-cell'can be used to read or set the
current instruction or its cell."
@@ -650,19 +663,19 @@ current instruction or its cell."
;;; spill-lap pass specific code.
-(defun comp-lex-byte-func-p (f)
+(defun comp--lex-byte-func-p (f)
"Return t if F is a lexically-scoped byte compiled function."
(and (byte-code-function-p f)
(fixnump (aref f 0))))
-(defun comp-spill-decl-spec (function-name spec)
+(defun comp--spill-decl-spec (function-name spec)
"Return the declared specifier SPEC for FUNCTION-NAME."
(plist-get (cdr (assq function-name byte-to-native-plist-environment))
spec))
-(defun comp-spill-speed (function-name)
+(defun comp--spill-speed (function-name)
"Return the speed for FUNCTION-NAME."
- (or (comp-spill-decl-spec function-name 'speed)
+ (or (comp--spill-decl-spec function-name 'speed)
(comp-ctxt-speed comp-ctxt)))
;; Autoloaded as might be used by `disassemble-internal'.
@@ -701,7 +714,7 @@ clashes."
;; pick the first one.
(concat prefix crypted "_" human-readable "_0"))))
-(defun comp-decrypt-arg-list (x function-name)
+(defun comp--decrypt-arg-list (x function-name)
"Decrypt argument list X for FUNCTION-NAME."
(unless (fixnump x)
(signal 'native-compiler-error-dyn-func (list function-name)))
@@ -716,21 +729,21 @@ clashes."
:nonrest nonrest
:rest rest))))
-(defsubst comp-byte-frame-size (byte-compiled-func)
+(defsubst comp--byte-frame-size (byte-compiled-func)
"Return the frame size to be allocated for BYTE-COMPILED-FUNC."
(aref byte-compiled-func 3))
-(defun comp-add-func-to-ctxt (func)
+(defun comp--add-func-to-ctxt (func)
"Add FUNC to the current compiler context."
(let ((name (comp-func-name func))
(c-name (comp-func-c-name func)))
(puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt))
(puthash c-name func (comp-ctxt-funcs-h comp-ctxt))))
-(cl-defgeneric comp-spill-lap-function (input)
+(cl-defgeneric comp--spill-lap-function (input)
"Byte-compile INPUT and spill lap for further stages.")
-(cl-defmethod comp-spill-lap-function ((function-name symbol))
+(cl-defmethod comp--spill-lap-function ((function-name symbol))
"Byte-compile FUNCTION-NAME, spilling data from the byte compiler."
(unless (comp-ctxt-output comp-ctxt)
(setf (comp-ctxt-output comp-ctxt)
@@ -746,9 +759,9 @@ clashes."
(list (make-byte-to-native-func-def :name function-name
:c-name c-name
:byte-func byte-code)))
- (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)))
+ (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)))
-(cl-defmethod comp-spill-lap-function ((form list))
+(cl-defmethod comp--spill-lap-function ((form list))
"Byte-compile FORM, spilling data from the byte compiler."
(unless (memq (car-safe form) '(lambda closure))
(signal 'native-compiler-error
@@ -762,9 +775,9 @@ clashes."
(list (make-byte-to-native-func-def :name '--anonymous-lambda
:c-name c-name
:byte-func byte-code)))
- (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)))
+ (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)))
-(defun comp-intern-func-in-ctxt (_ obj)
+(defun comp--intern-func-in-ctxt (_ obj)
"Given OBJ of type `byte-to-native-lambda', create a function in
`comp-ctxt'."
(when-let ((byte-func (byte-to-native-lambda-byte-func obj)))
(let* ((lap (byte-to-native-lambda-lap obj))
@@ -777,9 +790,9 @@ clashes."
(name (when top-l-form
(byte-to-native-func-def-name top-l-form)))
(c-name (comp-c-func-name (or name "anonymous-lambda") "F"))
- (func (if (comp-lex-byte-func-p byte-func)
+ (func (if (comp--lex-byte-func-p byte-func)
(make-comp-func-l
- :args (comp-decrypt-arg-list (aref byte-func 0)
+ :args (comp--decrypt-arg-list (aref byte-func 0)
name))
(make-comp-func-d :lambda-list (aref byte-func 0)))))
(setf (comp-func-name func) name
@@ -789,9 +802,9 @@ clashes."
(comp-func-command-modes func) (command-modes byte-func)
(comp-func-c-name func) c-name
(comp-func-lap func) lap
- (comp-func-frame-size func) (comp-byte-frame-size byte-func)
- (comp-func-speed func) (comp-spill-speed name)
- (comp-func-pure func) (comp-spill-decl-spec name 'pure))
+ (comp-func-frame-size func) (comp--byte-frame-size byte-func)
+ (comp-func-speed func) (comp--spill-speed name)
+ (comp-func-pure func) (comp--spill-decl-spec name 'pure))
;; Store the c-name to have it retrievable from
;; `comp-ctxt-top-level-forms'.
@@ -799,11 +812,11 @@ clashes."
(setf (byte-to-native-func-def-c-name top-l-form) c-name))
(unless name
(puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt)))
- (comp-add-func-to-ctxt func)
+ (comp--add-func-to-ctxt func)
(comp-log (format "Function %s:\n" name) 1)
(comp-log lap 1 t))))
-(cl-defmethod comp-spill-lap-function ((filename string))
+(cl-defmethod comp--spill-lap-function ((filename string))
"Byte-compile FILENAME, spilling data from the byte compiler."
(byte-compile-file filename)
(when (or (null byte-native-qualities)
@@ -828,7 +841,7 @@ clashes."
collect
(if (and (byte-to-native-func-def-p form)
(eq -1
- (comp-spill-speed (byte-to-native-func-def-name form))))
+ (comp--spill-speed (byte-to-native-func-def-name form))))
(let ((byte-code (byte-to-native-func-def-byte-func form)))
(remhash byte-code byte-to-native-lambdas-h)
(make-byte-to-native-top-level
@@ -836,11 +849,11 @@ clashes."
',(byte-to-native-func-def-name form)
,byte-code
nil)
- :lexical (comp-lex-byte-func-p byte-code)))
+ :lexical (comp--lex-byte-func-p byte-code)))
form)))
- (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))
+ (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))
-(defun comp-spill-lap (input)
+(defun comp--spill-lap (input)
"Byte-compile and spill the LAP representation for INPUT.
If INPUT is a symbol, it is the function-name to be compiled.
If INPUT is a string, it is the filename to be compiled."
@@ -848,7 +861,7 @@ If INPUT is a string, it is the filename to be compiled."
(byte-to-native-lambdas-h (make-hash-table :test #'eq))
(byte-to-native-top-level-forms ())
(byte-to-native-plist-environment ())
- (res (comp-spill-lap-function input)))
+ (res (comp--spill-lap-function input)))
(comp-cstr-ctxt-update-type-slots comp-ctxt)
res))
@@ -877,55 +890,55 @@ Points to the next slot to be filled.")
byte-switch byte-pushconditioncase)
"LAP end of basic blocks op codes.")
-(defun comp-lap-eob-p (inst)
+(defun comp--lap-eob-p (inst)
"Return t if INST closes the current basic blocks, nil otherwise."
(when (memq (car inst) comp-lap-eob-ops)
t))
-(defun comp-lap-fall-through-p (inst)
+(defun comp--lap-fall-through-p (inst)
"Return t if INST falls through, nil otherwise."
(when (not (memq (car inst) '(byte-goto byte-return)))
t))
-(defsubst comp-sp ()
+(defsubst comp--sp ()
"Current stack pointer."
(declare (gv-setter (lambda (val)
`(setf (comp-limplify-sp comp-pass) ,val))))
(comp-limplify-sp comp-pass))
-(defmacro comp-with-sp (sp &rest body)
+(defmacro comp--with-sp (sp &rest body)
"Execute BODY setting the stack pointer to SP.
Restore the original value afterwards."
(declare (debug (form body))
(indent defun))
(let ((sym (gensym)))
- `(let ((,sym (comp-sp)))
- (setf (comp-sp) ,sp)
+ `(let ((,sym (comp--sp)))
+ (setf (comp--sp) ,sp)
(progn ,@body)
- (setf (comp-sp) ,sym))))
+ (setf (comp--sp) ,sym))))
-(defsubst comp-slot-n (n)
+(defsubst comp--slot-n (n)
"Slot N into the meta-stack."
(comp-vec-aref (comp-limplify-frame comp-pass) n))
-(defsubst comp-slot ()
+(defsubst comp--slot ()
"Current slot into the meta-stack pointed by sp."
- (comp-slot-n (comp-sp)))
+ (comp--slot-n (comp--sp)))
-(defsubst comp-slot+1 ()
+(defsubst comp--slot+1 ()
"Slot into the meta-stack pointed by sp + 1."
- (comp-slot-n (1+ (comp-sp))))
+ (comp--slot-n (1+ (comp--sp))))
-(defsubst comp-label-to-addr (label)
+(defsubst comp--label-to-addr (label)
"Find the address of LABEL."
(or (gethash label (comp-limplify-label-to-addr comp-pass))
(signal 'native-ice (list "label not found" label))))
-(defsubst comp-mark-curr-bb-closed ()
+(defsubst comp--mark-curr-bb-closed ()
"Mark the current basic block as closed."
(setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t))
-(defun comp-bb-maybe-add (lap-addr &optional sp)
+(defun comp--bb-maybe-add (lap-addr &optional sp)
"If necessary create a pending basic block for LAP-ADDR with stack depth SP.
The basic block is returned regardless it was already declared or not."
(let ((bb (or (cl-loop ; See if the block was already limplified.
@@ -943,24 +956,24 @@ The basic block is returned regardless it was already
declared or not."
(signal 'native-ice (list "incoherent stack pointers"
sp (comp-block-lap-sp bb))))
bb)
- (car (push (make--comp-block-lap lap-addr sp (comp-new-block-sym))
+ (car (push (make--comp-block-lap lap-addr sp (comp--new-block-sym))
(comp-limplify-pending-blocks comp-pass))))))
-(defsubst comp-call (func &rest args)
+(defsubst comp--call (func &rest args)
"Emit a call for function FUNC with ARGS."
`(call ,func ,@args))
-(defun comp-callref (func nargs stack-off)
+(defun comp--callref (func nargs stack-off)
"Emit a call using narg abi for FUNC.
NARGS is the number of arguments.
STACK-OFF is the index of the first slot frame involved."
`(callref ,func ,@(cl-loop repeat nargs
for sp from stack-off
- collect (comp-slot-n sp))))
+ collect (comp--slot-n sp))))
-(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type neg)
+(cl-defun make--comp-mvar (&key slot (constant nil const-vld) type neg)
"`comp-mvar' initializer."
- (let ((mvar (make--comp-mvar :slot slot)))
+ (let ((mvar (make--comp-mvar0 :slot slot)))
(when const-vld
(comp--add-const-to-relocs constant)
(setf (comp-cstr-imm mvar) constant))
@@ -970,49 +983,49 @@ STACK-OFF is the index of the first slot frame involved."
(setf (comp-mvar-neg mvar) t))
mvar))
-(defun comp-new-frame (size vsize &optional ssa)
+(defun comp--new-frame (size vsize &optional ssa)
"Return a clean frame of meta variables of size SIZE and VSIZE.
If SSA is non-nil, populate it with m-var in ssa form."
(cl-loop with v = (make-comp-vec :beg (- vsize) :end size)
for i from (- vsize) below size
for mvar = (if ssa
- (make-comp-ssa-mvar :slot i)
- (make-comp-mvar :slot i))
+ (make--comp--ssa-mvar :slot i)
+ (make--comp-mvar :slot i))
do (setf (comp-vec-aref v i) mvar)
finally return v))
-(defun comp-emit (insn)
+(defun comp--emit (insn)
"Emit INSN into basic block BB."
(let ((bb (comp-limplify-curr-block comp-pass)))
(cl-assert (not (comp-block-closed bb)))
(push insn (comp-block-insns bb))))
-(defun comp-emit-set-call (call)
+(defun comp--emit-set-call (call)
"Emit CALL assigning the result to the current slot frame.
If the callee function is known to have a return type, propagate it."
(cl-assert call)
- (comp-emit (list 'set (comp-slot) call)))
+ (comp--emit (list 'set (comp--slot) call)))
-(defun comp-copy-slot (src-n &optional dst-n)
+(defun comp--copy-slot (src-n &optional dst-n)
"Set slot number DST-N to slot number SRC-N as source.
If DST-N is specified, use it; otherwise assume it to be the current slot."
- (comp-with-sp (or dst-n (comp-sp))
- (let ((src-slot (comp-slot-n src-n)))
+ (comp--with-sp (or dst-n (comp--sp))
+ (let ((src-slot (comp--slot-n src-n)))
(cl-assert src-slot)
- (comp-emit `(set ,(comp-slot) ,src-slot)))))
+ (comp--emit `(set ,(comp--slot) ,src-slot)))))
-(defsubst comp-emit-annotation (str)
+(defsubst comp--emit-annotation (str)
"Emit annotation STR."
- (comp-emit `(comment ,str)))
+ (comp--emit `(comment ,str)))
-(defsubst comp-emit-setimm (val)
+(defsubst comp--emit-setimm (val)
"Set constant VAL to current slot."
(comp--add-const-to-relocs val)
;; Leave relocation index nil on purpose, will be fixed-up in final
;; by `comp-finalize-relocs'.
- (comp-emit `(setimm ,(comp-slot) ,val)))
+ (comp--emit `(setimm ,(comp--slot) ,val)))
-(defun comp-make-curr-block (block-name entry-sp &optional addr)
+(defun comp--make-curr-block (block-name entry-sp &optional addr)
"Create a basic block with BLOCK-NAME and set it as current block.
ENTRY-SP is the sp value when entering.
Add block to the current function and return it."
@@ -1024,104 +1037,104 @@ Add block to the current function and return it."
(puthash (comp-block-name bb) bb (comp-func-blocks comp-func))
bb))
-(defun comp-latch-make-fill (target)
+(defun comp--latch-make-fill (target)
"Create a latch pointing to TARGET and fill it.
Return the created latch."
- (let ((latch (make-comp-latch :name (comp-new-block-sym "latch")))
+ (let ((latch (make-comp-latch :name (comp--new-block-sym "latch")))
(curr-bb (comp-limplify-curr-block comp-pass)))
- ;; See `comp-make-curr-block'.
+ ;; See `comp--make-curr-block'.
(setf (comp-limplify-curr-block comp-pass) latch)
(when (< (comp-func-speed comp-func) 3)
;; At speed 3 the programmer is responsible to manually
;; place `comp-maybe-gc-or-quit'.
- (comp-emit '(call comp-maybe-gc-or-quit)))
- ;; See `comp-emit-uncond-jump'.
- (comp-emit `(jump ,(comp-block-name target)))
- (comp-mark-curr-bb-closed)
+ (comp--emit '(call comp-maybe-gc-or-quit)))
+ ;; See `comp--emit-uncond-jump'.
+ (comp--emit `(jump ,(comp-block-name target)))
+ (comp--mark-curr-bb-closed)
(puthash (comp-block-name latch) latch (comp-func-blocks comp-func))
(setf (comp-limplify-curr-block comp-pass) curr-bb)
latch))
-(defun comp-emit-uncond-jump (lap-label)
+(defun comp--emit-uncond-jump (lap-label)
"Emit an unconditional branch to LAP-LABEL."
(cl-destructuring-bind (label-num . stack-depth) lap-label
(when stack-depth
- (cl-assert (= (1- stack-depth) (comp-sp))))
- (let* ((target-addr (comp-label-to-addr label-num))
- (target (comp-bb-maybe-add target-addr
- (comp-sp)))
+ (cl-assert (= (1- stack-depth) (comp--sp))))
+ (let* ((target-addr (comp--label-to-addr label-num))
+ (target (comp--bb-maybe-add target-addr
+ (comp--sp)))
(latch (when (< target-addr (comp-limplify-pc comp-pass))
- (comp-latch-make-fill target)))
+ (comp--latch-make-fill target)))
(eff-target-name (comp-block-name (or latch target))))
- (comp-emit `(jump ,eff-target-name))
- (comp-mark-curr-bb-closed))))
+ (comp--emit `(jump ,eff-target-name))
+ (comp--mark-curr-bb-closed))))
-(defun comp-emit-cond-jump (a b target-offset lap-label negated)
+(defun comp--emit-cond-jump (a b target-offset lap-label negated)
"Emit a conditional jump to LAP-LABEL when A and B satisfy EQ.
TARGET-OFFSET is the positive offset on the SP when branching to the target
block.
If NEGATED is non null, negate the tested condition.
Return value is the fall-through block name."
(cl-destructuring-bind (label-num . label-sp) lap-label
- (let* ((bb (comp-block-name (comp-bb-maybe-add
+ (let* ((bb (comp-block-name (comp--bb-maybe-add
(1+ (comp-limplify-pc comp-pass))
- (comp-sp)))) ; Fall through block.
- (target-sp (+ target-offset (comp-sp)))
- (target-addr (comp-label-to-addr label-num))
- (target (comp-bb-maybe-add target-addr target-sp))
+ (comp--sp)))) ; Fall through block.
+ (target-sp (+ target-offset (comp--sp)))
+ (target-addr (comp--label-to-addr label-num))
+ (target (comp--bb-maybe-add target-addr target-sp))
(latch (when (< target-addr (comp-limplify-pc comp-pass))
- (comp-latch-make-fill target)))
+ (comp--latch-make-fill target)))
(eff-target-name (comp-block-name (or latch target))))
(when label-sp
- (cl-assert (= (1- label-sp) (+ target-offset (comp-sp)))))
- (comp-emit (if negated
+ (cl-assert (= (1- label-sp) (+ target-offset (comp--sp)))))
+ (comp--emit (if negated
(list 'cond-jump a b bb eff-target-name)
(list 'cond-jump a b eff-target-name bb)))
- (comp-mark-curr-bb-closed)
+ (comp--mark-curr-bb-closed)
bb)))
-(defun comp-emit-handler (lap-label handler-type)
+(defun comp--emit-handler (lap-label handler-type)
"Emit a nonlocal-exit handler to LAP-LABEL of type HANDLER-TYPE."
(cl-destructuring-bind (label-num . label-sp) lap-label
- (cl-assert (= (- label-sp 2) (comp-sp)))
+ (cl-assert (= (- label-sp 2) (comp--sp)))
(setf (comp-func-has-non-local comp-func) t)
- (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
- (comp-sp)))
- (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num)
- (1+ (comp-sp))))
- (pop-bb (make--comp-block-lap nil (comp-sp) (comp-new-block-sym))))
- (comp-emit (list 'push-handler
+ (let* ((guarded-bb (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass))
+ (comp--sp)))
+ (handler-bb (comp--bb-maybe-add (comp--label-to-addr label-num)
+ (1+ (comp--sp))))
+ (pop-bb (make--comp-block-lap nil (comp--sp)
(comp--new-block-sym))))
+ (comp--emit (list 'push-handler
handler-type
- (comp-slot+1)
+ (comp--slot+1)
(comp-block-name pop-bb)
(comp-block-name guarded-bb)))
- (comp-mark-curr-bb-closed)
+ (comp--mark-curr-bb-closed)
;; Emit the basic block to pop the handler if we got the non local.
(puthash (comp-block-name pop-bb) pop-bb (comp-func-blocks comp-func))
(setf (comp-limplify-curr-block comp-pass) pop-bb)
- (comp-emit `(fetch-handler ,(comp-slot+1)))
- (comp-emit `(jump ,(comp-block-name handler-bb)))
- (comp-mark-curr-bb-closed))))
+ (comp--emit `(fetch-handler ,(comp--slot+1)))
+ (comp--emit `(jump ,(comp-block-name handler-bb)))
+ (comp--mark-curr-bb-closed))))
-(defun comp-limplify-listn (n)
+(defun comp--limplify-listn (n)
"Limplify list N."
- (comp-with-sp (+ (comp-sp) n -1)
- (comp-emit-set-call (comp-call 'cons
- (comp-slot)
- (make-comp-mvar :constant nil))))
- (cl-loop for sp from (+ (comp-sp) n -2) downto (comp-sp)
- do (comp-with-sp sp
- (comp-emit-set-call (comp-call 'cons
- (comp-slot)
- (comp-slot+1))))))
-
-(defun comp-new-block-sym (&optional postfix)
+ (comp--with-sp (+ (comp--sp) n -1)
+ (comp--emit-set-call (comp--call 'cons
+ (comp--slot)
+ (make--comp-mvar :constant nil))))
+ (cl-loop for sp from (+ (comp--sp) n -2) downto (comp--sp)
+ do (comp--with-sp sp
+ (comp--emit-set-call (comp--call 'cons
+ (comp--slot)
+ (comp--slot+1))))))
+
+(defun comp--new-block-sym (&optional postfix)
"Return a unique symbol postfixing POSTFIX naming the next new basic block."
(intern (format (if postfix "bb_%s_%s" "bb_%s")
(funcall (comp-func-block-cnt-gen comp-func))
postfix)))
-(defun comp-fill-label-h ()
+(defun comp--fill-label-h ()
"Fill label-to-addr hash table for the current function."
(setf (comp-limplify-label-to-addr comp-pass) (make-hash-table :test 'eql))
(cl-loop for insn in (comp-func-lap comp-func)
@@ -1130,7 +1143,7 @@ Return value is the fall-through block name."
(`(TAG ,label . ,_)
(puthash label addr (comp-limplify-label-to-addr
comp-pass))))))
-(defun comp-jump-table-optimizable (jmp-table)
+(defun comp--jump-table-optimizable (jmp-table)
"Return t if JMP-TABLE can be optimized out."
;; Identify LAP sequences like:
;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted
126 changed 126)) . 24)
@@ -1142,13 +1155,13 @@ Return value is the fall-through block name."
(`(TAG ,target . ,_label-sp)
(= target (car targets)))))))
-(defun comp-emit-switch (var last-insn)
+(defun comp--emit-switch (var last-insn)
"Emit a Limple for a lap jump table given VAR and LAST-INSN."
;; FIXME this not efficient for big jump tables. We should have a second
;; strategy for this case.
(pcase last-insn
(`(setimm ,_ ,jmp-table)
- (unless (comp-jump-table-optimizable jmp-table)
+ (unless (comp--jump-table-optimizable jmp-table)
(cl-loop
for test being each hash-keys of jmp-table
using (hash-value target-label)
@@ -1156,27 +1169,27 @@ Return value is the fall-through block name."
with test-func = (hash-table-test jmp-table)
for n from 1
for last = (= n len)
- for m-test = (make-comp-mvar :constant test)
- for target-name = (comp-block-name (comp-bb-maybe-add
- (comp-label-to-addr target-label)
- (comp-sp)))
+ for m-test = (make--comp-mvar :constant test)
+ for target-name = (comp-block-name (comp--bb-maybe-add
+ (comp--label-to-addr target-label)
+ (comp--sp)))
for ff-bb = (if last
- (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
- (comp-sp))
+ (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass))
+ (comp--sp))
(make--comp-block-lap nil
- (comp-sp)
- (comp-new-block-sym)))
+ (comp--sp)
+ (comp--new-block-sym)))
for ff-bb-name = (comp-block-name ff-bb)
if (eq test-func 'eq)
- do (comp-emit (list 'cond-jump var m-test target-name ff-bb-name))
+ do (comp--emit (list 'cond-jump var m-test target-name ff-bb-name))
else
;; Store the result of the comparison into the scratch slot before
;; emitting the conditional jump.
- do (comp-emit (list 'set (make-comp-mvar :slot 'scratch)
- (comp-call test-func var m-test)))
- (comp-emit (list 'cond-jump
- (make-comp-mvar :slot 'scratch)
- (make-comp-mvar :constant nil)
+ do (comp--emit (list 'set (make--comp-mvar :slot 'scratch)
+ (comp--call test-func var m-test)))
+ (comp--emit (list 'cond-jump
+ (make--comp-mvar :slot 'scratch)
+ (make--comp-mvar :constant nil)
ff-bb-name target-name))
unless last
;; All fall through are artificially created here except the last one.
@@ -1191,7 +1204,7 @@ SUBR-NAME is the name of function."
(or (gethash subr-name comp-subr-arities-h)
(func-arity subr-name)))
-(defun comp-emit-set-call-subr (subr-name sp-delta)
+(defun comp--emit-set-call-subr (subr-name sp-delta)
"Emit a call for SUBR-NAME.
SP-DELTA is the stack adjustment."
(let* ((nargs (1+ (- sp-delta)))
@@ -1202,39 +1215,39 @@ SP-DELTA is the stack adjustment."
(signal 'native-ice (list "subr contains unevalled args" subr-name)))
(if (eq maxarg 'many)
;; callref case.
- (comp-emit-set-call (comp-callref subr-name nargs (comp-sp)))
+ (comp--emit-set-call (comp--callref subr-name nargs (comp--sp)))
;; Normal call.
(unless (and (>= maxarg nargs) (<= minarg nargs))
(signal 'native-ice
(list "incoherent stack adjustment" nargs maxarg minarg)))
(let* ((subr-name subr-name)
(slots (cl-loop for i from 0 below maxarg
- collect (comp-slot-n (+ i (comp-sp))))))
- (comp-emit-set-call (apply #'comp-call (cons subr-name slots)))))))
+ collect (comp--slot-n (+ i (comp--sp))))))
+ (comp--emit-set-call (apply #'comp--call (cons subr-name slots)))))))
(eval-when-compile
- (defun comp-op-to-fun (x)
+ (defun comp--op-to-fun (x)
"Given the LAP op strip \"byte-\" to have the subr name."
(intern (string-replace "byte-" "" x)))
- (defun comp-body-eff (body op-name sp-delta)
+ (defun comp--body-eff (body op-name sp-delta)
"Given the original BODY, compute the effective one.
When BODY is `auto', guess function name from the LAP byte-code
name. Otherwise expect lname fnname."
(pcase (car body)
('auto
- `((comp-emit-set-call-subr ',(comp-op-to-fun op-name) ,sp-delta)))
+ `((comp--emit-set-call-subr ',(comp--op-to-fun op-name) ,sp-delta)))
((pred symbolp)
- `((comp-emit-set-call-subr ',(car body) ,sp-delta)))
+ `((comp--emit-set-call-subr ',(car body) ,sp-delta)))
(_ body))))
-(defmacro comp-op-case (&rest cases)
+(defmacro comp--op-case (&rest cases)
"Expand CASES into the corresponding `pcase' expansion.
This is responsible for generating the proper stack adjustment, when known,
and the annotation emission."
(declare (debug (body))
(indent defun))
- (declare-function comp-body-eff nil (body op-name sp-delta))
+ (declare-function comp--body-eff nil (body op-name sp-delta))
`(pcase op
,@(cl-loop for (op . body) in cases
for sp-delta = (gethash op comp-op-stack-info)
@@ -1243,55 +1256,55 @@ and the annotation emission."
collect `(',op
;; Log all LAP ops except the TAG one.
;; ,(unless (eq op 'TAG)
- ;; `(comp-emit-annotation
+ ;; `(comp--emit-annotation
;; ,(concat "LAP op " op-name)))
;; Emit the stack adjustment if present.
,(when (and sp-delta (not (eq 0 sp-delta)))
- `(cl-incf (comp-sp) ,sp-delta))
- ,@(comp-body-eff body op-name sp-delta))
+ `(cl-incf (comp--sp) ,sp-delta))
+ ,@(comp--body-eff body op-name sp-delta))
else
collect `(',op (signal 'native-ice
(list "unsupported LAP op" ',op-name))))
(_ (signal 'native-ice (list "unexpected LAP op" (symbol-name op))))))
-(defun comp-limplify-lap-inst (insn)
+(defun comp--limplify-lap-inst (insn)
"Limplify LAP instruction INSN pushing it in the proper basic block."
(let ((op (car insn))
(arg (if (consp (cdr insn))
(cadr insn)
(cdr insn))))
- (comp-op-case
+ (comp--op-case
(TAG
(cl-destructuring-bind (_TAG label-num . label-sp) insn
;; Paranoid?
(when label-sp
(cl-assert (= (1- label-sp) (comp-limplify-sp comp-pass))))
- (comp-emit-annotation (format "LAP TAG %d" label-num))))
+ (comp--emit-annotation (format "LAP TAG %d" label-num))))
(byte-stack-ref
- (comp-copy-slot (- (comp-sp) arg 1)))
+ (comp--copy-slot (- (comp--sp) arg 1)))
(byte-varref
- (comp-emit-set-call (comp-call 'symbol-value (make-comp-mvar
+ (comp--emit-set-call (comp--call 'symbol-value (make--comp-mvar
:constant arg))))
(byte-varset
- (comp-emit (comp-call 'set_internal
- (make-comp-mvar :constant arg)
- (comp-slot+1))))
+ (comp--emit (comp--call 'set_internal
+ (make--comp-mvar :constant arg)
+ (comp--slot+1))))
(byte-varbind ;; Verify
- (comp-emit (comp-call 'specbind
- (make-comp-mvar :constant arg)
- (comp-slot+1))))
+ (comp--emit (comp--call 'specbind
+ (make--comp-mvar :constant arg)
+ (comp--slot+1))))
(byte-call
- (cl-incf (comp-sp) (- arg))
- (comp-emit-set-call (comp-callref 'funcall (1+ arg) (comp-sp))))
+ (cl-incf (comp--sp) (- arg))
+ (comp--emit-set-call (comp--callref 'funcall (1+ arg) (comp--sp))))
(byte-unbind
- (comp-emit (comp-call 'helper_unbind_n
- (make-comp-mvar :constant arg))))
+ (comp--emit (comp--call 'helper_unbind_n
+ (make--comp-mvar :constant arg))))
(byte-pophandler
- (comp-emit '(pop-handler)))
+ (comp--emit '(pop-handler)))
(byte-pushconditioncase
- (comp-emit-handler (cddr insn) 'condition-case))
+ (comp--emit-handler (cddr insn) 'condition-case))
(byte-pushcatch
- (comp-emit-handler (cddr insn) 'catcher))
+ (comp--emit-handler (cddr insn) 'catcher))
(byte-nth auto)
(byte-symbolp auto)
(byte-consp auto)
@@ -1300,19 +1313,19 @@ and the annotation emission."
(byte-eq auto)
(byte-memq auto)
(byte-not
- (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp))
- (make-comp-mvar :constant nil))))
+ (comp--emit-set-call (comp--call 'eq (comp--slot-n (comp--sp))
+ (make--comp-mvar :constant nil))))
(byte-car auto)
(byte-cdr auto)
(byte-cons auto)
(byte-list1
- (comp-limplify-listn 1))
+ (comp--limplify-listn 1))
(byte-list2
- (comp-limplify-listn 2))
+ (comp--limplify-listn 2))
(byte-list3
- (comp-limplify-listn 3))
+ (comp--limplify-listn 3))
(byte-list4
- (comp-limplify-listn 4))
+ (comp--limplify-listn 4))
(byte-length auto)
(byte-aref auto)
(byte-aset auto)
@@ -1323,11 +1336,11 @@ and the annotation emission."
(byte-get auto)
(byte-substring auto)
(byte-concat2
- (comp-emit-set-call (comp-callref 'concat 2 (comp-sp))))
+ (comp--emit-set-call (comp--callref 'concat 2 (comp--sp))))
(byte-concat3
- (comp-emit-set-call (comp-callref 'concat 3 (comp-sp))))
+ (comp--emit-set-call (comp--callref 'concat 3 (comp--sp))))
(byte-concat4
- (comp-emit-set-call (comp-callref 'concat 4 (comp-sp))))
+ (comp--emit-set-call (comp--callref 'concat 4 (comp--sp))))
(byte-sub1 1-)
(byte-add1 1+)
(byte-eqlsign =)
@@ -1337,7 +1350,7 @@ and the annotation emission."
(byte-geq >=)
(byte-diff -)
(byte-negate
- (comp-emit-set-call (comp-call 'negate (comp-slot))))
+ (comp--emit-set-call (comp--call 'negate (comp--slot))))
(byte-plus +)
(byte-max auto)
(byte-min auto)
@@ -1352,9 +1365,9 @@ and the annotation emission."
(byte-preceding-char preceding-char)
(byte-current-column auto)
(byte-indent-to
- (comp-emit-set-call (comp-call 'indent-to
- (comp-slot)
- (make-comp-mvar :constant nil))))
+ (comp--emit-set-call (comp--call 'indent-to
+ (comp--slot)
+ (make--comp-mvar :constant nil))))
(byte-scan-buffer-OBSOLETE)
(byte-eolp auto)
(byte-eobp auto)
@@ -1363,7 +1376,7 @@ and the annotation emission."
(byte-current-buffer auto)
(byte-set-buffer auto)
(byte-save-current-buffer
- (comp-emit (comp-call 'record_unwind_current_buffer)))
+ (comp--emit (comp--call 'record_unwind_current_buffer)))
(byte-set-mark-OBSOLETE)
(byte-interactive-p-OBSOLETE)
(byte-forward-char auto)
@@ -1375,41 +1388,41 @@ and the annotation emission."
(byte-buffer-substring auto)
(byte-delete-region auto)
(byte-narrow-to-region
- (comp-emit-set-call (comp-call 'narrow-to-region
- (comp-slot)
- (comp-slot+1))))
+ (comp--emit-set-call (comp--call 'narrow-to-region
+ (comp--slot)
+ (comp--slot+1))))
(byte-widen
- (comp-emit-set-call (comp-call 'widen)))
+ (comp--emit-set-call (comp--call 'widen)))
(byte-end-of-line auto)
(byte-constant2) ; TODO
;; Branches.
(byte-goto
- (comp-emit-uncond-jump (cddr insn)))
+ (comp--emit-uncond-jump (cddr insn)))
(byte-goto-if-nil
- (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0
+ (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0
(cddr insn) nil))
(byte-goto-if-not-nil
- (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0
+ (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0
(cddr insn) t))
(byte-goto-if-nil-else-pop
- (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1
+ (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1
(cddr insn) nil))
(byte-goto-if-not-nil-else-pop
- (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1
+ (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1
(cddr insn) t))
(byte-return
- (comp-emit `(return ,(comp-slot+1))))
+ (comp--emit `(return ,(comp--slot+1))))
(byte-discard 'pass)
(byte-dup
- (comp-copy-slot (1- (comp-sp))))
+ (comp--copy-slot (1- (comp--sp))))
(byte-save-excursion
- (comp-emit (comp-call 'record_unwind_protect_excursion)))
+ (comp--emit (comp--call 'record_unwind_protect_excursion)))
(byte-save-window-excursion-OBSOLETE)
(byte-save-restriction
- (comp-emit (comp-call 'helper_save_restriction)))
+ (comp--emit (comp--call 'helper_save_restriction)))
(byte-catch) ;; Obsolete
(byte-unwind-protect
- (comp-emit (comp-call 'helper_unwind_protect (comp-slot+1))))
+ (comp--emit (comp--call 'helper_unwind_protect (comp--slot+1))))
(byte-condition-case) ;; Obsolete
(byte-temp-output-buffer-setup-OBSOLETE)
(byte-temp-output-buffer-show-OBSOLETE)
@@ -1436,61 +1449,61 @@ and the annotation emission."
(byte-numberp auto)
(byte-integerp auto)
(byte-listN
- (cl-incf (comp-sp) (- 1 arg))
- (comp-emit-set-call (comp-callref 'list arg (comp-sp))))
+ (cl-incf (comp--sp) (- 1 arg))
+ (comp--emit-set-call (comp--callref 'list arg (comp--sp))))
(byte-concatN
- (cl-incf (comp-sp) (- 1 arg))
- (comp-emit-set-call (comp-callref 'concat arg (comp-sp))))
+ (cl-incf (comp--sp) (- 1 arg))
+ (comp--emit-set-call (comp--callref 'concat arg (comp--sp))))
(byte-insertN
- (cl-incf (comp-sp) (- 1 arg))
- (comp-emit-set-call (comp-callref 'insert arg (comp-sp))))
+ (cl-incf (comp--sp) (- 1 arg))
+ (comp--emit-set-call (comp--callref 'insert arg (comp--sp))))
(byte-stack-set
- (comp-copy-slot (1+ (comp-sp)) (- (comp-sp) arg -1)))
+ (comp--copy-slot (1+ (comp--sp)) (- (comp--sp) arg -1)))
(byte-stack-set2 (cl-assert nil)) ;; TODO
(byte-discardN
- (cl-incf (comp-sp) (- arg)))
+ (cl-incf (comp--sp) (- arg)))
(byte-switch
;; Assume to follow the emission of a setimm.
- ;; This is checked into comp-emit-switch.
- (comp-emit-switch (comp-slot+1)
+ ;; This is checked into comp--emit-switch.
+ (comp--emit-switch (comp--slot+1)
(cl-first (comp-block-insns
(comp-limplify-curr-block comp-pass)))))
(byte-constant
- (comp-emit-setimm arg))
+ (comp--emit-setimm arg))
(byte-discardN-preserve-tos
- (cl-incf (comp-sp) (- arg))
- (comp-copy-slot (+ arg (comp-sp)))))))
+ (cl-incf (comp--sp) (- arg))
+ (comp--copy-slot (+ arg (comp--sp)))))))
-(defun comp-emit-narg-prologue (minarg nonrest rest)
+(defun comp--emit-narg-prologue (minarg nonrest rest)
"Emit the prologue for a narg function."
(cl-loop for i below minarg
- do (comp-emit `(set-args-to-local ,(comp-slot-n i)))
- (comp-emit '(inc-args)))
+ do (comp--emit `(set-args-to-local ,(comp--slot-n i)))
+ (comp--emit '(inc-args)))
(cl-loop for i from minarg below nonrest
for bb = (intern (format "entry_%s" i))
for fallback = (intern (format "entry_fallback_%s" i))
- do (comp-emit `(cond-jump-narg-leq ,i ,fallback ,bb))
- (comp-make-curr-block bb (comp-sp))
- (comp-emit `(set-args-to-local ,(comp-slot-n i)))
- (comp-emit '(inc-args))
- finally (comp-emit '(jump entry_rest_args)))
+ do (comp--emit `(cond-jump-narg-leq ,i ,fallback ,bb))
+ (comp--make-curr-block bb (comp--sp))
+ (comp--emit `(set-args-to-local ,(comp--slot-n i)))
+ (comp--emit '(inc-args))
+ finally (comp--emit '(jump entry_rest_args)))
(when (/= minarg nonrest)
(cl-loop for i from minarg below nonrest
for bb = (intern (format "entry_fallback_%s" i))
for next-bb = (if (= (1+ i) nonrest)
'entry_rest_args
(intern (format "entry_fallback_%s" (1+ i))))
- do (comp-with-sp i
- (comp-make-curr-block bb (comp-sp))
- (comp-emit-setimm nil)
- (comp-emit `(jump ,next-bb)))))
- (comp-make-curr-block 'entry_rest_args (comp-sp))
- (comp-emit `(set-rest-args-to-local ,(comp-slot-n nonrest)))
- (setf (comp-sp) nonrest)
+ do (comp--with-sp i
+ (comp--make-curr-block bb (comp--sp))
+ (comp--emit-setimm nil)
+ (comp--emit `(jump ,next-bb)))))
+ (comp--make-curr-block 'entry_rest_args (comp--sp))
+ (comp--emit `(set-rest-args-to-local ,(comp--slot-n nonrest)))
+ (setf (comp--sp) nonrest)
(when (and (> nonrest 8) (null rest))
- (cl-decf (comp-sp))))
+ (cl-decf (comp--sp))))
-(defun comp-limplify-finalize-function (func)
+(defun comp--limplify-finalize-function (func)
"Reverse insns into all basic blocks of FUNC."
(cl-loop for bb being the hash-value in (comp-func-blocks func)
do (setf (comp-block-insns bb)
@@ -1498,49 +1511,49 @@ and the annotation emission."
(comp--log-func func 2)
func)
-(cl-defgeneric comp-prepare-args-for-top-level (function)
+(cl-defgeneric comp--prepare-args-for-top-level (function)
"Given FUNCTION, return the two arguments for comp--register-...")
-(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-l))
+(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-l))
"Lexically-scoped FUNCTION."
(let ((args (comp-func-l-args function)))
- (cons (make-comp-mvar :constant (comp-args-base-min args))
- (make-comp-mvar :constant (cond
+ (cons (make--comp-mvar :constant (comp-args-base-min args))
+ (make--comp-mvar :constant (cond
((comp-args-p args) (comp-args-max args))
((comp-nargs-rest args) 'many)
(t (comp-nargs-nonrest args)))))))
-(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d))
+(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-d))
"Dynamically scoped FUNCTION."
- (cons (make-comp-mvar :constant (func-arity (comp-func-byte-func function)))
+ (cons (make--comp-mvar :constant (func-arity (comp-func-byte-func function)))
(let ((comp-curr-allocation-class 'd-default))
;; Lambda-lists must stay in the same relocation class of
;; the object referenced by code to respect uninterned
;; symbols.
- (make-comp-mvar :constant (comp-func-d-lambda-list function)))))
+ (make--comp-mvar :constant (comp-func-d-lambda-list function)))))
-(cl-defgeneric comp-emit-for-top-level (form for-late-load)
+(cl-defgeneric comp--emit-for-top-level (form for-late-load)
"Emit the Limple code for top level FORM.")
-(cl-defmethod comp-emit-for-top-level ((form byte-to-native-func-def)
+(cl-defmethod comp--emit-for-top-level ((form byte-to-native-func-def)
for-late-load)
(let* ((name (byte-to-native-func-def-name form))
(c-name (byte-to-native-func-def-c-name form))
(f (gethash c-name (comp-ctxt-funcs-h comp-ctxt)))
- (args (comp-prepare-args-for-top-level f)))
+ (args (comp--prepare-args-for-top-level f)))
(cl-assert (and name f))
- (comp-emit
- `(set ,(make-comp-mvar :slot 1)
- ,(comp-call (if for-late-load
+ (comp--emit
+ `(set ,(make--comp-mvar :slot 1)
+ ,(comp--call (if for-late-load
'comp--late-register-subr
'comp--register-subr)
- (make-comp-mvar :constant name)
- (make-comp-mvar :constant c-name)
+ (make--comp-mvar :constant name)
+ (make--comp-mvar :constant c-name)
(car args)
(cdr args)
(setf (comp-func-type f)
- (make-comp-mvar :constant nil))
- (make-comp-mvar
+ (make--comp-mvar :constant nil))
+ (make--comp-mvar
:constant
(list
(let* ((h (comp-ctxt-function-docs comp-ctxt))
@@ -1551,40 +1564,40 @@ and the annotation emission."
(comp-func-command-modes f)))
;; This is the compilation unit it-self passed as
;; parameter.
- (make-comp-mvar :slot 0))))))
+ (make--comp-mvar :slot 0))))))
-(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level)
+(cl-defmethod comp--emit-for-top-level ((form byte-to-native-top-level)
for-late-load)
(unless for-late-load
- (comp-emit
- (comp-call 'eval
+ (comp--emit
+ (comp--call 'eval
(let ((comp-curr-allocation-class 'd-impure))
- (make-comp-mvar :constant
+ (make--comp-mvar :constant
(byte-to-native-top-level-form form)))
- (make-comp-mvar :constant
+ (make--comp-mvar :constant
(byte-to-native-top-level-lexical form))))))
-(defun comp-emit-lambda-for-top-level (func)
+(defun comp--emit-lambda-for-top-level (func)
"Emit the creation of subrs for lambda FUNC.
These are stored in the reloc data array."
- (let ((args (comp-prepare-args-for-top-level func)))
+ (let ((args (comp--prepare-args-for-top-level func)))
(let ((comp-curr-allocation-class 'd-impure))
(comp--add-const-to-relocs (comp-func-byte-func func)))
- (comp-emit
- (comp-call 'comp--register-lambda
+ (comp--emit
+ (comp--call 'comp--register-lambda
;; mvar to be fixed-up when containers are
;; finalized.
(or (gethash (comp-func-byte-func func)
(comp-ctxt-lambda-fixups-h comp-ctxt))
(puthash (comp-func-byte-func func)
- (make-comp-mvar :constant nil)
+ (make--comp-mvar :constant nil)
(comp-ctxt-lambda-fixups-h comp-ctxt)))
- (make-comp-mvar :constant (comp-func-c-name func))
+ (make--comp-mvar :constant (comp-func-c-name func))
(car args)
(cdr args)
(setf (comp-func-type func)
- (make-comp-mvar :constant nil))
- (make-comp-mvar
+ (make--comp-mvar :constant nil))
+ (make--comp-mvar
:constant
(list
(let* ((h (comp-ctxt-function-docs comp-ctxt))
@@ -1595,9 +1608,9 @@ These are stored in the reloc data array."
(comp-func-command-modes func)))
;; This is the compilation unit it-self passed as
;; parameter.
- (make-comp-mvar :slot 0)))))
+ (make--comp-mvar :slot 0)))))
-(defun comp-limplify-top-level (for-late-load)
+(defun comp--limplify-top-level (for-late-load)
"Create a Limple function to modify the global environment at load.
When FOR-LATE-LOAD is non-nil, the emitted function modifies only
function definition.
@@ -1627,22 +1640,22 @@ into the C code forwarding the compilation unit."
(comp-func func)
(comp-pass (make-comp-limplify
:curr-block (make--comp-block-lap -1 0 'top-level)
- :frame (comp-new-frame 1 0))))
- (comp-make-curr-block 'entry (comp-sp))
- (comp-emit-annotation (if for-late-load
+ :frame (comp--new-frame 1 0))))
+ (comp--make-curr-block 'entry (comp--sp))
+ (comp--emit-annotation (if for-late-load
"Late top level"
"Top level"))
;; Assign the compilation unit incoming as parameter to the slot frame 0.
- (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0))
+ (comp--emit `(set-par-to-local ,(comp--slot-n 0) 0))
(maphash (lambda (_ func)
- (comp-emit-lambda-for-top-level func))
+ (comp--emit-lambda-for-top-level func))
(comp-ctxt-byte-func-to-func-h comp-ctxt))
- (mapc (lambda (x) (comp-emit-for-top-level x for-late-load))
+ (mapc (lambda (x) (comp--emit-for-top-level x for-late-load))
(comp-ctxt-top-level-forms comp-ctxt))
- (comp-emit `(return ,(make-comp-mvar :slot 1)))
- (comp-limplify-finalize-function func)))
+ (comp--emit `(return ,(make--comp-mvar :slot 1)))
+ (comp--limplify-finalize-function func)))
-(defun comp-addr-to-bb-name (addr)
+(defun comp--addr-to-bb-name (addr)
"Search for a block starting at ADDR into pending or limplified blocks."
;; FIXME Actually we could have another hash for this.
(cl-flet ((pred (bb)
@@ -1654,7 +1667,7 @@ into the C code forwarding the compilation unit."
when (pred bb)
return (comp-block-name bb)))))
-(defun comp-limplify-block (bb)
+(defun comp--limplify-block (bb)
"Limplify basic-block BB and add it to the current function."
(setf (comp-limplify-curr-block comp-pass) bb
(comp-limplify-sp comp-pass) (comp-block-lap-sp bb)
@@ -1665,51 +1678,51 @@ into the C code forwarding the compilation unit."
(comp-func-lap comp-func))
for inst = (car inst-cell)
for next-inst = (car-safe (cdr inst-cell))
- do (comp-limplify-lap-inst inst)
+ do (comp--limplify-lap-inst inst)
(cl-incf (comp-limplify-pc comp-pass))
- when (comp-lap-fall-through-p inst)
+ when (comp--lap-fall-through-p inst)
do (pcase next-inst
(`(TAG ,_label . ,label-sp)
(when label-sp
- (cl-assert (= (1- label-sp) (comp-sp))))
+ (cl-assert (= (1- label-sp) (comp--sp))))
(let* ((stack-depth (if label-sp
(1- label-sp)
- (comp-sp)))
- (next-bb (comp-block-name (comp-bb-maybe-add
+ (comp--sp)))
+ (next-bb (comp-block-name (comp--bb-maybe-add
(comp-limplify-pc comp-pass)
stack-depth))))
(unless (comp-block-closed bb)
- (comp-emit `(jump ,next-bb))))
+ (comp--emit `(jump ,next-bb))))
(cl-return)))
- until (comp-lap-eob-p inst)))
+ until (comp--lap-eob-p inst)))
-(defun comp-limplify-function (func)
+(defun comp--limplify-function (func)
"Limplify a single function FUNC."
(let* ((frame-size (comp-func-frame-size func))
(comp-func func)
(comp-pass (make-comp-limplify
- :frame (comp-new-frame frame-size 0))))
- (comp-fill-label-h)
+ :frame (comp--new-frame frame-size 0))))
+ (comp--fill-label-h)
;; Prologue
- (comp-make-curr-block 'entry (comp-sp))
- (comp-emit-annotation (concat "Lisp function: "
+ (comp--make-curr-block 'entry (comp--sp))
+ (comp--emit-annotation (concat "Lisp function: "
(symbol-name (comp-func-name func))))
;; Dynamic functions have parameters bound by the trampoline.
(when (comp-func-l-p func)
(let ((args (comp-func-l-args func)))
(if (comp-args-p args)
(cl-loop for i below (comp-args-max args)
- do (cl-incf (comp-sp))
- (comp-emit `(set-par-to-local ,(comp-slot) ,i)))
- (comp-emit-narg-prologue (comp-args-base-min args)
+ do (cl-incf (comp--sp))
+ (comp--emit `(set-par-to-local ,(comp--slot) ,i)))
+ (comp--emit-narg-prologue (comp-args-base-min args)
(comp-nargs-nonrest args)
(comp-nargs-rest args)))))
- (comp-emit '(jump bb_0))
+ (comp--emit '(jump bb_0))
;; Body
- (comp-bb-maybe-add 0 (comp-sp))
+ (comp--bb-maybe-add 0 (comp--sp))
(cl-loop for next-bb = (pop (comp-limplify-pending-blocks comp-pass))
while next-bb
- do (comp-limplify-block next-bb))
+ do (comp--limplify-block next-bb))
;; Sanity check against block duplication.
(cl-loop with addr-h = (make-hash-table)
for bb being the hash-value in (comp-func-blocks func)
@@ -1718,15 +1731,15 @@ into the C code forwarding the compilation unit."
when addr
do (cl-assert (null (gethash addr addr-h)))
(puthash addr t addr-h))
- (comp-limplify-finalize-function func)))
+ (comp--limplify-finalize-function func)))
-(defun comp-limplify (_)
+(defun comp--limplify (_)
"Compute LIMPLE IR for forms in `comp-ctxt'."
- (maphash (lambda (_ f) (comp-limplify-function f))
+ (maphash (lambda (_ f) (comp--limplify-function f))
(comp-ctxt-funcs-h comp-ctxt))
- (comp-add-func-to-ctxt (comp-limplify-top-level nil))
+ (comp--add-func-to-ctxt (comp--limplify-top-level nil))
(when (comp-ctxt-with-late-load comp-ctxt)
- (comp-add-func-to-ctxt (comp-limplify-top-level t))))
+ (comp--add-func-to-ctxt (comp--limplify-top-level t))))
;;; add-cstrs pass specific code.
@@ -1750,22 +1763,22 @@ into the C code forwarding the compilation unit."
;; type specifier.
-(defsubst comp-mvar-used-p (mvar)
+(defsubst comp--mvar-used-p (mvar)
"Non-nil when MVAR is used as lhs in the current function."
(declare (gv-setter (lambda (val)
`(puthash ,mvar ,val comp-pass))))
(gethash mvar comp-pass))
-(defun comp-collect-mvars (form)
+(defun comp--collect-mvars (form)
"Add rhs m-var present in FORM into `comp-pass'."
(cl-loop for x in form
if (consp x)
- do (comp-collect-mvars x)
+ do (comp--collect-mvars x)
else
when (comp-mvar-p x)
- do (setf (comp-mvar-used-p x) t)))
+ do (setf (comp--mvar-used-p x) t)))
-(defun comp-collect-rhs ()
+(defun comp--collect-rhs ()
"Collect all lhs mvars into `comp-pass'."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
@@ -1773,11 +1786,11 @@ into the C code forwarding the compilation unit."
for insn in (comp-block-insns b)
for (op . args) = insn
if (comp--assign-op-p op)
- do (comp-collect-mvars (cdr args))
+ do (comp--collect-mvars (cdr args))
else
- do (comp-collect-mvars args))))
+ do (comp--collect-mvars args))))
-(defun comp-negate-arithm-cmp-fun (function)
+(defun comp--negate-arithm-cmp-fun (function)
"Negate FUNCTION.
Return nil if we don't want to emit constraints for its negation."
(cl-ecase function
@@ -1787,7 +1800,7 @@ Return nil if we don't want to emit constraints for its
negation."
(>= '<)
(<= '>)))
-(defun comp-reverse-arithm-fun (function)
+(defun comp--reverse-arithm-fun (function)
"Reverse FUNCTION."
(cl-case function
(= '=)
@@ -1797,7 +1810,7 @@ Return nil if we don't want to emit constraints for its
negation."
(<= '>=)
(t function)))
-(defun comp-emit-assume (kind lhs rhs bb negated)
+(defun comp--emit-assume (kind lhs rhs bb negated)
"Emit an assume of kind KIND for mvar LHS being RHS.
When NEGATED is non-nil, the assumption is negated.
The assume is emitted at the beginning of the block BB."
@@ -1807,41 +1820,41 @@ The assume is emitted at the beginning of the block BB."
((or 'and 'and-nhc)
(if (comp-mvar-p rhs)
(let ((tmp-mvar (if negated
- (make-comp-mvar :slot (comp-mvar-slot rhs))
+ (make--comp-mvar :slot (comp-mvar-slot rhs))
rhs)))
- (push `(assume ,(make-comp-mvar :slot lhs-slot)
+ (push `(assume ,(make--comp-mvar :slot lhs-slot)
(,kind ,lhs ,tmp-mvar))
(comp-block-insns bb))
(if negated
(push `(assume ,tmp-mvar (not ,rhs))
(comp-block-insns bb))))
;; If is only a constraint we can negate it directly.
- (push `(assume ,(make-comp-mvar :slot lhs-slot)
+ (push `(assume ,(make--comp-mvar :slot lhs-slot)
(,kind ,lhs ,(if negated
(comp-cstr-negation-make rhs)
rhs)))
(comp-block-insns bb))))
((pred comp--arithm-cmp-fun-p)
(when-let ((kind (if negated
- (comp-negate-arithm-cmp-fun kind)
+ (comp--negate-arithm-cmp-fun kind)
kind)))
- (push `(assume ,(make-comp-mvar :slot lhs-slot)
+ (push `(assume ,(make--comp-mvar :slot lhs-slot)
(,kind ,lhs
,(if-let* ((vld (comp-cstr-imm-vld-p rhs))
(val (comp-cstr-imm rhs))
(ok (and (integerp val)
(not (memq kind '(= !=))))))
val
- (make-comp-mvar :slot (comp-mvar-slot
rhs)))))
+ (make--comp-mvar :slot (comp-mvar-slot
rhs)))))
(comp-block-insns bb))))
(_ (cl-assert nil)))
(setf (comp-func-ssa-status comp-func) 'dirty)))
-(defun comp-maybe-add-vmvar (op cmp-res insns-seq)
+(defun comp--maybe-add-vmvar (op cmp-res insns-seq)
"If CMP-RES is clobbering OP emit a new constrained mvar and return it.
Return OP otherwise."
(if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res)))
- (new-mvar (make-comp-mvar
+ (new-mvar (make--comp-mvar
:slot
(- (cl-incf (comp-func-vframe-size comp-func))))))
(progn
@@ -1849,7 +1862,7 @@ Return OP otherwise."
new-mvar)
op))
-(defun comp-add-new-block-between (bb-symbol bb-a bb-b)
+(defun comp--add-new-block-between (bb-symbol bb-a bb-b)
"Create a new basic-block named BB-SYMBOL and add it between BB-A and BB-B."
(cl-loop
with new-bb = (make-comp-block-cstr :name bb-symbol
@@ -1872,7 +1885,7 @@ Return OP otherwise."
finally (cl-assert nil)))
;; Cheap substitute to a copy propagation pass...
-(defun comp-cond-cstrs-target-mvar (mvar exit-insn bb)
+(defun comp--cond-cstrs-target-mvar (mvar exit-insn bb)
"Given MVAR, search in BB the original mvar MVAR got assigned from.
Keep on searching till EXIT-INSN is encountered."
(cl-flet ((targetp (x)
@@ -1889,7 +1902,7 @@ Keep on searching till EXIT-INSN is encountered."
(setf res rhs)))
finally (cl-assert nil))))
-(defun comp-add-cond-cstrs-target-block (curr-bb target-bb-sym)
+(defun comp--add-cond-cstrs-target-block (curr-bb target-bb-sym)
"Return the appropriate basic block to add constraint assumptions into.
CURR-BB is the current basic block.
TARGET-BB-SYM is the symbol name of the target block."
@@ -1909,10 +1922,10 @@ TARGET-BB-SYM is the symbol name of the target block."
until (null (gethash new-name (comp-func-blocks comp-func)))
finally
;; Add it.
- (cl-return (comp-add-new-block-between new-name curr-bb target-bb))))))
+ (cl-return (comp--add-new-block-between new-name curr-bb target-bb))))))
-(defun comp-add-cond-cstrs-simple ()
- "`comp-add-cstrs' worker function for each selected function."
+(defun comp--add-cond-cstrs-simple ()
+ "`comp--add-cstrs' worker function for each selected function."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
do
@@ -1928,26 +1941,26 @@ TARGET-BB-SYM is the symbol name of the target block."
for branch-target-cell on blocks
for branch-target = (car branch-target-cell)
for negated in '(nil t)
- when (comp-mvar-used-p tmp-mvar)
+ when (comp--mvar-used-p tmp-mvar)
do
- (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (let ((block-target (comp--add-cond-cstrs-target-block b
branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
- (comp-emit-assume 'and tmp-mvar obj2 block-target negated))
+ (comp--emit-assume 'and tmp-mvar obj2 block-target negated))
finally (cl-return-from in-the-basic-block)))
(`((cond-jump ,obj1 ,obj2 . ,blocks))
(cl-loop
for branch-target-cell on blocks
for branch-target = (car branch-target-cell)
for negated in '(nil t)
- when (comp-mvar-used-p obj1)
+ when (comp--mvar-used-p obj1)
do
- (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (let ((block-target (comp--add-cond-cstrs-target-block b
branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
- (comp-emit-assume 'and obj1 obj2 block-target negated))
+ (comp--emit-assume 'and obj1 obj2 block-target negated))
finally (cl-return-from in-the-basic-block)))))))
-(defun comp-add-cond-cstrs ()
- "`comp-add-cstrs' worker function for each selected function."
+(defun comp--add-cond-cstrs ()
+ "`comp--add-cstrs' worker function for each selected function."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
do
@@ -1966,13 +1979,13 @@ TARGET-BB-SYM is the symbol name of the target block."
(set ,(and (pred comp-mvar-p) mvar-3)
(call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred
comp-mvar-p) mvar-2)))
(cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1
,bb2))
- (comp-emit-assume 'and mvar-tested
- (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag))
- (comp-add-cond-cstrs-target-block b bb2)
+ (comp--emit-assume 'and mvar-tested
+ (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
+ (comp--add-cond-cstrs-target-block b bb2)
nil)
- (comp-emit-assume 'and mvar-tested
- (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag))
- (comp-add-cond-cstrs-target-block b bb1)
+ (comp--emit-assume 'and mvar-tested
+ (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
+ (comp--add-cond-cstrs-target-block b bb1)
t))
(`((set ,(and (pred comp-mvar-p) cmp-res)
(,(pred comp--call-op-p)
@@ -1983,8 +1996,8 @@ TARGET-BB-SYM is the symbol name of the target block."
;; (comment ,_comment-str)
(cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
(cl-loop
- with target-mvar1 = (comp-cond-cstrs-target-mvar op1 (car insns-seq) b)
- with target-mvar2 = (comp-cond-cstrs-target-mvar op2 (car insns-seq) b)
+ with target-mvar1 = (comp--cond-cstrs-target-mvar op1 (car insns-seq)
b)
+ with target-mvar2 = (comp--cond-cstrs-target-mvar op2 (car insns-seq)
b)
for branch-target-cell on blocks
for branch-target = (car branch-target-cell)
for negated in '(t nil)
@@ -1993,19 +2006,19 @@ TARGET-BB-SYM is the symbol name of the target block."
(eql 'and-nhc)
(eq 'and)
(t fun))
- when (or (comp-mvar-used-p target-mvar1)
- (comp-mvar-used-p target-mvar2))
+ when (or (comp--mvar-used-p target-mvar1)
+ (comp--mvar-used-p target-mvar2))
do
- (let ((block-target (comp-add-cond-cstrs-target-block b
branch-target)))
+ (let ((block-target (comp--add-cond-cstrs-target-block b
branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
- (when (comp-mvar-used-p target-mvar1)
- (comp-emit-assume kind target-mvar1
- (comp-maybe-add-vmvar op2 cmp-res prev-insns-seq)
+ (when (comp--mvar-used-p target-mvar1)
+ (comp--emit-assume kind target-mvar1
+ (comp--maybe-add-vmvar op2 cmp-res
prev-insns-seq)
block-target negated))
- (when (comp-mvar-used-p target-mvar2)
- (comp-emit-assume (comp-reverse-arithm-fun kind)
+ (when (comp--mvar-used-p target-mvar2)
+ (comp--emit-assume (comp--reverse-arithm-fun kind)
target-mvar2
- (comp-maybe-add-vmvar op1 cmp-res prev-insns-seq)
+ (comp--maybe-add-vmvar op1 cmp-res
prev-insns-seq)
block-target negated)))
finally (cl-return-from in-the-basic-block)))
(`((set ,(and (pred comp-mvar-p) cmp-res)
@@ -2015,16 +2028,16 @@ TARGET-BB-SYM is the symbol name of the target block."
;; (comment ,_comment-str)
(cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
(cl-loop
- with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
+ with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b)
with cstr = (comp--pred-to-cstr fun)
for branch-target-cell on blocks
for branch-target = (car branch-target-cell)
for negated in '(t nil)
- when (comp-mvar-used-p target-mvar)
+ when (comp--mvar-used-p target-mvar)
do
- (let ((block-target (comp-add-cond-cstrs-target-block b
branch-target)))
+ (let ((block-target (comp--add-cond-cstrs-target-block b
branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
- (comp-emit-assume 'and target-mvar cstr block-target negated))
+ (comp--emit-assume 'and target-mvar cstr block-target negated))
finally (cl-return-from in-the-basic-block)))
;; Match predicate on the negated branch (unless).
(`((set ,(and (pred comp-mvar-p) cmp-res)
@@ -2034,20 +2047,20 @@ TARGET-BB-SYM is the symbol name of the target block."
(set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p)))
(cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks))
(cl-loop
- with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
+ with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b)
with cstr = (comp--pred-to-cstr fun)
for branch-target-cell on blocks
for branch-target = (car branch-target-cell)
for negated in '(nil t)
- when (comp-mvar-used-p target-mvar)
+ when (comp--mvar-used-p target-mvar)
do
- (let ((block-target (comp-add-cond-cstrs-target-block b
branch-target)))
+ (let ((block-target (comp--add-cond-cstrs-target-block b
branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
- (comp-emit-assume 'and target-mvar cstr block-target negated))
+ (comp--emit-assume 'and target-mvar cstr block-target negated))
finally (cl-return-from in-the-basic-block))))
(setf prev-insns-seq insns-seq))))
-(defsubst comp-insert-insn (insn insn-cell)
+(defsubst comp--insert-insn (insn insn-cell)
"Insert INSN as second insn of INSN-CELL."
(let ((next-cell (cdr insn-cell))
(new-cell `(,insn)))
@@ -2055,15 +2068,15 @@ TARGET-BB-SYM is the symbol name of the target block."
(cdr new-cell) next-cell
(comp-func-ssa-status comp-func) 'dirty)))
-(defun comp-emit-call-cstr (mvar call-cell cstr)
+(defun comp--emit-call-cstr (mvar call-cell cstr)
"Emit a constraint CSTR for MVAR after CALL-CELL."
- (let* ((new-mvar (make-comp-mvar :slot (comp-mvar-slot mvar)))
+ (let* ((new-mvar (make--comp-mvar :slot (comp-mvar-slot mvar)))
;; Have new-mvar as LHS *and* RHS to ensure monotonicity and
;; fwprop convergence!!
(insn `(assume ,new-mvar (and ,new-mvar ,mvar ,cstr))))
- (comp-insert-insn insn call-cell)))
+ (comp--insert-insn insn call-cell)))
-(defun comp-lambda-list-gen (lambda-list)
+(defun comp--lambda-list-gen (lambda-list)
"Return a generator to iterate over LAMBDA-LIST."
(lambda ()
(cl-case (car lambda-list)
@@ -2079,12 +2092,12 @@ TARGET-BB-SYM is the symbol name of the target block."
(car lambda-list)
(setf lambda-list (cdr lambda-list)))))))
-(defun comp-add-call-cstr ()
+(defun comp--add-call-cstr ()
"Add args assumptions for each function of which the type specifier is
known."
(cl-loop
for bb being each hash-value of (comp-func-blocks comp-func)
do
- (comp-loop-insn-in-block bb
+ (comp--loop-insn-in-block bb
(when-let ((match
(pcase insn
(`(set ,lhs (,(pred comp--call-op-p) ,f . ,args))
@@ -2095,10 +2108,10 @@ TARGET-BB-SYM is the symbol name of the target block."
(cl-values f cstr-f nil args))))))
(cl-multiple-value-bind (f cstr-f lhs args) match
(cl-loop
- with gen = (comp-lambda-list-gen (comp-cstr-f-args cstr-f))
+ with gen = (comp--lambda-list-gen (comp-cstr-f-args cstr-f))
for arg in args
for cstr = (funcall gen)
- for target = (comp-cond-cstrs-target-mvar arg insn bb)
+ for target = (comp--cond-cstrs-target-mvar arg insn bb)
unless (comp-cstr-p cstr)
do (signal 'native-ice
(list "Incoherent type specifier for function" f))
@@ -2109,9 +2122,9 @@ TARGET-BB-SYM is the symbol name of the target block."
(or (null lhs)
(not (eql (comp-mvar-slot lhs)
(comp-mvar-slot target)))))
- do (comp-emit-call-cstr target insn-cell cstr)))))))
+ do (comp--emit-call-cstr target insn-cell cstr)))))))
-(defun comp-add-cstrs (_)
+(defun comp--add-cstrs (_)
"Rewrite conditional branches adding appropriate `assume' insns.
This is introducing and placing `assume' insns in use by fwprop
to propagate conditional branch test information on target basic
@@ -2125,10 +2138,10 @@ blocks."
(not (comp-func-has-non-local f)))
(let ((comp-func f)
(comp-pass (make-hash-table :test #'eq)))
- (comp-collect-rhs)
- (comp-add-cond-cstrs-simple)
- (comp-add-cond-cstrs)
- (comp-add-call-cstr)
+ (comp--collect-rhs)
+ (comp--add-cond-cstrs-simple)
+ (comp--add-cond-cstrs)
+ (comp--add-call-cstr)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2140,7 +2153,7 @@ blocks."
;; avoid optimizing-out functions and preventing their redefinition
;; being effective.
-(defun comp-collect-calls (f)
+(defun comp--collect-calls (f)
"Return a list with all the functions called by F."
(cl-loop
with h = (make-hash-table :test #'eq)
@@ -2160,17 +2173,17 @@ blocks."
(comp-ctxt-funcs-h comp-ctxt)))
f))))
-(defun comp-pure-infer-func (f)
+(defun comp--pure-infer-func (f)
"If all functions called by F are pure then F is pure too."
(when (and (cl-every (lambda (x)
(or (comp--function-pure-p x)
(eq x (comp-func-name f))))
- (comp-collect-calls f))
+ (comp--collect-calls f))
(not (eq (comp-func-pure f) t)))
(comp-log (format "%s inferred to be pure" (comp-func-name f)))
(setf (comp-func-pure f) t)))
-(defun comp-ipa-pure (_)
+(defun comp--ipa-pure (_)
"Infer function purity."
(cl-loop
with pure-n = 0
@@ -2183,7 +2196,7 @@ blocks."
when (and (>= (comp-func-speed f) 3)
(comp-func-l-p f)
(not (comp-func-pure f)))
- do (comp-pure-infer-func f)
+ do (comp--pure-infer-func f)
count (comp-func-pure f))))
finally (comp-log (format "ipa-pure iterated %d times" n))))
@@ -2197,13 +2210,13 @@ blocks."
;; this form is called 'minimal SSA form'.
;; This pass should be run every time basic blocks or m-var are shuffled.
-(cl-defun make-comp-ssa-mvar (&rest rest &key _slot _constant _type)
- "Same as `make-comp-mvar' but set the `id' slot."
- (let ((mvar (apply #'make-comp-mvar rest)))
+(cl-defun make--comp--ssa-mvar (&rest rest &key _slot _constant _type)
+ "Same as `make--comp-mvar' but set the `id' slot."
+ (let ((mvar (apply #'make--comp-mvar rest)))
(setf (comp-mvar-id mvar) (sxhash-eq mvar))
mvar))
-(defun comp-clean-ssa (f)
+(defun comp--clean-ssa (f)
"Clean-up SSA for function F."
(setf (comp-func-edges-h f) (make-hash-table))
(cl-loop
@@ -2219,7 +2232,7 @@ blocks."
unless (eq 'phi (car insn))
collect insn))))
-(defun comp-compute-edges ()
+(defun comp--compute-edges ()
"Compute the basic block edges for the current function."
(cl-loop with blocks = (comp-func-blocks comp-func)
for bb being each hash-value of blocks
@@ -2255,7 +2268,7 @@ blocks."
(comp-block-in-edges (comp-edge-dst edge))))
(comp--log-edges comp-func)))
-(defun comp-collect-rev-post-order (basic-block)
+(defun comp--collect-rev-post-order (basic-block)
"Walk BASIC-BLOCK children and return their name in reversed post-order."
(let ((visited (make-hash-table))
(acc ()))
@@ -2270,7 +2283,7 @@ blocks."
(collect-rec basic-block)
acc)))
-(defun comp-compute-dominator-tree ()
+(defun comp--compute-dominator-tree ()
"Compute immediate dominators for each basic block in current function."
;; Originally based on: "A Simple, Fast Dominance Algorithm"
;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001).
@@ -2295,7 +2308,7 @@ blocks."
;; No point to go on if the only bb is 'entry'.
(bb0 (gethash 'bb_0 blocks)))
(cl-loop
- with rev-bb-list = (comp-collect-rev-post-order entry)
+ with rev-bb-list = (comp--collect-rev-post-order entry)
with changed = t
while changed
initially (progn
@@ -2322,7 +2335,7 @@ blocks."
new-idom)
changed t))))))
-(defun comp-compute-dominator-frontiers ()
+(defun comp--compute-dominator-frontiers ()
"Compute the dominator frontier for each basic block in `comp-func'."
;; Originally based on: "A Simple, Fast Dominance Algorithm"
;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001).
@@ -2337,7 +2350,7 @@ blocks."
(puthash b-name b (comp-block-df runner))
(setf runner (comp-block-idom runner))))))
-(defun comp-log-block-info ()
+(defun comp--log-block-info ()
"Log basic blocks info for the current function."
(maphash (lambda (name bb)
(let ((dom (comp-block-idom bb))
@@ -2350,7 +2363,7 @@ blocks."
3)))
(comp-func-blocks comp-func)))
-(defun comp-place-phis ()
+(defun comp--place-phis ()
"Place phi insns into the current function."
;; Originally based on: Static Single Assignment Book
;; Algorithm 3.1: Standard algorithm for inserting phi-functions
@@ -2391,7 +2404,7 @@ blocks."
(unless (cl-find y defs-v)
(push y w))))))))
-(defun comp-dom-tree-walker (bb pre-lambda post-lambda)
+(defun comp--dom-tree-walker (bb pre-lambda post-lambda)
"Dominator tree walker function starting from basic block BB.
PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
(when pre-lambda
@@ -2401,18 +2414,18 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or
post-order if non-nil."
for child = (comp-edge-dst ed)
when (eq bb (comp-block-idom child))
;; Current block is the immediate dominator then recur.
- do (comp-dom-tree-walker child pre-lambda post-lambda)))
+ do (comp--dom-tree-walker child pre-lambda post-lambda)))
(when post-lambda
(funcall post-lambda bb)))
-(cl-defstruct (comp-ssa (:copier nil))
+(cl-defstruct (comp--ssa (:copier nil))
"Support structure used while SSA renaming."
- (frame (comp-new-frame (comp-func-frame-size comp-func)
+ (frame (comp--new-frame (comp-func-frame-size comp-func)
(comp-func-vframe-size comp-func) t)
:type comp-vec
:documentation "`comp-vec' of m-vars."))
-(defun comp-ssa-rename-insn (insn frame)
+(defun comp--ssa-rename-insn (insn frame)
(cl-loop
for slot-n from (- (comp-func-vframe-size comp-func))
below (comp-func-frame-size comp-func)
@@ -2423,7 +2436,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or
post-order if non-nil."
(eql slot-n (comp-mvar-slot x))))
(new-lvalue ()
;; If is an assignment make a new mvar and put it as l-value.
- (let ((mvar (make-comp-ssa-mvar :slot slot-n)))
+ (let ((mvar (make--comp--ssa-mvar :slot slot-n)))
(setf (comp-vec-aref frame slot-n) mvar
(cadr insn) mvar))))
(pcase insn
@@ -2433,7 +2446,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or
post-order if non-nil."
(new-lvalue))
(`(fetch-handler . ,_)
;; Clobber all no matter what!
- (setf (comp-vec-aref frame slot-n) (make-comp-ssa-mvar :slot slot-n)))
+ (setf (comp-vec-aref frame slot-n) (make--comp--ssa-mvar :slot
slot-n)))
(`(phi ,n)
(when (equal n slot-n)
(new-lvalue)))
@@ -2441,7 +2454,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or
post-order if non-nil."
(let ((mvar (comp-vec-aref frame slot-n)))
(setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn)))))))))
-(defun comp-ssa-rename ()
+(defun comp--ssa-rename ()
"Entry point to rename into SSA within the current function."
(comp-log "Renaming\n" 2)
(let ((visited (make-hash-table)))
@@ -2449,7 +2462,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or
post-order if non-nil."
(unless (gethash bb visited)
(puthash bb t visited)
(cl-loop for insn in (comp-block-insns bb)
- do (comp-ssa-rename-insn insn in-frame))
+ do (comp--ssa-rename-insn insn in-frame))
(setf (comp-block-final-frame bb)
(copy-sequence in-frame))
(when-let ((out-edges (comp-block-out-edges bb)))
@@ -2460,11 +2473,11 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or
post-order if non-nil."
do (ssa-rename-rec child (comp-vec-copy in-frame)))))))
(ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func))
- (comp-new-frame (comp-func-frame-size comp-func)
+ (comp--new-frame (comp-func-frame-size comp-func)
(comp-func-vframe-size comp-func)
t)))))
-(defun comp-finalize-phis ()
+(defun comp--finalize-phis ()
"Fixup r-values into phis in all basic blocks."
(cl-flet ((finalize-phi (args b)
;; Concatenate into args all incoming m-vars for this phi.
@@ -2481,7 +2494,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or
post-order if non-nil."
when (eq op 'phi)
do (finalize-phi args b)))))
-(defun comp-remove-unreachable-blocks ()
+(defun comp--remove-unreachable-blocks ()
"Remove unreachable basic blocks.
Return t when one or more block was removed, nil otherwise."
(cl-loop
@@ -2497,7 +2510,7 @@ Return t when one or more block was removed, nil
otherwise."
ret t)
finally return ret))
-(defun comp-ssa ()
+(defun comp--ssa ()
"Port all functions into minimal SSA form."
(maphash (lambda (_ f)
(let* ((comp-func f)
@@ -2505,15 +2518,15 @@ Return t when one or more block was removed, nil
otherwise."
(unless (eq ssa-status t)
(cl-loop
when (eq ssa-status 'dirty)
- do (comp-clean-ssa f)
- do (comp-compute-edges)
- (comp-compute-dominator-tree)
- until (null (comp-remove-unreachable-blocks)))
- (comp-compute-dominator-frontiers)
- (comp-log-block-info)
- (comp-place-phis)
- (comp-ssa-rename)
- (comp-finalize-phis)
+ do (comp--clean-ssa f)
+ do (comp--compute-edges)
+ (comp--compute-dominator-tree)
+ until (null (comp--remove-unreachable-blocks)))
+ (comp--compute-dominator-frontiers)
+ (comp--log-block-info)
+ (comp--place-phis)
+ (comp--ssa-rename)
+ (comp--finalize-phis)
(comp--log-func comp-func 3)
(setf (comp-func-ssa-status f) t))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2525,12 +2538,12 @@ Return t when one or more block was removed, nil
otherwise."
;; This is also responsible for removing function calls to pure functions if
;; possible.
-(defconst comp-fwprop-max-insns-scan 4500
+(defconst comp--fwprop-max-insns-scan 4500
;; Chosen as ~ the greatest required value for full convergence
;; native compiling all Emacs code-base.
"Max number of scanned insn before giving-up.")
-(defun comp-copy-insn (insn)
+(defun comp--copy-insn (insn)
"Deep copy INSN."
;; Adapted from `copy-tree'.
(if (consp insn)
@@ -2538,16 +2551,16 @@ Return t when one or more block was removed, nil
otherwise."
(while (consp insn)
(let ((newcar (car insn)))
(if (or (consp (car insn)) (comp-mvar-p (car insn)))
- (setf newcar (comp-copy-insn (car insn))))
+ (setf newcar (comp--copy-insn (car insn))))
(push newcar result))
(setf insn (cdr insn)))
(nconc (nreverse result)
- (if (comp-mvar-p insn) (comp-copy-insn insn) insn)))
+ (if (comp-mvar-p insn) (comp--copy-insn insn) insn)))
(if (comp-mvar-p insn)
(copy-comp-mvar insn)
insn)))
-(defmacro comp-apply-in-env (func &rest args)
+(defmacro comp--apply-in-env (func &rest args)
"Apply FUNC to ARGS in the current compilation environment."
`(let ((env (cl-loop
for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt)
@@ -2563,7 +2576,7 @@ Return t when one or more block was removed, nil
otherwise."
for (func-name . def) in env
do (setf (symbol-function func-name) def)))))
-(defun comp-fwprop-prologue ()
+(defun comp--fwprop-prologue ()
"Prologue for the propagate pass.
Here goes everything that can be done not iteratively (read once).
Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved
or invoked?
@@ -2575,16 +2588,16 @@ Forward propagate immediate involed in assignments." ;
FIXME: Typo. Involved or
(`(setimm ,lval ,v)
(setf (comp-cstr-imm lval) v))))))
-(defun comp-function-foldable-p (f args)
+(defun comp--function-foldable-p (f args)
"Given function F called with ARGS, return non-nil when optimizable."
(and (comp--function-pure-p f)
(cl-every #'comp-cstr-imm-vld-p args)))
-(defun comp-function-call-maybe-fold (insn f args)
+(defun comp--function-call-maybe-fold (insn f args)
"Given INSN, when F is pure if all ARGS are known, remove the function call.
Return non-nil if the function is folded successfully."
(cl-flet ((rewrite-insn-as-setimm (insn value)
- ;; See `comp-emit-setimm'.
+ ;; See `comp--emit-setimm'.
(comp--add-const-to-relocs value)
(setf (car insn) 'setimm
(cddr insn) `(,value))))
@@ -2596,7 +2609,7 @@ Return non-nil if the function is folded successfully."
comp-symbol-values-optimizable)))
(rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm
(car args))))))
- ((comp-function-foldable-p f args)
+ ((comp--function-foldable-p f args)
(ignore-errors
;; No point to complain here in case of error because we
;; should do basic block pruning in order to be sure that this
@@ -2607,14 +2620,14 @@ Return non-nil if the function is folded successfully."
;; and know to be pure.
(comp-func-byte-func f-in-ctxt)
f))
- (value (comp-apply-in-env f (mapcar #'comp-cstr-imm args))))
+ (value (comp--apply-in-env f (mapcar #'comp-cstr-imm args))))
(rewrite-insn-as-setimm insn value)))))))
-(defun comp-fwprop-call (insn lval f args)
+(defun comp--fwprop-call (insn lval f args)
"Propagate on a call INSN into LVAL.
F is the function being called with arguments ARGS.
Fold the call in case."
- (unless (comp-function-call-maybe-fold insn f args)
+ (unless (comp--function-call-maybe-fold insn f args)
(when (and (eq 'funcall f)
(comp-cstr-imm-vld-p (car args)))
(setf f (comp-cstr-imm (car args))
@@ -2635,16 +2648,16 @@ Fold the call in case."
(comp-type-spec-to-cstr
(comp-cstr-imm (car args)))))))))
-(defun comp-fwprop-insn (insn)
+(defun comp--fwprop-insn (insn)
"Propagate within INSN."
(pcase insn
(`(set ,lval ,rval)
(pcase rval
(`(,(or 'call 'callref) ,f . ,args)
- (comp-fwprop-call insn lval f args))
+ (comp--fwprop-call insn lval f args))
(`(,(or 'direct-call 'direct-callref) ,f . ,args)
(let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt)))))
- (comp-fwprop-call insn lval f args)))
+ (comp--fwprop-call insn lval f args)))
(_
(comp-cstr-shallow-copy lval rval))))
(`(assume ,lval ,(and (pred comp-mvar-p) rval))
@@ -2689,7 +2702,7 @@ Fold the call in case."
(rvals (mapcar #'car rest)))
(apply prop-fn lval rvals)))))
-(defun comp-fwprop* ()
+(defun comp--fwprop* ()
"Propagate for set* and phi operands.
Return t if something was changed."
(cl-loop named outer
@@ -2701,17 +2714,17 @@ Return t if something was changed."
for insn in (comp-block-insns b)
for orig-insn = (unless modified
;; Save consing after 1st change.
- (comp-copy-insn insn))
+ (comp--copy-insn insn))
do
- (comp-fwprop-insn insn)
+ (comp--fwprop-insn insn)
(cl-incf i)
when (and (null modified) (not (equal insn orig-insn)))
do (setf modified t))
- when (> i comp-fwprop-max-insns-scan)
+ when (> i comp--fwprop-max-insns-scan)
do (cl-return-from outer nil)
finally return modified))
-(defun comp-rewrite-non-locals ()
+(defun comp--rewrite-non-locals ()
"Make explicit in LIMPLE non-local exits if identified."
(cl-loop
for bb being each hash-value of (comp-func-blocks comp-func)
@@ -2728,26 +2741,26 @@ Return t if something was changed."
(cdr insn-seq) '((unreachable))
(comp-func-ssa-status comp-func) 'dirty))))
-(defun comp-fwprop (_)
+(defun comp--fwprop (_)
"Forward propagate types and consts within the lattice."
- (comp-ssa)
- (comp-dead-code)
+ (comp--ssa)
+ (comp--dead-code)
(maphash (lambda (_ f)
(when (and (>= (comp-func-speed f) 2)
;; FIXME remove the following condition when tested.
(not (comp-func-has-non-local f)))
(let ((comp-func f))
- (comp-fwprop-prologue)
+ (comp--fwprop-prologue)
(cl-loop
for i from 1 to 100
- while (comp-fwprop*)
+ while (comp--fwprop*)
finally
(when (= i 100)
(display-warning
'comp
(format "fwprop pass jammed into %s?" (comp-func-name
f))))
(comp-log (format "Propagation run %d times\n" i) 2))
- (comp-rewrite-non-locals)
+ (comp--rewrite-non-locals)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2767,7 +2780,7 @@ Return t if something was changed."
;; the full compilation unit.
;; For this reason this is triggered only at native-comp-speed == 3.
-(defun comp-func-in-unit (func)
+(defun comp--func-in-unit (func)
"Given FUNC return the `comp-fun' definition in the current context.
FUNCTION can be a function-name or byte compiled function."
(if (symbolp func)
@@ -2775,11 +2788,11 @@ FUNCTION can be a function-name or byte compiled
function."
(cl-assert (byte-code-function-p func))
(gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt))))
-(defun comp-call-optim-form-call (callee args)
+(defun comp--call-optim-form-call (callee args)
(cl-flet ((fill-args (args total)
;; Fill missing args to reach TOTAL
(append args (cl-loop repeat (- total (length args))
- collect (make-comp-mvar :constant nil)))))
+ collect (make--comp-mvar :constant nil)))))
(when (and callee
(or (symbolp callee)
(gethash callee (comp-ctxt-byte-func-to-func-h comp-ctxt)))
@@ -2797,7 +2810,7 @@ FUNCTION can be a function-name or byte compiled
function."
;; actually cheaper since it avoids the call to the
;; intermediate native trampoline (bug#67005).
(subrp (subrp f))
- (comp-func-callee (comp-func-in-unit callee)))
+ (comp-func-callee (comp--func-in-unit callee)))
(cond
((and subrp (not (subr-native-elisp-p f)))
;; Trampoline removal.
@@ -2832,30 +2845,30 @@ FUNCTION can be a function-name or byte compiled
function."
((comp--type-hint-p callee)
`(call ,callee ,@args)))))))
-(defun comp-call-optim-func ()
+(defun comp--call-optim-func ()
"Perform the trampoline call optimization for the current function."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
- do (comp-loop-insn-in-block b
+ do (comp--loop-insn-in-block b
(pcase insn
(`(set ,lval (callref funcall ,f . ,rest))
(when-let ((ok (comp-cstr-imm-vld-p f))
- (new-form (comp-call-optim-form-call
+ (new-form (comp--call-optim-form-call
(comp-cstr-imm f) rest)))
(setf insn `(set ,lval ,new-form))))
(`(callref funcall ,f . ,rest)
(when-let ((ok (comp-cstr-imm-vld-p f))
- (new-form (comp-call-optim-form-call
+ (new-form (comp--call-optim-form-call
(comp-cstr-imm f) rest)))
(setf insn new-form)))))))
-(defun comp-call-optim (_)
+(defun comp--call-optim (_)
"Try to optimize out funcall trampoline usage when possible."
(maphash (lambda (_ f)
(when (and (>= (comp-func-speed f) 2)
(comp-func-l-p f))
(let ((comp-func f))
- (comp-call-optim-func))))
+ (comp--call-optim-func))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2866,16 +2879,16 @@ FUNCTION can be a function-name or byte compiled
function."
;;
;; This pass can be run as last optim.
-(defun comp-collect-mvar-ids (insn)
+(defun comp--collect-mvar-ids (insn)
"Collect the m-var unique identifiers into INSN."
(cl-loop for x in insn
if (consp x)
- append (comp-collect-mvar-ids x)
+ append (comp--collect-mvar-ids x)
else
when (comp-mvar-p x)
collect (comp-mvar-id x)))
-(defun comp-dead-assignments-func ()
+(defun comp--dead-assignments-func ()
"Clean-up dead assignments into current function.
Return the list of m-var ids nuked."
(let ((l-vals ())
@@ -2888,9 +2901,9 @@ Return the list of m-var ids nuked."
for (op arg0 . rest) = insn
if (comp--assign-op-p op)
do (push (comp-mvar-id arg0) l-vals)
- (setf r-vals (nconc (comp-collect-mvar-ids rest) r-vals))
+ (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals))
else
- do (setf r-vals (nconc (comp-collect-mvar-ids insn) r-vals))))
+ do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals))))
;; Every l-value appearing that does not appear as r-value has no right to
;; exist and gets nuked.
(let ((nuke-list (cl-set-difference l-vals r-vals)))
@@ -2902,7 +2915,7 @@ Return the list of m-var ids nuked."
3)
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
- do (comp-loop-insn-in-block b
+ do (comp--loop-insn-in-block b
(cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn
(when (and (comp--assign-op-p op)
(memq (comp-mvar-id arg0) nuke-list))
@@ -2913,7 +2926,7 @@ Return the list of m-var ids nuked."
insn))))))))
nuke-list)))
-(defun comp-dead-code ()
+(defun comp--dead-code ()
"Dead code elimination."
(maphash (lambda (_ f)
(when (and (>= (comp-func-speed f) 2)
@@ -2922,7 +2935,7 @@ Return the list of m-var ids nuked."
(cl-loop
for comp-func = f
for i from 1
- while (comp-dead-assignments-func)
+ while (comp--dead-assignments-func)
finally (comp-log (format "dead code rm run %d times\n" i) 2)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2930,14 +2943,14 @@ Return the list of m-var ids nuked."
;;; Tail Call Optimization pass specific code.
-(defun comp-form-tco-call-seq (args)
+(defun comp--form-tco-call-seq (args)
"Generate a TCO sequence for ARGS."
`(,@(cl-loop for arg in args
for i from 0
- collect `(set ,(make-comp-mvar :slot i) ,arg))
+ collect `(set ,(make--comp-mvar :slot i) ,arg))
(jump bb_0)))
-(defun comp-tco-func ()
+(defun comp--tco-func ()
"Try to pattern match and perform TCO within the current function."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
@@ -2950,20 +2963,20 @@ Return the list of m-var ids nuked."
(return ,ret-val))
(when (and (string= func (comp-func-c-name comp-func))
(eq l-val ret-val))
- (let ((tco-seq (comp-form-tco-call-seq args)))
+ (let ((tco-seq (comp--form-tco-call-seq args)))
(setf (car insns-seq) (car tco-seq)
(cdr insns-seq) (cdr tco-seq)
(comp-func-ssa-status comp-func) 'dirty)
(cl-return-from in-the-basic-block))))))))
-(defun comp-tco (_)
+(defun comp--tco (_)
"Simple peephole pass performing self TCO."
(maphash (lambda (_ f)
(when (and (>= (comp-func-speed f) 3)
(comp-func-l-p f)
(not (comp-func-has-non-local f)))
(let ((comp-func f))
- (comp-tco-func)
+ (comp--tco-func)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2973,29 +2986,62 @@ Return the list of m-var ids nuked."
;; This must run after all SSA prop not to have the type hint
;; information overwritten.
-(defun comp-remove-type-hints-func ()
+(defun comp--remove-type-hints-func ()
"Remove type hints from the current function.
These are substituted with a normal `set' op."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
- do (comp-loop-insn-in-block b
+ do (comp--loop-insn-in-block b
(pcase insn
(`(set ,l-val (call ,(pred comp--type-hint-p) ,r-val))
(setf insn `(set ,l-val ,r-val)))))))
-(defun comp-remove-type-hints (_)
+(defun comp--remove-type-hints (_)
"Dead code elimination."
(maphash (lambda (_ f)
(when (>= (comp-func-speed f) 2)
(let ((comp-func f))
- (comp-remove-type-hints-func)
+ (comp--remove-type-hints-func)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
+;;; Function types pass specific code.
+
+(defun comp--compute-function-type (_ func)
+ "Compute type specifier for `comp-func' FUNC.
+Set it into the `type' slot."
+ (when (and (comp-func-l-p func)
+ (comp-mvar-p (comp-func-type func)))
+ (let* ((comp-func (make-comp-func))
+ (res-mvar (apply #'comp-cstr-union
+ (make-comp-cstr)
+ (cl-loop
+ with res = nil
+ for bb being the hash-value in (comp-func-blocks
+ func)
+ do (cl-loop
+ for insn in (comp-block-insns bb)
+ ;; Collect over every exit point the returned
+ ;; mvars and union results.
+ do (pcase insn
+ (`(return ,mvar)
+ (push mvar res))))
+ finally return res)))
+ (type `(function ,(comp--args-to-lambda-list (comp-func-l-args
func))
+ ,(comp-cstr-to-type-spec res-mvar))))
+ (comp--add-const-to-relocs type)
+ ;; Fix it up.
+ (setf (comp-cstr-imm (comp-func-type func)) type))))
+
+(defun comp--compute-function-types (_)
+ "Compute and store the type specifier for all functions."
+ (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt)))
+
+
;;; Final pass specific code.
-(defun comp-args-to-lambda-list (args)
+(defun comp--args-to-lambda-list (args)
"Return a lambda list for ARGS."
(cl-loop
with res
@@ -3020,33 +3066,7 @@ These are substituted with a normal `set' op."
(push 't res))))
(cl-return (reverse res))))
-(defun comp-compute-function-type (_ func)
- "Compute type specifier for `comp-func' FUNC.
-Set it into the `type' slot."
- (when (and (comp-func-l-p func)
- (comp-mvar-p (comp-func-type func)))
- (let* ((comp-func (make-comp-func))
- (res-mvar (apply #'comp-cstr-union
- (make-comp-cstr)
- (cl-loop
- with res = nil
- for bb being the hash-value in (comp-func-blocks
- func)
- do (cl-loop
- for insn in (comp-block-insns bb)
- ;; Collect over every exit point the returned
- ;; mvars and union results.
- do (pcase insn
- (`(return ,mvar)
- (push mvar res))))
- finally return res)))
- (type `(function ,(comp-args-to-lambda-list (comp-func-l-args func))
- ,(comp-cstr-to-type-spec res-mvar))))
- (comp--add-const-to-relocs type)
- ;; Fix it up.
- (setf (comp-cstr-imm (comp-func-type func)) type))))
-
-(defun comp-finalize-container (cont)
+(defun comp--finalize-container (cont)
"Finalize data container CONT."
(setf (comp-data-container-l cont)
(cl-loop with h = (comp-data-container-idx cont)
@@ -3064,7 +3084,7 @@ Set it into the `type' slot."
'lambda-fixup
obj))))
-(defun comp-finalize-relocs ()
+(defun comp--finalize-relocs ()
"Finalize data containers for each relocation class.
Remove immediate duplicates within relocation classes.
Update all insn accordingly."
@@ -3080,7 +3100,7 @@ Update all insn accordingly."
(d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt))
(d-ephemeral-idx (comp-data-container-idx d-ephemeral)))
;; We never want compiled lambdas ending up in pure space. A copy must
- ;; be already present in impure (see `comp-emit-lambda-for-top-level').
+ ;; be already present in impure (see `comp--emit-lambda-for-top-level').
(cl-loop for obj being each hash-keys of d-default-idx
when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt))
do (cl-assert (gethash obj d-impure-idx))
@@ -3096,7 +3116,7 @@ Update all insn accordingly."
do (remhash obj d-ephemeral-idx))
;; Fix-up indexes in each relocation class and fill corresponding
;; reloc lists.
- (mapc #'comp-finalize-container (list d-default d-impure d-ephemeral))
+ (mapc #'comp--finalize-container (list d-default d-impure d-ephemeral))
;; Make a vector from the function documentation hash table.
(cl-loop with h = (comp-ctxt-function-docs comp-ctxt)
with v = (make-vector (hash-table-count h) nil)
@@ -3120,11 +3140,11 @@ Update all insn accordingly."
(comp-mvar-range mvar) (list (cons idx idx)))
(puthash idx t reverse-h))))
-(defun comp-compile-ctxt-to-file (name)
+(defun comp--compile-ctxt-to-file (name)
"Compile as native code the current context naming it NAME.
Prepare every function for final compilation and drive the C back-end."
(let ((dir (file-name-directory name)))
- (comp-finalize-relocs)
+ (comp--finalize-relocs)
(maphash (lambda (_ f)
(comp--log-func f 1))
(comp-ctxt-funcs-h comp-ctxt))
@@ -3132,12 +3152,12 @@ Prepare every function for final compilation and drive
the C back-end."
;; In case it's created in the meanwhile.
(ignore-error file-already-exists
(make-directory dir t)))
- (comp--compile-ctxt-to-file name)))
+ (comp--compile-ctxt-to-file0 name)))
-(defun comp-final1 ()
+(defun comp--final1 ()
(comp--init-ctxt)
(unwind-protect
- (comp-compile-ctxt-to-file (comp-ctxt-output comp-ctxt))
+ (comp--compile-ctxt-to-file (comp-ctxt-output comp-ctxt))
(comp--release-ctxt)))
(defvar comp-async-compilation nil
@@ -3146,17 +3166,16 @@ Prepare every function for final compilation and drive
the C back-end."
(defvar comp-running-batch-compilation nil
"Non-nil when compilation is driven by any `batch-*-compile' function.")
-(defun comp-final (_)
+(defun comp--final (_)
"Final pass driving the C back-end for code emission."
- (maphash #'comp-compute-function-type (comp-ctxt-funcs-h comp-ctxt))
(unless comp-dry-run
;; Always run the C side of the compilation as a sub-process
;; unless during bootstrap or async compilation (bug#45056). GCC
;; leaks memory but also interfere with the ability of Emacs to
;; detect when a sub-process completes (TODO understand why).
(if (or comp-running-batch-compilation comp-async-compilation)
- (comp-final1)
- ;; Call comp-final1 in a child process.
+ (comp--final1)
+ ;; Call comp--final1 in a child process.
(let* ((output (comp-ctxt-output comp-ctxt))
(print-escape-newlines t)
(print-length nil)
@@ -3178,7 +3197,7 @@ Prepare every function for final compilation and drive
the C back-end."
load-path ',load-path)
,native-comp-async-env-modifier-form
(message "Compiling %s..." ',output)
- (comp-final1)))
+ (comp--final1)))
(temp-file (make-temp-file
(concat "emacs-int-comp-"
(file-name-base output) "-")
@@ -3222,7 +3241,7 @@ Prepare every function for final compilation and drive
the C back-end."
;; Primitive function advice machinery
-(defun comp-make-lambda-list-from-subr (subr)
+(defun comp--make-lambda-list-from-subr (subr)
"Given SUBR return the equivalent lambda-list."
(pcase-let ((`(,min . ,max) (subr-arity subr))
(lambda-list '()))
@@ -3266,7 +3285,7 @@ Prepare every function for final compilation and drive
the C back-end."
;;;###autoload
(defun comp-trampoline-compile (subr-name)
"Synthesize compile and return a trampoline for SUBR-NAME."
- (let* ((lambda-list (comp-make-lambda-list-from-subr
+ (let* ((lambda-list (comp--make-lambda-list-from-subr
(symbol-function subr-name)))
;; The synthesized trampoline must expose the exact same ABI of
;; the primitive we are replacing in the function reloc table.
@@ -3310,6 +3329,7 @@ filename (including FILE)."
do (ignore-error file-error
(comp-delete-or-replace-file f))))))
+;; In use by comp.c.
(defun comp-delete-or-replace-file (oldfile &optional newfile)
"Replace OLDFILE with NEWFILE.
When NEWFILE is nil just delete OLDFILE.
@@ -3398,16 +3418,18 @@ the deferred compilation mechanism."
;; (if (and comp-async-compilation
;; (not (eq (car err) 'native-compiler-error)))
;; (progn
- ;; (message (if err-val
- ;; "%s: Error: %s %s"
- ;; "%s: Error %s")
+ ;; (message "%s: Error %s"
;; function-or-file
- ;; (get (car err) 'error-message)
- ;; (car-safe err-val))
+ ;; (error-message-string err))
;; (kill-emacs -1))
;; ;; Otherwise re-signal it adding the compilation input.
+ ;; ;; FIXME: We can't just insert arbitrary info in the
+ ;; ;; error-data part of an error: the handler may expect
+ ;; ;; specific data at specific positions!
;; (signal (car err) (if (consp err-val)
;; (cons function-or-file err-val)
+ ;; ;; FIXME: `err-val' is supposed to be
+ ;; ;; a list, so it can only be nil here!
;; (list function-or-file err-val)))))))
(if (stringp function-or-file)
data
@@ -3491,7 +3513,8 @@ last directory in `native-comp-eln-load-path')."
else
collect (byte-compile-file file))))
-(defun comp-write-bytecode-file (eln-file)
+;; In use by elisp-mode.el
+(defun comp--write-bytecode-file (eln-file)
"After native compilation write the bytecode file for ELN-FILE.
Make sure that eln file is younger than byte-compiled one and
return the filename of this last.
@@ -3528,7 +3551,7 @@ variable \"NATIVE_DISABLED\" is set, only byte compile."
(car (last native-comp-eln-load-path)))
(byte-to-native-output-buffer-file nil)
(eln-file (car (batch-native-compile))))
- (comp-write-bytecode-file eln-file)
+ (comp--write-bytecode-file eln-file)
(setq command-line-args-left (cdr command-line-args-left)))))
(defun native-compile-prune-cache ()
diff --git a/lisp/emacs-lisp/compat.el b/lisp/emacs-lisp/compat.el
new file mode 100644
index 00000000000..f7037dc4101
--- /dev/null
+++ b/lisp/emacs-lisp/compat.el
@@ -0,0 +1,92 @@
+;;; compat.el --- Stub of the Compatibility Library -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
+
+;; Author: \
+;; Philip Kaludercic <philipk@posteo.net>, \
+;; Daniel Mendler <mail@daniel-mendler.de>
+;; Maintainer: \
+;; Daniel Mendler <mail@daniel-mendler.de>, \
+;; Compat Development <~pkal/compat-devel@lists.sr.ht>,
+;; emacs-devel@gnu.org
+;; URL: https://github.com/emacs-compat/compat
+;; Keywords: lisp, maint
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The Compat package on ELPA provides forward-compatibility
+;; definitions for other packages. While mostly transparent, a
+;; minimal API is necessary whenever core definitions change calling
+;; conventions (e.g. `plist-get' can be invoked with a predicate from
+;; Emacs 29.1 onward). For core packages on ELPA to be able to take
+;; advantage of this functionality, the macros `compat-function' and
+;; `compat-call' have to be available in the core, usable even if
+;; users do not have the Compat package installed, which this file
+;; ensures.
+
+;; A basic introduction to Compat is given in the Info node `(elisp)
+;; Forwards Compatibility'. Further details on Compat are documented
+;; in the Info node `(compat) Top' (installed along with the Compat
+;; package) or read the same manual online:
+;; https://elpa.gnu.org/packages/doc/compat.html.
+
+;;; Code:
+
+(defmacro compat-function (fun)
+ "Return compatibility function symbol for FUN.
+This is a pseudo-compatibility stub for core packages on ELPA,
+that depend on the Compat package, whenever the user doesn't have
+the package installed on their current system."
+ `#',fun)
+
+(defmacro compat-call (fun &rest args)
+ "Call compatibility function or macro FUN with ARGS.
+This is a pseudo-compatibility stub for core packages on ELPA,
+that depend on the Compat package, whenever the user doesn't have
+the package installed on their current system."
+ (cons fun args))
+
+;;;; Clever trick to avoid installing Compat if not necessary
+
+;; The versioning scheme of the Compat package follows that of Emacs,
+;; to indicate the version of Emacs, that functionality is being
+;; provided for. For example, the Compat version number 29.2.3.9
+;; would attempt to provide compatibility definitions up to Emacs
+;; 29.2, while also designating that this is the third major release
+;; and ninth minor release of Compat, for the specific Emacs release.
+
+;; The package version of this file is specified programmatically,
+;; instead of giving a fixed version in the header of this file. This
+;; is done to ensure that the version of compat.el provided by Emacs
+;; always corresponds to the current version of Emacs. In addition to
+;; the major-minor version, a large "major release" makes sure that
+;; the built-in version of Compat is always preferred over an external
+;; installation. This means that if a package specifies a dependency
+;; on Compat which matches the current or an older version of Emacs
+;; that is being used, no additional dependencies have to be
+;; downloaded.
+;;
+;; Further details and background on this file can be found in the
+;; bug#66554 discussion.
+
+;;;###autoload (push (list 'compat
+;;;###autoload emacs-major-version
+;;;###autoload emacs-minor-version
+;;;###autoload 9999)
+;;;###autoload package--builtin-versions)
+
+(provide 'compat)
+;;; compat.el ends here
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index b7db2adde59..850cc2085f7 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -54,7 +54,7 @@
(defun disassemble (object &optional buffer indent interactive-p)
"Print disassembled code for OBJECT in (optional) BUFFER.
OBJECT can be a symbol defined as a function, or a function itself
-\(a lambda expression or a compiled-function object).
+\(a lambda expression or a byte-code-function object).
If OBJECT is not already compiled, we compile it, but do not
redefine OBJECT if it is a symbol."
(interactive
@@ -70,7 +70,7 @@ redefine OBJECT if it is a symbol."
(save-excursion
(if (or interactive-p (null buffer))
(with-output-to-temp-buffer "*Disassemble*"
- (set-buffer "*Disassemble*")
+ (set-buffer standard-output)
(let ((lexical-binding lb))
(disassemble-internal object indent (not interactive-p))))
(set-buffer buffer)
@@ -250,29 +250,22 @@ OBJ should be a call to BYTE-CODE generated by the byte
compiler."
;; if the succeeding op is byte-switch, display the jump table
;; used
(cond ((eq (car-safe (car-safe (cdr lap))) 'byte-switch)
- (insert (format "<jump-table-%s (" (hash-table-test
arg)))
- (let ((first-time t))
- (maphash #'(lambda (value tag)
- (if first-time
- (setq first-time nil)
- (insert " "))
- (insert (format "%s %s" value (cadr
tag))))
- arg))
- (insert ")>"))
- ;; if the value of the constant is compiled code, then
- ;; recursively disassemble it.
- ((or (byte-code-function-p arg)
- (and (consp arg) (functionp arg)
- (assq 'byte-code arg))
+ (insert (format "<jump-table-%s (" (hash-table-test
arg)))
+ (let ((first-time t))
+ (maphash #'(lambda (value tag)
+ (if first-time
+ (setq first-time nil)
+ (insert " "))
+ (insert (format "%s %s" value (cadr
tag))))
+ arg))
+ (insert ")>"))
+ ;; if the value of the constant is compiled code, then
+ ;; recursively disassemble it.
+ ((or (byte-code-function-p arg)
(and (eq (car-safe arg) 'macro)
- (or (byte-code-function-p (cdr arg))
- (and (consp (cdr arg))
- (functionp (cdr arg))
- (assq 'byte-code (cdr arg))))))
+ (byte-code-function-p (cdr arg))))
(cond ((byte-code-function-p arg)
(insert "<compiled-function>\n"))
- ((functionp arg)
- (insert "<compiled lambda>"))
(t (insert "<compiled macro>\n")))
(disassemble-internal
arg
@@ -285,7 +278,7 @@ OBJ should be a call to BYTE-CODE generated by the byte
compiler."
(+ indent disassemble-recursive-indent)))
((eq (car-safe (car-safe arg)) 'byte-code)
(insert "(<byte code>...)\n")
- (mapc ;recurse on list of byte-code objects
+ (mapc ;Recurse on list of byte-code objects.
(lambda (obj)
(disassemble-1
obj
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index fe9a9b0d9b6..d8668b800f3 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -132,7 +132,7 @@ it is disabled.")
(string-replace "'" "\\='" (format "%S" getter)))))
(let ((start (point)))
(insert argdoc)
- (when (fboundp 'fill-region)
+ (when (fboundp 'fill-region) ;Don't break bootstrap!
(fill-region start (point) 'left t))))
;; Finally, insert the keymap.
(when (and (boundp keymap-sym)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 4dbbeb69312..f2c8af0456c 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -481,7 +481,7 @@ just FUNCTION is printed."
(edebug--eval-defun #'eval-defun edebug-it)))
;;;###autoload
-(defalias 'edebug-defun 'edebug-eval-top-level-form)
+(defalias 'edebug-defun #'edebug-eval-top-level-form)
;;;###autoload
(defun edebug-eval-top-level-form ()
@@ -1734,7 +1734,7 @@ contains a circular object."
(defun edebug-match-form (cursor)
(list (edebug-form cursor)))
-(defalias 'edebug-match-place 'edebug-match-form)
+(defalias 'edebug-match-place #'edebug-match-form)
;; Currently identical to edebug-match-form.
;; This is for common lisp setf-style place arguments.
@@ -2282,12 +2282,7 @@ only be active while Edebug is. It checks
`debug-on-error' to see
whether it should call the debugger. When execution is resumed, the
error is signaled again."
(if (and (listp debug-on-error) (memq signal-name debug-on-error))
- (edebug 'error (cons signal-name signal-data)))
- ;; If we reach here without another non-local exit, then send signal again.
- ;; i.e. the signal is not continuable, yet.
- ;; Avoid infinite recursion.
- (let ((signal-hook-function nil))
- (signal signal-name signal-data)))
+ (edebug 'error (cons signal-name signal-data))))
;;; Entering Edebug
@@ -2331,6 +2326,12 @@ and run its entry function, and set up `edebug-before'
and
(debug-on-error (or debug-on-error edebug-on-error))
(debug-on-quit edebug-on-quit))
(unwind-protect
+ ;; FIXME: We could replace this `signal-hook-function' with
+ ;; a cleaner `handler-bind' but then we wouldn't be able to
+ ;; install it here (i.e. once and for all when entering
+ ;; an Edebugged function), but instead it would have to
+ ;; be installed into a modified `edebug-after' which wraps
+ ;; the `handler-bind' around its argument(s). :-(
(let ((signal-hook-function #'edebug-signal))
(setq edebug-execution-mode (or edebug-next-execution-mode
edebug-initial-mode
@@ -3353,7 +3354,7 @@ With prefix argument, make it a temporary breakpoint."
(message "%s" msg)))
-(defalias 'edebug-step-through-mode 'edebug-step-mode)
+(defalias 'edebug-step-through-mode #'edebug-step-mode)
(defun edebug-step-mode ()
"Proceed to next stop point."
@@ -3841,12 +3842,12 @@ be installed in `emacs-lisp-mode-map'.")
;; Global GUD bindings for all emacs-lisp-mode buffers.
(unless edebug-inhibit-emacs-lisp-mode-bindings
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" #'edebug-step-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" #'edebug-next-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" #'edebug-go-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" #'edebug-where)
;; The following isn't a GUD binding.
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" 'edebug-set-initial-mode))
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" #'edebug-set-initial-mode))
(defvar-keymap edebug-mode-map
:parent emacs-lisp-mode-map
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 9c526f67204..a2f7c4172a3 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -191,7 +191,7 @@ Abstract classes cannot be instantiated."
;; We autoload this because it's used in `make-autoload'.
;;;###autoload
-(defun eieio-defclass-autoload (cname _superclasses filename doc)
+(defun eieio-defclass-autoload (cname superclasses filename doc)
"Create autoload symbols for the EIEIO class CNAME.
SUPERCLASSES are the superclasses that CNAME inherits from.
DOC is the docstring for CNAME.
@@ -199,15 +199,9 @@ This function creates a mock-class for CNAME and adds it
into
SUPERCLASSES as children.
It creates an autoload function for CNAME's constructor."
;; Assume we've already debugged inputs.
-
- ;; We used to store the list of superclasses in the `parent' slot (as a list
- ;; of class names). But now this slot holds a list of class objects, and
- ;; those parents may not exist yet, so the corresponding class objects may
- ;; simply not exist yet. So instead we just don't store the list of parents
- ;; here in eieio-defclass-autoload at all, since it seems that they're just
- ;; not needed before the class is actually loaded.
(let* ((oldc (cl--find-class cname))
- (newc (eieio--class-make cname)))
+ (newc (eieio--class-make cname))
+ (parents (mapcar #'cl-find-class superclasses)))
(if (eieio--class-p oldc)
nil ;; Do nothing if we already have this class.
@@ -218,6 +212,12 @@ It creates an autoload function for CNAME's constructor."
use '%s or turn off `eieio-backward-compatibility' instead" cname)
"25.1"))
+ (when (memq nil parents)
+ ;; If some parents aren't yet fully defined, just ignore them for now.
+ (setq parents (delq nil parents)))
+ (unless parents
+ (setq parents (list (cl--find-class 'eieio-default-superclass))))
+ (setf (cl--class-parents newc) parents)
(setf (cl--find-class cname) newc)
;; Create an autoload on top of our constructor function.
@@ -293,8 +293,7 @@ See `defclass' for more information."
;; reloading the file that does the `defclass', we don't
;; want to create a new class object.
(eieio--class-make cname)))
- (groups nil) ;; list of groups id'd from slots
- (clearparent nil))
+ (groups nil)) ;; list of groups id'd from slots
;; If this class already existed, and we are updating its structure,
;; make sure we keep the old child list. This can cause bugs, but
@@ -317,6 +316,9 @@ See `defclass' for more information."
(setf (eieio--class-children newc) children)
(remhash cname eieio-defclass-autoload-map))))
+ (unless (or superclasses (eq cname 'eieio-default-superclass))
+ (setq superclasses '(eieio-default-superclass)))
+
(if superclasses
(progn
(dolist (p superclasses)
@@ -336,16 +338,13 @@ See `defclass' for more information."
(push c (eieio--class-parents newc))))))
;; Reverse the list of our parents so that they are prioritized in
;; the same order as specified in the code.
- (cl-callf nreverse (eieio--class-parents newc)))
- ;; If there is nothing to loop over, then inherit from the
- ;; default superclass.
- (unless (eq cname 'eieio-default-superclass)
- ;; adopt the default parent here, but clear it later...
- (setq clearparent t)
- ;; save new child in parent
- (cl-pushnew cname (eieio--class-children eieio-default-superclass))
- ;; save parent in child
- (setf (eieio--class-parents newc) (list eieio-default-superclass))))
+ (cl-callf nreverse (eieio--class-parents newc))
+ ;; Before adding new slots, let's add all the methods and classes
+ ;; in from the parent class.
+ (eieio-copy-parents-into-subclass newc))
+
+ (cl-assert (eq cname 'eieio-default-superclass))
+ (setf (eieio--class-parents newc) (list (cl--find-class 'record))))
;; turn this into a usable self-pointing symbol; FIXME: Why?
(when eieio-backward-compatibility
@@ -376,10 +375,6 @@ See `defclass' for more information."
cname)
"25.1")))
- ;; Before adding new slots, let's add all the methods and classes
- ;; in from the parent class.
- (eieio-copy-parents-into-subclass newc)
-
;; Store the new class vector definition into the symbol. We need to
;; do this first so that we can call defmethod for the accessor.
;; The vector will be updated by the following while loop and will not
@@ -512,10 +507,6 @@ See `defclass' for more information."
;; Set up the options we have collected.
(setf (eieio--class-options newc) options)
- ;; if this is a superclass, clear out parent (which was set to the
- ;; default superclass eieio-default-superclass)
- (if clearparent (setf (eieio--class-parents newc) nil))
-
;; Create the cached default object.
(let ((cache (make-record newc
(+ (length (eieio--class-slots newc))
@@ -967,19 +958,13 @@ need be... May remove that later...)"
(cdr tuple)
nil)))
-(defsubst eieio--class/struct-parents (class)
- (or (eieio--class-parents class)
- `(,eieio-default-superclass)))
-
(defun eieio--class-precedence-c3 (class)
"Return all parents of CLASS in c3 order."
- (let ((parents (eieio--class-parents class)))
+ (let ((parents (cl--class-parents class)))
(cons class
(merge-ordered-lists
(append
- (or
- (mapcar #'eieio--class-precedence-c3 parents)
- `((,eieio-default-superclass)))
+ (mapcar #'eieio--class-precedence-c3 parents)
(list parents))
(lambda (remaining-inputs)
(signal 'inconsistent-class-hierarchy
@@ -989,17 +974,15 @@ need be... May remove that later...)"
(defun eieio--class-precedence-dfs (class)
"Return all parents of CLASS in depth-first order."
- (let* ((parents (eieio--class-parents class))
+ (let* ((parents (cl--class-parents class))
(classes (copy-sequence
(apply #'append
(list class)
- (or
- (mapcar
- (lambda (parent)
- (cons parent
- (eieio--class-precedence-dfs parent)))
- parents)
- `((,eieio-default-superclass))))))
+ (mapcar
+ (lambda (parent)
+ (cons parent
+ (eieio--class-precedence-dfs parent)))
+ parents))))
(tail classes))
;; Remove duplicates.
(while tail
@@ -1012,13 +995,12 @@ need be... May remove that later...)"
(defun eieio--class-precedence-bfs (class)
"Return all parents of CLASS in breadth-first order."
(let* ((result)
- (queue (eieio--class/struct-parents class)))
+ (queue (cl--class-parents class)))
(while queue
(let ((head (pop queue)))
(unless (member head result)
(push head result)
- (unless (eq head eieio-default-superclass)
- (setq queue (append queue (eieio--class/struct-parents head)))))))
+ (setq queue (append queue (cl--class-parents head))))))
(cons class (nreverse result)))
)
@@ -1058,6 +1040,14 @@ method invocation orders of the involved classes."
;;;; General support to dispatch based on the type of the argument.
+;; FIXME: We could almost use the typeof-generalizer (i.e. the same as
+;; used for cl-structs), except that that generalizer doesn't support
+;; `:method-invocation-order' :-(
+
+(defun cl--generic-struct-tag (name &rest _)
+ ;; Use exactly the same code as for `typeof'.
+ `(if ,name (type-of ,name) 'null))
+
(cl-generic-define-generalizer eieio--generic-generalizer
;; Use the exact same tagcode as for cl-struct, so that methods
;; that dispatch on both kinds of objects get to share this
@@ -1066,8 +1056,7 @@ method invocation orders of the involved classes."
(lambda (tag &rest _)
(let ((class (cl--find-class tag)))
(and (eieio--class-p class)
- (mapcar #'eieio--class-name
- (eieio--class-precedence-list class))))))
+ (cl--class-allparents class)))))
(cl-defmethod cl-generic-generalizers :extra "class" (specializer)
"Support for dispatch on types defined by EIEIO's `defclass'."
@@ -1089,10 +1078,11 @@ method invocation orders of the involved classes."
;; Instead, we add a new "subclass" specializer.
(defun eieio--generic-subclass-specializers (tag &rest _)
- (when (eieio--class-p tag)
- (mapcar (lambda (class)
- `(subclass ,(eieio--class-name class)))
- (eieio--class-precedence-list tag))))
+ (when (cl--class-p tag)
+ (when (eieio--class-p tag)
+ (setq tag (eieio--full-class-object tag))) ;Autoload, if applicable.
+ (mapcar (lambda (class) `(subclass ,class))
+ (cl--class-allparents tag))))
(cl-generic-define-generalizer eieio--generic-subclass-generalizer
60 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name)))
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index df85a64baf3..74f5e21db7d 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -387,9 +387,9 @@ contents of field NAME is matched against PAT, or they can
be of
,@(mapcar (lambda (field)
(pcase-exhaustive field
(`(,name ,pat)
- `(app (pcase--flip eieio-oref ',name) ,pat))
+ `(app (eieio-oref _ ',name) ,pat))
((pred symbolp)
- `(app (pcase--flip eieio-oref ',field) ,field))))
+ `(app (eieio-oref _ ',field) ,field))))
fields)))
;;; Simple generators, and query functions. None of these would do
@@ -449,7 +449,12 @@ If EXTRA, include that in the string returned to represent
the symbol."
(defun eieio-class-parents (class)
;; FIXME: What does "(overload of variable)" mean here?
"Return parent classes to CLASS. (overload of variable)."
- (eieio--class-parents (eieio--full-class-object class)))
+ ;; (declare (obsolete cl--class-parents "30.1"))
+ (let ((parents (eieio--class-parents (eieio--full-class-object class))))
+ (if (and (null (cdr parents))
+ (eq (car parents) (cl--find-class 'eieio-default-superclass)))
+ nil
+ parents)))
(define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4")
@@ -497,7 +502,7 @@ If EXTRA, include that in the string returned to represent
the symbol."
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
(while (and child (not (eq child class)))
- (setq p (append p (eieio--class-parents child))
+ (setq p (append p (cl--class-parents child))
child (pop p)))
(if child t))))
@@ -680,8 +685,7 @@ If SLOT is unbound, do nothing."
(defclass eieio-default-superclass nil
nil
"Default parent class for classes with no specified parent class.
-Its slots are automatically adopted by classes with no specified parents.
-This class is not stored in the `parent' slot of a class vector."
+Its slots are automatically adopted by classes with no specified parents."
:abstract t)
(setq eieio-default-superclass (cl--find-class 'eieio-default-superclass))
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 912a7357ca7..24afd03fbe6 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -155,7 +155,7 @@ Remember to keep it a prime number to improve hash
performance.")
(defvar eldoc-message-commands
;; Don't define as `defconst' since it would then go to (read-only)
purespace.
- (make-vector eldoc-message-commands-table-size 0)
+ (obarray-make eldoc-message-commands-table-size)
"Commands after which it is appropriate to print in the echo area.
ElDoc does not try to print function arglists, etc., after just any command,
because some commands print their own messages in the echo area and these
@@ -191,7 +191,7 @@ It should receive the same arguments as `message'.")
When `eldoc-print-after-edit' is non-nil, ElDoc messages are only
printed after commands contained in this obarray."
- (let ((cmds (make-vector 31 0))
+ (let ((cmds (obarray-make 31))
(re (regexp-opt '("delete" "insert" "edit" "electric" "newline"))))
(mapatoms (lambda (s)
(and (commandp s)
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index a8bc4bdd1e0..27c169cc657 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -266,6 +266,7 @@ This environment can be passed to `macroexpand'."
(insert-file-contents file)
(let ((buffer-file-name file)
(max-lisp-eval-depth (max 1000 max-lisp-eval-depth)))
+ (hack-local-variables)
(with-syntax-table emacs-lisp-mode-syntax-table
(mapc 'elint-top-form (elint-update-env)))))
(elint-set-mode-line)
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 63f547ebeb8..411602ef166 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -60,6 +60,7 @@
ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\
+transient-define-\\(?:prefix\\|suffix\\|infix\\|argument\\)\\|\
menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)"
find-function-space-re
"\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)")
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index ad0525e24be..3475d944337 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1347,7 +1347,6 @@ Lisp function does not specify a special indentation."
(put 'condition-case 'lisp-indent-function 2)
(put 'handler-case 'lisp-indent-function 1) ;CL
(put 'unwind-protect 'lisp-indent-function 1)
-(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
(put 'closure 'lisp-indent-function 2)
(defun indent-sexp (&optional endpos)
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 5f152d3b509..581053f6304 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -183,7 +183,9 @@ expression, in which case we want to handle forms
differently."
(loaddefs-generate--shorten-autoload
`(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))))
- ((and expansion (memq car '(progn prog1)))
+ ;; Look inside `progn', and `eval-and-compile', since these
+ ;; are often used in the expansion of things like `pcase-defmacro'.
+ ((and expansion (memq car '(progn prog1 eval-and-compile)))
(let ((end (memq :autoload-end form)))
(when end ;Cut-off anything after the :autoload-end marker.
(setq form (copy-sequence form))
@@ -199,8 +201,7 @@ expression, in which case we want to handle forms
differently."
define-globalized-minor-mode defun defmacro
easy-mmode-define-minor-mode define-minor-mode
define-inline cl-defun cl-defmacro cl-defgeneric
- cl-defstruct pcase-defmacro iter-defun cl-iter-defun
- transient-define-prefix))
+ cl-defstruct pcase-defmacro iter-defun cl-iter-defun))
(macrop car)
(setq expand (let ((load-true-file-name file)
(load-file-name file))
@@ -216,13 +217,17 @@ expression, in which case we want to handle forms
differently."
define-globalized-minor-mode
easy-mmode-define-minor-mode define-minor-mode
cl-defun defun* cl-defmacro defmacro*
- define-overloadable-function))
+ define-overloadable-function
+ transient-define-prefix transient-define-suffix
+ transient-define-infix transient-define-argument))
(let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
(name (nth 1 form))
(args (pcase car
((or 'defun 'defmacro
'defun* 'defmacro* 'cl-defun 'cl-defmacro
- 'define-overloadable-function)
+ 'define-overloadable-function
+ 'transient-define-prefix 'transient-define-suffix
+ 'transient-define-infix 'transient-define-argument)
(nth 2 form))
('define-skeleton '(&optional str arg))
((or 'define-generic-mode 'define-derived-mode
@@ -244,7 +249,11 @@ expression, in which case we want to handle forms
differently."
define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode
- define-minor-mode))
+ define-minor-mode
+ transient-define-prefix
+ transient-define-suffix
+ transient-define-infix
+ transient-define-argument))
t)
(and (eq (car-safe (car body)) 'interactive)
;; List of modes or just t.
@@ -378,6 +387,7 @@ don't include."
(let ((defs nil)
(load-name (loaddefs-generate--file-load-name file main-outfile))
(compute-prefixes t)
+ read-symbol-shorthands
local-outfile inhibit-autoloads)
(with-temp-buffer
(insert-file-contents file)
@@ -399,7 +409,22 @@ don't include."
(setq inhibit-autoloads (read (current-buffer)))))
(save-excursion
(when (re-search-forward "autoload-compute-prefixes: *" nil t)
- (setq compute-prefixes (read (current-buffer))))))
+ (setq compute-prefixes (read (current-buffer)))))
+ (save-excursion
+ ;; Since we're "open-coding", we have to repeat more
+ ;; complicated logic in `hack-local-variables'.
+ (when-let ((beg
+ (re-search-forward "read-symbol-shorthands: *" nil t)))
+ ;; `read-symbol-shorthands' alist ends with two parens.
+ (let* ((end (re-search-forward ")[;\n\s]*)"))
+ (commentless (replace-regexp-in-string
+ "\n\\s-*;+" ""
+ (buffer-substring beg end)))
+ (unsorted-shorthands (car (read-from-string commentless))))
+ (setq read-symbol-shorthands
+ (sort unsorted-shorthands
+ (lambda (sh1 sh2)
+ (> (length (car sh1)) (length (car sh2))))))))))
;; We always return the package version (even for pre-dumped
;; files).
@@ -473,27 +498,35 @@ don't include."
(when (and autoload-compute-prefixes
compute-prefixes)
- (when-let ((form (loaddefs-generate--compute-prefixes load-name)))
- ;; This output needs to always go in the main loaddefs.el,
- ;; regardless of `generated-autoload-file'.
- (push (list main-outfile file form) defs)))))
+ (with-demoted-errors "%S"
+ (when-let
+ ((form (loaddefs-generate--compute-prefixes load-name)))
+ ;; This output needs to always go in the main loaddefs.el,
+ ;; regardless of `generated-autoload-file'.
+ (push (list main-outfile file form) defs))))))
defs))
(defun loaddefs-generate--compute-prefixes (load-name)
(goto-char (point-min))
- (let ((prefs nil))
+ (let ((prefs nil)
+ (temp-obarray (obarray-make)))
;; Avoid (defvar <foo>) by requiring a trailing space.
(while (re-search-forward
"^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
(unless (member (match-string 1) autoload-ignored-definitions)
- (let ((name (match-string-no-properties 2)))
- (when (save-excursion
- (goto-char (match-beginning 0))
- (or (bobp)
- (progn
- (forward-line -1)
- (not (looking-at ";;;###autoload")))))
- (push name prefs)))))
+ (let* ((name (match-string-no-properties 2))
+ ;; Consider `read-symbol-shorthands'.
+ (probe (let ((obarray temp-obarray))
+ (car (read-from-string name)))))
+ (when (symbolp probe)
+ (setq name (symbol-name probe))
+ (when (save-excursion
+ (goto-char (match-beginning 0))
+ (or (bobp)
+ (progn
+ (forward-line -1)
+ (not (looking-at ";;;###autoload")))))
+ (push name prefs))))))
(loaddefs-generate--make-prefixes prefs load-name)))
(defun loaddefs-generate--rubric (file &optional type feature compile)
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index ffbb29615da..d3d71a36ee4 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -608,18 +608,30 @@ This allows using default values for `map-elt', which
can't be
done using `pcase--flip'.
KEY is the key sought in the map. DEFAULT is the default value."
+ ;; It's obsolete in Emacs>29, but `map.el' is distributed via GNU ELPA
+ ;; for earlier Emacsen.
+ (declare (obsolete _ "30.1"))
`(map-elt ,map ,key ,default))
(defun map--make-pcase-bindings (args)
"Return a list of pcase bindings from ARGS to the elements of a map."
- (mapcar (lambda (elt)
- (cond ((consp elt)
- `(app (map--pcase-map-elt ,(car elt) ,(caddr elt))
- ,(cadr elt)))
- ((keywordp elt)
- (let ((var (intern (substring (symbol-name elt) 1))))
- `(app (pcase--flip map-elt ,elt) ,var)))
- (t `(app (pcase--flip map-elt ',elt) ,elt))))
+ (mapcar (if (< emacs-major-version 30)
+ (lambda (elt)
+ (cond ((consp elt)
+ `(app (map--pcase-map-elt ,(car elt) ,(caddr elt))
+ ,(cadr elt)))
+ ((keywordp elt)
+ (let ((var (intern (substring (symbol-name elt) 1))))
+ `(app (pcase--flip map-elt ,elt) ,var)))
+ (t `(app (pcase--flip map-elt ',elt) ,elt))))
+ (lambda (elt)
+ (cond ((consp elt)
+ `(app (map-elt _ ,(car elt) ,(caddr elt))
+ ,(cadr elt)))
+ ((keywordp elt)
+ (let ((var (intern (substring (symbol-name elt) 1))))
+ `(app (map-elt _ ,elt) ,var)))
+ (t `(app (map-elt _ ',elt) ,elt)))))
args))
(defun map--make-pcase-patterns (args)
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 26cd8594dfc..977d5735171 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -139,12 +139,15 @@
(:include cl--class)
(:copier nil))
"Metaclass for OClosure classes."
+ ;; The `allparents' slot is used for the predicate that checks if a given
+ ;; object is an OClosure of a particular type.
(allparents nil :read-only t :type (list-of symbol)))
(setf (cl--find-class 'oclosure)
(oclosure--class-make 'oclosure
- "The root parent of all OClosure classes"
- nil nil '(oclosure)))
+ "The root parent of all OClosure types"
+ nil (list (cl--find-class 'function))
+ '(oclosure)))
(defun oclosure--p (oclosure)
(not (not (oclosure-type oclosure))))
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index db0cc515e46..ef056c7909b 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -501,8 +501,10 @@ This includes downloading missing dependencies, generating
autoloads, generating a package description file (used to
identify a package as a VC package later on), building
documentation and marking the package as installed."
- (let ((pkg-spec (package-vc--desc->spec pkg-desc))
- missing)
+ (let* ((pkg-spec (package-vc--desc->spec pkg-desc))
+ (lisp-dir (plist-get pkg-spec :lisp-dir))
+ (lisp-path (file-name-concat pkg-dir lisp-dir))
+ missing)
;; In case the package was installed directly from source, the
;; dependency list wasn't know beforehand, and they might have
@@ -519,7 +521,7 @@ documentation and marking the package as installed."
"\\|")
regexp-unmatchable))
(deps '()))
- (dolist (file (directory-files pkg-dir t "\\.el\\'" t))
+ (dolist (file (directory-files lisp-path t "\\.el\\'" t))
(unless (string-match-p ignored-files file)
(with-temp-buffer
(insert-file-contents file)
@@ -532,6 +534,7 @@ documentation and marking the package as installed."
(setq deps))))))
(dolist (dep deps)
(cl-callf version-to-list (cadr dep)))
+ (setf (package-desc-reqs pkg-desc) deps)
(setf missing (package-vc-install-dependencies (delete-dups deps)))
(setf missing (delq (assq (package-desc-name pkg-desc)
missing)
@@ -541,10 +544,8 @@ documentation and marking the package as installed."
(pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir)))
;; Generate autoloads
(let* ((name (package-desc-name pkg-desc))
- (auto-name (format "%s-autoloads.el" name))
- (lisp-dir (plist-get pkg-spec :lisp-dir)))
- (package-generate-autoloads
- name (file-name-concat pkg-dir lisp-dir))
+ (auto-name (format "%s-autoloads.el" name)))
+ (package-generate-autoloads name lisp-path)
(when lisp-dir
(write-region
(with-temp-buffer
@@ -938,8 +939,8 @@ for the last released version of the package."
(interactive
(let* ((name (package-vc--read-package-name "Fetch package source: ")))
(list (cadr (assoc name package-archive-contents #'string=))
- (read-file-name "Clone into new or empty directory: " nil nil t nil
- (lambda (dir) (or (not (file-exists-p dir))
+ (read-directory-name "Clone into new or empty directory: " nil nil
+ (lambda (dir) (or (not (file-exists-p dir))
(directory-empty-p dir))))
(and current-prefix-arg :last-release))))
(package-vc--archives-initialize)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 868373f46c2..fe7b10f569a 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2610,7 +2610,8 @@ This is meant to be used only in the case the
byte-compiled files
are invalid due to changed byte-code, macros or the like."
(interactive)
(pcase-dolist (`(_ ,pkg-desc) package-alist)
- (package-recompile pkg-desc)))
+ (with-demoted-errors "Error while recompiling: %S"
+ (package-recompile pkg-desc))))
;;;###autoload
(defun package-autoremove ()
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 0eb0ac84147..c2fe1233b3e 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -131,6 +131,8 @@ FUN in `pred' and `app' can take one of the forms:
call it with one argument
(F ARG1 .. ARGn)
call F with ARG1..ARGn and EXPVAL as n+1'th argument
+ (F ARG1 .. _ .. ARGn)
+ call F, passing EXPVAL at the _ position.
FUN, BOOLEXP, and subsequent PAT can refer to variables
bound earlier in the pattern by a SYMBOL pattern.
@@ -163,8 +165,12 @@ Emacs Lisp manual for more information and examples."
;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
-(declare-function help-fns--signature "help-fns"
- (function doc real-def real-function buffer))
+(defconst pcase--find-macro-def-regexp "(pcase-defmacro[\s\t\n]+%s[\s\t\n]*(")
+
+(with-eval-after-load 'find-func
+ (defvar find-function-regexp-alist)
+ (add-to-list 'find-function-regexp-alist
+ `(pcase-macro . pcase--find-macro-def-regexp)))
;; FIXME: Obviously, this will collide with nadvice's use of
;; function-documentation if we happen to advise `pcase'.
@@ -174,9 +180,10 @@ Emacs Lisp manual for more information and examples."
(defun pcase--make-docstring ()
(let* ((main (documentation (symbol-function 'pcase) 'raw))
(ud (help-split-fundoc main 'pcase)))
- ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works,
- ;; where cl-lib is anything using pcase-defmacro.
(require 'help-fns)
+ (declare-function help-fns-short-filename "help-fns" (filename))
+ (declare-function help-fns--signature "help-fns"
+ (function doc real-def real-function buffer))
(with-temp-buffer
(insert (or (cdr ud) main))
;; Presentation Note: For conceptual continuity, we guarantee
@@ -197,11 +204,20 @@ Emacs Lisp manual for more information and examples."
(let* ((pair (pop more))
(symbol (car pair))
(me (cdr pair))
- (doc (documentation me 'raw)))
+ (doc (documentation me 'raw))
+ (filename (find-lisp-object-file-name me 'defun)))
(insert "\n\n-- ")
(setq doc (help-fns--signature symbol doc me
(indirect-function me)
nil))
+ (when filename
+ (save-excursion
+ (forward-char -1)
+ (insert (format-message " in `"))
+ (help-insert-xref-button (help-fns-short-filename filename)
+ 'help-function-def symbol filename
+ 'pcase-macro)
+ (insert (format-message "'."))))
(insert "\n" (or doc "Not documented.")))))
(let ((combined-doc (buffer-string)))
(if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
@@ -269,8 +285,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN
EXP), but the
EXP in each binding in BINDINGS can use the results of the destructuring
bindings that precede it in BINDINGS' order.
-Each EXP should match (i.e. be of compatible structure) to its
-respective PATTERN; a mismatch may signal an error or may go
+Each EXP should match its respective PATTERN (i.e. be of structure
+compatible to PATTERN); a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil."
(declare (indent 1)
(debug ((&rest (pcase-PAT &optional form)) body)))
@@ -291,8 +307,8 @@ All EXPs are evaluated first, and then used to perform
destructuring
bindings by matching each EXP against its respective PATTERN. Then
BODY is evaluated with those bindings in effect.
-Each EXP should match (i.e. be of compatible structure) to its
-respective PATTERN; a mismatch may signal an error or may go
+Each EXP should match its respective PATTERN (i.e. be of structure
+compatible to PATTERN); a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil."
(declare (indent 1) (debug pcase-let*))
(if (null (cdr bindings))
@@ -800,10 +816,10 @@ A and B can be one of:
#'compiled-function-p))))
(pcase--mutually-exclusive-p (cadr upat) otherpred))
'(:pcase--fail . nil))
- ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c))))
+ ;; Since we turn (or 'a 'b 'c) into (pred (memq _ '(a b c)))
;; try and preserve the info we get from that memq test.
- ((and (eq 'pcase--flip (car-safe (cadr upat)))
- (memq (cadr (cadr upat)) '(memq member memql))
+ ((and (memq (car-safe (cadr upat)) '(memq member memql))
+ (eq (cadr (cadr upat)) '_)
(eq 'quote (car-safe (nth 2 (cadr upat))))
(eq 'quote (car-safe pat)))
(let ((set (cadr (nth 2 (cadr upat)))))
@@ -851,7 +867,7 @@ A and B can be one of:
(defmacro pcase--flip (fun arg1 arg2)
"Helper function, used internally to avoid (funcall (lambda ...) ...)."
- (declare (debug (sexp body)))
+ (declare (debug (sexp body)) (obsolete _ "30.1"))
`(,fun ,arg2 ,arg1))
(defun pcase--funcall (fun arg vars)
@@ -872,9 +888,13 @@ A and B can be one of:
(let ((newsym (gensym "x")))
(push (list newsym arg) env)
(setq arg newsym)))
- (if (or (functionp fun) (not (consp fun)))
- `(funcall #',fun ,arg)
- `(,@fun ,arg)))))
+ (cond
+ ((or (functionp fun) (not (consp fun)))
+ `(funcall #',fun ,arg))
+ ((memq '_ fun)
+ (mapcar (lambda (x) (if (eq '_ x) arg x)) fun))
+ (t
+ `(,@fun ,arg))))))
(if (null env)
call
;; Let's not replace `vars' in `fun' since it's
@@ -935,7 +955,7 @@ Otherwise, it defers to REST which is a list of branches of
the form
;; Yes, we can use `memql' (or `member')!
((> (length simples) 1)
(pcase--u1 (cons `(match ,var
- . (pred (pcase--flip ,mem-fun ',simples)))
+ . (pred (,mem-fun _ ',simples)))
(cdr matches))
code vars
(if (null others) rest
@@ -1082,12 +1102,13 @@ The predicate is the logical-AND of:
(declare (debug (pcase-QPAT)))
(cond
((eq (car-safe qpat) '\,) (cadr qpat))
+ ((eq (car-safe qpat) '\,@) (error "Unsupported QPAT: %S" qpat))
((vectorp qpat)
`(and (pred vectorp)
(app length ,(length qpat))
,@(let ((upats nil))
(dotimes (i (length qpat))
- (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i)))
+ (push `(app (aref _ ,i) ,(list '\` (aref qpat i)))
upats))
(nreverse upats))))
((consp qpat)
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 4c6553972c2..20077db9e60 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -619,12 +619,12 @@ SEQUENCE must be a sequence of numbers or markers."
(unless rest-marker
(pcase name
(`&rest
- (progn (push `(app (pcase--flip seq-drop ,index)
+ (progn (push `(app (seq-drop _ ,index)
,(seq--elt-safe args (1+ index)))
bindings)
(setq rest-marker t)))
(_
- (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings))))
+ (push `(app (seq--elt-safe _ ,index) ,name) bindings))))
(setq index (1+ index)))
bindings))
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index a6a49c72f74..cbb5618ffce 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -50,6 +50,17 @@
'((t :inherit variable-pitch))
"Face used for a section.")
+;;;###autoload
+(defun shortdoc--check (group functions)
+ (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval*
+ :result :result-string :eg-result :eg-result-string
:doc)))
+ (dolist (f functions)
+ (when (consp f)
+ (dolist (x f)
+ (when (and (keywordp x) (not (memq x keywords)))
+ (error "Shortdoc %s function `%s': bad keyword `%s'"
+ group (car f) x)))))))
+
;;;###autoload
(progn
(defvar shortdoc--groups nil)
@@ -118,6 +129,7 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
`:no-eval*', `:result', `:result-string', `:eg-result' and
`:eg-result-string' properties."
(declare (indent defun))
+ (shortdoc--check group functions)
`(progn
(setq shortdoc--groups (delq (assq ',group shortdoc--groups)
shortdoc--groups))
@@ -715,7 +727,7 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eval (plist-get '(a 1 b 2 c 3) 'b))
(plist-put
:no-eval (setq plist (plist-put plist 'd 4))
- :eq-result (a 1 b 2 c 3 d 4))
+ :eg-result (a 1 b 2 c 3 d 4))
(plist-member
:eval (plist-member '(a 1 b 2 c 3) 'b))
"Data About Lists"
@@ -735,9 +747,13 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
(intern
:eval (intern "abc"))
(intern-soft
+ :eval (intern-soft "list")
:eval (intern-soft "Phooey!"))
(make-symbol
:eval (make-symbol "abc"))
+ (gensym
+ :no-eval (gensym)
+ :eg-result g37)
"Comparing symbols"
(eq
:eval (eq 'abc 'abc)
@@ -748,7 +764,20 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eval (equal 'abc 'abc))
"Name"
(symbol-name
- :eval (symbol-name 'abc)))
+ :eval (symbol-name 'abc))
+ "Obarrays"
+ (obarray-make
+ :eval (obarray-make))
+ (obarrayp
+ :eval (obarrayp (obarray-make))
+ :eval (obarrayp nil))
+ (unintern
+ :no-eval (unintern "abc" my-obarray)
+ :eg-result t)
+ (mapatoms
+ :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray))
+ (obarray-clear
+ :no-eval (obarray-clear my-obarray)))
(define-short-documentation-group comparison
"General-purpose"
diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el
index 6348aaccf93..379fb0baec9 100644
--- a/lisp/emacs-lisp/shorthands.el
+++ b/lisp/emacs-lisp/shorthands.el
@@ -52,38 +52,26 @@
:version "28.1"
:group 'font-lock-faces)
-(defun shorthands--mismatch-from-end (str1 str2)
- "Tell index of first mismatch in STR1 and STR2, from end.
-The index is a valid 0-based index on STR1. Returns nil if STR1
-equals STR2. Return 0 if STR1 is a suffix of STR2."
- (cl-loop with l1 = (length str1) with l2 = (length str2)
- for i from 1
- for i1 = (- l1 i) for i2 = (- l2 i)
- while (eq (aref str1 i1) (aref str2 i2))
- if (zerop i2) return (if (zerop i1) nil i1)
- if (zerop i1) return 0
- finally (return i1)))
-
(defun shorthands-font-lock-shorthands (limit)
+ "Font lock until LIMIT considering `read-symbol-shorthands'."
(when read-symbol-shorthands
(while (re-search-forward
(concat "\\_<\\(" (rx lisp-mode-symbol) "\\)\\_>")
limit t)
(let* ((existing (get-text-property (match-beginning 1) 'face))
+ (print-name (match-string 1))
(probe (and (not (memq existing '(font-lock-comment-face
font-lock-string-face)))
- (intern-soft (match-string 1))))
- (sname (and probe (symbol-name probe)))
- (mismatch (and sname (shorthands--mismatch-from-end
- (match-string 1) sname)))
- (guess (and mismatch (1+ mismatch))))
- (when guess
- (when (and (< guess (1- (length (match-string 1))))
- ;; In bug#67390 we allow other separators
- (eq (char-syntax (aref (match-string 1) guess)) ?_))
- (setq guess (1+ guess)))
+ (intern-soft print-name)))
+ (symbol-name (and probe (symbol-name probe)))
+ (prefix (and symbol-name
+ (not (string-equal print-name symbol-name))
+ (car (assoc print-name
+ read-symbol-shorthands
+ #'string-prefix-p)))))
+ (when prefix
(add-face-text-property (match-beginning 1)
- (+ (match-beginning 1) guess)
+ (+ (match-beginning 1) (length prefix))
'elisp-shorthand-font-lock-face))))))
(font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands))
t)
diff --git a/lisp/emacs-lisp/tabulated-list.el
b/lisp/emacs-lisp/tabulated-list.el
index 9884a2fc24b..c86e3f9c5df 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -139,6 +139,21 @@ If `tabulated-list-entries' is a function, it is called
with no
arguments and must return a list of the above form.")
(put 'tabulated-list-entries 'permanent-local t)
+(defvar-local tabulated-list-groups nil
+ "Groups displayed in the current Tabulated List buffer.
+This should be either a function, or a list.
+If a list, each element has the form (GROUP-NAME ENTRIES),
+where:
+
+ - GROUP-NAME is a group name as a string, which is displayed
+ at the top line of each group.
+
+ - ENTRIES is a list described in `tabulated-list-entries'.
+
+If `tabulated-list-groups' is a function, it is called with no
+arguments and must return a list of the above form.")
+(put 'tabulated-list-groups 'permanent-local t)
+
(defvar-local tabulated-list-padding 0
"Number of characters preceding each Tabulated List mode entry.
By default, lines are padded with spaces, but you can use the
@@ -362,15 +377,17 @@ Do nothing if `tabulated-list--header-string' is nil."
(if tabulated-list--header-overlay
(move-overlay tabulated-list--header-overlay (point-min) (point))
(setq-local tabulated-list--header-overlay
- (make-overlay (point-min) (point))))
- (overlay-put tabulated-list--header-overlay
- 'face 'tabulated-list-fake-header))))
+ (make-overlay (point-min) (point)))
+ (overlay-put tabulated-list--header-overlay 'fake-header t)
+ (overlay-put tabulated-list--header-overlay
+ 'face 'tabulated-list-fake-header)))))
(defsubst tabulated-list-header-overlay-p (&optional pos)
"Return non-nil if there is a fake header.
Optional arg POS is a buffer position where to look for a fake header;
defaults to `point-min'."
- (overlays-at (or pos (point-min))))
+ (seq-find (lambda (o) (overlay-get o 'fake-header))
+ (overlays-at (or pos (point-min)))))
(defun tabulated-list-revert (&rest _ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
@@ -427,6 +444,9 @@ This sorts the `tabulated-list-entries' list if sorting is
specified by `tabulated-list-sort-key'. It then erases the
buffer and inserts the entries with `tabulated-list-printer'.
+If `tabulated-list-groups' is non-nil, each group of entries
+is printed and sorted separately.
+
Optional argument REMEMBER-POS, if non-nil, means to move point
to the entry with the same ID element as the current line.
@@ -437,6 +457,9 @@ be removed from entries that haven't changed (see
`tabulated-list-put-tag'). Don't use this immediately after
changing `tabulated-list-sort-key'."
(let ((inhibit-read-only t)
+ (groups (if (functionp tabulated-list-groups)
+ (funcall tabulated-list-groups)
+ tabulated-list-groups))
(entries (if (functionp tabulated-list-entries)
(funcall tabulated-list-entries)
tabulated-list-entries))
@@ -447,7 +470,14 @@ changing `tabulated-list-sort-key'."
(setq saved-col (current-column)))
;; Sort the entries, if necessary.
(when sorter
- (setq entries (sort entries sorter)))
+ (if groups
+ (setq groups
+ (mapcar (lambda (group)
+ (cons (car group) (sort (cdr group) sorter)))
+ groups))
+ (setq entries (sort entries sorter))))
+ (unless (functionp tabulated-list-groups)
+ (setq tabulated-list-groups groups))
(unless (functionp tabulated-list-entries)
(setq tabulated-list-entries entries))
;; Without a sorter, we have no way to just update.
@@ -459,6 +489,25 @@ changing `tabulated-list-sort-key'."
(unless tabulated-list-use-header-line
(tabulated-list-print-fake-header)))
;; Finally, print the resulting list.
+ (if groups
+ (dolist (group groups)
+ (insert (car group) ?\n)
+ (when-let ((saved-pt-new (tabulated-list-print-entries
+ (cdr group) sorter update entry-id)))
+ (setq saved-pt saved-pt-new)))
+ (setq saved-pt (tabulated-list-print-entries
+ entries sorter update entry-id)))
+ (when update
+ (delete-region (point) (point-max)))
+ (set-buffer-modified-p nil)
+ ;; If REMEMBER-POS was specified, move to the "old" location.
+ (if saved-pt
+ (progn (goto-char saved-pt)
+ (move-to-column saved-col))
+ (goto-char (point-min)))))
+
+(defun tabulated-list-print-entries (entries sorter update entry-id)
+ (let (saved-pt)
(while entries
(let* ((elt (car entries))
(tabulated-list--near-rows
@@ -495,14 +544,7 @@ changing `tabulated-list-sort-key'."
(forward-line 1)
(delete-region old (point))))))
(setq entries (cdr entries)))
- (when update
- (delete-region (point) (point-max)))
- (set-buffer-modified-p nil)
- ;; If REMEMBER-POS was specified, move to the "old" location.
- (if saved-pt
- (progn (goto-char saved-pt)
- (move-to-column saved-col))
- (goto-char (point-min)))))
+ saved-pt))
(defun tabulated-list-print-entry (id cols)
"Insert a Tabulated List entry at point.
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 29775e77716..1ed1528c6d5 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -193,7 +193,7 @@ LEVEL is the trace level, VALUE value returned by FUNCTION."
;; Do this so we'll see strings:
(cl-prin1-to-string value)
ctx)))))
-
+
(defvar trace--timer nil)
(defun trace--display-buffer (buf)
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 83fcdf89375..287292a24dc 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -388,7 +388,6 @@ widget."
idl-mode
perl-mode
- cperl-mode
javascript-mode
tcl-mode
python-mode
diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el
index c3c11bb0b0b..13840da0bd9 100644
--- a/lisp/epa-ks.el
+++ b/lisp/epa-ks.el
@@ -47,11 +47,8 @@ This is used by `epa-search-keys', for looking up public
keys."
(repeat :tag "Random pool"
(string :tag "Keyserver address"))
(const "keyring.debian.org")
- (const "keys.gnupg.net")
(const "keyserver.ubuntu.com")
(const "pgp.mit.edu")
- (const "pool.sks-keyservers.net")
- (const "zimmermann.mayfirst.org")
(string :tag "Custom keyserver"))
:version "28.1")
diff --git a/lisp/epa.el b/lisp/epa.el
index 53da3bf6cce..c29df18bb58 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -73,6 +73,17 @@ The command `epa-mail-encrypt' uses this."
:group 'epa
:version "24.4")
+(defcustom epa-keys-select-method 'buffer
+ "Method used to select keys in `epa-select-keys'.
+If the value is \\='buffer, the default, keys are selected via a
+pop-up buffer. If the value is \\='minibuffer, keys are selected
+via the minibuffer instead, using `completing-read-multiple'.
+Any other value is treated as \\='buffer."
+ :type '(choice (const :tag "Read keys from a pop-up buffer" buffer)
+ (const :tag "Read keys from minibuffer" minibuffer))
+ :group 'epa
+ :version "30.1")
+
;;; Faces
(defgroup epa-faces nil
@@ -450,6 +461,25 @@ q trust status questionable. - trust status unspecified.
(epa--marked-keys))
(kill-buffer epa-keys-buffer)))))
+(defun epa--select-keys-in-minibuffer (prompt keys)
+ (let* ((prompt (pcase-let ((`(,first ,second ,third)
+ (string-split prompt "\\."))
+ (hint "(separated by comma)"))
+ (if third
+ (format "%s %s. %s: " first hint second)
+ (format "%s %s: " first hint))))
+ (keys-alist
+ (seq-map
+ (lambda (key)
+ (cons (substring-no-properties
+ (epa--button-key-text key))
+ key))
+ keys))
+ (selected-keys (completing-read-multiple prompt keys-alist)))
+ (seq-map
+ (lambda (key) (cdr (assoc key keys-alist)))
+ selected-keys)))
+
;;;###autoload
(defun epa-select-keys (context prompt &optional names secret)
"Display a user's keyring and ask him to select keys.
@@ -459,7 +489,9 @@ NAMES is a list of strings to be matched with keys. If it
is nil, all
the keys are listed.
If SECRET is non-nil, list secret keys instead of public keys."
(let ((keys (epg-list-keys context names secret)))
- (epa--select-keys prompt keys)))
+ (pcase epa-keys-select-method
+ ('minibuffer (epa--select-keys-in-minibuffer prompt keys))
+ (_ (epa--select-keys prompt keys)))))
;;;; Key Details
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 9f00464f93d..3745d596fe7 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -158,7 +158,6 @@
(declare-function erc-parse-user "erc" (string))
(declare-function erc-process-away "erc" (proc away-p))
(declare-function erc-process-ctcp-query "erc" (proc parsed nick login host))
-(declare-function erc-query-buffer-p "erc" (&optional buffer))
(declare-function erc-remove-channel-member "erc" (channel nick))
(declare-function erc-remove-channel-users "erc" nil)
(declare-function erc-remove-user "erc" (nick))
@@ -254,6 +253,11 @@ Entries are of the form:
or
(PARAMETER) if no value is provided.
+where PARAMETER is a string and VALUE is a string or nil. For
+compatibility, a raw parameter of the form \"FOO=\" becomes
+(\"FOO\" . \"\") even though it's equivalent to the preferred
+canonical form \"FOO\" and its lisp representation (\"FOO\").
+
Some examples of possible parameters sent by servers:
CHANMODES=b,k,l,imnpst - list of supported channel modes
CHANNELLEN=50 - maximum length of channel names
@@ -273,7 +277,8 @@ WALLCHOPS - supports sending messages to all operators in a
channel")
(defvar-local erc--isupport-params nil
"Hash map of \"ISUPPORT\" params.
Keys are symbols. Values are lists of zero or more strings with hex
-escapes removed.")
+escapes removed. ERC normalizes incoming parameters of the form
+\"FOO=\" to (FOO).")
;;; Server and connection state
@@ -1474,10 +1479,12 @@ for decoding."
(let ((args (erc-response.command-args parsed-response))
(decode-target nil)
(decoded-args ()))
+ ;; FIXME this should stop after the first match.
(dolist (arg args nil)
(when (string-match "^[#&].*" arg)
(setq decode-target arg)))
(when (stringp decode-target)
+ ;; FIXME `decode-target' should be passed as TARGET.
(setq decode-target (erc-decode-string-from-target decode-target nil)))
(setf (erc-response.unparsed parsed-response)
(erc-decode-string-from-target
@@ -2155,10 +2162,6 @@ Then display the welcome message."
;;
;; > The server SHOULD send "X", not "X="; this is the normalized form.
;;
- ;; Note: for now, assume the server will only send non-empty values,
- ;; possibly with printable ASCII escapes. Though in practice, the
- ;; only two escapes we're likely to see are backslash and space,
- ;; meaning the pattern is too liberal.
(let (case-fold-search)
(mapcar
(lambda (v)
@@ -2169,7 +2172,9 @@ Then display the welcome message."
(string-match "[\\]x[0-9A-F][0-9A-F]" v start))
(setq m (substring v (+ 2 (match-beginning 0)) (match-end 0))
c (string-to-number m 16))
- (if (<= ?\ c ?~)
+ ;; In practice, this range is too liberal. The only
+ ;; escapes we're likely to see are ?\\, ?=, and ?\s.
+ (if (<= ?\s c ?~)
(setq v (concat (substring v 0 (match-beginning 0))
(string c)
(substring v (match-end 0)))
@@ -2194,8 +2199,9 @@ primitive value."
(or erc-server-parameters
(erc-with-server-buffer
erc-server-parameters)))))
- (if (cdr v)
- (erc--parse-isupport-value (cdr v))
+ (if-let ((val (cdr v))
+ ((not (string-empty-p val))))
+ (erc--parse-isupport-value val)
'--empty--)))))
(pcase value
('--empty-- (unless single (list key)))
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index abcdc4c8843..8388efe062c 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -171,7 +171,7 @@ Derived from the advertised \"PREFIX\" ISUPPORT parameter."
;; After dropping 28, we can use prefixed "erc-autoload" cookies.
(defun erc--normalize-module-symbol (symbol)
- "Return preferred SYMBOL for `erc--modules'."
+ "Return preferred SYMBOL for `erc--module'."
(while-let ((canonical (get symbol 'erc--module))
((not (eq canonical symbol))))
(setq symbol canonical))
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index dede833a93d..b5b8fbaf8ab 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -31,51 +31,11 @@
;;; Code:
-(require 'compat nil 'noerror)
+(require 'compat)
(eval-when-compile (require 'cl-lib))
-;; Except for the "erc-" namespacing, these two definitions should be
-;; continuously updated to match the latest upstream ones verbatim.
-;; Although they're pretty simple, it's likely not worth checking for
-;; and possibly deferring to the non-prefixed versions.
-;;
-;; BEGIN Compat macros
-
-;;;; Macros for extended compatibility function calls
-
-(defmacro erc-compat-function (fun)
- "Return compatibility function symbol for FUN.
-
-If the Emacs version provides a sufficiently recent version of
-FUN, the symbol FUN is returned itself. Otherwise the macro
-returns the symbol of a compatibility function which supports the
-behavior and calling convention of the current stable Emacs
-version. For example Compat 29.1 will provide compatibility
-functions which implement the behavior and calling convention of
-Emacs 29.1.
-
-See also `compat-call' to directly call compatibility functions."
- (let ((compat (intern (format "compat--%s" fun))))
- `#',(if (fboundp compat) compat fun)))
-
-(defmacro erc-compat-call (fun &rest args)
- "Call compatibility function or macro FUN with ARGS.
-
-A good example function is `plist-get' which was extended with an
-additional predicate argument in Emacs 29.1. The compatibility
-function, which supports this additional argument, can be
-obtained via (compat-function plist-get) and called
-via (compat-call plist-get plist prop predicate). It is not
-possible to directly call (plist-get plist prop predicate) on
-Emacs older than 29.1, since the original `plist-get' function
-does not yet support the predicate argument. Note that the
-Compat library never overrides existing functions.
-
-See also `compat-function' to lookup compatibility functions."
- (let ((compat (intern (format "compat--%s" fun))))
- `(,(if (fboundp compat) compat fun) ,@args)))
-
-;; END Compat macros
+(define-obsolete-function-alias 'erc-compat-function #'compat-function "30.1")
+(define-obsolete-function-alias 'erc-compat-call #'compat-call "30.1")
;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
(define-obsolete-function-alias 'erc-define-minor-mode
@@ -102,7 +62,7 @@ See `erc-encoding-coding-alist'."
(defun erc-set-write-file-functions (new-val)
(declare (obsolete nil "28.1"))
- (set (make-local-variable 'write-file-functions) new-val))
+ (setq-local write-file-functions new-val))
(defvar erc-emacs-build-time
(if (or (stringp emacs-build-time) (not emacs-build-time))
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index b91ce007087..aa12b807fbc 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -44,11 +44,7 @@
(define-erc-module fill nil
"Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
-the channel buffers are filled."
- ;; FIXME ensure a consistent ordering relative to hook members from
- ;; other modules. Ideally, this module's processing should happen
- ;; after "morphological" modifications to a message's text but
- ;; before superficial decorations.
+channel buffers are filled. See also `erc-fill-wrap-mode'."
((add-hook 'erc-insert-modify-hook #'erc-fill 60)
(add-hook 'erc-send-modify-hook #'erc-fill 60))
((remove-hook 'erc-insert-modify-hook #'erc-fill)
@@ -425,8 +421,11 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
(defvar erc-button-mode)
+(defvar erc-scrolltobottom-mode)
(defvar erc-legacy-invisible-bounds-p)
+(defvar erc--fill-wrap-scrolltobottom-exempt-p nil)
+
(defun erc-fill--wrap-ensure-dependencies ()
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(when erc-legacy-invisible-bounds-p
@@ -439,6 +438,10 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
(unless erc-fill-mode
(push 'fill missing-deps)
(erc-fill-mode +1))
+ (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p
+ (memq 'scrolltobottom erc-modules))
+ (push 'scrolltobottom missing-deps)
+ (erc-scrolltobottom-mode +1))
(when erc-fill-wrap-merge
(require 'erc-button)
(unless erc-button-mode
@@ -459,27 +462,25 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
(define-erc-module fill-wrap nil
"Fill style leveraging `visual-line-mode'.
+
This module displays nicks overhanging leftward to a common
-offset, as determined by the option `erc-fill-static-center'.
-And it \"wraps\" messages at a common margin width, as determined
-by the option `erc-fill-wrap-margin-width'. To use it, either
-include `fill-wrap' in `erc-modules' or set `erc-fill-function'
-to `erc-fill-wrap'. Most users will want to enable the
-`scrolltobottom' module as well.
-
-During sessions in which this module is active, use
-\\[erc-fill-wrap-nudge] to adjust the width of the indent and the
-stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for
-cycling between logical- and screen-line oriented command
-movement. Similarly, use \\[erc-fill-wrap-refill-buffer] to fix
-alignment problems after running certain commands, like
-`text-scale-adjust'. Also see related stylistic options
-`erc-fill-wrap-merge', and `erc-fill-wrap-merge-indicator'.
-\(Hint: in narrow windows, where is space tight, try setting
-`erc-fill-static-center' to 1. And if you also use the option
-`erc-fill-wrap-merge-indicator', set that to value-menu item
-\"Leading MIDDLE DOT sans gap\" or one of the various
-\"trailing\" items.)
+offset, as determined by the option `erc-fill-static-center'. It
+also \"wraps\" messages at a common width, as determined by the
+option `erc-fill-wrap-margin-width'. To use it, either include
+`fill-wrap' in `erc-modules' or set `erc-fill-function' to
+`erc-fill-wrap'.
+
+Once enabled, use \\[erc-fill-wrap-nudge] to adjust the width of
+the indent and the stamp margin. And For cycling between
+logical- and screen-line oriented command movement, see
+\\[erc-fill-wrap-toggle-truncate-lines]. Similarly, use
+\\[erc-fill-wrap-refill-buffer] to fix alignment problems after
+running certain commands, like `text-scale-adjust'. Also see
+related stylistic options `erc-fill-wrap-merge', and
+`erc-fill-wrap-merge-indicator'. (Hint: in narrow windows, try
+setting `erc-fill-static-center' to 1, and if you use
+`erc-fill-wrap-merge-indicator', choose \"Leading MIDDLE DOT sans
+gap\" or one of the \"trailing\" items from the Customize menu.)
This module imposes various restrictions on the appearance of
timestamps. Most notably, it insists on displaying them in the
@@ -497,11 +498,12 @@ a workaround provided by `erc-stamp-prefix-log-filter',
which
strips trailing stamps from logged messages and instead prepends
them to every line.
-As a so-called \"local\" module, `fill-wrap' depends on the
-global modules `fill', `stamp', and `button'; it activates them
-as needed when initializing. Please note that enabling and
-disabling this module by invoking one of its minor-mode toggles
-is not recommended."
+A so-called \"local\" module, `fill-wrap' depends on the global
+modules `fill', `stamp', `button', and `scrolltobottom'. It
+activates them as needed when initializing and leaves them
+enabled when shutting down. To opt out of `scrolltobottom'
+specifically, disable its minor mode, `erc-scrolltobottom-mode',
+via `erc-fill-wrap-mode-hook'."
((erc-fill--wrap-ensure-dependencies)
(erc--restore-initialize-priors erc-fill-wrap-mode
erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys
@@ -832,7 +834,7 @@ decorations applied by third-party modules."
(line (count-screen-lines (window-start) (window-point))))
(when (zerop arg)
(setq arg 1))
- (erc-compat-call
+ (compat-call
set-transient-map
(let ((map (make-sparse-keymap)))
(dolist (key '(?= ?- ?0))
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index e3d28aa60dd..a81a3869436 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -566,8 +566,9 @@ The INDENT level is ignored."
(defun erc-speedbar--reset-last-ran-on-timer ()
"Reset `erc-speedbar--last-ran'."
(when speedbar-buffer
- (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer)
- (current-time))))
+ (with-suppressed-warnings ((obsolete buffer-local-value)) ; <=29
+ (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer)
+ (current-time)))))
;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t)
(define-erc-module nickbar nil
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index a11739a4195..a8190a2c94a 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -828,6 +828,7 @@ left-sided stamps and date stamps inserted by this
function."
;; perform day alignments via this function only when needed.
(defun erc-stamp--time-as-day (current-time)
"Discard hour, minute, and second info from timestamp CURRENT-TIME."
+ (defvar current-time-list) ; <=28
(let* ((current-time-list) ; flag
(decoded (decode-time current-time erc-stamp--tz)))
(setf (decoded-time-second decoded) 0
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ef047201251..cce3b2508fb 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -135,6 +135,13 @@ concerning buffers."
"Running scripts at startup and with /LOAD."
:group 'erc)
+;; Add `custom-loads' features for group symbols missing from a
+;; supported Emacs version, possibly because they belong to a new ERC
+;; library. These groups all share their library's feature name.
+;;;###autoload(dolist (symbol '( erc-sasl erc-spelling ; 29
+;;;###autoload erc-imenu erc-nicks)) ; 30
+;;;###autoload (custom-add-load symbol symbol))
+
(defvar erc-message-parsed) ; only known to this file
(defvar erc--msg-props nil
@@ -1656,11 +1663,7 @@ If BUFFER is nil, the current buffer is used."
(defun erc-query-buffer-p (&optional buffer)
"Return non-nil if BUFFER is an ERC query buffer.
If BUFFER is nil, the current buffer is used."
- (with-current-buffer (or buffer (current-buffer))
- (let ((target (erc-target)))
- (and (eq major-mode 'erc-mode)
- target
- (not (memq (aref target 0) '(?# ?& ?+ ?!)))))))
+ (not (erc-channel-p (or buffer (current-buffer)))))
(defun erc-ison-p (nick)
"Return non-nil if NICK is online."
@@ -1875,18 +1878,20 @@ buries those."
:group 'erc-buffers
:type 'boolean)
-(defun erc-channel-p (channel)
- "Return non-nil if CHANNEL seems to be an IRC channel name."
- (cond ((stringp channel)
- (memq (aref channel 0)
- (if-let ((types (erc--get-isupport-entry 'CHANTYPES 'single)))
- (append types nil)
- '(?# ?& ?+ ?!))))
- ((and-let* (((bufferp channel))
- ((buffer-live-p channel))
- (target (buffer-local-value 'erc--target channel)))
- (erc-channel-p (erc--target-string target))))
- (t nil)))
+(defvar erc--fallback-channel-prefixes "#&"
+ "Prefix chars for distinguishing channel targets when CHANTYPES is unknown.")
+
+(defun erc-channel-p (target)
+ "Return non-nil if TARGET is a valid channel name or a channel buffer."
+ (cond ((stringp target)
+ (and-let*
+ (((not (string-empty-p target)))
+ (value (let ((entry (erc--get-isupport-entry 'CHANTYPES)))
+ (if entry (cadr entry) erc--fallback-channel-prefixes)))
+ ((erc--strpos (aref target 0) value)))))
+ ((and-let* (((buffer-live-p target))
+ (target (buffer-local-value 'erc--target target))
+ ((erc--target-channel-p target)))))))
;; For the sake of compatibility, a historical quirk concerning this
;; option, when nil, has been preserved: all buffers are suffixed with
@@ -2479,29 +2484,22 @@ nil."
(cl-assert (= (point) (point-max)))))
(defun erc-open (&optional server port nick full-name
- connect passwd tgt-list channel process
+ connect passwd _tgt-list channel process
client-certificate user id)
- "Connect to SERVER on PORT as NICK with USER and FULL-NAME.
-
-If CONNECT is non-nil, connect to the server. Otherwise assume
-already connected and just create a separate buffer for the new
-target given by CHANNEL, meaning these parameters are mutually
-exclusive. Note that CHANNEL may also be a query; its name has
-been retained for historical reasons.
-
-Use PASSWD as user password on the server. If TGT-LIST is
-non-nil, use it to initialize `erc-default-recipients'.
-
-CLIENT-CERTIFICATE, if non-nil, should either be a list where the
-first element is the file name of the private key corresponding
-to a client certificate and the second element is the file name
-of the client certificate itself to use when connecting over TLS,
-or t, which means that `auth-source' will be queried for the
-private key and the certificate.
-
-When non-nil, ID should be a symbol for identifying the connection.
-
-Returns the buffer for the given server or channel."
+ "Return a new or reinitialized server or target buffer.
+If CONNECT is non-nil, connect to SERVER and return its new or
+reassociated buffer. Otherwise, assume PROCESS is non-nil and belongs
+to an active session, and return a new or refurbished target buffer for
+CHANNEL, which may also be a query target (the parameter name remains
+for historical reasons). Pass SERVER, PORT, NICK, USER, FULL-NAME, and
+PASSWD to `erc-determine-parameters' for preserving as session-local
+variables. Do something similar for CLIENT-CERTIFICATE and ID, which
+should be as described by `erc-tls'.
+
+Note that ERC ignores TGT-LIST and initializes `erc-default-recipients'
+with CHANNEL as its only member. Note also that this function has the
+side effect of setting the current buffer to the one it returns. Use
+`with-current-buffer' or `save-excursion' to nullify this effect."
(let* ((target (and channel (erc--target-from-string channel)))
(buffer (erc-get-buffer-create server port nil target id))
(old-buffer (current-buffer))
@@ -2538,7 +2536,7 @@ Returns the buffer for the given server or channel."
;; connection parameters
(setq erc-server-process process)
;; stack of default recipients
- (setq erc-default-recipients tgt-list)
+ (when channel (setq erc-default-recipients (list channel)))
(when target
(setq erc--target target
erc-network (erc-network)))
@@ -2774,8 +2772,9 @@ PORT, NICK, and PASSWORD, along with USER and FULL-NAME
when
given a prefix argument. Non-interactively, expect the rarely
needed ID parameter, when non-nil, to be a symbol or a string for
naming the server buffer and identifying the connection
-unequivocally. (See Info node `(erc) Connecting' for details
-about all mentioned parameters.)
+unequivocally. Once connected, return the server buffer. (See
+Info node `(erc) Connecting' for details about all mentioned
+parameters.)
Together with `erc-tls', this command serves as the main entry
point for ERC, the powerful, modular, and extensible IRC client.
@@ -4047,16 +4046,42 @@ this function from interpreting the line as a command."
;; Input commands handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun erc-cmd-AMSG (line)
- "Send LINE to all channels of the current server that you are on."
- (interactive "sSend to all channels you're on: ")
- (setq line (erc-trim-string line))
+(defun erc--connected-and-joined-p ()
+ (and (erc--current-buffer-joined-p)
+ erc-server-connected))
+
+(defun erc-cmd-GMSG (line)
+ "Send LINE to all channels on all networks you are on."
+ (setq line (string-remove-prefix " " line))
(erc-with-all-buffers-of-server nil
- (lambda ()
- (erc-channel-p (erc-default-target)))
+ #'erc--connected-and-joined-p
+ (erc-send-message line)))
+(put 'erc-cmd-GMSG 'do-not-parse-args t)
+
+(defun erc-cmd-AMSG (line)
+ "Send LINE to all channels of the current network.
+Interactively, prompt for the line of text to send."
+ (interactive "sSend to all channels on this network: ")
+ (setq line (string-remove-prefix " " line))
+ (erc-with-all-buffers-of-server erc-server-process
+ #'erc--connected-and-joined-p
(erc-send-message line)))
(put 'erc-cmd-AMSG 'do-not-parse-args t)
+(defun erc-cmd-GME (line)
+ "Send LINE as an action to all channels on all networks you are on."
+ (erc-with-all-buffers-of-server nil
+ #'erc--connected-and-joined-p
+ (erc-cmd-ME line)))
+(put 'erc-cmd-GME 'do-not-parse-args t)
+
+(defun erc-cmd-AME (line)
+ "Send LINE as an action to all channels on the current network."
+ (erc-with-all-buffers-of-server erc-server-process
+ #'erc--connected-and-joined-p
+ (erc-cmd-ME line)))
+(put 'erc-cmd-AME 'do-not-parse-args t)
+
(defun erc-cmd-SAY (line)
"Send LINE to the current query or channel as a message, not a command.
@@ -6815,7 +6840,7 @@ stand-in from the fallback value \"(qaohv)~&@%+\"."
"Return numeric rank for CHAR or nil if unknown.
For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h,
and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a
-`erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to
+`erc--parsed-prefix' object. With FROM-PREFIX-P, expect CHAR to
be a prefix instead."
(and-let* ((obj (or parsed-prefix (erc--parsed-prefix)))
(pos (erc--strpos char (if from-prefix-p
@@ -9492,6 +9517,7 @@ guarantee that the input method functions properly for the
purpose of typing within the ERC prompt."
(when (and (eq major-mode 'erc-mode)
(fboundp 'set-text-conversion-style))
+ (defvar text-conversion-style) ; avoid free variable warning on <=29
(if (>= (point) (erc-beg-of-input-line))
(unless (eq text-conversion-style 'action)
(set-text-conversion-style 'action))
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index b0c3e6e7a11..7fc6958a00f 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -190,6 +190,12 @@ interpretation."
'(("**/" . recurse)
("***/" . recurse-symlink)))
+(defsubst eshell-glob-chars-regexp ()
+ "Return the lazily-created value for `eshell-glob-chars-regexp'."
+ (or eshell-glob-chars-regexp
+ (setq-local eshell-glob-chars-regexp
+ (format "[%s]+" (apply 'string eshell-glob-chars-list)))))
+
(defun eshell-glob-regexp (pattern)
"Convert glob-pattern PATTERN to a regular expression.
The basic syntax is:
@@ -210,11 +216,8 @@ set to true, then these characters will match themselves
in the
resulting regular expression."
(let ((matched-in-pattern 0) ; How much of PATTERN handled
regexp)
- (while (string-match
- (or eshell-glob-chars-regexp
- (setq-local eshell-glob-chars-regexp
- (format "[%s]+" (apply 'string eshell-glob-chars-list))))
- pattern matched-in-pattern)
+ (while (string-match (eshell-glob-chars-regexp)
+ pattern matched-in-pattern)
(let* ((op-begin (match-beginning 0))
(op-char (aref pattern op-begin)))
(setq regexp
@@ -239,6 +242,10 @@ resulting regular expression."
(regexp-quote (substring pattern matched-in-pattern))
"\\'")))
+(defun eshell-glob-p (pattern)
+ "Return non-nil if PATTERN has any special glob characters."
+ (string-match (eshell-glob-chars-regexp) pattern))
+
(defun eshell-glob-convert-1 (glob &optional last)
"Convert a GLOB matching a single element of a file name to regexps.
If LAST is non-nil, this glob is the last element of a file name.
@@ -291,14 +298,13 @@ The result is a list of three elements:
symlinks.
3. A boolean indicating whether to match directories only."
- (let ((globs (eshell-split-path glob))
- (isdir (eq (aref glob (1- (length glob))) ?/))
+ (let ((globs (eshell-split-filename glob))
+ (isdir (string-suffix-p "/" glob))
start-dir result last-saw-recursion)
(if (and (cdr globs)
(file-name-absolute-p (car globs)))
- (setq start-dir (car globs)
- globs (cdr globs))
- (setq start-dir "."))
+ (setq start-dir (pop globs))
+ (setq start-dir (file-name-as-directory ".")))
(while globs
(if-let ((recurse (cdr (assoc (car globs)
eshell-glob-recursive-alist))))
@@ -306,11 +312,15 @@ The result is a list of three elements:
(setcar result recurse)
(push recurse result)
(setq last-saw-recursion t))
- (push (eshell-glob-convert-1 (car globs) (null (cdr globs)))
- result)
+ (if (or result (eshell-glob-p (car globs)))
+ (push (eshell-glob-convert-1 (car globs) (null (cdr globs)))
+ result)
+ ;; We haven't seen a glob yet, so instead append to the start
+ ;; directory.
+ (setq start-dir (file-name-concat start-dir (car globs))))
(setq last-saw-recursion nil))
(setq globs (cdr globs)))
- (list (file-name-as-directory start-dir)
+ (list start-dir
(nreverse result)
isdir)))
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 78dfd0654e2..23028576f45 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -618,11 +618,11 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
:preserve-args
:external "ln"
:show-usage
- :usage "[OPTION]... TARGET [LINK_NAME]
+ :usage "[OPTION]... TARGET LINK_NAME
or: ln [OPTION]... TARGET... DIRECTORY
-Create a link to the specified TARGET with optional LINK_NAME. If there is
-more than one TARGET, the last argument must be a directory; create links
-in DIRECTORY to each TARGET. Create hard links by default, symbolic links
+Create a link to the specified TARGET with LINK_NAME. If there is more
+than one TARGET, the last argument must be a directory; create links in
+DIRECTORY to each TARGET. Create hard links by default, symbolic links
with `--symbolic'. When creating hard links, each TARGET must exist.")
(let ((no-dereference t))
(eshell-mvcpln-template "ln" "linking"
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 97ddac58629..78cf28d785a 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -285,7 +285,7 @@ QUOTED is passed to `eshell-concat' (which see) and, if
non-nil,
allows values to be converted to numbers where appropriate.
ARGS should be a list of lists of arguments, such as that
-produced by `eshell-prepare-slice'. \"Adjacent\" values of
+produced by `eshell-prepare-splice'. \"Adjacent\" values of
consecutive arguments will be passed to `eshell-concat'. For
example, if ARGS is
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index dc2b93e574b..44861c222b8 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -253,10 +253,10 @@ An external command simply means external to Emacs."
"Add a set of paths to PATH."
(eshell-eval-using-options
"addpath" args
- '((?b "begin" nil prepend "add path element at beginning")
+ '((?b "begin" nil prepend "add to beginning of $PATH")
(?h "help" nil nil "display this usage message")
- :usage "[-b] PATH
-Adds the given PATH to $PATH.")
+ :usage "[-b] DIR...
+Adds the given DIR to $PATH.")
(let ((path (eshell-get-path t)))
(if args
(progn
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index fd279f61673..b15f99a0359 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -290,7 +290,7 @@ non-interactive sessions, such as when using
`eshell-command'.")
"C-e" #'eshell-show-maximum-output
"C-f" #'eshell-forward-argument
"C-m" #'eshell-copy-old-input
- "C-o" #'eshell-kill-output
+ "C-o" #'eshell-delete-output
"C-r" #'eshell-show-output
"C-t" #'eshell-truncate-buffer
"C-u" #'eshell-kill-input
@@ -832,15 +832,23 @@ This function should be in the list
`eshell-output-filter-functions'."
eshell-last-output-start
eshell-last-output-end))
-(defun eshell-kill-output ()
- "Kill all output from interpreter since last input.
-Does not delete the prompt."
- (interactive)
+(defun eshell-delete-output (&optional kill)
+ "Delete all output from interpreter since last input.
+If KILL is non-nil (interactively, the prefix), save the killed text in
+the kill ring.
+
+This command does not delete the prompt."
+ (interactive "P")
(save-excursion
(goto-char (eshell-beginning-of-output))
(insert "*** output flushed ***\n")
+ (when kill
+ (copy-region-as-kill (point) (eshell-end-of-output)))
(delete-region (point) (eshell-end-of-output))))
+(define-obsolete-function-alias 'eshell-kill-output
+ #'eshell-delete-output "30.1")
+
(defun eshell-show-output (&optional arg)
"Display start of this batch of interpreter output at top of window.
Sets mark to the value of point when this command is run.
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index d01e3569d57..e6f5fc9629a 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -100,29 +100,37 @@ the new process for its value.
Lastly, any remaining arguments will be available in the locally
let-bound variable `args'."
(declare (debug (form form sexp body)))
- `(let* ((temp-args
- ,(if (memq ':preserve-args (cadr options))
- (list 'copy-tree macro-args)
- (list 'eshell-stringify-list
- (list 'flatten-tree macro-args))))
- (processed-args (eshell--do-opts ,name ,options temp-args
,macro-args))
- ,@(delete-dups
- (delq nil (mapcar (lambda (opt)
- (and (listp opt) (nth 3 opt)
- `(,(nth 3 opt) (pop processed-args))))
- ;; `options' is of the form (quote OPTS).
- (cadr options))))
- (args processed-args))
- ;; Silence unused lexical variable warning if body does not use `args'.
- (ignore args)
- ,@body-forms))
+ (let ((option-syms (eshell--get-option-symbols
+ ;; `options' is of the form (quote OPTS).
+ (cadr options))))
+ `(let* ((temp-args
+ ,(if (memq ':preserve-args (cadr options))
+ (list 'copy-tree macro-args)
+ (list 'eshell-stringify-list
+ (list 'flatten-tree macro-args))))
+ (args (eshell--do-opts ,name temp-args ,macro-args
+ ,options ',option-syms))
+ ;; Bind all the option variables. When done, `args' will
+ ;; contain any remaining positional arguments.
+ ,@(mapcar (lambda (sym) `(,sym (pop args))) option-syms))
+ ;; Silence unused lexical variable warning if body does not use `args'.
+ (ignore args)
+ ,@body-forms)))
;;; Internal Functions:
;; Documented part of the interface; see eshell-eval-using-options.
(defvar eshell--args)
-(defun eshell--do-opts (name options args orig-args)
+(defun eshell--get-option-symbols (options)
+ "Get a list of symbols for the specified OPTIONS.
+OPTIONS is a list of command-line options from
+`eshell-eval-using-options' (which see)."
+ (delete-dups
+ (delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt)))
+ options))))
+
+(defun eshell--do-opts (name args orig-args options option-syms)
"Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
(require 'esh-ext)
@@ -134,7 +142,8 @@ This code doesn't really need to be macro expanded
everywhere."
(if (and (= (length args) 0)
(memq ':show-usage options))
(eshell-show-usage name options)
- (setq args (eshell--process-args name args options))
+ (setq args (eshell--process-args name args options
+ option-syms))
nil))))
(when usage-msg
(user-error "%s" usage-msg))))))
@@ -269,16 +278,13 @@ triggered to say that the switch is unrecognized."
"%s: unrecognized option --%s")
name (car switch)))))))
-(defun eshell--process-args (name args options)
- "Process the given ARGS using OPTIONS."
- (let* ((seen ())
- (opt-vals (delq nil (mapcar (lambda (opt)
- (when (listp opt)
- (let ((sym (nth 3 opt)))
- (when (and sym (not (memq sym
seen)))
- (push sym seen)
- (list sym)))))
- options)))
+(defun eshell--process-args (name args options option-syms)
+ "Process the given ARGS for the command NAME using OPTIONS.
+OPTION-SYMS is a list of symbols that will hold the processed arguments.
+
+Return a list of values corresponding to each element in OPTION-SYMS,
+followed by any additional positional arguments."
+ (let* ((opt-vals (mapcar #'list option-syms))
(ai 0) arg
(eshell--args args)
(pos-argument-found nil))
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index f0acfecb701..129134814e3 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -447,29 +447,34 @@ Prepend remote identification of `default-directory', if
any."
(parse-colon-path path-env))
(parse-colon-path path-env))))
-(defun eshell-split-path (path)
- "Split a path into multiple subparts."
- (let ((len (length path))
- (i 0) (li 0)
- parts)
- (if (and (eshell-under-windows-p)
- (> len 2)
- (eq (aref path 0) ?/)
- (eq (aref path 1) ?/))
- (setq i 2))
- (while (< i len)
- (if (and (eq (aref path i) ?/)
- (not (get-text-property i 'escaped path)))
- (setq parts (cons (if (= li i) "/"
- (substring path li (1+ i))) parts)
- li (1+ i)))
- (setq i (1+ i)))
- (if (< li i)
- (setq parts (cons (substring path li i) parts)))
- (if (and (eshell-under-windows-p)
- (string-match "\\`[A-Za-z]:\\'" (car (last parts))))
- (setcar (last parts) (concat (car (last parts)) "/")))
- (nreverse parts)))
+(defun eshell-split-filename (filename)
+ "Split a FILENAME into a list of file/directory components."
+ (let* ((remote (file-remote-p filename))
+ (filename (file-local-name filename))
+ (len (length filename))
+ (index 0) (curr-start 0)
+ parts)
+ (when (and (eshell-under-windows-p)
+ (string-prefix-p "//" filename))
+ (setq index 2))
+ (while (< index len)
+ (when (and (eq (aref filename index) ?/)
+ (not (get-text-property index 'escaped filename)))
+ (push (if (= curr-start index) "/"
+ (substring filename curr-start (1+ index)))
+ parts)
+ (setq curr-start (1+ index)))
+ (setq index (1+ index)))
+ (when (< curr-start len)
+ (push (substring filename curr-start) parts))
+ (setq parts (nreverse parts))
+ (when (and (eshell-under-windows-p)
+ (string-match "\\`[A-Za-z]:\\'" (car parts)))
+ (setcar parts (concat (car parts) "/")))
+ (if remote (cons remote parts) parts)))
+
+(define-obsolete-function-alias 'eshell-split-path
+ 'eshell-split-filename "30.1")
(defun eshell-to-flat-string (value)
"Make value a string. If separated by newlines change them to spaces."
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 537bc4b0641..02b5c785625 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -433,7 +433,7 @@ the values of nil for each."
(?h "help" nil nil "show this usage screen")
:external "env"
:parse-leading-options-only
- :usage "[NAME=VALUE]... [COMMAND [ARG]...]")
+ :usage "[NAME=VALUE]... [COMMAND]...")
(if args
(or (eshell-parse-local-variables args)
(eshell-named-command (car args) (cdr args)))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 3492dcbf17a..5383f743878 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1098,12 +1098,12 @@ Suppose the cursor is somewhere that might be near end
of file,
the guessing would position point before punctuation (like comma)
after the file extension:
- C:\temp\file.log, which contain ....
+ C:\\temp\\file.log, which contain ....
=============================== (before)
---------------- (after)
- C:\temp\file.log on Windows or /tmp/file.log on Unix
+ C:\\temp\\file.log on Windows or /tmp/file.log on Unix
=============================== (before)
---------------- (after)
diff --git a/lisp/files.el b/lisp/files.el
index 9c8914bfc50..3ca4f047144 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2747,6 +2747,10 @@ Fifth arg NOMODES non-nil means don't alter the file's
modes.
Finishes by calling the functions in `find-file-hook'
unless NOMODES is non-nil."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
+ ;; The above is sufficiently like turning on read-only-mode, so run
+ ;; the mode hook here by hand.
+ (if buffer-read-only
+ (run-hooks 'read-only-mode-hook))
(if noninteractive
nil
(let* (not-serious
@@ -3270,7 +3274,16 @@ and `inhibit-local-variables-suffixes'. If
;; Optional group 1: env(1) invocation.
"\\("
"[^ \t\n]*/bin/env[ \t]*"
- "\\(?:-S[ \t]*\\|--split-string\\(?:=\\|[ \t]*\\)\\)?"
+ ;; Within group 1: possible -S/--split-string and environment
+ ;; adjustments.
+ "\\(?:"
+ ;; -S/--split-string
+ "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)"
+ ;; More env arguments.
+ "\\(?:-[^ \t\n]+[ \t]+\\)*"
+ ;; Interpreter environment modifications.
+ "\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*"
+ "\\)?"
"\\)?"
;; Group 2: interpreter.
"\\([^ \t\n]+\\)"))
@@ -3400,7 +3413,7 @@ checks if it uses an interpreter listed in
`interpreter-mode-alist',
matches the buffer beginning against `magic-mode-alist',
compares the file name against the entries in `auto-mode-alist',
then matches the buffer beginning against `magic-fallback-mode-alist'.
-It also obeys `major-mode-remap-alist'.
+It also obeys `major-mode-remap-alist' and `major-mode-remap-defaults'.
If `enable-local-variables' is nil, or if the file name matches
`inhibit-local-variables-regexps', this function does not check
@@ -3546,9 +3559,22 @@ we don't actually set it to the same mode the buffer
already has."
Every entry is of the form (MODE . FUNCTION) which means that in order
to activate the major mode MODE (specified via something like
`auto-mode-alist', file-local variables, ...) we should actually call
-FUNCTION instead."
+FUNCTION instead.
+FUNCTION can be nil to hide other entries (either in this var or in
+`major-mode-remap-defaults') and means that we should call MODE."
:type '(alist (symbol) (function)))
+(defvar major-mode-remap-defaults nil
+ "Alist mapping file-specified mode to actual mode.
+This works like `major-mode-remap-alist' except it has lower priority
+and it is meant to be modified by packages rather than users.")
+
+(defun major-mode-remap (mode)
+ "Return the function to use to enable MODE."
+ (or (cdr (or (assq mode major-mode-remap-alist)
+ (assq mode major-mode-remap-defaults)))
+ mode))
+
;; When `keep-mode-if-same' is set, we are working on behalf of
;; set-visited-file-name. In that case, if the major mode specified is the
;; same one we already have, don't actually reset it. We don't want to lose
@@ -3565,7 +3591,7 @@ same, do nothing and return nil."
(eq mode (car set-auto-mode--last))
(eq major-mode (cdr set-auto-mode--last)))))
(when mode
- (funcall (alist-get mode major-mode-remap-alist mode))
+ (funcall (major-mode-remap mode))
(unless (eq mode major-mode)
(setq set-auto-mode--last (cons mode major-mode)))
mode)))
@@ -3754,7 +3780,8 @@ function is allowed to change the contents of this alist.
This hook is called only if there is at least one file-local
variable to set.")
-(defvar permanently-enabled-local-variables '(lexical-binding)
+(defvar permanently-enabled-local-variables
+ '(lexical-binding read-symbol-shorthands)
"A list of file-local variables that are always enabled.
This overrides any `enable-local-variables' setting.")
@@ -4190,6 +4217,13 @@ major-mode."
;; to use 'thisbuf's name in the
;; warning message.
(or (buffer-file-name thisbuf) ""))))))
+ ((eq var 'read-symbol-shorthands)
+ ;; Sort automatically by shorthand length
+ ;; in descending order.
+ (setq val (sort val
+ (lambda (sh1 sh2) (> (length (car
sh1))
+ (length (car
sh2))))))
+ (push (cons 'read-symbol-shorthands val) result))
((and (eq var 'mode) handle-mode))
(t
(ignore-errors
@@ -4331,10 +4365,8 @@ already the major mode."
(pcase var
('mode
(let ((mode (intern (concat (downcase (symbol-name val))
- "-mode"))))
- (unless (eq (indirect-function mode)
- (indirect-function major-mode))
- (funcall mode))))
+ "-mode"))))
+ (set-auto-mode-0 mode t)))
('eval
(pcase val
(`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook)))
@@ -4414,6 +4446,12 @@ to see whether it should be considered."
(funcall predicate key)
(or (not key)
(derived-mode-p key)))
+ ;; If KEY is an extra parent it may remain not loaded
+ ;; (hence with some of its mode-specific vars missing their
+ ;; `safe-local-variable' property), leading to spurious
+ ;; prompts about unsafe vars (bug#68246).
+ (if (and (symbolp key) (autoloadp (indirect-function key)))
+ (ignore-errors (autoload-do-load (indirect-function key))))
(let* ((alist (cdr entry))
(subdirs (assq 'subdirs alist)))
(if (or (not subdirs)
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 4e2de8fed1b..68133ba2255 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -161,18 +161,9 @@ COND-FN takes one argument: the current element."
(define-obsolete-function-alias 'filesets-member #'cl-member "28.1")
(define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1")
-(defun filesets-select-command (cmd-list)
- "Select one command from CMD-LIST -- a string with space separated names."
- (let ((this (shell-command-to-string
- (format "which --skip-alias %s 2> %s | head -n 1"
- cmd-list null-device))))
- (if (equal this "")
- nil
- (file-name-nondirectory (substring this 0 (- (length this) 1))))))
-
(defun filesets-which-command (cmd)
"Call \"which CMD\"."
- (shell-command-to-string (format "which %s" cmd)))
+ (shell-command-to-string (format "which %s" (shell-quote-argument cmd))))
(defun filesets-which-command-p (cmd)
"Call \"which CMD\" and return non-nil if the command was found."
@@ -547,16 +538,6 @@ the filename."
(defcustom filesets-external-viewers
(let
- ;; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer)
- ;; (filesets-select-command "ggv gv")))
- ;; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer)
- ;; (filesets-select-command "xpdf acroread")))
- ;; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer)
- ;; (filesets-select-command "xdvi tkdvi")))
- ;; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer)
- ;; (filesets-select-command "antiword")))
- ;; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer)
- ;; (filesets-select-command "gqview ee display"))))
((ps-cmd "ggv")
(pdf-cmd "xpdf")
(dvi-cmd "xdvi")
@@ -1084,10 +1065,6 @@ Return full path if FULL-FLAG is non-nil."
(t
(error "Filesets: %s does not exist" dir))))
-(defun filesets-quote (txt)
- "Return TXT in quotes."
- (concat "\"" txt "\""))
-
(defun filesets-get-selection ()
"Get the text between mark and point -- i.e. the selection or region."
(let ((m (mark))
@@ -1098,7 +1075,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-quoted-selection ()
"Return the currently selected text in quotes."
- (filesets-quote (filesets-get-selection)))
+ (shell-quote-argument (filesets-get-selection)))
(defun filesets-get-shortcut (n)
"Create menu shortcuts based on number N."
@@ -1245,12 +1222,13 @@ Use the viewer defined in EV-ENTRY (a valid element of
(if fmt
(mapconcat
(lambda (this)
- (if (stringp this) (format this file)
- (format "%S" (if (functionp this)
- (funcall this)
- this))))
+ (if (stringp this)
+ (format this (shell-quote-argument file))
+ (shell-quote-argument (if (functionp this)
+ (funcall this)
+ this))))
fmt "")
- (format "%S" file))))
+ (shell-quote-argument file))))
(output
(cond
((and (functionp vwr) co-flag)
@@ -1259,7 +1237,7 @@ Use the viewer defined in EV-ENTRY (a valid element of
(funcall vwr file)
nil)
(co-flag
- (shell-command-to-string (format "%s %s" vwr args)))
+ (shell-command-to-string (format "%s %s" vwr args)))
(t
(shell-command (format "%s %s&" vwr args))
nil))))
@@ -2483,11 +2461,15 @@ Set up hooks, load the cache file -- if existing -- and
build the menu."
(setq filesets-menu-use-cached-flag t)))
(filesets-build-menu)))
+;;; obsolete
+
(defun filesets-error (_class &rest args)
"`error' wrapper."
(declare (obsolete error "28.1"))
(error "%s" (mapconcat #'identity args " ")))
+(define-obsolete-function-alias 'filesets-quote #'shell-quote-argument "30.1")
+
(provide 'filesets)
;;; filesets.el ends here
diff --git a/lisp/follow.el b/lisp/follow.el
index ce40317ca59..874e546bd6d 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -874,6 +874,7 @@ from the bottom."
(when (< dest win-s)
(setq follow-internal-force-redisplay t))))))
+(put 'follow-recenter 'isearch-scroll t)
(defun follow-redraw ()
"Arrange windows displaying the same buffer in successor order.
diff --git a/lisp/forms.el b/lisp/forms.el
index 009667af273..3a3160a0c8b 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -343,7 +343,7 @@ suitable for forms processing.")
(defvar forms-write-file-filter nil
"The name of a function that is called before writing the data file.
-This can be used to undo the effects of `form-read-file-filter'.")
+This can be used to undo the effects of `forms-read-file-filter'.")
(defvar forms-new-record-filter nil
"The name of a function that is called when a new record is created.")
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 3ee93031119..0928b179787 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -2910,13 +2910,9 @@ The following commands are available:
(car func)
(gnus-byte-compile `(lambda () ,func)))))
-(defun gnus-agent-true ()
- "Return t."
- t)
+(defalias 'gnus-agent-true #'always)
-(defun gnus-agent-false ()
- "Return nil."
- nil)
+(defalias 'gnus-agent-false #'ignore)
(defun gnus-category-make-function-1 (predicate)
"Make a function from PREDICATE."
@@ -2924,8 +2920,9 @@ The following commands are available:
;; Functions are just returned as is.
((or (symbolp predicate)
(functionp predicate))
- `(,(or (cdr (assq predicate gnus-category-predicate-alist))
- predicate)))
+ (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist))
+ predicate)))
+ (if (symbolp fun) `(,fun) `(funcall ',fun))))
;; More complex predicate.
((consp predicate)
`(,(cond
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index c3c5eab7d89..9f313108089 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -694,7 +694,7 @@ used as possible file names."
(defcustom gnus-page-delimiter "^\^L"
"Regexp describing what to use as article page delimiters.
-The default value is \"^\^L\", which is a form linefeed at the
+The default value is \"^\\^L\", which is a form linefeed at the
beginning of a line."
:type 'regexp
:group 'gnus-article-various)
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index 48c1aef968b..f33c5f7f2e5 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -111,6 +111,12 @@ See `mail-user-agent' for more information."
(autoload 'gnus-completing-read "gnus-util")
+(defcustom gnus-dired-attach-at-end t
+ "Non-nil means that files should be attached at the end of a buffer."
+ :group 'mail ;; dired?
+ :version "30.1"
+ :type 'boolean)
+
;; Method to attach files to a mail composition.
(defun gnus-dired-attach (files-to-attach)
"Attach dired's marked files to a gnus message composition.
@@ -161,7 +167,8 @@ filenames."
;; set buffer to destination buffer, and attach files
(set-buffer destination)
- (goto-char (point-max)) ;attach at end of buffer
+ (when gnus-dired-attach-at-end
+ (goto-char (point-max))) ;attach at end of buffer
(while files-to-attach
(mml-attach-file (car files-to-attach)
(or (mm-default-file-type (car files-to-attach))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index fdf97e1aabd..b18ede58fbf 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1189,12 +1189,12 @@ Uses the process/prefix convention.
The reply will include all From/Cc headers from the original
messages as the To/Cc headers.
-If prefix argument YANK is non-nil, the original article(s) will
+If prefix argument YANK is non-nil, the original article will
be yanked automatically."
(interactive (list (and current-prefix-arg
(gnus-summary-work-articles 1)))
gnus-summary-mode)
- (gnus-summary-reply yank t (gnus-summary-work-articles yank)))
+ (gnus-summary-reply yank t (gnus-summary-work-articles current-prefix-arg)))
(defun gnus-summary-very-wide-reply-with-original (n)
"Start composing a very wide reply mail a set of messages.
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index bd19e7d7cd7..479b7496cf1 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -893,9 +893,14 @@ If optional argument `EXTRA' is non-nil, it's a
non-standard overview header."
(t "permanent"))
header
(if (< score 0) "lower" "raise"))
- (if (numberp match)
- (int-to-string match)
- match))))
+ (cond ((numberp match) (int-to-string match))
+ ((string= header "date")
+ (int-to-string
+ (-
+ (/ (car (time-convert (current-time) 1)) 86400)
+ (/ (car (time-convert (gnus-date-get-time match)
1))
+ 86400))))
+ (t match)))))
;; If this is an integer comparison, we transform from string to int.
(if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index b5aa0b02d34..0b0a9bbfc1d 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1113,8 +1113,7 @@ sure of changing the value of `foo'."
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
-(defun gnus-not-ignore (&rest _args)
- t)
+(defalias 'gnus-not-ignore #'always)
(defvar gnus-directory-sep-char-regexp "/"
"The regexp of directory separator character.
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 99833e4eeca..dab66b60205 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -309,12 +309,31 @@ be set in `.emacs' instead."
:group 'gnus-start
:type 'boolean)
+(defcustom gnus-mode-line-logo
+ '((:type svg :file "gnus-pointer.svg" :ascent center)
+ (:type xpm :file "gnus-pointer.xpm" :ascent center)
+ (:type xbm :file "gnus-pointer.xbm" :ascent center))
+ "Image spec for the Gnus logo to be displayed in mode-line.
+
+If non-nil, it should be a list of image specifications to be passed
+as the first argument to `find-image', which see. Then, if the display
+is capable of showing images, the Gnus logo will be displayed as part of
+the buffer-identification in the mode-line of Gnus-buffers.
+
+If nil, there will be no Gnus logo in the mode-line."
+ :group 'gnus-visual
+ :type '(choice
+ (repeat :tag "List of Gnus logo image specifications" (plist))
+ (const :tag "Don't display Gnus logo" nil))
+ :version "30.1")
+
(defun gnus-mode-line-buffer-identification (line)
(let* ((str (car-safe line))
(str (if (stringp str)
(car (propertized-buffer-identification str))
str)))
- (if (or (not (fboundp 'find-image))
+ (if (or (not gnus-mode-line-logo)
+ (not (fboundp 'find-image))
(not (display-graphic-p))
(not (stringp str))
(not (string-match "^Gnus:" str)))
@@ -325,14 +344,7 @@ be set in `.emacs' instead."
(add-text-properties
0 5
(list 'display
- (find-image
- '((:type svg :file "gnus-pointer.svg"
- :ascent center)
- (:type xpm :file "gnus-pointer.xpm"
- :ascent center)
- (:type xbm :file "gnus-pointer.xbm"
- :ascent center))
- t)
+ (find-image gnus-mode-line-logo t)
'help-echo (if gnus-emacs-version
(format
"This is %s, %s."
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 97821894b48..ea679759f3e 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -1016,7 +1016,7 @@ See `find-file-noselect' for the arguments."
(nnheader-skeleton-replace from to t))
(defun nnheader-strip-cr ()
- "Strip all \r's from the current buffer."
+ "Strip all \\r's from the current buffer."
(nnheader-skeleton-replace "\r"))
(define-obsolete-function-alias 'nnheader-cancel-timer 'cancel-timer "27.1")
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 1ba848c107d..15d87f9925c 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -2133,6 +2133,12 @@ keymap value."
(when used-gentemp
(makunbound keymap))))
+(defcustom describe-mode-outline t
+ "Non-nil enables outlines in the output buffer of `describe-mode'."
+ :type 'boolean
+ :group 'help
+ :version "30.1")
+
;;;###autoload
(defun describe-mode (&optional buffer)
"Display documentation of current major mode and minor modes.
@@ -2145,7 +2151,10 @@ variable \(listed in `minor-mode-alist') must also be a
function
whose documentation describes the minor mode.
If called from Lisp with a non-nil BUFFER argument, display
-documentation for the major and minor modes of that buffer."
+documentation for the major and minor modes of that buffer.
+
+When `describe-mode-outline' is non-nil, Outline minor mode
+is enabled in the Help buffer."
(interactive "@")
(unless buffer
(setq buffer (current-buffer)))
@@ -2159,13 +2168,20 @@ documentation for the major and minor modes of that
buffer."
(with-current-buffer (help-buffer)
;; Add the local minor modes at the start.
(when local-minors
- (insert (format "Minor mode%s enabled in this buffer:"
- (if (length> local-minors 1)
- "s" "")))
+ (unless describe-mode-outline
+ (insert (format "Minor mode%s enabled in this buffer:"
+ (if (length> local-minors 1)
+ "s" ""))))
(describe-mode--minor-modes local-minors))
;; Document the major mode.
(let ((major (buffer-local-value 'major-mode buffer)))
+ (when describe-mode-outline
+ (goto-char (point-min))
+ (put-text-property
+ (point) (progn (insert (format "Major mode %S" major)) (point))
+ 'outline-level 1)
+ (insert "\n\n"))
(insert "The major mode is "
(buttonize
(propertize (format-mode-line
@@ -2189,36 +2205,56 @@ documentation for the major and minor modes of that
buffer."
;; Insert the global minor modes after the major mode.
(when global-minor-modes
- (insert (format "Global minor mode%s enabled:"
- (if (length> global-minor-modes 1)
- "s" "")))
- (describe-mode--minor-modes global-minor-modes)
- (when (re-search-forward "^\f")
- (beginning-of-line)
- (ensure-empty-lines 1)))
+ (unless describe-mode-outline
+ (insert (format "Global minor mode%s enabled:"
+ (if (length> global-minor-modes 1)
+ "s" ""))))
+ (describe-mode--minor-modes global-minor-modes t)
+ (unless describe-mode-outline
+ (when (re-search-forward "^\f")
+ (beginning-of-line)
+ (ensure-empty-lines 1))))
+
+ (when describe-mode-outline
+ (setq-local outline-search-function #'outline-search-level)
+ (setq-local outline-level (lambda () 1))
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight t
+ outline-minor-mode-use-buttons 'insert)
+ (outline-minor-mode 1))
+
;; For the sake of IELM and maybe others
nil)))))
-(defun describe-mode--minor-modes (modes)
+(defun describe-mode--minor-modes (modes &optional global)
(dolist (mode (seq-sort #'string< modes))
(let ((pretty-minor-mode
(capitalize
(replace-regexp-in-string
"\\(\\(-minor\\)?-mode\\)?\\'" ""
(symbol-name mode)))))
- (insert
- " "
- (buttonize
- pretty-minor-mode
- (lambda (mode)
- (goto-char (point-min))
- (text-property-search-forward
- 'help-minor-mode mode t)
- (beginning-of-line))
- mode))
+ (if (not describe-mode-outline)
+ (insert
+ " "
+ (buttonize
+ pretty-minor-mode
+ (lambda (mode)
+ (goto-char (point-min))
+ (text-property-search-forward
+ 'help-minor-mode mode t)
+ (beginning-of-line))
+ mode))
+ (goto-char (point-max))
+ (put-text-property
+ (point) (progn (insert (if global "Global" "Local")
+ (format " minor mode %S" mode))
+ (point))
+ 'outline-level 1)
+ (insert "\n\n"))
(save-excursion
- (goto-char (point-max))
- (insert "\n\n\f\n")
+ (unless describe-mode-outline
+ (goto-char (point-max))
+ (insert "\n\n\f\n"))
;; Document the minor modes fully.
(insert (buttonize
(propertize pretty-minor-mode 'help-minor-mode mode)
@@ -2232,11 +2268,14 @@ documentation for the major and minor modes of that
buffer."
(format "indicator%s"
indicator)))))
(insert (or (help-split-fundoc (documentation mode) nil 'doc)
- "No docstring")))))
- (forward-line -1)
- (fill-paragraph nil)
- (forward-paragraph 1)
- (ensure-empty-lines 1))
+ "No docstring"))
+ (when describe-mode-outline
+ (insert "\n\n")))))
+ (unless describe-mode-outline
+ (forward-line -1)
+ (fill-paragraph nil)
+ (forward-paragraph 1)
+ (ensure-empty-lines 1)))
(defun help-fns--list-local-commands ()
(let ((functions nil))
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 9c405efeee5..f9ec8a5cc2b 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -501,7 +501,17 @@ restore it properly when going back."
;; Disable `outline-minor-mode' in a reused Help buffer
;; created by `describe-bindings' that enables this mode.
(when (bound-and-true-p outline-minor-mode)
- (outline-minor-mode -1))
+ (outline-minor-mode -1)
+ (mapc #'kill-local-variable
+ '(outline-search-function
+ outline-regexp
+ outline-heading-end-regexp
+ outline-level
+ outline-minor-mode-cycle
+ outline-minor-mode-highlight
+ outline-minor-mode-use-buttons
+ outline-default-state
+ outline-default-rules)))
(when help-xref-stack-item
(push (cons (point) help-xref-stack-item) help-xref-stack)
(setq help-xref-forward-stack nil))
diff --git a/lisp/help.el b/lisp/help.el
index eae29bb5734..eaada89cf0a 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -151,7 +151,7 @@ buffer.")
("Mark & Kill"
(set-mark-command . "mark")
(kill-line . "kill line")
- (kill-ring-save . "kill region")
+ (kill-region . "kill region")
(yank . "yank")
(exchange-point-and-mark . "swap"))
("Projects"
@@ -165,7 +165,15 @@ buffer.")
(isearch-forward . "search")
(isearch-backward . "reverse search")
(query-replace . "search & replace")
- (fill-paragraph . "reformat"))))
+ (fill-paragraph . "reformat")))
+ "Data structure for `help-quick'.
+Value should be a list of elements, each element should of the form
+
+ (GROUP-NAME (COMMAND . DESCRIPTION) (COMMAND . DESCRIPTION)...)
+
+where GROUP-NAME is the name of the group of the commands,
+COMMAND is the symbol of a command and DESCRIPTION is its short
+description, 10 to 15 char5acters at most.")
(declare-function prop-match-value "text-property-search" (match))
@@ -2272,6 +2280,27 @@ The `temp-buffer-window-setup-hook' hook is called."
(with-output-to-temp-buffer " *Char Help*"
(princ msg)))))
+(defun help--append-keystrokes-help (str)
+ (let* ((keys (this-single-command-keys))
+ (bindings (delete nil
+ (mapcar (lambda (map) (lookup-key map keys t))
+ (current-active-maps t)))))
+ (catch 'res
+ (dolist (val help-event-list)
+ (let ((key (vector (if (eql val 'help)
+ help-char
+ val))))
+ (unless (seq-find (lambda (map) (and (keymapp map) (lookup-key map
key)))
+ bindings)
+ (throw 'res
+ (concat
+ str
+ (substitute-command-keys
+ (format
+ " (\\`%s' for help)"
+ (key-description key))))))))
+ str)))
+
(defun help--docstring-quote (string)
"Return a doc string that represents STRING.
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 6b9c623f31f..89c2bee2204 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -586,6 +586,7 @@ If a window system is unavailable, calls
`hfy-fallback-color-values'."
(defvar hfy-cperl-mode-kludged-p nil)
(defun hfy-kludge-cperl-mode ()
+ ;; FIXME: Still?
"CPerl mode does its damnedest not to do some of its fontification when not
in a windowing system - try to trick it..."
(declare (obsolete nil "28.1"))
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 777aebb70cf..e583e0fe32c 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -110,6 +110,13 @@ This gives more frame width for large indented sexps, and
allows functions
such as `edebug-defun' to work with such inputs."
:type 'boolean)
+(defcustom ielm-history-file-name
+ (locate-user-emacs-file "ielm-history.eld")
+ "If non-nil, name of the file to read/write IELM input history."
+ :type '(choice (const :tag "Disable input history" nil)
+ file)
+ :version "30.1")
+
(defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook)
(defcustom ielm-mode-hook nil
"Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started."
@@ -503,6 +510,17 @@ behavior of the indirect buffer."
(funcall pp-default-function beg end)
end))
+;;; Input history
+
+(defvar ielm--exit nil
+ "Function to call when Emacs is killed.")
+
+(defun ielm--input-history-writer (buf)
+ "Return a function writing IELM input history to BUF."
+ (lambda ()
+ (with-current-buffer buf
+ (comint-write-input-ring))))
+
;;; Major mode
(define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM"
@@ -605,6 +623,17 @@ Customized bindings may be defined in `ielm-map', which
currently contains:
#'ielm-indirect-setup-hook 'append t)
(setq comint-indirect-setup-function #'emacs-lisp-mode)
+ ;; Input history
+ (setq-local comint-input-ring-file-name ielm-history-file-name)
+ (setq-local ielm--exit (ielm--input-history-writer (current-buffer)))
+ (setq-local kill-buffer-hook
+ (lambda ()
+ (funcall ielm--exit)
+ (remove-hook 'kill-emacs-hook ielm--exit)))
+ (unless noninteractive
+ (add-hook 'kill-emacs-hook ielm--exit))
+ (comint-read-input-ring t)
+
;; A dummy process to keep comint happy. It will never get any input
(unless (comint-check-proc (current-buffer))
;; Was cat, but on non-Unix platforms that might not exist, so
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 205141577c9..0f2297465fe 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -134,6 +134,7 @@ Examples of image filename patterns to match:
:max-width (- (nth 2 edges) (nth 0 edges))
:max-height (- (nth 3 edges) (nth 1 edges)))
keymap ,image-map
+ context-menu-functions (image-context-menu)
modification-hooks
(iimage-modification-hook)))
(remove-list-of-text-properties
diff --git a/lisp/image.el b/lisp/image.el
index 73801f88d1e..c13fea6c45c 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -193,6 +193,29 @@ or \"ffmpeg\") is installed."
"h" #'image-flip-horizontally
"v" #'image-flip-vertically))
+(defun image-context-menu (menu click)
+ "Populate MENU with image-related commands at CLICK."
+ (when (mouse-posn-property (event-start click) 'display)
+ (define-key menu [image-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Image")))
+ (easy-menu-define nil easy-menu nil
+ '("Image"
+ ["Zoom In" image-increase-size
+ :help "Enlarge the image"]
+ ["Zoom Out" image-decrease-size
+ :help "Shrink the image"]
+ ["Rotate Clockwise" image-rotate
+ :help "Rotate the image"]
+ ["Flip horizontally" image-flip-horizontally
+ :help "Flip horizontally"]
+ ["Flip vertically" image-flip-vertically
+ :help "Flip vertically"]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar image])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item))))))
+
+ menu)
+
(defun image-load-path-for-library (library image &optional path no-error)
"Return a suitable search path for images used by LIBRARY.
@@ -494,9 +517,13 @@ use its file extension as image type.
Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
Optional PROPS are additional image attributes to assign to the image,
-like, e.g. `:mask MASK'. If the property `:scale' is not given and the
-display has a high resolution (more exactly, when the average width of a
-character in the default font is more than 10 pixels), the image is
+like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for
+the list of supported properties; see the nodes following that node
+for properties specific to certain image types.
+
+If the property `:scale' is not given and the display has a high
+resolution (more exactly, when the average width of a character
+in the default font is more than 10 pixels), the image is
automatically scaled up in proportion to the default font.
Value is the image created, or nil if images of type TYPE are not supported.
@@ -571,7 +598,11 @@ Internal use only."
Properties can be set with
(setf (image-property IMAGE PROPERTY) VALUE)
-If VALUE is nil, PROPERTY is removed from IMAGE."
+If VALUE is nil, PROPERTY is removed from IMAGE.
+
+See Info node `(elisp)Image Descriptors' for the list of
+supported properties; see the nodes following that node for
+properties specific to certain image types."
(declare (gv-setter image--set-property))
(plist-get (cdr image) property))
@@ -620,6 +651,7 @@ means display it in the right marginal area."
(overlay-put overlay 'put-image t)
(overlay-put overlay 'before-string string)
(overlay-put overlay 'keymap image-map)
+ (overlay-put overlay 'context-menu-functions '(image-context-menu))
overlay)))
@@ -672,8 +704,9 @@ is non-nil, this is inhibited."
inhibit-isearch ,inhibit-isearch
keymap ,(if slice
image-slice-map
- image-map)))))
-
+ image-map)
+ context-menu-functions
+ (image-context-menu)))))
;;;###autoload
(defun insert-sliced-image (image &optional string area rows cols)
@@ -709,7 +742,9 @@ The image is automatically split into ROWS x COLS slices."
(add-text-properties start (point)
`(display ,(list (list 'slice x y dx dy) image)
rear-nonsticky (display keymap)
- keymap ,image-slice-map))
+ keymap ,image-slice-map
+ context-menu-functions
+ (image-context-menu)))
(setq x (+ x dx))))
(setq x 0.0
y (+ y dy))
@@ -759,21 +794,25 @@ BUFFER nil or omitted means use the current buffer."
;;;###autoload
(defun find-image (specs &optional cache)
- "Find an image, choosing one of a list of image specifications.
+ "Find an image that satisfies one of a list of image specifications.
SPECS is a list of image specifications.
-Each image specification in SPECS is a property list. The contents of
-a specification are image type dependent. All specifications must at
-least contain either the property `:file FILE' or `:data DATA',
-where FILE is the file to load the image from, and DATA is a string
-containing the actual image data. If the property `:type TYPE' is
-omitted or nil, try to determine the image type from its first few
+Each image specification in SPECS is a property list. The
+contents of a specification are image type dependent; see the
+info node `(elisp)Image Descriptors' for details. All specifications
+must at least contain either the property `:file FILE' or `:data DATA',
+where FILE is the file from which to load the image, and DATA is a
+string containing the actual image data. If the property `:type TYPE'
+is omitted or nil, try to determine the image type from its first few
bytes of image data. If that doesn't work, and the property `:file
-FILE' provide a file name, use its file extension as image type.
-If `:type TYPE' is provided, it must match the actual type
-determined for FILE or DATA by `create-image'. Return nil if no
-specification is satisfied.
+FILE' provide a file name, use its file extension as idication of the
+image type. If `:type TYPE' is provided, it must match the actual type
+determined for FILE or DATA by `create-image'.
+
+The function returns the image specification for the first specification
+in the list whose TYPE is supported and FILE, if specified, exists. It
+returns nil if no specification in the list can be satisfied.
If CACHE is non-nil, results are cached and returned on subsequent calls.
diff --git a/lisp/info-look.el b/lisp/info-look.el
index da7beafe500..cd59fdf17d7 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -985,9 +985,8 @@ Return nil if there is nothing appropriate in the buffer
near point."
finally return "(python)Index")))))
(info-lookup-maybe-add-help
- :mode 'cperl-mode
- :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*"
- :other-modes '(perl-mode))
+ :mode 'perl-mode
+ :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*")
(info-lookup-maybe-add-help
:mode 'latex-mode
diff --git a/lisp/info.el b/lisp/info.el
index e91cc7b8e54..176bc9c0033 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -231,8 +231,9 @@ Each element of this list has the form (MANUALs . URL-SPEC).
MANUALs represents the name of one or more manuals. It can
either be a string or a list of strings. URL-SPEC can be a
string in which the substring \"%m\" will be expanded to the
-manual-name, \"%n\" to the node-name, and \"%e\" to the
-URL-encoded node-name (without a `.html' suffix). (The
+manual-name and \"%n\" to the node-name. \"%e\" will expand to
+the URL-encoded node-name, including the `.html' extension; in
+case of the Top node, it will expand to the empty string. (The
URL-encoding of the node-name mimics GNU Texinfo, as documented
at Info node `(texinfo)HTML Xref Node Name Expansion'.)
Alternatively, URL-SPEC can be a function which is given
@@ -499,6 +500,7 @@ or `Info-virtual-nodes'."
(".info.bz2" . ("bzip2" "-dc"))
(".info.xz" . "unxz")
(".info.zst" . ("zstd" "-dc"))
+ (".info.lz" . ("lzip" "-dc"))
(".info" . nil)
("-info.Z" . "uncompress")
("-info.Y" . "unyabba")
@@ -507,6 +509,7 @@ or `Info-virtual-nodes'."
("-info.z" . "gunzip")
("-info.xz" . "unxz")
("-info.zst" . ("zstd" "-dc"))
+ ("-info.lz" . ("lzip" "-dc"))
("-info" . nil)
("/index.Z" . "uncompress")
("/index.Y" . "unyabba")
@@ -515,6 +518,7 @@ or `Info-virtual-nodes'."
("/index.bz2" . ("bzip2" "-dc"))
("/index.xz" . "unxz")
("/index.zst" . ("zstd" "-dc"))
+ ("/index.lz" . ("lzip" "-dc"))
("/index" . nil)
(".Z" . "uncompress")
(".Y" . "unyabba")
@@ -523,6 +527,7 @@ or `Info-virtual-nodes'."
(".bz2" . ("bzip2" "-dc"))
(".xz" . "unxz")
(".zst" . ("zstd" "-dc"))
+ (".lz" . ("lzip" "-dc"))
("" . nil)))
"List of file name suffixes and associated decoding commands.
Each entry should be (SUFFIX . STRING); the file is given to
@@ -1924,18 +1929,20 @@ NODE should be a string of the form \"(manual)Node\"."
;; (info "(texinfo) HTML Xref Node Name Expansion")
(if (equal node "Top")
""
- (url-hexify-string
- (string-replace " " "-"
- (mapconcat
- (lambda (ch)
- (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^-
- (<= 33 ch 47) ; !"#$%&'()*+,-./
- (<= 58 ch 64) ; :;<=>?@
- (<= 91 ch 96) ; [\]_`
- (<= 123 ch 127)) ; {|}~ DEL
- (format "_00%x" ch)
- (char-to-string ch)))
- node ""))))))
+ (concat
+ (url-hexify-string
+ (string-replace " " "-"
+ (mapconcat
+ (lambda (ch)
+ (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^-
+ (<= 33 ch 47) ; !"#$%&'()*+,-./
+ (<= 58 ch 64) ; :;<=>?@
+ (<= 91 ch 96) ; [\]_`
+ (<= 123 ch 127)) ; {|}~ DEL
+ (format "_00%x" ch)
+ (char-to-string ch)))
+ node "")))
+ ".html"))))
(cond
((stringp url-spec)
(format-spec url-spec
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index c4706e061e3..42584f6548c 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -31,12 +31,12 @@
;; Convert cxterm dictionary (of TIT format) to quail-package.
;;
;; Usage (within Emacs):
-;; M-x titdic-convert<CR>CXTERM-DICTIONARY-NAME<CR>
+;; M-x tit-dic-convert<CR>CXTERM-DICTIONARY-NAME<CR>
;; Usage (from shell):
-;; % emacs -batch -l titdic-cnv -f batch-titdic-convert\
+;; % emacs -batch -l titdic-cnv -f batch-tit-dic-convert\
;; [-dir DIR] [DIR | FILE] ...
;;
-;; When you run titdic-convert within Emacs, you have a chance to
+;; When you run `tit-dic-convert' within Emacs, you have a chance to
;; modify arguments of `quail-define-package' before saving the
;; converted file. For instance, you are likely to modify TITLE,
;; DOCSTRING, and KEY-BINDINGS.
@@ -90,7 +90,8 @@
;; \<quail-translation-docstring> is replaced by a description about
;; how to select a translation from a list of candidates.
-(defvar quail-cxterm-package-ext-info
+(define-obsolete-variable-alias 'quail-cxterm-package-ext-info
'tit-quail-cxterm-package-ext-info "30.1")
+(defvar tit-quail-cxterm-package-ext-info
'(("chinese-4corner" "四角")
("chinese-array30" "３０")
("chinese-ccdospy" "缩拼"
@@ -277,7 +278,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲,
4:去聲,
(tit-moveleft ",<")
(tit-keyprompt nil))
- (generate-lisp-file-heading filename 'titdic-convert :code nil)
+ (generate-lisp-file-heading filename 'tit-dic-convert :code nil)
(princ ";; Quail package `")
(princ package)
(princ "\n")
@@ -354,7 +355,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲,
4:去聲,
(princ "(quail-define-package ")
;; Args NAME, LANGUAGE, TITLE
- (let ((title (nth 1 (assoc package quail-cxterm-package-ext-info))))
+ (let ((title (nth 1 (assoc package tit-quail-cxterm-package-ext-info))))
(princ "\"")
(princ package)
(princ "\" \"")
@@ -383,7 +384,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲,
4:去聲,
(let ((doc (concat tit-prompt "\n"))
(comments (if tit-comments
(mapconcat #'identity (nreverse tit-comments) "\n")))
- (doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info))))
+ (doc-ext (nth 2 (assoc package tit-quail-cxterm-package-ext-info))))
(if comments
(setq doc (concat doc "\n" comments "\n")))
(if doc-ext
@@ -476,6 +477,9 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲,
4:去聲,
;;;###autoload
(defun titdic-convert (filename &optional dirname)
+ (declare (obsolete tit-dic-convert "30.1"))
+ (tit-dic-convert filename dirname))
+(defun tit-dic-convert (filename &optional dirname)
"Convert a TIT dictionary of FILENAME into a Quail package.
Optional argument DIRNAME if specified is the directory name under which
the generated Quail package is saved."
@@ -531,21 +535,24 @@ the generated Quail package is saved."
;;;###autoload
(defun batch-titdic-convert (&optional force)
- "Run `titdic-convert' on the files remaining on the command line.
+ (declare (obsolete batch-tit-dic-convert "30.1"))
+ (batch-tit-dic-convert force))
+(defun batch-tit-dic-convert (&optional force)
+ "Run `tit-dic-convert' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
-For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
+For example, invoke \"emacs -batch -f batch-tit-dic-convert XXX.tit\" to
generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
-To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
+To get complete usage, invoke \"emacs -batch -f batch-tit-dic-convert -h\"."
(defvar command-line-args-left) ; Avoid compiler warning.
(if (not noninteractive)
- (error "`batch-titdic-convert' should be used only with -batch"))
+ (error "`batch-tit-dic-convert' should be used only with -batch"))
(if (string= (car command-line-args-left) "-h")
(progn
(message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:")
- (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert
XXX.tit YYY.tit")
+ (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert
XXX.tit YYY.tit")
(message "To convert XXX.tit into DIR/xxx.el:")
- (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir
DIR XXX.tit"))
+ (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert -dir
DIR XXX.tit"))
(let (targetdir filename files file)
(if (string= (car command-line-args-left) "-dir")
(progn
@@ -564,7 +571,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
(when (or force
(file-newer-than-file-p
file (tit-make-quail-package-file-name file targetdir)))
- (titdic-convert file targetdir))
+ (tit-dic-convert file targetdir))
(setq files (cdr files)))
(setq command-line-args-left (cdr command-line-args-left)))))
(kill-emacs 0))
@@ -583,10 +590,11 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; COPYRIGHT-NOTICE ;; Copyright notice of the source dictionary.
;; )
-(defvar quail-misc-package-ext-info
+(define-obsolete-variable-alias 'quail-misc-package-ext-info
'tit-quail-misc-package-ext-info "30.1")
+(defvar tit-quail-misc-package-ext-info
'(("chinese-b5-tsangchi" "倉B"
"cangjie-table.b5" big5 "tsang-b5.el"
- tsang-b5-converter
+ tit--tsang-b5-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;; #
@@ -596,7 +604,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
("chinese-b5-quick" "簡B"
"cangjie-table.b5" big5 "quick-b5.el"
- quick-b5-converter
+ tit--quick-b5-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;; #
@@ -606,7 +614,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
("chinese-cns-tsangchi" "倉C"
"cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el"
- tsang-cns-converter
+ tit--tsang-cns-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;; #
@@ -616,7 +624,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
("chinese-cns-quick" "簡C"
"cangjie-table.cns" iso-2022-cn-ext "quick-cns.el"
- quick-cns-converter
+ tit--quick-cns-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;; #
@@ -626,7 +634,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
("chinese-py" "拼G"
"pinyin.map" cn-gb-2312 "PY.el"
- py-converter
+ tit--py-converter
"\
;; \"pinyin.map\" is included in a free package called CCE. It is
;; available at: [link needs updating -- SK 2021-09-27]
@@ -654,7 +662,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
("chinese-ziranma" "自然"
"ziranma.cin" cn-gb-2312 "ZIRANMA.el"
- ziranma-converter
+ tit--ziranma-converter
"\
;; \"ziranma.cin\" is included in a free package called CCE. It is
;; available at: [link needs updating -- SK 2021-09-27]
@@ -682,7 +690,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
("chinese-ctlau" "刘粤"
"CTLau.html" cn-gb-2312 "CTLau.el"
- ctlau-gb-converter
+ tit--ctlau-gb-converter
"\
;; \"CTLau.html\" is available at:
;;
@@ -707,7 +715,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
("chinese-ctlaub" "劉粵"
"CTLau-b5.html" big5 "CTLau-b5.el"
- ctlau-b5-converter
+ tit--ctlau-b5-converter
"\
;; \"CTLau-b5.html\" is available at:
;;
@@ -740,7 +748,8 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; input method is for inputting Big5 characters. Otherwise the input
;; method is for inputting CNS characters.
-(defun tsang-quick-converter (dicbuf tsang-p big5-p)
+(define-obsolete-function-alias 'tsang-quick-converter
#'tit--tsang-quick-converter "30.1")
+(defun tit--tsang-quick-converter (dicbuf tsang-p big5-p)
(let ((fulltitle (if tsang-p "倉頡" "簡易"))
dic)
(goto-char (point-max))
@@ -822,23 +831,28 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
(if big5-p (nth 1 elt) (nth 2 elt))))))
(insert ")\n")))
-(defun tsang-b5-converter (dicbuf)
- (tsang-quick-converter dicbuf t t))
+(define-obsolete-function-alias 'tsang-b5-converter #'tit--tsang-b5-converter
"30.1")
+(defun tit--tsang-b5-converter (dicbuf)
+ (tit--tsang-quick-converter dicbuf t t))
-(defun quick-b5-converter (dicbuf)
- (tsang-quick-converter dicbuf nil t))
+(define-obsolete-function-alias 'quick-b5-converter #'tit--quick-b5-converter
"30.1")
+(defun tit--quick-b5-converter (dicbuf)
+ (tit--tsang-quick-converter dicbuf nil t))
-(defun tsang-cns-converter (dicbuf)
- (tsang-quick-converter dicbuf t nil))
+(define-obsolete-function-alias 'tsang-cns-converter
#'tit--tsang-cns-converter "30.1")
+(defun tit--tsang-cns-converter (dicbuf)
+ (tit--tsang-quick-converter dicbuf t nil))
-(defun quick-cns-converter (dicbuf)
- (tsang-quick-converter dicbuf nil nil))
+(define-obsolete-function-alias 'quick-cns-converter
#'tit--quick-cns-converter "30.1")
+(defun tit--quick-cns-converter (dicbuf)
+ (tit--tsang-quick-converter dicbuf nil nil))
;; Generate a code of a Quail package in the current buffer from
;; Pinyin dictionary in the buffer DICBUF. The input method name of
;; the Quail package is NAME, and the title string is TITLE.
-(defun py-converter (dicbuf)
+(define-obsolete-function-alias 'py-converter #'tit--py-converter "30.1")
+(defun tit--py-converter (dicbuf)
(goto-char (point-max))
(insert (format "%S\n" "汉字输入∷拼音∷
@@ -913,7 +927,8 @@ method `chinese-tonepy' with which you must specify tones
by digits
;; Ziranma dictionary in the buffer DICBUF. The input method name of
;; the Quail package is NAME, and the title string is TITLE.
-(defun ziranma-converter (dicbuf)
+(define-obsolete-function-alias 'ziranma-converter #'tit--ziranma-converter
"30.1")
+(defun tit--ziranma-converter (dicbuf)
(let (dic)
(with-current-buffer dicbuf
(goto-char (point-min))
@@ -1022,7 +1037,8 @@ To input symbols and punctuation, type `/' followed by
one of `a' to
;; method name of the Quail package is NAME, and the title string is
;; TITLE. DESCRIPTION is the string shown by describe-input-method.
-(defun ctlau-converter (dicbuf description)
+(define-obsolete-function-alias 'ctlau-converter #'tit--ctlau-converter "30.1")
+(defun tit--ctlau-converter (dicbuf description)
(goto-char (point-max))
(insert (format "%S\n" description))
(insert " '((\"\C-?\" . quail-delete-last-char)
@@ -1071,8 +1087,9 @@ To input symbols and punctuation, type `/' followed by
one of `a' to
(forward-line 1)))
(insert ")\n"))
-(defun ctlau-gb-converter (dicbuf)
- (ctlau-converter dicbuf
+(define-obsolete-function-alias 'ctlau-gb-converter #'tit--ctlau-gb-converter
"30.1")
+(defun tit--ctlau-gb-converter (dicbuf)
+ (tit--ctlau-converter dicbuf
"汉字输入∷刘锡祥式粤音∷
刘锡祥式粤语注音方案
@@ -1085,8 +1102,9 @@ To input symbols and punctuation, type `/' followed by
one of `a' to
Some infrequent GB characters are accessed by typing \\, followed by
the Cantonese romanization of the respective radical (部首)."))
-(defun ctlau-b5-converter (dicbuf)
- (ctlau-converter dicbuf
+(define-obsolete-function-alias 'ctlau-b5-converter #'tit--ctlau-b5-converter
"30.1")
+(defun tit--ctlau-b5-converter (dicbuf)
+ (tit--ctlau-converter dicbuf
"漢字輸入：劉錫祥式粵音：
劉錫祥式粵語注音方案
@@ -1101,14 +1119,15 @@ To input symbols and punctuation, type `/' followed by
one of `a' to
(declare-function dos-8+3-filename "dos-fns.el" (filename))
-(defun miscdic-convert (filename &optional dirname)
+(define-obsolete-function-alias 'miscdic-convert #'tit-miscdic-convert "30.1")
+(defun tit-miscdic-convert (filename &optional dirname)
"Convert a dictionary file FILENAME into a Quail package.
Optional argument DIRNAME if specified is the directory name under which
the generated Quail package is saved."
(interactive "FInput method dictionary file: ")
(or (file-readable-p filename)
(error "%s does not exist" filename))
- (let ((tail quail-misc-package-ext-info)
+ (let ((tail tit-quail-misc-package-ext-info)
coding-system-for-write
slot
name title dicfile coding quailfile converter copyright)
@@ -1137,7 +1156,7 @@ the generated Quail package is saved."
;; Explicitly set eol format to `unix'.
(setq coding-system-for-write 'utf-8-unix)
(with-temp-file (expand-file-name quailfile dirname)
- (generate-lisp-file-heading quailfile 'miscdic-convert)
+ (generate-lisp-file-heading quailfile 'tit-miscdic-convert)
(insert (format-message ";; Quail package `%s'\n" name))
(insert ";; Source dictionary file: " dicfile "\n")
(insert ";; Copyright notice of the source file\n")
@@ -1164,15 +1183,17 @@ the generated Quail package is saved."
quailfile :inhibit-provide t :compile t :coding nil)))
(setq tail (cdr tail)))))
-(defun batch-miscdic-convert ()
- "Run `miscdic-convert' on the files remaining on the command line.
+;; Used in `Makefile.in'.
+(define-obsolete-function-alias 'batch-miscdic-convert
#'batch-tit-miscdic-convert "30.1")
+(defun batch-tit-miscdic-convert ()
+ "Run `tit-miscdic-convert' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
If there's an argument \"-dir\", the next argument specifies a directory
to store generated Quail packages."
(defvar command-line-args-left) ; Avoid compiler warning.
(if (not noninteractive)
- (error "`batch-miscdic-convert' should be used only with -batch"))
+ (error "`batch-tit-miscdic-convert' should be used only with -batch"))
(let ((dir default-directory)
filename)
(while command-line-args-left
@@ -1186,11 +1207,13 @@ to store generated Quail packages."
(if (file-directory-p filename)
(dolist (file (directory-files filename t nil t))
(or (file-directory-p file)
- (miscdic-convert file dir)))
- (miscdic-convert filename dir))))
+ (tit-miscdic-convert file dir)))
+ (tit-miscdic-convert filename dir))))
(kill-emacs 0))
-(defun pinyin-convert ()
+;; Used in `Makefile.in'.
+(define-obsolete-function-alias 'pinyin-convert #'tit-pinyin-convert "30.1")
+(defun tit-pinyin-convert ()
"Convert text file pinyin.map into an elisp library.
The library is named pinyin.el, and contains the constant
`pinyin-character-map'."
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index 93e8ab24971..b058eab7029 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -29,8 +29,8 @@
;;;###autoload
(defun setup-japanese-environment-internal ()
- (prefer-coding-system (if (memq system-type '(windows-nt ms-dos cygwin))
- 'japanese-shift-jis
+ (prefer-coding-system (if (memq system-type '(windows-nt ms-dos))
+ 'japanese-cp932
'utf-8))
(use-cjk-char-width-table 'ja_JP))
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index dd65409c839..8957d1a49af 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -79,7 +79,7 @@
(#x00A2 . #xFFE0) ; CENT SIGN FULLWIDTH CENT SIGN
(#x00A3 . #xFFE1) ; POUND SIGN FULLWIDTH POUND SIGN
(#x00AC . #xFFE2) ; NOT SIGN FULLWIDTH NOT SIGN
- (#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
+ (#x00A6 . #xFFE4) ; BROKEN BAR FULLWIDTH BROKEN BAR
)))
(define-translation-table 'japanese-ucs-jis-to-cp932-map map)
(setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index ceef383b45a..a435b2e4b19 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -729,19 +729,19 @@ CONCEALED:
CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED.
OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be.
-This is a minor mode. If called interactively, toggle the
-`Allout mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Allout mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `allout-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(define-obsolete-function-alias 'outlinify-sticky #'allout-outlinify-sticky
"29.1")
@@ -803,18 +803,18 @@ bindings for easy outline navigation and exposure
control, extending
outline hot-spot navigation (see `allout-mode').
This is a minor mode. If called interactively, toggle the
-`Allout-Widgets mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Allout-Widgets mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `allout-widgets-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "allout-widgets" '("allout-"))
@@ -1389,19 +1389,19 @@ Keymap summary
\\{artist-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Artist mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Artist mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `artist-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "artist" '("artist-"))
@@ -1534,18 +1534,18 @@ When Auto-insert mode is enabled, when new files are
created you can
insert a template for the file depending on the mode of the buffer.
This is a global minor mode. If called interactively, toggle the
-`Auto-Insert mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Auto-Insert mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='auto-insert-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "autoinsert" '("auto-insert"))
@@ -1571,19 +1571,19 @@ Use `global-auto-revert-mode' to automatically revert
all buffers.
Use `auto-revert-tail-mode' if you know that the file will only grow
without being changed in the part that is already in the buffer.
-This is a minor mode. If called interactively, toggle the
-`Auto-Revert mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Auto-Revert
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `auto-revert-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'turn-on-auto-revert-mode "autorevert" "\
@@ -1610,19 +1610,18 @@ suppressed by setting `auto-revert-verbose' to nil.
Use `auto-revert-mode' for changes other than appends!
This is a minor mode. If called interactively, toggle the
-`Auto-Revert-Tail mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Auto-Revert-Tail mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `auto-revert-tail-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'turn-on-auto-revert-tail-mode "autorevert" "\
@@ -1659,19 +1658,18 @@ It displays the text that `global-auto-revert-mode-text'
specifies in the mode line.
This is a global minor mode. If called interactively, toggle the
-`Global Auto-Revert mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Global Auto-Revert mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='global-auto-revert-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "autorevert" '("auto-revert-"
"global-auto-revert-"))
@@ -1774,18 +1772,18 @@ functions in `battery-update-functions', which can be
used to
trigger actions based on battery-related events.
This is a global minor mode. If called interactively, toggle the
-`Display-Battery mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Display-Battery mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='display-battery-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "battery" '("battery-"))
@@ -1949,6 +1947,10 @@ Major mode for editing BibTeX style files.
;;; Generated autoloads from bind-key.el
(push (purecopy '(bind-key 2 4 1)) package--builtin-versions)
+(defvar personal-keybindings nil "\
+List of bindings performed by `bind-key'.
+
+Elements have the form ((KEY . [MAP]) CMD ORIGINAL-CMD)")
(autoload 'bind-key "bind-key" "\
Bind KEY-NAME to COMMAND in KEYMAP (`global-map' if not passed).
@@ -2022,7 +2024,7 @@ other modes. See `override-global-mode'.
(fn &rest ARGS)" nil t)
(autoload 'describe-personal-keybindings "bind-key" "\
Display all the personal keybindings defined by `bind-key'." t)
-(register-definition-prefixes "bind-key" '("bind-key" "override-global-m"
"personal-keybindings"))
+(register-definition-prefixes "bind-key" '("bind-key" "override-global-m"))
;;; Generated autoloads from emacs-lisp/bindat.el
@@ -2755,37 +2757,36 @@ columns on its right towards the left.
Toggle hyperlinking bug references in the buffer (Bug Reference mode).
This is a minor mode. If called interactively, toggle the
-`Bug-Reference mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Bug-Reference mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `bug-reference-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'bug-reference-prog-mode "bug-reference" "\
Like `bug-reference-mode', but only buttonize in comments and strings.
This is a minor mode. If called interactively, toggle the
-`Bug-Reference-Prog mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Bug-Reference-Prog mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `bug-reference-prog-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "bug-reference" '("bug-reference-"))
@@ -2939,12 +2940,6 @@ and corresponding effects.
;;; Generated autoloads from progmodes/c-ts-mode.el
-(autoload 'c-ts-base-mode "c-ts-mode" "\
-Major mode for editing C, powered by tree-sitter.
-
-\\{c-ts-base-mode-map}
-
-(fn)" t)
(autoload 'c-ts-mode "c-ts-mode" "\
Major mode for editing C, powered by tree-sitter.
@@ -2994,6 +2989,7 @@ should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-ts-mode' or `c++-ts-mode'." t)
+(make-obsolete 'c-or-c++-ts-mode 'c-or-c++-mode "30.1")
(register-definition-prefixes "c-ts-mode" '("c-ts-"))
@@ -4380,19 +4376,19 @@ checking of documentation strings.
\\{checkdoc-minor-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Checkdoc minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Checkdoc
+minor mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `checkdoc-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'checkdoc-package-keywords "checkdoc" "\
@@ -4478,19 +4474,18 @@ or call the function `cl-font-lock-built-in-mode'.")
Highlight built-in functions, variables, and types in `lisp-mode'.
This is a global minor mode. If called interactively, toggle the
-`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='cl-font-lock-built-in-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "cl-font-lock" '("cl-font-lock-"))
@@ -4620,19 +4615,18 @@ macro-expansion of `cl-defstruct' that used vectors
objects instead
of record objects.
This is a global minor mode. If called interactively, toggle the
-`Cl-Old-Struct-Compat mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Cl-Old-Struct-Compat mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='cl-old-struct-compat-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "cl-lib" '("cl-"))
@@ -5032,6 +5026,16 @@ on third call it again advances points to the next
difference and so on.
(register-definition-prefixes "compare-w" '("compare-"))
+;;; Generated autoloads from emacs-lisp/compat.el
+
+ (push (list 'compat
+ emacs-major-version
+ emacs-minor-version
+ 9999)
+ package--builtin-versions)
+(register-definition-prefixes "compat" '("compat-"))
+
+
;;; Generated autoloads from image/compface.el
(register-definition-prefixes "compface" '("uncompface"))
@@ -5180,18 +5184,18 @@ See `compilation-mode'.
This is a minor mode. If called interactively, toggle the
`Compilation-Shell minor mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `compilation-shell-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'compilation-minor-mode "compile" "\
@@ -5201,20 +5205,19 @@ When Compilation minor mode is enabled, all the
error-parsing
commands of Compilation major mode are available. See
`compilation-mode'.
-This is a minor mode. If called interactively, toggle the
-`Compilation minor mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Compilation
+minor mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `compilation-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'compilation-next-error-function "compile" "\
@@ -5272,19 +5275,18 @@ this mode: `enable-completion',
`save-completions-flag', and
options can be found in the `completion' group.
This is a global minor mode. If called interactively, toggle the
-`Dynamic-Completion mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Dynamic-Completion mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='dynamic-completion-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "completion" '("*c-def-regexp*"
"*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-"
"check-completion-length" "clear-all-completions" "cmpl-" "complet"
"current-completion-source" "delete-completion" "enable-completion" "find-"
"inside-locate-completion-entry" "interactive-completion-string-reader" "kill-"
"list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev"
"num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-comp [...]
@@ -5304,19 +5306,18 @@ completion suggestion, and
\\[completion-preview-prev-candidate]
cycles backward.
This is a minor mode. If called interactively, toggle the
-`Completion-Preview mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Completion-Preview mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `completion-preview-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "completion-preview" '("completion-preview-"))
@@ -5543,6 +5544,7 @@ If FIX is non-nil, run `copyright-fix-years' instead.
;;; Generated autoloads from progmodes/cperl-mode.el
+(put 'cperl-file-style 'safe-local-variable 'stringp)
(put 'cperl-indent-level 'safe-local-variable 'integerp)
(put 'cperl-brace-offset 'safe-local-variable 'integerp)
(put 'cperl-continued-brace-offset 'safe-local-variable 'integerp)
@@ -5550,7 +5552,6 @@ If FIX is non-nil, run `copyright-fix-years' instead.
(put 'cperl-continued-statement-offset 'safe-local-variable 'integerp)
(put 'cperl-extra-newline-before-brace 'safe-local-variable 'booleanp)
(put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp)
-(put 'cperl-file-style 'safe-local-variable 'stringp)
(autoload 'cperl-mode "cperl-mode" "\
Major mode for editing Perl code.
Expression and list commands understand all C brackets.
@@ -5903,19 +5904,19 @@ You can customize `cua-enable-cua-keys' to completely
disable the
CUA bindings, or `cua-prefix-override-inhibit-delay' to change
the prefix fallback behavior.
-This is a global minor mode. If called interactively, toggle the
-`Cua mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the `Cua
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='cua-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'cua-selection-mode "cua-base" "\
@@ -5938,19 +5939,18 @@ Toggle the region as rectangular.
Activates the region if needed. Only lasts until the region is deactivated.
This is a minor mode. If called interactively, toggle the
-`Cua-Rectangle-Mark mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Cua-Rectangle-Mark mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `cua-rectangle-mark-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "cua-rect" '("cua-"))
@@ -5966,19 +5966,18 @@ By convention, this is a list of symbols where each
symbol stands for the
Keep cursor outside of any `cursor-intangible' text property.
This is a minor mode. If called interactively, toggle the
-`Cursor-Intangible mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Cursor-Intangible mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `cursor-intangible-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'cursor-sensor-mode "cursor-sensor" "\
@@ -5991,18 +5990,18 @@ the cursor and DIR can be `entered' or `left' depending
on whether the cursor
is entering the area covered by the text-property property or leaving it.
This is a minor mode. If called interactively, toggle the
-`Cursor-Sensor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Cursor-Sensor mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `cursor-sensor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "cursor-sensor" '("cursor-sensor-"))
@@ -6115,6 +6114,11 @@ Customize GROUP, which must be a customization group, in
another window.
Customize SYMBOL, which must be a user option.
(fn SYMBOL)" t)
+(autoload 'customize-toggle-option "cus-edit" "\
+Toggle the value of boolean option SYMBOL for this session.
+
+(fn SYMBOL)" t)
+(defalias 'toggle-option #'customize-toggle-option)
(defalias 'customize-variable-other-window 'customize-option-other-window)
(autoload 'customize-option-other-window "cus-edit" "\
Customize SYMBOL, which must be a user option.
@@ -6368,19 +6372,19 @@ Note, in addition to enabling this minor mode, the
major mode must
be included in the variable `cwarn-configuration'. By default C and
C++ modes are included.
-This is a minor mode. If called interactively, toggle the `Cwarn
-mode' mode. If the prefix argument is positive, enable the mode,
-and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Cwarn mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `cwarn-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-cwarn-mode 'globalized-minor-mode t)
@@ -6873,19 +6877,18 @@ See `delete-selection-helper' and
`delete-selection-pre-hook' for
information on adapting behavior of commands in Delete Selection mode.
This is a global minor mode. If called interactively, toggle the
-`Delete-Selection mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Delete-Selection mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='delete-selection-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'delete-active-region "delsel" "\
@@ -6966,13 +6969,6 @@ See Info node `(elisp)Derived Modes' for more details.
(fn CHILD PARENT NAME [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)" nil t)
(function-put 'define-derived-mode 'doc-string-elt 4)
(function-put 'define-derived-mode 'lisp-indent-function 'defun)
-(autoload 'derived-mode-init-mode-variables "derived" "\
-Initialize variables for a new MODE.
-Right now, if they don't already exist, set up a blank keymap, an
-empty syntax table, and an empty abbrev table -- these will be merged
-the first time the mode is used.
-
-(fn MODE)")
(register-definition-prefixes "derived" '("derived-mode-"))
@@ -7044,13 +7040,22 @@ or call the function `desktop-save-mode'.")
(autoload 'desktop-save-mode "desktop" "\
Toggle desktop saving (Desktop Save mode).
-When Desktop Save mode is enabled, the state of Emacs is saved from
-one session to another. In particular, Emacs will save the desktop when
-it exits (this may prompt you; see the option `desktop-save'). The next
-time Emacs starts, if this mode is active it will restore the desktop.
+When Desktop Save mode is enabled, the state of Emacs is saved from one
+session to another. The saved Emacs \"desktop configuration\" includes the
+buffers, their file names, major modes, buffer positions, window and frame
+configuration, and some important global variables.
+
+To enable this feature for future sessions, customize `desktop-save-mode'
+to t, or add this line in your init file:
-To manually save the desktop at any time, use the command `\\[desktop-save]'.
-To load it, use `\\[desktop-read]'.
+ (desktop-save-mode 1)
+
+When this mode is enabled, Emacs will save the desktop when it exits
+(this may prompt you, see the option `desktop-save'). The next time
+Emacs starts, if this mode is active it will restore the desktop.
+
+To manually save the desktop at any time, use the command \\[desktop-save].
+To load it, use \\[desktop-read].
Once a desktop file exists, Emacs will auto-save it according to the
option `desktop-auto-save-timeout'.
@@ -7060,18 +7065,18 @@ To see all the options you can set, browse the
`desktop' customization group.
For further details, see info node `(emacs)Saving Emacs Sessions'.
This is a global minor mode. If called interactively, toggle the
-`Desktop-Save mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Desktop-Save mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='desktop-save-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar desktop-locals-to-save '(desktop-locals-to-save truncate-lines
case-fold-search case-replace fill-column overwrite-mode
change-log-default-name line-number-mode column-number-mode
size-indication-mode buffer-file-coding-system buffer-display-time
indent-tabs-mode tab-width indicate-buffer-boundaries indicate-empty-lines
show-trailing-whitespace) "\
@@ -7505,19 +7510,19 @@ Toggle Diff minor mode.
\\{diff-minor-mode-map}
-This is a minor mode. If called interactively, toggle the `Diff
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Diff minor
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `diff-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar diff-add-log-use-relative-names nil "\
@@ -7721,19 +7726,19 @@ This is an alternative to `shell-dirtrack-mode', which
works by
tracking `cd' and similar commands which change the shell working
directory.
-This is a minor mode. If called interactively, toggle the
-`Dirtrack mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Dirtrack
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `dirtrack-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'dirtrack "dirtrack" "\
@@ -7752,7 +7757,7 @@ from `default-directory'.
(autoload 'disassemble "disass" "\
Print disassembled code for OBJECT in (optional) BUFFER.
OBJECT can be a symbol defined as a function, or a function itself
-(a lambda expression or a compiled-function object).
+(a lambda expression or a byte-code-function object).
If OBJECT is not already compiled, we compile it, but do not
redefine OBJECT if it is a symbol.
@@ -7907,19 +7912,19 @@ not appear aligned.
See Info node `Displaying Boundaries' for details.
This is a minor mode. If called interactively, toggle the
-`Display-Fill-Column-Indicator mode' mode. If the prefix
-argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+`Display-Fill-Column-Indicator mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `display-fill-column-indicator-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-display-fill-column-indicator-mode 'globalized-minor-mode t)
@@ -7979,19 +7984,18 @@ customize `display-line-numbers-type'. To change the
type while
the mode is on, set `display-line-numbers' directly.
This is a minor mode. If called interactively, toggle the
-`Display-Line-Numbers mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Display-Line-Numbers mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `display-line-numbers-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-display-line-numbers-mode 'globalized-minor-mode t)
@@ -8068,19 +8072,18 @@ of `header-line-format', like this:
See also `line-number-display-width'.
This is a minor mode. If called interactively, toggle the
-`Header-Line-Indent mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Header-Line-Indent mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `header-line-indent-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "display-line-numbers" '("display-line-numbers-"
"header-line-indent--"))
@@ -8181,19 +8184,19 @@ Toggle displaying buffer via Doc View (Doc View minor
mode).
See the command `doc-view-mode' for more information on this mode.
-This is a minor mode. If called interactively, toggle the
-`Doc-View minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Doc-View
+minor mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `doc-view-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'doc-view-bookmark-jump "doc-view" "\
@@ -8252,19 +8255,19 @@ Toggle special insertion on double keypresses (Double
mode).
When Double mode is enabled, some keys will insert different
strings when pressed twice. See `double-map' for details.
-This is a minor mode. If called interactively, toggle the
-`Double mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Double mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `double-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "double" '("double-"))
@@ -8872,18 +8875,18 @@ This global minor mode enables `ede-minor-mode' in all
buffers in
an EDE controlled project.
This is a global minor mode. If called interactively, toggle the
-`Global Ede mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Global Ede mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='global-ede-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "ede" '("ede" "global-ede-mode-map"
"project-try-ede"))
@@ -8921,7 +8924,7 @@ An extant spec symbol is a symbol that is not a function
and has a
`edebug-form-spec' property.
(fn SPEC)")
-(defalias 'edebug-defun 'edebug-eval-top-level-form)
+(defalias 'edebug-defun #'edebug-eval-top-level-form)
(autoload 'edebug-eval-top-level-form "edebug" "\
Evaluate the top level form point is in, stepping through with Edebug.
This is like `eval-defun' except that it steps the code for Edebug
@@ -9287,9 +9290,9 @@ To change the default, set the variable
`ediff-use-toolbar-p', which see." t)
(autoload 'edit-kbd-macro "edmacro" "\
Edit a keyboard macro.
At the prompt, type any key sequence which is bound to a keyboard macro.
-Or, type `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last
-keyboard macro, `\\[view-lossage]' to edit the last 300
-keystrokes as a keyboard macro, or `\\[execute-extended-command]'
+Or, type \\[kmacro-end-and-call-macro] or \\`RET' to edit the last
+keyboard macro, \\[view-lossage] to edit the last 300
+keystrokes as a keyboard macro, or \\[execute-extended-command]
to edit a macro by its command name.
With a prefix argument, format the macro in a more concise way.
@@ -9361,7 +9364,7 @@ Turn on EDT Emulation." t)
;;; Generated autoloads from progmodes/eglot.el
-(push (purecopy '(eglot 1 16)) package--builtin-versions)
+(push (purecopy '(eglot 1 17)) 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.
@@ -9496,7 +9499,7 @@ SUPERCLASSES as children.
It creates an autoload function for CNAME's constructor.
(fn CNAME SUPERCLASSES FILENAME DOC)")
-(register-definition-prefixes "eieio-core" '("class-" "eieio-"
"inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot"))
+(register-definition-prefixes "eieio-core" '("cl--generic-struct-tag" "class-"
"eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot"))
;;; Generated autoloads from emacs-lisp/eieio-custom.el
@@ -9573,37 +9576,36 @@ inserted around the region instead.
To toggle the mode in a single buffer, use `electric-pair-local-mode'.
This is a global minor mode. If called interactively, toggle the
-`Electric-Pair mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Electric-Pair mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='electric-pair-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'electric-pair-local-mode "elec-pair" "\
Toggle `electric-pair-mode' only in this buffer.
This is a minor mode. If called interactively, toggle the
-`Electric-Pair-Local mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Electric-Pair-Local mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `electric-pair-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "elec-pair" '("electric-pair-"))
@@ -9620,19 +9622,19 @@ to `elide-head-headers-to-hide'.
This is suitable as an entry on `find-file-hook' or appropriate
mode hooks.
-This is a minor mode. If called interactively, toggle the
-`Elide-Head mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Elide-Head
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `elide-head-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'elide-head "elide-head" "\
@@ -10000,19 +10002,19 @@ Commands:
\\{enriched-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Enriched mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Enriched
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `enriched-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'enriched-encode "enriched" "\
@@ -10233,19 +10235,19 @@ enough, since keyservers have strict timeout settings.
(autoload 'epa-mail-mode "epa-mail" "\
A minor-mode for composing encrypted/clearsigned mails.
-This is a minor mode. If called interactively, toggle the
-`epa-mail mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `epa-mail
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `epa-mail-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'epa-mail-decrypt "epa-mail" "\
@@ -10295,18 +10297,18 @@ or call the function `epa-global-mail-mode'.")
Minor mode to hook EasyPG into Mail mode.
This is a global minor mode. If called interactively, toggle the
-`Epa-Global-Mail mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Epa-Global-Mail mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='epa-global-mail-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "epa-mail" '("epa-mail-"))
@@ -10358,84 +10360,77 @@ Look at CONFIG and try to expand GROUP.
;;; Generated autoloads from erc/erc.el
(push (purecopy '(erc 5 6 -4)) package--builtin-versions)
+(dolist (symbol '( erc-sasl erc-spelling ; 29
+ erc-imenu erc-nicks)) ; 30
+ (custom-add-load symbol symbol))
+(custom-autoload 'erc-modules "erc")
(autoload 'erc-select-read-args "erc" "\
-Prompt the user for values of nick, server, port, and password.
-With prefix arg, also prompt for user and full name.")
+Prompt for connection parameters and return them in a plist.
+By default, collect `:server', `:port', `:nickname', and
+`:password'. With a non-nil prefix argument, also prompt for
+`:user' and `:full-name'. Also return various environmental
+properties needed by entry-point commands, like `erc-tls'.")
(autoload 'erc-server-select "erc" "\
Interactively connect to a server from `erc-server-alist'." t)
(make-obsolete 'erc-server-select 'erc-tls "30.1")
(autoload 'erc "erc" "\
-ERC is a powerful, modular, and extensible IRC client.
-This function is the main entry point for ERC.
-
-It allows selecting connection parameters, and then starts ERC.
-
-Non-interactively, it takes the keyword arguments
- (server (erc-compute-server))
- (port (erc-compute-port))
- (nick (erc-compute-nick))
- (user (erc-compute-user))
- password
- (full-name (erc-compute-full-name))
- id
-
-That is, if called with
+Connect to an Internet Relay Chat SERVER on a non-TLS PORT.
+Use NICK and USER, when non-nil, to inform the IRC commands of
+the same name, possibly factoring in a non-nil FULL-NAME as well.
+When PASSWORD is non-nil, also send an opening server password
+via the \"PASS\" command. Interactively, prompt for SERVER,
+PORT, NICK, and PASSWORD, along with USER and FULL-NAME when
+given a prefix argument. Non-interactively, expect the rarely
+needed ID parameter, when non-nil, to be a symbol or a string for
+naming the server buffer and identifying the connection
+unequivocally. Once connected, return the server buffer. (See
+Info node `(erc) Connecting' for details about all mentioned
+parameters.)
+
+Together with `erc-tls', this command serves as the main entry
+point for ERC, the powerful, modular, and extensible IRC client.
+Non-interactively, both commands accept the following keyword
+arguments, with their defaults supplied by the indicated
+\"compute\" functions:
+
+ :server `erc-compute-server'
+ :port `erc-compute-port'
+ :nick `erc-compute-nick'
+ :user `erc-compute-user'
+ :password N/A
+ :full-name `erc-compute-full-name'
+ :id' N/A
+
+For example, when called in the following manner
(erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
-then the server and full-name will be set to those values,
-whereas `erc-compute-port' and `erc-compute-nick' will be invoked
-for the values of the other parameters.
-
-See `erc-tls' for the meaning of ID.
+ERC assigns SERVER and FULL-NAME the associated keyword values
+and defers to `erc-compute-port', `erc-compute-user', and
+`erc-compute-nick' for those respective parameters.
(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" '((let
((erc--display-context `((erc-interactive-display . erc)
,@erc--display-context))) (erc-select-read-args))))
(defalias 'erc-select #'erc)
(autoload 'erc-tls "erc" "\
-ERC is a powerful, modular, and extensible IRC client.
-This function is the main entry point for ERC over TLS.
-
-It allows selecting connection parameters, and then starts ERC
-over TLS.
-
-Non-interactively, it takes the keyword arguments
- (server (erc-compute-server))
- (port (erc-compute-port))
- (nick (erc-compute-nick))
- (user (erc-compute-user))
- password
- (full-name (erc-compute-full-name))
- client-certificate
- id
+Connect to an IRC server over a TLS-encrypted connection.
+Interactively, prompt for SERVER, PORT, NICK, and PASSWORD, along
+with USER and FULL-NAME when given a prefix argument.
+Non-interactively, also accept a CLIENT-CERTIFICATE, which should
+be a list containing the file name of the certificate's key
+followed by that of the certificate itself. Alternatively,
+accept a value of t instead of a list, to tell ERC to query
+`auth-source' for the certificate's details.
-That is, if called with
-
- (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
-
-then the server and full-name will be set to those values,
-whereas `erc-compute-port' and `erc-compute-nick' will be invoked
-for the values of their respective parameters.
-
-CLIENT-CERTIFICATE, if non-nil, should either be a list where the
-first element is the certificate key file name, and the second
-element is the certificate file name itself, or t, which means
-that `auth-source' will be queried for the key and the
-certificate. Authenticating using a TLS client certificate is
-also referred to as \"CertFP\" (Certificate Fingerprint)
-authentication by various IRC networks.
-
-Example usage:
+Example client certificate (CertFP) usage:
(erc-tls :server \"irc.libera.chat\" :port 6697
:client-certificate
\\='(\"/home/bandali/my-cert.key\"
\"/home/bandali/my-cert.crt\"))
-When present, ID should be a symbol or a string to use for naming
-the server buffer and identifying the connection unequivocally.
-See Info node `(erc) Network Identifier' for details. Like
-CLIENT-CERTIFICATE, this parameter cannot be specified
-interactively.
+See the alternative entry-point command `erc' as well as Info
+node `(erc) Connecting' for a fuller description of the various
+parameters, like ID.
(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)"
'((let ((erc-default-port erc-default-port-tls) (erc--display-context
`((erc-interactive-display . erc-tls) ,@erc--display-context)))
(erc-select-read-args))))
(autoload 'erc-handle-irc-url "erc" "\
@@ -10704,6 +10699,46 @@ Display the documentation for TEST-OR-TEST-NAME (a
symbol or ert-test).
(register-definition-prefixes "ert" '("ert-"))
+;;; Generated autoloads from emacs-lisp/ert-font-lock.el
+
+(autoload 'ert-font-lock-deftest "ert-font-lock" "\
+Define test NAME (a symbol) using assertions from TEST-STR.
+
+Other than MAJOR-MODE and TEST-STR parameters, this macro accepts
+the same parameters and keywords as `ert-deftest' and is intended
+to be used through `ert'.
+
+(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)]
MAJOR-MODE TEST-STR)" nil t)
+(function-put 'ert-font-lock-deftest 'doc-string-elt 3)
+(function-put 'ert-font-lock-deftest 'lisp-indent-function 2)
+(autoload 'ert-font-lock-deftest-file "ert-font-lock" "\
+Define test NAME (a symbol) using assertions from FILE.
+
+FILE - path to a file with assertions in ERT resource director as
+return by `ert-resource-directory'.
+
+Other than MAJOR-MODE and FILE parameters, this macro accepts the
+same parameters and keywords as `ert-deftest' and is intended to
+be used through `ert'.
+
+(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)]
MAJOR-MODE FILE)" nil t)
+(function-put 'ert-font-lock-deftest-file 'doc-string-elt 3)
+(function-put 'ert-font-lock-deftest-file 'lisp-indent-function 2)
+(autoload 'ert-font-lock-test-string "ert-font-lock" "\
+Check font faces in TEST-STRING set by MODE.
+
+The function is meant to be run from within an ERT test.
+
+(fn TEST-STRING MODE)")
+(autoload 'ert-font-lock-test-file "ert-font-lock" "\
+Check font faces in FILENAME set by MODE.
+
+The function is meant to be run from within an ERT test.
+
+(fn FILENAME MODE)")
+(register-definition-prefixes "ert-font-lock" '("ert-font-lock--"))
+
+
;;; Generated autoloads from emacs-lisp/ert-x.el
(autoload 'ert-kill-all-test-buffers "ert-x" "\
@@ -11089,6 +11124,49 @@ for \\[find-tag] (which see)." t)
(register-definition-prefixes "etags" '("default-tags-table-function" "etags-"
"file-of-tag" "find-tag-" "goto-tag-location-function"
"initialize-new-tags-table" "last-tag" "list-tags-function"
"select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function"))
+;;; Generated autoloads from progmodes/etags-regen.el
+
+(put 'etags-regen-regexp-alist 'safe-local-variable (lambda (value) (and
(listp value) (seq-every-p (lambda (group) (and (consp group) (listp (car
group)) (listp (cdr group)) (seq-every-p #'stringp (car group)) (seq-every-p
#'stringp (cdr group)))) value))))
+(put 'etags-regen-file-extensions 'safe-local-variable (lambda (value) (and
(listp value) (seq-every-p #'stringp value))))
+(put 'etags-regen-ignores 'safe-local-variable (lambda (value) (and (listp
value) (seq-every-p #'stringp value))))
+(defvar etags-regen-mode nil "\
+Non-nil if Etags-Regen mode is enabled.
+See the `etags-regen-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `etags-regen-mode'.")
+(custom-autoload 'etags-regen-mode "etags-regen" nil)
+(autoload 'etags-regen-mode "etags-regen" "\
+Minor mode to automatically generate and update tags tables.
+
+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.
+
+If you select a tags table manually (for example, using
+\\[visit-tags-table]), then this mode will be effectively
+disabled for the entire session. Use \\[tags-reset-tags-tables]
+to countermand the effect of a previous \\[visit-tags-table].
+
+This is a global minor mode. If called interactively, toggle the
+`Etags-Regen mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='etags-regen-mode)'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(register-definition-prefixes "etags-regen" '("etags-regen-"))
+
+
;;; Generated autoloads from language/ethio-util.el
(autoload 'setup-ethiopic-environment-internal "ethio-util")
@@ -11894,19 +11972,19 @@ Minor mode for a buffer-specific default face.
When enabled, the face specified by the variable
`buffer-face-mode-face' is used to display the buffer text.
-This is a minor mode. If called interactively, toggle the
-`Buffer-Face mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Buffer-Face
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `buffer-face-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'buffer-face-set "face-remap" "\
@@ -12379,12 +12457,14 @@ earlier in the `setq-connection-local'. The return
value of the
(fn [VARIABLE VALUE]...)" nil t)
(autoload 'connection-local-p "files-x" "\
Non-nil if VARIABLE has a connection-local binding in `default-directory'.
+`default-directory' must be a remote file name.
If APPLICATION is nil, the value of
`connection-local-default-application' is used.
(fn VARIABLE &optional APPLICATION)" nil t)
(autoload 'connection-local-value "files-x" "\
Return connection-local VARIABLE for APPLICATION in `default-directory'.
+`default-directory' must be a remote file name.
If APPLICATION is nil, the value of
`connection-local-default-application' is used.
If VARIABLE does not have a connection-local binding, the return
@@ -12902,19 +12982,19 @@ suitable for the current buffer. The commands
`flymake-reporting-backends' summarize the situation, as does the
special *Flymake log* buffer.
-This is a minor mode. If called interactively, toggle the
-`Flymake mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Flymake
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `flymake-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'flymake-mode-on "flymake" "\
@@ -12979,19 +13059,19 @@ in your init file.
\\[flyspell-region] checks all words inside a region.
\\[flyspell-buffer] checks the whole buffer.
-This is a minor mode. If called interactively, toggle the
-`Flyspell mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Flyspell
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `flyspell-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'turn-on-flyspell "flyspell" "\
@@ -13047,7 +13127,7 @@ being able to use 144 or 216 lines instead of the
normal 72... (your
mileage may vary).
To split one large window into two side-by-side windows, the commands
-`\\[split-window-right]' or `\\[follow-delete-other-windows-and-split]' can be
used.
+\\[split-window-right] or \\[follow-delete-other-windows-and-split] can be
used.
Only windows displayed in the same frame follow each other.
@@ -13056,19 +13136,19 @@ This command runs the normal hook `follow-mode-hook'.
Keys specific to Follow mode:
\\{follow-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Follow mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Follow mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `follow-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'follow-scroll-up-window "follow" "\
@@ -13154,19 +13234,19 @@ provides footnote support for `message-mode'. To get
started,
play around with the following keys:
\\{footnote-minor-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Footnote mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Footnote
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `footnote-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "footnote" '("footnote-"))
@@ -13620,19 +13700,18 @@ being transferred. This list may grow up to a size of
the list) is deleted every time a new one is added (at the front).
This is a global minor mode. If called interactively, toggle the
-`Gdb-Enable-Debug mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Gdb-Enable-Debug mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='gdb-enable-debug)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'gdb "gdb-mi" "\
@@ -13796,19 +13875,19 @@ Minor mode for making identifiers likeThis readable.
When this mode is active, it tries to add virtual
separators (like underscores) at places they belong to.
-This is a minor mode. If called interactively, toggle the
-`Glasses mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Glasses
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `glasses-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "glasses" '("glasses-"))
@@ -13828,19 +13907,18 @@ If enabled, all glyphless characters will be
displayed as boxes
that display their acronyms.
This is a minor mode. If called interactively, toggle the
-`Glyphless-Display mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Glyphless-Display mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `glyphless-display-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "glyphless-mode" '("glyphless-mode-"))
@@ -14321,19 +14399,18 @@ Minor mode for providing mailing-list commands.
\\{gnus-mailing-list-mode-map}
This is a minor mode. If called interactively, toggle the
-`Gnus-Mailing-List mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Gnus-Mailing-List mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `gnus-mailing-list-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "gnus-ml" '("gnus-mailing-list-"))
@@ -14720,19 +14797,19 @@ Also fontifies the buffer appropriately (see
`goto-address-fontify-p' and
(autoload 'goto-address-mode "goto-addr" "\
Minor mode to buttonize URLs and e-mail addresses in the current buffer.
-This is a minor mode. If called interactively, toggle the
-`Goto-Address mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Goto-Address
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `goto-address-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-goto-address-mode 'globalized-minor-mode t)
@@ -14763,19 +14840,18 @@ See `goto-address-mode' for more information on
Goto-Address mode.
Like `goto-address-mode', but only for comments and strings.
This is a minor mode. If called interactively, toggle the
-`Goto-Address-Prog mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Goto-Address-Prog mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `goto-address-prog-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "goto-addr" '("goto-addr"))
@@ -15131,18 +15207,18 @@ or call the function `gud-tooltip-mode'.")
Toggle the display of GUD tooltips.
This is a global minor mode. If called interactively, toggle the
-`Gud-Tooltip mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Gud-Tooltip mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='gud-tooltip-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'lldb "gud" "\
@@ -15584,6 +15660,9 @@ whose documentation describes the minor mode.
If called from Lisp with a non-nil BUFFER argument, display
documentation for the major and minor modes of that buffer.
+When `describe-mode-outline' is non-nil, Outline minor mode
+is enabled in the Help buffer.
+
(fn &optional BUFFER)" t)
(autoload 'describe-widget "help-fns" "\
Display a buffer with information about a widget.
@@ -15909,19 +15988,19 @@ position (number of characters into buffer)
Hi-lock: end is found. A mode is excluded if it's in the list
`hi-lock-exclude-modes'.
-This is a minor mode. If called interactively, toggle the
-`Hi-Lock mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Hi-Lock
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `hi-lock-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-hi-lock-mode 'globalized-minor-mode t)
@@ -16085,22 +16164,22 @@ Several variables affect how the hiding is done:
\\{hide-ifdef-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Hide-Ifdef mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Hide-Ifdef
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `hide-ifdef-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
-(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef"
"forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef"
"show-ifdef" "up-ifdef"))
+(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef"
"forward-ifdef" "hide-ifdef" "hif-" "next-ifdef" "previous-ifdef" "show-ifdef"
"up-ifdef"))
;;; Generated autoloads from progmodes/hideshow.el
@@ -16162,19 +16241,19 @@ Lastly, the normal hook `hs-minor-mode-hook' is run
using `run-hooks'.
Key bindings:
\\{hs-minor-mode-map}
-This is a minor mode. If called interactively, toggle the `hs
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `hs minor
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `hs-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'turn-off-hideshow "hideshow" "\
@@ -16208,19 +16287,18 @@ buffer with the contents of a file
\\[highlight-compare-buffers] highlights differences between two buffers.
This is a minor mode. If called interactively, toggle the
-`Highlight-Changes mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Highlight-Changes mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `highlight-changes-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'highlight-changes-visible-mode "hilit-chg" "\
@@ -16237,18 +16315,18 @@ This command does not itself set Highlight Changes
mode.
This is a minor mode. If called interactively, toggle the
`Highlight-Changes-Visible mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `highlight-changes-visible-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'highlight-changes-remove-highlight "hilit-chg" "\
@@ -16374,19 +16452,19 @@ non-selected window. Hl-Line mode uses the function
When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the
line about point in the selected window only.
-This is a minor mode. If called interactively, toggle the
-`Hl-Line mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Hl-Line
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `hl-line-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar global-hl-line-mode nil "\
@@ -16408,18 +16486,18 @@ Global-Hl-Line mode uses the function
`global-hl-line-highlight'
on `post-command-hook'.
This is a global minor mode. If called interactively, toggle the
-`Global Hl-Line mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Global Hl-Line mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='global-hl-line-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-"))
@@ -16779,19 +16857,19 @@ An enhanced `icomplete-mode' that emulates `ido-mode'.
This global minor mode makes minibuffer completion behave
more like `ido-mode' than regular `icomplete-mode'.
-This is a global minor mode. If called interactively, toggle the
-`Fido mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the `Fido
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='fido-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar icomplete-mode nil "\
@@ -16819,18 +16897,18 @@ completions:
\\{icomplete-minibuffer-map}
This is a global minor mode. If called interactively, toggle the
-`Icomplete mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Icomplete mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='icomplete-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar icomplete-vertical-mode nil "\
@@ -16851,19 +16929,18 @@ the value of `max-mini-window-height', and the way
the mini-window is
resized depends on `resize-mini-windows'.
This is a global minor mode. If called interactively, toggle the
-`Icomplete-Vertical mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Icomplete-Vertical mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='icomplete-vertical-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar fido-vertical-mode nil "\
@@ -16881,18 +16958,18 @@ When turning on, if non-vertical `fido-mode' is off,
turn it on.
If it's on, just add the vertical display.
This is a global minor mode. If called interactively, toggle the
-`Fido-Vertical mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Fido-Vertical mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='fido-vertical-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(when (locate-library "obsolete/iswitchb")
@@ -17382,19 +17459,19 @@ See `inferior-emacs-lisp-mode' for details.
(autoload 'iimage-mode "iimage" "\
Toggle Iimage mode on or off.
-This is a minor mode. If called interactively, toggle the
-`Iimage mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Iimage mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `iimage-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode"))
@@ -17466,9 +17543,13 @@ use its file extension as image type.
Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
Optional PROPS are additional image attributes to assign to the image,
-like, e.g. `:mask MASK'. If the property `:scale' is not given and the
-display has a high resolution (more exactly, when the average width of a
-character in the default font is more than 10 pixels), the image is
+like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for
+the list of supported properties; see the nodes following that node
+for properties specific to certain image types.
+
+If the property `:scale' is not given and the display has a high
+resolution (more exactly, when the average width of a character
+in the default font is more than 10 pixels), the image is
automatically scaled up in proportion to the default font.
Value is the image created, or nil if images of type TYPE are not supported.
@@ -17533,21 +17614,25 @@ BUFFER nil or omitted means use the current buffer.
(fn START END &optional BUFFER)")
(autoload 'find-image "image" "\
-Find an image, choosing one of a list of image specifications.
+Find an image that satisfies one of a list of image specifications.
SPECS is a list of image specifications.
-Each image specification in SPECS is a property list. The contents of
-a specification are image type dependent. All specifications must at
-least contain either the property `:file FILE' or `:data DATA',
-where FILE is the file to load the image from, and DATA is a string
-containing the actual image data. If the property `:type TYPE' is
-omitted or nil, try to determine the image type from its first few
+Each image specification in SPECS is a property list. The
+contents of a specification are image type dependent; see the
+info node `(elisp)Image Descriptors' for details. All specifications
+must at least contain either the property `:file FILE' or `:data DATA',
+where FILE is the file from which to load the image, and DATA is a
+string containing the actual image data. If the property `:type TYPE'
+is omitted or nil, try to determine the image type from its first few
bytes of image data. If that doesn't work, and the property `:file
-FILE' provide a file name, use its file extension as image type.
-If `:type TYPE' is provided, it must match the actual type
-determined for FILE or DATA by `create-image'. Return nil if no
-specification is satisfied.
+FILE' provide a file name, use its file extension as idication of the
+image type. If `:type TYPE' is provided, it must match the actual type
+determined for FILE or DATA by `create-image'.
+
+The function returns the image specification for the first specification
+in the list whose TYPE is supported and FILE, if specified, exists. It
+returns nil if no specification in the list can be satisfied.
If CACHE is non-nil, results are cached and returned on subsequent calls.
@@ -17764,20 +17849,19 @@ are always available in Dired:
\\[image-dired-dired-toggle-marked-thumbs] Toggle thumbnails in front of
file names.
\\[image-dired-dired-edit-comment-and-tags] Edit comment and tags
of marked images.
-This is a minor mode. If called interactively, toggle the
-`Image-Dired minor mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Image-Dired
+minor mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `image-dired-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'image-dired-display-thumbs-append "image-dired-dired" "\
@@ -17883,18 +17967,18 @@ An image file is one whose name has an extension in
`image-file-name-regexps'.
This is a global minor mode. If called interactively, toggle the
-`Auto-Image-File mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Auto-Image-File mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='auto-image-file-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "image-file" '("image-file-"))
@@ -17915,19 +17999,19 @@ Toggle Image minor mode in this buffer.
Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
to switch back to
`image-mode' and display an image file as the actual image.
-This is a minor mode. If called interactively, toggle the `Image
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Image minor
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `image-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'image-mode-to-text "image-mode" "\
@@ -18128,19 +18212,18 @@ indented towards the left by the column number at the
start of
that text.
This is a global minor mode. If called interactively, toggle the
-`Kill-Ring-Deindent mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Kill-Ring-Deindent mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='kill-ring-deindent-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "indent-aux"
'("kill-ring-deindent-buffer-substring-function"))
@@ -18833,19 +18916,19 @@ SPC.
For spell-checking \"on the fly\", not just after typing SPC or
RET, use `flyspell-mode'.
-This is a minor mode. If called interactively, toggle the
-`ISpell minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `ISpell minor
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `ispell-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'ispell-message "ispell" "\
@@ -19051,7 +19134,7 @@ Major mode for editing JSON, powered by tree-sitter.
;;; Generated autoloads from jsonrpc.el
-(push (purecopy '(jsonrpc 1 0 23)) package--builtin-versions)
+(push (purecopy '(jsonrpc 1 0 24)) package--builtin-versions)
(register-definition-prefixes "jsonrpc" '("jsonrpc-"))
@@ -19851,7 +19934,7 @@ For example, in Usenet articles, sections of text
quoted from another
author are indented, or have each line start with `>'. To quote a
section of text, define a keyboard macro which inserts `>', put point
and mark at opposite ends of the quoted section, and use
-`\\[apply-macro-to-region-lines]' to mark the entire section.
+\\[apply-macro-to-region-lines] to mark the entire section.
Suppose you wanted to build a keyword table in C where each entry
looked like this:
@@ -19873,7 +19956,7 @@ and write a macro to massage a word into a table entry:
\\C-x )
and then select the region of un-tablified names and use
-`\\[apply-macro-to-region-lines]' to build the table from the names.
+\\[apply-macro-to-region-lines] to build the table from the names.
(fn TOP BOTTOM &optional MACRO)" t)
(define-key ctl-x-map "q" 'kbd-macro-query)
@@ -20035,18 +20118,18 @@ headers (those specified by
`mail-abbrev-mode-regexp'), based on
the entries in your `mail-personal-alias-file'.
This is a global minor mode. If called interactively, toggle the
-`Mail-Abbrevs mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Mail-Abbrevs mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='mail-abbrevs-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'mail-abbrevs-setup "mailabbrev" "\
@@ -20362,19 +20445,19 @@ The slave buffer is stored in the buffer-local
variable `master-of'.
You can set this variable using `master-set-slave'. You can show
yourself the value of `master-of' by calling `master-show-slave'.
-This is a minor mode. If called interactively, toggle the
-`Master mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Master mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `master-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "master" '("master-"))
@@ -20400,18 +20483,18 @@ recursion depth in the minibuffer prompt. This is
only useful if
This is a global minor mode. If called interactively, toggle the
`Minibuffer-Depth-Indicate mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='minibuffer-depth-indicate-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "mb-depth" '("minibuffer-depth-"))
@@ -20567,7 +20650,7 @@ Major mode for editing MetaPost sources.
;;; Generated autoloads from mh-e/mh-acros.el
-(register-definition-prefixes "mh-acros" '("defmacro-mh" "defun-mh" "mh-"
"with-mh-folder-updating"))
+(register-definition-prefixes "mh-acros" '("mh-" "with-mh-folder-updating"))
;;; Generated autoloads from mh-e/mh-alias.el
@@ -20857,18 +20940,18 @@ or call the function `midnight-mode'.")
Non-nil means run `midnight-hook' at midnight.
This is a global minor mode. If called interactively, toggle the
-`Midnight mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Midnight mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='midnight-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'clean-buffer-list "midnight" "\
@@ -20912,19 +20995,19 @@ such that hitting RET would enter a non-default
value, the prompt
is modified to remove the default indication.
This is a global minor mode. If called interactively, toggle the
-`Minibuffer-Electric-Default mode' mode. If the prefix argument
-is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+`Minibuffer-Electric-Default mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='minibuffer-electric-default-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "minibuf-eldef" '("minibuf"))
@@ -21442,19 +21525,19 @@ Toggle Msb mode.
This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
different buffer menu using the function `msb'.
-This is a global minor mode. If called interactively, toggle the
-`Msb mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the `Msb
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='msb-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "msb" '("mouse-select-buffer" "msb"))
@@ -21743,18 +21826,18 @@ or call the function `mouse-wheel-mode'.")
Toggle mouse wheel support (Mouse Wheel mode).
This is a global minor mode. If called interactively, toggle the
-`Mouse-Wheel mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Mouse-Wheel mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='mouse-wheel-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-"))
@@ -22765,7 +22848,7 @@ Coloring:
;;; Generated autoloads from org/org.el
-(push (purecopy '(org 9 6 13)) package--builtin-versions)
+(push (purecopy '(org 9 6 15)) package--builtin-versions)
(autoload 'org-babel-do-load-languages "org" "\
Load the languages defined in `org-babel-load-languages'.
@@ -23497,19 +23580,19 @@ Toggle Outline minor mode.
See the command `outline-mode' for more information on this mode.
-This is a minor mode. If called interactively, toggle the
-`Outline minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Outline
+minor mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `outline-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'outline-search-level "outline" "\
@@ -24120,6 +24203,8 @@ FUN in `pred' and `app' can take one of the forms:
call it with one argument
(F ARG1 .. ARGn)
call F with ARG1..ARGn and EXPVAL as n+1'th argument
+ (F ARG1 .. _ .. ARGn)
+ call F, passing EXPVAL at the _ position.
FUN, BOOLEXP, and subsequent PAT can refer to variables
bound earlier in the pattern by a SYMBOL pattern.
@@ -24158,8 +24243,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN
EXP), but the
EXP in each binding in BINDINGS can use the results of the destructuring
bindings that precede it in BINDINGS' order.
-Each EXP should match (i.e. be of compatible structure) to its
-respective PATTERN; a mismatch may signal an error or may go
+Each EXP should match its respective PATTERN (i.e. be of structure
+compatible to PATTERN); a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil.
(fn BINDINGS &rest BODY)" nil t)
@@ -24172,8 +24257,8 @@ All EXPs are evaluated first, and then used to perform
destructuring
bindings by matching each EXP against its respective PATTERN. Then
BODY is evaluated with those bindings in effect.
-Each EXP should match (i.e. be of compatible structure) to its
-respective PATTERN; a mismatch may signal an error or may go
+Each EXP should match its respective PATTERN (i.e. be of structure
+compatible to PATTERN); a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil.
(fn BINDINGS &rest BODY)" nil t)
@@ -24775,11 +24860,6 @@ they are not by default assigned to keys." t)
(register-definition-prefixes "picture" '("picture-"))
-;;; Generated autoloads from language/pinyin.el
-
-(register-definition-prefixes "pinyin" '("pinyin-character-map"))
-
-
;;; Generated autoloads from textmodes/pixel-fill.el
(register-definition-prefixes "pixel-fill" '("pixel-fill-"))
@@ -24799,18 +24879,18 @@ or call the function `pixel-scroll-mode'.")
A minor mode to scroll text pixel-by-pixel.
This is a global minor mode. If called interactively, toggle the
-`Pixel-Scroll mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Pixel-Scroll mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='pixel-scroll-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'pixel-scroll-precision-scroll-down-page "pixel-scroll" "\
@@ -24840,19 +24920,18 @@ When enabled, this minor mode allows you to scroll
the display
precisely, according to the turning of the mouse wheel.
This is a global minor mode. If called interactively, toggle the
-`Pixel-Scroll-Precision mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Pixel-Scroll-Precision mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='pixel-scroll-precision-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "pixel-scroll" '("pixel-"))
@@ -25616,8 +25695,6 @@ requires quoting, e.g. `\\[quoted-insert]<space>'.
(fn REGEXP)" t)
(autoload 'project-or-external-find-regexp "project" "\
Find all matches for REGEXP in the project roots or external roots.
-With \\[universal-argument] prefix, you can specify the file name
-pattern to search for.
(fn REGEXP)" t)
(autoload 'project-find-file "project" "\
@@ -25773,8 +25850,8 @@ Otherwise, `default-directory' is temporarily set to
the current
project's root.
If OVERRIDING-MAP is non-nil, it will be used as
-`overriding-local-map' to provide shorter bindings from that map
-which will take priority over the global ones.
+`overriding-terminal-local-map' to provide shorter bindings
+from that map which will take priority over the global ones.
(fn &optional OVERRIDING-MAP PROMPT-FORMAT)" t)
(autoload 'project-prefix-or-any-command "project" "\
@@ -25824,7 +25901,7 @@ line and comments can also be enclosed in /* ... */.
If an optional argument SYSTEM is non-nil, set up mode for the given system.
To find out what version of Prolog mode you are running, enter
-`\\[prolog-mode-version]'.
+\\[prolog-mode-version].
Commands:
\\{prolog-mode-map}
@@ -26454,19 +26531,18 @@ or call the function `rcirc-track-minor-mode'.")
Global minor mode for tracking activity in rcirc buffers.
This is a global minor mode. If called interactively, toggle the
-`Rcirc-Track minor mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Rcirc-Track minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='rcirc-track-minor-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "rcirc" '("rcirc-" "with-rcirc-"))
@@ -26529,18 +26605,18 @@ buffers you switch to a lot, you can say something
like the following:
(add-hook \\='buffer-list-update-hook #\\='recentf-track-opened-file)
This is a global minor mode. If called interactively, toggle the
-`Recentf mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Recentf mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='recentf-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "recentf" '("recentf-"))
@@ -26671,18 +26747,18 @@ Activates the region if it's inactive and Transient
Mark mode is
on. Only lasts until the region is next deactivated.
This is a minor mode. If called interactively, toggle the
-`Rectangle-Mark mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Rectangle-Mark mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `rectangle-mark-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "rect" '("apply-on-rectangle"
"clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope"
"rectangle-" "spaces-string" "string-rectangle-"))
@@ -26710,19 +26786,19 @@ auto-filling.
For true \"word wrap\" behavior, use `visual-line-mode' instead.
-This is a minor mode. If called interactively, toggle the
-`Refill mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Refill mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `refill-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "refill" '("refill-"))
@@ -26772,19 +26848,19 @@ on the menu bar.
------------------------------------------------------------------------------
-This is a minor mode. If called interactively, toggle the
-`Reftex mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Reftex mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `reftex-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'reftex-reset-scanning-information "reftex" "\
@@ -27006,18 +27082,18 @@ keys for repeating.
See `describe-repeat-maps' for a list of all repeatable commands.
This is a global minor mode. If called interactively, toggle the
-`Repeat mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Repeat mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='repeat-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'repeat-exit "repeat" "\
@@ -27093,19 +27169,19 @@ reveals invisible text around point.
Also see the `reveal-auto-hide' variable.
-This is a minor mode. If called interactively, toggle the
-`Reveal mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Reveal mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `reveal-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar global-reveal-mode nil "\
@@ -27122,18 +27198,18 @@ Toggle Reveal mode in all buffers (Global Reveal
mode).
Reveal mode renders invisible text around point visible again.
This is a global minor mode. If called interactively, toggle the
-`Global Reveal mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Global Reveal mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='global-reveal-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "reveal" '("reveal-"))
@@ -27676,19 +27752,19 @@ conventionally have a suffix of `.rnc'). The variable
`rng-schema-locating-files' specifies files containing rules
to use for finding the schema.
-This is a minor mode. If called interactively, toggle the
-`Rng-Validate mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Rng-Validate
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `rng-validate-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "rng-valid" '("rng-"))
@@ -27802,19 +27878,19 @@ When ReST minor mode is enabled, the ReST mode
keybindings
are installed on top of the major mode bindings. Use this
for modes derived from Text mode, like Mail mode.
-This is a minor mode. If called interactively, toggle the `Rst
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Rst minor
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `rst-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "rst" '("rst-"))
@@ -27862,19 +27938,19 @@ Use the command `ruler-mode' to change this
variable.")
(autoload 'ruler-mode "ruler-mode" "\
Toggle display of ruler in header line (Ruler mode).
-This is a minor mode. If called interactively, toggle the `Ruler
-mode' mode. If the prefix argument is positive, enable the mode,
-and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Ruler mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `ruler-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "ruler-mode" '("ruler-"))
@@ -28072,7 +28148,8 @@ For more details, see Info node `(elisp) Extending Rx'.
(fn NAME [(ARGS...)] RX)" nil t)
(function-put 'rx-define 'lisp-indent-function 'defun)
-(eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern
that matches strings against `rx' REGEXPS in sexp form.
+(autoload 'rx--pcase-macroexpander "rx" "\
+A pattern that matches strings against `rx' REGEXPS in sexp form.
REGEXPS are interpreted as in `rx'. The pattern matches any
string that is a match for REGEXPS, as if by `string-match'.
@@ -28086,7 +28163,9 @@ following constructs:
(backref REF) matches whatever the submatch REF matched.
REF can be a number, as usual, or a name
introduced by a previous (let REF ...)
- construct." (rx--pcase-expand regexps)))
+ construct.
+
+(fn &rest REGEXPS)")
(define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil)
(define-symbol-prop 'rx 'pcase-macroexpander #'rx--pcase-macroexpander)
(autoload 'rx--pcase-expand "rx" "\
@@ -28166,18 +28245,18 @@ Calling it at any other time replaces your current
minibuffer
histories, which is probably undesirable.
This is a global minor mode. If called interactively, toggle the
-`Savehist mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Savehist mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='savehist-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "savehist" '("savehist-"))
@@ -28200,18 +28279,18 @@ This means when you visit a file, point goes to the
last place
where it was when you previously visited the same file.
This is a global minor mode. If called interactively, toggle the
-`Save-Place mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Save-Place mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='save-place-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'save-place-local-mode "saveplace" "\
@@ -28227,19 +28306,18 @@ file:
(save-place-mode 1)
This is a minor mode. If called interactively, toggle the
-`Save-Place-Local mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Save-Place-Local mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `save-place-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "saveplace" '("save-place"))
@@ -28326,18 +28404,18 @@ When Scroll-All mode is enabled, scrolling commands
invoked in
one window apply to all visible windows in the same frame.
This is a global minor mode. If called interactively, toggle the
-`Scroll-All mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Scroll-All mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='scroll-all-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "scroll-all" '("scroll-all-"))
@@ -28361,19 +28439,19 @@ boundaries during scrolling.
Note that the default key binding to `scroll' will not work on
MS-Windows systems if `w32-scroll-lock-modifier' is non-nil.
-This is a minor mode. If called interactively, toggle the
-`Scroll-Lock mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Scroll-Lock
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `scroll-lock-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "scroll-lock" '("scroll-lock-"))
@@ -28437,18 +28515,18 @@ Semantic mode.
\\{semantic-mode-map}
This is a global minor mode. If called interactively, toggle the
-`Semantic mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Semantic mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='semantic-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "semantic" '("bovinate" "semantic-"))
@@ -28757,18 +28835,18 @@ Server mode runs a process that accepts commands from
the
`server-start' for details.
This is a global minor mode. If called interactively, toggle the
-`Server mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Server mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='server-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'server-save-buffers-kill-terminal "server" "\
@@ -29109,6 +29187,10 @@ Make the shell buffer the current buffer, and return
it.
;;; Generated autoloads from emacs-lisp/shortdoc.el
+(autoload 'shortdoc--check "shortdoc" "\
+
+
+(fn GROUP FUNCTIONS)")
(defvar shortdoc--groups nil)
(defmacro define-short-documentation-group (group &rest functions) "\
Add GROUP to the list of defined documentation groups.
@@ -29172,7 +29254,7 @@ execution of the documented form depends on some
conditions.
A FUNC form can have any number of `:no-eval' (or `:no-value'),
`:no-eval*', `:result', `:result-string', `:eg-result' and
-`:eg-result-string' properties." (declare (indent defun)) `(progn (setq
shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) (push
(cons ',group ',functions) shortdoc--groups)))
+`:eg-result-string' properties." (declare (indent defun)) (shortdoc--check
group functions) `(progn (setq shortdoc--groups (delq (assq ',group
shortdoc--groups) shortdoc--groups)) (push (cons ',group ',functions)
shortdoc--groups)))
(autoload 'shortdoc-display-group "shortdoc" "\
Pop to a buffer with short documentation summary for functions in GROUP.
If FUNCTION is non-nil, place point on the entry for FUNCTION (if any).
@@ -29437,19 +29519,19 @@ Minor mode to simplify editing output from the diff3
program.
\\{smerge-mode-map}
-This is a minor mode. If called interactively, toggle the
-`SMerge mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `SMerge mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `smerge-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'smerge-start-session "smerge-mode" "\
@@ -29552,19 +29634,19 @@ with `so-long-variable-overrides'.
This minor mode is a standard `so-long-action' option.
-This is a minor mode. If called interactively, toggle the
-`So-Long minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `So-Long
+minor mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `so-long-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'so-long-mode "so-long" "\
@@ -29642,18 +29724,18 @@ Use \\[so-long-customize] to open the customization
group `so-long' to
configure the behavior.
This is a global minor mode. If called interactively, toggle the
-`Global So-Long mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Global So-Long mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='global-so-long-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "so-long" '("so-long-" "turn-o"))
@@ -29890,6 +29972,24 @@ For example: to sort lines in the region by the first
word on each line
RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\<f\\\\w*\\\\>\"
(fn REVERSE RECORD-REGEXP KEY-REGEXP BEG END)" t)
+(autoload 'sort-on "sort" "\
+Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR.
+SEQUENCE should be the input sequence to sort.
+Elements of SEQUENCE are sorted by keys which are obtained by
+calling ACCESSOR on each element. ACCESSOR should be a function of
+one argument, an element of SEQUENCE, and should return the key
+value to be compared by PREDICATE for sorting the element.
+PREDICATE is the function for comparing keys; it is called with two
+arguments, the keys to compare, and should return non-nil if the
+first key should sort before the second key.
+The return value is always a new list.
+This function has the performance advantage of evaluating
+ACCESSOR only once for each element in the input SEQUENCE, and is
+therefore appropriate when computing the key by ACCESSOR is an
+expensive operation. This is known as the \"decorate-sort-undecorate\"
+paradigm, or the Schwartzian transform.
+
+(fn SEQUENCE PREDICATE ACCESSOR)")
(autoload 'sort-columns "sort" "\
Sort lines in region alphabetically by a certain range of columns.
For the purpose of this command, the region BEG...END includes
@@ -30669,18 +30769,18 @@ Encode/decode your strokes with
\\[strokes-encode-buffer],
\\{strokes-mode-map}
This is a global minor mode. If called interactively, toggle the
-`Strokes mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Strokes mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='strokes-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'strokes-decode-buffer "strokes" "\
@@ -30800,19 +30900,19 @@ called a `subword'. Here are some examples:
This mode changes the definition of a word so that word commands
treat nomenclature boundaries as word boundaries.
-This is a minor mode. If called interactively, toggle the
-`Subword mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Subword
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `subword-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-subword-mode 'globalized-minor-mode t)
@@ -30849,19 +30949,19 @@ syntax are treated as parts of words: e.g., in
`superword-mode',
\\{superword-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Superword mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Superword
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `superword-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-superword-mode 'globalized-minor-mode t)
@@ -30953,18 +31053,18 @@ mouse to transfer text between Emacs and other
programs which use
GPM. This is due to limitations in GPM and the Linux kernel.
This is a global minor mode. If called interactively, toggle the
-`Gpm-Mouse mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Gpm-Mouse mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='gpm-mouse-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "t-mouse" '("gpm-mouse-"))
@@ -30975,19 +31075,19 @@ it is disabled.
(autoload 'tab-line-mode "tab-line" "\
Toggle display of tab line in the windows displaying the current buffer.
-This is a minor mode. If called interactively, toggle the
-`Tab-Line mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Tab-Line
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `tab-line-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar-local tab-line-exclude nil)
@@ -31059,19 +31159,18 @@ variable's value can be toggled by
\\[table-fixed-width-mode] at
run-time.
This is a minor mode. If called interactively, toggle the
-`Table-Fixed-Width mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Table-Fixed-Width mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `table-fixed-width-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'table-insert "table" "\
@@ -31928,6 +32027,9 @@ such as if there are no commands in the file, the value
of `tex-default-mode'
says which mode to use.
(fn)" t)
+ (add-to-list 'major-mode-remap-defaults '(TeX-mode . tex-mode))
+ (add-to-list 'major-mode-remap-defaults '(plain-TeX-mode . plain-tex-mode))
+ (add-to-list 'major-mode-remap-defaults '(LaTeX-mode . latex-mode))
(defalias 'TeX-mode #'tex-mode)
(defalias 'plain-TeX-mode #'plain-tex-mode)
(defalias 'LaTeX-mode #'latex-mode)
@@ -32477,19 +32579,19 @@ When `tildify-mode' is enabled, if
`tildify-string-alist' specifies a hard space
representation for current major mode, the `tildify-space-string' buffer-local
variable will be set to the representation.
-This is a minor mode. If called interactively, toggle the
-`Tildify mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Tildify
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `tildify-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "tildify" '("tildify-"))
@@ -32525,25 +32627,25 @@ non-nil, the current day and date are displayed as
well. This
runs the normal hook `display-time-hook' after each update.
This is a global minor mode. If called interactively, toggle the
-`Display-Time mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Display-Time mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='display-time-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(define-obsolete-function-alias 'display-time-world #'world-clock "28.1")
(autoload 'world-clock "time" "\
Display a world clock buffer with times in various time zones.
The variable `world-clock-list' specifies which time zones to use.
-To turn off the world time display, go to the window and type
`\\[quit-window]'." t)
+To turn off the world time display, go to the window and type
\\[quit-window]." t)
(autoload 'emacs-uptime "time" "\
Return a string giving the uptime of this instance of Emacs.
FORMAT is a string to format the result, using `format-seconds'.
@@ -32824,21 +32926,16 @@ List all timers in a buffer.
;;; Generated autoloads from international/titdic-cnv.el
(autoload 'titdic-convert "titdic-cnv" "\
-Convert a TIT dictionary of FILENAME into a Quail package.
-Optional argument DIRNAME if specified is the directory name under which
-the generated Quail package is saved.
-(fn FILENAME &optional DIRNAME)" t)
+
+(fn FILENAME &optional DIRNAME)")
+(make-obsolete 'titdic-convert 'tit-dic-convert "30.1")
(autoload 'batch-titdic-convert "titdic-cnv" "\
-Run `titdic-convert' on the files remaining on the command line.
-Use this from the command line, with `-batch';
-it won't work in an interactive Emacs.
-For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
- generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
-To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\".
+
(fn &optional FORCE)")
-(register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "ctlau-"
"miscdic-convert" "pinyin-convert" "py-converter" "quail-" "quick-" "tit-"
"tsang-" "ziranma-converter"))
+(make-obsolete 'batch-titdic-convert 'batch-tit-dic-convert "30.1")
+(register-definition-prefixes "titdic-cnv" '("batch-tit-" "tit-"))
;;; Generated autoloads from tmm.el
@@ -32916,7 +33013,7 @@ current (i.e., last displayed) category.
In Todo mode just the category's unfinished todo items are shown
by default. The done items are hidden, but typing
-`\\[todo-toggle-view-done-items]' displays them below the todo
+\\[todo-toggle-view-done-items] displays them below the todo
items. With non-nil user option `todo-show-with-done' both todo
and done items are always shown on visiting a category.
@@ -33015,6 +33112,61 @@ holds a keymap.
(register-definition-prefixes "tooltip" '("tooltip-"))
+;;; Generated autoloads from touch-screen.el
+
+(autoload 'touch-screen-hold "touch-screen" "\
+Handle a long press EVENT.
+Ding and select the window at EVENT, then activate the mark. If
+`touch-screen-word-select' is enabled, try to select the whole
+word around EVENT; otherwise, set point to the location of EVENT.
+
+(fn EVENT)" t)
+(autoload 'touch-screen-track-tap "touch-screen" "\
+Track a single tap starting from EVENT.
+EVENT should be a `touchscreen-begin' event.
+
+Read touch screen events until a `touchscreen-end' event is
+received with the same ID as in EVENT. If UPDATE is non-nil and
+a `touchscreen-update' event is received in the mean time and
+contains a touch point with the same ID as in EVENT, call UPDATE
+with that event and DATA.
+
+If THRESHOLD is non-nil, enforce a threshold of movement that is
+either itself or 10 pixels when it is not a number. If the
+aforementioned touch point moves beyond that threshold on any
+axis, return nil immediately, and further resume mouse event
+translation for the touch point at hand.
+
+Return nil immediately if any other kind of event is received;
+otherwise, return t once the `touchscreen-end' event arrives.
+
+(fn EVENT &optional UPDATE DATA THRESHOLD)")
+(autoload 'touch-screen-track-drag "touch-screen" "\
+Track a single drag starting from EVENT.
+EVENT should be a `touchscreen-begin' event.
+
+Read touch screen events until a `touchscreen-end' event is
+received with the same ID as in EVENT. For each
+`touchscreen-update' event received in the mean time containing a
+touch point with the same ID as in EVENT, call UPDATE with the
+touch point in event and DATA, once the touch point has moved
+significantly by at least 5 pixels from where it was in EVENT.
+
+Return nil immediately if any other kind of event is received;
+otherwise, return either t or `no-drag' once the
+`touchscreen-end' event arrives; return `no-drag' returned if the
+touch point in EVENT did not move significantly, and t otherwise.
+
+(fn EVENT UPDATE &optional DATA)")
+(autoload 'touch-screen-inhibit-drag "touch-screen" "\
+Inhibit subsequent `touchscreen-drag' events from being sent.
+Prevent `touchscreen-drag' and translated mouse events from being
+sent until the touch sequence currently being translated ends.
+Must be called from a command bound to a `touchscreen-hold' or
+`touchscreen-drag' event.")
+(register-definition-prefixes "touch-screen" '("touch-screen-"))
+
+
;;; Generated autoloads from emacs-lisp/tq.el
(autoload 'tq-create "tq" "\
@@ -33226,55 +33378,13 @@ Add archive file name handler to
`file-name-handler-alist'." (when (and tramp-ar
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 7 0 -1)) package--builtin-versions)
+(push (purecopy '(tramp 2 7 1 -1)) package--builtin-versions)
(register-definition-prefixes "trampver" '("tramp-"))
;;; Generated autoloads from transient.el
(push (purecopy '(transient 0 5 2)) package--builtin-versions)
-(autoload 'transient-define-prefix "transient" "\
-Define NAME as a transient prefix command.
-
-ARGLIST are the arguments that command takes.
-DOCSTRING is the documentation string and is optional.
-
-These arguments can optionally be followed by key-value pairs.
-Each key has to be a keyword symbol, either `:class' or a keyword
-argument supported by the constructor of that class. The
-`transient-prefix' class is used if the class is not specified
-explicitly.
-
-GROUPs add key bindings for infix and suffix commands and specify
-how these bindings are presented in the popup buffer. At least
-one GROUP has to be specified. See info node `(transient)Binding
-Suffix and Infix Commands'.
-
-The BODY is optional. If it is omitted, then ARGLIST is also
-ignored and the function definition becomes:
-
- (lambda ()
- (interactive)
- (transient-setup \\='NAME))
-
-If BODY is specified, then it must begin with an `interactive'
-form that matches ARGLIST, and it must call `transient-setup'.
-It may however call that function only when some condition is
-satisfied; that is one of the reason why you might want to use
-an explicit BODY.
-
-All transients have a (possibly nil) value, which is exported
-when suffix commands are called, so that they can consume that
-value. For some transients it might be necessary to have a sort
-of secondary value, called a scope. Such a scope would usually
-be set in the commands `interactive' form and has to be passed
-to the setup function:
-
- (transient-setup \\='NAME nil nil :scope SCOPE)
-
-(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])" nil t)
-(function-put 'transient-define-prefix 'lisp-indent-function 'defun)
-(function-put 'transient-define-prefix 'doc-string-elt 3)
(autoload 'transient-insert-suffix "transient" "\
Insert a SUFFIX into PREFIX before LOC.
PREFIX is a prefix command, a symbol.
@@ -33519,18 +33629,18 @@ sessions and after a crash. Manual changes to the
file may result in
problems.
This is a global minor mode. If called interactively, toggle the
-`Type-Break mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Type-Break mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='type-break-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'type-break "type-break" "\
@@ -33916,18 +34026,18 @@ and `C-x C-f https://www.gnu.org/ RET' will give you
the HTML at
that URL in a buffer.
This is a global minor mode. If called interactively, toggle the
-`Url-Handler mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Url-Handler mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='url-handler-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'url-file-handler "url-handlers" "\
@@ -34014,10 +34124,7 @@ URL can be a URL string, or a URL record of the type
returned by
;;; Generated autoloads from url/url-mailto.el
-(autoload 'url-mail "url-mailto" "\
-
-
-(fn &rest ARGS)" t)
+(defalias 'url-mail #'message-mail)
(autoload 'url-mailto "url-mailto" "\
Handle the mailto: URL syntax.
@@ -34480,7 +34587,6 @@ Normalize arguments to delight.
;;; Generated autoloads from use-package/use-package-ensure-system-package.el
-(push (purecopy '(use-package-ensure-system-package 0 2))
package--builtin-versions)
(autoload 'use-package-normalize/:ensure-system-package
"use-package-ensure-system-package" "\
Turn ARGS into a list of conses of the form (PACKAGE-NAME . INSTALL-COMMAND).
@@ -35194,6 +35300,25 @@ case, and the process object in the asynchronous case.
(progn
(load "vc-git" nil t)
(vc-git-registered file))))
+(autoload 'vc-git-grep "vc-git" "\
+Run git grep, searching for REGEXP in FILES in directory DIR.
+The search is limited to file names matching shell pattern FILES.
+FILES may use abbreviations defined in `grep-files-aliases', e.g.
+entering `ch' is equivalent to `*.[ch]'. As whitespace triggers
+completion when entering a pattern, including it requires
+quoting, e.g. `\\[quoted-insert]<space>'.
+
+With \\[universal-argument] prefix, you can edit the constructed shell command
line
+before it is executed.
+With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
+
+Collect output in a buffer. While git grep runs asynchronously, you
+can use \\[next-error] (`next-error'), or
\\<grep-mode-map>\\[compile-goto-error] in the grep output buffer,
+to go to the lines where grep found matches.
+
+This command shares argument histories with \\[rgrep] and \\[grep].
+
+(fn REGEXP &optional FILES DIR)" t)
(register-definition-prefixes "vc-git" '("vc-"))
@@ -35319,7 +35444,7 @@ Key bindings:
;;; Generated autoloads from progmodes/verilog-mode.el
-(push (purecopy '(verilog-mode 2023 6 6 141322628)) package--builtin-versions)
+(push (purecopy '(verilog-mode 2024 3 1 121933719)) package--builtin-versions)
(autoload 'verilog-mode "verilog-mode" "\
Major mode for editing Verilog code.
\\<verilog-mode-map>
@@ -35594,7 +35719,7 @@ Usage:
according to option `vhdl-argument-list-indent'.
If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
- tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to
+ tabs. \\[tabify] and \\[untabify] allow the conversion of spaces to
tabs and vice versa.
Syntax-based indentation can be very slow in large files. Option
@@ -35905,7 +36030,7 @@ Usage:
`vhdl-highlight-translate-off' is non-nil.
For documentation and customization of the used colors see
- customization group `vhdl-highlight-faces' (`\\[customize-group]'). For
+ customization group `vhdl-highlight-faces' (\\[customize-group]). For
highlighting of matching parenthesis, see customization group
`paren-showing'. Automatic buffer highlighting is turned on/off by
option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
@@ -35965,14 +36090,14 @@ Usage:
sessions using the \"Save Options\" menu entry.
Options and their detailed descriptions can also be accessed by using
- the \"Customize\" menu entry or the command `\\[customize-option]'
- (`\\[customize-group]' for groups). Some customizations only take effect
+ the \"Customize\" menu entry or the command \\[customize-option]
+ (\\[customize-group] for groups). Some customizations only take effect
after some action (read the NOTE in the option documentation).
Customization can also be done globally (i.e. site-wide, read the
INSTALL file).
Not all options are described in this documentation, so go and see
- what other useful user options there are (`\\[vhdl-customize]' or menu)!
+ what other useful user options there are (\\[vhdl-customize] or menu)!
FILE EXTENSIONS:
@@ -36001,7 +36126,7 @@ Usage:
Maintenance:
------------
-To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.
+To submit a bug report, enter \\[vhdl-submit-bug-report] within VHDL Mode.
Add a description of the problem and include a reproducible test case.
Questions and enhancement requests can be sent to <reto@gnu.org>.
@@ -36266,19 +36391,19 @@ then \\[View-leave], \\[View-quit] and
\\[View-kill-and-leave] will return to th
Entry to view-mode runs the normal hook `view-mode-hook'.
-This is a minor mode. If called interactively, toggle the `View
-mode' mode. If the prefix argument is positive, enable the mode,
-and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `View mode'
+mode. If the prefix argument is positive, enable the mode, and if it is
+zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `view-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'view-mode-enter "view" "\
@@ -36353,6 +36478,57 @@ Turn on Viper emulation of Vi in Emacs. See Info node
`(viper)Top'." t)
(register-definition-prefixes "quail/viqr" '("viet-quail-define-rules"))
+;;; Generated autoloads from visual-wrap.el
+
+(autoload 'visual-wrap-prefix-mode "visual-wrap" "\
+Display continuation lines with prefixes from surrounding context.
+
+To enable this minor mode across all buffers, enable
+`global-visual-wrap-prefix-mode'.
+
+This is a minor mode. If called interactively, toggle the
+`Visual-Wrap-Prefix mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `visual-wrap-prefix-mode'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(put 'global-visual-wrap-prefix-mode 'globalized-minor-mode t)
+(defvar global-visual-wrap-prefix-mode nil "\
+Non-nil if Global Visual-Wrap-Prefix mode is enabled.
+See the `global-visual-wrap-prefix-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-visual-wrap-prefix-mode'.")
+(custom-autoload 'global-visual-wrap-prefix-mode "visual-wrap" nil)
+(autoload 'global-visual-wrap-prefix-mode "visual-wrap" "\
+Toggle Visual-Wrap-Prefix mode in all buffers.
+With prefix ARG, enable Global Visual-Wrap-Prefix mode if ARG is
+positive; otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+Visual-Wrap-Prefix mode is enabled in all buffers where
+`visual-wrap-prefix-mode' would do it.
+
+See `visual-wrap-prefix-mode' for more information on
+Visual-Wrap-Prefix mode.
+
+(fn &optional ARG)" t)
+(register-definition-prefixes "visual-wrap" '("visual-wrap-"))
+
+
;;; Generated autoloads from emacs-lisp/vtable.el
(register-definition-prefixes "vtable" '("vtable"))
@@ -36534,18 +36710,18 @@ current function name is continuously displayed in
the mode line,
in certain major modes.
This is a global minor mode. If called interactively, toggle the
-`Which-Function mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Which-Function mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='which-function-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "which-func" '("which-func"))
@@ -36563,19 +36739,19 @@ See also `whitespace-style', `whitespace-newline' and
This mode uses a number of faces to visualize the whitespace; see
the customization group `whitespace' for details.
-This is a minor mode. If called interactively, toggle the
-`Whitespace mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Whitespace
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `whitespace-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'whitespace-newline-mode "whitespace" "\
@@ -36589,19 +36765,18 @@ use `whitespace-mode'.
See also `whitespace-newline' and `whitespace-display-mappings'.
This is a minor mode. If called interactively, toggle the
-`Whitespace-Newline mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Whitespace-Newline mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `whitespace-newline-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-whitespace-mode 'globalized-minor-mode t)
@@ -36648,18 +36823,18 @@ See also `whitespace-newline' and
`whitespace-display-mappings'.
This is a global minor mode. If called interactively, toggle the
`Global Whitespace-Newline mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='global-whitespace-newline-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'whitespace-toggle-options "whitespace" "\
@@ -36963,19 +37138,19 @@ Show widget browser for WIDGET in other window.
(autoload 'widget-minor-mode "wid-browse" "\
Minor mode for traversing widgets.
-This is a minor mode. If called interactively, toggle the
-`Widget minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Widget minor
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `widget-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "wid-browse" '("widget-"))
@@ -37070,18 +37245,18 @@ for a description of this minor mode.")
Global minor mode for default windmove commands.
This is a global minor mode. If called interactively, toggle the
-`Windmove mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Windmove mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='windmove-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'windmove-default-keybindings "windmove" "\
@@ -37217,18 +37392,18 @@ sequence \\`C-c <left>'. If you change your mind
(while undoing),
you can press \\`C-c <right>' (calling `winner-redo').
This is a global minor mode. If called interactively, toggle the
-`Winner mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Winner mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='winner-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "winner" '("winner-"))
@@ -37296,19 +37471,18 @@ Allow `word-wrap' to fold on all breaking whitespace
characters.
The characters to break on are defined by `word-wrap-whitespace-characters'.
This is a minor mode. If called interactively, toggle the
-`Word-Wrap-Whitespace mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Word-Wrap-Whitespace mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `word-wrap-whitespace-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-word-wrap-whitespace-mode 'globalized-minor-mode t)
@@ -37559,18 +37733,18 @@ mouse functionality for such clicks is still
available by holding
down the SHIFT key while pressing the mouse button.
This is a global minor mode. If called interactively, toggle the
-`Xterm-Mouse mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Xterm-Mouse mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='xterm-mouse-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch"
"xterm-mouse-"))
@@ -37654,99 +37828,9 @@ run a specific program. The program must be a member
of
(register-definition-prefixes "zone" '("zone-"))
-;;; Generated autoloads from emacs-lisp/ert-font-lock.el
-
-(autoload 'ert-font-lock-deftest "ert-font-lock" "\
-Define test NAME (a symbol) using assertions from TEST-STR.
-
-Other than MAJOR-MODE and TEST-STR parameters, this macro accepts
-the same parameters and keywords as `ert-deftest' and is intended
-to be used through `ert'.
-
-(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)]
MAJOR-MODE TEST-STR)" nil t)
-(function-put 'ert-font-lock-deftest 'doc-string-elt 3)
-(function-put 'ert-font-lock-deftest 'lisp-indent-function 2)
-(autoload 'ert-font-lock-deftest-file "ert-font-lock" "\
-Define test NAME (a symbol) using assertions from FILE.
-
-FILE - path to a file with assertions in ERT resource director as
-return by `ert-resource-directory'.
-
-Other than MAJOR-MODE and FILE parameters, this macro accepts the
-same parameters and keywords as `ert-deftest' and is intended to
-be used through `ert'.
-
-(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)]
MAJOR-MODE FILE)" nil t)
-(function-put 'ert-font-lock-deftest-file 'doc-string-elt 3)
-(function-put 'ert-font-lock-deftest-file 'lisp-indent-function 2)
-(autoload 'ert-font-lock-test-string "ert-font-lock" "\
-Check font faces in TEST-STRING set by MODE.
-
-The function is meant to be run from within an ERT test.
-
-(fn TEST-STRING MODE)")
-(autoload 'ert-font-lock-test-file "ert-font-lock" "\
-Check font faces in FILENAME set by MODE.
-
-The function is meant to be run from within an ERT test.
-
-(fn FILENAME MODE)")
-(register-definition-prefixes "ert-font-lock" '("ert-font-lock--"))
-
-
-;;; Generated autoloads from touch-screen.el
-
-(autoload 'touch-screen-hold "touch-screen" "\
-Handle a long press EVENT.
-Ding and select the window at EVENT, then activate the mark. If
-`touch-screen-word-select' is enabled, try to select the whole
-word around EVENT; otherwise, set point to the location of EVENT.
-
-(fn EVENT)" t)
-(autoload 'touch-screen-track-tap "touch-screen" "\
-Track a single tap starting from EVENT.
-EVENT should be a `touchscreen-begin' event.
-
-Read touch screen events until a `touchscreen-end' event is
-received with the same ID as in EVENT. If UPDATE is non-nil and
-a `touchscreen-update' event is received in the mean time and
-contains a touch point with the same ID as in EVENT, call UPDATE
-with that event and DATA.
-
-If THRESHOLD is non-nil, enforce a threshold of movement that is
-either itself or 10 pixels when it is not a number. If the
-aforementioned touch point moves beyond that threshold on any
-axis, return nil immediately, and further resume mouse event
-translation for the touch point at hand.
-
-Return nil immediately if any other kind of event is received;
-otherwise, return t once the `touchscreen-end' event arrives.
-
-(fn EVENT &optional UPDATE DATA THRESHOLD)")
-(autoload 'touch-screen-track-drag "touch-screen" "\
-Track a single drag starting from EVENT.
-EVENT should be a `touchscreen-begin' event.
-
-Read touch screen events until a `touchscreen-end' event is
-received with the same ID as in EVENT. For each
-`touchscreen-update' event received in the mean time containing a
-touch point with the same ID as in EVENT, call UPDATE with the
-touch point in event and DATA, once the touch point has moved
-significantly by at least 5 pixels from where it was in EVENT.
-
-Return nil immediately if any other kind of event is received;
-otherwise, return either t or `no-drag' once the
-`touchscreen-end' event arrives; return `no-drag' returned if the
-touch point in EVENT did not move significantly, and t otherwise.
+;;; Generated autoloads from net/tramp-androidsu.el
-(fn EVENT UPDATE &optional DATA)")
-(autoload 'touch-screen-inhibit-drag "touch-screen" "\
-Inhibit subsequent `touchscreen-drag' events from being sent.
-Prevent `touchscreen-drag' and translated mouse events from being
-sent until the touch sequence currently being translated ends.
-Must be called from a command bound to a `touchscreen-hold' or
-`touchscreen-drag' event.")
-(register-definition-prefixes "touch-screen" '("touch-screen-"))
+(register-definition-prefixes "tramp-androidsu" '("tramp-androidsu-"))
;;; End of scraped data
@@ -37756,8 +37840,8 @@ Must be called from a command bound to a
`touchscreen-hold' or
;; Local Variables:
;; version-control: never
;; no-update-autoloads: t
-;; no-byte-compile: t
;; no-native-compile: t
+;; no-byte-compile: t
;; coding: utf-8-emacs-unix
;; End:
diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el
index 0d2c1888426..25e7c4a64a8 100644
--- a/lisp/leim/quail/latin-post.el
+++ b/lisp/leim/quail/latin-post.el
@@ -1616,6 +1616,7 @@ Doubling the postfix separates the letter and postfix:
e.g. a^^ -> a^
;; Italian (itln)
;; Spanish (spnsh)
;; Dvorak (dvorak)
+;; Colemak (colemak)
;;
;;; 92.12.15 created for Mule Ver.0.9.6 by Takahashi N. <ntakahas@etl.go.jp>
;;; 92.12.29 modified by Takahashi N. <ntakahas@etl.go.jp>
@@ -2224,6 +2225,55 @@ Dead accent is right to æ." nil t t t t nil nil nil nil
nil t)
("?" ?Z)
)
+;;
+(quail-define-package
+ "english-colemak" "English" "CM@" t
+ "English (ASCII) input method simulating Colemak keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2@ 3# 4$ 5% 6^ 7& 8* 9( 0) -_ =+ `~
+;; qQ wW fF pP gG jJ lL uU yY ;: [{ ]}
+;; aA rR sS tT dD hH nN eE iI oO '" \|
+;; zZ xX cC vV bB kK mM ,< .> /?
+
+(quail-define-rules
+ ("e" ?f)
+ ("r" ?p)
+ ("t" ?g)
+ ("y" ?j)
+ ("u" ?l)
+ ("i" ?u)
+ ("o" ?y)
+ ("p" ?\;)
+ ("s" ?r)
+ ("d" ?s)
+ ("f" ?t)
+ ("g" ?d)
+ ("j" ?n)
+ ("k" ?e)
+ ("l" ?i)
+ (";" ?o)
+ ("n" ?k)
+
+ ("E" ?F)
+ ("R" ?P)
+ ("T" ?G)
+ ("Y" ?J)
+ ("U" ?L)
+ ("I" ?U)
+ ("O" ?Y)
+ ("P" ?\:)
+ ("S" ?R)
+ ("D" ?S)
+ ("F" ?T)
+ ("G" ?D)
+ ("J" ?N)
+ ("K" ?E)
+ ("L" ?I)
+ (":" ?O)
+ ("N" ?K)
+ )
+
(quail-define-package
"latin-postfix" "Latin" "L<" t
"Latin character input method with postfix modifiers.
diff --git a/lisp/leim/quail/vnvni.el b/lisp/leim/quail/vnvni.el
index 59d1a82eb21..ae5941cbfc7 100644
--- a/lisp/leim/quail/vnvni.el
+++ b/lisp/leim/quail/vnvni.el
@@ -125,8 +125,8 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("A61" ?Ấ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
("a62" ?ầ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
("A62" ?Ầ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
- ("a63" ?ẩ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
- ("A63" ?Ẩ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
+ ("a63" ?ẩ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+ ("A63" ?Ẩ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
("a64" ?ẫ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
("A64" ?Ẫ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
("a65" ?ậ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
@@ -135,42 +135,42 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("A81" ?Ắ) ; LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
("a82" ?ằ) ; LATIN SMALL LETTER A WITH BREVE AND GRAVE
("A82" ?Ằ) ; LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
- ("a83" ?ẳ) ; LATIN SMALL LETTER A WITH BREVE AND HO6K ABOVE
- ("A83" ?Ẳ) ; LATIN CAPITAL LETTER A WITH BREVE AND HO6K ABOVE
+ ("a83" ?ẳ) ; LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE
+ ("A83" ?Ẳ) ; LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE
("a84" ?ẵ) ; LATIN SMALL LETTER A WITH BREVE AND TILDE
("A84" ?Ẵ) ; LATIN CAPITAL LETTER A WITH BREVE AND TILDE
("a85" ?ặ) ; LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
("A85" ?Ặ) ; LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
("e5" ?ẹ) ; LATIN SMALL LETTER E WITH DOT BELOW
("E5" ?Ẹ) ; LATIN CAPITAL LETTER E WITH DOT BELOW
- ("e3" ?ẻ) ; LATIN SMALL LETTER E WITH HO6K ABOVE
- ("E3" ?Ẻ) ; LATIN CAPITAL LETTER E WITH HO6K ABOVE
+ ("e3" ?ẻ) ; LATIN SMALL LETTER E WITH HOOK ABOVE
+ ("E3" ?Ẻ) ; LATIN CAPITAL LETTER E WITH HOOK ABOVE
("e4" ?ẽ) ; LATIN SMALL LETTER E WITH TILDE
("E4" ?Ẽ) ; LATIN CAPITAL LETTER E WITH TILDE
("e61" ?ế) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
("E61" ?Ế) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
("e62" ?ề) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
("E62" ?Ề) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
- ("e63" ?ể) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
- ("E63" ?Ể) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
+ ("e63" ?ể) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+ ("E63" ?Ể) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
("e64" ?ễ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
("E64" ?Ễ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
("e65" ?ệ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
("E65" ?Ệ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
- ("i3" ?ỉ) ; LATIN SMALL LETTER I WITH HO6K ABOVE
- ("I3" ?Ỉ) ; LATIN CAPITAL LETTER I WITH HO6K ABOVE
+ ("i3" ?ỉ) ; LATIN SMALL LETTER I WITH HOOK ABOVE
+ ("I3" ?Ỉ) ; LATIN CAPITAL LETTER I WITH HOOK ABOVE
("i5" ?ị) ; LATIN SMALL LETTER I WITH DOT BELOW
("I5" ?Ị) ; LATIN CAPITAL LETTER I WITH DOT BELOW
("o5" ?ọ) ; LATIN SMALL LETTER O WITH DOT BELOW
("O5" ?Ọ) ; LATIN CAPITAL LETTER O WITH DOT BELOW
- ("o3" ?ỏ) ; LATIN SMALL LETTER O WITH HO6K ABOVE
- ("O3" ?Ỏ) ; LATIN CAPITAL LETTER O WITH HO6K ABOVE
+ ("o3" ?ỏ) ; LATIN SMALL LETTER O WITH HOOK ABOVE
+ ("O3" ?Ỏ) ; LATIN CAPITAL LETTER O WITH HOOK ABOVE
("o61" ?ố) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
("O61" ?Ố) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
("o62" ?ồ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
("O62" ?Ồ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
- ("o63" ?ổ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
- ("O63" ?Ổ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
+ ("o63" ?ổ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+ ("O63" ?Ổ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
("o64" ?ỗ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
("O64" ?Ỗ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
("o65" ?ộ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELO7
@@ -179,22 +179,22 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("O71" ?Ớ) ; LATIN CAPITAL LETTER O WITH HORN AND ACUTE
("o72" ?ờ) ; LATIN SMALL LETTER O WITH HORN AND GRAVE
("O72" ?Ờ) ; LATIN CAPITAL LETTER O WITH HORN AND GRAVE
- ("o73" ?ở) ; LATIN SMALL LETTER O WITH HORN AND HO6K ABOVE
- ("O73" ?Ở) ; LATIN CAPITAL LETTER O WITH HORN AND HO6K ABOVE
+ ("o73" ?ở) ; LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE
+ ("O73" ?Ở) ; LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE
("o74" ?ỡ) ; LATIN SMALL LETTER O WITH HORN AND TILDE
("O74" ?Ỡ) ; LATIN CAPITAL LETTER O WITH HORN AND TILDE
("o75" ?ợ) ; LATIN SMALL LETTER O WITH HORN AND DOT BELO7
("O75" ?Ợ) ; LATIN CAPITAL LETTER O WITH HORN AND DOT BELO7
("u5" ?ụ) ; LATIN SMALL LETTER U WITH DOT BELO7
("U5" ?Ụ) ; LATIN CAPITAL LETTER U WITH DOT BELO7
- ("u3" ?ủ) ; LATIN SMALL LETTER U WITH HO6K ABOVE
- ("U3" ?Ủ) ; LATIN CAPITAL LETTER U WITH HO6K ABOVE
+ ("u3" ?ủ) ; LATIN SMALL LETTER U WITH HOOK ABOVE
+ ("U3" ?Ủ) ; LATIN CAPITAL LETTER U WITH HOOK ABOVE
("u71" ?ứ) ; LATIN SMALL LETTER U WITH HORN AND ACUTE
("U71" ?Ứ) ; LATIN CAPITAL LETTER U WITH HORN AND ACUTE
("u72" ?ừ) ; LATIN SMALL LETTER U WITH HORN AND GRAVE
("U72" ?Ừ) ; LATIN CAPITAL LETTER U WITH HORN AND GRAVE
- ("u73" ?ử) ; LATIN SMALL LETTER U WITH HORN AND HO6K ABOVE
- ("U73" ?Ử) ; LATIN CAPITAL LETTER U WITH HORN AND HO6K ABOVE
+ ("u73" ?ử) ; LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE
+ ("U73" ?Ử) ; LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE
("u74" ?ữ) ; LATIN SMALL LETTER U WITH HORN AND TILDE
("U74" ?Ữ) ; LATIN CAPITAL LETTER U WITH HORN AND TILDE
("u75" ?ự) ; LATIN SMALL LETTER U WITH HORN AND DOT BELO7
@@ -203,20 +203,20 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("Y2" ?Ỳ) ; LATIN CAPITAL LETTER Y WITH GRAVE
("y5" ?ỵ) ; LATIN SMALL LETTER Y WITH DOT BELO7
("Y5" ?Ỵ) ; LATIN CAPITAL LETTER Y WITH DOT BELO7
- ("y3" ?ỷ) ; LATIN SMALL LETTER Y WITH HO6K ABOVE
- ("Y3" ?Ỷ) ; LATIN CAPITAL LETTER Y WITH HO6K ABOVE
+ ("y3" ?ỷ) ; LATIN SMALL LETTER Y WITH HOOK ABOVE
+ ("Y3" ?Ỷ) ; LATIN CAPITAL LETTER Y WITH HOOK ABOVE
("y4" ?ỹ) ; LATIN SMALL LETTER Y WITH TILDE
("Y4" ?Ỹ) ; LATIN CAPITAL LETTER Y WITH TILDE
("d9" ?đ) ; LATIN SMALL LETTER D WITH STROKE
("D9" ?Đ) ; LATIN CAPITAL LETTER D WITH STROKE
;("$$" ?₫) ; U+20AB DONG SIGN (#### check)
- ("a22" ["a22"])
+ ("a22" ["a2"])
("A22" ["A2"])
("a11" ["a1"])
("A11" ["A1"])
- ("a66"' ["a6"])
- ("A66"' ["A6"])
+ ("a66" ["a6"])
+ ("A66" ["A6"])
("a44" ["a4"])
("A44" ["A4"])
("e22" ["e2"])
@@ -248,7 +248,7 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("i44" ["i4"])
("I44" ["I4"])
("u44" ["u4"])
- ("U44" ["u4"])
+ ("U44" ["U4"])
("o77" ["o7"])
("O77" ["O7"])
("u77" ["u7"])
@@ -283,7 +283,7 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("Y33" ["Y3"])
("y44" ["y4"])
("Y44" ["Y4"])
- ("d9" ["d9"])
+ ("d99" ["d9"])
("D99" ["D9"])
;("$$$" ["$$"])
diff --git a/lisp/loadup.el b/lisp/loadup.el
index e25b2d7ed8a..b2e1080f0e9 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -725,6 +725,8 @@ directory got moved. This is set to be a pair in the form
of:
(unwind-protect
(let ((tmp-dump-mode dump-mode)
(dump-mode nil)
+ ;; Set `lexical-binding' to nil by default
+ ;; in the dumped Emacs.
(lexical-binding nil))
(if (member tmp-dump-mode '("pdump" "pbootstrap"))
(dump-emacs-portable (expand-file-name output
invocation-directory))
diff --git a/lisp/locate.el b/lisp/locate.el
index d86e7fa678f..70328d5184e 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -559,7 +559,7 @@ do not work in subdirectories.
(defun locate-tags ()
"Visit a tags table in `*Locate*' mode."
- (interactive)
+ (interactive nil locate-mode)
(if (locate-main-listing-line-p)
(let ((tags-table (locate-get-filename)))
(and (y-or-n-p (format "Visit tags table %s? " tags-table))
@@ -589,7 +589,7 @@ locate database using the shell command in
`locate-update-command'."
(defun locate-find-directory ()
"Visit the directory of the file mentioned on this line."
- (interactive)
+ (interactive nil locate-mode)
(if (locate-main-listing-line-p)
(let ((directory-name (locate-get-dirname)))
(if (file-directory-p directory-name)
@@ -601,7 +601,7 @@ locate database using the shell command in
`locate-update-command'."
(defun locate-find-directory-other-window ()
"Visit the directory of the file named on this line in other window."
- (interactive)
+ (interactive nil locate-mode)
(if (locate-main-listing-line-p)
(find-file-other-window (locate-get-dirname))
(message "This command only works inside main listing.")))
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 668cae05521..cfdbc1b2509 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1845,7 +1845,7 @@ place. It affects how `mail-extract-address-components'
works."
;; https://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
(defconst mail-extr-all-top-level-domains
- (let ((ob (make-vector 739 0)))
+ (let ((ob (obarray-make 739)))
(mapc
(lambda (x)
(put (intern (downcase (car x)) ob)
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 68d325ea261..c8006294a7d 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -171,7 +171,7 @@ no aliases, which is represented by this being a table with
no entries.)")
;;;###autoload
(defun mail-abbrevs-setup ()
"Initialize use of the `mailabbrev' package."
- (if (and (not (vectorp mail-abbrevs))
+ (if (and (not (obarrayp mail-abbrevs))
(file-exists-p mail-personal-alias-file))
(progn
(setq mail-abbrev-modtime
@@ -196,7 +196,7 @@ no aliases, which is represented by this being a table with
no entries.)")
"Read mail aliases from personal mail alias file and set `mail-abbrevs'.
By default this is the file specified by `mail-personal-alias-file'."
(setq file (expand-file-name (or file mail-personal-alias-file)))
- (if (vectorp mail-abbrevs)
+ (if (obarrayp mail-abbrevs)
nil
(setq mail-abbrevs nil)
(define-abbrev-table 'mail-abbrevs '()))
@@ -278,7 +278,7 @@ double-quotes."
;; true, and we do some evil space->comma hacking like /bin/mail does.
(interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
;; Read the defaults first, if we have not done so.
- (unless (vectorp mail-abbrevs) (build-mail-abbrevs))
+ (unless (obarrayp mail-abbrevs) (build-mail-abbrevs))
;; strip garbage from front and end
(if (string-match "\\`[ \t\n,]+" definition)
(setq definition (substring definition (match-end 0))))
@@ -355,7 +355,7 @@ double-quotes."
(if mail-abbrev-aliases-need-to-be-resolved
(progn
;; (message "Resolving mail aliases...")
- (if (vectorp mail-abbrevs)
+ (if (obarrayp mail-abbrevs)
(mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs))
(setq mail-abbrev-aliases-need-to-be-resolved nil)
;; (message "Resolving mail aliases... done.")
@@ -555,9 +555,9 @@ of a mail alias. The value is set up, buffer-local, when
first needed.")
(defun mail-abbrev-insert-alias (&optional alias)
"Prompt for and insert a mail alias."
(interactive (progn
- (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
+ (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup))
(list (completing-read "Expand alias: " mail-abbrevs nil t))))
- (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
+ (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup))
(insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) ""))
(mail-abbrev-expand-hook))
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 85eaec33660..d422383acdf 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -805,8 +805,8 @@ that knows the exact ordering of the \\( \\)
subexpressions.")
"\\(" cite-chars "[ \t]*\\)\\)+\\)"
"\\(.*\\)")
(beginning-of-line) (end-of-line)
- (1 font-lock-comment-delimiter-face nil t)
- (5 font-lock-comment-face nil t)))
+ (1 'font-lock-comment-delimiter-face nil t)
+ (5 'font-lock-comment-face nil t)))
'("^\\(X-[a-z0-9-]+\\|In-Reply-To\\|Date\\):.*\\(\n[ \t]+.*\\)*$"
. 'rmail-header-name))))
"Additional expressions to highlight in Rmail mode.")
@@ -815,7 +815,7 @@ that knows the exact ordering of the \\( \\)
subexpressions.")
(defun rmail-pop-to-buffer (&rest args)
"Like `pop-to-buffer', but with `split-width-threshold' set to nil."
(let (split-width-threshold)
- (apply 'pop-to-buffer args)))
+ (apply #'pop-to-buffer args)))
;; Perform BODY in the summary buffer
;; in such a way that its cursor is properly updated in its own window.
@@ -1008,66 +1008,66 @@ The buffer is expected to be narrowed to just the
header of the message."
(defvar rmail-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
- (define-key map "a" 'rmail-add-label)
- (define-key map "b" 'rmail-bury)
- (define-key map "c" 'rmail-continue)
- (define-key map "d" 'rmail-delete-forward)
- (define-key map "\C-d" 'rmail-delete-backward)
- (define-key map "e" 'rmail-edit-current-message)
+ (define-key map "a" #'rmail-add-label)
+ (define-key map "b" #'rmail-bury)
+ (define-key map "c" #'rmail-continue)
+ (define-key map "d" #'rmail-delete-forward)
+ (define-key map "\C-d" #'rmail-delete-backward)
+ (define-key map "e" #'rmail-edit-current-message)
;; If you change this, change the rmail-resend menu-item's :keys.
- (define-key map "f" 'rmail-forward)
- (define-key map "g" 'rmail-get-new-mail)
- (define-key map "h" 'rmail-summary)
- (define-key map "i" 'rmail-input)
- (define-key map "j" 'rmail-show-message)
- (define-key map "k" 'rmail-kill-label)
- (define-key map "l" 'rmail-summary-by-labels)
- (define-key map "\e\C-h" 'rmail-summary)
- (define-key map "\e\C-l" 'rmail-summary-by-labels)
- (define-key map "\e\C-r" 'rmail-summary-by-recipients)
- (define-key map "\e\C-s" 'rmail-summary-by-regexp)
- (define-key map "\e\C-f" 'rmail-summary-by-senders)
- (define-key map "\e\C-t" 'rmail-summary-by-topic)
- (define-key map "m" 'rmail-mail)
- (define-key map "\em" 'rmail-retry-failure)
- (define-key map "n" 'rmail-next-undeleted-message)
- (define-key map "\en" 'rmail-next-message)
- (define-key map "\e\C-n" 'rmail-next-labeled-message)
- (define-key map "o" 'rmail-output)
- (define-key map "\C-o" 'rmail-output-as-seen)
- (define-key map "p" 'rmail-previous-undeleted-message)
- (define-key map "\ep" 'rmail-previous-message)
- (define-key map "\e\C-p" 'rmail-previous-labeled-message)
- (define-key map "q" 'rmail-quit)
- (define-key map "r" 'rmail-reply)
+ (define-key map "f" #'rmail-forward)
+ (define-key map "g" #'rmail-get-new-mail)
+ (define-key map "h" #'rmail-summary)
+ (define-key map "i" #'rmail-input)
+ (define-key map "j" #'rmail-show-message)
+ (define-key map "k" #'rmail-kill-label)
+ (define-key map "l" #'rmail-summary-by-labels)
+ (define-key map "\e\C-h" #'rmail-summary)
+ (define-key map "\e\C-l" #'rmail-summary-by-labels)
+ (define-key map "\e\C-r" #'rmail-summary-by-recipients)
+ (define-key map "\e\C-s" #'rmail-summary-by-regexp)
+ (define-key map "\e\C-f" #'rmail-summary-by-senders)
+ (define-key map "\e\C-t" #'rmail-summary-by-topic)
+ (define-key map "m" #'rmail-mail)
+ (define-key map "\em" #'rmail-retry-failure)
+ (define-key map "n" #'rmail-next-undeleted-message)
+ (define-key map "\en" #'rmail-next-message)
+ (define-key map "\e\C-n" #'rmail-next-labeled-message)
+ (define-key map "o" #'rmail-output)
+ (define-key map "\C-o" #'rmail-output-as-seen)
+ (define-key map "p" #'rmail-previous-undeleted-message)
+ (define-key map "\ep" #'rmail-previous-message)
+ (define-key map "\e\C-p" #'rmail-previous-labeled-message)
+ (define-key map "q" #'rmail-quit)
+ (define-key map "r" #'rmail-reply)
;; I find I can't live without the default M-r command -- rms.
- ;; (define-key rmail-mode-map "\er" 'rmail-search-backwards)
- (define-key map "s" 'rmail-expunge-and-save)
- (define-key map "\es" 'rmail-search)
- (define-key map "t" 'rmail-toggle-header)
- (define-key map "u" 'rmail-undelete-previous-message)
- (define-key map "v" 'rmail-mime)
- (define-key map "w" 'rmail-output-body-to-file)
- (define-key map "\C-c\C-w" 'rmail-widen)
- (define-key map "x" 'rmail-expunge)
- (define-key map "." 'rmail-beginning-of-message)
- (define-key map "/" 'rmail-end-of-message)
- (define-key map "<" 'rmail-first-message)
- (define-key map ">" 'rmail-last-message)
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map "\177" 'scroll-down-command)
- (define-key map "?" 'describe-mode)
- (define-key map "\C-c\C-d" 'rmail-epa-decrypt)
- (define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date)
- (define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject)
- (define-key map "\C-c\C-s\C-a" 'rmail-sort-by-author)
- (define-key map "\C-c\C-s\C-r" 'rmail-sort-by-recipient)
- (define-key map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent)
- (define-key map "\C-c\C-s\C-l" 'rmail-sort-by-lines)
- (define-key map "\C-c\C-s\C-k" 'rmail-sort-by-labels)
- (define-key map "\C-c\C-n" 'rmail-next-same-subject)
- (define-key map "\C-c\C-p" 'rmail-previous-same-subject)
+ ;; (define-key rmail-mode-map "\er" #'rmail-search-backwards)
+ (define-key map "s" #'rmail-expunge-and-save)
+ (define-key map "\es" #'rmail-search)
+ (define-key map "t" #'rmail-toggle-header)
+ (define-key map "u" #'rmail-undelete-previous-message)
+ (define-key map "v" #'rmail-mime)
+ (define-key map "w" #'rmail-output-body-to-file)
+ (define-key map "\C-c\C-w" #'rmail-widen)
+ (define-key map "x" #'rmail-expunge)
+ (define-key map "." #'rmail-beginning-of-message)
+ (define-key map "/" #'rmail-end-of-message)
+ (define-key map "<" #'rmail-first-message)
+ (define-key map ">" #'rmail-last-message)
+ (define-key map " " #'scroll-up-command)
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map "\177" #'scroll-down-command)
+ (define-key map "?" #'describe-mode)
+ (define-key map "\C-c\C-d" #'rmail-epa-decrypt)
+ (define-key map "\C-c\C-s\C-d" #'rmail-sort-by-date)
+ (define-key map "\C-c\C-s\C-s" #'rmail-sort-by-subject)
+ (define-key map "\C-c\C-s\C-a" #'rmail-sort-by-author)
+ (define-key map "\C-c\C-s\C-r" #'rmail-sort-by-recipient)
+ (define-key map "\C-c\C-s\C-c" #'rmail-sort-by-correspondent)
+ (define-key map "\C-c\C-s\C-l" #'rmail-sort-by-lines)
+ (define-key map "\C-c\C-s\C-k" #'rmail-sort-by-labels)
+ (define-key map "\C-c\C-n" #'rmail-next-same-subject)
+ (define-key map "\C-c\C-p" #'rmail-previous-same-subject)
(define-key map [menu-bar] (make-sparse-keymap))
@@ -1344,9 +1344,9 @@ Instead, these commands are available:
(setq local-abbrev-table text-mode-abbrev-table)
;; Functions to support buffer swapping:
(add-hook 'write-region-annotate-functions
- 'rmail-write-region-annotate nil t)
- (add-hook 'kill-buffer-hook 'rmail-mode-kill-buffer-hook nil t)
- (add-hook 'change-major-mode-hook 'rmail-change-major-mode-hook nil t))
+ #'rmail-write-region-annotate nil t)
+ (add-hook 'kill-buffer-hook #'rmail-mode-kill-buffer-hook nil t)
+ (add-hook 'change-major-mode-hook #'rmail-change-major-mode-hook nil t))
(defun rmail-generate-viewer-buffer ()
"Return a reusable buffer suitable for viewing messages.
@@ -1363,7 +1363,7 @@ Create the buffer if necessary."
(file-name-nondirectory
(or buffer-file-name (buffer-name)))))))
(with-current-buffer newbuf
- (add-hook 'kill-buffer-hook 'rmail-view-buffer-kill-buffer-hook nil t))
+ (add-hook 'kill-buffer-hook #'rmail-view-buffer-kill-buffer-hook nil t))
newbuf)))
(defun rmail-swap-buffers ()
@@ -1479,7 +1479,7 @@ If so restore the actual mbox message collection."
;; Don't turn off auto-saving based on the size of the buffer
;; because that code does not understand buffer-swapping.
(setq-local auto-save-include-big-deletions t)
- (setq-local revert-buffer-function 'rmail-revert)
+ (setq-local revert-buffer-function #'rmail-revert)
(setq-local font-lock-defaults
'(rmail-font-lock-keywords
t t nil nil
@@ -1490,7 +1490,7 @@ If so restore the actual mbox message collection."
(setq-local file-precious-flag t)
(setq-local desktop-save-buffer t)
(setq-local save-buffer-coding-system 'no-conversion)
- (setq next-error-move-function 'rmail-next-error-move))
+ (setq next-error-move-function #'rmail-next-error-move))
;; Handle M-x revert-buffer done in an rmail-mode buffer.
(defun rmail-revert (arg noconfirm)
@@ -1606,7 +1606,7 @@ The duplicate copy goes into the Rmail file just after
the original."
(files (directory-files start t rmail-secondary-file-regexp)))
;; Sort here instead of in directory-files
;; because this list is usually much shorter.
- (sort files 'string<))))
+ (sort files #'string<))))
(defun rmail-list-to-menu (menu-name l action &optional full-name)
(let ((menu (make-sparse-keymap menu-name))
@@ -2026,7 +2026,7 @@ Value is the size of the newly read mail after
conversion."
rmail-movemail-flags)
(list file tofile)
(if password (list password) nil))))
- (apply 'call-process args))
+ (apply #'call-process args))
(if (not (buffer-modified-p errors))
;; No output => movemail won
nil
@@ -2518,7 +2518,7 @@ Output a helpful message unless NOMSG is non-nil."
;; which will never be used.
(push nil messages-head)
(push ?0 deleted-head)
- (setq rmail-message-vector (apply 'vector messages-head)
+ (setq rmail-message-vector (apply #'vector messages-head)
rmail-deleted-vector (concat deleted-head))
(setq rmail-summary-vector (make-vector rmail-total-messages nil)
@@ -3605,10 +3605,10 @@ If `rmail-confirm-expunge' is non-nil, ask user to
confirm."
(cons (aref messages number) nil)))
(setq rmail-current-message new-message-number
rmail-total-messages counter
- rmail-message-vector (apply 'vector messages-head)
+ rmail-message-vector (apply #'vector messages-head)
rmail-deleted-vector (make-string (1+ counter) ?\s)
rmail-summary-vector (vconcat (nreverse new-summary))
- rmail-msgref-vector (apply 'vector (nreverse new-msgref))
+ rmail-msgref-vector (apply #'vector (nreverse new-msgref))
win t)))
(message "Expunging deleted messages...done")
(if (not win)
@@ -3891,7 +3891,7 @@ use \\[mail-yank-original] to yank the original message
into it."
(if (or references message-id)
(list (cons "References" (if references
(concat
- (mapconcat 'identity references " ")
+ (mapconcat #'identity references " ")
" " message-id)
message-id)))))))
@@ -4089,26 +4089,24 @@ typically for purposes of moderating a list."
(insert "Resent-Bcc: " (user-login-name) "\n"))
(insert "Resent-To: " (if (stringp address)
address
- (mapconcat 'identity address ",\n\t"))
+ (mapconcat #'identity address ",\n\t"))
"\n")
;; Expand abbrevs in the recipients.
(save-excursion
(if (featurep 'mailabbrev)
(let ((end (point-marker))
- (local-abbrev-table mail-abbrevs)
- (old-syntax-table (syntax-table)))
- (if (and (not (vectorp mail-abbrevs))
+ (local-abbrev-table mail-abbrevs))
+ (if (and (not (obarrayp mail-abbrevs))
(file-exists-p mail-personal-alias-file))
(build-mail-abbrevs))
(unless mail-abbrev-syntax-table
(mail-abbrev-make-syntax-table))
- (set-syntax-table mail-abbrev-syntax-table)
- (goto-char before)
- (while (and (< (point) end)
- (progn (forward-word-strictly 1)
- (<= (point) end)))
- (expand-abbrev))
- (set-syntax-table old-syntax-table))
+ (with-syntax-table mail-abbrev-syntax-table
+ (goto-char before)
+ (while (and (< (point) end)
+ (progn (forward-word-strictly 1)
+ (<= (point) end)))
+ (expand-abbrev))))
(expand-mail-aliases before (point)))))
;;>> Set up comment, if any.
(if (and (sequencep comment) (not (zerop (length comment))))
@@ -4335,7 +4333,7 @@ This has an effect only if a summary buffer exists."
(defun rmail-fontify-buffer-function ()
;; This function's symbol is bound to font-lock-fontify-buffer-function.
- (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t)
+ (add-hook 'rmail-show-message-hook #'rmail-fontify-message nil t)
;; If we're already showing a message, fontify it now.
(if rmail-current-message (rmail-fontify-message))
;; Prevent Font Lock mode from kicking in.
@@ -4346,7 +4344,7 @@ This has an effect only if a summary buffer exists."
(with-silent-modifications
(save-restriction
(widen)
- (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t)
+ (remove-hook 'rmail-show-message-hook #'rmail-fontify-message t)
(remove-text-properties (point-min) (point-max) '(rmail-fontified nil))
(font-lock-default-unfontify-buffer))))
@@ -4381,11 +4379,12 @@ browsing, and moving of messages."
"Install those variables used by speedbar to enhance rmail."
(unless rmail-speedbar-key-map
(setq rmail-speedbar-key-map (speedbar-make-specialized-keymap))
- (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line)
- (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line)
- (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line)
+ (declare-function speedbar-edit-line "speedbar")
+ (define-key rmail-speedbar-key-map "e" #'speedbar-edit-line)
+ (define-key rmail-speedbar-key-map "r" #'speedbar-edit-line)
+ (define-key rmail-speedbar-key-map "\C-m" #'speedbar-edit-line)
(define-key rmail-speedbar-key-map "M"
- 'rmail-speedbar-move-message-to-folder-on-line)))
+ #'rmail-speedbar-move-message-to-folder-on-line)))
;; Mouse-3.
(defvar rmail-speedbar-menu-items
@@ -4829,7 +4828,8 @@ Content-Transfer-Encoding: base64\n")
(with-current-buffer
(if (rmail-buffers-swapped-p) rmail-buffer rmail-view-buffer)
(setq buffer-file-coding-system rmail-message-encoding))))
-(add-hook 'after-save-hook 'rmail-after-save-hook)
+;; FIXME: Don't do it globally!!
+(add-hook 'after-save-hook #'rmail-after-save-hook)
;;; Mailing list support
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index d9c4cb8cfee..a13c42edb5c 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -31,7 +31,7 @@
;; Global to all RMAIL buffers. It exists for the sake of completion.
;; It is better to use strings with the label functions and let them
;; worry about making the label.
-(defvar rmail-label-obarray (make-vector 47 0)
+(defvar rmail-label-obarray (obarray-make 47)
"Obarray of labels used by Rmail.
`rmail-read-label' uses this to offer completion.")
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 47c6a8f0613..5b290899ff5 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1353,6 +1353,15 @@ mail status in mode line"))
(frame-visible-p
(symbol-value 'speedbar-frame))))))
+ (bindings--define-key menu [showhide-outline-minor-mode]
+ '(menu-item "Outlines" outline-minor-mode
+ :help "Turn outline-minor-mode on/off"
+ :visible (seq-some #'local-variable-p
+ '(outline-search-function
+ outline-regexp outline-level))
+ :button (:toggle . (and (boundp 'outline-minor-mode)
+ outline-minor-mode))))
+
(bindings--define-key menu [showhide-tab-line-mode]
'(menu-item "Window Tab Line" global-tab-line-mode
:help "Turn window-local tab-lines on/off"
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 0bfc5c06313..099fa1599d5 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -321,7 +321,7 @@ the form (concat S2 S)."
;; Predicates are called differently depending on the nature of
;; the completion table :-(
(cond
- ((vectorp table) ;Obarray.
+ ((obarrayp table)
(lambda (sym) (funcall pred (concat prefix (symbol-name sym)))))
((hash-table-p table)
(lambda (s _v) (funcall pred (concat prefix s))))
@@ -3485,9 +3485,10 @@ Fourth arg MUSTMATCH can take the following values:
input, but she needs to confirm her choice if she called
`minibuffer-complete' right before `minibuffer-complete-and-exit'
and the input is not an existing file.
-- a function, which will be called with the input as the
- argument. If the function returns a non-nil value, the
- minibuffer is exited with that argument as the value.
+- a function, which will be called with a single argument, the
+ input unquoted by `substitute-in-file-name', which see. If the
+ function returns a non-nil value, the minibuffer is exited with
+ that argument as the value.
- anything else behaves like t except that typing RET does not exit if it
does non-null completion.
@@ -3576,7 +3577,13 @@ See `read-file-name' for the meaning of the arguments."
(let ((ignore-case read-file-name-completion-ignore-case)
(minibuffer-completing-file-name t)
(pred (or predicate 'file-exists-p))
- (add-to-history nil))
+ (add-to-history nil)
+ (require-match (if (functionp mustmatch)
+ (lambda (input)
+ (funcall mustmatch
+ ;; User-supplied MUSTMATCH expects an
unquoted filename
+ (substitute-in-file-name input)))
+ mustmatch)))
(let* ((val
(if (or (not (next-read-file-uses-dialog-p))
@@ -3612,7 +3619,7 @@ See `read-file-name' for the meaning of the arguments."
(read-file-name--defaults dir initial))))
(set-syntax-table minibuffer-local-filename-syntax))
(completing-read prompt 'read-file-name-internal
- pred mustmatch insdef
+ pred require-match insdef
'file-name-history default-filename)))
;; If DEFAULT-FILENAME not supplied and DIR contains
;; a file name, split it.
diff --git a/lisp/mouse.el b/lisp/mouse.el
index d1b06c2040d..26835437c08 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -414,13 +414,17 @@ Each function receives the menu and the mouse click event
and returns the same menu after adding own menu items to the composite menu.
When there is a text property `context-menu-function' at CLICK,
it overrides all functions from `context-menu-functions'.
+Whereas the property `context-menu-functions' doesn't override
+the variable `context-menu-functions', but adds menus from the
+list in the property after adding menus from the variable.
At the end, it's possible to modify the final menu by specifying
the function `context-menu-filter-function'."
(let* ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t)))
(click (or click last-input-event))
- (window (posn-window (event-start click)))
- (fun (mouse-posn-property (event-start click)
- 'context-menu-function)))
+ (start (event-start click))
+ (window (posn-window start))
+ (fun (mouse-posn-property start 'context-menu-function))
+ (funs (mouse-posn-property start 'context-menu-functions)))
(unless (eq (selected-window) window)
(select-window window))
@@ -430,7 +434,9 @@ the function `context-menu-filter-function'."
(run-hook-wrapped 'context-menu-functions
(lambda (fun)
(setq menu (funcall fun menu click))
- nil)))
+ nil))
+ (dolist (fun funs)
+ (setq menu (funcall fun menu click))))
;; Remove duplicate separators as well as ones at the beginning or
;; end of the menu.
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 9577e0f2f42..768c70c2e3a 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -1867,11 +1867,14 @@ A value of t means the main playlist.")
(defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t)
(defun mpc-volume-refresh ()
- ;; Maintain the volume.
- (setq mpc-volume
- (mpc-volume-widget
- (string-to-number (cdr (assq 'volume mpc-status)))))
- (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status)))
+ "Maintain the volume."
+ (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status))
+ (status-vol (cdr (assq 'volume mpc-status))))
+ ;; If MPD is paused or stopped the volume is nil.
+ (when status-vol
+ (setq mpc-volume
+ (mpc-volume-widget
+ (string-to-number status-vol))))
(when (buffer-live-p status-buf)
(with-current-buffer status-buf (force-mode-line-update)))))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 359453ca433..ddc57724343 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -688,8 +688,10 @@ websites are increasingly rare, but they do still exist."
(defun browse-url-url-at-point ()
(or (thing-at-point 'url t)
;; assume that the user is pointing at something like gnu.org/gnu
- (let ((f (thing-at-point 'filename t)))
- (and f (concat browse-url-default-scheme "://" f)))))
+ (when-let ((f (thing-at-point 'filename t)))
+ (if (string-match-p browse-url-button-regexp f)
+ f
+ (concat browse-url-default-scheme "://" f)))))
;; Having this as a separate function called by the browser-specific
;; functions allows them to be stand-alone commands, making it easier
@@ -1322,7 +1324,7 @@ and instant messengers instead of opening it in a web
browser."
:type 'boolean
:version "30.1")
-(declare-function android-browse-url "androidselect.c")
+(declare-function android-browse-url "../term/android-win")
;;;###autoload
(defun browse-url-default-android-browser (url &optional _new-window)
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 1981b757017..d4dfa33716c 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -787,7 +787,7 @@ FUNCTION is the callback which is called for each search
result."
Optional argument NOMATCHING controls whether to suppress the display
of matching words."
- (message "Searching for %s in %s" word dictionary)
+ (insert (format-message "Searching for `%s' in `%s'\n" word dictionary))
(dictionary-send-command (concat "define "
(dictionary-encode-charset dictionary "")
" \""
@@ -799,13 +799,13 @@ of matching words."
(if (dictionary-check-reply reply 552)
(progn
(unless nomatching
- (insert "Word not found")
+ (insert (format-message "Word `%s' not found\n" word))
(dictionary-do-matching
word
dictionary
"."
(lambda (reply)
- (insert ", maybe you are looking for one of these words\n\n")
+ (insert "Maybe you are looking for one of these words\n")
(dictionary-display-only-match-result reply)))
(dictionary-post-buffer)))
(if (dictionary-check-reply reply 550)
@@ -1116,20 +1116,26 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
(defun dictionary-new-matching (word)
"Run a new matching search on WORD."
- (dictionary-ensure-buffer)
(dictionary-store-positions)
- (dictionary-do-matching word dictionary-default-dictionary
- dictionary-default-strategy
- 'dictionary-display-match-result)
- (dictionary-store-state 'dictionary-do-matching
+ (dictionary-ensure-buffer)
+ (dictionary-new-matching-internal word dictionary-default-dictionary
+ dictionary-default-strategy
+ 'dictionary-display-match-result)
+ (dictionary-store-state 'dictionary-new-matching-internal
(list word dictionary-default-dictionary
dictionary-default-strategy
'dictionary-display-match-result)))
+(defun dictionary-new-matching-internal (word dictionary strategy function)
+ "Start a new matching for WORD in DICTIONARY after preparing the buffer.
+FUNCTION is the callback which is called for each search result."
+ (dictionary-pre-buffer)
+ (dictionary-do-matching word dictionary strategy function))
+
(defun dictionary-do-matching (word dictionary strategy function)
"Search for WORD with STRATEGY in DICTIONARY and display them with FUNCTION."
- (message "Lookup matching words for %s in %s using %s"
- word dictionary strategy)
+ (insert (format-message "Lookup matching words for `%s' in `%s' using `%s'\n"
+ word dictionary strategy))
(dictionary-send-command
(concat "match " (dictionary-encode-charset dictionary "") " "
(dictionary-encode-charset strategy "") " \""
@@ -1141,10 +1147,13 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
(if (dictionary-check-reply reply 551)
(error "Strategy \"%s\" is invalid" strategy))
(if (dictionary-check-reply reply 552)
- (error (concat
- "No match for \"%s\" with strategy \"%s\" in "
- "dictionary \"%s\".")
- word strategy dictionary))
+ (let ((errmsg (format-message
+ (concat
+ "No match for `%s' with strategy `%s' in "
+ "dictionary `%s'.")
+ word strategy dictionary)))
+ (insert errmsg "\n")
+ (user-error errmsg)))
(unless (dictionary-check-reply reply 152)
(error "Unknown server answer: %s" (dictionary-reply reply)))
(funcall function reply)))
@@ -1172,8 +1181,6 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
(defun dictionary-display-match-result (reply)
"Display the results in REPLY from a match operation."
- (dictionary-pre-buffer)
-
(let ((number (nth 1 (dictionary-reply-list reply)))
(list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
(insert number " matching word" (if (equal number "1") "" "s")
@@ -1271,7 +1278,7 @@ prompt for DICTIONARY."
(interactive)
(let ((word (current-word)))
(unless word
- (error "No word at point"))
+ (user-error "No word at point"))
(dictionary-new-search (cons word dictionary-default-dictionary))))
(defun dictionary-previous ()
@@ -1311,7 +1318,8 @@ prompt for DICTIONARY."
(defun dictionary-popup-matching-words (&optional word)
"Display entries matching WORD or the current word if not given."
(interactive)
- (dictionary-do-matching (or word (current-word) (error "Nothing to search
for"))
+ (dictionary-do-matching (or word (current-word)
+ (user-error "Nothing to search for"))
dictionary-default-dictionary
dictionary-default-popup-strategy
'dictionary-process-popup-replies))
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 23ea88ef4ad..54f4d227a49 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -359,7 +359,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
result))
;;; Interface functions.
-(defvar dns-cache (make-vector 4096 0))
+(defvar dns-cache (obarray-make 4096))
(defun dns-query-cached (name &optional type fullp reversep)
(let* ((key (format "%s:%s:%s:%s" name type fullp reversep))
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 6ae1e6d3d0a..2936bc8f099 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -182,6 +182,33 @@ the tab bar is enabled."
(const :tag "Open new tab when tab bar is enabled" tab-bar)
(const :tag "Never open URL in new tab" nil)))
+(defcustom eww-before-browse-history-function #'eww-delete-future-history
+ "A function to call to update history before browsing to a new page.
+EWW provides the following values for this option:
+
+* `eww-delete-future-history': Delete any history entries after the
+ currently-shown one. This is the default behavior, and works the same
+ as in most other web browsers.
+
+* `eww-clone-previous-history': Clone and prepend any history entries up
+ to the currently-shown one. This is like `eww-delete-future-history',
+ except that it preserves the previous contents of the history list at
+ the end.
+
+* `ignore': Preserve the current history unchanged. This will result in
+ the new page simply being prepended to the existing history list.
+
+You can also set this to any other function you wish."
+ :version "30.1"
+ :group 'eww
+ :type '(choice (function-item :tag "Delete future history"
+ eww-delete-future-history)
+ (function-item :tag "Clone previous history"
+ eww-clone-previous-history)
+ (function-item :tag "Preserve history"
+ ignore)
+ (function :tag "Custom function")))
+
(defcustom eww-after-render-hook nil
"A hook called after eww has finished rendering the buffer."
:version "25.1"
@@ -312,7 +339,10 @@ parameter, and should return the (possibly) transformed
URL."
(defvar eww-data nil)
(defvar eww-history nil)
-(defvar eww-history-position 0)
+(defvar eww-history-position 0
+ "The 1-indexed position in `eww-history'.
+If zero, EWW is at the newest page, which isn't yet present in
+`eww-history'.")
(defvar eww-prompt-history nil)
(defvar eww-local-regex "localhost"
@@ -340,7 +370,7 @@ parameter, and should return the (possibly) transformed
URL."
(defun eww-suggested-uris nil
"Return the list of URIs to suggest at the `eww' prompt.
This list can be customized via `eww-suggest-uris'."
- (let ((obseen (make-vector 42 0))
+ (let ((obseen (obarray-make 42))
(uris nil))
(dolist (fun eww-suggest-uris)
(let ((ret (funcall fun)))
@@ -402,6 +432,7 @@ For more information, see Info node `(eww) Top'."
(t
(get-buffer-create "*eww*"))))
(eww-setup-buffer)
+ (eww--before-browse)
;; Check whether the domain only uses "Highly Restricted" Unicode
;; IDNA characters. If not, transform to punycode to indicate that
;; there may be funny business going on.
@@ -654,7 +685,6 @@ The renaming scheme is performed in accordance with
(with-current-buffer buffer
(plist-put eww-data :url url)
(eww--after-page-change)
- (setq eww-history-position 0)
(and last-coding-system-used
(set-buffer-file-coding-system last-coding-system-used))
(unless shr-fill-text
@@ -905,6 +935,11 @@ The renaming scheme is performed in accordance with
`((?u . ,(or url ""))
(?t . ,title))))))))
+(defun eww--before-browse ()
+ (funcall eww-before-browse-history-function)
+ (setq eww-history-position 0
+ eww-data (list :title "")))
+
(defun eww--after-page-change ()
(eww-update-header-line-format)
(eww--rename-buffer))
@@ -1037,6 +1072,7 @@ the like."
(base (plist-get eww-data :url)))
(eww-score-readability dom)
(eww-save-history)
+ (eww--before-browse)
(eww-display-html nil nil
(list 'base (list (cons 'href base))
(eww-highest-readability dom))
@@ -1129,9 +1165,9 @@ the like."
["Reload" eww-reload t]
["Follow URL in new buffer" eww-open-in-new-buffer]
["Back to previous page" eww-back-url
- :active (not (zerop (length eww-history)))]
+ :active (< eww-history-position (length eww-history))]
["Forward to next page" eww-forward-url
- :active (not (zerop eww-history-position))]
+ :active (> eww-history-position 1)]
["Browse with external browser" eww-browse-with-external-browser t]
["Download" eww-download t]
["View page source" eww-view-source]
@@ -1155,9 +1191,9 @@ the like."
(easy-menu-define nil easy-menu nil
'("Eww"
["Back to previous page" eww-back-url
- :visible (not (zerop (length eww-history)))]
+ :active (< eww-history-position (length eww-history))]
["Forward to next page" eww-forward-url
- :visible (not (zerop eww-history-position))]
+ :active (> eww-history-position 1)]
["Reload" eww-reload t]))
(dolist (item (reverse (lookup-key easy-menu [menu-bar eww])))
(when (consp item)
@@ -1280,16 +1316,20 @@ instead of `browse-url-new-window-flag'."
(interactive nil eww-mode)
(when (>= eww-history-position (length eww-history))
(user-error "No previous page"))
- (eww-save-history)
- (setq eww-history-position (+ eww-history-position 2))
+ (if (eww-save-history)
+ ;; We were at the latest page (which was just added to the
+ ;; history), so go back two entries.
+ (setq eww-history-position 2)
+ (setq eww-history-position (1+ eww-history-position)))
(eww-restore-history (elt eww-history (1- eww-history-position))))
(defun eww-forward-url ()
"Go to the next displayed page."
(interactive nil eww-mode)
- (when (zerop eww-history-position)
+ (when (<= eww-history-position 1)
(user-error "No next page"))
(eww-save-history)
+ (setq eww-history-position (1- eww-history-position))
(eww-restore-history (elt eww-history (1- eww-history-position))))
(defun eww-restore-history (elem)
@@ -1959,6 +1999,7 @@ If EXTERNAL is double prefix, browse in new buffer."
(eww-same-page-p url (plist-get eww-data :url)))
(let ((point (point)))
(eww-save-history)
+ (eww--before-browse)
(plist-put eww-data :url url)
(goto-char (point-min))
(if-let ((match (text-property-search-forward 'shr-target-id target
#'member)))
@@ -2289,11 +2330,69 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
;;; History code
(defun eww-save-history ()
+ "Save the current page's data to the history.
+If the current page is a historial one loaded from
+`eww-history' (e.g. by calling `eww-back-url'), this will update the
+page's entry in `eww-history' and return nil. Otherwise, add a new
+entry to `eww-history' and return t."
(plist-put eww-data :point (point))
(plist-put eww-data :text (buffer-string))
- (let ((history-delete-duplicates nil))
- (add-to-history 'eww-history eww-data eww-history-limit t))
- (setq eww-data (list :title "")))
+ (if (zerop eww-history-position)
+ (let ((history-delete-duplicates nil))
+ (add-to-history 'eww-history eww-data eww-history-limit t)
+ (setq eww-history-position 1)
+ t)
+ (setf (elt eww-history (1- eww-history-position)) eww-data)
+ nil))
+
+(defun eww-delete-future-history ()
+ "Remove any entries in `eww-history' after the currently-shown one.
+This is useful for `eww-before-browse-history-function' to make EWW's
+navigation to a new page from a historical one work like other web
+browsers: it will delete any \"future\" history elements before adding
+the new page to the end of the history.
+
+For example, if `eww-history' looks like this (going from newest to
+oldest, with \"*\" marking the current page):
+
+ E D C* B A
+
+then calling this function updates `eww-history' to:
+
+ C* B A"
+ (when (> eww-history-position 1)
+ (setq eww-history (nthcdr (1- eww-history-position) eww-history)
+ ;; We don't really need to set this since `eww--before-browse'
+ ;; sets it too, but this ensures that other callers can use
+ ;; this function and get the expected results.
+ eww-history-position 1)))
+
+(defun eww-clone-previous-history ()
+ "Clone and prepend entries in `eww-history' up to the currently-shown one.
+These cloned entries get added to the beginning of `eww-history' so that
+it's possible to navigate back to the very first page for this EWW
+without deleting any history entries.
+
+For example, if `eww-history' looks like this (going from newest to
+oldest, with \"*\" marking the current page):
+
+ E D C* B A
+
+then calling this function updates `eww-history' to:
+
+ C* B A E D C B A
+
+This is useful for setting `eww-before-browse-history-function' (which
+see)."
+ (when (> eww-history-position 1)
+ (setq eww-history (take eww-history-limit
+ (append (nthcdr (1- eww-history-position)
+ eww-history)
+ eww-history))
+ ;; As with `eww-delete-future-history', we don't really need
+ ;; to set this since `eww--before-browse' sets it too, but
+ ;; let's be thorough.
+ eww-history-position 1)))
(defvar eww-current-buffer)
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index f10b5b8fc12..a06740528e9 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1057,7 +1057,7 @@ necessary. If nil, the buffer name is generated."
(setq imap-capability nil)
(setq streams nil))))))
(when (imap-opened buffer)
- (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
+ (setq imap-mailbox-data (obarray-make imap-mailbox-prime)))
;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state
imap-auth buffer)
(when imap-stream
buffer))))
@@ -1280,7 +1280,7 @@ If EXAMINE is non-nil, do a read-only select."
(concat (if examine "EXAMINE" "SELECT") " \""
mailbox "\"")))
(progn
- (setq imap-message-data (make-vector imap-message-prime 0)
+ (setq imap-message-data (obarray-make imap-message-prime)
imap-state (if examine 'examine 'selected))
imap-current-mailbox)
;; Failed SELECT/EXAMINE unselects current mailbox
@@ -1722,7 +1722,7 @@ See `imap-enable-exchange-bug-workaround'."
(string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox))))
(let ((old-mailbox imap-current-mailbox)
(state imap-state)
- (imap-message-data (make-vector 2 0)))
+ (imap-message-data (obarray-make 2)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch-safe '("*" . "*:*") "UID")
@@ -1768,7 +1768,7 @@ first element. The rest of list contains the saved
articles' UIDs."
(imap-mailbox-get-1 'appenduid mailbox)
(let ((old-mailbox imap-current-mailbox)
(state imap-state)
- (imap-message-data (make-vector 2 0)))
+ (imap-message-data (obarray-make 2)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch-safe '("*" . "*:*") "UID")
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 2e4ad1cc412..da23d062c2e 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -263,9 +263,10 @@ arguments to pass to the OPERATION."
(tramp-convert-file-attributes v localname id-format
(and
(tramp-adb-send-command-and-check
- v (format "%s -d -l %s | cat"
+ v (format "(%s -d -l %s; echo tramp_exit_status $?) | cat"
(tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
+ (tramp-shell-quote-argument localname))
+ nil t)
(with-current-buffer (tramp-get-buffer v)
(tramp-adb-sh-fix-ls-output)
(cdar (tramp-do-parse-file-attributes-with-ls v)))))))
@@ -316,9 +317,10 @@ arguments to pass to the OPERATION."
directory full match nosort id-format count
(with-current-buffer (tramp-get-buffer v)
(when (tramp-adb-send-command-and-check
- v (format "%s -a -l %s | cat"
+ v (format "(%s -a -l %s; echo tramp_exit_status $?) | cat"
(tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
+ (tramp-shell-quote-argument localname))
+ nil t)
;; We insert also filename/. and filename/.., because "ls"
;; doesn't on some file systems, like "sdcard".
(unless (search-backward-regexp (rx "." eol) nil t)
@@ -440,10 +442,12 @@ Emacs dired can't find files."
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
- (tramp-adb-send-command
- v (format "%s -a %s | cat"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
+ (unless (tramp-adb-send-command-and-check
+ v (format "(%s -a %s; echo tramp_exit_status $?) | cat"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname))
+ nil t)
+ (erase-buffer))
(mapcar
(lambda (f)
(if (file-directory-p (expand-file-name f directory))
@@ -504,12 +508,11 @@ Emacs dired can't find files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (if (tramp-file-property-p v localname "file-attributes")
- (tramp-check-cached-permissions v ?w)
- (tramp-adb-send-command-and-check
- v (format "test -w %s" (tramp-shell-quote-argument localname))))
+ ;; The file-attributes cache is unreliable since its
+ ;; information does not take partition writability into
+ ;; account, so a call to test must never be skipped.
+ (tramp-adb-send-command-and-check
+ v (format "test -w %s" (tramp-shell-quote-argument localname)))
;; If file doesn't exist, check if directory is writable.
(and
(file-directory-p (file-name-directory filename))
@@ -1142,17 +1145,23 @@ error and non-nil on success."
(while (search-forward-regexp (rx (+ "\r") eol) nil t)
(replace-match "" nil nil)))))))
-(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
+(defun tramp-adb-send-command-and-check
+ (vec command &optional exit-status command-augmented-p)
"Run COMMAND and check its exit status.
Sends `echo $?' along with the COMMAND for checking the exit
status. If COMMAND is nil, just sends `echo $?'. Returns nil if
the exit status is not equal 0, and t otherwise.
+If COMMAND-AUGMENTED-P, COMMAND is already configured to print exit
+status upon completion and need not be modified.
+
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
(tramp-adb-send-command
vec (if command
- (format "%s; echo tramp_exit_status $?" command)
+ (if command-augmented-p
+ command
+ (format "%s; echo tramp_exit_status $?" command))
"echo tramp_exit_status $?"))
(with-current-buffer (tramp-get-connection-buffer vec)
(unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
@@ -1230,7 +1239,7 @@ connection if a previous connection has died for some
reason."
(let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?
(process-connection-type tramp-process-connection-type)
(args (tramp-expand-args
- vec 'tramp-login-args ?d (or device "")))
+ vec 'tramp-login-args nil ?d (or device "")))
(p (let ((default-directory
tramp-compat-temporary-file-directory))
(apply
@@ -1257,7 +1266,7 @@ connection if a previous connection has died for some
reason."
(tramp-set-connection-property
p "prompt" (rx "///" (literal prompt) "#$"))
(tramp-adb-send-command
- vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
+ vec (format "PS1=\"///\"\"%s\"\"#$\" PS2=''" prompt))
;; Disable line editing.
(tramp-adb-send-command
diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el
new file mode 100644
index 00000000000..09bee323f5e
--- /dev/null
+++ b/lisp/net/tramp-androidsu.el
@@ -0,0 +1,561 @@
+;;; tramp-androidsu.el --- Tramp method for Android superuser shells -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; Author: Po Lu
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; `su' method implementation for Android.
+;;
+;; The `su' method struggles (as do other shell-based methods) with the
+;; crippled versions of many Unix utilities installed on Android,
+;; workarounds for which are implemented in the `adb' method. This
+;; method defines a shell-based method that is identical in function to
+;; and replaces if connecting to a local Android machine `su', but
+;; reuses such code from the `adb' method where applicable and also
+;; provides for certain mannerisms of popular Android `su'
+;; implementations.
+
+;;; Code:
+
+(require 'tramp)
+(require 'tramp-adb)
+(require 'tramp-sh)
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-method "androidsu"
+ "When this method name is used, forward all calls to su.")
+
+;;;###tramp-autoload
+(defcustom tramp-androidsu-mount-global-namespace t
+ "When non-nil, browse files from within the global mount namespace.
+On systems that assign each application a unique view of the
+filesystem by executing them within individual mount namespaces
+and thus conceal each application's data directories from
+others, invoke `su' with the option `-mm' in order for the shell
+launched to run within the global mount namespace, so that Tramp
+may edit files belonging to any and all applications."
+ :group 'tramp
+ :version "30.1"
+ :type 'boolean)
+
+;;;###tramp-autoload
+(defcustom tramp-androidsu-remote-path '("/system/bin"
+ "/system/xbin")
+ "Directories in which to search for transfer programs and the like."
+ :group 'tramp
+ :version "30.1"
+ :type '(list string))
+
+(defvar tramp-androidsu-su-mm-supported 'unknown
+ "Whether `su -mm' is supported on this system.")
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-local-shell-name "/system/bin/sh"
+ "Name of the local shell on Android.")
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-local-tmp-directory "/data/local/tmp"
+ "Name of the local temporary directory on Android.")
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-androidsu-method
+ (tramp-login-program "su")
+ (tramp-login-args (("-") ("%u")))
+ (tramp-remote-shell ,tramp-androidsu-local-shell-name)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-tmpdir
,tramp-androidsu-local-tmp-directory)
+ (tramp-connection-timeout 10)
+ (tramp-shell-name ,tramp-androidsu-local-shell-name)))
+ (add-to-list 'tramp-default-user-alist
+ `(,tramp-androidsu-method nil ,tramp-root-id-string)))
+
+(defvar android-use-exec-loader) ; androidfns.c.
+
+(defun tramp-androidsu-maybe-open-connection (vec)
+ "Open a connection VEC if not already open.
+Mostly identical to `tramp-adb-maybe-open-connection', but also disables
+multibyte mode and waits for the shell prompt to appear."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
+ (with-tramp-debug-message vec "Opening connection"
+ (let ((p (tramp-get-connection-process vec))
+ (process-name (tramp-get-connection-property vec "process-name"))
+ (process-environment (copy-sequence process-environment)))
+ ;; Open a new connection.
+ (condition-case err
+ (unless (process-live-p p)
+ (with-tramp-progress-reporter
+ vec 3
+ (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
+ (format "Opening connection %s for %s using %s"
+ process-name
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec))
+ (format "Opening connection %s for %s@%s using %s"
+ process-name
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec)))
+ (let* ((coding-system-for-read 'utf-8-unix)
+ (process-connection-type tramp-process-connection-type)
+ ;; The executable loader cannot execute setuid
+ ;; binaries, such as su.
+ (android-use-exec-loader nil)
+ (p (start-process (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ ;; Disregard
+ ;; `tramp-encoding-shell', as
+ ;; there's no guarantee that it's
+ ;; possible to execute it with
+ ;; `android-use-exec-loader' off.
+ tramp-androidsu-local-shell-name "-i"))
+ (user (tramp-file-name-user vec))
+ command)
+ ;; Set sentinel. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
+ (tramp-post-process-creation p vec)
+ ;; Replace `login-args' place holders.
+ (setq command (format "exec su - %s || exit" user))
+ ;; Attempt to execute the shell inside the global mount
+ ;; namespace if requested.
+ (when tramp-androidsu-mount-global-namespace
+ (progn
+ (when (eq tramp-androidsu-su-mm-supported 'unknown)
+ ;; Change the prompt in advance so that
+ ;; `tramp-adb-send-command-and-check' can call
+ ;; `tramp-search-regexp'.
+ (tramp-adb-send-command
+ vec (format "PS1=%s PS2=''"
+ (tramp-shell-quote-argument
+ tramp-end-of-output)))
+ (setq tramp-androidsu-su-mm-supported
+ ;; Detect support for `su -mm'.
+ (tramp-adb-send-command-and-check
+ vec "su -mm -c 'exit 24'" 24)))
+ (when tramp-androidsu-su-mm-supported
+ (tramp-set-connection-property
+ vec "remote-namespace" t)
+ (setq command (format "exec su -mm - %s || exit"
+ user)))))
+ ;; Send the command.
+ (tramp-message vec 3 "Sending command `%s'" command)
+ (tramp-adb-send-command vec command t t)
+ ;; Android su binaries contact a background service to
+ ;; obtain authentication; during this process, input
+ ;; received is discarded, so input cannot be
+ ;; guaranteed to reach the root shell until its prompt
+ ;; is displayed.
+ (with-current-buffer (process-buffer p)
+ (tramp-wait-for-regexp p tramp-connection-timeout
+ "#[[:space:]]*$"))
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+ ;; Change prompt.
+ (tramp-adb-send-command
+ vec (format "PS1=%s PS2=''"
+ (tramp-shell-quote-argument tramp-end-of-output)))
+ ;; Disable line editing.
+ (tramp-adb-send-command
+ vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs")
+ ;; Disable Unicode, for otherwise Unicode filenames will
+ ;; not be decoded correctly.
+ (tramp-adb-send-command vec "set +U")
+ ;; Dump option settings in the traces.
+ (when (>= tramp-verbose 9)
+ (tramp-adb-send-command vec "set -o"))
+ ;; Disable echo expansion.
+ (tramp-adb-send-command
+ vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t)
+ ;; Check whether the echo has really been disabled.
+ ;; Some implementations, like busybox, don't support
+ ;; disabling.
+ (tramp-adb-send-command vec "echo foo" t)
+ (with-current-buffer (process-buffer p)
+ (goto-char (point-min))
+ (when (looking-at-p "echo foo")
+ (tramp-set-connection-property p "remote-echo" t)
+ (tramp-message vec 5 "Remote echo still on. Ok.")
+ ;; Make sure backspaces and their echo are enabled
+ ;; and no line width magic interferes with them.
+ (tramp-adb-send-command
+ vec "stty icanon erase ^H cols 32767" t)))
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t))))
+ ;; Cleanup, and propagate the signal.
+ ((error quit)
+ (tramp-cleanup-connection vec t)
+ (signal (car err) (cdr err)))))))
+
+(defun tramp-androidsu-generate-wrapper (function)
+ "Return connection wrapper function for FUNCTION.
+Return a function which temporarily substitutes local replacements for
+the `adb' method's connection management functions around a call to
+FUNCTION."
+ (lambda (&rest args)
+ (let ((tramp-adb-wait-for-output
+ (symbol-function #'tramp-adb-wait-for-output))
+ (tramp-adb-maybe-open-connection
+ (symbol-function #'tramp-adb-maybe-open-connection)))
+ (unwind-protect
+ (progn
+ ;; `tramp-adb-wait-for-output' addresses problems introduced
+ ;; by the adb utility itself, not Android utilities, so
+ ;; replace it with the regular Tramp function.
+ (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output)
+ ;; Likewise, except some special treatment is necessary on
+ ;; account of flaws in Android's su implementation.
+ (fset 'tramp-adb-maybe-open-connection
+ #'tramp-androidsu-maybe-open-connection)
+ (apply function args))
+ ;; Restore the original definitions of the functions overridden
+ ;; above.
+ (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output)
+ (fset 'tramp-adb-maybe-open-connection
+ tramp-adb-maybe-open-connection)))))
+
+(defalias 'tramp-androidsu-handle-copy-file #'tramp-sh-handle-copy-file)
+
+(defalias 'tramp-androidsu-handle-delete-directory
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory))
+
+(defalias 'tramp-androidsu-handle-delete-file
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file))
+
+(defalias 'tramp-androidsu-handle-directory-files-and-attributes
+ (tramp-androidsu-generate-wrapper
+ #'tramp-adb-handle-directory-files-and-attributes))
+
+(defalias 'tramp-androidsu-handle-exec-path
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path))
+
+(defalias 'tramp-androidsu-handle-file-attributes
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-attributes))
+
+(defalias 'tramp-androidsu-handle-file-executable-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-executable-p))
+
+(defalias 'tramp-androidsu-handle-file-exists-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p))
+
+(defalias 'tramp-androidsu-handle-file-local-copy
+ #'tramp-sh-handle-file-local-copy)
+
+(defalias 'tramp-androidsu-handle-file-name-all-completions
+ (tramp-androidsu-generate-wrapper
+ #'tramp-adb-handle-file-name-all-completions))
+
+(defalias 'tramp-androidsu-handle-file-readable-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p))
+
+(defalias 'tramp-androidsu-handle-file-system-info
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-system-info))
+
+(defalias 'tramp-androidsu-handle-file-writable-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-writable-p))
+
+(defalias 'tramp-androidsu-handle-make-directory
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-directory))
+
+(defun tramp-androidsu-handle-make-process (&rest args)
+ "Like `tramp-handle-make-process', but modified for Android."
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((default-directory tramp-compat-temporary-file-directory)
+ (name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type
+ (or (plist-get args :connection-type) process-connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (bufferp buffer) (string-or-null-p buffer))
+ (signal 'wrong-type-argument (list #'bufferp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (memq (car coding) coding-system-list)
+ (memq (cdr coding) coding-system-list)))
+ (signal 'wrong-type-argument (list #'symbolp coding)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (eq filter t) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr))
+ (signal 'wrong-type-argument (list #'bufferp stderr)))
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ (orig-command command)
+ (env (mapcar
+ (lambda (elt)
+ (when (tramp-compat-string-search "=" elt) elt))
+ tramp-remote-process-environment))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ (env (dolist (elt process-environment env)
+ (when
+ (and
+ (tramp-compat-string-search "=" elt)
+ (not
+ (member
+ elt (default-toplevel-value
'process-environment))))
+ (setq env (cons elt env)))))
+ ;; Add remote path if exists.
+ (env (let ((remote-path
+ (string-join (tramp-get-remote-path v) ":")))
+ (setenv-internal env "PATH" remote-path 'keep)))
+ (env (setenv-internal
+ env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
+ (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
+ ;; Quote command.
+ (command (mapconcat #'tramp-shell-quote-argument command " "))
+ ;; Set cwd and environment variables.
+ (command
+ (append
+ `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env")
+ env `(,command ")")))
+ ;; Add remote shell if needed.
+ (command
+ (if (consp (tramp-get-method-parameter v 'tramp-direct-async))
+ (append
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ `(,(string-join command " ")))
+ command))
+ p)
+ ;; Generate a command to start the process using `su' with
+ ;; suitable options for specifying the mount namespace and
+ ;; suchlike.
+ (setq
+ p (make-process
+ :name name :buffer buffer
+ :command (if (tramp-get-connection-property v "remote-namespace")
+ (append (list "su" "-mm" "-" user "-c") command)
+ (append (list "su" "-" user "-c") command))
+ :coding coding :noquery noquery :connection-type connection-type
+ :sentinel sentinel :stderr stderr))
+ ;; Set filter. Prior Emacs 29.1, it doesn't work reliably
+ ;; to provide it as `make-process' argument when filter is
+ ;; t. See Bug#51177.
+ (when filter
+ (set-process-filter p filter))
+ (tramp-post-process-creation p v)
+ ;; Query flag is overwritten in `tramp-post-process-creation',
+ ;; so we reset it.
+ (set-process-query-on-exit-flag p (null noquery))
+ ;; This is needed for ssh or PuTTY based processes, and
+ ;; only if the respective options are set. Perhaps, the
+ ;; setting could be more fine-grained.
+ ;; (process-put p 'tramp-shared-socket t)
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property p "remote-command" orig-command)
+ (when (bufferp stderr)
+ (tramp-taint-remote-process-buffer stderr))
+ p)))))
+
+(defalias 'tramp-androidsu-handle-make-symbolic-link
+ #'tramp-sh-handle-make-symbolic-link)
+
+(defalias 'tramp-androidsu-handle-process-file
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file))
+
+(defalias 'tramp-androidsu-handle-rename-file #'tramp-sh-handle-rename-file)
+
+(defalias 'tramp-androidsu-handle-set-file-modes
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes))
+
+(defalias 'tramp-androidsu-handle-set-file-times
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-times))
+
+(defalias 'tramp-androidsu-handle-get-remote-gid
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-gid))
+
+(defalias 'tramp-androidsu-handle-get-remote-groups
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-groups))
+
+(defalias 'tramp-androidsu-handle-get-remote-uid
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid))
+
+(defalias 'tramp-androidsu-handle-write-region #'tramp-sh-handle-write-region)
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-file-name-handler-alist
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ (copy-directory . tramp-handle-copy-directory)
+ (copy-file . tramp-androidsu-handle-copy-file)
+ (delete-directory . tramp-androidsu-handle-delete-directory)
+ (delete-file . tramp-androidsu-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-androidsu-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . tramp-androidsu-handle-exec-path)
+ (expand-file-name . tramp-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-androidsu-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-androidsu-handle-file-executable-p)
+ (file-exists-p . tramp-androidsu-handle-file-exists-p)
+ (file-group-gid . tramp-handle-file-group-gid)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-androidsu-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions
+ . tramp-androidsu-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `file-name-sans-versions' performed by default handler.
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
+ (file-ownership-preserved-p . ignore)
+ (file-readable-p . tramp-androidsu-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-androidsu-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
+ (file-writable-p . tramp-androidsu-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . tramp-handle-list-system-processes)
+ (load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-androidsu-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . tramp-androidsu-handle-make-process)
+ (make-symbolic-link . tramp-androidsu-handle-make-symbolic-link)
+ (memory-info . tramp-handle-memory-info)
+ (process-attributes . tramp-handle-process-attributes)
+ (process-file . tramp-androidsu-handle-process-file)
+ (rename-file . tramp-androidsu-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . tramp-androidsu-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . tramp-androidsu-handle-set-file-times)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-handle-start-file-process)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
+ (tramp-get-remote-gid . tramp-androidsu-handle-get-remote-gid)
+ (tramp-get-remote-groups . tramp-androidsu-handle-get-remote-groups)
+ (tramp-get-remote-uid . tramp-androidsu-handle-get-remote-uid)
+ (tramp-set-file-uid-gid . ignore)
+ (unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-androidsu-handle-write-region))
+ "Alist of Tramp handler functions for superuser sessions on Android.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-androidsu-file-name-p (vec-or-filename)
+ "Check whether VEC-OR-FILENAME is for the `androidsu' method."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (equal (tramp-file-name-method vec) tramp-androidsu-method)))
+
+;;;###tramp-autoload
+(defun tramp-androidsu-file-name-handler (operation &rest args)
+ "Invoke the `androidsu' handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
+ (if-let ((fn (assoc operation tramp-androidsu-file-name-handler-alist)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler))
+
+;;; Default connection-local variables for Tramp.
+
+(defconst tramp-androidsu-connection-local-default-variables
+ `((tramp-remote-path . ,tramp-androidsu-remote-path))
+ "Default connection-local variables for remote androidsu connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-androidsu-connection-local-default-profile
+ tramp-androidsu-connection-local-default-variables)
+
+(connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-androidsu-method)
+ 'tramp-androidsu-connection-local-default-profile)
+
+(with-eval-after-load 'shell
+ (connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-androidsu-method)
+ 'tramp-adb-connection-local-default-shell-profile
+ 'tramp-adb-connection-local-default-ps-profile))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-androidsu 'force)))
+
+(provide 'tramp-androidsu)
+;;; tramp-androidsu.el ends here
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 298cacdb0e0..59c4223794c 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -387,6 +387,8 @@ arguments to pass to the OPERATION."
;;;###autoload
(progn (defun tramp-register-archive-autoload-file-name-handler ()
"Add archive file name handler to `file-name-handler-alist'."
+ ;; Do not use read syntax #' for `tramp-archive-file-name-handler', it
+ ;; isn't autoloaded.
(when (and tramp-archive-enabled
(not
(rassq 'tramp-archive-file-name-handler
file-name-handler-alist)))
@@ -443,7 +445,7 @@ arguments to pass to the OPERATION."
(and (tramp-archive-file-name-p name)
(match-string 2 name)))
-(defvar tramp-archive-hash (make-hash-table :test 'equal)
+(defvar tramp-archive-hash (make-hash-table :test #'equal)
"Hash table for archive local copies.
The hash key is the archive name. The value is a cons of the
used `tramp-file-name' structure for tramp-gvfs, and the file
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 25123a6e282..225a26ad1cd 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -144,7 +144,6 @@ If KEY is `tramp-cache-undefined', don't create anything,
and return nil."
(defun tramp-get-file-property (key file property &optional default)
"Get the PROPERTY of FILE from the cache context of KEY.
Return DEFAULT if not set."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(if (eq key tramp-cache-undefined) default
(let* ((hash (tramp-get-hash-table key))
@@ -191,7 +190,6 @@ Return DEFAULT if not set."
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Return VALUE."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(if (eq key tramp-cache-undefined) value
(let ((hash (tramp-get-hash-table key)))
@@ -224,7 +222,6 @@ Return VALUE."
;;;###tramp-autoload
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(remhash property (tramp-get-hash-table key))
@@ -239,7 +236,6 @@ Return VALUE."
;; `file-name-directory' can return nil, for example for "~".
(when-let ((file (file-name-directory file))
(file (directory-file-name file)))
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(dolist (property (hash-table-keys (tramp-get-hash-table key)))
@@ -254,7 +250,6 @@ Return VALUE."
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
(let ((truename (tramp-get-file-property key file "file-truename")))
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(tramp-message key 8 "%s" (tramp-file-name-localname key))
@@ -338,17 +333,15 @@ FILE must be a local file name on a connection identified
via KEY."
"Save PROPERTY, run BODY, reset PROPERTY.
Preserve timestamps."
(declare (indent 3) (debug t))
- `(progn
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setf ,key (tramp-file-name-unify ,key ,file))
- (let* ((hash (tramp-get-hash-table ,key))
- (cached (and (hash-table-p hash) (gethash ,property hash))))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTY. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (if (consp cached)
- (puthash ,property cached hash)
- (remhash ,property hash))))))
+ `(let* ((key (tramp-file-name-unify ,key ,file))
+ (hash (tramp-get-hash-table key))
+ (cached (and (hash-table-p hash) (gethash ,property hash))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (if (consp cached)
+ (puthash ,property cached hash)
+ (remhash ,property hash)))))
;;;###tramp-autoload
(defmacro with-tramp-saved-file-properties (key file properties &rest body)
@@ -356,22 +349,20 @@ Preserve timestamps."
PROPERTIES is a list of file properties (strings).
Preserve timestamps."
(declare (indent 3) (debug t))
- `(progn
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setf ,key (tramp-file-name-unify ,key ,file))
- (let* ((hash (tramp-get-hash-table ,key))
- (values
- (and (hash-table-p hash)
- (mapcar
- (lambda (property) (cons property (gethash property hash)))
- ,properties))))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (dolist (value values)
- (if (consp (cdr value))
- (puthash (car value) (cdr value) hash)
- (remhash (car value) hash)))))))
+ `(let* ((key (tramp-file-name-unify ,key ,file))
+ (hash (tramp-get-hash-table key))
+ (values
+ (and (hash-table-p hash)
+ (mapcar
+ (lambda (property) (cons property (gethash property hash)))
+ ,properties))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (dolist (value values)
+ (if (consp (cdr value))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash))))))
;;; -- Properties --
@@ -473,38 +464,36 @@ used to cache connection properties of the local machine."
(defmacro with-tramp-saved-connection-property (key property &rest body)
"Save PROPERTY, run BODY, reset PROPERTY."
(declare (indent 2) (debug t))
- `(progn
- (setf ,key (tramp-file-name-unify ,key))
- (let* ((hash (tramp-get-hash-table ,key))
- (cached (and (hash-table-p hash)
- (gethash ,property hash tramp-cache-undefined))))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTY. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (if (not (eq cached tramp-cache-undefined))
- (puthash ,property cached hash)
- (remhash ,property hash))))))
+ `(let* ((key (tramp-file-name-unify ,key))
+ (hash (tramp-get-hash-table key))
+ (cached (and (hash-table-p hash)
+ (gethash ,property hash tramp-cache-undefined))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (if (not (eq cached tramp-cache-undefined))
+ (puthash ,property cached hash)
+ (remhash ,property hash)))))
;;;###tramp-autoload
(defmacro with-tramp-saved-connection-properties (key properties &rest body)
"Save PROPERTIES, run BODY, reset PROPERTIES.
PROPERTIES is a list of file properties (strings)."
(declare (indent 2) (debug t))
- `(progn
- (setf ,key (tramp-file-name-unify ,key))
- (let* ((hash (tramp-get-hash-table ,key))
- (values
- (mapcar
- (lambda (property)
- (cons property (gethash property hash tramp-cache-undefined)))
- ,properties)))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (dolist (value values)
- (if (not (eq (cdr value) tramp-cache-undefined))
- (puthash (car value) (cdr value) hash)
- (remhash (car value) hash)))))))
+ `(let* ((key (tramp-file-name-unify ,key))
+ (hash (tramp-get-hash-table key))
+ (values
+ (mapcar
+ (lambda (property)
+ (cons property (gethash property hash tramp-cache-undefined)))
+ ,properties)))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (dolist (value values)
+ (if (not (eq (cdr value) tramp-cache-undefined))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash))))))
;;;###tramp-autoload
(defun tramp-cache-print (table)
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 87b20b982f9..98de0dba7ff 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -309,7 +309,7 @@ Also see `ignore'."
;; Macro `connection-local-p' is new in Emacs 30.1.
(if (macrop 'connection-local-p)
- (defalias 'tramp-compat-connection-local-p #'connection-local-p)
+ (defalias 'tramp-compat-connection-local-p 'connection-local-p)
(defmacro tramp-compat-connection-local-p (variable)
"Non-nil if VARIABLE has a connection-local binding in
`default-directory'."
`(let (connection-local-variables-alist file-local-variables-alist)
@@ -337,6 +337,8 @@ Also see `ignore'."
;;
;; * Starting with Emacs 29.1, use `buffer-match-p'.
;;
+;; * Starting with Emacs 29.1, use `string-split'.
+;;
;; * Starting with Emacs 30.1, there is `handler-bind'. Use it
;; instead of `condition-case' when the origin of an error shall be
;; kept, for example when the HANDLER propagates the error with
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el
index 1f578949e4d..30639cbeb85 100644
--- a/lisp/net/tramp-container.el
+++ b/lisp/net/tramp-container.el
@@ -31,15 +31,20 @@
;; Open a file on a running Docker container:
;;
;; C-x C-f /docker:USER@CONTAINER:/path/to/file
+;; C-x C-f /dockercp:USER@CONTAINER:/path/to/file
;;
;; or Podman:
;;
;; C-x C-f /podman:USER@CONTAINER:/path/to/file
+;; C-x C-f /podmancp:USER@CONTAINER:/path/to/file
;;
;; Where:
;; USER is the user on the container to connect as (optional).
;; CONTAINER is the container to connect to.
;;
+;; "docker" and "podman" are inline methods, "dockercp" and "podmancp"
+;; are out-of-band methods.
+;;
;;
;;
;; Open file in a Kubernetes container:
@@ -141,10 +146,20 @@ If it is nil, the default context will be used."
(defconst tramp-docker-method "docker"
"Tramp method name to use to connect to Docker containers.")
+;;;###tramp-autoload
+(defconst tramp-dockercp-method "dockercp"
+ "Tramp method name to use to connect to Docker containers.
+This is for out-of-band connections.")
+
;;;###tramp-autoload
(defconst tramp-podman-method "podman"
"Tramp method name to use to connect to Podman containers.")
+;;;###tramp-autoload
+(defconst tramp-podmancp-method "podmancp"
+ "Tramp method name to use to connect to Podman containers.
+This is for out-of-band connections.")
+
;;;###tramp-autoload
(defconst tramp-kubernetes-method "kubernetes"
"Tramp method name to use to connect to Kubernetes containers.")
@@ -183,7 +198,8 @@ BODY is the backend specific code."
(defun tramp-container--completion-function (method)
"List running containers available for connection.
METHOD is the Tramp method to be used for \"ps\", either
-`tramp-docker-method' or `tramp-podman-method'.
+`tramp-docker-method', `tramp-dockercp-method', `tramp-podman-method',
+or `tramp-podmancp-method'.
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
@@ -375,6 +391,23 @@ see its function help for a description of the format."
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c"))))
+ (add-to-list 'tramp-methods
+ `(,tramp-dockercp-method
+ (tramp-login-program ,tramp-docker-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))
+ (tramp-copy-program ,tramp-docker-program)
+ (tramp-copy-args (("cp")))
+ (tramp-copy-file-name (("%h" ":") ("%f")))
+ (tramp-copy-recursive t)))
+
(add-to-list 'tramp-methods
`(,tramp-podman-method
(tramp-login-program ,tramp-podman-program)
@@ -388,6 +421,23 @@ see its function help for a description of the format."
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c"))))
+ (add-to-list 'tramp-methods
+ `(,tramp-podmancp-method
+ (tramp-login-program ,tramp-podman-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))
+ (tramp-copy-program ,tramp-podman-program)
+ (tramp-copy-args (("cp")))
+ (tramp-copy-file-name (("%h" ":") ("%f")))
+ (tramp-copy-recursive t)))
+
(add-to-list 'tramp-methods
`(,tramp-kubernetes-method
(tramp-login-program ,tramp-kubernetes-program)
@@ -431,10 +481,18 @@ see its function help for a description of the format."
tramp-docker-method
`((tramp-container--completion-function ,tramp-docker-method)))
+ (tramp-set-completion-function
+ tramp-dockercp-method
+ `((tramp-container--completion-function ,tramp-dockercp-method)))
+
(tramp-set-completion-function
tramp-podman-method
`((tramp-container--completion-function ,tramp-podman-method)))
+ (tramp-set-completion-function
+ tramp-podmancp-method
+ `((tramp-container--completion-function ,tramp-podmancp-method)))
+
(tramp-set-completion-function
tramp-kubernetes-method
`((tramp-kubernetes--completion-function ,tramp-kubernetes-method)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 72589e7ce4a..93071ed7350 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -888,7 +888,8 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
"Invoke the GVFS related OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (unless tramp-gvfs-enabled
+ ;; `file-remote-p' must not return an error. (Bug#68976)
+ (unless (or tramp-gvfs-enabled (eq operation 'file-remote-p))
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
(if-let ((filename (apply #'tramp-file-name-for-operation operation args))
(tramp-gvfs-dbus-event-vector
@@ -2293,8 +2294,8 @@ connection if a previous connection has died for some
reason."
;; indicated by the "mounted" signal, i.e. the
;; "fuse-mountpoint" file property.
(with-timeout
- ((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
- tramp-connection-timeout)
+ ((tramp-get-method-parameter
+ vec 'tramp-connection-timeout tramp-connection-timeout)
(if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
(tramp-error
vec 'file-error
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index c0b60f57e40..e1f0b2a3495 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -69,7 +69,7 @@ special handling of `substitute-in-file-name'."
(when minibuffer-completing-file-name
(setq tramp-rfn-eshadow-overlay
(make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
- ;; Copy rfn-eshadow-overlay properties.
+ ;; Copy `rfn-eshadow-overlay' properties.
(let ((props (overlay-properties rfn-eshadow-overlay)))
(while props
;; The `field' property prevents correct minibuffer
diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el
index 96071e626a5..97e94a51e7a 100644
--- a/lisp/net/tramp-message.el
+++ b/lisp/net/tramp-message.el
@@ -353,6 +353,7 @@ applicable)."
If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE
forces the backtrace even if `tramp-verbose' is less than 10.
This function is meant for debugging purposes."
+ (declare (tramp-suppress-trace t))
(let ((tramp-verbose (if force 10 tramp-verbose)))
(when (>= tramp-verbose 10)
(tramp-message
@@ -364,6 +365,7 @@ VEC-OR-PROC identifies the connection to use, SIGNAL is the
signal identifier to be raised, remaining arguments passed to
`tramp-message'. Finally, signal SIGNAL is raised with
FMT-STRING and ARGUMENTS."
+ (declare (tramp-suppress-trace t))
(let (signal-hook-function)
(tramp-backtrace vec-or-proc)
(unless arguments
@@ -391,6 +393,7 @@ tramp-tests.el.")
"Emit an error, and show BUF.
If BUF is nil, show the connection buf. Wait for 30\", or until
an input event arrives. The other arguments are passed to `tramp-error'."
+ (declare (tramp-suppress-trace t))
(save-window-excursion
(let* ((buf (or (and (bufferp buf) buf)
(and (processp vec-or-proc) (process-buffer vec-or-proc))
@@ -424,6 +427,7 @@ an input event arrives. The other arguments are passed to
`tramp-error'."
(defsubst tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a user error (or \"pilot error\")."
+ (declare (tramp-suppress-trace t))
(unwind-protect
(apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
;; Save exit.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6bb1d976ec5..66e648624b2 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -38,7 +38,6 @@
(declare-function dired-compress-file "dired-aux")
(declare-function dired-remove-file "dired-aux")
(defvar dired-compress-file-suffixes)
-(defvar ls-lisp-use-insert-directory-program)
;; Added in Emacs 28.1.
(defvar process-file-return-signal-string)
(defvar vc-handled-backends)
@@ -283,6 +282,7 @@ The string is used in `tramp-methods'.")
(tramp-copy-program "nc")
;; We use "-v" for better error tracking.
(tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r")))
+ (tramp-copy-file-name (("%f")))
(tramp-remote-copy-program "nc")
;; We use "-p" as required for newer busyboxes. For older
;; busybox/nc versions, the value must be (("-l") ("%r")).
This
@@ -429,6 +429,9 @@ The string is used in `tramp-methods'.")
eos)
nil ,(user-login-name))))
+(defconst tramp-default-copy-file-name '(("%u" "@") ("%h" ":") ("%f"))
+ "Default `tramp-copy-file-name' entry for out-of-band methods.")
+
;;;###tramp-autoload
(defconst tramp-completion-function-alist-rsh
'((tramp-parse-rhosts "/etc/hosts.equiv")
@@ -548,6 +551,7 @@ shell from reading its init file."
(tramp-terminal-prompt-regexp tramp-action-terminal)
(tramp-antispoof-regexp tramp-action-confirm-message)
(tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
+ (tramp-security-key-pin-regexp tramp-action-otp-password)
(tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
@@ -567,6 +571,7 @@ corresponding PATTERN matches, the ACTION function is
called.")
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-copy-failed-regexp tramp-action-permission-denied)
(tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
+ (tramp-security-key-pin-regexp tramp-action-otp-password)
(tramp-process-alive-regexp tramp-action-out-of-band))
"List of pattern/action pairs.
This list is used for copying/renaming with out-of-band methods.
@@ -2010,7 +2015,7 @@ ID-FORMAT valid values are `string' and `integer'."
#'copy-directory
(list dirname newname keep-date parents copy-contents))))
- ;; When newname did exist, we have wrong cached values.
+ ;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name (expand-file-name newname) nil
(tramp-flush-file-properties v localname)))))))
@@ -2149,24 +2154,24 @@ file names."
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
- ;; Handle `preserve-extended-attributes'. We ignore
- ;; possible errors, because ACL strings could be
- ;; incompatible.
- (when-let ((attributes (and preserve-extended-attributes
- (file-extended-attributes filename))))
- (ignore-errors
- (set-file-extended-attributes newname attributes)))
-
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
- ;; When newname did exist, we have wrong cached values.
+ ;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname)))
+ ;; Handle `preserve-extended-attributes'. We ignore
+ ;; possible errors, because ACL strings could be
+ ;; incompatible.
+ (when-let ((attributes (and preserve-extended-attributes
+ (file-extended-attributes filename))))
+ (ignore-errors
+ (set-file-extended-attributes newname attributes)))
+
;; KEEP-DATE handling.
(when (and keep-date (not copy-keep-date))
(tramp-compat-set-file-times
@@ -2398,10 +2403,10 @@ The method used must be an out-of-band method."
#'file-name-as-directory
#'identity)
(if v1
- (tramp-make-copy-program-file-name v1)
+ (tramp-make-copy-file-name v1)
(file-name-unquote filename)))
target (if v2
- (tramp-make-copy-program-file-name v2)
+ (tramp-make-copy-file-name v2)
(file-name-unquote newname)))
;; Check for listener port.
@@ -2438,9 +2443,9 @@ The method used must be an out-of-band method."
copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-args
;; " " has either been a replacement of "%k" (when
- ;; keep-date argument is non-nil), or a replacement for
+ ;; KEEP-DATE argument is non-nil), or a replacement for
;; the whole keep-date sublist.
- (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
+ (delete " " (apply #'tramp-expand-args v 'tramp-copy-args nil spec))
;; `tramp-ssh-controlmaster-options' is a string instead
;; of a list. Unflatten it.
copy-args
@@ -2449,11 +2454,11 @@ The method used must be an out-of-band method."
(lambda (x) (if (tramp-compat-string-search " " x)
(split-string x) x))
copy-args))
- copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
+ copy-env (apply #'tramp-expand-args v 'tramp-copy-env nil spec)
remote-copy-program
(tramp-get-method-parameter v 'tramp-remote-copy-program)
remote-copy-args
- (apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
+ (apply #'tramp-expand-args v 'tramp-remote-copy-args nil spec))
;; Check for local copy program.
(unless (executable-find copy-program)
@@ -2636,7 +2641,7 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
- (if (and (featurep 'ls-lisp)
+ (if (and (boundp 'ls-lisp-use-insert-directory-program)
(not ls-lisp-use-insert-directory-program))
(tramp-handle-insert-directory
filename switches wildcard full-directory-p)
@@ -5289,7 +5294,8 @@ connection if a previous connection has died for some
reason."
(tramp-get-method-parameter hop
'tramp-async-args)))
(connection-timeout
(tramp-get-method-parameter
- hop 'tramp-connection-timeout))
+ hop 'tramp-connection-timeout
+ tramp-connection-timeout))
(command
(tramp-get-method-parameter
hop 'tramp-login-program))
@@ -5347,14 +5353,14 @@ connection if a previous connection has died for some
reason."
;; Add arguments for asynchronous processes.
(when process-name async-args)
(tramp-expand-args
- hop 'tramp-login-args
+ hop 'tramp-login-args nil
?h (or l-host "") ?u (or l-user "") ?p (or l-port "")
?c (format-spec options (format-spec-make ?t tmpfile))
?n (concat
"2>" (tramp-get-remote-null-device previous-hop))
?l (concat remote-shell " " extra-args " -i"))
;; A restricted shell does not allow "exec".
- (when r-shell '("&&" "exit")) '("||" "exit"))
+ (when r-shell '("&&" "exit")) '("||" "exit"))
" "))
;; Send the command.
@@ -5364,8 +5370,7 @@ connection if a previous connection has died for some
reason."
p vec
(min
pos (with-current-buffer (process-buffer p)
(point-max)))
- tramp-actions-before-shell
- (or connection-timeout tramp-connection-timeout))
+ tramp-actions-before-shell connection-timeout)
(tramp-message
vec 3 "Found remote shell prompt on `%s'" l-host)
@@ -5558,8 +5563,8 @@ raises an error."
string
""))
-(defun tramp-make-copy-program-file-name (vec)
- "Create a file name suitable for `scp', `pscp', or `nc' and workalikes."
+(defun tramp-make-copy-file-name (vec)
+ "Create a file name suitable for out-of-band methods."
(let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
(host (tramp-file-name-host vec))
@@ -5570,13 +5575,13 @@ raises an error."
;; This does not work for MS Windows scp, if there are characters
;; to be quoted. OpenSSH 8 supports disabling of strict file name
;; checking in scp, we use it when available.
- (unless (string-match-p (rx "ftp" eos) method)
+ (unless (string-match-p (rx (| "dockercp" "podmancp" "ftp") eos) method)
(setq localname (tramp-unquote-shell-quote-argument localname)))
- (cond
- ((tramp-get-method-parameter vec 'tramp-remote-copy-program)
- localname)
- ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname))
- (t (format "%s@%s:%s" user host localname)))))
+ (string-join
+ (apply #'tramp-expand-args vec
+ 'tramp-copy-file-name tramp-default-copy-file-name
+ (list ?h (or host "") ?u (or user "") ?f localname))
+ "")))
(defun tramp-method-out-of-band-p (vec size)
"Return t if this is an out-of-band method, nil otherwise."
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 8dad599c7e7..d0d56b8967e 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -322,7 +322,7 @@ arguments to pass to the OPERATION."
v (tramp-get-method-parameter v 'tramp-login-program)
nil outbuf display
(tramp-expand-args
- v 'tramp-login-args
+ v 'tramp-login-args nil
?h (or (tramp-file-name-host v) "")
?u (or (tramp-file-name-user v) "")
?p (or (tramp-file-name-port v) "")
@@ -424,7 +424,7 @@ connection if a previous connection has died for some
reason."
(tramp-fuse-mount-spec vec)
(tramp-fuse-mount-point vec)
(tramp-expand-args
- vec 'tramp-mount-args
+ vec 'tramp-mount-args nil
?p (or (tramp-file-name-port vec) ""))))))
(tramp-error
vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec)))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 0c717c4a5aa..7bbfec62753 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -771,7 +771,7 @@ in case of error, t otherwise."
(tramp-get-connection-name vec) (current-buffer)
(append
(tramp-expand-args
- vec 'tramp-sudo-login
+ vec 'tramp-sudo-login nil
?h (or (tramp-file-name-host vec) "")
?u (or (tramp-file-name-user vec) ""))
(flatten-tree args))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 74d95757e46..5b101000926 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -67,11 +67,6 @@
(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
-(defvar ls-lisp-dirs-first)
-(defvar ls-lisp-emulation)
-(defvar ls-lisp-ignore-case)
-(defvar ls-lisp-use-insert-directory-program)
-(defvar ls-lisp-verbosity)
(defvar tramp-prefix-format)
(defvar tramp-prefix-regexp)
(defvar tramp-method-regexp)
@@ -306,6 +301,15 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
This specifies the list of parameters to pass to the above mentioned
program, the hints for `tramp-login-args' also apply here.
+ * `tramp-copy-file-name'
+ The remote source or destination file name for out-of-band methods.
+ You can use \"%u\" and \"%h\" like in `tramp-login-args'.
+ Additionally, \"%f\" denotes the local file name part. This list
+ will be expanded to a string without spaces between the elements of
+ the list.
+
+ The default value is `tramp-default-copy-file-name'.
+
* `tramp-copy-env'
A list of environment variables and their values, which will
be set when calling `tramp-copy-program'.
@@ -320,8 +324,8 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
chosen port for the remote listener.
* `tramp-copy-keep-date'
- This specifies whether the copying program when the preserves the
- timestamp of the original file.
+ This specifies whether the copying program preserves the timestamp
+ of the original file.
* `tramp-copy-keep-tmpfile'
This specifies whether a temporary local file shall be kept
@@ -562,7 +566,7 @@ host runs a restricted shell, it shall be added to this
list, too."
eos)
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
- :version "30.1"
+ :version "29.3"
:type '(choice (const :tag "Chrooted environment" nil)
(regexp :tag "Host regexp")))
@@ -750,9 +754,8 @@ The regexp should match at end of buffer."
;; A security key requires the user physically to touch the device
;; with their finger. We must tell it to the user.
-;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey and
-;; Titankey, which have also passed the tests, do not show such a
-;; message.
+;; Added in OpenSSH 8.2. I've tested it with Nitrokey, Titankey, and
+;; Yubikey.
(defcustom tramp-security-key-confirm-regexp
(rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n")))
"Regular expression matching security key confirmation message.
@@ -775,6 +778,14 @@ The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
+;; Needed only for FIDO2 (residential) keys. Tested with Nitrokey and Yubikey.
+(defcustom tramp-security-key-pin-regexp
+ (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n")))
+ "Regular expression matching security key PIN prompt.
+The regexp should match at end of buffer."
+ :version "29.3"
+ :type 'regexp)
+
(defcustom tramp-operation-not-permitted-regexp
(rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank)
"Operation not permitted")
@@ -1543,21 +1554,23 @@ LOCALNAME and HOP do not count."
(equal (tramp-file-name-unify vec1)
(tramp-file-name-unify vec2))))
-(defun tramp-get-method-parameter (vec param)
+(defun tramp-get-method-parameter (vec param &optional default)
"Return the method parameter PARAM.
If VEC is a vector, check first in connection properties.
Afterwards, check in `tramp-methods'. If the `tramp-methods'
-entry does not exist, return nil."
+entry does not exist, return DEFAULT."
(let ((hash-entry
(replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param))))
(if (tramp-connection-property-p vec hash-entry)
;; We use the cached property.
(tramp-get-connection-property vec hash-entry)
;; Use the static value from `tramp-methods'.
- (when-let ((methods-entry
+ (if-let ((methods-entry
(assoc
param (assoc (tramp-file-name-method vec) tramp-methods))))
- (cadr methods-entry)))))
+ (cadr methods-entry)
+ ;; Return the default value.
+ default))))
;; The localname can be quoted with "/:". Extract this.
(defun tramp-file-name-unquote-localname (vec)
@@ -3941,6 +3954,9 @@ Let-bind it when necessary.")
(tramp-get-method-parameter v 'tramp-case-insensitive)
;; There isn't. So we must check, in case there's a connection already.
+ ;; Note: We cannot use it as DEFAULT value of
+ ;; `tramp-get-method-parameter', because it would be evalled
+ ;; during the call.
(and (let ((non-essential t)) (tramp-connectable-p v))
(with-tramp-connection-property v "case-insensitive"
(ignore-errors
@@ -4189,6 +4205,11 @@ Let-bind it when necessary.")
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(require 'ls-lisp)
+ (defvar ls-lisp-dirs-first)
+ (defvar ls-lisp-emulation)
+ (defvar ls-lisp-ignore-case)
+ (defvar ls-lisp-use-insert-directory-program)
+ (defvar ls-lisp-verbosity)
(unless switches (setq switches ""))
;; Mark trailing "/".
(when (and (directory-name-p filename)
@@ -4745,15 +4766,15 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(defvar tramp-extra-expand-args nil
"Method specific arguments.")
-(defun tramp-expand-args (vec parameter &rest spec-list)
+(defun tramp-expand-args (vec parameter default &rest spec-list)
"Expand login arguments as given by PARAMETER in `tramp-methods'.
PARAMETER is a symbol like `tramp-login-args', denoting a list of
list of strings from `tramp-methods', containing %-sequences for
-substitution.
+substitution. DEFAULT is used when PARAMETER is not specified.
SPEC-LIST is a list of char/value pairs used for
`format-spec-make'. It is appended by `tramp-extra-expand-args',
a connection-local variable."
- (let ((args (tramp-get-method-parameter vec parameter))
+ (let ((args (tramp-get-method-parameter vec parameter default))
(extra-spec-list
(mapcar
#'eval
@@ -4932,7 +4953,7 @@ a connection-local variable."
(mapcar
(lambda (x) (split-string x " "))
(tramp-expand-args
- v 'tramp-login-args
+ v 'tramp-login-args nil
?h (or host "") ?u (or user "") ?p (or port "")
?c (format-spec (or options "") (format-spec-make ?t tmpfile))
?d (or device "") ?a (or pta "") ?l ""))))
@@ -5435,7 +5456,7 @@ of."
prompt)
(goto-char (point-min))
(tramp-check-for-regexp proc tramp-process-action-regexp)
- (setq prompt (concat (match-string 1) " "))
+ (setq prompt (concat (string-trim (match-string 1)) " "))
(tramp-message vec 3 "Sending %s" (match-string 1))
;; We don't call `tramp-send-string' in order to hide the
;; password from the debug buffer and the traces.
@@ -5511,14 +5532,16 @@ Wait, until the connection buffer changes."
(ignore set-message-function clear-message-function)
(tramp-message vec 6 "\n%s" (buffer-string))
(tramp-check-for-regexp proc tramp-process-action-regexp)
- (with-temp-message
- (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0))
+ (with-temp-message (concat (string-trim (match-string 0)) " ")
;; Hide message in buffer.
(narrow-to-region (point-max) (point-max))
;; Wait for new output.
(while (not (ignore-error file-error
(tramp-wait-for-regexp
- proc 0.1 tramp-security-key-confirmed-regexp)))
+ proc 0.1
+ (rx (| (regexp tramp-security-key-confirmed-regexp)
+ (regexp tramp-security-key-pin-regexp)
+ (regexp tramp-security-key-timeout-regexp))))))
(when (tramp-check-for-regexp proc
tramp-security-key-timeout-regexp)
(throw 'tramp-action 'timeout))
(redisplay 'force))))))
@@ -6317,9 +6340,8 @@ This handles also chrooted environments, which are not
regarded as local."
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
(with-tramp-connection-property (tramp-get-process vec) "remote-tmpdir"
- (let ((dir
- (tramp-make-tramp-file-name
- vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
+ (let ((dir (tramp-make-tramp-file-name
+ vec (tramp-get-method-parameter vec 'tramp-tmpdir "/tmp"))))
(or (and (file-directory-p dir) (file-writable-p dir)
(tramp-file-local-name dir))
(tramp-error vec 'file-error "Directory %s not accessible" dir))
@@ -6564,12 +6586,13 @@ Consults the auth-source package."
(tramp-get-connection-property key "login-as")))
(host (tramp-file-name-host-port vec))
(pw-prompt
- (or prompt
- (with-current-buffer (process-buffer proc)
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
- (if (string-match-p "passphrase" (match-string 1))
- (match-string 0)
- (format "%s for %s " (capitalize (match-string 1)) key)))))
+ (string-trim-left
+ (or prompt
+ (with-current-buffer (process-buffer proc)
+ (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (if (string-match-p "passphrase" (match-string 1))
+ (match-string 0)
+ (format "%s for %s " (capitalize (match-string 1)) key))))))
(auth-source-creation-prompts `((secret . ,pw-prompt)))
;; Use connection-local value.
(auth-sources (buffer-local-value 'auth-sources (process-buffer proc)))
diff --git a/lisp/obarray.el b/lisp/obarray.el
index a26992df8e2..5e646db9ab7 100644
--- a/lisp/obarray.el
+++ b/lisp/obarray.el
@@ -27,24 +27,13 @@
;;; Code:
-(defconst obarray-default-size 59
- "The value 59 is an arbitrary prime number that gives a good hash.")
+(defconst obarray-default-size 4)
+(make-obsolete-variable 'obarray-default-size
+ "obarrays now grow automatically." "30.1")
-(defun obarray-make (&optional size)
- "Return a new obarray of size SIZE or `obarray-default-size'."
- (let ((size (or size obarray-default-size)))
- (if (< 0 size)
- (make-vector size 0)
- (signal 'wrong-type-argument '(size 0)))))
-
-(defun obarray-size (ob)
- "Return the number of slots of obarray OB."
- (length ob))
-
-(defun obarrayp (object)
- "Return t if OBJECT is an obarray."
- (and (vectorp object)
- (< 0 (length object))))
+(defun obarray-size (_ob)
+ (declare (obsolete "obarrays now grow automatically." "30.1"))
+ obarray-default-size)
;; Don’t use obarray as a variable name to avoid shadowing.
(defun obarray-get (ob name)
@@ -54,7 +43,7 @@ Return nil otherwise."
(defun obarray-put (ob name)
"Return symbol named NAME from obarray OB.
-Creates and adds the symbol if doesn't exist."
+Creates and adds the symbol if it doesn't exist."
(intern name ob))
(defun obarray-remove (ob name)
diff --git a/lisp/obsolete/eieio-compat.el b/lisp/obsolete/eieio-compat.el
index 26648a4d7bb..8fdcebbd1c4 100644
--- a/lisp/obsolete/eieio-compat.el
+++ b/lisp/obsolete/eieio-compat.el
@@ -150,10 +150,9 @@ Summary:
(lambda (tag &rest _)
(and (symbolp tag) (setq tag (cl--find-class tag))
(eieio--class-p tag)
- (let ((superclasses (eieio--class-precedence-list tag))
+ (let ((superclasses (cl--class-allparents tag))
(specializers ()))
(dolist (superclass superclasses)
- (setq superclass (eieio--class-name superclass))
(push superclass specializers)
(push `(eieio--static ,superclass) specializers))
(nreverse specializers)))))
@@ -240,7 +239,7 @@ Summary:
(declare (obsolete cl-no-applicable-method "25.1"))
(apply #'cl-no-applicable-method method object args))
-(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1")
+(define-obsolete-function-alias 'call-next-method #'cl-call-next-method "25.1")
(defun next-method-p ()
(declare (obsolete cl-next-method-p "25.1"))
;; EIEIO's `next-method-p' just returned nil when called in an
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 3f05b7fe7ac..e1ea9141f0d 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -370,7 +370,7 @@ See documentation of `walk-windows' for useful values."
This hook is run during minibuffer setup if `iswitchb' is active.
For instance:
\(add-hook \\='iswitchb-minibuffer-setup-hook
- \\='\(lambda () (set (make-local-variable \\='max-mini-window-height)
3)))
+ \\='\(lambda () (setq-local max-mini-window-height 3)))
will constrain the minibuffer to a maximum height of 3 lines when
iswitchb is running."
:type 'hook)
@@ -1262,7 +1262,7 @@ Modified from `icomplete-completions'."
"Set up minibuffer for `iswitchb-buffer'.
Copied from `icomplete-minibuffer-setup-hook'."
(when (iswitchb-entryfn-p)
- (set (make-local-variable 'iswitchb-use-mycompletion) t)
+ (setq-local iswitchb-use-mycompletion t)
(add-hook 'pre-command-hook #'iswitchb-pre-command nil t)
(add-hook 'post-command-hook #'iswitchb-post-command nil t)
(run-hooks 'iswitchb-minibuffer-setup-hook)))
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index 6aa388805f2..f065bcaff26 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -116,17 +116,14 @@ newlines are indicated with a symbol."
;; Turn on longlines mode
(progn
(use-hard-newlines 1 'never)
- (set (make-local-variable 'require-final-newline) nil)
+ (setq-local require-final-newline nil)
(add-to-list 'buffer-file-format 'longlines)
(add-hook 'change-major-mode-hook #'longlines-mode-off nil t)
(add-hook 'before-revert-hook #'longlines-before-revert-hook nil t)
(make-local-variable 'longlines-auto-wrap)
- (set (make-local-variable 'isearch-search-fun-function)
- #'longlines-search-function)
- (set (make-local-variable 'replace-search-function)
- #'longlines-search-forward)
- (set (make-local-variable 'replace-re-search-function)
- #'longlines-re-search-forward)
+ (setq-local isearch-search-fun-function #'longlines-search-function)
+ (setq-local replace-search-function #'longlines-search-forward)
+ (setq-local replace-re-search-function #'longlines-re-search-forward)
(add-function :filter-return (local 'filter-buffer-substring-function)
#'longlines-encode-string)
(when longlines-wrap-follows-window-size
@@ -136,8 +133,7 @@ newlines are indicated with a symbol."
(window-width)))
longlines-wrap-follows-window-size
2)))
- (set (make-local-variable 'fill-column)
- (- (window-width) dw)))
+ (setq-local fill-column (- (window-width) dw)))
(add-hook 'window-configuration-change-hook
#'longlines-window-change-function nil t))
(let ((buffer-undo-list t)
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el
index 6c00ad201f1..4c7b653155e 100644
--- a/lisp/obsolete/pgg.el
+++ b/lisp/obsolete/pgg.el
@@ -85,9 +85,9 @@ is true, or else the output buffer is displayed."
(set-buffer standard-output)
(insert-buffer-substring pgg-errors-buffer))))
-(defvar pgg-passphrase-cache (make-vector 7 0))
+(defvar pgg-passphrase-cache (obarray-make 7))
-(defvar pgg-pending-timers (make-vector 7 0)
+(defvar pgg-pending-timers (obarray-make 7)
"Hash table for managing scheduled pgg cache management timers.
We associate key and timer, so the timer can be canceled if a new
diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el
index e0826475e32..258b2b519d9 100644
--- a/lisp/obsolete/rcompile.el
+++ b/lisp/obsolete/rcompile.el
@@ -169,12 +169,12 @@ See \\[compile]."
;; compilation-parse-errors will find referenced files by Tramp.
(with-current-buffer next-error-last-buffer
(when (fboundp 'tramp-make-tramp-file-name)
- (set (make-local-variable 'comint-file-name-prefix)
- (funcall
- #'tramp-make-tramp-file-name
- nil ;; method.
- remote-compile-user
- remote-compile-host
- ""))))))
+ (setq-local comint-file-name-prefix
+ (funcall
+ #'tramp-make-tramp-file-name
+ nil ;; method.
+ remote-compile-user
+ remote-compile-host
+ ""))))))
;;; rcompile.el ends here
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 2332c0c927c..aafbdf0e0aa 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -982,7 +982,7 @@ Otherwise, return nil."
"Splits STRING into substrings at SEPARATORS.
SEPARATORS is a regular expression. When nil, it defaults to
-\"[ \f\t\n\r\v]+\".
+\"[ \\f\\t\\n\\r\\v]+\".
Unlike `split-string', matching SEPARATORS at the beginning and
end of string are ignored."
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 2c5de69a36c..d361408eaca 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -4685,7 +4685,7 @@ returns non-nil if any of them match."
(if (and (= char ?f) current-file)
(concat "file://" current-file) uri))
"\\'")))))
- (prog1 (memq char '(?y ?n ?! ?d ?\s ?f))
+ (prog1 (memq char '(?y ?! ?d ?\s ?f))
(quit-window t)))))))
(defun org-extract-log-state-settings (x)
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
index 3d4d998432d..d3a90179d73 100644
--- a/lisp/org/ox-beamer.el
+++ b/lisp/org/ox-beamer.el
@@ -1008,7 +1008,10 @@ will be displayed when
`org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
(org-export-to-buffer 'beamer "*Org BEAMER Export*"
- async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+ async subtreep visible-only body-only ext-plist
+ (if (fboundp 'major-mode-remap)
+ (major-mode-remap 'latex-mode)
+ #'LaTeX-mode)))
;;;###autoload
(defun org-beamer-export-to-latex
diff --git a/lisp/org/ox-koma-letter.el b/lisp/org/ox-koma-letter.el
index aef25232c20..38460d1749e 100644
--- a/lisp/org/ox-koma-letter.el
+++ b/lisp/org/ox-koma-letter.el
@@ -911,7 +911,9 @@ non-nil."
(let (org-koma-letter-special-contents)
(org-export-to-buffer 'koma-letter "*Org KOMA-LETTER Export*"
async subtreep visible-only body-only ext-plist
- (lambda () (LaTeX-mode)))))
+ (if (fboundp 'major-mode-remap)
+ (major-mode-remap 'latex-mode)
+ #'LaTeX-mode))))
;;;###autoload
(defun org-koma-letter-export-to-latex
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
index b409f552a2b..98b388081ea 100644
--- a/lisp/org/ox-latex.el
+++ b/lisp/org/ox-latex.el
@@ -1632,7 +1632,7 @@ explicitly been loaded. Then it is added to the rest of
package's options.
The optional argument to Babel or the mandatory argument to
-`\babelprovide' command may be \"AUTO\" which is then replaced
+`\\babelprovide' command may be \"AUTO\" which is then replaced
with the language of the document or
`org-export-default-language' unless language in question is
already loaded.
@@ -4160,7 +4160,10 @@ will be displayed when
`org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
(org-export-to-buffer 'latex "*Org LATEX Export*"
- async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+ async subtreep visible-only body-only ext-plist
+ (if (fboundp 'major-mode-remap)
+ (major-mode-remap 'latex-mode)
+ #'LaTeX-mode)))
;;;###autoload
(defun org-latex-convert-region-to-latex ()
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 19bf559c9e7..bf2d9b569af 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -6608,7 +6608,7 @@ use it to set a major mode there, e.g.,
(interactive)
(org-export-to-buffer \\='latex \"*Org LATEX Export*\"
async subtreep visible-only body-only ext-plist
- #\\='LaTeX-mode))
+ (major-mode-remap \\='latex-mode)))
When expressed as an anonymous function, using `lambda',
POST-PROCESS needs to be quoted.
diff --git a/lisp/outline.el b/lisp/outline.el
index b50708c1a7b..40a75701cbf 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -318,8 +318,8 @@ Using the value `insert' is not recommended in editable
buffers because it modifies them.
When the value is `in-margins', then clickable buttons are
displayed in the margins before the headings.
-When the value is `t', clickable buttons are displayed
-in the buffer before the headings. The values `t' and
+When the value is t, clickable buttons are displayed
+in the buffer before the headings. The values t and
`in-margins' can be used in editing buffers because they
don't modify the buffer."
;; The value `insert' is not intended to be customizable.
@@ -686,7 +686,7 @@ If POS is nil, use `point' instead."
(defun outline-back-to-heading (&optional invisible-ok)
"Move to previous heading line, or beg of this line if it's a heading.
Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
- (beginning-of-line)
+ (forward-line 0)
(or (outline-on-heading-p invisible-ok)
(let (found)
(save-excursion
@@ -705,7 +705,7 @@ Only visible heading lines are considered, unless
INVISIBLE-OK is non-nil."
"Return t if point is on a (visible) heading line.
If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(and (bolp) (or invisible-ok (not (outline-invisible-p)))
(if outline-search-function
(funcall outline-search-function nil nil nil t)
@@ -725,7 +725,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok
too."
(not (string-match (concat "\\`\\(?:" outline-regexp "\\)")
(concat head " "))))
(setq head (concat head " ")))
- (unless (bolp) (end-of-line) (newline))
+ (unless (bolp) (goto-char (pos-eol)) (newline))
(insert head)
(unless (eolp)
(save-excursion (newline-and-indent)))
@@ -941,9 +941,7 @@ With ARG, repeats or can move backward if negative.
A heading line is one that starts with a `*' (or that
`outline-regexp' matches)."
(interactive "p")
- (if (< arg 0)
- (beginning-of-line)
- (end-of-line))
+ (goto-char (if (< arg 0) (pos-bol) (pos-eol)))
(let ((regexp (unless outline-search-function
(concat "^\\(?:" outline-regexp "\\)")))
found-heading-p)
@@ -963,7 +961,7 @@ A heading line is one that starts with a `*' (or that
(re-search-forward regexp nil 'move)))
(outline-invisible-p (match-beginning 0))))
(setq arg (1- arg)))
- (if found-heading-p (beginning-of-line))))
+ (if found-heading-p (forward-line 0))))
(defun outline-previous-visible-heading (arg)
"Move to the previous heading line.
@@ -980,7 +978,7 @@ This puts point at the start of the current subtree, and
mark at the end."
(let ((beg))
(if (outline-on-heading-p)
;; we are already looking at a heading
- (beginning-of-line)
+ (forward-line 0)
;; else go back to previous heading
(outline-previous-visible-heading 1))
(setq beg (point))
@@ -1183,7 +1181,7 @@ of the current heading, or to 1 if the current line is
not a heading."
(cond
(current-prefix-arg (prefix-numeric-value current-prefix-arg))
((save-excursion
- (beginning-of-line)
+ (forward-line 0)
(if outline-search-function
(funcall outline-search-function nil nil nil t)
(looking-at outline-regexp)))
@@ -1243,7 +1241,7 @@ This also unhides the top heading-less body, if any."
(interactive)
(save-excursion
(outline-back-to-heading)
- (if (not (outline-invisible-p (line-end-position)))
+ (if (not (outline-invisible-p (pos-eol)))
(outline-hide-subtree)
(outline-show-children)
(outline-show-entry))))
@@ -1834,7 +1832,7 @@ With a prefix argument, show headings up to that LEVEL."
(defun outline--insert-button (type)
(with-silent-modifications
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(let ((icon (nth (if (eq type 'close) 1 0) outline--button-icons))
(o (seq-find (lambda (o) (overlay-get o 'outline-button))
(overlays-at (point)))))
@@ -1842,7 +1840,7 @@ With a prefix argument, show headings up to that LEVEL."
(when (eq outline-minor-mode-use-buttons 'insert)
(let ((inhibit-read-only t))
(insert (apply #'propertize " " (text-properties-at (point))))
- (beginning-of-line)))
+ (forward-line 0)))
(setq o (make-overlay (point) (1+ (point))))
(overlay-put o 'outline-button t)
(overlay-put o 'evaporate t))
@@ -1866,7 +1864,7 @@ With a prefix argument, show headings up to that LEVEL."
(when from
(save-excursion
(goto-char from)
- (setq from (line-beginning-position))))
+ (setq from (pos-bol))))
(outline-map-region
(lambda ()
(let ((close-p (save-excursion
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index c8e9d097a5f..c4697a0d3b9 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -65,7 +65,7 @@
(defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0"
"Delimiter used to separate cookie file entries.")
-(defvar cookie-cache (make-vector 511 0)
+(defvar cookie-cache (obarray-make 511)
"Cache of cookie files that have already been snarfed.")
(defun cookie-check-file (file)
diff --git a/lisp/proced.el b/lisp/proced.el
index 3435f1ab8cd..7d7de1e2ce3 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -2261,7 +2261,7 @@ If LOG is a string and there are more args, it is
formatted with
those ARGS. Usually the LOG string ends with a \\n.
End each bunch of errors with (proced-log t signal):
this inserts the current time, buffer and signal at the start of the page,
-and \f (formfeed) at the end."
+and \\f (formfeed) at the end."
(let ((obuf (current-buffer)))
(with-current-buffer (get-buffer-create proced-log-buffer)
(goto-char (point-max))
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index e5835bdb62d..a2e7f6fba2e 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -922,6 +922,17 @@ Return nil if NODE is not a defun node or doesn't have a
name."
name)))
t))
+;;; Outline minor mode
+
+(defun c-ts-mode--outline-predicate (node)
+ "Match outlines on lines with function names."
+ (or (and (equal (treesit-node-type node) "function_declarator")
+ (equal (treesit-node-type (treesit-node-parent node))
+ "function_definition"))
+ ;; DEFUNs in Emacs sources.
+ (and c-ts-mode-emacs-sources-support
+ (c-ts-mode--emacs-defun-p node))))
+
;;; Defun navigation
(defun c-ts-mode--defun-valid-p (node)
@@ -1179,7 +1190,6 @@ BEG and END are described in `treesit-range-rules'."
"C-c C-c" #'comment-region
"C-c C-k" #'c-ts-mode-toggle-comment-style)
-;;;###autoload
(define-derived-mode c-ts-base-mode prog-mode "C"
"Major mode for editing C, powered by tree-sitter.
@@ -1259,6 +1269,10 @@ BEG and END are described in `treesit-range-rules'."
eos)
c-ts-mode--defun-for-class-in-imenu-p nil))))
+ ;; Outline minor mode
+ (setq-local treesit-outline-predicate
+ #'c-ts-mode--outline-predicate)
+
(setq-local treesit-font-lock-feature-list
c-ts-mode--feature-list))
@@ -1314,6 +1328,8 @@ in your configuration."
(lambda (_pos) 'c))
(treesit-font-lock-recompute-features '(emacs-devel)))))
+(derived-mode-add-parents 'c-ts-mode '(c-mode))
+
;;;###autoload
(define-derived-mode c++-ts-mode c-ts-base-mode "C++"
"Major mode for editing C++, powered by tree-sitter.
@@ -1357,6 +1373,8 @@ recommended to enable `electric-pair-mode' with this
mode."
(setq-local add-log-current-defun-function
#'c-ts-mode--emacs-current-defun-name))))
+(derived-mode-add-parents 'c++-ts-mode '(c++-mode))
+
(easy-menu-define c-ts-mode-menu (list c-ts-mode-map c++-ts-mode-map)
"Menu for `c-ts-mode' and `c++-ts-mode'."
'("C/C++"
@@ -1424,36 +1442,33 @@ should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-ts-mode' or `c++-ts-mode'."
+ (declare (obsolete c-or-c++-mode "30.1"))
(interactive)
- (if (save-excursion
- (save-restriction
- (save-match-data ; Why `save-match-data'?
- (widen)
- (goto-char (point-min))
- (re-search-forward c-ts-mode--c-or-c++-regexp nil t))))
- (c++-ts-mode)
- (c-ts-mode)))
+ (let ((mode
+ (if (save-excursion
+ (save-restriction
+ (save-match-data ; Why `save-match-data'?
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward c-ts-mode--c-or-c++-regexp nil t))))
+ 'c++-ts-mode
+ 'c-ts-mode)))
+ (funcall (major-mode-remap mode))))
+
;; The entries for C++ must come first to prevent *.c files be taken
;; as C++ on case-insensitive filesystems, since *.C files are C++,
;; not C.
(if (treesit-ready-p 'cpp)
- (add-to-list 'auto-mode-alist
-
'("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'"
- . c++-ts-mode)))
+ (add-to-list 'major-mode-remap-defaults
+ '(c++-mode . c++-ts-mode)))
(when (treesit-ready-p 'c)
- (add-to-list 'auto-mode-alist
- '("\\(\\.[chi]\\|\\.lex\\|\\.y\\(acc\\)?\\)\\'" . c-ts-mode))
- (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . c-ts-mode))
- ;; image-mode's association must be before the C mode, otherwise XPM
- ;; images will be initially visited as C files. Also note that the
- ;; regexp must be different from what files.el does, or else
- ;; add-to-list will not add the association where we want it.
- (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . image-mode)))
-
-(if (and (treesit-ready-p 'cpp)
- (treesit-ready-p 'c))
- (add-to-list 'auto-mode-alist '("\\.h\\'" . c-or-c++-ts-mode)))
+ (add-to-list 'major-mode-remap-defaults '(c++-mode . c++-ts-mode))
+ (add-to-list 'major-mode-remap-defaults '(c-mode . c-ts-mode)))
+
+(when (and (treesit-ready-p 'cpp)
+ (treesit-ready-p 'c))
+ (add-to-list 'major-mode-remap-defaults '(c-or-c++-mode . c-or-c++-ts-mode)))
(provide 'c-ts-mode)
(provide 'c++-ts-mode)
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index bc0aae919e5..b5b7d262f52 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -2425,7 +2425,7 @@ system."
(error "Unknown base mode `%s'" base-mode))
(put mode 'c-fallback-mode base-mode))
-(defvar c-lang-constants (make-vector 151 0))
+(defvar c-lang-constants (obarray-make 151))
;; Obarray used as a cache to keep track of the language constants.
;; The constants stored are those defined by `c-lang-defconst' and the values
;; computed by `c-lang-const'. It's mostly used at compile time but it's not
@@ -2631,7 +2631,7 @@ constant. A file is identified by its base name."
;; Clear the evaluated values that depend on this source.
(let ((agenda (get sym 'dependents))
- (visited (make-vector 101 0))
+ (visited (obarray-make 101))
ptr)
(while agenda
(setq sym (car agenda)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index dc75bf741a6..f3f717cb97c 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -3512,7 +3512,7 @@ Note that Java specific rules are currently applied to
tell this from
(let* ((alist (c-lang-const c-keyword-member-alist))
kwd lang-const-list
- (obarray (make-vector (* (length alist) 2) 0)))
+ (obarray (obarray-make (* (length alist) 2))))
(while alist
(setq kwd (caar alist)
lang-const-list (cdar alist)
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 64a679eacc7..1a9d0907bd0 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -2902,15 +2902,19 @@ This function attempts to use file contents to
determine whether
the code is C or C++ and based on that chooses whether to enable
`c-mode' or `c++-mode'."
(interactive)
- (if (save-excursion
- (save-restriction
- (save-match-data
- (widen)
- (goto-char (point-min))
- (re-search-forward c-or-c++-mode--regexp
- (+ (point) c-guess-region-max) t))))
- (c++-mode)
- (c-mode)))
+ (let ((mode
+ (if (save-excursion
+ (save-restriction
+ (save-match-data
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward c-or-c++-mode--regexp
+ (+ (point) c-guess-region-max) t))))
+ 'c++-mode
+ 'c-mode)))
+ (funcall (if (fboundp 'major-mode-remap)
+ (major-mode-remap mode)
+ mode))))
;; Support for C++
diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el
index 29c9e957d3c..b70806f4c30 100644
--- a/lisp/progmodes/cmake-ts-mode.el
+++ b/lisp/progmodes/cmake-ts-mode.el
@@ -193,13 +193,13 @@ Check if a node type is available, then return the right
font lock rules."
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `cmake-ts-mode'.")
-(defun cmake-ts-mode--function-name (node)
- "Return the function name of NODE.
-Return nil if there is no name or if NODE is not a function node."
+(defun cmake-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."
(pcase (treesit-node-type node)
- ("function_command"
+ ((or "function_def" "macro_def")
(treesit-node-text
- (treesit-search-subtree node "^argument$" nil nil 2)
+ (treesit-search-subtree node "^argument$" nil nil 3)
t))))
;;;###autoload
@@ -216,9 +216,15 @@ Return nil if there is no name or if NODE is not a
function node."
(setq-local comment-end "")
(setq-local comment-start-skip (rx "#" (* (syntax whitespace))))
+ ;; Defuns.
+ (setq-local treesit-defun-type-regexp (rx (or "function" "macro")
+ "_def"))
+ (setq-local treesit-defun-name-function #'cmake-ts-mode--defun-name)
+
;; Imenu.
(setq-local treesit-simple-imenu-settings
- `(("Function" "\\`function_command\\'" nil
cmake-ts-mode--function-name)))
+ `(("Function" "^function_def$")
+ ("Macro" "^macro_def$")))
(setq-local which-func-functions nil)
;; Indent.
@@ -237,6 +243,8 @@ Return nil if there is no name or if NODE is not a function
node."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'cmake-ts-mode '(cmake-mode))
+
(if (treesit-ready-p 'cmake)
(add-to-list 'auto-mode-alist
'("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode)))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 758a6e17f72..11709bfe00b 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1934,6 +1934,8 @@ or as help on variables `cperl-tips', `cperl-problems',
;; Setup Flymake
(add-hook 'flymake-diagnostic-functions #'perl-flymake nil t))
+(derived-mode-add-parents 'cperl-mode '(perl-mode))
+
(defun cperl--set-file-style ()
(when cperl-file-style
(cperl-file-style cperl-file-style)))
@@ -4014,7 +4016,10 @@ recursive calls in starting lines of here-documents."
;; 1+6+2+1+1+6+1+1+1=20 extra () before this:
"\\|"
;; -------- backslash-escaped stuff, don't interpret it
- "\\\\\\(['`\"($]\\)") ; BACKWACKED something-hairy
+ "\\\\\\(['`\"($]\\)" ; BACKWACKED something-hairy
+ "\\|"
+ ;; -------- $\ is a variable in code, but not in a string
+ "\\(\\$\\\\\\)")
"")))
warning-message)
(unwind-protect
@@ -4068,7 +4073,12 @@ recursive calls in starting lines of here-documents."
(cperl-modify-syntax-type bb cperl-st-punct)))
;; No processing in strings/comments beyond this point:
((or (nth 3 state) (nth 4 state))
- t) ; Do nothing in comment/string
+ ;; Edge case: In a double-quoted string, $\ is not the
+ ;; punctuation variable, $ must not quote \ here. We
+ ;; generally make $ a punctuation character in strings
+ ;; and comments (Bug#69604).
+ (when (match-beginning 22)
+ (cperl-modify-syntax-type (match-beginning 22)
cperl-st-punct)))
((match-beginning 1) ; POD section
;; "\\(\\`\n?\\|^\n\\)="
(setq b (match-beginning 0)
@@ -6557,7 +6567,7 @@ and \"Whitesmith\"."
(let ((option (car setting))
(value (cdr setting)))
(set (make-local-variable option) value)))
- (set (make-local-variable 'cperl-file-style) style))
+ (setq-local cperl-file-style style))
(declare-function Info-find-node "info"
(filename nodename &optional no-going-back strict-case
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index 7bf57bcbe21..18114d08528 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -998,6 +998,8 @@ Key bindings:
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-ts-mode)))
+(derived-mode-add-parents 'csharp-ts-mode '(csharp-mode))
+
(provide 'csharp-mode)
;;; csharp-mode.el ends here
diff --git a/lisp/progmodes/dockerfile-ts-mode.el
b/lisp/progmodes/dockerfile-ts-mode.el
index f6587018513..e31fd86bbdf 100644
--- a/lisp/progmodes/dockerfile-ts-mode.el
+++ b/lisp/progmodes/dockerfile-ts-mode.el
@@ -165,6 +165,8 @@ Return nil if there is no name or if NODE is not a stage
node."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'dockerfile-ts-mode '(dockerfile-mode))
+
(if (treesit-ready-p 'dockerfile)
(add-to-list 'auto-mode-alist
;; NOTE: We can't use `rx' here, as it breaks bootstrap.
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index df8a287b4f2..afe3281361d 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -226,91 +226,105 @@ automatically)."
when probe return (cons probe args)
finally (funcall err)))))))
-(defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ("rust-analyzer"))
- ((cmake-mode cmake-ts-mode) .
("cmake-language-server"))
- (vimrc-mode . ("vim-language-server"
"--stdio"))
- ((python-mode python-ts-mode)
- . ,(eglot-alternatives
- '("pylsp" "pyls" ("pyright-langserver"
"--stdio") "jedi-language-server" "ruff-lsp")))
- ((js-json-mode json-mode json-ts-mode)
- . ,(eglot-alternatives
'(("vscode-json-language-server" "--stdio")
-
("vscode-json-languageserver" "--stdio")
-
("json-languageserver" "--stdio"))))
- (((js-mode :language-id "javascript")
- (js-ts-mode :language-id "javascript")
- (tsx-ts-mode :language-id "typescriptreact")
- (typescript-ts-mode :language-id
"typescript")
- (typescript-mode :language-id "typescript"))
- . ("typescript-language-server" "--stdio"))
- ((bash-ts-mode sh-mode) .
("bash-language-server" "start"))
- ((php-mode phps-mode php-ts-mode)
- . ,(eglot-alternatives
- '(("phpactor" "language-server")
- ("php"
"vendor/felixfbecker/language-server/bin/php-language-server.php"))))
- ((c-mode c-ts-mode c++-mode c++-ts-mode
objc-mode)
- . ,(eglot-alternatives
- '("clangd" "ccls")))
- (((caml-mode :language-id "ocaml")
- (tuareg-mode :language-id "ocaml")
reason-mode)
- . ("ocamllsp"))
- ((ruby-mode ruby-ts-mode)
- . ("solargraph" "socket" "--port" :autoport))
- (haskell-mode
- . ("haskell-language-server-wrapper" "--lsp"))
- (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)
- . ("gopls"))
- ((R-mode ess-r-mode) . ("R" "--slave" "-e"
-
"languageserver::run()"))
- ((java-mode java-ts-mode) . ("jdtls"))
- ((dart-mode dart-ts-mode)
- . ("dart" "language-server"
- "--client-id" "emacs.eglot-dart"))
- ((elixir-mode elixir-ts-mode heex-ts-mode)
- . ,(if (and (fboundp 'w32-shell-dos-semantics)
- (w32-shell-dos-semantics))
- '("language_server.bat")
- (eglot-alternatives
- '("language_server.sh"
"start_lexical.sh"))))
- (ada-mode . ("ada_language_server"))
- (scala-mode . ,(eglot-alternatives
- '("metals" "metals-emacs")))
- (racket-mode . ("racket" "-l"
"racket-langserver"))
- ((tex-mode context-mode texinfo-mode
bibtex-mode)
- . ,(eglot-alternatives '("digestif"
"texlab")))
- (erlang-mode . ("erlang_ls" "--transport"
"stdio"))
- ((yaml-ts-mode yaml-mode) .
("yaml-language-server" "--stdio"))
- (nix-mode . ,(eglot-alternatives '("nil"
"rnix-lsp" "nixd")))
- (nickel-mode . ("nls"))
- ((nushell-mode nushell-ts-mode) . ("nu"
"--lsp"))
- (gdscript-mode . ("localhost" 6008))
- ((fortran-mode f90-mode) . ("fortls"))
- (futhark-mode . ("futhark" "lsp"))
- ((lua-mode lua-ts-mode) . ,(eglot-alternatives
-
'("lua-language-server" "lua-lsp")))
- (zig-mode . ("zls"))
- ((css-mode css-ts-mode)
- . ,(eglot-alternatives
'(("vscode-css-language-server" "--stdio")
-
("css-languageserver" "--stdio"))))
- (html-mode . ,(eglot-alternatives
'(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio"))))
- ((dockerfile-mode dockerfile-ts-mode) .
("docker-langserver" "--stdio"))
- ((clojure-mode clojurescript-mode
clojurec-mode clojure-ts-mode)
- . ("clojure-lsp"))
- ((csharp-mode csharp-ts-mode)
- . ,(eglot-alternatives
- '(("omnisharp" "-lsp")
- ("csharp-ls"))))
- (purescript-mode .
("purescript-language-server" "--stdio"))
- ((perl-mode cperl-mode) . ("perl"
"-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run"))
- (markdown-mode
- . ,(eglot-alternatives
- '(("marksman" "server")
- ("vscode-markdown-language-server"
"--stdio"))))
- (graphviz-dot-mode . ("dot-language-server"
"--stdio"))
- (terraform-mode . ("terraform-ls" "serve"))
- ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")))
+(defvar eglot-server-programs
+ ;; FIXME: Maybe this info should be distributed into the major modes
+ ;; themselves where they could set a buffer-local `eglot-server-program'
+ ;; instead of keeping this database centralized.
+ ;; FIXME: With `derived-mode-add-parents' in Emacs≥30, some of
+ ;; those entries can be simplified, but we keep them for when
+ ;; `eglot.el' is installed via GNU ELPA in an older Emacs.
+ `(((rust-ts-mode rust-mode) . ("rust-analyzer"))
+ ((cmake-mode cmake-ts-mode) . ("cmake-language-server"))
+ (vimrc-mode . ("vim-language-server" "--stdio"))
+ ((python-mode python-ts-mode)
+ . ,(eglot-alternatives
+ '("pylsp" "pyls" ("pyright-langserver" "--stdio")
+ "jedi-language-server" "ruff-lsp")))
+ ((js-json-mode json-mode json-ts-mode)
+ . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio")
+ ("vscode-json-languageserver" "--stdio")
+ ("json-languageserver" "--stdio"))))
+ (((js-mode :language-id "javascript")
+ (js-ts-mode :language-id "javascript")
+ (tsx-ts-mode :language-id "typescriptreact")
+ (typescript-ts-mode :language-id "typescript")
+ (typescript-mode :language-id "typescript"))
+ . ("typescript-language-server" "--stdio"))
+ ((bash-ts-mode sh-mode) . ("bash-language-server" "start"))
+ ((php-mode phps-mode php-ts-mode)
+ . ,(eglot-alternatives
+ '(("phpactor" "language-server")
+ ("php"
"vendor/felixfbecker/language-server/bin/php-language-server.php"))))
+ ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode)
+ . ,(eglot-alternatives
+ '("clangd" "ccls")))
+ (((caml-mode :language-id "ocaml")
+ (tuareg-mode :language-id "ocaml") reason-mode)
+ . ("ocamllsp"))
+ ((ruby-mode ruby-ts-mode)
+ . ("solargraph" "socket" "--port" :autoport))
+ (haskell-mode
+ . ("haskell-language-server-wrapper" "--lsp"))
+ (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)
+ . ("gopls"))
+ ((R-mode ess-r-mode) . ("R" "--slave" "-e"
+ "languageserver::run()"))
+ ((java-mode java-ts-mode) . ("jdtls"))
+ ((dart-mode dart-ts-mode)
+ . ("dart" "language-server"
+ "--client-id" "emacs.eglot-dart"))
+ ((elixir-mode elixir-ts-mode heex-ts-mode)
+ . ,(if (and (fboundp 'w32-shell-dos-semantics)
+ (w32-shell-dos-semantics))
+ '("language_server.bat")
+ (eglot-alternatives
+ '("language_server.sh" "start_lexical.sh"))))
+ (ada-mode . ("ada_language_server"))
+ (scala-mode . ,(eglot-alternatives
+ '("metals" "metals-emacs")))
+ (racket-mode . ("racket" "-l" "racket-langserver"))
+ ((tex-mode context-mode texinfo-mode bibtex-mode)
+ . ,(eglot-alternatives '("digestif" "texlab")))
+ (erlang-mode . ("erlang_ls" "--transport" "stdio"))
+ ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio"))
+ (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd")))
+ (nickel-mode . ("nls"))
+ ((nushell-mode nushell-ts-mode) . ("nu" "--lsp"))
+ (gdscript-mode . ("localhost" 6008))
+ ((fortran-mode f90-mode) . ("fortls"))
+ (futhark-mode . ("futhark" "lsp"))
+ ((lua-mode lua-ts-mode) . ,(eglot-alternatives
+ '("lua-language-server" "lua-lsp")))
+ (zig-mode . ("zls"))
+ ((css-mode css-ts-mode)
+ . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio")
+ ("css-languageserver" "--stdio"))))
+ (html-mode . ,(eglot-alternatives
+ '(("vscode-html-language-server" "--stdio")
+ ("html-languageserver" "--stdio"))))
+ ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio"))
+ ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode)
+ . ("clojure-lsp"))
+ ((csharp-mode csharp-ts-mode)
+ . ,(eglot-alternatives
+ '(("omnisharp" "-lsp")
+ ("csharp-ls"))))
+ (purescript-mode . ("purescript-language-server" "--stdio"))
+ ((perl-mode cperl-mode)
+ . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run"))
+ (markdown-mode
+ . ,(eglot-alternatives
+ '(("marksman" "server")
+ ("vscode-markdown-language-server" "--stdio"))))
+ (graphviz-dot-mode . ("dot-language-server" "--stdio"))
+ (terraform-mode . ("terraform-ls" "serve"))
+ ((uiua-ts-mode uiua-mode) . ("uiua" "lsp"))
+ (sml-mode
+ . ,(lambda (_interactive project)
+ (list "millet-ls" (project-root project)))))
"How the command `eglot' guesses the server to start.
An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE
identifies the buffers that are to be managed by a specific
@@ -591,7 +605,7 @@ It is nil if Eglot is not byte-complied.")
(let ((vec (copy-sequence url-path-allowed-chars)))
(aset vec ?: nil) ;; see github#639
vec)
- "Like `url-path-allows-chars' but more restrictive.")
+ "Like `url-path-allowed-chars' but more restrictive.")
;;; Message verification helpers
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 3161d2e5a9a..7f9e64c1d14 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -221,7 +221,7 @@ All commands in `lisp-mode-shared-map' are inherited by
this map."
(load (byte-compile-dest-file buffer-file-name)))
(declare-function native-compile "comp")
-(declare-function comp-write-bytecode-file "comp")
+(declare-function comp--write-bytecode-file "comp")
(defun emacs-lisp-native-compile ()
"Native-compile the current buffer's file (if it has changed).
@@ -233,7 +233,7 @@ visited by the current buffer."
(byte-to-native-output-buffer-file nil)
(eln (native-compile buffer-file-name)))
(when eln
- (comp-write-bytecode-file eln))))
+ (comp--write-bytecode-file eln))))
(defun emacs-lisp-native-compile-and-load ()
"Native-compile the current buffer's file (if it has changed), then load it.
@@ -309,7 +309,7 @@ Comments in the form will be lost."
INTERACTIVE non-nil means ask the user for confirmation; this
happens in interactive invocations."
(interactive "p")
- (if lexical-binding
+ (if (and (local-variable-p 'lexical-binding) lexical-binding)
(when interactive
(message "lexical-binding already enabled!")
(ding))
@@ -371,6 +371,12 @@ be used instead.
;; Font-locking support.
+(defun elisp--font-lock-shorthand (_limit)
+ ;; Add faces on shorthands between point and LIMIT.
+ ;; ...
+ ;; Return nil to tell font-lock, that there's nothing left to do.
+ nil)
+
(defun elisp--font-lock-flush-elisp-buffers (&optional file)
;; We're only ever called from after-load-functions, load-in-progress can
;; still be t in case of nested loads.
@@ -1585,9 +1591,6 @@ character)."
(buffer-substring-no-properties beg end))
))))
-
-(defvar elisp--eval-last-sexp-fake-value (make-symbol "t"))
-
(defun eval-sexp-add-defvars (exp &optional pos)
"Prepend EXP with all the `defvar's that precede it in the buffer.
POS specifies the starting position where EXP was found and defaults to point."
@@ -1629,16 +1632,10 @@ integer value is also printed as a character of that
codepoint.
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
(interactive "P")
- (if (null eval-expression-debug-on-error)
- (values--store-value
- (elisp--eval-last-sexp eval-last-sexp-arg-internal))
- (let ((value
- (let ((debug-on-error elisp--eval-last-sexp-fake-value))
- (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
- debug-on-error))))
- (unless (eq (cdr value) elisp--eval-last-sexp-fake-value)
- (setq debug-on-error (cdr value)))
- (car value))))
+ (values--store-value
+ (handler-bind ((error (if eval-expression-debug-on-error
+ #'eval-expression--debug #'ignore)))
+ (elisp--eval-last-sexp eval-last-sexp-arg-internal))))
(defun elisp--eval-defun-1 (form)
"Treat some expressions in FORM specially.
@@ -1697,8 +1694,7 @@ Return the result of evaluation."
;; FIXME: the print-length/level bindings should only be applied while
;; printing, not while evaluating.
(defvar elisp--eval-defun-result)
- (let ((debug-on-error eval-expression-debug-on-error)
- (edebugging edebug-all-defs)
+ (let ((edebugging edebug-all-defs)
elisp--eval-defun-result)
(save-excursion
;; Arrange for eval-region to "read" the (possibly) altered form.
@@ -1777,15 +1773,9 @@ which see."
(defvar edebug-all-defs)
(eval-defun (not edebug-all-defs)))
(t
- (if (null eval-expression-debug-on-error)
- (elisp--eval-defun)
- (let (new-value value)
- (let ((debug-on-error elisp--eval-last-sexp-fake-value))
- (setq value (elisp--eval-defun))
- (setq new-value debug-on-error))
- (unless (eq elisp--eval-last-sexp-fake-value new-value)
- (setq debug-on-error new-value))
- value)))))
+ (handler-bind ((error (if eval-expression-debug-on-error
+ #'eval-expression--debug #'ignore)))
+ (elisp--eval-defun)))))
;;; ElDoc Support
diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el
index b493195eedd..9804152d9ab 100644
--- a/lisp/progmodes/elixir-ts-mode.el
+++ b/lisp/progmodes/elixir-ts-mode.el
@@ -360,13 +360,19 @@
(defvar elixir-ts--font-lock-settings
(treesit-font-lock-rules
:language 'elixir
- :feature 'elixir-function-name
+ :feature 'elixir-definition
`((call target: (identifier) @target-identifier
+ (arguments
+ (call target: (identifier) @font-lock-function-name-face
+ (arguments)))
+ (:match ,elixir-ts--definition-keywords-re @target-identifier))
+ (call target: (identifier) @target-identifier
(arguments (identifier) @font-lock-function-name-face)
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(call target: (identifier) @target-identifier
(arguments
- (call target: (identifier) @font-lock-function-name-face))
+ (call target: (identifier) @font-lock-function-name-face
+ (arguments ((identifier)) @font-lock-variable-name-face)))
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(call target: (identifier) @target-identifier
(arguments
@@ -379,13 +385,15 @@
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(call target: (identifier) @target-identifier
(arguments
- (call target: (identifier) @font-lock-function-name-face))
+ (call target: (identifier) @font-lock-function-name-face
+ (arguments ((identifier)) @font-lock-variable-name-face)))
(do_block)
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(call target: (identifier) @target-identifier
(arguments
(binary_operator
- left: (call target: (identifier) @font-lock-function-name-face)))
+ left: (call target: (identifier) @font-lock-function-name-face
+ (arguments ((identifier))
@font-lock-variable-name-face))))
(do_block)
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(unary_operator
@@ -521,8 +529,8 @@
operator: "/" right: (integer)))
(call
target: (dot right: (identifier) @font-lock-function-call-face))
- (unary_operator operator: "&" @font-lock-variable-name-face
- operand: (integer) @font-lock-variable-name-face)
+ (unary_operator operator: "&" @font-lock-variable-use-face
+ operand: (integer) @font-lock-variable-use-face)
(unary_operator operator: "&" @font-lock-operator-face
operand: (list)))
@@ -537,16 +545,18 @@
:language 'elixir
:feature 'elixir-variable
- '((binary_operator left: (identifier) @font-lock-variable-name-face)
- (binary_operator right: (identifier) @font-lock-variable-name-face)
- (arguments ( (identifier) @font-lock-variable-name-face))
- (tuple (identifier) @font-lock-variable-name-face)
- (list (identifier) @font-lock-variable-name-face)
- (pair value: (identifier) @font-lock-variable-name-face)
- (body (identifier) @font-lock-variable-name-face)
- (unary_operator operand: (identifier) @font-lock-variable-name-face)
- (interpolation (identifier) @font-lock-variable-name-face)
- (do_block (identifier) @font-lock-variable-name-face))
+ '((binary_operator left: (identifier) @font-lock-variable-use-face)
+ (binary_operator right: (identifier) @font-lock-variable-use-face)
+ (arguments ( (identifier) @font-lock-variable-use-face))
+ (tuple (identifier) @font-lock-variable-use-face)
+ (list (identifier) @font-lock-variable-use-face)
+ (pair value: (identifier) @font-lock-variable-use-face)
+ (body (identifier) @font-lock-variable-use-face)
+ (unary_operator operand: (identifier) @font-lock-variable-use-face)
+ (interpolation (identifier) @font-lock-variable-use-face)
+ (do_block (identifier) @font-lock-variable-use-face)
+ (access_call target: (identifier) @font-lock-variable-use-face)
+ (access_call "[" key: (identifier) @font-lock-variable-use-face "]"))
:language 'elixir
:feature 'elixir-builtin
@@ -697,11 +707,10 @@ Return nil if NODE is not a defun node or doesn't have a
name."
;; Font-lock.
(setq-local treesit-font-lock-settings elixir-ts--font-lock-settings)
(setq-local treesit-font-lock-feature-list
- '(( elixir-comment elixir-doc elixir-function-name)
+ '(( elixir-comment elixir-doc elixir-definition)
( elixir-string elixir-keyword elixir-data-type)
- ( elixir-sigil elixir-variable elixir-builtin
- elixir-string-escape)
- ( elixir-function-call elixir-operator elixir-number )))
+ ( elixir-sigil elixir-builtin elixir-string-escape)
+ ( elixir-function-call elixir-variable elixir-operator
elixir-number )))
;; Imenu.
@@ -734,17 +743,18 @@ Return nil if NODE is not a defun node or doesn't have a
name."
heex-ts--indent-rules))
(setq-local treesit-font-lock-feature-list
- '(( elixir-comment elixir-doc elixir-function-name
+ '(( elixir-comment elixir-doc elixir-definition
heex-comment heex-keyword heex-doctype )
( elixir-string elixir-keyword elixir-data-type
heex-component heex-tag heex-attribute heex-string )
- ( elixir-sigil elixir-variable elixir-builtin
- elixir-string-escape)
- ( elixir-function-call elixir-operator elixir-number ))))
+ ( elixir-sigil elixir-builtin elixir-string-escape)
+ ( elixir-function-call elixir-variable elixir-operator
elixir-number ))))
(treesit-major-mode-setup)
(setq-local syntax-propertize-function #'elixir-ts--syntax-propertize)))
+(derived-mode-add-parents 'elixir-ts-mode '(elixir-mode))
+
(if (treesit-ready-p 'elixir)
(progn
(add-to-list 'auto-mode-alist '("\\.elixir\\'" . elixir-ts-mode))
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index b9bd772ddfc..597612196fd 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1488,7 +1488,7 @@ hits the start of file."
(setq symbs (symbol-value symbs))
(insert (format-message "symbol `%s' has no value\n" symbs))
(setq symbs nil)))
- (if (vectorp symbs)
+ (if (obarrayp symbs)
(mapatoms ins-symb symbs)
(dolist (sy symbs)
(funcall ins-symb (car sy))))
@@ -2065,7 +2065,8 @@ for \\[find-tag] (which see)."
(user-error "%s"
(substitute-command-keys
"No tags table loaded; try \\[visit-tags-table]")))
- (let ((comp-data (tags-completion-at-point-function)))
+ (let ((comp-data (tags-completion-at-point-function))
+ (completion-ignore-case (find-tag--completion-ignore-case)))
(if (null comp-data)
(user-error "Nothing to complete")
(completion-in-region (car comp-data) (cadr comp-data)
@@ -2183,7 +2184,7 @@ file name, add `tag-partial-file-name-match-p' to the
list value.")
(setq symbs (symbol-value symbs))
(warn "symbol `%s' has no value" symbs)
(setq symbs nil))
- (if (vectorp symbs)
+ (if (obarrayp symbs)
(mapatoms add-xref symbs)
(dolist (sy symbs)
(funcall add-xref (car sy))))
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 5974f076556..db00cc59c0e 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1569,13 +1569,19 @@ correctly.")
,flymake-mode-line-lighter
mouse-face mode-line-highlight
help-echo
- ,(lambda (&rest _)
- (concat
- (format "%s known backends\n" (hash-table-count flymake--state))
- (format "%s running\n" (length (flymake-running-backends)))
- (format "%s disabled\n" (length (flymake-disabled-backends)))
- "mouse-1: Display minor mode menu\n"
- "mouse-2: Show help for minor mode"))
+ ,(lambda (w &rest _)
+ (with-current-buffer (window-buffer w)
+ ;; Mouse can activate tool-tip without window being active.
+ ;; `flymake--state' is buffer local and is null when line
+ ;; lighter appears in *Help* `describe-mode'.
+ (concat
+ (unless (null flymake--state)
+ (concat
+ (format "%s known backends\n" (hash-table-count flymake--state))
+ (format "%s running\n" (length (flymake-running-backends)))
+ (format "%s disabled\n" (length (flymake-disabled-backends)))))
+ "mouse-1: Display minor mode menu\n"
+ "mouse-2: Show help for minor mode")))
keymap
,(let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1]
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index e08653f7f9e..c8b086cfad2 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1880,7 +1880,8 @@ this trigger is subscribed to `gdb-buf-publisher' and
called with
(defun gdb-clear-inferior-io ()
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
- (erase-buffer)))
+ (let ((inhibit-read-only t))
+ (erase-buffer))))
(defconst breakpoint-xpm-data
@@ -2866,7 +2867,8 @@ current thread and update GDB buffers."
(defun gdb-clear-partial-output ()
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
- (erase-buffer)))
+ (let ((inhibit-read-only t))
+ (erase-buffer))))
;; Parse GDB/MI result records: this process converts
;; list [...] -> list
diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el
index 65adc1c55ea..cc330688dc3 100644
--- a/lisp/progmodes/go-ts-mode.el
+++ b/lisp/progmodes/go-ts-mode.el
@@ -261,7 +261,11 @@
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'go-ts-mode '(go-mode))
+
(if (treesit-ready-p 'go)
+ ;; FIXME: Should we instead put `go-mode' in `auto-mode-alist'
+ ;; and then use `major-mode-remap-defaults' to map it to `go-ts-mode'?
(add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode)))
(defun go-ts-mode--defun-name (node &optional skip-prefix)
@@ -437,6 +441,8 @@ what the parent of the node would be if it were a node."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'go-mod-ts-mode '(go-mod-mode))
+
(if (treesit-ready-p 'gomod)
(add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode)))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index b7c85fe7f43..f10b047cc74 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3671,8 +3671,7 @@ Treats actions as defuns."
(remove-hook 'after-save-hook #'gdb-create-define-alist t))))
(defcustom gud-tooltip-modes '( gud-mode c-mode c++-mode fortran-mode
- python-mode c-ts-mode c++-ts-mode
- python-ts-mode)
+ python-mode)
"List of modes for which to enable GUD tooltips."
:type '(repeat (symbol :tag "Major mode"))
:group 'tooltip)
@@ -3708,10 +3707,9 @@ only tooltips in the buffer containing the overlay
arrow."
#'gud-tooltip-activate-mouse-motions-if-enabled)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
- (if (and gud-tooltip-mode
- (memq major-mode gud-tooltip-modes))
- (gud-tooltip-activate-mouse-motions t)
- (gud-tooltip-activate-mouse-motions nil)))))
+ (gud-tooltip-activate-mouse-motions
+ (and gud-tooltip-mode
+ (derived-mode-p gud-tooltip-modes))))))
(defvar gud-tooltip-mouse-motions-active nil
"Locally t in a buffer if tooltip processing of mouse motion is enabled.")
diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el
index 7b53a44deb2..07b8bfdc74f 100644
--- a/lisp/progmodes/heex-ts-mode.el
+++ b/lisp/progmodes/heex-ts-mode.el
@@ -166,6 +166,16 @@ With ARG, do it many times. Negative ARG means move
backward."
("Slot" "\\`slot\\'" nil nil)
("Tag" "\\`tag\\'" nil nil)))
+ ;; Outline minor mode
+ ;; `heex-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
+ ;; to use `treesit-outline-predicate' derived
+ ;; from `treesit-simple-imenu-settings' above.
+ (kill-local-variable 'outline-heading-end-regexp)
+ (kill-local-variable 'outline-regexp)
+ (kill-local-variable 'outline-level)
+
(setq-local treesit-font-lock-settings heex-ts--font-lock-settings)
(setq-local treesit-simple-indent-rules heex-ts--indent-rules)
@@ -177,6 +187,8 @@ With ARG, do it many times. Negative ARG means move
backward."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'heex-ts-mode '(heex-mode))
+
(if (treesit-ready-p 'heex)
;; Both .heex and the deprecated .leex files should work
;; with the tree-sitter-heex grammar.
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 71f55379d96..98e567299a1 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -390,7 +390,7 @@ If there is a marked region from START to END it only shows
the symbols within."
(defun hif-after-revert-function ()
(and hide-ifdef-mode hide-ifdef-hiding
(hide-ifdefs nil nil t)))
-(add-hook 'after-revert-hook 'hif-after-revert-function)
+(add-hook 'after-revert-hook #'hif-after-revert-function)
(defun hif-end-of-line ()
"Find the end-point of line concatenation."
@@ -474,7 +474,7 @@ Everything including these lines is made invisible."
(defun hif-eval (form)
"Evaluate hideif internal representation."
- (let ((val (eval form)))
+ (let ((val (eval form t)))
(if (stringp val)
(or (get-text-property 0 'hif-value val)
val)
@@ -542,7 +542,7 @@ that form should be displayed.")
(defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*")
(defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def"))
(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
-(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[
\t]+\\)"))
+(defvar hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[
\t]+\\)"))
(defconst hif-elif-regexp (concat hif-cpp-prefix "elif"))
(defconst hif-else-regexp (concat hif-cpp-prefix "else"))
(defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
@@ -679,7 +679,7 @@ that form should be displayed.")
("..." . hif-etc)
("defined" . hif-defined)))
-(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist))
+(defconst hif-valid-token-list (mapcar #'cdr hif-token-alist))
(defconst hif-token-regexp
;; The ordering of regexp grouping is crucial to `hif-strtok'
@@ -690,7 +690,7 @@ that form should be displayed.")
;; decimal/octal:
"\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?"
hif-numtype-suffix-regexp "?\\)"
- "\\|" (regexp-opt (mapcar 'car hif-token-alist) t)
+ "\\|" (regexp-opt (mapcar #'car hif-token-alist) t)
"\\|\\(\\w+\\)"))
;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"")
@@ -867,7 +867,7 @@ Assuming we've just performed a `hif-token-regexp' lookup."
(t
(setq hif-simple-token-only nil)
- (intern-safe string)))))
+ (hif--intern-safe string)))))
(defun hif-backward-comment (&optional start end)
"If we're currently within a C(++) comment, skip them backwards."
@@ -1448,7 +1448,7 @@ This macro cannot be evaluated alone without parameters
input."
(t
(error "Invalid token to stringify"))))
-(defun intern-safe (str)
+(defun hif--intern-safe (str)
(if (stringp str)
(intern str)))
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index b181b21118f..07616960565 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -254,6 +254,9 @@ This has effect only if `search-invisible' is set to
`open'."
;;;###autoload
(defvar hs-special-modes-alist
+ ;; FIXME: Currently the check is made via
+ ;; (assoc major-mode hs-special-modes-alist) so it doesn't pay attention
+ ;; to the mode hierarchy.
(mapcar #'purecopy
'((c-mode "{" "}" "/[*/]" nil nil)
(c-ts-mode "{" "}" "/[*/]" nil nil)
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 0f11103cf02..b5d91f46b17 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -96,8 +96,8 @@
(defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> "
"Regexp to match IDL prompt at beginning of a line.
-For example, \"^\r?IDL> \" or \"^\r?WAVE> \".
-The \"^\r?\" is needed, to indicate the beginning of the line, with
+For example, \"^\\r?IDL> \" or \"^\\r?WAVE> \".
+The \"^\\r?\" is needed, to indicate the beginning of the line, with
optional return character (which IDL seems to output randomly).
This variable is used to initialize `comint-prompt-regexp' in the
process buffer."
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el
index 0b1ac49b99f..bb4a7df3340 100644
--- a/lisp/progmodes/java-ts-mode.el
+++ b/lisp/progmodes/java-ts-mode.el
@@ -74,7 +74,12 @@
((parent-is "program") column-0 0)
((match "}" "element_value_array_initializer")
parent-bol 0)
- ((node-is "}") column-0 c-ts-common-statement-offset)
+ ((node-is
+ ,(format "\\`%s\\'"
+ (regexp-opt '("constructor_body" "class_body" "interface_body"
+ "block" "switch_block" "array_initializer"))))
+ parent-bol 0)
+ ((node-is "}") standalone-parent 0)
((node-is ")") parent-bol 0)
((node-is "else") parent-bol 0)
((node-is "]") parent-bol 0)
@@ -86,10 +91,10 @@
((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset)
((parent-is "annotation_type_body") column-0 c-ts-common-statement-offset)
((parent-is "interface_body") column-0 c-ts-common-statement-offset)
- ((parent-is "constructor_body") column-0 c-ts-common-statement-offset)
+ ((parent-is "constructor_body") standalone-parent
java-ts-mode-indent-offset)
((parent-is "enum_body_declarations") parent-bol 0)
((parent-is "enum_body") column-0 c-ts-common-statement-offset)
- ((parent-is "switch_block") column-0 c-ts-common-statement-offset)
+ ((parent-is "switch_block") standalone-parent java-ts-mode-indent-offset)
((parent-is "record_declaration_body") column-0
c-ts-common-statement-offset)
((query "(method_declaration (block _ @indent))") parent-bol
java-ts-mode-indent-offset)
((query "(method_declaration (block (_) @indent))") parent-bol
java-ts-mode-indent-offset)
@@ -125,7 +130,7 @@
((parent-is "case_statement") parent-bol java-ts-mode-indent-offset)
((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset)
((parent-is "do_statement") parent-bol java-ts-mode-indent-offset)
- ((parent-is "block") column-0 c-ts-common-statement-offset)))
+ ((parent-is "block") standalone-parent java-ts-mode-indent-offset)))
"Tree-sitter indent rules.")
(defvar java-ts-mode--keywords
@@ -401,6 +406,8 @@ Return nil if there is no name or if NODE is not a defun
node."
("Method" "\\`method_declaration\\'" nil nil)))
(treesit-major-mode-setup))
+(derived-mode-add-parents 'java-ts-mode '(java-mode))
+
(if (treesit-ready-p 'java)
(add-to-list 'auto-mode-alist '("\\.java\\'" . java-ts-mode)))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index ebc098e6a75..6cb84592896 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -3916,6 +3916,8 @@ See `treesit-thing-settings' for more information.")
(add-to-list 'auto-mode-alist
'("\\(\\.js[mx]\\|\\.har\\)\\'" . js-ts-mode))))
+(derived-mode-add-parents 'js-ts-mode '(js-mode))
+
(defvar js-ts--s-p-query
(when (treesit-available-p)
(treesit-query-compile 'javascript
diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el
index 32bc10bbda9..1fb96555010 100644
--- a/lisp/progmodes/json-ts-mode.el
+++ b/lisp/progmodes/json-ts-mode.el
@@ -164,6 +164,8 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-major-mode-setup))
+(derived-mode-add-parents 'json-ts-mode '(json-mode))
+
(if (treesit-ready-p 'json)
(add-to-list 'auto-mode-alist
'("\\.json\\'" . json-ts-mode)))
diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el
index 05a3ff6d7c6..25fd7792f42 100644
--- a/lisp/progmodes/lua-ts-mode.el
+++ b/lisp/progmodes/lua-ts-mode.el
@@ -26,8 +26,8 @@
;; This package provides `lua-ts-mode' which is a major mode for Lua
;; files that uses Tree Sitter to parse the language.
;;
-;; This package is compatible with and tested against the grammar
-;; for Lua found at https://github.com/MunifTanjim/tree-sitter-lua
+;; This package is compatible with and tested against the grammar for
+;; Lua found at https://github.com/tree-sitter-grammars/tree-sitter-lua
;;; Code:
@@ -317,6 +317,8 @@ values of OVERRIDE."
(node-is ")")
(node-is "}"))
standalone-parent 0)
+ ((match null "table_constructor")
+ standalone-parent lua-ts-indent-offset)
((or (and (parent-is "arguments") lua-ts--first-child-matcher)
(and (parent-is "parameters") lua-ts--first-child-matcher)
(and (parent-is "table_constructor") lua-ts--first-child-matcher))
@@ -774,7 +776,7 @@ Calls REPORT-FN directly."
"vararg_expression"))))
(text "comment"))))
- ;; Imenu.
+ ;; Imenu/Outline.
(setq-local treesit-simple-imenu-settings
`(("Requires"
"\\`function_call\\'"
@@ -789,16 +791,6 @@ Calls REPORT-FN directly."
;; Which-function.
(setq-local which-func-functions (treesit-defun-at-point))
- ;; Outline.
- (setq-local outline-regexp
- (rx (seq (0+ space)
- (or (seq "--[[" (0+ space) eol)
- (seq symbol-start
- (or "do" "for" "if" "repeat" "while"
- (seq (? (seq "local" (1+ space)))
- "function"))
- symbol-end)))))
-
;; Align.
(setq-local align-indent-before-aligning t)
@@ -806,6 +798,8 @@ Calls REPORT-FN directly."
(add-hook 'flymake-diagnostic-functions #'lua-ts-flymake-luacheck nil
'local))
+(derived-mode-add-parents 'lua-ts-mode '(lua-mode))
+
(when (treesit-ready-p 'lua)
(add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode)))
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index 09cb848fd52..2bb31988290 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -325,20 +325,20 @@ followed by the first character of the construct.
;;
;; Module definitions.
("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?"
- (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
+ (1 'font-lock-keyword-face) (2 'font-lock-function-name-face nil t))
;;
;; Import directives.
("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>"
- (1 font-lock-keyword-face)
+ (1 'font-lock-keyword-face)
(font-lock-match-c-style-declaration-item-and-skip-to-next
nil (goto-char (match-end 0))
- (1 font-lock-constant-face)))
+ (1 'font-lock-constant-face)))
;;
;; Pragmas as warnings.
;; Spencer Allain <sallain@teknowledge.com> says do them as comments...
;; ("<\\*.*\\*>" . font-lock-warning-face)
;; ... but instead we fontify the first word.
- ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend)
+ ("<\\*[ \t]*\\(\\sw+\\)" 1 'font-lock-warning-face prepend)
)
"Subdued level highlighting for Modula-3 modes.")
@@ -366,26 +366,29 @@ followed by the first character of the construct.
"LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD"
"ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL")))
)
- (list
- ;;
- ;; Keywords except those fontified elsewhere.
- (concat "\\<\\(" m3-keywords "\\)\\>")
- ;;
- ;; Builtins.
- (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face)
- ;;
- ;; Type names.
- (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face)
- ;;
- ;; Fontify tokens as function names.
- '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*"
- (1 font-lock-keyword-face)
+ `(
+ ;;
+ ;; Keywords except those fontified elsewhere.
+ ,(concat "\\<\\(" m3-keywords "\\)\\>")
+ ;;
+ ;; Builtins.
+ (,(concat "\\<\\(" m3-builtins "\\)\\>")
+ (0 'font-lock-builtin-face))
+ ;;
+ ;; Type names.
+ (,(concat "\\<\\(" m3-types "\\)\\>")
+ (0 'font-lock-type-face))
+ ;;
+ ;; Fontify tokens as function names.
+ ("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*"
+ (1 'font-lock-keyword-face)
(font-lock-match-c-style-declaration-item-and-skip-to-next
nil (goto-char (match-end 0))
- (1 font-lock-function-name-face)))
- ;;
- ;; Fontify constants as references.
- '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face)
+ (1 'font-lock-function-name-face)))
+ ;;
+ ;; Fontify constants as references.
+ ("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>"
+ (0 'font-lock-constant-face))
))))
"Gaudy level highlighting for Modula-3 modes.")
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index 5e8263cb646..a80e12b8129 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -281,7 +281,7 @@ nested routine.")
(eval-when-compile
(pcase-defmacro opascal--in (set)
- `(pred (pcase--flip memq ,set))))
+ `(pred (memq _ ,set))))
(defun opascal-string-of (start end)
;; Returns the buffer string from start to end.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f74390841fe..f6c4dbed1e2 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -251,7 +251,16 @@
;; correctly the \() construct (Bug#11996) as well as references
;; to string values.
("\\(\\\\\\)['`\"($]" (1 (unless (nth 3 (syntax-ppss))
- (string-to-syntax "."))))
+ (string-to-syntax "."))))
+ ;; A "$" in Perl code must escape the next char to protect against
+ ;; misinterpreting Perl's punctuation variables as unbalanced
+ ;; quotes or parens. This is not needed in strings and broken in
+ ;; the special case of "$\"" (Bug#69604). Make "$" a punctuation
+ ;; char in strings.
+ ("\\$" (0 (if (save-excursion
+ (nth 3 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax ".")
+ (string-to-syntax "/"))))
;; Handle funny names like $DB'stop.
("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
;; format statements
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index da782ad5537..9622b1b6768 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -992,9 +992,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
;;;###autoload
(defun project-or-external-find-regexp (regexp)
- "Find all matches for REGEXP in the project roots or external roots.
-With \\[universal-argument] prefix, you can specify the file name
-pattern to search for."
+ "Find all matches for REGEXP in the project roots or external roots."
(interactive (list (project--read-regexp)))
(require 'xref)
(let* ((pr (project-current t))
@@ -1515,7 +1513,8 @@ ARG, show only buffers that are visiting files."
(lambda (buffer)
(let ((name (buffer-name buffer))
(file (buffer-file-name buffer)))
- (and (or (not (string= (substring name 0 1) " "))
+ (and (or Buffer-menu-show-internal
+ (not (string= (substring name 0 1) " "))
file)
(not (eq buffer (current-buffer)))
(or file (not Buffer-menu-files-only)))))
@@ -1525,6 +1524,7 @@ ARG, show only buffers that are visiting files."
(let ((buf (list-buffers-noselect
arg (with-current-buffer
(get-buffer-create "*Buffer List*")
+ (setq-local Buffer-menu-show-internal nil)
(let ((Buffer-menu-files-only arg))
(funcall buffer-list-function))))))
(with-current-buffer buf
@@ -1866,12 +1866,12 @@ Otherwise, `default-directory' is temporarily set to
the current
project's root.
If OVERRIDING-MAP is non-nil, it will be used as
-`overriding-local-map' to provide shorter bindings from that map
-which will take priority over the global ones."
+`overriding-terminal-local-map' to provide shorter bindings
+from that map which will take priority over the global ones."
(interactive)
(let* ((pr (project-current t))
(prompt-format (or prompt-format "[execute in %s]:"))
- (command (let ((overriding-local-map overriding-map))
+ (command (let ((overriding-terminal-local-map overriding-map))
(key-binding (read-key-sequence
(format prompt-format (project-root pr)))
t)))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 9d840efb9da..1016655cb62 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -5,7 +5,7 @@
;; Author: Fabián E. Gallina <fgallina@gnu.org>
;; URL: https://github.com/fgallina/python.el
;; Version: 0.28
-;; Package-Requires: ((emacs "24.4") (compat "28.1.2.1") (seq "2.23"))
+;; Package-Requires: ((emacs "24.4") (compat "29.1.1.0") (seq "2.23"))
;; Maintainer: emacs-devel@gnu.org
;; Created: Jul 2010
;; Keywords: languages
@@ -128,9 +128,9 @@
;; receiving escape sequences (with some limitations, i.e. completion
;; in blocks does not work). The code executed for the "fallback"
;; completion can be found in `python-shell-completion-setup-code' and
-;; `python-shell-completion-string-code' variables. Their default
-;; values enable completion for both CPython and IPython, and probably
-;; any readline based shell (it's known to work with PyPy). If your
+;; `python-shell-completion-get-completions'. Their default values
+;; enable completion for both CPython and IPython, and probably any
+;; readline based shell (it's known to work with PyPy). If your
;; Python installation lacks readline (like CPython for Windows),
;; installing pyreadline (URL `https://ipython.org/pyreadline.html')
;; should suffice. To troubleshoot why you are not getting any
@@ -141,6 +141,12 @@
;; If you see an error, then you need to either install pyreadline or
;; setup custom code that avoids that dependency.
+;; By default, the "native" completion uses the built-in rlcompleter.
+;; To use other readline completer (e.g. Jedi) or a custom one, you just
+;; need to set it in the PYTHONSTARTUP file. You can set an
+;; Emacs-specific completer by testing the environment variable
+;; INSIDE_EMACS.
+
;; Shell virtualenv support: The shell also contains support for
;; virtualenvs and other special environment modifications thanks to
;; `python-shell-process-environment' and `python-shell-exec-path'.
@@ -267,7 +273,7 @@
(eval-when-compile (require 'subr-x)) ;For `string-empty-p' and
`string-join'.
(require 'treesit)
(require 'pcase)
-(require 'compat nil 'noerror)
+(require 'compat)
(require 'project nil 'noerror)
(require 'seq)
@@ -3515,6 +3521,16 @@ eventually provide a shell."
:version "25.1"
:type 'hook)
+(defconst python-shell-setup-code
+ "\
+try:
+ import tty
+except ImportError:
+ pass
+else:
+ tty.setraw(0)"
+ "Code used to setup the inferior Python processes.")
+
(defconst python-shell-eval-setup-code
"\
def __PYTHON_EL_eval(source, filename):
@@ -3580,6 +3596,7 @@ The coding cookie regexp is specified in PEP 263.")
(format "exec(%s)\n" (python-shell--encode-string
string))))))
;; Bootstrap: the normal definition of `python-shell-send-string'
;; depends on the Python code sent here.
+ (python-shell-send-string-no-output python-shell-setup-code)
(python-shell-send-string-no-output python-shell-eval-setup-code)
(python-shell-send-string-no-output
python-shell-eval-file-setup-code))
(with-current-buffer (current-buffer)
@@ -3604,7 +3621,6 @@ interpreter is run. Variables
`python-shell-prompt-block-regexp',
`python-shell-font-lock-enable',
`python-shell-completion-setup-code',
-`python-shell-completion-string-code',
`python-eldoc-setup-code',
`python-ffap-setup-code' can
customize this mode for different Python interpreters.
@@ -4244,8 +4260,9 @@ def __PYTHON_EL_get_completions(text):
completions = []
completer = None
+ import json
try:
- import readline
+ import readline, re
try:
import __builtin__
@@ -4256,16 +4273,29 @@ def __PYTHON_EL_get_completions(text):
is_ipython = ('__IPYTHON__' in builtins or
'__IPYTHON__active' in builtins)
- splits = text.split()
- is_module = splits and splits[0] in ('from', 'import')
-
- if is_ipython and is_module:
- from IPython.core.completerlib import module_completion
- completions = module_completion(text.strip())
- elif is_ipython and '__IP' in builtins:
- completions = __IP.complete(text)
- elif is_ipython and 'get_ipython' in builtins:
- completions = get_ipython().Completer.all_completions(text)
+
+ if is_ipython and 'get_ipython' in builtins:
+ def filter_c(prefix, c):
+ if re.match('_+(i?[0-9]+)?$', c):
+ return False
+ elif c[0] == '%' and not re.match('[%a-zA-Z]+$', prefix):
+ return False
+ return True
+
+ import IPython
+ try:
+ if IPython.version_info[0] >= 6:
+ from IPython.core.completer import provisionalcompleter
+ with provisionalcompleter():
+ completions = [
+ [c.text, c.start, c.end, c.type or '?',
c.signature or '']
+ for c in
get_ipython().Completer.completions(text, len(text))
+ if filter_c(text, c.text)]
+ else:
+ part, matches =
get_ipython().Completer.complete(line_buffer=text)
+ completions = [text + m[len(part):] for m in matches if
filter_c(text, m)]
+ except:
+ pass
else:
# Try to reuse current completer.
completer = readline.get_completer()
@@ -4288,7 +4318,7 @@ def __PYTHON_EL_get_completions(text):
finally:
if getattr(completer, 'PYTHON_EL_WRAPPED', False):
completer.print_mode = True
- return completions"
+ return json.dumps(completions)"
"Code used to setup completion in inferior Python processes."
:type 'string)
@@ -4329,6 +4359,10 @@ When a match is found, native completion is disabled."
:version "25.1"
:type 'float)
+(defvar python-shell-readline-completer-delims nil
+ "Word delimiters used by the readline completer.
+It is automatically set by Python shell.")
+
(defvar python-shell-completion-native-redirect-buffer
" *Python completions redirect*"
"Buffer to be used to redirect output of readline commands.")
@@ -4467,6 +4501,10 @@ def __PYTHON_EL_native_completion_setup():
__PYTHON_EL_native_completion_setup()" process)))
(when (string-match-p "python\\.el: native completion setup loaded"
output)
+ (setq-local python-shell-readline-completer-delims
+ (string-trim-right
+ (python-shell-send-string-no-output
+ "import readline;
print(readline.get_completer_delims())")))
(python-shell-completion-native-try))))
(defun python-shell-completion-native-turn-off (&optional msg)
@@ -4498,18 +4536,11 @@ With argument MSG show activation/deactivation message."
((python-shell-completion-native-setup)
(when msg
(message "Shell native completion is enabled.")))
- (t (lwarn
- '(python python-shell-completion-native-turn-on-maybe)
- :warning
- (concat
- "Your `python-shell-interpreter' doesn't seem to "
- "support readline, yet `python-shell-completion-native-enable' "
- (format "was t and %S is not part of the "
- (file-name-nondirectory python-shell-interpreter))
- "`python-shell-completion-native-disabled-interpreters' "
- "list. Native completions have been disabled locally. "
- "Consider installing the python package \"readline\". "))
- (python-shell-completion-native-turn-off msg))))))
+ (t
+ (when msg
+ (message (concat "Python does not use GNU readline;"
+ " no completion in multi-line commands.")))
+ (python-shell-completion-native-turn-off nil))))))
(defun python-shell-completion-native-turn-on-maybe-with-msg ()
"Like `python-shell-completion-native-turn-on-maybe' but force messages."
@@ -4534,6 +4565,8 @@ With argument MSG show activation/deactivation message."
(let* ((original-filter-fn (process-filter process))
(redirect-buffer (get-buffer-create
python-shell-completion-native-redirect-buffer))
+ (sep (if (string= python-shell-readline-completer-delims "")
+ "[\n\r]+" "[ \f\t\n\r\v()]+"))
(trigger "\t")
(new-input (concat input trigger))
(input-length
@@ -4576,28 +4609,80 @@ With argument MSG show activation/deactivation message."
process python-shell-completion-native-output-timeout
comint-redirect-finished-regexp)
(re-search-backward "0__dummy_completion__" nil t)
- (cl-remove-duplicates
- (split-string
- (buffer-substring-no-properties
- (line-beginning-position) (point-min))
- "[ \f\t\n\r\v()]+" t)
- :test #'string=))))
+ (let ((str (buffer-substring-no-properties
+ (line-beginning-position) (point-min))))
+ ;; The readline completer is allowed to return a list
+ ;; of (text start end type signature) as a JSON
+ ;; string. See the return value for IPython in
+ ;; `python-shell-completion-setup-code'.
+ (if (string= "[" (substring str 0 1))
+ (condition-case nil
+ (python--parse-json-array str)
+ (t (cl-remove-duplicates (split-string str sep t)
+ :test #'string=)))
+ (cl-remove-duplicates (split-string str sep t)
+ :test #'string=))))))
(set-process-filter process original-filter-fn)))))
(defun python-shell-completion-get-completions (process input)
"Get completions of INPUT using PROCESS."
(with-current-buffer (process-buffer process)
- (let ((completions
- (python-util-strip-string
- (python-shell-send-string-no-output
- (format
- "%s\nprint(';'.join(__PYTHON_EL_get_completions(%s)))"
+ (python--parse-json-array
+ (python-shell-send-string-no-output
+ (format "%s\nprint(__PYTHON_EL_get_completions(%s))"
python-shell-completion-setup-code
(python-shell--encode-string input))
- process))))
- (when (> (length completions) 2)
- (split-string completions
- "^'\\|^\"\\|;\\|'$\\|\"$" t)))))
+ process))))
+
+(defun python-shell--get-multiline-input ()
+ "Return lines at a multi-line input in Python shell."
+ (save-excursion
+ (let ((p (point)) lines)
+ (when (progn
+ (beginning-of-line)
+ (looking-back python-shell-prompt-block-regexp (pos-bol)))
+ (push (buffer-substring-no-properties (point) p) lines)
+ (while (progn (comint-previous-prompt 1)
+ (looking-back python-shell-prompt-block-regexp
(pos-bol)))
+ (push (buffer-substring-no-properties (point) (pos-eol)) lines))
+ (push (buffer-substring-no-properties (point) (pos-eol)) lines))
+ lines)))
+
+(defun python-shell--extra-completion-context ()
+ "Get extra completion context of current input in Python shell."
+ (let ((lines (python-shell--get-multiline-input))
+ (python-indent-guess-indent-offset nil))
+ (when (not (zerop (length lines)))
+ (with-temp-buffer
+ (delay-mode-hooks
+ (insert (string-join lines "\n"))
+ (python-mode)
+ (python-shell-completion-extra-context))))))
+
+(defun python-shell-completion-extra-context (&optional pos)
+ "Get extra completion context at position POS in Python buffer.
+If optional argument POS is nil, use current position.
+
+Readline completers could use current line as the completion
+context, which may be insufficient. In this function, extra
+context (e.g. multi-line function call) is found and reformatted
+as one line, which is required by native completion."
+ (let (bound p)
+ (save-excursion
+ (and pos (goto-char pos))
+ (setq bound (pos-bol))
+ (python-nav-up-list -1)
+ (when (and (< (point) bound)
+ (or
+ (looking-back
+ (python-rx (group (+ (or "." symbol-name)))) (pos-bol) t)
+ (progn
+ (forward-line 0)
+ (looking-at "^[ \t]*\\(from \\)"))))
+ (setq p (match-beginning 1))))
+ (when p
+ (replace-regexp-in-string
+ "\n[ \t]*" "" (buffer-substring-no-properties p (1- bound))))))
(defvar-local python-shell--capf-cache nil
"Variable to store cached completions and invalidation keys.")
@@ -4612,21 +4697,26 @@ using that one instead of current buffer's process."
;; Working on a shell buffer: use prompt end.
(cdr (python-util-comint-last-prompt))
(line-beginning-position)))
- (import-statement
- (when (string-match-p
- (rx (* space) word-start (or "from" "import") word-end space)
- (buffer-substring-no-properties line-start (point)))
- (buffer-substring-no-properties line-start (point))))
+ (no-delims
+ (and (not (if is-shell-buffer
+ (eq 'font-lock-comment-face
+ (get-text-property (1- (point)) 'face))
+ (python-syntax-context 'comment)))
+ (with-current-buffer (process-buffer process)
+ (if python-shell-completion-native-enable
+ (string= python-shell-readline-completer-delims "")
+ (string-match-p "ipython[23]?\\'"
python-shell-interpreter)))))
(start
(if (< (point) line-start)
(point)
(save-excursion
- (if (not (re-search-backward
- (python-rx
- (or whitespace open-paren close-paren
- string-delimiter simple-operator))
- line-start
- t 1))
+ (if (or no-delims
+ (not (re-search-backward
+ (python-rx
+ (or whitespace open-paren close-paren
+ string-delimiter simple-operator))
+ line-start
+ t 1)))
line-start
(forward-char (length (match-string-no-properties 0)))
(point)))))
@@ -4666,18 +4756,56 @@ using that one instead of current buffer's process."
(t #'python-shell-completion-native-get-completions))))
(prev-prompt (car python-shell--capf-cache))
(re (or (cadr python-shell--capf-cache) regexp-unmatchable))
- (prefix (buffer-substring-no-properties start end)))
+ (prefix (buffer-substring-no-properties start end))
+ (prefix-offset 0)
+ (extra-context (when no-delims
+ (if is-shell-buffer
+ (python-shell--extra-completion-context)
+ (python-shell-completion-extra-context))))
+ (extra-offset (length extra-context)))
+ (unless (zerop extra-offset)
+ (setq prefix (concat extra-context prefix)))
;; To invalidate the cache, we check if the prompt position or the
;; completion prefix changed.
(unless (and (equal prev-prompt (car prompt-boundaries))
- (string-match re prefix))
+ (string-match re prefix)
+ (setq prefix-offset (- (length prefix) (match-end 1))))
(setq python-shell--capf-cache
`(,(car prompt-boundaries)
,(if (string-empty-p prefix)
regexp-unmatchable
- (concat "\\`" (regexp-quote prefix)
"\\(?:\\sw\\|\\s_\\)*\\'"))
- ,@(funcall completion-fn process (or import-statement prefix)))))
- (list start end (cddr python-shell--capf-cache))))
+ (concat "\\`\\(" (regexp-quote prefix)
"\\)\\(?:\\sw\\|\\s_\\)*\\'"))
+ ,@(funcall completion-fn process prefix))))
+ (let ((cands (cddr python-shell--capf-cache)))
+ (cond
+ ((stringp (car cands))
+ (if no-delims
+ ;; Reduce completion candidates due to long prefix.
+ (if-let ((Lp (length prefix))
+ ((string-match "\\(\\sw\\|\\s_\\)+\\'" prefix))
+ (L (match-beginning 0)))
+ ;; If extra-offset is not zero:
+ ;; start end
+ ;; o------------------o---------o-------o
+ ;; |<- extra-offset ->|
+ ;; |<----------- L ------------>|
+ ;; new-start
+ (list (+ start L (- extra-offset)) end
+ (mapcar (lambda (s) (substring s L)) cands))
+ (list end end (mapcar (lambda (s) (substring s Lp)) cands)))
+ (list start end cands)))
+ ;; python-shell-completion(-native)-get-completions may produce a
+ ;; list of (text start end type signature) for completion.
+ ((consp (car cands))
+ (list (+ start (nth 1 (car cands)) (- extra-offset))
+ ;; Candidates may be cached, so the end position should
+ ;; be adjusted according to current completion prefix.
+ (+ start (nth 2 (car cands)) (- extra-offset) prefix-offset)
+ cands
+ :annotation-function
+ (lambda (c) (concat " " (nth 3 (assoc c cands))))
+ :company-docsig
+ (lambda (c) (nth 4 (assoc c cands)))))))))
(define-obsolete-function-alias
'python-shell-completion-complete-at-point
@@ -7000,6 +7128,8 @@ implementations: `python-mode' and `python-ts-mode'."
(add-to-list 'auto-mode-alist '("\\.py[iw]?\\'" . python-ts-mode))
(add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode))))
+(derived-mode-add-parents 'python-ts-mode '(python-mode))
+
;;; Completion predicates for M-x
;; Commands that only make sense when editing Python code.
(dolist (sym '(python-add-import
diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el
index 598eaa461ff..7133cb0b5b0 100644
--- a/lisp/progmodes/ruby-ts-mode.el
+++ b/lisp/progmodes/ruby-ts-mode.el
@@ -1133,6 +1133,7 @@ leading double colon is not added."
"singleton_class"
"module"
"method"
+ "singleton_method"
"array"
"hash"
"parenthesized_statements"
@@ -1178,6 +1179,19 @@ leading double colon is not added."
;; Imenu.
(setq-local imenu-create-index-function #'ruby-ts--imenu)
+ ;; Outline minor mode.
+ (setq-local treesit-outline-predicate
+ (rx bos (or "singleton_method"
+ "method"
+ "alias"
+ "class"
+ "module")
+ eos))
+ ;; Restore default values of outline variables
+ ;; to use `treesit-outline-predicate'.
+ (kill-local-variable 'outline-regexp)
+ (kill-local-variable 'outline-level)
+
(setq-local treesit-simple-indent-rules (ruby-ts--indent-rules))
;; Font-lock.
@@ -1196,19 +1210,11 @@ leading double colon is not added."
(setq-local syntax-propertize-function #'ruby-ts--syntax-propertize))
+(derived-mode-add-parents 'ruby-ts-mode '(ruby-mode))
+
(if (treesit-ready-p 'ruby)
- ;; Copied from ruby-mode.el.
- (add-to-list 'auto-mode-alist
- (cons (concat "\\(?:\\.\\(?:"
- "rbw?\\|ru\\|rake\\|thor"
- "\\|jbuilder\\|rabl\\|gemspec\\|podspec"
- "\\)"
- "\\|/"
- "\\(?:Gem\\|Rake\\|Cap\\|Thor"
- "\\|Puppet\\|Berks\\|Brew"
- "\\|Vagrant\\|Guard\\|Pod\\)file"
- "\\)\\'")
- 'ruby-ts-mode)))
+ (add-to-list 'major-mode-remap-defaults
+ '(ruby-mode . ruby-ts-mode)))
(provide 'ruby-ts-mode)
diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el
index c5fc57cc374..c67ac43e4d0 100644
--- a/lisp/progmodes/rust-ts-mode.el
+++ b/lisp/progmodes/rust-ts-mode.el
@@ -474,6 +474,8 @@ See `prettify-symbols-compose-predicate'."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'rust-ts-mode '(rust-mode))
+
(if (treesit-ready-p 'rust)
(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode)))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 43fb8a723bd..ab95dc9f924 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1639,6 +1639,8 @@ not written in Bash or sh."
(setq-local treesit-defun-type-regexp "function_definition")
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'bash-ts-mode '(sh-mode))
+
(advice-add 'bash-ts-mode :around #'sh--redirect-bash-ts-mode
;; Give it lower precedence than normal advice, so other
;; advices take precedence over it.
diff --git a/lisp/progmodes/typescript-ts-mode.el
b/lisp/progmodes/typescript-ts-mode.el
index e9c6afff440..ea4f6417c5a 100644
--- a/lisp/progmodes/typescript-ts-mode.el
+++ b/lisp/progmodes/typescript-ts-mode.el
@@ -199,183 +199,197 @@ Argument LANGUAGE is either `typescript' or `tsx'."
[(nested_identifier (identifier)) (identifier)]
@typescript-ts-jsx-tag-face)))))
+(defun tsx-ts-mode--font-lock-compatibility-function-expression (language)
+ "Handle tree-sitter grammar breaking change for `function' expression.
+
+LANGUAGE can be `typescript' or `tsx'. Starting from version 0.20.4 of the
+typescript/tsx grammar, `function' becomes `function_expression'."
+ (condition-case nil
+ (progn (treesit-query-capture language '((function_expression) @cap))
+ ;; New version of the grammar
+ 'function_expression)
+ (treesit-query-error
+ ;; Old version of the grammar
+ 'function)))
+
(defun typescript-ts-mode--font-lock-settings (language)
"Tree-sitter font-lock settings.
Argument LANGUAGE is either `typescript' or `tsx'."
- (treesit-font-lock-rules
- :language language
- :feature 'comment
- `([(comment) (hash_bang_line)] @font-lock-comment-face)
-
- :language language
- :feature 'constant
- `(((identifier) @font-lock-constant-face
- (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face))
- [(true) (false) (null)] @font-lock-constant-face)
-
- :language language
- :feature 'keyword
- `([,@typescript-ts-mode--keywords] @font-lock-keyword-face
- [(this) (super)] @font-lock-keyword-face)
-
- :language language
- :feature 'string
- `((regex pattern: (regex_pattern)) @font-lock-regexp-face
- (string) @font-lock-string-face
- (template_string) @js--fontify-template-string
- (template_substitution ["${" "}"] @font-lock-misc-punctuation-face))
-
- :language language
- :override t ;; for functions assigned to variables
- :feature 'declaration
- `((function
- name: (identifier) @font-lock-function-name-face)
- (function_declaration
- name: (identifier) @font-lock-function-name-face)
- (function_signature
- name: (identifier) @font-lock-function-name-face)
-
- (method_definition
- name: (property_identifier) @font-lock-function-name-face)
- (method_signature
- name: (property_identifier) @font-lock-function-name-face)
- (required_parameter (identifier) @font-lock-variable-name-face)
- (optional_parameter (identifier) @font-lock-variable-name-face)
-
- (variable_declarator
- name: (identifier) @font-lock-function-name-face
- value: [(function) (arrow_function)])
-
- (variable_declarator
- name: (identifier) @font-lock-variable-name-face)
-
- (enum_declaration (identifier) @font-lock-type-face)
-
- (extends_clause value: (identifier) @font-lock-type-face)
- ;; extends React.Component<T>
- (extends_clause value: (member_expression
- object: (identifier) @font-lock-type-face
- property: (property_identifier)
@font-lock-type-face))
-
- (arrow_function
- parameter: (identifier) @font-lock-variable-name-face)
-
- (variable_declarator
- name: (array_pattern
- (identifier)
- (identifier) @font-lock-function-name-face)
- value: (array (number) (function)))
-
- (catch_clause
- parameter: (identifier) @font-lock-variable-name-face)
-
- ;; full module imports
- (import_clause (identifier) @font-lock-variable-name-face)
- ;; named imports with aliasing
- (import_clause (named_imports (import_specifier
- alias: (identifier)
@font-lock-variable-name-face)))
- ;; named imports without aliasing
- (import_clause (named_imports (import_specifier
- !alias
- name: (identifier)
@font-lock-variable-name-face)))
-
- ;; full namespace import (* as alias)
- (import_clause (namespace_import (identifier)
@font-lock-variable-name-face)))
-
- :language language
- :feature 'identifier
- `((nested_type_identifier
- module: (identifier) @font-lock-type-face)
-
- (type_identifier) @font-lock-type-face
-
- (predefined_type) @font-lock-type-face
-
- (new_expression
- constructor: (identifier) @font-lock-type-face)
-
- (enum_body (property_identifier) @font-lock-type-face)
-
- (enum_assignment name: (property_identifier) @font-lock-type-face)
-
- (variable_declarator
- name: (identifier) @font-lock-variable-name-face)
-
- (for_in_statement
- left: (identifier) @font-lock-variable-name-face)
-
- (arrow_function
- parameters:
- [(_ (identifier) @font-lock-variable-name-face)
- (_ (_ (identifier) @font-lock-variable-name-face))
- (_ (_ (_ (identifier) @font-lock-variable-name-face)))]))
-
- :language language
- :feature 'property
- `((property_signature
- name: (property_identifier) @font-lock-property-name-face)
- (public_field_definition
- name: (property_identifier) @font-lock-property-name-face)
-
- (pair key: (property_identifier) @font-lock-property-use-face)
-
- ((shorthand_property_identifier) @font-lock-property-use-face))
-
- :language language
- :feature 'expression
- '((assignment_expression
- left: [(identifier) @font-lock-function-name-face
- (member_expression
- property: (property_identifier) @font-lock-function-name-face)]
- right: [(function) (arrow_function)]))
-
- :language language
- :feature 'function
- '((call_expression
- function:
- [(identifier) @font-lock-function-call-face
- (member_expression
- property: (property_identifier) @font-lock-function-call-face)]))
-
- :language language
- :feature 'pattern
- `((pair_pattern
- key: (property_identifier) @font-lock-property-use-face
- value: [(identifier) @font-lock-variable-name-face
- (assignment_pattern left: (identifier)
@font-lock-variable-name-face)])
-
- (array_pattern (identifier) @font-lock-variable-name-face)
-
- ((shorthand_property_identifier_pattern) @font-lock-variable-name-face))
-
- :language language
- :feature 'jsx
- (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language)
- `((jsx_attribute (property_identifier)
@typescript-ts-jsx-attribute-face)))
-
- :language language
- :feature 'number
- `((number) @font-lock-number-face
- ((identifier) @font-lock-number-face
- (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face)))
-
- :language language
- :feature 'operator
- `([,@typescript-ts-mode--operators] @font-lock-operator-face
- (ternary_expression ["?" ":"] @font-lock-operator-face))
-
- :language language
- :feature 'bracket
- '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face)
-
- :language language
- :feature 'delimiter
- '((["," "." ";" ":"]) @font-lock-delimiter-face)
-
- :language language
- :feature 'escape-sequence
- :override t
- '((escape_sequence) @font-lock-escape-face)))
+ (let ((func-exp (tsx-ts-mode--font-lock-compatibility-function-expression
language)))
+ (treesit-font-lock-rules
+ :language language
+ :feature 'comment
+ `([(comment) (hash_bang_line)] @font-lock-comment-face)
+
+ :language language
+ :feature 'constant
+ `(((identifier) @font-lock-constant-face
+ (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face))
+ [(true) (false) (null)] @font-lock-constant-face)
+
+ :language language
+ :feature 'keyword
+ `([,@typescript-ts-mode--keywords] @font-lock-keyword-face
+ [(this) (super)] @font-lock-keyword-face)
+
+ :language language
+ :feature 'string
+ `((regex pattern: (regex_pattern)) @font-lock-regexp-face
+ (string) @font-lock-string-face
+ (template_string) @js--fontify-template-string
+ (template_substitution ["${" "}"] @font-lock-misc-punctuation-face))
+
+ :language language
+ :override t ;; for functions assigned to variables
+ :feature 'declaration
+ `((,func-exp
+ name: (identifier) @font-lock-function-name-face)
+ (function_declaration
+ name: (identifier) @font-lock-function-name-face)
+ (function_signature
+ name: (identifier) @font-lock-function-name-face)
+
+ (method_definition
+ name: (property_identifier) @font-lock-function-name-face)
+ (method_signature
+ name: (property_identifier) @font-lock-function-name-face)
+ (required_parameter (identifier) @font-lock-variable-name-face)
+ (optional_parameter (identifier) @font-lock-variable-name-face)
+
+ (variable_declarator
+ name: (identifier) @font-lock-function-name-face
+ value: [(,func-exp) (arrow_function)])
+
+ (variable_declarator
+ name: (identifier) @font-lock-variable-name-face)
+
+ (enum_declaration (identifier) @font-lock-type-face)
+
+ (extends_clause value: (identifier) @font-lock-type-face)
+ ;; extends React.Component<T>
+ (extends_clause value: (member_expression
+ object: (identifier) @font-lock-type-face
+ property: (property_identifier)
@font-lock-type-face))
+
+ (arrow_function
+ parameter: (identifier) @font-lock-variable-name-face)
+
+ (variable_declarator
+ name: (array_pattern
+ (identifier)
+ (identifier) @font-lock-function-name-face)
+ value: (array (number) (,func-exp)))
+
+ (catch_clause
+ parameter: (identifier) @font-lock-variable-name-face)
+
+ ;; full module imports
+ (import_clause (identifier) @font-lock-variable-name-face)
+ ;; named imports with aliasing
+ (import_clause (named_imports (import_specifier
+ alias: (identifier)
@font-lock-variable-name-face)))
+ ;; named imports without aliasing
+ (import_clause (named_imports (import_specifier
+ !alias
+ name: (identifier)
@font-lock-variable-name-face)))
+
+ ;; full namespace import (* as alias)
+ (import_clause (namespace_import (identifier)
@font-lock-variable-name-face)))
+
+ :language language
+ :feature 'identifier
+ `((nested_type_identifier
+ module: (identifier) @font-lock-type-face)
+
+ (type_identifier) @font-lock-type-face
+
+ (predefined_type) @font-lock-type-face
+
+ (new_expression
+ constructor: (identifier) @font-lock-type-face)
+
+ (enum_body (property_identifier) @font-lock-type-face)
+
+ (enum_assignment name: (property_identifier) @font-lock-type-face)
+
+ (variable_declarator
+ name: (identifier) @font-lock-variable-name-face)
+
+ (for_in_statement
+ left: (identifier) @font-lock-variable-name-face)
+
+ (arrow_function
+ parameters:
+ [(_ (identifier) @font-lock-variable-name-face)
+ (_ (_ (identifier) @font-lock-variable-name-face))
+ (_ (_ (_ (identifier) @font-lock-variable-name-face)))]))
+
+ :language language
+ :feature 'property
+ `((property_signature
+ name: (property_identifier) @font-lock-property-name-face)
+ (public_field_definition
+ name: (property_identifier) @font-lock-property-name-face)
+
+ (pair key: (property_identifier) @font-lock-property-use-face)
+
+ ((shorthand_property_identifier) @font-lock-property-use-face))
+
+ :language language
+ :feature 'expression
+ `((assignment_expression
+ left: [(identifier) @font-lock-function-name-face
+ (member_expression
+ property: (property_identifier) @font-lock-function-name-face)]
+ right: [(,func-exp) (arrow_function)]))
+
+ :language language
+ :feature 'function
+ '((call_expression
+ function:
+ [(identifier) @font-lock-function-call-face
+ (member_expression
+ property: (property_identifier) @font-lock-function-call-face)]))
+
+ :language language
+ :feature 'pattern
+ `((pair_pattern
+ key: (property_identifier) @font-lock-property-use-face
+ value: [(identifier) @font-lock-variable-name-face
+ (assignment_pattern left: (identifier)
@font-lock-variable-name-face)])
+
+ (array_pattern (identifier) @font-lock-variable-name-face)
+
+ ((shorthand_property_identifier_pattern) @font-lock-variable-name-face))
+
+ :language language
+ :feature 'jsx
+ (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language)
+ `((jsx_attribute (property_identifier)
@typescript-ts-jsx-attribute-face)))
+
+ :language language
+ :feature 'number
+ `((number) @font-lock-number-face
+ ((identifier) @font-lock-number-face
+ (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face)))
+
+ :language language
+ :feature 'operator
+ `([,@typescript-ts-mode--operators] @font-lock-operator-face
+ (ternary_expression ["?" ":"] @font-lock-operator-face))
+
+ :language language
+ :feature 'bracket
+ '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face)
+
+ :language language
+ :feature 'delimiter
+ '((["," "." ";" ":"]) @font-lock-delimiter-face)
+
+ :language language
+ :feature 'escape-sequence
+ :override t
+ '((escape_sequence) @font-lock-escape-face))))
(defvar typescript-ts-mode--sentence-nodes
'("import_statement"
@@ -491,6 +505,8 @@ This mode is intended to be inherited by concrete major
modes."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'typescript-ts-mode '(typescript-mode))
+
(if (treesit-ready-p 'typescript)
(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)))
@@ -548,6 +564,8 @@ at least 3 (which is the default value)."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'tsx-ts-mode '(tsx-mode))
+
(defvar typescript-ts--s-p-query
(when (treesit-available-p)
(treesit-query-compile 'typescript
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 6081372af33..7af78f2229a 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -9,7 +9,7 @@
;; Keywords: languages
;; The "Version" is the date followed by the decimal rendition of the Git
;; commit hex.
-;; Version: 2023.06.06.141322628
+;; Version: 2024.03.01.121933719
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 19/3/2008, and the maintainer agreed that when a bug is
@@ -124,7 +124,7 @@
;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2023-06-06-86c6984-vpo-GNU"
+(defconst verilog-mode-version "2024-03-01-7448f97-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -2556,11 +2556,13 @@ find the errors."
(defconst verilog-assignment-operation-re-2
(concat "\\(.*?\\)" verilog-assignment-operator-re))
+;; Loosely related to IEEE 1800's concurrent_assertion_statement
+(defconst verilog-concurrent-assertion-statement-re
+
"\\(\\<\\(assert\\|assume\\|cover\\|restrict\\)\\>\\s-+\\<\\(property\\|sequence\\)\\>\\)\\|\\(\\<assert\\>\\)")
+
(defconst verilog-label-re (concat verilog-identifier-sym-re "\\s-*:\\s-*"))
(defconst verilog-property-re
- (concat "\\(" verilog-label-re "\\)?"
- ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>"
-
"\\(\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(assert\\)"))
+ (concat "\\(" verilog-label-re "\\)?"
verilog-concurrent-assertion-statement-re))
(defconst verilog-no-indent-begin-re
(eval-when-compile
@@ -2715,7 +2717,6 @@ find the errors."
"\\(\\<fork\\>\\)\\|" ; 7
"\\(\\<if\\>\\)\\|"
verilog-property-re "\\|"
- "\\(\\(" verilog-label-re "\\)?\\<assert\\>\\)\\|"
"\\(\\<clocking\\>\\)\\|"
"\\(\\<task\\>\\)\\|"
"\\(\\<function\\>\\)\\|"
@@ -4843,7 +4844,7 @@ Uses `verilog-scan' cache."
(not (or (looking-at "\\<") (forward-word-strictly -1)))
;; stop if we see an assertion (perhaps labeled)
(and
- (looking-at
"\\(\\w+\\W*:\\W*\\)?\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(\\<assert\\>\\)")
+ (looking-at (concat "\\(\\w+\\W*:\\W*\\)?"
verilog-concurrent-assertion-statement-re))
(progn
(setq h (point))
(save-excursion
@@ -4970,7 +4971,7 @@ More specifically, point @ in the line foo : @ begin"
(while t
(verilog-re-search-backward
(concat
"\\(\\<module\\>\\)\\|\\(\\<connectmodule\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|"
- "\\(\\<endcase\\>\\)\\>")
+ "\\(\\<endcase\\>\\)")
nil 'move)
(cond
((match-end 4)
@@ -5010,7 +5011,7 @@ More specifically, after a generate and before an
endgenerate."
(while (and
(/= nest 0)
(verilog-re-search-backward
-
"\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\>"
nil 'move)
+
"\\<\\(?:\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\)\\>"
nil 'move)
(cond
((match-end 1) ; module - we have crawled out
(throw 'done 1))
@@ -5038,7 +5039,7 @@ More specifically, after a generate and before an
endgenerate."
(save-excursion
(while (and
(/= nest 0)
- (verilog-re-search-backward
"\\<\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\>" lim 'move)
+ (verilog-re-search-backward
"\\<\\(?:\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\)\\>" lim 'move)
(cond
((match-end 1) ; fork
(setq nest (1- nest)))
@@ -5335,7 +5336,7 @@ primitive or interface named NAME."
(match-end 3)
(goto-char there)
(let ((nest 0)
- (reg
"\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(assert\\)"))
+ (reg
"\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(\\<assert\\>\\)"))
(catch 'skip
(while (verilog-re-search-backward reg nil
'move)
(cond
@@ -6244,7 +6245,7 @@ Return a list of two elements: (INDENT-TYPE
INDENT-LEVEL)."
(match-end 22))
(throw 'continue 'foo))
- ((looking-at "\\<class\\|struct\\|function\\|task\\>")
+ ((looking-at "\\<\\(?:class\\|struct\\|function\\|task\\)\\>")
;; *sigh* These words have an optional prefix:
;; extern {virtual|protected}? function a();
;; and we don't want to confuse this with
@@ -6268,12 +6269,16 @@ Return a list of two elements: (INDENT-TYPE
INDENT-LEVEL)."
(throw 'nesting 'defun))))
;;
- ((looking-at "\\<property\\>")
+ ((looking-at "\\<\\(property\\|sequence\\)\\>")
;; *sigh*
- ;; {assert|assume|cover} property (); are complete
- ;; and could also be labeled: - foo: assert property
- ;; but
- ;; property ID () ... needs endproperty
+ ;; - {assert|assume|cover|restrict} property (); are complete
+ ;; - cover sequence (); is complete
+ ;; and could also be labeled:
+ ;; - foo: assert property
+ ;; - bar: cover sequence
+ ;; but:
+ ;; - property ID () ... needs endproperty
+ ;; - sequence ID () ... needs endsequence
(verilog-beg-of-statement)
(if (looking-at verilog-property-re)
(throw 'continue 'statement) ; We don't need an endproperty
for these
@@ -6940,7 +6945,7 @@ Also move point to constraint."
(let ( (pt (point)) (pass 0))
(verilog-backward-ws&directives)
(verilog-backward-token)
- (if (looking-at (concat
"\\<constraint\\|coverpoint\\|cross\\|with\\>\\|" verilog-in-constraint-re))
+ (if (looking-at (concat
"\\<\\(?:constraint\\|coverpoint\\|cross\\|with\\)\\>\\|"
verilog-in-constraint-re))
(progn (setq pass 1)
(if (looking-at "\\<with\\>")
(progn (verilog-backward-ws&directives)
@@ -6981,7 +6986,7 @@ Also move point to constraint."
(save-excursion
(if (and (equal (char-after) ?\{)
(verilog-backward-token))
- (looking-at "\\<struct\\|union\\|packed\\|\\(un\\)?signed\\>")
+ (looking-at "\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>")
nil)))
(defun verilog-at-struct-mv-p ()
@@ -6989,7 +6994,7 @@ Also move point to constraint."
(let ((pt (point)))
(if (and (equal (char-after) ?\{)
(verilog-backward-token))
- (if (looking-at "\\<struct\\|union\\|packed\\|\\(un\\)?signed\\>")
+ (if (looking-at
"\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>")
(progn (verilog-beg-of-statement) (point))
(progn (goto-char pt) nil))
(progn (goto-char pt) nil))))
@@ -9675,7 +9680,7 @@ Return an array of [outputs inouts inputs wire reg assign
const gparam intf]."
(cond
;; {..., a, b} requires us to recurse on a,b
;; To support {#{},{#{a,b}} we'll just split everything on [{},]
- ((string-match "^\\s-*{\\(.*\\)}\\s-*$" expr)
+ ((string-match "^\\s-*'?{\\(.*\\)}\\s-*$" expr)
(let ((mlst (split-string (match-string 1 expr) "[{},]"))
mstr)
(while (setq mstr (pop mlst))
@@ -9755,7 +9760,10 @@ Inserts the list of signals found, using submodi to look
up each port."
;; We intentionally ignore (non-escaped) signals with .s in them
;; this prevents AUTOWIRE etc from noticing hierarchical sigs.
(when port
- (cond ((looking-at "[^\n]*AUTONOHOOKUP"))
+ (cond ((and verilog-auto-ignore-concat
+ (looking-at "[({]"))
+ nil) ; {...} or (...) historically ignored with
auto-ignore-concat
+ ((looking-at "[^\n]*AUTONOHOOKUP"))
((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)")
(verilog-read-sub-decls-sig
submoddecls par-values comment port
@@ -11436,7 +11444,7 @@ This repairs those mis-inserted by an AUTOARG."
(while (string-match
(concat "\\([[({:*/<>+-]\\)" ; - must be last
"(\\<\\([0-9A-Za-z_]+\\))"
- "\\([])}:*/<>+-]\\)")
+ "\\([])}:*/<>.+-]\\)")
out)
(setq out (replace-match "\\1\\2\\3" nil nil out)))
(while (string-match
@@ -11531,7 +11539,8 @@ This repairs those mis-inserted by an AUTOARG."
;;(verilog-simplify-range-expression "[(TEST[1])-1:0]")
;;(verilog-simplify-range-expression "[1<<2:8>>2]") ; [4:2]
;;(verilog-simplify-range-expression "[2*4/(4-2) +2+4 <<4 >>2]")
-;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]")
+;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]") ; "[WIDTH*2/8-1:0]"
+;;(verilog-simplify-range-expression "[(FOO).size:0]") ; "[FOO.size:0]"
(defun verilog-clog2 (value)
"Compute $clog2 - ceiling log2 of VALUE."
@@ -12247,18 +12256,12 @@ If PAR-VALUES replace final strings with these
parameter values."
(vl-memory (verilog-sig-memory port-st))
(vl-mbits (if (verilog-sig-multidim port-st)
(verilog-sig-multidim-string port-st) ""))
- (vl-bits (if (or (eq verilog-auto-inst-vector t)
- (and (eq verilog-auto-inst-vector `unsigned)
- (not (verilog-sig-signed port-st)))
- (not (assoc port (verilog-decls-get-signals
moddecls)))
- (not (equal (verilog-sig-bits port-st)
- (verilog-sig-bits
- (assoc port (verilog-decls-get-signals
moddecls))))))
- (or (verilog-sig-bits port-st) "")
- ""))
+ (vl-bits (or (verilog-sig-bits port-st) ""))
(case-fold-search nil)
(check-values par-values)
- tpl-net dflt-bits)
+ auto-inst-vector
+ auto-inst-vector-tpl
+ tpl-net dflt-bits)
;; Replace parameters in bit-width
(when (and check-values
(not (equal vl-bits "")))
@@ -12281,6 +12284,16 @@ If PAR-VALUES replace final strings with these
parameter values."
vl-mbits (verilog-simplify-range-expression vl-mbits)
vl-memory (when vl-memory (verilog-simplify-range-expression
vl-memory))
vl-width (verilog-make-width-expression vl-bits))) ; Not in the
loop for speed
+ (setq auto-inst-vector
+ (if (or (eq verilog-auto-inst-vector t)
+ (and (eq verilog-auto-inst-vector `unsigned)
+ (not (verilog-sig-signed port-st)))
+ (not (assoc port (verilog-decls-get-signals moddecls)))
+ (not (equal (verilog-sig-bits port-st)
+ (verilog-sig-bits
+ (assoc port (verilog-decls-get-signals
moddecls))))))
+ vl-bits
+ ""))
;; Default net value if not found
(setq dflt-bits (if (or (and (verilog-sig-bits port-st)
(verilog-sig-multidim port-st))
@@ -12290,7 +12303,7 @@ If PAR-VALUES replace final strings with these
parameter values."
(if vl-memory "." "")
(if vl-memory vl-memory "")
"*/")
- (concat vl-bits))
+ (concat auto-inst-vector))
tpl-net (concat port
(if (and vl-modport
;; .modport cannot be added if attachment is
@@ -12329,10 +12342,21 @@ If PAR-VALUES replace final strings with these
parameter values."
(if (numberp value) (setq value (number-to-string value)))
value))
(substring tpl-net (match-end 0))))))
+ ;; Get range based off template net
+ (setq auto-inst-vector-tpl
+ (if (or (eq verilog-auto-inst-vector t)
+ (and (eq verilog-auto-inst-vector `unsigned)
+ (not (verilog-sig-signed port-st)))
+ (not (assoc tpl-net (verilog-decls-get-signals moddecls)))
+ (not (equal (verilog-sig-bits port-st)
+ (verilog-sig-bits
+ (assoc tpl-net (verilog-decls-get-signals
moddecls))))))
+ vl-bits
+ ""))
;; Replace @ and [] magic variables in final output
(setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil
tpl-net))
(setq tpl-net (verilog-string-replace-matches "\\[\\]\\[\\]" dflt-bits
nil nil tpl-net))
- (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil
tpl-net)))
+ (setq tpl-net (verilog-string-replace-matches "\\[\\]"
auto-inst-vector-tpl nil nil tpl-net)))
;; Insert it
(when (or tpl-ass (not verilog-auto-inst-template-required))
(verilog--auto-inst-first indent-pt section)
@@ -12502,7 +12526,7 @@ Typing \\[verilog-auto] will make this into:
endmodule
Where the list of inputs and outputs came from the inst module.
-
+
Exceptions:
Unless you are instantiating a module multiple times, or the module is
@@ -12527,7 +12551,7 @@ Exceptions:
// Outputs
.o (o[31:0]));
-
+
Templates:
For multiple instantiations based upon a single template, create a
@@ -12598,7 +12622,7 @@ Templates:
.ptl_bus (ptl_busnew[3:0]),
....
-
+
Multiple Module Templates:
The same template lines can be applied to multiple modules with
@@ -12613,7 +12637,7 @@ Multiple Module Templates:
*/
Note there is only one AUTO_TEMPLATE opening parenthesis.
-
+
@ Templates:
It is common to instantiate a cell multiple times, so templates make it
@@ -12678,7 +12702,7 @@ Multiple Module Templates:
.ptl_mapvalidx (BAR_ptl_mapvalid),
.ptl_mapvalidp1x (ptl_mapvalid_BAR));
-
+
Regexp Templates:
A template entry of the form
@@ -12702,7 +12726,7 @@ Regexp Templates:
subscript:
.\\(.*\\)_l (\\1_[]),
-
+
Lisp Templates:
First any regular expression template is expanded.
@@ -12747,7 +12771,7 @@ Lisp Templates:
After the evaluation is completed, @ substitution and [] substitution
occur.
-
+
Ignoring Hookup:
AUTOWIRE and related AUTOs will read the signals created by a template.
@@ -12756,7 +12780,7 @@ Ignoring Hookup:
.pci_req_l (pci_req_not_to_wire), //AUTONOHOOKUP
-
+
For more information see the \\[verilog-faq] and forums at URL
`https://www.veripool.org'."
(save-excursion
@@ -12910,7 +12934,7 @@ Typing \\[verilog-auto] will make this into:
endmodule
Where the list of parameter connections come from the inst module.
-
+
Templates:
You can customize the parameter connections using AUTO_TEMPLATEs,
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index f52baf049aa..144bfa944d3 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -8398,6 +8398,44 @@ buffer."
(message "Updating sensitivity lists...done")))
(when noninteractive (save-buffer)))
+(defun vhdl--re2-region (beg-re end-re)
+ "Return a function searching for a region delimited by a pair of regexps.
+BEG-RE and END-RE are the regexps delimiting the region to search for."
+ (lambda (proc-end)
+ (when (vhdl-re-search-forward beg-re proc-end t)
+ (save-excursion
+ (vhdl-re-search-forward end-re proc-end t)))))
+
+(defconst vhdl--signal-regions-functions
+ (list
+ ;; right-hand side of signal/variable assignment
+ ;; (special case: "<=" is relational operator in a condition)
+ (vhdl--re2-region "[<:]="
+ ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>")
+ ;; if condition
+ (vhdl--re2-region "^\\s-*if\\>" "\\<then\\>")
+ ;; elsif condition
+ (vhdl--re2-region "\\<elsif\\>" "\\<then\\>")
+ ;; while loop condition
+ (vhdl--re2-region "^\\s-*while\\>" "\\<loop\\>")
+ ;; exit/next condition
+ (vhdl--re2-region "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ";")
+ ;; assert condition
+ (vhdl--re2-region "\\<assert\\>" "\\(\\<report\\>\\|\\<severity\\>\\|;\\)")
+ ;; case expression
+ (vhdl--re2-region "^\\s-*case\\>" "\\<is\\>")
+ ;; parameter list of procedure call, array index
+ (lambda (proc-end)
+ (when (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t)
+ (forward-char -1)
+ (save-excursion
+ (forward-sexp)
+ (while (looking-at "(") (forward-sexp)) (point)))))
+ "Define syntactic regions where signals are read.
+Each function is called with one arg (a limit for the (forward) search) and
+should return either nil or the end position of the region (in which case
+point will be set to its beginning).")
+
(defun vhdl-update-sensitivity-list ()
"Update sensitivity list."
(let ((proc-beg (point))
@@ -8418,35 +8456,6 @@ buffer."
(let
;; scan for visible signals
((visible-list (vhdl-get-visible-signals))
- ;; define syntactic regions where signals are read
- (scan-regions-list
- `(;; right-hand side of signal/variable assignment
- ;; (special case: "<=" is relational operator in a condition)
- ((vhdl-re-search-forward "[<:]=" ,proc-end t)
- (vhdl-re-search-forward
";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" ,proc-end t))
- ;; if condition
- ((vhdl-re-search-forward "^\\s-*if\\>" ,proc-end t)
- (vhdl-re-search-forward "\\<then\\>" ,proc-end t))
- ;; elsif condition
- ((vhdl-re-search-forward "\\<elsif\\>" ,proc-end t)
- (vhdl-re-search-forward "\\<then\\>" ,proc-end t))
- ;; while loop condition
- ((vhdl-re-search-forward "^\\s-*while\\>" ,proc-end t)
- (vhdl-re-search-forward "\\<loop\\>" ,proc-end t))
- ;; exit/next condition
- ((vhdl-re-search-forward
"\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ,proc-end t)
- (vhdl-re-search-forward ";" ,proc-end t))
- ;; assert condition
- ((vhdl-re-search-forward "\\<assert\\>" ,proc-end t)
- (vhdl-re-search-forward
"\\(\\<report\\>\\|\\<severity\\>\\|;\\)" ,proc-end t))
- ;; case expression
- ((vhdl-re-search-forward "^\\s-*case\\>" ,proc-end t)
- (vhdl-re-search-forward "\\<is\\>" ,proc-end t))
- ;; parameter list of procedure call, array index
- ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*("
,proc-end t)
- (1- (point)))
- (progn (backward-char) (forward-sexp)
- (while (looking-at "(") (forward-sexp)) (point)))))
name field read-list sens-list signal-list tmp-list
sens-beg sens-end beg end margin)
;; scan for signals in old sensitivity list
@@ -8475,11 +8484,9 @@ buffer."
(push (cons end (point)) seq-region-list)
(beginning-of-line)))
;; scan for signals read in process
- (while scan-regions-list
+ (dolist (scan-fun vhdl--signal-regions-functions)
(goto-char proc-mid)
- (while (and (setq beg (eval (nth 0 (car scan-regions-list))))
- (setq end (eval (nth 1 (car scan-regions-list)))))
- (goto-char beg)
+ (while (setq end (funcall scan-fun proc-end))
(unless (or (vhdl-in-literal)
(and seq-region-list
(let ((tmp-list seq-region-list))
@@ -8518,8 +8525,7 @@ buffer."
(car tmp-list))
(setq read-list (delete (car tmp-list) read-list)))
(setq tmp-list (cdr tmp-list)))))
- (goto-char (match-end 1)))))
- (setq scan-regions-list (cdr scan-regions-list)))
+ (goto-char (match-end 1))))))
;; update sensitivity list
(goto-char sens-beg)
(if sens-end
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index bd68672f905..b36e13104e3 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -211,7 +211,7 @@ non-nil.")
(when which-function-mode
(unless (local-variable-p 'which-func-mode)
(setq which-func-mode (or (eq which-func-modes t)
- (member major-mode which-func-modes)))
+ (derived-mode-p which-func-modes)))
(setq which-func--use-mode-line
(member which-func-display '(mode mode-and-header)))
(setq which-func--use-header-line
@@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary."
(condition-case err
(if (and which-func-mode
- (not (member major-mode which-func-non-auto-modes))
+ (not (derived-mode-p which-func-non-auto-modes))
(or (null which-func-maxout)
(< buffer-saved-size which-func-maxout)
(= which-func-maxout 0)))
diff --git a/lisp/replace.el b/lisp/replace.el
index fa460a16063..49e7c85c487 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2916,7 +2916,7 @@ characters."
;; If last typed key in previous call of multi-buffer perform-replace
;; was `automatic-all', don't ask more questions in next files
- (when (eq (lookup-key map (vector last-input-event)) 'automatic-all)
+ (when (eq (lookup-key map (vector last-input-event) t) 'automatic-all)
(setq query-flag nil multi-buffer t))
(cond
@@ -3100,7 +3100,7 @@ characters."
;; read-event that clobbers the match data.
(set-match-data real-match-data)
(setq key (vector key))
- (setq def (lookup-key map key))
+ (setq def (lookup-key map key t))
;; Restore the match data while we process the command.
(cond ((eq def 'help)
(let ((display-buffer-overriding-action
diff --git a/lisp/server.el b/lisp/server.el
index 66e6d729f8a..b65053267a6 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1439,7 +1439,11 @@ invocations of \"emacs\".")
;; including code that needs to wait.
(with-local-quit
(condition-case err
- (let ((buffers (server-visit-files files proc nowait)))
+ (let ((buffers (server-visit-files files proc nowait))
+ ;; On Android, the Emacs server generally can't provide
+ ;; feedback to the user except by means of dialog boxes,
+ ;; which are displayed in the GUI emacsclient wrapper.
+ (use-dialog-box-override (featurep 'android)))
(mapc 'funcall (nreverse commands))
(let ((server-eval-args-left (nreverse evalexprs)))
(while server-eval-args-left
diff --git a/lisp/simple.el b/lisp/simple.el
index 9a33049f4ca..f127290231b 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10858,6 +10858,87 @@ and setting it to nil."
(setq-local vis-mode-saved-buffer-invisibility-spec
buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
+
+
+(defvar read-passwd--mode-line-buffer nil
+ "Buffer to modify `mode-line-format' for showing/hiding passwords.")
+
+(defvar read-passwd--mode-line-icon nil
+ "Propertized mode line icon for showing/hiding passwords.")
+
+(defun read-passwd-toggle-visibility ()
+ "Toggle minibuffer contents visibility.
+Adapt also mode line."
+ (interactive)
+ (setq read-passwd--hide-password (not read-passwd--hide-password))
+ (with-current-buffer read-passwd--mode-line-buffer
+ (setq read-passwd--mode-line-icon
+ `(:propertize
+ ,(if icon-preference
+ (icon-string
+ (if read-passwd--hide-password
+ 'read-passwd--show-password-icon
+ 'read-passwd--hide-password-icon))
+ "")
+ mouse-face mode-line-highlight
+ local-map
+ (keymap
+ (mode-line keymap (mouse-1 . read-passwd-toggle-visibility)))))
+ (force-mode-line-update))
+ (read-passwd--hide-password))
+
+(define-minor-mode read-passwd-mode
+ "Toggle visibility of password in minibuffer."
+ :group 'mode-line
+ :group 'minibuffer
+ :keymap read-passwd-map
+ :version "30.1"
+
+ (require 'icons)
+ ;; It would be preferable to use "👁" ("\N{EYE}"). However, there is
+ ;; no corresponding Unicode char with a slash. So we use symbols as
+ ;; fallback only, with "⦵" ("\N{CIRCLE WITH HORIZONTAL BAR}") for
+ ;; hiding the password.
+ (define-icon read-passwd--show-password-icon nil
+ '((image "reveal.svg" "reveal.pbm" :height (0.8 . em))
+ (symbol "👁")
+ (text "<o>"))
+ "Mode line icon to show a hidden password."
+ :group mode-line-faces
+ :version "30.1"
+ :help-echo "mouse-1: Toggle password visibility")
+ (define-icon read-passwd--hide-password-icon nil
+ '((image "conceal.svg" "conceal.pbm" :height (0.8 . em))
+ (symbol "⦵")
+ (text "<\\>"))
+ "Mode line icon to hide a visible password."
+ :group mode-line-faces
+ :version "30.1"
+ :help-echo "mouse-1: Toggle password visibility")
+
+ (setq read-passwd--hide-password nil
+ ;; Stolen from `eldoc-minibuffer-message'.
+ read-passwd--mode-line-buffer
+ (window-buffer
+ (or (window-in-direction 'above (minibuffer-window))
+ (minibuffer-selected-window)
+ (get-largest-window))))
+
+ (if read-passwd-mode
+ (with-current-buffer read-passwd--mode-line-buffer
+ ;; Add `read-passwd--mode-line-icon'.
+ (when (listp mode-line-format)
+ (setq mode-line-format
+ (cons '(:eval read-passwd--mode-line-icon)
+ mode-line-format))))
+ (with-current-buffer read-passwd--mode-line-buffer
+ ;; Remove `read-passwd--mode-line-icon'.
+ (when (listp mode-line-format)
+ (setq mode-line-format (cdr mode-line-format)))))
+
+ (when read-passwd-mode
+ (read-passwd-toggle-visibility)))
+
(defvar messages-buffer-mode-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 1cb72dc23e6..2ed97986fe7 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -3488,7 +3488,7 @@ functions to do caching and flushing if appropriate."
nil
-(eval-when-compile (condition-case nil (require 'imenu) (error nil)))
+(eval-when-compile (require 'imenu))
(declare-function imenu--make-index-alist "imenu" (&optional no-error))
(defun speedbar-fetch-dynamic-imenu (file)
diff --git a/lisp/startup.el b/lisp/startup.el
index 0a2ab7011b3..a796129f013 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -556,6 +556,17 @@ the updated value."
(setq startup--original-eln-load-path
(copy-sequence native-comp-eln-load-path))))
+(defun startup--rescale-elt-match-p (font-pattern font-object)
+ "Test whether FONT-OBJECT matches an element of `face-font-rescale-alist'.
+FONT-OBJECT is a font-object that specifies a font to test.
+FONT-PATTERN is the car of an element of `face-font-rescale-alist',
+which can be either a regexp matching a font name or a font-spec."
+ (if (stringp font-pattern)
+ ;; FONT-PATTERN is a regexp, we need the name of FONT-OBJECT to match.
+ (string-match-p font-pattern (font-xlfd-name font-object))
+ ;; FONT-PATTERN is a font-spec.
+ (font-match-p font-pattern font-object)))
+
(defvar android-fonts-enumerated nil
"Whether or not fonts have been enumerated already.
On Android, Emacs uses this variable internally at startup.")
@@ -821,8 +832,9 @@ It is the default value of the variable `top-level'."
(when (and (display-multi-font-p)
(not (eq face-font-rescale-alist
old-face-font-rescale-alist))
- (assoc (font-xlfd-name (face-attribute 'default :font))
- face-font-rescale-alist #'string-match-p))
+ (assoc (face-attribute 'default :font)
+ face-font-rescale-alist
+ #'startup--rescale-elt-match-p))
(set-face-attribute 'default nil :font (font-spec)))
;; Modify the initial frame based on what .emacs puts into
@@ -1632,7 +1644,9 @@ Consider using a subdirectory instead, e.g.: %s"
(let ((dn (daemonp)))
(when dn
(when (stringp dn) (setq server-name dn))
- (server-start)
+ (condition-case err
+ (server-start)
+ (error (error "Unable to start daemon: %s; exiting"
(error-message-string err))))
(if server-process
(daemon-initialized)
(if (stringp dn)
@@ -2031,10 +2045,6 @@ a face or button specification."
(call-interactively
'recover-session)))
" to recover the files you were editing."))))
- ;; Insert the permissions notice if the user has yet to grant Emacs
- ;; storage permissions.
- (when (fboundp 'android-after-splash-screen)
- (funcall 'android-after-splash-screen t))
(when concise
(fancy-splash-insert
:face 'variable-pitch "\n"
@@ -2087,6 +2097,10 @@ splash screen in another window."
(make-local-variable 'startup-screen-inhibit-startup-screen)
(if pure-space-overflow
(insert pure-space-overflow-message))
+ ;; Insert the permissions notice if the user has yet to grant Emacs
+ ;; storage permissions.
+ (when (fboundp 'android-before-splash-screen)
+ (funcall 'android-before-splash-screen t))
(unless concise
(fancy-splash-head))
(dolist (text fancy-startup-text)
@@ -2193,7 +2207,10 @@ splash screen in another window."
(if pure-space-overflow
(insert pure-space-overflow-message))
-
+ ;; Insert the permissions notice if the user has yet to grant
+ ;; Emacs storage permissions.
+ (when (fboundp 'android-before-splash-screen)
+ (funcall 'android-before-splash-screen nil))
;; The convention for this piece of code is that
;; each piece of output starts with one or two newlines
;; and does not end with any newlines.
@@ -2235,12 +2252,6 @@ splash screen in another window."
(insert "\n\nIf an Emacs session crashed recently, "
"type M-x recover-session RET\nto recover"
" the files you were editing.\n"))
-
- ;; Insert the permissions notice if the user has yet to grant
- ;; Emacs storage permissions.
- (when (fboundp 'android-after-splash-screen)
- (funcall 'android-after-splash-screen nil))
-
(use-local-map splash-screen-keymap)
;; Display the input that we set up in the buffer.
diff --git a/lisp/subr.el b/lisp/subr.el
index a9b30a1aa6a..89ff1338f70 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1,7 +1,6 @@
;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2024 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2024 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
@@ -2581,6 +2580,8 @@ Affects only hooks run in the current buffer."
(list binding binding))
((null (cdr binding))
(list (make-symbol "s") (car binding)))
+ ((eq '_ (car binding))
+ (list (make-symbol "s") (cadr binding)))
(t binding)))
(when (> (length binding) 2)
(signal 'error
@@ -2621,7 +2622,7 @@ This is like `when-let' but doesn't handle a VARLIST of
the form
(defmacro and-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
Like `when-let*', except if BODY is empty and all the bindings
-are non-nil, then the result is non-nil."
+are non-nil, then the result is the value of the last binding."
(declare (indent 1) (debug if-let*))
(let (res)
(if varlist
@@ -2634,7 +2635,8 @@ are non-nil, then the result is non-nil."
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
binding value is nil. If all are non-nil return the value of
-THEN, otherwise the last form in ELSE.
+THEN, otherwise the value of the last form in ELSE, or nil if
+there are none.
Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
SYMBOL to the value of VALUEFORM. An element can additionally be
@@ -3376,14 +3378,23 @@ with Emacs. Do not call it directly in your own
packages."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570
+ (define-key map "\t" #'read-passwd-toggle-visibility)
map)
"Keymap used while reading passwords.")
-(defun read-password--hide-password ()
+(defvar read-passwd--hide-password t)
+
+(defun read-passwd--hide-password ()
+ "Make password in minibuffer hidden or visible."
(let ((beg (minibuffer-prompt-end)))
(dotimes (i (1+ (- (buffer-size) beg)))
- (put-text-property (+ i beg) (+ 1 i beg)
- 'display (string (or read-hide-char ?*))))))
+ (if read-passwd--hide-password
+ (put-text-property
+ (+ i beg) (+ 1 i beg) 'display (string (or read-hide-char ?*)))
+ (remove-list-of-text-properties (+ i beg) (+ 1 i beg) '(display)))
+ (put-text-property
+ (+ i beg) (+ 1 i beg)
+ 'help-echo "C-u: Clear password\nTAB: Toggle password visibility"))))
(defun read-passwd (prompt &optional confirm default)
"Read a password, prompting with PROMPT, and return it.
@@ -3421,18 +3432,20 @@ by doing (clear-string STRING)."
(setq-local inhibit-modification-hooks nil) ;bug#15501.
(setq-local show-paren-mode nil) ;bug#16091.
(setq-local inhibit--record-char t)
- (add-hook 'post-command-hook #'read-password--hide-password nil t))
+ (read-passwd-mode 1)
+ (add-hook 'post-command-hook #'read-passwd--hide-password nil t))
(unwind-protect
(let ((enable-recursive-minibuffers t)
(read-hide-char (or read-hide-char ?*)))
(read-string prompt nil t default)) ; t = "no history"
(when (buffer-live-p minibuf)
(with-current-buffer minibuf
+ (read-passwd-mode -1)
;; Not sure why but it seems that there might be cases where the
;; minibuffer is not always properly reset later on, so undo
;; whatever we've done here (bug#11392).
(remove-hook 'after-change-functions
- #'read-password--hide-password 'local)
+ #'read-passwd--hide-password 'local)
(kill-local-variable 'post-self-insert-hook)
;; And of course, don't keep the sensitive data around.
(erase-buffer))))))))
@@ -3727,10 +3740,10 @@ There is no need to explicitly add `help-char' to CHARS;
(this-command this-command)
(result (minibuffer-with-setup-hook
(lambda ()
+ (setq-local post-self-insert-hook nil)
(add-hook 'post-command-hook
(lambda ()
- ;; FIXME: Should we use `<='?
- (if (= (1+ (minibuffer-prompt-end))
+ (if (<= (1+ (minibuffer-prompt-end))
(point-max))
(exit-minibuffer)))
nil 'local))
@@ -3830,15 +3843,25 @@ confusing to some users.")
(defvar from--tty-menu-p nil
"Non-nil means the current command was invoked from a TTY menu.")
+
+(declare-function android-detect-keyboard "androidfns.c")
+
+(defvar use-dialog-box-override nil
+ "Whether `use-dialog-box-p' should always return t.")
+
(defun use-dialog-box-p ()
"Return non-nil if the current command should prompt the user via a dialog
box."
- (and last-input-event ; not during startup
- (or (consp last-nonmenu-event) ; invoked by a mouse event
- (and (null last-nonmenu-event)
- (consp last-input-event))
- (featurep 'android) ; Prefer dialog boxes on Android.
- from--tty-menu-p) ; invoked via TTY menu
- use-dialog-box))
+ (or use-dialog-box-override
+ (and last-input-event ; not during startup
+ (or (consp last-nonmenu-event) ; invoked by a mouse event
+ (and (null last-nonmenu-event)
+ (consp last-input-event))
+ (and (featurep 'android) ; Prefer dialog boxes on
+ ; Android.
+ (not (android-detect-keyboard))) ; If no keyboard is
+ ; connected.
+ from--tty-menu-p) ; invoked via TTY menu
+ use-dialog-box)))
;; Actually in textconv.c.
(defvar overriding-text-conversion-style)
@@ -5016,7 +5039,7 @@ read-only, and scans it for function and variable names
to make them into
clickable cross-references.
See the related form `with-temp-buffer-window'."
- (declare (debug t))
+ (declare (debug t) (indent 1))
(let ((old-dir (make-symbol "old-dir"))
(buf (make-symbol "buf")))
`(let* ((,old-dir default-directory)
@@ -6736,6 +6759,8 @@ effectively rounded up."
(progress-reporter-update reporter (or current-value min-value))
reporter))
+(defalias 'progress-reporter-make #'make-progress-reporter)
+
(defun progress-reporter-force-update (reporter &optional value new-message
suffix)
"Report progress of an operation in the echo area unconditionally.
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 3e1d8278b04..61efa332e0b 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -1385,6 +1385,14 @@ inherits the current tab's `explicit-name' parameter."
tabs))))
+(defcustom tab-bar-tab-post-select-functions nil
+ "List of functions to call after selecting a tab.
+Two arguments are supplied: the previous tab that was selected before,
+and the newly selected tab."
+ :type '(repeat function)
+ :group 'tab-bar
+ :version "30.1")
+
(defvar tab-bar-minibuffer-restore-tab nil
"Tab number for `tab-bar-minibuffer-restore-tab'.")
@@ -1499,7 +1507,10 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
(tab-bar--current-tab-make (nth to-index tabs)))
(unless tab-bar-mode
- (message "Selected tab '%s'" (alist-get 'name to-tab))))
+ (message "Selected tab '%s'" (alist-get 'name to-tab)))
+
+ (run-hook-with-args 'tab-bar-tab-post-select-functions
+ from-tab to-tab))
(force-mode-line-update))))
diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el
index e0d252f17e0..1d10402b15d 100644
--- a/lisp/term/android-win.el
+++ b/lisp/term/android-win.el
@@ -398,7 +398,7 @@ directory /content/storage.
(inhibit-read-only t))
(fill-region (point-min) (point-max))))))))
-(defun android-after-splash-screen (fancy-p)
+(defun android-before-splash-screen (fancy-p)
"Insert a brief notice on the absence of storage permissions.
If storage permissions are as yet denied to Emacs, insert a short
notice to that effect, followed by a button that enables the user
@@ -412,14 +412,14 @@ screen display; see `fancy-splash-insert'."
(fancy-splash-insert
:face '(variable-pitch
font-lock-function-call-face)
- "\nPermissions necessary to access external storage directories have
-been denied. Click "
+ "Permissions necessary to access external storage directories have"
+ "\nbeen denied. Click "
:link '("here" android-display-storage-permission-popup)
- " to grant them.")
+ " to grant them.\n")
(insert
- "\nPermissions necessary to access external storage directories have
been
-denied. ")
- (insert-button "Click here to grant them."
+ "Permissions necessary to access external storage directories"
+ "\nhave been denied. ")
+ (insert-button "Click here to grant them.\n"
'action #'android-display-storage-permission-popup
'follow-link t)
(newline))))
@@ -480,5 +480,49 @@ the UTF-8 coding system."
(concat locale-base locale-modifier)))
+;; Miscellaneous functions.
+
+(declare-function android-browse-url-internal "androidselect.c")
+
+(defun android-browse-url (url &optional send)
+ "Open URL in an external application.
+
+URL should be a URL-encoded URL with a scheme specified unless
+SEND is non-nil. Signal an error upon failure.
+
+If SEND is nil, start a program that is able to display the URL,
+such as a web browser. Otherwise, try to share URL using
+programs such as email clients.
+
+If URL is a file URI, convert it into a `content' address
+accessible to other programs."
+ (when-let* ((uri (url-generic-parse-url url))
+ (filename (url-filename uri))
+ ;; If `uri' is a file URI and the file resides in /content
+ ;; or /assets, copy it to a temporary file before
+ ;; providing it to other programs.
+ (replacement-url (and (string-match-p
+ "/\\(content\\|assets\\)[/$]"
+ filename)
+ (prog1 t
+ (copy-file
+ filename
+ (setq filename
+ (make-temp-file
+ "local"
+ nil
+ (let ((extension
+ (file-name-extension
+ filename)))
+ (if extension
+ (concat "."
+ extension)
+ nil))))
+ t))
+ (concat "file://" filename))))
+ (setq url replacement-url))
+ (android-browse-url-internal url send))
+
+
(provide 'android-win)
;; android-win.el ends here.
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 425f3ec8a30..f5a20e0ca0e 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1830,6 +1830,8 @@ can also be used to fill comments.
(add-to-list 'auto-mode-alist '("\\.css\\'" . css-ts-mode))))
+(derived-mode-add-parents 'css-ts-mode '(css-mode))
+
;;;###autoload
(define-derived-mode css-mode css-base-mode "CSS"
"Major mode to edit Cascading Style Sheets (CSS).
diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el
index 301f3e8791c..235e1055fa9 100644
--- a/lisp/textmodes/html-ts-mode.el
+++ b/lisp/textmodes/html-ts-mode.el
@@ -121,8 +121,21 @@ 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)))
+
+ ;; Outline minor mode.
+ (setq-local treesit-outline-predicate "\\`element\\'")
+ ;; `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
+ ;; to use `treesit-outline-predicate' above.
+ (kill-local-variable 'outline-regexp)
+ (kill-local-variable 'outline-heading-end-regexp)
+ (kill-local-variable 'outline-level)
+
(treesit-major-mode-setup))
+(derived-mode-add-parents 'html-ts-mode '(html-mode))
+
(if (treesit-ready-p 'html)
(add-to-list 'auto-mode-alist '("\\.html\\'" . html-ts-mode)))
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index a0bc5c11ece..791b10412c9 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -235,11 +235,10 @@ distribution. Mixed-case symbols are convenience
aliases.")
"ConTeXt bib module"
((?\C-m . "\\cite[%l]")
(?s . "\\cite[][%l]")
- (?n . "\\nocite[%l]")))
- )
+ (?n . "\\nocite[%l]"))))
"Builtin versions of the citation format.
The following conventions are valid for all alist entries:
-`?\C-m' should always point to a straight \\cite{%l} macro.
+`?\\C-m' should always point to a straight \\cite{%l} macro.
`?t' should point to a textual citation (citation as a noun).
`?p' should point to a parenthetical citation.")
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 2cd78943883..5fbff4ba888 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -1147,14 +1147,14 @@ as well but give an additional message."
(unless (fboundp forwarder-function)
(defalias forwarder-function
(lambda ()
+ (:documentation
+ (format "Deprecated binding for %s, use \\[%s] instead."
+ def def))
(interactive)
(call-interactively def)
(message "[Deprecated use of key %s; use key %s instead]"
(key-description (this-command-keys))
- (key-description key)))
- ;; FIXME: In Emacs-25 we could use (:documentation ...) instead.
- (format "Deprecated binding for %s, use \\[%s] instead."
- def def)))
+ (key-description key)))))
(dolist (dep-key deprecated)
(define-key keymap dep-key forwarder-function)))))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 8968d8ec23b..02ee1242c72 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -511,17 +511,26 @@ An alternative value is \" . \", if you use a font with a
narrow period."
;; This would allow highlighting \newcommand\CMD but requires
;; adapting subgroup numbers below.
;; (arg
"\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)"))
- (inbraces-re (lambda (re)
- (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)")))
- (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)")))
- `( ;; Highlight $$math$$ and $math$.
+ (inbraces-re
+ (lambda (n) ;; Level of nesting of braces we should support.
+ (let ((re "[^}]"))
+ (dotimes (_ n)
+ (setq re
+ (concat "\\(?:[^{}\\]\\|\\\\.\\|{" re "*}\\)")))
+ re)))
+ (arg (concat "{\\(" (funcall inbraces-re 2) "+\\)")))
+ `(;; Verbatim-like args.
+ ;; Do it first, because we don't want to highlight them
+ ;; in comments (bug#68827), but we do want to highlight them
+ ;; in $math$.
+ (,(concat slash verbish opt arg) 3 'tex-verbatim keep)
+ ;; Highlight $$math$$ and $math$.
;; This is done at the very beginning so as to interact with the other
;; keywords in the same way as comments and strings.
(,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{"
- (funcall inbraces-re
- (concat "{" (funcall inbraces-re "{[^}]*}") "*}"))
+ (funcall inbraces-re 6)
"*}\\)+\\$?\\$")
- (0 'tex-math))
+ (0 'tex-math keep))
;; Heading args.
(,(concat slash headings "\\*?" opt arg)
;; If ARG ends up matching too much (if the {} don't match, e.g.)
@@ -543,8 +552,6 @@ An alternative value is \" . \", if you use a font with a
narrow period."
(,(concat slash variables " *" arg) 2 font-lock-variable-name-face)
;; Include args.
(,(concat slash includes opt arg) 3 font-lock-builtin-face)
- ;; Verbatim-like args.
- (,(concat slash verbish opt arg) 3 'tex-verbatim t)
;; Definitions. I think.
("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)"
1 font-lock-function-name-face))))
@@ -602,14 +609,14 @@ An alternative value is \" . \", if you use a font with a
narrow period."
(list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t)
"\\(\\(.\\|\n\\)+?\\)"
(regexp-opt `("''" "\">" "\"'" ">>" "»") t))
- '(1 font-lock-keyword-face)
- '(2 font-lock-string-face)
- '(4 font-lock-keyword-face))
+ '(1 'font-lock-keyword-face)
+ '(2 'font-lock-string-face)
+ '(4 'font-lock-keyword-face))
;;
;; Command names, special and general.
(cons (concat slash specials-1) 'font-lock-warning-face)
(list (concat "\\(" slash specials-2 "\\)\\([^a-zA-Z@]\\|\\'\\)")
- 1 'font-lock-warning-face)
+ '(1 'font-lock-warning-face))
(concat slash general)
;;
;; Font environments. It seems a bit dubious to use `bold' etc. faces
@@ -677,7 +684,7 @@ An alternative value is \" . \", if you use a font with a
narrow period."
(eval-when-compile
(defconst tex-syntax-propertize-rules
(syntax-propertize-precompile-rules
- ("\\\\verb\\**\\([^a-z@*]\\)"
+ ("\\\\verb\\**\\([^a-z@*]\\)"
(1 (prog1 "\""
(tex-font-lock-verb
(match-beginning 0) (char-after (match-beginning 1))))))))
@@ -761,7 +768,7 @@ automatically inserts its partner."
(regexp-quote (buffer-substring arg-start arg-end)))
(text-clone-create arg-start arg-end))))))))
(scan-error nil)
- (error (message "Error in latex-env-before-change: %s" err)))))
+ (error (message "Error in latex-env-before-change: %S" err)))))
(defun tex-font-lock-unfontify-region (beg end)
(font-lock-default-unfontify-region beg end)
@@ -849,7 +856,7 @@ START is the position of the \\ and DELIM is the delimiter
char."
(let ((char (nth 3 state)))
(cond
((not char)
- (if (eq 2 (nth 7 state)) 'tex-verbatim font-lock-comment-face))
+ (if (eq 2 (nth 7 state)) 'tex-verbatim 'font-lock-comment-face))
((eq char ?$) 'tex-math)
;; A \verb element.
(t 'tex-verbatim))))
@@ -1029,14 +1036,20 @@ says which mode to use."
;; `tex--guess-mode' really tries to guess the *type* of file,
;; so we still need to consult `major-mode-remap-alist'
;; to see which mode to use for that type.
- (alist-get mode major-mode-remap-alist mode))))))
+ (major-mode-remap mode))))))
-;; The following three autoloaded aliases appear to conflict with
-;; AUCTeX. We keep those confusing aliases for those users who may
-;; have files annotated with -*- LaTeX -*- (e.g. because they received
+;; Support files annotated with -*- LaTeX -*- (e.g. because they received
;; them from someone using AUCTeX).
-;; FIXME: Turn them into autoloads so that AUCTeX can override them
-;; with its own autoloads? Or maybe rely on `major-mode-remap-alist'?
+;;;###autoload (add-to-list 'major-mode-remap-defaults '(TeX-mode . tex-mode))
+;;;###autoload (add-to-list 'major-mode-remap-defaults '(plain-TeX-mode .
plain-tex-mode))
+;;;###autoload (add-to-list 'major-mode-remap-defaults '(LaTeX-mode .
latex-mode))
+
+;; FIXME: These aliases conflict with AUCTeX, but we still need them
+;; because of packages out there which call these functions directly.
+;; They should be patched to use `major-mode-remap'.
+;; It would be nice to mark them obsolete somehow to encourage using
+;; something else, but the obsolete declaration would become invalid
+;; and confusing when AUCTeX *is* installed.
;;;###autoload (defalias 'TeX-mode #'tex-mode)
;;;###autoload (defalias 'plain-TeX-mode #'plain-tex-mode)
;;;###autoload (defalias 'LaTeX-mode #'latex-mode)
@@ -1262,8 +1275,8 @@ Entering SliTeX mode runs the hook `text-mode-hook', then
the hook
(setq-local facemenu-end-add-face "}")
(setq-local facemenu-remove-face-function t)
(setq-local font-lock-defaults
- '((tex-font-lock-keywords tex-font-lock-keywords-1
- tex-font-lock-keywords-2
tex-font-lock-keywords-3)
+ '(( tex-font-lock-keywords tex-font-lock-keywords-1
+ tex-font-lock-keywords-2 tex-font-lock-keywords-3)
nil nil nil nil
;; Who ever uses that anyway ???
(font-lock-mark-block-function . mark-paragraph)
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 87f6668cecb..e8e1f4898ce 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -88,7 +88,7 @@ nor does it extend `completion-at-point-functions'.
This user option only takes effect when you customize it in
Custom or with `setopt', not with `setq'."
:group 'text
- :type 'boolean
+ :type '(choice (const completion-at-point) boolean)
:version "30.1"
:set (lambda (sym val)
(if (and (set sym val)
diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el
index 1ba410045f5..1b621032f8a 100644
--- a/lisp/textmodes/toml-ts-mode.el
+++ b/lisp/textmodes/toml-ts-mode.el
@@ -153,6 +153,8 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'toml-ts-mode '(toml-mode))
+
(if (treesit-ready-p 'toml)
(add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode)))
diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el
index a8cb504ef03..210835585fe 100644
--- a/lisp/textmodes/yaml-ts-mode.el
+++ b/lisp/textmodes/yaml-ts-mode.el
@@ -169,6 +169,8 @@ boundaries. JUSTIFY is passed to `fill-paragraph'."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'yaml-ts-mode '(yaml-mode))
+
(if (treesit-ready-p 'yaml)
(add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode)))
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 323d3d1cf6c..83ddc640d35 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -619,36 +619,20 @@ point.
Optional argument DISTANCE limits search for REGEXP forward and
back from point."
- (save-excursion
- (let ((old-point (point))
- (forward-bound (and distance (+ (point) distance)))
- (backward-bound (and distance (- (point) distance)))
- match prev-pos new-pos)
- (and (looking-at regexp)
- (>= (match-end 0) old-point)
- (setq match (point)))
- ;; Search back repeatedly from end of next match.
- ;; This may fail if next match ends before this match does.
- (re-search-forward regexp forward-bound 'limit)
- (setq prev-pos (point))
- (while (and (setq new-pos (re-search-backward regexp backward-bound t))
- ;; Avoid inflooping with some regexps, such as "^",
- ;; matching which never moves point.
- (< new-pos prev-pos)
- (or (> (match-beginning 0) old-point)
- (and (looking-at regexp) ; Extend match-end past search
start
- (>= (match-end 0) old-point)
- (setq match (point))))))
- (if (not match) nil
- (goto-char match)
- ;; Back up a char at a time in case search skipped
- ;; intermediate match straddling search start pos.
- (while (and (not (bobp))
- (progn (backward-char 1) (looking-at regexp))
- (>= (match-end 0) old-point)
- (setq match (point))))
- (goto-char match)
- (looking-at regexp)))))
+ (let* ((old (point))
+ (beg (if distance (max (point-min) (- old distance)) (point-min)))
+ (end (if distance (min (point-max) (+ old distance))))
+ prev match)
+ (save-excursion
+ (goto-char beg)
+ (while (and (setq prev (point)
+ match (re-search-forward regexp end t))
+ (< (match-end 0) old))
+ (goto-char (match-beginning 0))
+ ;; Avoid inflooping when `regexp' matches the empty string.
+ (unless (< prev (point)) (forward-char))))
+ (and match (<= (match-beginning 0) old (match-end 0)))))
+
;; Email addresses
(defvar thing-at-point-email-regexp
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index a1ec4bca89f..c8de1d8ee31 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -87,7 +87,7 @@ is being called from `read-sequence' or some similar
function.")
(defgroup touch-screen nil
"Interact with Emacs from touch screen devices."
:group 'mouse
- :version "30.0")
+ :version "30.1")
(defcustom touch-screen-display-keyboard nil
"If non-nil, always display the on screen keyboard.
diff --git a/lisp/transient.el b/lisp/transient.el
index 06d0b95bd82..8cc7cd9b2a9 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -855,7 +855,6 @@ elements themselves.")
;;; Define
-;;;###autoload
(defmacro transient-define-prefix (name arglist &rest args)
"Define NAME as a transient prefix command.
diff --git a/lisp/treesit.el b/lisp/treesit.el
index fab2ddd88e6..fa82ad898a9 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -344,14 +344,13 @@ ancestor node which satisfies the predicate PRED; then it
returns that ancestor node. It returns nil if no ancestor
node was found that satisfies PRED.
-PRED should be a function that takes one argument, the node to
-examine, and returns a boolean value indicating whether that
-node is a match.
+PRED can be a predicate function, a regexp matching node type,
+and more; see docstring of `treesit-thing-settings'.
If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
(let ((node (if include-node node
(treesit-node-parent node))))
- (while (and node (not (funcall pred node)))
+ (while (and node (not (treesit-node-match-p node pred)))
(setq node (treesit-node-parent node)))
node))
@@ -364,11 +363,10 @@ no longer satisfies the predicate PRED; it returns the
last
examined node that satisfies PRED. If no node satisfies PRED, it
returns nil.
-PRED should be a function that takes one argument, the node to
-examine, and returns a boolean value indicating whether that
-node is a match."
+PRED can be a predicate function, a regexp matching node type,
+and more; see docstring of `treesit-thing-settings'."
(let ((last nil))
- (while (and node (funcall pred node))
+ (while (and node (treesit-node-match-p node pred))
(setq last node
node (treesit-node-parent node)))
last))
@@ -1384,7 +1382,15 @@ as comment due to incomplete parse tree."
;; `treesit-update-ranges' will force the host language's parser to
;; reparse and set correct ranges for embedded parsers. Then
;; `treesit-parser-root-node' will force those parsers to reparse.
- (treesit-update-ranges)
+ (let ((len (+ (* (window-body-height) (window-body-width)) 800)))
+ ;; FIXME: As a temporary fix, this prevents Emacs from updating
+ ;; every single local parsers in the buffer every time there's an
+ ;; edit. Moving forward, we need some way to properly track the
+ ;; regions which need update on parser ranges, like what jit-lock
+ ;; and syntax-ppss does.
+ (treesit-update-ranges
+ (max (point-min) (- (point) len))
+ (min (point-max) (+ (point) len))))
;; Force repase on _all_ the parsers might not be necessary, but
;; this is probably the most robust way.
(dolist (parser (treesit-parser-list))
@@ -2662,9 +2668,17 @@ function is called recursively."
(setq parent (treesit-node-top-level parent thing t)
prev nil
next nil))
- ;; If TACTIC is `restricted', the implementation is very simple.
+ ;; If TACTIC is `restricted', the implementation is simple.
+ ;; In principle we don't go to parent's beg/end for
+ ;; `restricted' tactic, but if the parent is a "leaf thing"
+ ;; (doesn't have any child "thing" inside it), then we can
+ ;; move to the beg/end of it (bug#68899).
(if (eq tactic 'restricted)
- (setq pos (funcall advance (if (> arg 0) next prev)))
+ (setq pos (funcall
+ advance
+ (cond ((and (null next) (null prev)) parent)
+ ((> arg 0) next)
+ (t prev))))
;; For `nested', it's a bit more work:
;; Move...
(if (> arg 0)
@@ -2854,6 +2868,71 @@ ENTRY. MARKER marks the start of each tree-sitter node."
index))))
treesit-simple-imenu-settings)))
+;;; Outline minor mode
+
+(defvar-local treesit-outline-predicate nil
+ "Predicate used to find outline headings in the syntax tree.
+The predicate can be a function, a regexp matching node type,
+and more; see docstring of `treesit-thing-settings'.
+It matches the nodes located on lines with outline headings.
+Intended to be set by a major mode. When nil, the predicate
+is constructed from the value of `treesit-simple-imenu-settings'
+when a major mode sets it.")
+
+(defun treesit-outline-predicate--from-imenu (node)
+ ;; Return an outline searching predicate created from Imenu.
+ ;; Return the value suitable to set `treesit-outline-predicate'.
+ ;; Create this predicate from the value `treesit-simple-imenu-settings'
+ ;; that major modes set to find Imenu entries. The assumption here
+ ;; is that the positions of Imenu entries most of the time coincide
+ ;; with the lines of outline headings. When this assumption fails,
+ ;; you can directly set a proper value to `treesit-outline-predicate'.
+ (seq-some
+ (lambda (setting)
+ (and (string-match-p (nth 1 setting) (treesit-node-type node))
+ (or (null (nth 2 setting))
+ (funcall (nth 2 setting) node))))
+ treesit-simple-imenu-settings))
+
+(defun treesit-outline-search (&optional bound move backward looking-at)
+ "Search for the next outline heading in the syntax tree.
+See the descriptions of arguments 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))))
+
+ (let* ((pos
+ ;; When function wants to find the current outline, point
+ ;; is at the beginning of the current line. When it wants
+ ;; to find the next outline, point is at the second column.
+ (if (eq (point) (pos-bol))
+ (if (bobp) (point) (1- (point)))
+ (pos-eol)))
+ (found (treesit--navigate-thing pos (if backward -1 1) 'beg
+ treesit-outline-predicate)))
+ (if found
+ (if (or (not bound) (if backward (>= found bound) (<= found bound)))
+ (progn
+ (goto-char found)
+ (goto-char (pos-bol))
+ (set-match-data (list (point) (pos-eol)))
+ t)
+ (when move (goto-char bound))
+ nil)
+ (when move (goto-char (or bound (if backward (point-min)
(point-max)))))
+ nil))))
+
+(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)))
+ (while (setq node (treesit-parent-until node treesit-outline-predicate))
+ (setq level (1+ level)))
+ (if (zerop level) 1 level)))
+
;;; Activating tree-sitter
(defun treesit-ready-p (language &optional quiet)
@@ -2984,6 +3063,17 @@ before calling this function."
(setq-local imenu-create-index-function
#'treesit-simple-imenu))
+ ;; Outline minor mode.
+ (when (and (or treesit-outline-predicate treesit-simple-imenu-settings)
+ (not (seq-some #'local-variable-p
+ '(outline-search-function
+ outline-regexp outline-level))))
+ (unless treesit-outline-predicate
+ (setq treesit-outline-predicate
+ #'treesit-outline-predicate--from-imenu))
+ (setq-local outline-search-function #'treesit-outline-search
+ outline-level #'treesit-outline-level))
+
;; Remove existing local parsers.
(dolist (ov (overlays-in (point-min) (point-max)))
(when-let ((parser (overlay-get ov 'treesit-parser)))
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
index 17a0318e652..d80037f8fe9 100644
--- a/lisp/url/url-cid.el
+++ b/lisp/url/url-cid.el
@@ -1,6 +1,6 @@
;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*-
-;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2024 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -52,12 +52,7 @@
;;;###autoload
(defun url-cid (url)
- (cond
- ((fboundp 'mm-get-content-id)
- ;; Using Pterodactyl Gnus or later
- (with-current-buffer (generate-new-buffer " *url-cid*")
- (url-cid-gnus (url-filename url))))
- (t
- (message "Unable to handle CID URL: %s" url))))
+ (with-current-buffer (generate-new-buffer " *url-cid*")
+ (url-cid-gnus (url-filename url))))
;;; url-cid.el ends here
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index d6a1d0eade8..184c1278072 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -427,7 +427,7 @@ Use `url-http-referer' as the Referer-header (subject to
`url-privacy-level')."
;; Parsing routines
(defun url-http-clean-headers ()
- "Remove trailing \r from header lines.
+ "Remove trailing \\r from header lines.
This allows us to use `mail-fetch-field', etc.
Return the number of characters removed."
(let ((end (marker-position url-http-end-of-headers)))
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index 1bdd5099637..6aaea606c27 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,6 +1,6 @@
;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*-
lexical-binding: t; -*-
-;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2024 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -92,12 +92,8 @@
"'>" dn "</a>"))
(defun url-ldap-certificate-formatter (data)
- (condition-case ()
- (require 'ssl)
- (error nil))
- (let ((vals (if (fboundp 'ssl-certificate-information)
- (ssl-certificate-information data)
- (tls-certificate-information data))))
+ ;; FIXME: tls.el is obsolete.
+ (let ((vals (tls-certificate-information data)))
(if (not vals)
"<b>Unable to parse certificate</b>"
(concat "<table border=0>\n"
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index c2d347a1646..50293ab3f05 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,6 +1,6 @@
;;; url-mailto.el --- Mail Uniform Resource Locator retrieval code -*-
lexical-binding: t; -*-
-;; Copyright (C) 1996-1999, 2004-2024 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2024 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -28,12 +28,7 @@
(require 'url-util)
;;;###autoload
-(defun url-mail (&rest args)
- (interactive "P")
- (if (fboundp 'message-mail)
- (apply 'message-mail args)
- (or (apply 'mail args)
- (error "Mail aborted"))))
+(defalias 'url-mail #'message-mail)
(defun url-mail-goto-field (field)
(if (not field)
@@ -57,8 +52,6 @@
(save-excursion
(insert "\n"))))))
-(declare-function mail-send-and-exit "sendmail")
-
;;;###autoload
(defun url-mailto (url)
"Handle the mailto: URL syntax."
@@ -111,8 +104,6 @@
;; (setq func (intern-soft (concat "mail-" (caar args))))
(insert (mapconcat 'identity (cdar args) ", ")))
(setq args (cdr args)))
- ;; (url-mail-goto-field "User-Agent")
-;; (insert url-package-name "/" url-package-version " URL/" url-version)
(if (not url-request-data)
(progn
(set-buffer-modified-p nil)
@@ -128,8 +119,8 @@
(goto-char (point-max))
(insert url-request-data)
;; It seems Microsoft-ish to send without warning.
- ;; Fixme: presumably this should depend on a privacy setting.
- (if (y-or-n-p "Send this auto-generated mail? ")
+ ;; FIXME: presumably this should depend on a privacy setting.
+ (if (y-or-n-p "Send this auto-generated mail?")
(let ((buffer (current-buffer)))
(cond ((eq url-mail-command 'compose-mail)
(funcall (get mail-user-agent 'sendfunc) nil))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 83d580d98dd..ac7d55c8a46 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -517,8 +517,8 @@ use the face `diff-removed' for removed lines, and the face
("^Only in .*\n" . 'diff-nonexistent)
("^Binary files .* differ\n" . 'diff-file-header)
("^\\(#\\)\\(.*\\)"
- (1 font-lock-comment-delimiter-face)
- (2 font-lock-comment-face))
+ (1 'font-lock-comment-delimiter-face)
+ (2 'font-lock-comment-face))
("^diff: .*" (0 'diff-error))
("^[^-=+*!<>#].*\n" (0 'diff-context))
(,#'diff--font-lock-syntax)
@@ -944,7 +944,8 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\"
\"/a/c/foo\")."
(when (and (string-match (concat
"\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n"
"\\1\\(.*\\)\\3\n"
- "\\(.*\\(\\2\\).*\\)\\'") str)
+ "\\(.*\\(\\2\\).*\\)\\'")
+ str)
(equal to (match-string 5 str)))
(concat (substring str (match-beginning 5) (match-beginning 6))
(match-string 4 str)
@@ -1999,7 +2000,7 @@ With a prefix argument, REVERSE the hunk."
(diff-find-source-location nil reverse)))
(cond
((null line-offset)
- (error "Can't find the text to patch"))
+ (user-error "Can't find the text to patch"))
((with-current-buffer buf
(and buffer-file-name
(backup-file-name-p buffer-file-name)
@@ -2008,7 +2009,7 @@ With a prefix argument, REVERSE the hunk."
(yes-or-no-p (format "Really apply this hunk to
%s? "
(file-name-nondirectory
buffer-file-name)))))))
- (error "%s"
+ (user-error "%s"
(substitute-command-keys
(format "Use %s\\[diff-apply-hunk] to apply it to the other file"
(if (not reverse) "\\[universal-argument] ")))))
@@ -2275,6 +2276,24 @@ Return new point, if it was moved."
(end (progn (diff-end-of-hunk) (point))))
(diff--refine-hunk beg end)))))
+(defun diff--refine-propertize (beg end face)
+ (let ((ol (make-overlay beg end)))
+ (overlay-put ol 'diff-mode 'fine)
+ (overlay-put ol 'evaporate t)
+ (overlay-put ol 'face face)))
+
+(defcustom diff-refine-nonmodified nil
+ "If non-nil, also highlight the added/removed lines as \"refined\".
+The lines highlighted when this is non-nil are those that were
+added or removed in their entirety, as opposed to lines some
+parts of which were modified. The added lines are highlighted
+using the `diff-refine-added' face, while the removed lines are
+highlighted using the `diff-refine-removed' face.
+This is currently implemented only for diff formats supported
+by `diff-refine-hunk'."
+ :version "30.1"
+ :type 'boolean)
+
(defun diff--refine-hunk (start end)
(require 'smerge-mode)
(goto-char start)
@@ -2289,41 +2308,68 @@ Return new point, if it was moved."
(goto-char beg)
(pcase style
('unified
- (while (re-search-forward "^-" end t)
+ (while (re-search-forward "^[-+]" end t)
(let ((beg-del (progn (beginning-of-line) (point)))
beg-add end-add)
- (when (and (diff--forward-while-leading-char ?- end)
- ;; Allow for "\ No newline at end of file".
- (progn (diff--forward-while-leading-char ?\\ end)
- (setq beg-add (point)))
- (diff--forward-while-leading-char ?+ end)
- (progn (diff--forward-while-leading-char ?\\ end)
- (setq end-add (point))))
+ (cond
+ ((eq (char-after) ?+)
+ (diff--forward-while-leading-char ?+ end)
+ (when diff-refine-nonmodified
+ (diff--refine-propertize beg-del (point) 'diff-refine-added)))
+ ((and (diff--forward-while-leading-char ?- end)
+ ;; Allow for "\ No newline at end of file".
+ (progn (diff--forward-while-leading-char ?\\ end)
+ (setq beg-add (point)))
+ (diff--forward-while-leading-char ?+ end)
+ (progn (diff--forward-while-leading-char ?\\ end)
+ (setq end-add (point))))
(smerge-refine-regions beg-del beg-add beg-add end-add
- nil #'diff-refine-preproc props-r
props-a)))))
+ nil #'diff-refine-preproc props-r props-a))
+ (t ;; If we're here, it's because
+ ;; (diff--forward-while-leading-char ?+ end) failed.
+ (when diff-refine-nonmodified
+ (diff--refine-propertize beg-del (point)
+ 'diff-refine-removed)))))))
('context
(let* ((middle (save-excursion (re-search-forward "^---" end t)))
(other middle))
- (while (and middle
- (re-search-forward "^\\(?:!.*\n\\)+" middle t))
- (smerge-refine-regions (match-beginning 0) (match-end 0)
- (save-excursion
- (goto-char other)
- (re-search-forward "^\\(?:!.*\n\\)+" end)
- (setq other (match-end 0))
- (match-beginning 0))
- other
- (if diff-use-changed-face props-c)
- #'diff-refine-preproc
- (unless diff-use-changed-face props-r)
- (unless diff-use-changed-face props-a)))))
+ (when middle
+ (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
+ (smerge-refine-regions (match-beginning 0) (match-end 0)
+ (save-excursion
+ (goto-char other)
+ (re-search-forward "^\\(?:!.*\n\\)+" end)
+ (setq other (match-end 0))
+ (match-beginning 0))
+ other
+ (if diff-use-changed-face props-c)
+ #'diff-refine-preproc
+ (unless diff-use-changed-face props-r)
+ (unless diff-use-changed-face props-a)))
+ (when diff-refine-nonmodified
+ (goto-char beg)
+ (while (re-search-forward "^\\(?:-.*\n\\)+" middle t)
+ (diff--refine-propertize (match-beginning 0)
+ (match-end 0)
+ 'diff-refine-removed))
+ (goto-char middle)
+ (while (re-search-forward "^\\(?:\\+.*\n\\)+" end t)
+ (diff--refine-propertize (match-beginning 0)
+ (match-end 0)
+ 'diff-refine-added))))))
(_ ;; Normal diffs.
(let ((beg1 (1+ (point))))
- (when (re-search-forward "^---.*\n" end t)
+ (cond
+ ((re-search-forward "^---.*\n" end t)
;; It's a combined add&remove, so there's something to do.
(smerge-refine-regions beg1 (match-beginning 0)
(match-end 0) end
- nil #'diff-refine-preproc props-r
props-a)))))))
+ nil #'diff-refine-preproc props-r props-a))
+ (diff-refine-nonmodified
+ (diff--refine-propertize
+ beg1 end
+ (if (eq (char-after beg1) ?<)
+ 'diff-refine-removed 'diff-refine-added)))))))))
(defun diff--iterate-hunks (max fun)
"Iterate over all hunks between point and MAX.
@@ -2817,6 +2863,57 @@ and the position in MAX."
(defvar-local diff--syntax-file-attributes nil)
(put 'diff--syntax-file-attributes 'permanent-local t)
+(defvar diff--cached-revision-buffers nil
+ "List of ((FILE . REVISION) . BUFFER) in MRU order.")
+
+(defvar diff--cache-clean-timer nil)
+(defconst diff--cache-clean-interval 3600) ; seconds
+
+(defun diff--cache-clean ()
+ "Discard the least recently used half of the cache."
+ (let ((n (/ (length diff--cached-revision-buffers) 2)))
+ (mapc #'kill-buffer (mapcar #'cdr (nthcdr n
diff--cached-revision-buffers)))
+ (setq diff--cached-revision-buffers
+ (ntake n diff--cached-revision-buffers)))
+ (diff--cache-schedule-clean))
+
+(defun diff--cache-schedule-clean ()
+ (setq diff--cache-clean-timer
+ (and diff--cached-revision-buffers
+ (run-with-timer diff--cache-clean-interval nil
+ #'diff--cache-clean))))
+
+(defun diff--get-revision-properties (file revision text line-nb)
+ "Get font-lock properties from FILE at REVISION for TEXT at LINE-NB."
+ (let* ((file-rev (cons file revision))
+ (entry (assoc file-rev diff--cached-revision-buffers))
+ (buffer (cdr entry)))
+ (if (buffer-live-p buffer)
+ (progn
+ ;; Don't re-initialize the buffer (which would throw
+ ;; away the previous fontification work).
+ (setq file nil)
+ (setq diff--cached-revision-buffers
+ (cons entry
+ (delq entry diff--cached-revision-buffers))))
+ ;; Cache miss: create a new entry.
+ (setq buffer (get-buffer-create (format " *diff-syntax:%s.~%s~*"
+ file revision)))
+ (condition-case nil
+ (vc-find-revision-no-save file revision diff-vc-backend buffer)
+ (error
+ (kill-buffer buffer)
+ (setq buffer nil))
+ (:success
+ (push (cons file-rev buffer)
+ diff--cached-revision-buffers))))
+ (when diff--cache-clean-timer
+ (cancel-timer diff--cache-clean-timer))
+ (diff--cache-schedule-clean)
+ (and buffer
+ (with-current-buffer buffer
+ (diff-syntax-fontify-props file text line-nb)))))
+
(defun diff-syntax-fontify-hunk (beg end old)
"Highlight source language syntax in diff hunk between BEG and END.
When OLD is non-nil, highlight the hunk from the old source."
@@ -2867,22 +2964,8 @@ When OLD is non-nil, highlight the hunk from the old
source."
(insert-file-contents file)
(setq diff--syntax-file-attributes attrs)))
(diff-syntax-fontify-props file text line-nb)))))
- ;; Get properties from a cached revision
- (let* ((buffer-name (format " *diff-syntax:%s.~%s~*"
- file revision))
- (buffer (get-buffer buffer-name)))
- (if buffer
- ;; Don't re-initialize the buffer (which would throw
- ;; away the previous fontification work).
- (setq file nil)
- (setq buffer (ignore-errors
- (vc-find-revision-no-save
- file revision
- diff-vc-backend
- (get-buffer-create buffer-name)))))
- (when buffer
- (with-current-buffer buffer
- (diff-syntax-fontify-props file text line-nb))))))))
+ (diff--get-revision-properties file revision
+ text line-nb)))))
(let ((file (car (diff-hunk-file-names old))))
(cond
((and file diff-default-directory
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 456417e566e..18b4a8691e9 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1411,9 +1411,16 @@ This prompts for a branch to merge from."
(vc-message-unresolved-conflicts buffer-file-name)))
(defun vc-git-clone (remote directory rev)
- (if rev
- (vc-git--out-ok "clone" "--branch" rev remote directory)
+ "Attempt to clone REMOTE repository into DIRECTORY at revision REV."
+ (cond
+ ((null rev)
(vc-git--out-ok "clone" remote directory))
+ ((ignore-errors
+ (vc-git--out-ok "clone" "--branch" rev remote directory)))
+ ((vc-git--out-ok "clone" remote directory)
+ (let ((default-directory directory))
+ (vc-git--out-ok "checkout" rev)))
+ ((error "Failed to check out %s at %s" remote rev)))
directory)
;;; HISTORY FUNCTIONS
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 1493845e2d9..75f68dd80d1 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -186,7 +186,8 @@ revision number and lock status."
This minor mode is automatically activated whenever you visit a file under
control of one of the revision control systems in `vc-handled-backends'.
VC commands are globally reachable under the prefix \\[vc-prefix-map]:
-\\{vc-prefix-map}")
+\\{vc-prefix-map}"
+ nil)
(defmacro vc-error-occurred (&rest body)
`(condition-case nil (progn ,@body nil) (error t)))
@@ -197,7 +198,7 @@ VC commands are globally reachable under the prefix
\\[vc-prefix-map]:
;; during any subsequent VC operations, and forget them when
;; the buffer is killed.
-(defvar vc-file-prop-obarray (make-vector 17 0)
+(defvar vc-file-prop-obarray (obarray-make 17)
"Obarray for per-file properties.")
(defvar vc-touched-properties nil)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index f612daaa569..f26e5cc751d 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -935,7 +935,7 @@ is sensitive to blank lines."
(defun vc-clear-context ()
"Clear all cached file properties."
(interactive)
- (fillarray vc-file-prop-obarray 0))
+ (obarray-clear vc-file-prop-obarray))
(defmacro with-vc-properties (files form settings)
"Execute FORM, then maybe set per-file properties for FILES.
@@ -3623,7 +3623,15 @@ revisions.
When invoked interactively in a Log View buffer with
marked revisions, use those."
(interactive
- (let ((revs (vc-prepare-patch-prompt-revisions)) to)
+ (let* ((revs (vc-prepare-patch-prompt-revisions))
+ (subject
+ (and (length= revs 1)
+ (plist-get
+ (vc-call-backend
+ (vc-responsible-backend default-directory)
+ 'prepare-patch (car revs))
+ :subject)))
+ to)
(require 'message)
(while (null (setq to (completing-read-multiple
(format-prompt
@@ -3636,10 +3644,9 @@ marked revisions, use those."
(sit-for blink-matching-delay))
(list (string-join to ", ")
(and (not vc-prepare-patches-separately)
- (read-string "Subject: " "[PATCH] " nil nil t))
+ (read-string "Subject: " (or subject "[PATCH] ") nil nil t))
revs)))
(save-current-buffer
- (vc-ensure-vc-buffer)
(let ((patches (mapcar (lambda (rev)
(vc-call-backend
(vc-responsible-backend default-directory)
@@ -3794,11 +3801,16 @@ to provide the `find-revision' operation instead."
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
(defun vc-clone (remote &optional backend directory rev)
- "Use BACKEND to clone REMOTE into DIRECTORY.
-If successful, returns the string with the directory of the
-checkout. If BACKEND is nil, iterate through every known backend
-in `vc-handled-backends' until one succeeds. If REV is non-nil,
-it indicates a specific revision to check out."
+ "Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
+If successful, return the string with the directory of the checkout;
+otherwise return nil.
+REMOTE should be a string, the URL of the remote repository or the name
+of a directory (if the repository is local).
+If DIRECTORY is nil or omitted, it defaults to `default-directory'.
+If BACKEND is nil or omitted, the function iterates through every known
+backend in `vc-handled-backends' until one succeeds to clone REMOTE.
+If REV is non-nil, it indicates a specific revision to check out after
+cloning; the syntax of REV depends on what BACKEND accepts."
(setq directory (expand-file-name (or directory default-directory)))
(if backend
(progn
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index ec5adbd832c..15791285b13 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -433,7 +433,7 @@ Default is nil."
(defcustom vcursor-interpret-input nil
"If non-nil, input from the vcursor is treated as interactive input.
This will cause text insertion to be much slower. Note that no special
-interpretation of strings is done: \"\C-x\" is a string of four
+interpretation of strings is done: \"\\C-x\" is a string of four
characters. The default is simply to copy strings."
:type 'boolean
:version "20.3")
diff --git a/lisp/window.el b/lisp/window.el
index 58d4100a029..0037e69f4fe 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -6174,6 +6174,12 @@ value can be also stored on disk and read back in a new
session."
(defvar window-state-put-stale-windows nil
"Helper variable for `window-state-put'.")
+(defvar window-state-put-kept-windows nil
+ "Helper variable for `window-state-put'.")
+
+(defvar window-state-put-selected-window nil
+ "Helper variable for `window-state-put'.")
+
(defun window--state-put-1 (state &optional window ignore totals pixelwise)
"Helper function for `window-state-put'."
(let ((type (car state)))
@@ -6278,9 +6284,10 @@ value can be also stored on disk and read back in a new
session."
(set-window-parameter window (car parameter) (cdr parameter))))
;; Process buffer related state.
(when state
- (let ((buffer (get-buffer (car state)))
- (state (cdr state)))
- (if buffer
+ (let* ((old-buffer-or-name (car state))
+ (buffer (get-buffer old-buffer-or-name))
+ (state (cdr state)))
+ (if (buffer-live-p buffer)
(with-current-buffer buffer
(set-window-buffer window buffer)
(set-window-hscroll window (cdr (assq 'hscroll state)))
@@ -6348,7 +6355,18 @@ value can be also stored on disk and read back in a new
session."
(set-window-point window (cdr (assq 'point state))))
;; Select window if it's the selected one.
(when (cdr (assq 'selected state))
- (select-window window))
+ ;; This used to call 'select-window' which, however,
+ ;; can be partially undone because the current buffer
+ ;; may subsequently change twice: When leaving the
+ ;; present 'with-current-buffer' and when leaving the
+ ;; containing 'with-temp-buffer' form (Bug#69093).
+ ;; 'window-state-put-selected-window' should now work
+ ;; around that bug but we leave this 'select-window'
+ ;; in since some code run before the part that fixed
+ ;; it might still refer to this window as the selected
+ ;; one.
+ (select-window window)
+ (setq window-state-put-selected-window window))
(set-window-next-buffers
window
(delq nil (mapcar (lambda (buffer)
@@ -6375,7 +6393,20 @@ value can be also stored on disk and read back in a new
session."
;; save the window with the intention of deleting it later
;; if possible.
(switch-to-prev-buffer window)
- (push window window-state-put-stale-windows)))))))
+ (if window-kept-windows-functions
+ (let* ((start (cdr (assq 'start state)))
+ ;; Handle both - marker positions from writable
+ ;; states and markers from non-writable states.
+ (start-pos (if (markerp start)
+ (marker-last-position start)
+ start))
+ (point (cdr (assq 'point state)))
+ (point-pos (if (markerp point)
+ (marker-last-position point)
+ point)))
+ (push (list window old-buffer-or-name start-pos point-pos)
+ window-state-put-kept-windows))
+ (push window window-state-put-stale-windows))))))))
(defun window-state-put (state &optional window ignore)
"Put window state STATE into WINDOW.
@@ -6388,8 +6419,20 @@ If WINDOW is nil, create a new window before putting
STATE into it.
Optional argument IGNORE non-nil means ignore minimum window
sizes and fixed size restrictions. IGNORE equal `safe' means
windows can get as small as `window-safe-min-height' and
-`window-safe-min-width'."
+`window-safe-min-width'.
+
+If the abnormal hook `window-kept-windows-functions' is non-nil,
+do not delete any windows saved by STATE whose buffers were
+deleted since STATE was saved. Rather, show some live buffer in
+them and call the functions in `window-kept-windows-functions'
+with a list of two arguments: the frame where STATE was put and a
+list of entries for each such window. Each entry contains four
+elements - the window, its old buffer and the last positions of
+`window-start' and `window-point' for the buffer in that window.
+Always check the window for liveness because another function run
+by this hook may have deleted it."
(setq window-state-put-stale-windows nil)
+ (setq window-state-put-kept-windows nil)
;; When WINDOW is internal or nil, reduce it to a live one,
;; then create a new window on the same frame to put STATE into.
@@ -6482,6 +6525,7 @@ windows can get as small as `window-safe-min-height' and
(error "Window %s too small to accommodate state" window)
(setq state (cdr state))
(setq window-state-put-list nil)
+ (setq window-state-put-selected-window nil)
;; Work on the windows of a temporary buffer to make sure that
;; splitting proceeds regardless of any buffer local values of
;; `window-size-fixed'. Release that buffer after the buffers of
@@ -6490,14 +6534,21 @@ windows can get as small as `window-safe-min-height' and
(set-window-buffer window (current-buffer))
(window--state-put-1 state window nil totals pixelwise)
(window--state-put-2 ignore pixelwise))
+ (when (window-live-p window-state-put-selected-window)
+ (select-window window-state-put-selected-window))
(while window-state-put-stale-windows
(let ((window (pop window-state-put-stale-windows)))
- ;; Avoid that 'window-deletable-p' throws an error if window
+ ;; Avoid that 'window-deletable-p' throws an error if window
;; was already deleted when exiting 'with-temp-buffer' above
;; (Bug#54028).
(when (and (window-valid-p window)
(eq (window-deletable-p window) t))
(delete-window window))))
+ (when window-kept-windows-functions
+ (run-hook-with-args
+ 'window-kept-windows-functions
+ frame window-state-put-kept-windows)
+ (setq window-state-put-kept-windows nil))
(window--check frame))))
(defun window-state-buffers (state)
diff --git a/lisp/winner.el b/lisp/winner.el
index 2aa59a86b25..19641a05bfc 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -178,7 +178,8 @@ You may want to include buffer names such as *Help*,
*Apropos*,
(setq winner-last-frames nil)
(setq winner-last-command this-command))
(dolist (frame winner-modified-list)
- (winner-insert-if-new frame))
+ (if (frame-live-p frame)
+ (winner-insert-if-new frame)))
(setq winner-modified-list nil)
(winner-remember)))
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 00691c0d6c3..d8d0904f787 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 91
+# gnulib-common.m4 serial 92
dnl Copyright (C) 2007-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -76,42 +76,48 @@ AC_DEFUN([gl_COMMON_BODY], [
#endif])
AH_VERBATIM([attribute],
[/* Attributes. */
-#if (defined __has_attribute \
- && (!defined __clang_minor__ \
- || (defined __apple_build_version__ \
- ? 7000000 <= __apple_build_version__ \
- : 5 <= __clang_major__)))
-# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__)
-#else
-# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr
-# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3)
-# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2)
-# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3)
-# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3)
-# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95)
-# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1)
-# define _GL_ATTR_diagnose_if 0
-# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3)
-# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1)
-# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0)
-# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7)
-# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6)
-# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0)
-# ifdef _ICC
-# define _GL_ATTR_may_alias 0
+/* Define _GL_HAS_ATTRIBUTE only once, because on FreeBSD, with gcc < 5, if
+ <config.h> gets included once again after <sys/cdefs.h>, __has_attribute(x)
+ expands to 0 always, and redefining _GL_HAS_ATTRIBUTE would turn off all
+ attributes. */
+#ifndef _GL_HAS_ATTRIBUTE
+# if (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || (defined __apple_build_version__ \
+ ? 7000000 <= __apple_build_version__ \
+ : 5 <= __clang_major__)))
+# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__)
# else
-# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3)
+# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr
+# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2)
+# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95)
+# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1)
+# define _GL_ATTR_diagnose_if 0
+# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1)
+# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0)
+# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6)
+# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0)
+# ifdef _ICC
+# define _GL_ATTR_may_alias 0
+# else
+# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3)
+# endif
+# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1)
+# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3)
+# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0)
+# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3)
+# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96)
+# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9)
+# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0)
+# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4)
# endif
-# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1)
-# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3)
-# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0)
-# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3)
-# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7)
-# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96)
-# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9)
-# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0)
-# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7)
-# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4)
#endif
/* Use __has_c_attribute if available. However, do not use with
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 7a7ebb0f34e..d8b92e7b122 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -1024,7 +1024,7 @@ AC_DEFUN([gl_INIT],
if test $ac_use_included_regex = yes; then
func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c
fi
- if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test
$ac_cv_type_long_long_int = yes; then
+ if test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
func_gl_gnulib_m4code_strtoll
fi
if test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1; then
@@ -1422,6 +1422,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/stdlib.in.h
lib/stpcpy.c
lib/str-two-way.h
+ lib/strftime.c
lib/strftime.h
lib/string.in.h
lib/strnlen.c
diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4
index c51f590402f..ff730b676cd 100644
--- a/m4/nanosleep.m4
+++ b/m4/nanosleep.m4
@@ -1,4 +1,4 @@
-# serial 46
+# serial 47
dnl From Jim Meyering.
dnl Check for the nanosleep function.
@@ -119,6 +119,10 @@ AC_DEFUN([gl_FUNC_NANOSLEEP],
# Guess it halfway works when the kernel is Linux.
linux*)
gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;;
+ # Midipix generally emulates the Linux system calls,
+ # but here it handles large arguments correctly.
+ midipix*)
+ gl_cv_func_nanosleep='guessing yes' ;;
# Guess no on native Windows.
mingw* | windows*)
gl_cv_func_nanosleep='guessing no' ;;
diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4
index 67250dc9455..aa5d63a54b5 100644
--- a/m4/nstrftime.m4
+++ b/m4/nstrftime.m4
@@ -1,4 +1,4 @@
-# serial 37
+# serial 38
# Copyright (C) 1996-1997, 1999-2007, 2009-2024 Free Software Foundation, Inc.
#
@@ -16,7 +16,4 @@ AC_DEFUN([gl_FUNC_GNU_STRFTIME],
AC_REQUIRE([AC_STRUCT_TIMEZONE])
AC_REQUIRE([gl_TM_GMTOFF])
-
- AC_DEFINE([my_strftime], [nstrftime],
- [Define to the name of the strftime replacement function.])
])
diff --git a/m4/utimens.m4 b/m4/utimens.m4
index af03e6b52be..0f5bfd4c843 100644
--- a/m4/utimens.m4
+++ b/m4/utimens.m4
@@ -3,7 +3,7 @@ dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
-dnl serial 15
+dnl serial 16
AC_DEFUN([gl_UTIMENS],
[
@@ -36,12 +36,13 @@ AC_DEFUN([gl_UTIMENS],
[gl_cv_func_futimesat_works=yes],
[gl_cv_func_futimesat_works=no],
[case "$host_os" in
- # Guess yes on Linux systems.
- linux-* | linux) gl_cv_func_futimesat_works="guessing yes" ;;
- # Guess yes on glibc systems.
- *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;;
- # If we don't know, obey --enable-cross-guesses.
- *)
gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;;
+ # Guess yes on Linux systems
+ # and on systems that emulate the Linux system
calls.
+ linux* | midipix*) gl_cv_func_futimesat_works="guessing yes" ;;
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;;
+ # If we don't know, obey --enable-cross-guesses.
+ *)
gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;;
esac
])
rm -f conftest.file])
diff --git a/m4/utimensat.m4 b/m4/utimensat.m4
index e595b333d17..4af7f6f81c8 100644
--- a/m4/utimensat.m4
+++ b/m4/utimensat.m4
@@ -1,4 +1,4 @@
-# serial 11
+# serial 12
# See if we need to provide utimensat replacement.
dnl Copyright (C) 2009-2024 Free Software Foundation, Inc.
@@ -83,6 +83,9 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
# Guess yes on Linux or glibc systems.
linux-* | linux | *-gnu* | gnu*)
gl_cv_func_utimensat_works="guessing yes" ;;
+ # Guess yes on systems that emulate the Linux system calls.
+ midipix*)
+ gl_cv_func_utimensat_works="guessing yes" ;;
# Guess 'nearly' on AIX.
aix*)
gl_cv_func_utimensat_works="guessing nearly" ;;
diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c
index 0500b653bb2..c012151cf96 100644
--- a/nt/cmdproxy.c
+++ b/nt/cmdproxy.c
@@ -38,6 +38,14 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <string.h> /* strlen */
#include <ctype.h> /* isspace, isalpha */
+/* UCRT has a C99-compatible snprintf, and _snprintf is defined inline
+ in stdio.h, which we don't want to include here. Since the
+ differences in behavior between snprintf and _snprintf don't matter
+ in this file, we take the easy way out. */
+#ifdef _UCRT
+# define _snprintf snprintf
+#endif
+
/* We don't want to include stdio.h because we are already duplicating
lots of it here */
extern int _snprintf (char *buffer, size_t count, const char *format, ...);
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk
index 5b1c2c88ba5..048f812724a 100644
--- a/nt/gnulib-cfg.mk
+++ b/nt/gnulib-cfg.mk
@@ -46,6 +46,7 @@ OMIT_GNULIB_MODULE_allocator = true
OMIT_GNULIB_MODULE_at-internal = true
OMIT_GNULIB_MODULE_canonicalize-lgpl = true
OMIT_GNULIB_MODULE_careadlinkat = true
+OMIT_GNULIB_MODULE_copy-file-range = true
OMIT_GNULIB_MODULE_dirent = true
OMIT_GNULIB_MODULE_dirfd = true
OMIT_GNULIB_MODULE_fchmodat = true
diff --git a/src/alloc.c b/src/alloc.c
index 539e7ca0af4..137c3073697 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -360,13 +360,13 @@ static struct gcstat
object_ct total_intervals, total_free_intervals;
object_ct total_buffers;
- /* Size of the ancillary arrays of live hash-table objects.
+ /* Size of the ancillary arrays of live hash-table and obarray objects.
The objects themselves are not included (counted as vectors above). */
byte_ct total_hash_table_bytes;
} gcstat;
-/* Total size of ancillary arrays of all allocated hash-table objects,
- both dead and alive. This number is always kept up-to-date. */
+/* Total size of ancillary arrays of all allocated hash-table and obarray
+ objects, both dead and alive. This number is always kept up-to-date. */
static ptrdiff_t hash_table_allocated_bytes = 0;
/* Points to memory space allocated as "spare", to be freed if we run
@@ -3443,7 +3443,7 @@ cleanup_vector (struct Lisp_Vector *vector)
struct Lisp_Hash_Table *h = PSEUDOVEC_STRUCT (vector, Lisp_Hash_Table);
if (h->table_size > 0)
{
- eassert (h->index_size > 1);
+ eassert (h->index_bits > 0);
xfree (h->index);
xfree (h->key_and_value);
xfree (h->next);
@@ -3451,10 +3451,19 @@ cleanup_vector (struct Lisp_Vector *vector)
ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key_and_value
+ sizeof *h->hash
+ sizeof *h->next)
- + h->index_size * sizeof *h->index);
+ + hash_table_index_size (h) * sizeof *h->index);
hash_table_allocated_bytes -= bytes;
}
}
+ break;
+ case PVEC_OBARRAY:
+ {
+ struct Lisp_Obarray *o = PSEUDOVEC_STRUCT (vector, Lisp_Obarray);
+ xfree (o->buckets);
+ ptrdiff_t bytes = obarray_size (o) * sizeof *o->buckets;
+ hash_table_allocated_bytes -= bytes;
+ }
+ break;
/* Keep the switch exhaustive. */
case PVEC_NORMAL_VECTOR:
case PVEC_FREE:
@@ -5635,7 +5644,8 @@ valid_lisp_object_p (Lisp_Object obj)
return 0;
}
-/* Like xmalloc, but makes allocation count toward the total consing.
+/* Like xmalloc, but makes allocation count toward the total consing
+ and hash table or obarray usage.
Return NULL for a zero-sized allocation. */
void *
hash_table_alloc_bytes (ptrdiff_t nbytes)
@@ -5962,7 +5972,8 @@ purecopy_hash_table (struct Lisp_Hash_Table *table)
for (ptrdiff_t i = 0; i < nvalues; i++)
pure->key_and_value[i] = purecopy (table->key_and_value[i]);
- ptrdiff_t index_bytes = table->index_size * sizeof *table->index;
+ ptrdiff_t index_bytes = hash_table_index_size (table)
+ * sizeof *table->index;
pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index);
memcpy (pure->index, table->index, index_bytes);
}
@@ -6036,8 +6047,7 @@ purecopy (Lisp_Object obj)
return obj; /* Don't hash cons it. */
}
- struct Lisp_Hash_Table *h = purecopy_hash_table (table);
- XSET_HASH_TABLE (obj, h);
+ obj = make_lisp_hash_table (purecopy_hash_table (table));
}
else if (COMPILEDP (obj) || VECTORP (obj) || RECORDP (obj))
{
@@ -7313,6 +7323,14 @@ process_mark_stack (ptrdiff_t base_sp)
break;
}
+ case PVEC_OBARRAY:
+ {
+ struct Lisp_Obarray *o = (struct Lisp_Obarray *)ptr;
+ set_vector_marked (ptr);
+ mark_stack_push_values (o->buckets, obarray_size (o));
+ break;
+ }
+
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
mark_char_table (ptr, (enum pvec_type) pvectype);
diff --git a/src/android.c b/src/android.c
index 4a74f5b2af4..d7bd06f1f34 100644
--- a/src/android.c
+++ b/src/android.c
@@ -40,6 +40,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <sys/param.h>
#include <sys/stat.h>
+#include <sys/select.h>
/* Old NDK versions lack MIN and MAX. */
#include <minmax.h>
@@ -112,6 +113,8 @@ struct android_emacs_window
jmethodID define_cursor;
jmethodID damage_rect;
jmethodID recreate_activity;
+ jmethodID clear_window;
+ jmethodID clear_area;
};
struct android_emacs_cursor
@@ -120,6 +123,12 @@ struct android_emacs_cursor
jmethodID constructor;
};
+struct android_key_character_map
+{
+ jclass class;
+ jmethodID get_dead_char;
+};
+
/* The API level of the current device. */
static int android_api_level;
@@ -152,6 +161,13 @@ static char *android_files_dir;
/* The Java environment being used for the main thread. */
JNIEnv *android_java_env;
+#ifdef THREADS_ENABLED
+
+/* The Java VM new threads attach to. */
+JavaVM *android_jvm;
+
+#endif /* THREADS_ENABLED */
+
/* The EmacsGC class. */
static jclass emacs_gc_class;
@@ -193,6 +209,9 @@ static struct android_emacs_window window_class;
/* Various methods associated with the EmacsCursor class. */
static struct android_emacs_cursor cursor_class;
+/* Various methods associated with the KeyCharacterMap class. */
+static struct android_key_character_map key_character_map_class;
+
/* The time at which Emacs was installed, which also supplies the
mtime of asset files. */
struct timespec emacs_installation_time;
@@ -496,6 +515,9 @@ android_handle_sigusr1 (int sig, siginfo_t *siginfo, void
*arg)
This should ideally be defined further down. */
static sem_t android_query_sem;
+/* ID of the Emacs thread. */
+static pthread_t main_thread_id;
+
/* Set up the global event queue by initializing the mutex and two
condition variables, and the linked list of events. This must be
called before starting the Emacs thread. Also, initialize the
@@ -531,6 +553,8 @@ android_init_events (void)
event_queue.events.next = &event_queue.events;
event_queue.events.last = &event_queue.events;
+ main_thread_id = pthread_self ();
+
#if __ANDROID_API__ >= 16
/* Before starting the select thread, make sure the disposition for
@@ -579,10 +603,6 @@ android_pending (void)
return i;
}
-/* Forward declaration. */
-
-static void android_check_query (void);
-
/* Wait for events to become available synchronously. Return once an
event arrives. Also, reply to the UI thread whenever it requires a
response. */
@@ -732,6 +752,12 @@ android_select (int nfds, fd_set *readfds, fd_set
*writefds,
static char byte;
#endif
+#ifdef THREADS_ENABLED
+ if (!pthread_equal (pthread_self (), main_thread_id))
+ return pselect (nfds, readfds, writefds, exceptfds, timeout,
+ NULL);
+#endif /* THREADS_ENABLED */
+
/* Since Emacs is reading keyboard input again, signify that queries
from input methods are no longer ``urgent''. */
@@ -837,9 +863,11 @@ android_select (int nfds, fd_set *readfds, fd_set
*writefds,
if (nfds_return < 0)
errno = EINTR;
+#ifndef THREADS_ENABLED
/* Now check for and run anything the UI thread wants to run in the
main thread. */
android_check_query ();
+#endif /* THREADS_ENABLED */
return nfds_return;
}
@@ -1315,12 +1343,17 @@ NATIVE_NAME (setEmacsParams) (JNIEnv *env, jobject
object,
const char *java_string;
struct stat statb;
+#ifdef THREADS_ENABLED
+ /* Save the Java VM. */
+ if ((*env)->GetJavaVM (env, &android_jvm))
+ emacs_abort ();
+#endif /* THREADS_ENABLED */
+
/* Set the Android API level early, as it is used by
`android_vfs_init'. */
android_api_level = api_level;
/* This function should only be called from the main thread. */
-
android_pixel_density_x = pixel_density_x;
android_pixel_density_y = pixel_density_y;
android_scaled_pixel_density = scaled_density;
@@ -1583,16 +1616,13 @@ android_init_emacs_service (void)
FIND_METHOD (draw_point, "drawPoint",
"(Lorg/gnu/emacs/EmacsDrawable;"
"Lorg/gnu/emacs/EmacsGC;II)V");
- FIND_METHOD (clear_window, "clearWindow",
- "(Lorg/gnu/emacs/EmacsWindow;)V");
- FIND_METHOD (clear_area, "clearArea",
- "(Lorg/gnu/emacs/EmacsWindow;IIII)V");
FIND_METHOD (ring_bell, "ringBell", "(I)V");
FIND_METHOD (query_tree, "queryTree",
"(Lorg/gnu/emacs/EmacsWindow;)[S");
FIND_METHOD (get_screen_width, "getScreenWidth", "(Z)I");
FIND_METHOD (get_screen_height, "getScreenHeight", "(Z)I");
FIND_METHOD (detect_mouse, "detectMouse", "()Z");
+ FIND_METHOD (detect_keyboard, "detectKeyboard", "()Z");
FIND_METHOD (name_keysym, "nameKeysym", "(I)Ljava/lang/String;");
FIND_METHOD (browse_url, "browseUrl", "(Ljava/lang/String;Z)"
"Ljava/lang/String;");
@@ -1809,6 +1839,8 @@ android_init_emacs_window (void)
android_damage_window. */
FIND_METHOD (damage_rect, "damageRect", "(IIII)V");
FIND_METHOD (recreate_activity, "recreateActivity", "()V");
+ FIND_METHOD (clear_window, "clearWindow", "()V");
+ FIND_METHOD (clear_area, "clearArea", "(IIII)V");
#undef FIND_METHOD
}
@@ -1842,6 +1874,32 @@ android_init_emacs_cursor (void)
#undef FIND_METHOD
}
+static void
+android_init_key_character_map (void)
+{
+ jclass old;
+
+ key_character_map_class.class
+ = (*android_java_env)->FindClass (android_java_env,
+ "android/view/KeyCharacterMap");
+ eassert (key_character_map_class.class);
+
+ old = key_character_map_class.class;
+ key_character_map_class.class
+ = (jclass) (*android_java_env)->NewGlobalRef (android_java_env,
+ (jobject) old);
+ ANDROID_DELETE_LOCAL_REF (old);
+
+ if (!key_character_map_class.class)
+ emacs_abort ();
+
+ key_character_map_class.get_dead_char
+ = (*android_java_env)->GetStaticMethodID (android_java_env,
+ key_character_map_class.class,
+ "getDeadChar", "(II)I");
+ eassert (key_character_map_class.get_dead_char);
+}
+
JNIEXPORT void JNICALL
NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object, jarray argv,
jobject dump_file_object)
@@ -1890,6 +1948,7 @@ NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object,
jarray argv,
android_init_emacs_drawable ();
android_init_emacs_window ();
android_init_emacs_cursor ();
+ android_init_key_character_map ();
/* Set HOME to the app data directory. */
setenv ("HOME", android_files_dir, 1);
@@ -2496,6 +2555,8 @@ JNIEXPORT jboolean JNICALL
NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env,
jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
/* Yes, android_pass_multimedia_buttons_to_system is being
read from the UI thread. */
return !android_pass_multimedia_buttons_to_system;
@@ -2504,6 +2565,8 @@ NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env,
JNIEXPORT jboolean JNICALL
NATIVE_NAME (shouldForwardCtrlSpace) (JNIEnv *env, jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
return !android_intercept_control_space;
}
@@ -2607,6 +2670,8 @@ JNIEXPORT void JNICALL
NATIVE_NAME (notifyPixelsChanged) (JNIEnv *env, jobject object,
jobject bitmap)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
void *data;
/* Lock and unlock the bitmap. This calls
@@ -2660,6 +2725,8 @@ NATIVE_NAME (answerQuerySpin) (JNIEnv *env, jobject
object)
JNIEXPORT void JNICALL
NATIVE_NAME (setupSystemThread) (void)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
sigset_t sigset;
/* Block everything except for SIGSEGV and SIGBUS; those two are
@@ -3408,10 +3475,9 @@ android_clear_window (android_window handle)
window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
- emacs_service,
- service_class.class,
- service_class.clear_window,
- window);
+ window,
+ window_class.class,
+ window_class.clear_window);
android_exception_check ();
}
@@ -4722,10 +4788,10 @@ android_clear_area (android_window handle, int x, int y,
window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
- emacs_service,
- service_class.class,
- service_class.clear_area,
- window, (jint) x, (jint) y,
+ window,
+ window_class.class,
+ window_class.clear_area,
+ (jint) x, (jint) y,
(jint) width, (jint) height);
}
@@ -5346,11 +5412,51 @@ android_translate_coordinates (android_window src, int
x,
ANDROID_DELETE_LOCAL_REF (coordinates);
}
+/* Return the character produced by combining the diacritic character
+ DCHAR with the key-producing character C in *VALUE. Value is 1 if
+ there is no character for this combination, 0 otherwise. */
+
+static int
+android_get_dead_char (unsigned int dchar, unsigned int c,
+ unsigned int *value)
+{
+ jmethodID method;
+ jclass class;
+ jint result;
+
+ /* Call getDeadChar. */
+ class = key_character_map_class.class;
+ method = key_character_map_class.get_dead_char;
+ result = (*android_java_env)->CallStaticIntMethod (android_java_env,
+ class, method,
+ (jint) dchar,
+ (jint) c);
+
+ if (result)
+ {
+ *value = result;
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Return a Unicode string in BUFFER_RETURN, a buffer of size
+ WCHARS_BUFFER, from the key press event EVENT, much like
+ XmbLookupString. If EVENT represents a key press without a
+ corresponding Unicode character, return its keysym in *KEYSYM_RETURN.
+ Return the action taken in *STATUS_RETURN.
+
+ COMPOSE_STATUS, if non-NULL, should point to a structure for
+ temporary information to be stored in during dead key
+ composition. */
+
int
android_wc_lookup_string (android_key_pressed_event *event,
wchar_t *buffer_return, int wchars_buffer,
int *keysym_return,
- enum android_lookup_status *status_return)
+ enum android_lookup_status *status_return,
+ struct android_compose_status *compose_status)
{
enum android_lookup_status status;
int rc;
@@ -5359,6 +5465,7 @@ android_wc_lookup_string (android_key_pressed_event
*event,
jsize size;
size_t i;
JNIEnv *env;
+ unsigned int unicode_char;
env = android_java_env;
status = ANDROID_LOOKUP_NONE;
@@ -5372,6 +5479,13 @@ android_wc_lookup_string (android_key_pressed_event
*event,
{
if (event->unicode_char)
{
+ /* KeyCharacterMap.COMBINING_ACCENT. */
+ if ((event->unicode_char & 0x80000000) && compose_status)
+ goto dead_key;
+
+ /* Remove combining accent bits. */
+ unicode_char = event->unicode_char & ~0x80000000;
+
if (wchars_buffer < 1)
{
*status_return = ANDROID_BUFFER_OVERFLOW;
@@ -5379,7 +5493,31 @@ android_wc_lookup_string (android_key_pressed_event
*event,
}
else
{
- buffer_return[0] = event->unicode_char;
+ /* If COMPOSE_STATUS holds a diacritic mark unicode_char
+ ought to be combined with, and this combination is
+ valid, return the result alone with no keysym. */
+
+ if (compose_status
+ && compose_status->chars_matched
+ && !android_get_dead_char (compose_status->accent,
+ unicode_char,
+ &unicode_char))
+ {
+ buffer_return[0] = unicode_char;
+ *status_return = ANDROID_LOOKUP_CHARS;
+ compose_status->chars_matched = 0;
+ return 1;
+ }
+ else if (compose_status && compose_status->chars_matched)
+ {
+ /* If the combination is valid the compose status must
+ be reset and no character returned. */
+ compose_status->chars_matched = 0;
+ status = ANDROID_LOOKUP_NONE;
+ return 0;
+ }
+
+ buffer_return[0] = unicode_char;
status = ANDROID_LOOKUP_CHARS;
rc = 1;
}
@@ -5395,8 +5533,14 @@ android_wc_lookup_string (android_key_pressed_event
*event,
rc = 0;
}
+ /* Terminate any ongoing character composition after a key is
+ registered. */
+ if (compose_status
+ /* Provided that a modifier key is not the key being
+ depressed. */
+ && !ANDROID_IS_MODIFIER_KEY (event->keycode))
+ compose_status->chars_matched = 0;
*status_return = status;
-
return rc;
}
@@ -5452,6 +5596,15 @@ android_wc_lookup_string (android_key_pressed_event
*event,
*status_return = status;
return rc;
+
+ dead_key:
+ /* event->unicode_char is a dead key, which are diacritic marks that
+ should not be directly inserted but instead be combined with a
+ subsequent character before insertion. */
+ *status_return = ANDROID_LOOKUP_NONE;
+ compose_status->chars_matched = 1;
+ compose_status->accent = event->unicode_char & ~0x80000000;
+ return 0;
}
@@ -5626,6 +5779,21 @@ android_detect_mouse (void)
return rc;
}
+bool
+android_detect_keyboard (void)
+{
+ bool rc;
+ jmethodID method;
+
+ method = service_class.detect_keyboard;
+ rc = (*android_java_env)->CallNonvirtualBooleanMethod (android_java_env,
+ emacs_service,
+ service_class.class,
+ method);
+ android_exception_check ();
+ return rc;
+}
+
void
android_set_dont_focus_on_map (android_window handle,
bool no_focus_on_map)
@@ -6701,7 +6869,7 @@ static void *android_query_context;
/* Run any function that the UI thread has asked to run, and then
signal its completion. */
-static void
+void
android_check_query (void)
{
void (*proc) (void *);
diff --git a/src/android.h b/src/android.h
index 2f5f32037c5..e1834cebf68 100644
--- a/src/android.h
+++ b/src/android.h
@@ -24,6 +24,8 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
a table of function pointers. */
#ifndef _ANDROID_H_
+#define _ANDROID_H_
+
#ifndef ANDROID_STUBIFY
#include <jni.h>
#include <pwd.h>
@@ -103,6 +105,7 @@ extern int android_get_screen_height (void);
extern int android_get_mm_width (void);
extern int android_get_mm_height (void);
extern bool android_detect_mouse (void);
+extern bool android_detect_keyboard (void);
extern void android_set_dont_focus_on_map (android_window, bool);
extern void android_set_dont_accept_focus (android_window, bool);
@@ -225,6 +228,7 @@ extern void android_display_toast (const char *);
/* Event loop functions. */
+extern void android_check_query (void);
extern void android_check_query_urgent (void);
extern int android_run_in_emacs_thread (void (*) (void *), void *);
extern void android_write_event (union android_event *);
@@ -265,6 +269,7 @@ struct android_emacs_service
jmethodID get_screen_width;
jmethodID get_screen_height;
jmethodID detect_mouse;
+ jmethodID detect_keyboard;
jmethodID name_keysym;
jmethodID browse_url;
jmethodID restart_emacs;
@@ -297,6 +302,10 @@ struct android_emacs_service
extern JNIEnv *android_java_env;
+#ifdef THREADS_ENABLED
+extern JavaVM *android_jvm;
+#endif /* THREADS_ENABLED */
+
/* The EmacsService object. */
extern jobject emacs_service;
diff --git a/src/androidfns.c b/src/androidfns.c
index eaecb78338b..0675a0a3c98 100644
--- a/src/androidfns.c
+++ b/src/androidfns.c
@@ -2287,6 +2287,57 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
goto start_timer;
}
+ else if (tooltip_reuse_hidden_frame && BASE_EQ (frame, tip_last_frame))
+ {
+ bool delete = false;
+ Lisp_Object tail, elt, parm, last;
+
+ /* Check if every parameter in PARMS has the same value in
+ tip_last_parms. This may destruct tip_last_parms which,
+ however, will be recreated below. */
+ for (tail = parms; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ parm = CAR (elt);
+ /* The left, top, right and bottom parameters are handled
+ by compute_tip_xy so they can be ignored here. */
+ if (!EQ (parm, Qleft) && !EQ (parm, Qtop)
+ && !EQ (parm, Qright) && !EQ (parm, Qbottom))
+ {
+ last = Fassq (parm, tip_last_parms);
+ if (NILP (Fequal (CDR (elt), CDR (last))))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ else
+ tip_last_parms
+ = call2 (Qassq_delete_all, parm, tip_last_parms);
+ }
+ else
+ tip_last_parms
+ = call2 (Qassq_delete_all, parm, tip_last_parms);
+ }
+
+ /* Now check if every parameter in what is left of
+ tip_last_parms with a non-nil value has an association in
+ PARMS. */
+ for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ parm = CAR (elt);
+ if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright)
+ && !EQ (parm, Qbottom) && !NILP (CDR (elt)))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ }
+
+ android_hide_tip (delete);
+ }
else
android_hide_tip (true);
}
@@ -2453,7 +2504,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
#endif /* 0 */
return Qnil;
#else /* !ANDROID_STUBIFY */
- return android_hide_tip (true);
+ return android_hide_tip (!tooltip_reuse_hidden_frame);
#endif /* ANDROID_STUBIFY */
}
@@ -2476,6 +2527,25 @@ there is no mouse. */)
#endif
}
+DEFUN ("android-detect-keyboard", Fandroid_detect_keyboard,
+ Sandroid_detect_keyboard, 0, 0, 0,
+ doc: /* Return whether a keyboard is connected.
+Return non-nil if a key is connected to this computer, or nil
+if there is no keyboard. */)
+ (void)
+{
+#ifndef ANDROID_STUBIFY
+ /* If no display connection is present, just return nil. */
+
+ if (!android_init_gui)
+ return Qnil;
+
+ return android_detect_keyboard () ? Qt : Qnil;
+#else /* ANDROID_STUBIFY */
+ return Qt;
+#endif /* ANDROID_STUBIFY */
+}
+
DEFUN ("android-toggle-on-screen-keyboard",
Fandroid_toggle_on_screen_keyboard,
Sandroid_toggle_on_screen_keyboard, 2, 2, 0,
@@ -3197,6 +3267,10 @@ syms_of_androidfns_for_pdumper (void)
jstring string;
Lisp_Object language, country, script, variant;
const char *data;
+ FILE *fd;
+ char *line;
+ size_t size;
+ long pid;
/* Find the Locale class. */
@@ -3367,6 +3441,35 @@ syms_of_androidfns_for_pdumper (void)
/* Set Vandroid_os_language. */
Vandroid_os_language = list4 (language, country, script, variant);
+
+ /* Detect whether Emacs is running under libloader.so or another
+ process tracing mechanism, and disable `android_use_exec_loader' if
+ so, leaving subprocesses started by Emacs to the care of that
+ loader instance. */
+
+ if (android_get_current_api_level () >= 29) /* Q */
+ {
+ fd = fopen ("/proc/self/status", "r");
+ if (!fd)
+ return;
+
+ line = NULL;
+ while (getline (&line, &size, fd) != -1)
+ {
+ if (strncmp (line, "TracerPid:", sizeof "TracerPid:" - 1))
+ continue;
+
+ pid = atol (line + sizeof "TracerPid:" - 1);
+
+ if (pid)
+ android_use_exec_loader = false;
+
+ break;
+ }
+
+ free (line);
+ fclose (fd);
+ }
}
#endif /* ANDROID_STUBIFY */
@@ -3560,6 +3663,7 @@ language to be US English if LANGUAGE is empty. */);
defsubr (&Sx_show_tip);
defsubr (&Sx_hide_tip);
defsubr (&Sandroid_detect_mouse);
+ defsubr (&Sandroid_detect_keyboard);
defsubr (&Sandroid_toggle_on_screen_keyboard);
defsubr (&Sx_server_vendor);
defsubr (&Sx_server_version);
diff --git a/src/androidgui.h b/src/androidgui.h
index 89317581191..73b60c483d3 100644
--- a/src/androidgui.h
+++ b/src/androidgui.h
@@ -612,6 +612,15 @@ struct android_window_changes
enum android_stack_mode stack_mode;
};
+struct android_compose_status
+{
+ /* Accent character to be combined with another. */
+ unsigned int accent;
+
+ /* Number of characters matched. */
+ int chars_matched;
+};
+
extern int android_pending (void);
extern void android_next_event (union android_event *);
extern bool android_check_if_event (union android_event *,
@@ -707,7 +716,8 @@ extern void android_translate_coordinates (android_window,
int,
int, int *, int *);
extern int android_wc_lookup_string (android_key_pressed_event *,
wchar_t *, int, int *,
- enum android_lookup_status *);
+ enum android_lookup_status *,
+ struct android_compose_status *);
extern void android_recreate_activity (android_window);
extern void android_update_ic (android_window, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
diff --git a/src/androidselect.c b/src/androidselect.c
index 5b23c559d2c..61f1c6045db 100644
--- a/src/androidselect.c
+++ b/src/androidselect.c
@@ -237,15 +237,21 @@ DEFUN ("android-clipboard-exists-p",
Fandroid_clipboard_exists_p,
return rc ? Qt : Qnil;
}
-DEFUN ("android-browse-url", Fandroid_browse_url,
- Sandroid_browse_url, 1, 2, 0,
- doc: /* Open URL in an external application. URL should be a
-URL-encoded URL with a scheme specified unless SEND is non-nil.
-Signal an error upon failure.
+DEFUN ("android-browse-url-internal", Fandroid_browse_url_internal,
+ Sandroid_browse_url_internal, 1, 2, 0,
+ doc: /* Open URL in an external application.
+
+URL should be a URL-encoded URL with a scheme specified unless SEND is
+non-nil. Signal an error upon failure.
If SEND is nil, start a program that is able to display the URL, such
as a web browser. Otherwise, try to share URL using programs such as
-email clients. */)
+email clients.
+
+If URL is a file URI, convert it into a `content' address accessible to
+other programs. Files inside the /content or /assets directories cannot
+be opened through such addresses, which this function does not provide
+for. Use `android-browse-url' instead. */)
(Lisp_Object url, Lisp_Object send)
{
Lisp_Object value;
@@ -803,7 +809,7 @@ syms_of_androidselect (void)
defsubr (&Sandroid_set_clipboard);
defsubr (&Sandroid_get_clipboard);
defsubr (&Sandroid_clipboard_exists_p);
- defsubr (&Sandroid_browse_url);
+ defsubr (&Sandroid_browse_url_internal);
defsubr (&Sandroid_get_clipboard_targets);
defsubr (&Sandroid_get_clipboard_data);
diff --git a/src/androidterm.c b/src/androidterm.c
index d4612bb20fa..baf26abe322 100644
--- a/src/androidterm.c
+++ b/src/androidterm.c
@@ -495,8 +495,8 @@ android_note_mouse_movement (struct frame *frame,
/* Has the mouse moved off the glyph it was on at the last sighting? */
r = &dpyinfo->last_mouse_glyph;
if (frame != dpyinfo->last_mouse_glyph_frame
- || event->x < r->x || event->x >= r->x + r->width
- || event->y < r->y || event->y >= r->y + r->height)
+ || event->x < r->x || event->x >= r->x + (int) r->width
+ || event->y < r->y || event->y >= r->y + (int) r->height)
{
frame->mouse_moved = true;
note_mouse_highlight (frame, event->x, event->y);
@@ -811,6 +811,7 @@ handle_one_android_event (struct android_display_info
*dpyinfo,
int keysym;
ptrdiff_t nchars, i;
struct window *w;
+ static struct android_compose_status compose_status;
/* It is okay for this to not resemble handle_one_xevent so much.
Differences in event handling code are much less nasty than
@@ -947,6 +948,14 @@ handle_one_android_event (struct android_display_info
*dpyinfo,
extra_keyboard_modifiers);
modifiers = event->xkey.state;
+ /* In case Meta is ComposeCharacter, clear its status. According
+ to Markus Ehrnsperger
+ Markus.Ehrnsperger@lehrstuhl-bross.physik.uni-muenchen.de this
+ enables ComposeCharacter to work whether or not it is combined
+ with Meta. */
+ if (modifiers & ANDROID_ALT_MASK)
+ memset (&compose_status, 0, sizeof (compose_status));
+
/* Common for all keysym input events. */
XSETFRAME (inev.ie.frame_or_window, any);
inev.ie.modifiers
@@ -960,7 +969,8 @@ handle_one_android_event (struct android_display_info
*dpyinfo,
nchars = android_wc_lookup_string (&event->xkey, copy_bufptr,
copy_bufsiz, &keysym,
- &status_return);
+ &status_return,
+ &compose_status);
/* android_lookup_string can't be called twice, so there's no
way to recover from buffer overflow. */
@@ -1000,6 +1010,13 @@ handle_one_android_event (struct android_display_info
*dpyinfo,
}
}
+ /* If a compose sequence is in progress, we break here.
+ Otherwise, chars_matched is always 0. */
+ if (compose_status.chars_matched > 0 && nchars == 0)
+ break;
+
+ memset (&compose_status, 0, sizeof (compose_status));
+
if (nchars == 1 && copy_bufptr[0] >= 32)
{
/* Deal with characters. */
diff --git a/src/androidvfs.c b/src/androidvfs.c
index 78f6b6da6a8..d618e351204 100644
--- a/src/androidvfs.c
+++ b/src/androidvfs.c
@@ -1018,8 +1018,8 @@ android_extract_long (char *pointer)
static const char *
android_scan_directory_tree (char *file, size_t *limit_return)
{
- char *token, *saveptr, *copy, *copy1, *start, *max, *limit;
- size_t token_length, ntokens, i;
+ char *token, *saveptr, *copy, *start, *max, *limit;
+ size_t token_length, ntokens, i, len;
char *tokens[10];
USE_SAFE_ALLOCA;
@@ -1031,11 +1031,14 @@ android_scan_directory_tree (char *file, size_t
*limit_return)
limit = (char *) directory_tree + directory_tree_size;
/* Now, split `file' into tokens, with the delimiter being the file
- name separator. Look for the file and seek past it. */
+ name separator. Look for the file and seek past it. Create a copy
+ of FILE for the enjoyment of `strtok_r'. */
ntokens = 0;
saveptr = NULL;
- copy = copy1 = xstrdup (file);
+ len = strlen (file) + 1;
+ copy = SAFE_ALLOCA (len);
+ memcpy (copy, file, len);
memset (tokens, 0, sizeof tokens);
while ((token = strtok_r (copy, "/", &saveptr)))
@@ -1044,19 +1047,14 @@ android_scan_directory_tree (char *file, size_t
*limit_return)
/* Make sure ntokens is within bounds. */
if (ntokens == ARRAYELTS (tokens))
- {
- xfree (copy1);
- goto fail;
- }
+ goto fail;
- tokens[ntokens] = SAFE_ALLOCA (strlen (token) + 1);
- memcpy (tokens[ntokens], token, strlen (token) + 1);
+ len = strlen (token) + 1;
+ tokens[ntokens] = SAFE_ALLOCA (len);
+ memcpy (tokens[ntokens], token, len);
ntokens++;
}
- /* Free the copy created for strtok_r. */
- xfree (copy1);
-
/* If there are no tokens, just return the start of the directory
tree. */
@@ -6319,6 +6317,8 @@ static sem_t saf_completion_sem;
JNIEXPORT jint JNICALL
NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
while (sem_wait (&saf_completion_sem) < 0)
{
if (input_blocked_p ())
@@ -6340,6 +6340,8 @@ NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject
object)
JNIEXPORT void JNICALL
NATIVE_NAME (safSync) (JNIEnv *env, jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
while (sem_wait (&saf_completion_sem) < 0)
process_pending_signals ();
}
@@ -6347,12 +6349,16 @@ NATIVE_NAME (safSync) (JNIEnv *env, jobject object)
JNIEXPORT void JNICALL
NATIVE_NAME (safPostRequest) (JNIEnv *env, jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
sem_post (&saf_completion_sem);
}
JNIEXPORT jboolean JNICALL
NATIVE_NAME (ftruncate) (JNIEnv *env, jobject object, jint fd)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
if (ftruncate (fd, 0) < 0)
return false;
diff --git a/src/bidi.c b/src/bidi.c
index a2b5054cb60..36d1a0496b8 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -2908,7 +2908,6 @@ bidi_resolve_brackets (struct bidi_it *bidi_it)
}
else if (bidi_it->bracket_pairing_pos != eob)
{
- eassert (bidi_it->resolved_level == -1);
/* If the cached state shows an increase of embedding level due
to an isolate initiator, we need to update the 1st cached
state of the next run of the current isolating sequence with
@@ -2917,6 +2916,7 @@ bidi_resolve_brackets (struct bidi_it *bidi_it)
if (bidi_it->level_stack[bidi_it->stack_idx].level > prev_level
&& ISOLATE_STATUS (bidi_it, bidi_it->stack_idx))
{
+ eassert (bidi_it->resolved_level == -1);
bidi_record_type_for_neutral (&prev_for_neutral, prev_level, 0);
bidi_record_type_for_neutral (&next_for_neutral, prev_level, 1);
}
@@ -2931,6 +2931,7 @@ bidi_resolve_brackets (struct bidi_it *bidi_it)
}
else if (bidi_it->bracket_pairing_pos == -1)
{
+ eassert (bidi_it->resolved_level == -1);
/* Higher levels were not BPA-resolved yet, even if
cached by bidi_find_bracket_pairs. Force application
of BPA to the new level now. */
diff --git a/src/buffer.c b/src/buffer.c
index 352aca8ddfd..43a9249528c 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -796,14 +796,20 @@ DEFUN ("make-indirect-buffer", Fmake_indirect_buffer,
Smake_indirect_buffer,
BASE-BUFFER should be a live buffer, or the name of an existing buffer.
NAME should be a string which is not the name of an existing buffer.
+
+Interactively, prompt for BASE-BUFFER (offering the current buffer as
+the default), and for NAME (offering as default the name of a recently
+used buffer).
+
Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
such as major and minor modes, in the indirect buffer.
-
CLONE nil means the indirect buffer's state is reset to default values.
If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the new buffer
does not run the hooks `kill-buffer-hook',
-`kill-buffer-query-functions', and `buffer-list-update-hook'. */)
+`kill-buffer-query-functions', and `buffer-list-update-hook'.
+
+Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil. */)
(Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone,
Lisp_Object inhibit_buffer_hooks)
{
@@ -1965,8 +1971,16 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
Lisp_Object tail, other;
FOR_EACH_LIVE_BUFFER (tail, other)
- if (XBUFFER (other)->base_buffer == b)
- Fkill_buffer (other);
+ {
+ struct buffer *obuf = XBUFFER (other);
+ if (obuf->base_buffer == b)
+ {
+ Fkill_buffer (other);
+ if (BUFFER_LIVE_P (obuf))
+ error ("Unable to kill buffer whose indirect buffer `%s' cannot
be killed",
+ SDATA (BVAR (obuf, name)));
+ }
+ }
/* Exit if we now have killed the base buffer (Bug#11665). */
if (!BUFFER_LIVE_P (b))
@@ -3002,7 +3016,7 @@ the normal hook `change-major-mode-hook'. */)
But still return the total number of overlays.
*/
-ptrdiff_t
+static ptrdiff_t
overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend,
Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
bool empty, bool trailing,
@@ -3125,56 +3139,38 @@ mouse_face_overlay_overlaps (Lisp_Object overlay)
{
ptrdiff_t start = OVERLAY_START (overlay);
ptrdiff_t end = OVERLAY_END (overlay);
- ptrdiff_t n, i, size;
- Lisp_Object *v, tem;
- Lisp_Object vbuf[10];
- USE_SAFE_ALLOCA;
+ Lisp_Object tem;
+ struct itree_node *node;
- size = ARRAYELTS (vbuf);
- v = vbuf;
- n = overlays_in (start, end, 0, &v, &size, true, false, NULL);
- if (n > size)
+ ITREE_FOREACH (node, current_buffer->overlays,
+ start, min (end, ZV) + 1,
+ ASCENDING)
{
- SAFE_NALLOCA (v, 1, n);
- overlays_in (start, end, 0, &v, &n, true, false, NULL);
+ if (node->begin < end && node->end > start
+ && node->begin < node->end
+ && !EQ (node->data, overlay)
+ && (tem = Foverlay_get (overlay, Qmouse_face),
+ !NILP (tem)))
+ return true;
}
-
- for (i = 0; i < n; ++i)
- if (!EQ (v[i], overlay)
- && (tem = Foverlay_get (overlay, Qmouse_face),
- !NILP (tem)))
- break;
-
- SAFE_FREE ();
- return i < n;
+ return false;
}
/* Return the value of the 'display-line-numbers-disable' property at
EOB, if there's an overlay at ZV with a non-nil value of that property. */
-Lisp_Object
+bool
disable_line_numbers_overlay_at_eob (void)
{
- ptrdiff_t n, i, size;
- Lisp_Object *v, tem = Qnil;
- Lisp_Object vbuf[10];
- USE_SAFE_ALLOCA;
+ Lisp_Object tem = Qnil;
+ struct itree_node *node;
- size = ARRAYELTS (vbuf);
- v = vbuf;
- n = overlays_in (ZV, ZV, 0, &v, &size, false, false, NULL);
- if (n > size)
+ ITREE_FOREACH (node, current_buffer->overlays, ZV, ZV, ASCENDING)
{
- SAFE_NALLOCA (v, 1, n);
- overlays_in (ZV, ZV, 0, &v, &n, false, false, NULL);
+ if ((tem = Foverlay_get (node->data, Qdisplay_line_numbers_disable),
+ !NILP (tem)))
+ return true;
}
-
- for (i = 0; i < n; ++i)
- if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable),
- !NILP (tem)))
- break;
-
- SAFE_FREE ();
- return tem;
+ return false;
}
diff --git a/src/buffer.h b/src/buffer.h
index 9e0982f5da7..87ba2802b39 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1174,8 +1174,6 @@ extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
extern void compact_buffer (struct buffer *);
extern ptrdiff_t overlays_at (ptrdiff_t, bool, Lisp_Object **, ptrdiff_t *,
ptrdiff_t *);
-extern ptrdiff_t overlays_in (ptrdiff_t, ptrdiff_t, bool, Lisp_Object **,
- ptrdiff_t *, bool, bool, ptrdiff_t *);
extern ptrdiff_t previous_overlay_change (ptrdiff_t);
extern ptrdiff_t next_overlay_change (ptrdiff_t);
extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *);
diff --git a/src/bytecode.c b/src/bytecode.c
index dd805cbd97a..8d7240b9966 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1737,28 +1737,29 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t
args_template,
if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table))
emacs_abort ();
Lisp_Object v1 = POP;
- ptrdiff_t i;
struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table);
-
- /* h->count is a faster approximation for HASH_TABLE_SIZE (h)
- here. */
- if (h->count <= 5 && !h->test->cmpfn)
- { /* Do a linear search if there are not many cases
- FIXME: 5 is arbitrarily chosen. */
- for (i = h->count; 0 <= --i; )
- if (EQ (v1, HASH_KEY (h, i)))
- break;
+ /* Do a linear search if there are few cases and the test is `eq'.
+ (The table is assumed to be sized exactly; all entries are
+ consecutive at the beginning.)
+ FIXME: 5 is arbitrarily chosen. */
+ if (h->count <= 5 && !h->test->cmpfn && !symbols_with_pos_enabled)
+ {
+ eassume (h->count >= 2);
+ for (ptrdiff_t i = h->count - 1; i >= 0; i--)
+ if (BASE_EQ (v1, HASH_KEY (h, i)))
+ {
+ op = XFIXNUM (HASH_VALUE (h, i));
+ goto op_branch;
+ }
}
else
- i = hash_lookup (h, v1);
-
- if (i >= 0)
{
- Lisp_Object val = HASH_VALUE (h, i);
- if (BYTE_CODE_SAFE && !FIXNUMP (val))
- emacs_abort ();
- op = XFIXNUM (val);
- goto op_branch;
+ ptrdiff_t i = hash_lookup (h, v1);
+ if (i >= 0)
+ {
+ op = XFIXNUM (HASH_VALUE (h, i));
+ goto op_branch;
+ }
}
}
NEXT;
diff --git a/src/ccl.c b/src/ccl.c
index a3a03a5b7b1..8bb8a78fe3d 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -35,11 +35,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "coding.h"
#include "keyboard.h"
-/* Avoid GCC 12 bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=105784>. */
-#if GNUC_PREREQ (12, 0, 0)
-# pragma GCC diagnostic ignored "-Wanalyzer-use-of-uninitialized-value"
-#endif
-
/* Table of registered CCL programs. Each element is a vector of
NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the
name of the program, CCL_PROG (vector) is the compiled code of the
@@ -609,7 +604,7 @@ while (0)
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109579
which causes GCC to mistakenly complain about
popping the mapping stack. */
-#if GNUC_PREREQ (13, 0, 0)
+#if __GNUC__ == 13
# pragma GCC diagnostic ignored "-Wanalyzer-out-of-bounds"
#endif
diff --git a/src/comp.c b/src/comp.c
index 853757f6162..3f989c722d4 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -4859,8 +4859,8 @@ add_compiler_options (void)
#endif
}
-DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
- Scomp__compile_ctxt_to_file,
+DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0,
+ Scomp__compile_ctxt_to_file0,
1, 1, 0,
doc: /* Compile the current context as native code to file FILENAME.
*/)
(Lisp_Object filename)
@@ -5789,7 +5789,7 @@ natively-compiled one. */);
defsubr (&Scomp__install_trampoline);
defsubr (&Scomp__init_ctxt);
defsubr (&Scomp__release_ctxt);
- defsubr (&Scomp__compile_ctxt_to_file);
+ defsubr (&Scomp__compile_ctxt_to_file0);
defsubr (&Scomp_libgccjit_version);
defsubr (&Scomp__register_lambda);
defsubr (&Scomp__register_subr);
diff --git a/src/composite.c b/src/composite.c
index 111b1cea88b..e89d923168a 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1147,12 +1147,12 @@ composition_compute_stop_pos (struct composition_it
*cmp_it, ptrdiff_t charpos,
}
else if (charpos > endpos)
{
- /* Search backward for a pattern that may be composed and the
- position of (possibly) the last character of the match is
+ /* Search backward for a pattern that may be composed such that
+ the position of (possibly) the last character of the match is
closest to (but not after) START. The reason for the last
- character is that set_iterator_to_next works in reverse order,
- and thus we must stop at the last character for composition
- check. */
+ character is that set_iterator_to_next works in reverse
+ order, and thus we must stop at the last character for
+ composition check. */
unsigned char *p;
int len;
/* Limit byte position used in fast_looking_at. This is the
@@ -1165,6 +1165,22 @@ composition_compute_stop_pos (struct composition_it
*cmp_it, ptrdiff_t charpos,
p = SDATA (string) + bytepos;
c = string_char_and_length (p, &len);
limit = bytepos + len;
+ /* The algorithmic idea behind the loop below is somewhat tricky
+ and subtle. Keep in mind that any arbitrarily long sequence
+ of composable characters can potentially be composed to end
+ at or before START. So the fact that we find a character C
+ before START that can be composed with several following
+ characters does not mean we can exit the loop, because some
+ character before C could also be composed, yielding a longer
+ composed sequence which ends closer to START. And since a
+ composition can be arbitrarily long, it is very important to
+ know where to stop the search back, because the default --
+ BEGV -- could be VERY far away. Since searching back is only
+ needed when delivering bidirectional text reordered for
+ display, and since no character composition can ever cross
+ into another embedding level, the search could end when it
+ gets to the end of the current embedding level, but this
+ limit should be imposed by the caller. */
while (char_composable_p (c))
{
val = CHAR_TABLE_REF (Vcomposition_function_table, c);
diff --git a/src/conf_post.h b/src/conf_post.h
index 83a0dd1b09b..f2353803074 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -471,3 +471,7 @@ extern int emacs_setenv_TZ (char const *);
#undef MB_CUR_MAX
#define MB_CUR_MAX REPLACEMENT_MB_CUR_MAX
#endif /* REPLACEMENT_MB_CUR_MAX */
+
+/* Emacs does not need glibc strftime behavior for AM and PM
+ indicators. */
+#define REQUIRE_GNUISH_STRFTIME_AM_PM false
diff --git a/src/data.c b/src/data.c
index a66d387cb1f..41c592cb119 100644
--- a/src/data.c
+++ b/src/data.c
@@ -211,7 +211,7 @@ for example, (type-of 1) returns `integer'. */)
return Qcons;
case Lisp_Vectorlike:
- /* WARNING!! Keep 'cl--typeof-types' in sync with this code!! */
+ /* WARNING!! Keep 'cl--type-hierarchy' in sync with this code!! */
switch (PSEUDOVECTOR_TYPE (XVECTOR (object)))
{
case PVEC_NORMAL_VECTOR: return Qvector;
@@ -231,6 +231,7 @@ for example, (type-of 1) returns `integer'. */)
case PVEC_BOOL_VECTOR: return Qbool_vector;
case PVEC_FRAME: return Qframe;
case PVEC_HASH_TABLE: return Qhash_table;
+ case PVEC_OBARRAY: return Qobarray;
case PVEC_FONT:
if (FONT_SPEC_P (object))
return Qfont_spec;
@@ -791,18 +792,16 @@ DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0,
doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */)
(register Lisp_Object sym)
{
- if (BARE_SYMBOL_P (sym))
- return sym;
- /* Type checking is done in the following macro. */
- return SYMBOL_WITH_POS_SYM (sym);
+ CHECK_SYMBOL (sym);
+ return BARE_SYMBOL_P (sym) ? sym : XSYMBOL_WITH_POS_SYM (sym);
}
DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1,
1, 0,
doc: /* Extract the position from a symbol with position. */)
(register Lisp_Object ls)
{
- /* Type checking is done in the following macro. */
- return SYMBOL_WITH_POS_POS (ls);
+ CHECK_TYPE (SYMBOL_WITH_POS_P (ls), Qsymbol_with_pos_p, ls);
+ return XSYMBOL_WITH_POS_POS (ls);
}
DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol,
@@ -812,7 +811,7 @@ Otherwise, return ARG unchanged. Compare with
`bare-symbol'. */)
(register Lisp_Object arg)
{
if (SYMBOL_WITH_POS_P (arg))
- return (SYMBOL_WITH_POS_SYM (arg));
+ return XSYMBOL_WITH_POS_SYM (arg);
return arg;
}
@@ -823,20 +822,13 @@ POS, the position, is either a fixnum or a symbol with
position from which
the position will be taken. */)
(register Lisp_Object sym, register Lisp_Object pos)
{
- Lisp_Object bare;
+ Lisp_Object bare = Fbare_symbol (sym);
Lisp_Object position;
- if (BARE_SYMBOL_P (sym))
- bare = sym;
- else if (SYMBOL_WITH_POS_P (sym))
- bare = XSYMBOL_WITH_POS (sym)->sym;
- else
- wrong_type_argument (Qsymbolp, sym);
-
if (FIXNUMP (pos))
position = pos;
else if (SYMBOL_WITH_POS_P (pos))
- position = XSYMBOL_WITH_POS (pos)->pos;
+ position = XSYMBOL_WITH_POS_POS (pos);
else
wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos);
@@ -4243,6 +4235,7 @@ syms_of_data (void)
DEFSYM (Qtreesit_parser, "treesit-parser");
DEFSYM (Qtreesit_node, "treesit-node");
DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query");
+ DEFSYM (Qobarray, "obarray");
DEFSYM (Qdefun, "defun");
DEFSYM (Qbyte_run__early_defalias, "byte-run--early-defalias");
diff --git a/src/editfns.c b/src/editfns.c
index a764d2e7190..e0d0be4edba 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -272,24 +272,6 @@ If you set the marker not to point anywhere, the buffer
will have no mark. */)
}
-/* Find all the overlays in the current buffer that touch position POS.
- Return the number found, and store them in a vector in VEC
- of length LEN.
-
- Note: this can return overlays that do not touch POS. The caller
- should filter these out. */
-
-static ptrdiff_t
-overlays_around (ptrdiff_t pos, Lisp_Object *vec, ptrdiff_t len)
-{
- /* Find all potentially rear-advance overlays at (POS - 1). Find
- all overlays at POS, so end at (POS + 1). Find even empty
- overlays, which due to the way 'overlays-in' works implies that
- we might also fetch empty overlays starting at (POS + 1). */
- return overlays_in (pos - 1, pos + 1, false, &vec, &len,
- true, false, NULL);
-}
-
DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0,
doc: /* Return the value of POSITION's property PROP, in OBJECT.
Almost identical to `get-char-property' except for the following difference:
@@ -315,53 +297,44 @@ at POSITION. */)
else
{
EMACS_INT posn = XFIXNUM (position);
- ptrdiff_t noverlays;
- Lisp_Object *overlay_vec, tem;
+ Lisp_Object tem;
struct buffer *obuf = current_buffer;
- USE_SAFE_ALLOCA;
-
- set_buffer_temp (XBUFFER (object));
+ struct itree_node *node;
+ struct sortvec items[2];
+ struct buffer *b = XBUFFER (object);
+ struct sortvec *result = NULL;
+ Lisp_Object res = Qnil;
- /* First try with room for 40 overlays. */
- Lisp_Object overlay_vecbuf[40];
- noverlays = ARRAYELTS (overlay_vecbuf);
- overlay_vec = overlay_vecbuf;
- noverlays = overlays_around (posn, overlay_vec, noverlays);
+ set_buffer_temp (b);
- /* If there are more than 40,
- make enough space for all, and try again. */
- if (ARRAYELTS (overlay_vecbuf) < noverlays)
+ ITREE_FOREACH (node, b->overlays, posn - 1, posn + 1, ASCENDING)
{
- SAFE_ALLOCA_LISP (overlay_vec, noverlays);
- noverlays = overlays_around (posn, overlay_vec, noverlays);
- }
- noverlays = sort_overlays (overlay_vec, noverlays, NULL);
-
- set_buffer_temp (obuf);
-
- /* Now check the overlays in order of decreasing priority. */
- while (--noverlays >= 0)
- {
- Lisp_Object ol = overlay_vec[noverlays];
+ Lisp_Object ol = node->data;
tem = Foverlay_get (ol, prop);
- if (!NILP (tem))
- {
+ if (NILP (tem)
/* Check the overlay is indeed active at point. */
- if ((OVERLAY_START (ol) == posn
+ || ((node->begin == posn
&& OVERLAY_FRONT_ADVANCE_P (ol))
- || (OVERLAY_END (ol) == posn
+ || (node->end == posn
&& ! OVERLAY_REAR_ADVANCE_P (ol))
- || OVERLAY_START (ol) > posn
- || OVERLAY_END (ol) < posn)
- ; /* The overlay will not cover a char inserted at point. */
- else
- {
- SAFE_FREE ();
- return tem;
- }
- }
+ || node->begin > posn
+ || node->end < posn))
+ /* The overlay will not cover a char inserted at point. */
+ continue;
+
+ struct sortvec *this = (result == items ? items + 1 : items);
+ if (NILP (res)
+ || (make_sortvec_item (this, node->data),
+ compare_overlays (result, this) < 0))
+ {
+ result = this;
+ res = tem;
+ }
}
- SAFE_FREE ();
+ set_buffer_temp (obuf);
+
+ if (!NILP (res))
+ return res;
{ /* Now check the text properties. */
int stickiness = text_property_stickiness (prop, position, object);
diff --git a/src/emacs.c b/src/emacs.c
index 97c65fbfd33..f4bfb9a6bbd 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -3116,10 +3116,6 @@ shut_down_emacs (int sig, Lisp_Object stuff)
check_message_stack ();
}
-#ifdef HAVE_NATIVE_COMP
- eln_load_path_final_clean_up ();
-#endif
-
#ifdef MSDOS
dos_cleanup ();
#endif
diff --git a/src/fileio.c b/src/fileio.c
index a92da93ae48..483498fd879 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5628,7 +5628,15 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
changed to a call to `stat'. */
if (emacs_fstatat (AT_FDCWD, fn, &st1, 0) == 0
- && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
+ && st.st_dev == st1.st_dev
+ && (st.st_ino == st1.st_ino
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ /* `st1.st_ino' == 0 indicates that the inode number
+ cannot be extracted from this document file, despite
+ `st' potentially being backed by a real file. */
+ || st1.st_ino == 0
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+ ))
{
/* Use the heuristic if it appears to be valid. With neither
O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
diff --git a/src/fns.c b/src/fns.c
index 185abeb8e01..9abdde193cb 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2782,13 +2782,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum
equal_kind equal_kind,
/* A symbol with position compares the contained symbol, and is
`equal' to the corresponding ordinary symbol. */
- if (symbols_with_pos_enabled)
- {
- if (SYMBOL_WITH_POS_P (o1))
- o1 = SYMBOL_WITH_POS_SYM (o1);
- if (SYMBOL_WITH_POS_P (o2))
- o2 = SYMBOL_WITH_POS_SYM (o2);
- }
+ o1 = maybe_remove_pos_from_symbol (o1);
+ o2 = maybe_remove_pos_from_symbol (o2);
if (BASE_EQ (o1, o2))
return true;
@@ -2869,11 +2864,14 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum
equal_kind equal_kind,
if (TS_NODEP (o1))
return treesit_node_eq (o1, o2);
#endif
- if (SYMBOL_WITH_POS_P(o1)) /* symbols_with_pos_enabled is false. */
- return (BASE_EQ (XSYMBOL_WITH_POS (o1)->sym,
- XSYMBOL_WITH_POS (o2)->sym)
- && BASE_EQ (XSYMBOL_WITH_POS (o1)->pos,
- XSYMBOL_WITH_POS (o2)->pos));
+ if (SYMBOL_WITH_POS_P (o1))
+ {
+ eassert (!symbols_with_pos_enabled);
+ return (BASE_EQ (XSYMBOL_WITH_POS_SYM (o1),
+ XSYMBOL_WITH_POS_SYM (o2))
+ && BASE_EQ (XSYMBOL_WITH_POS_POS (o1),
+ XSYMBOL_WITH_POS_POS (o2)));
+ }
/* Aside from them, only true vectors, char-tables, compiled
functions, and fonts (font-spec, font-entity, font-object)
@@ -3211,7 +3209,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a
string. */)
Lisp_Object
do_yes_or_no_p (Lisp_Object prompt)
{
- return call1 (intern ("yes-or-no-p"), prompt);
+ return call1 (Qyes_or_no_p, prompt);
}
DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
@@ -3256,7 +3254,7 @@ by a mouse, or by some window-system gesture, or via a
menu. */)
}
if (use_short_answers)
- return call1 (intern ("y-or-n-p"), prompt);
+ return call1 (Qy_or_n_p, prompt);
{
char *s = SSDATA (prompt);
@@ -4291,7 +4289,7 @@ set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t
idx, hash_hash_t val)
static void
set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
{
- eassert (idx >= 0 && idx < h->index_size);
+ eassert (idx >= 0 && idx < hash_table_index_size (h));
h->index[idx] = val;
}
@@ -4392,7 +4390,7 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
static ptrdiff_t
HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
- eassert (idx >= 0 && idx < h->index_size);
+ eassert (idx >= 0 && idx < hash_table_index_size (h));
return h->index[idx];
}
@@ -4452,22 +4450,11 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2,
return hash_table_user_defined_call (ARRAYELTS (args), args, h);
}
-/* Reduce an EMACS_UINT hash value to hash_hash_t. */
-static inline hash_hash_t
-reduce_emacs_uint_to_hash_hash (EMACS_UINT x)
-{
- verify (sizeof x <= 2 * sizeof (hash_hash_t));
- return (sizeof x == sizeof (hash_hash_t)
- ? x
- : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t)))));
-}
-
static EMACS_INT
sxhash_eq (Lisp_Object key)
{
- if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key))
- key = SYMBOL_WITH_POS_SYM (key);
- return XHASH (key) ^ XTYPE (key);
+ Lisp_Object k = maybe_remove_pos_from_symbol (key);
+ return XHASH (k) ^ XTYPE (k);
}
static EMACS_INT
@@ -4527,26 +4514,19 @@ allocate_hash_table (void)
return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE);
}
-/* Compute the size of the index from the table capacity. */
-static ptrdiff_t
-hash_index_size (ptrdiff_t size)
-{
- /* An upper bound on the size of a hash table index. It must fit in
- ptrdiff_t and be a valid Emacs fixnum. */
- ptrdiff_t upper_bound = min (MOST_POSITIVE_FIXNUM,
- min (TYPE_MAXIMUM (hash_idx_t),
- PTRDIFF_MAX / sizeof (ptrdiff_t)));
- /* Single-element index vectors are used iff size=0. */
- eassert (size > 0);
- ptrdiff_t lower_bound = 2;
- ptrdiff_t index_size = size + max (size >> 2, 1); /* 1.25x larger */
- if (index_size < upper_bound)
- index_size = (index_size < lower_bound
- ? lower_bound
- : next_almost_prime (index_size));
- if (index_size > upper_bound)
+/* Compute the size of the index (as log2) from the table capacity. */
+static int
+compute_hash_index_bits (hash_idx_t size)
+{
+ /* An upper bound on the size of a hash table index index. */
+ hash_idx_t upper_bound = min (MOST_POSITIVE_FIXNUM,
+ min (TYPE_MAXIMUM (hash_idx_t),
+ PTRDIFF_MAX / sizeof (hash_idx_t)));
+ /* Use next higher power of 2. This works even for size=0. */
+ int bits = elogb (size) + 1;
+ if (bits >= TYPE_WIDTH (uintmax_t) || ((uintmax_t)1 << bits) > upper_bound)
error ("Hash table too large");
- return index_size;
+ return bits;
}
/* Constant hash index vector used when the table size is zero.
@@ -4587,7 +4567,7 @@ make_hash_table (const struct hash_table_test *test,
EMACS_INT size,
h->key_and_value = NULL;
h->hash = NULL;
h->next = NULL;
- h->index_size = 1;
+ h->index_bits = 0;
h->index = (hash_idx_t *)empty_hash_index_vector;
h->next_free = -1;
}
@@ -4605,8 +4585,9 @@ make_hash_table (const struct hash_table_test *test,
EMACS_INT size,
h->next[i] = i + 1;
h->next[size - 1] = -1;
- int index_size = hash_index_size (size);
- h->index_size = index_size;
+ int index_bits = compute_hash_index_bits (size);
+ h->index_bits = index_bits;
+ ptrdiff_t index_size = hash_table_index_size (h);
h->index = hash_table_alloc_bytes (index_size * sizeof *h->index);
for (ptrdiff_t i = 0; i < index_size; i++)
h->index[i] = -1;
@@ -4617,13 +4598,7 @@ make_hash_table (const struct hash_table_test *test,
EMACS_INT size,
h->next_weak = NULL;
h->purecopy = purecopy;
h->mutable = true;
-
- Lisp_Object table;
- XSET_HASH_TABLE (table, h);
- eassert (HASH_TABLE_P (table));
- eassert (XHASH_TABLE (table) == h);
-
- return table;
+ return make_lisp_hash_table (h);
}
@@ -4633,7 +4608,6 @@ make_hash_table (const struct hash_table_test *test,
EMACS_INT size,
static Lisp_Object
copy_hash_table (struct Lisp_Hash_Table *h1)
{
- Lisp_Object table;
struct Lisp_Hash_Table *h2;
h2 = allocate_hash_table ();
@@ -4654,22 +4628,18 @@ copy_hash_table (struct Lisp_Hash_Table *h1)
h2->next = hash_table_alloc_bytes (next_bytes);
memcpy (h2->next, h1->next, next_bytes);
- ptrdiff_t index_bytes = h1->index_size * sizeof *h1->index;
+ ptrdiff_t index_bytes = hash_table_index_size (h1) * sizeof *h1->index;
h2->index = hash_table_alloc_bytes (index_bytes);
memcpy (h2->index, h1->index, index_bytes);
}
- XSET_HASH_TABLE (table, h2);
-
- return table;
+ return make_lisp_hash_table (h2);
}
-
/* Compute index into the index vector from a hash value. */
static inline ptrdiff_t
hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash)
{
- eassert (h->index_size > 0);
- return hash % h->index_size;
+ return knuth_hash (hash, h->index_bits);
}
/* Resize hash table H if it's too full. If H cannot be resized
@@ -4681,7 +4651,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
if (h->next_free < 0)
{
ptrdiff_t old_size = HASH_TABLE_SIZE (h);
- ptrdiff_t min_size = 8;
+ ptrdiff_t min_size = 6;
ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2);
/* Grow aggressively at small sizes, then just double. */
ptrdiff_t new_size =
@@ -4706,13 +4676,14 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash);
memcpy (hash, h->hash, old_size * sizeof *hash);
- ptrdiff_t old_index_size = h->index_size;
- ptrdiff_t index_size = hash_index_size (new_size);
+ ptrdiff_t old_index_size = hash_table_index_size (h);
+ ptrdiff_t index_bits = compute_hash_index_bits (new_size);
+ ptrdiff_t index_size = (ptrdiff_t)1 << index_bits;
hash_idx_t *index = hash_table_alloc_bytes (index_size * sizeof *index);
for (ptrdiff_t i = 0; i < index_size; i++)
index[i] = -1;
- h->index_size = index_size;
+ h->index_bits = index_bits;
h->table_size = new_size;
h->next_free = old_size;
@@ -4778,18 +4749,19 @@ hash_table_thaw (Lisp_Object hash_table)
h->key_and_value = NULL;
h->hash = NULL;
h->next = NULL;
- h->index_size = 1;
+ h->index_bits = 0;
h->index = (hash_idx_t *)empty_hash_index_vector;
}
else
{
- ptrdiff_t index_size = hash_index_size (size);
- h->index_size = index_size;
+ ptrdiff_t index_bits = compute_hash_index_bits (size);
+ h->index_bits = index_bits;
h->hash = hash_table_alloc_bytes (size * sizeof *h->hash);
h->next = hash_table_alloc_bytes (size * sizeof *h->next);
+ ptrdiff_t index_size = hash_table_index_size (h);
h->index = hash_table_alloc_bytes (index_size * sizeof *h->index);
for (ptrdiff_t i = 0; i < index_size; i++)
h->index[i] = -1;
@@ -4937,7 +4909,8 @@ hash_clear (struct Lisp_Hash_Table *h)
set_hash_value_slot (h, i, Qnil);
}
- for (ptrdiff_t i = 0; i < h->index_size; i++)
+ ptrdiff_t index_size = hash_table_index_size (h);
+ for (ptrdiff_t i = 0; i < index_size; i++)
h->index[i] = -1;
h->next_free = 0;
@@ -4976,7 +4949,7 @@ keep_entry_p (hash_table_weakness_t weakness,
bool
sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
{
- ptrdiff_t n = h->index_size;
+ ptrdiff_t n = hash_table_index_size (h);
bool marked = false;
for (ptrdiff_t bucket = 0; bucket < n; ++bucket)
@@ -5072,24 +5045,52 @@ hash_string (char const *ptr, ptrdiff_t len)
EMACS_UINT hash = len;
/* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course,
* but dividing by 8 is cheaper. */
- ptrdiff_t step = sizeof hash + ((end - p) >> 3);
+ ptrdiff_t step = max (sizeof hash, ((end - p) >> 3));
- while (p + sizeof hash <= end)
+ if (p + sizeof hash <= end)
{
+ do
+ {
+ EMACS_UINT c;
+ /* We presume that the compiler will replace this `memcpy` with
+ a single load/move instruction when applicable. */
+ memcpy (&c, p, sizeof hash);
+ p += step;
+ hash = sxhash_combine (hash, c);
+ }
+ while (p + sizeof hash <= end);
+ /* Hash the last wordful of bytes in the string, because that is
+ is often the part where strings differ. This may cause some
+ bytes to be hashed twice but we assume that's not a big problem. */
EMACS_UINT c;
- /* We presume that the compiler will replace this `memcpy` with
- a single load/move instruction when applicable. */
- memcpy (&c, p, sizeof hash);
- p += step;
+ memcpy (&c, end - sizeof c, sizeof c);
hash = sxhash_combine (hash, c);
}
- /* A few last bytes may remain (smaller than an EMACS_UINT). */
- /* FIXME: We could do this without a loop, but it'd require
- endian-dependent code :-( */
- while (p < end)
+ else
{
- unsigned char c = *p++;
- hash = sxhash_combine (hash, c);
+ /* String is shorter than an EMACS_UINT. Use smaller loads. */
+ eassume (p <= end && end - p < sizeof (EMACS_UINT));
+ EMACS_UINT tail = 0;
+ verify (sizeof tail <= 8);
+#if EMACS_INT_MAX > INT32_MAX
+ if (end - p >= 4)
+ {
+ uint32_t c;
+ memcpy (&c, p, sizeof c);
+ tail = (tail << (8 * sizeof c)) + c;
+ p += sizeof c;
+ }
+#endif
+ if (end - p >= 2)
+ {
+ uint16_t c;
+ memcpy (&c, p, sizeof c);
+ tail = (tail << (8 * sizeof c)) + c;
+ p += sizeof c;
+ }
+ if (p < end)
+ tail = (tail << 8) + (unsigned char)*p;
+ hash = sxhash_combine (hash, tail);
}
return hash;
@@ -5177,7 +5178,7 @@ sxhash_bignum (Lisp_Object bignum)
{
mpz_t const *n = xbignum_val (bignum);
size_t i, nlimbs = mpz_size (*n);
- EMACS_UINT hash = 0;
+ EMACS_UINT hash = mpz_sgn(*n) < 0;
for (i = 0; i < nlimbs; ++i)
hash = sxhash_combine (hash, mpz_getlimbn (*n, i));
@@ -5247,12 +5248,15 @@ sxhash_obj (Lisp_Object obj, int depth)
hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist,
depth));
return hash;
}
- else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS)
- return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1);
else
- /* Others are 'equal' if they are 'eq', so take their
- address as hash. */
- return XHASH (obj);
+ {
+ if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS)
+ obj = XSYMBOL_WITH_POS_SYM (obj);
+
+ /* Others are 'equal' if they are 'eq', so take their
+ address as hash. */
+ return XHASH (obj);
+ }
}
case Lisp_Cons:
@@ -5374,7 +5378,7 @@ mark_fns (void)
}
}
-/* Find the hash_table_test object correponding to the (bare) symbol TEST,
+/* Find the hash_table_test object corresponding to the (bare) symbol TEST,
creating one if none existed. */
static struct hash_table_test *
get_hash_table_user_test (Lisp_Object test)
@@ -5447,9 +5451,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
/* See if there's a `:test TEST' among the arguments. */
ptrdiff_t i = get_key_arg (QCtest, nargs, args, used);
- Lisp_Object test = i ? args[i] : Qeql;
- if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test))
- test = SYMBOL_WITH_POS_SYM (test);
+ Lisp_Object test = i ? maybe_remove_pos_from_symbol (args[i]) : Qeql;
const struct hash_table_test *testdesc;
if (BASE_EQ (test, Qeq))
testdesc = &hashtest_eq;
@@ -5708,7 +5710,7 @@ DEFUN ("internal--hash-table-histogram",
struct Lisp_Hash_Table *h = check_hash_table (hash_table);
ptrdiff_t size = HASH_TABLE_SIZE (h);
ptrdiff_t *freq = xzalloc (size * sizeof *freq);
- ptrdiff_t index_size = h->index_size;
+ ptrdiff_t index_size = hash_table_index_size (h);
for (ptrdiff_t i = 0; i < index_size; i++)
{
ptrdiff_t n = 0;
@@ -5736,7 +5738,7 @@ Internal use only. */)
{
struct Lisp_Hash_Table *h = check_hash_table (hash_table);
Lisp_Object ret = Qnil;
- ptrdiff_t index_size = h->index_size;
+ ptrdiff_t index_size = hash_table_index_size (h);
for (ptrdiff_t i = 0; i < index_size; i++)
{
Lisp_Object bucket = Qnil;
@@ -5757,7 +5759,7 @@ DEFUN ("internal--hash-table-index-size",
(Lisp_Object hash_table)
{
struct Lisp_Hash_Table *h = check_hash_table (hash_table);
- return make_int (h->index_size);
+ return make_int (hash_table_index_size (h));
}
@@ -6625,4 +6627,6 @@ For best results this should end in a space. */);
DEFSYM (Qreal_this_command, "real-this-command");
DEFSYM (Qfrom__tty_menu_p, "from--tty-menu-p");
+ DEFSYM (Qyes_or_no_p, "yes-or-no-p");
+ DEFSYM (Qy_or_n_p, "y-or-n-p");
}
diff --git a/src/inotify.c b/src/inotify.c
index 2ee874530cc..7140568f1b6 100644
--- a/src/inotify.c
+++ b/src/inotify.c
@@ -26,6 +26,8 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "termhooks.h"
#include <errno.h>
+#include <fcntl.h>
+
#include <sys/inotify.h>
#include <sys/ioctl.h>
@@ -434,7 +436,15 @@ IN_ONESHOT */)
if (inotifyfd < 0)
{
+#ifdef HAVE_INOTIFY_INIT1
inotifyfd = inotify_init1 (IN_NONBLOCK | IN_CLOEXEC);
+#else /* !HAVE_INOTIFY_INIT1 */
+ /* This is prey to race conditions with other threads calling
+ exec. */
+ inotifyfd = inotify_init ();
+ fcntl (inotifyfd, F_SETFL, O_NONBLOCK);
+ fcntl (inotifyfd, F_SETFD, O_CLOEXEC);
+#endif /* HAVE_INOTIFY_INIT1 */
if (inotifyfd < 0)
report_file_notify_error ("File watching is not available", Qnil);
watch_list = Qnil;
diff --git a/src/keyboard.c b/src/keyboard.c
index 1f7253a7da1..eb0de98bad1 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -580,7 +580,10 @@ echo_dash (void)
idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1);
last_char = Faref (KVAR (current_kboard, echo_string), idx);
- if (XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ')
+ if ((XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ')
+ /* Or a keystroke help message. */
+ || (echo_keystrokes_help
+ && XFIXNUM (last_char) == ')' && XFIXNUM (prev_char) == 'p'))
return;
}
@@ -589,6 +592,12 @@ echo_dash (void)
AUTO_STRING (dash, "-");
kset_echo_string (current_kboard,
concat2 (KVAR (current_kboard, echo_string), dash));
+
+ if (echo_keystrokes_help)
+ kset_echo_string (current_kboard,
+ calln (Qhelp__append_keystrokes_help,
+ KVAR (current_kboard, echo_string)));
+
echo_now ();
}
@@ -1067,8 +1076,9 @@ Default value of `command-error-function'. */)
write to stderr and quit. In daemon mode, there are
many other potential errors that do not prevent frames
from being created, so continuing as normal is better in
- that case. */
- || (!IS_DAEMON && FRAME_INITIAL_P (sf))
+ that case, as long as the daemon has actually finished
+ initialization. */
+ || (!(IS_DAEMON && !DAEMON_RUNNING) && FRAME_INITIAL_P (sf))
|| noninteractive))
{
print_error_message (data, Qexternal_debugging_output,
@@ -12948,6 +12958,8 @@ syms_of_keyboard (void)
DEFSYM (Qhelp_key_binding, "help-key-binding");
+ DEFSYM (Qhelp__append_keystrokes_help, "help--append-keystrokes-help");
+
DEFSYM (Qecho_keystrokes, "echo-keystrokes");
Fset (Qinput_method_exit_on_first_char, Qnil);
@@ -13223,11 +13235,17 @@ Emacs also does a garbage collection if that seems to
be warranted. */);
XSETFASTINT (Vauto_save_timeout, 30);
DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes,
- doc: /* Nonzero means echo unfinished commands after this many
seconds of pause.
+ doc: /* Nonzero means echo unfinished commands after this many seconds of
pause.
The value may be integer or floating point.
If the value is zero, don't echo at all. */);
Vecho_keystrokes = make_fixnum (1);
+ DEFVAR_BOOL ("echo-keystrokes-help", echo_keystrokes_help,
+ doc: /* Whether to append help text to echoed commands.
+When non-nil, a reference to `C-h' is printed after echoed
+keystrokes. */);
+ echo_keystrokes_help = true;
+
DEFVAR_LISP ("polling-period", Vpolling_period,
doc: /* Interval between polling for input during Lisp execution.
The reason for polling is to make C-g work to stop a running program.
diff --git a/src/lisp.h b/src/lisp.h
index d6f99c96bff..ab967e0403b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -330,7 +330,8 @@ typedef EMACS_INT Lisp_Word;
without worrying about the implementations diverging, since
lisp_h_OP defines the actual implementation. The lisp_h_OP macros
are intended to be private to this include file, and should not be
- used elsewhere.
+ used elsewhere. They should evaluate each argument exactly once,
+ so that they behave like their functional counterparts.
FIXME: Remove the lisp_h_OP macros, and define just the inline OP
functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well
@@ -372,39 +373,12 @@ typedef EMACS_INT Lisp_Word;
# define lisp_h_Qnil {0}
#endif
-#define lisp_h_PSEUDOVECTORP(a,code) \
- (lisp_h_VECTORLIKEP (a) \
- && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size \
- & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
- == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))))
-
#define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x)
#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
#define lisp_h_CHECK_TYPE(ok, predicate, x) \
((ok) ? (void) 0 : wrong_type_argument (predicate, x))
#define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons)
#define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y))
-#define lisp_h_BASE2_EQ(x, y) \
- (BASE_EQ (x, y) \
- || (symbols_with_pos_enabled \
- && SYMBOL_WITH_POS_P (x) \
- && BASE_EQ (XSYMBOL_WITH_POS (x)->sym, y)))
-
-/* FIXME: Do we really need to inline the whole thing?
- * What about keeping the part after `symbols_with_pos_enabled` in
- * a separate function? */
-#define lisp_h_EQ(x, y) \
- (XLI (x) == XLI (y) \
- || (symbols_with_pos_enabled \
- && (SYMBOL_WITH_POS_P (x) \
- ? (BARE_SYMBOL_P (y) \
- ? XLI (XSYMBOL_WITH_POS (x)->sym) == XLI (y) \
- : (SYMBOL_WITH_POS_P (y) \
- && (XLI (XSYMBOL_WITH_POS (x)->sym) \
- == XLI (XSYMBOL_WITH_POS (y)->sym)))) \
- : (SYMBOL_WITH_POS_P (y) \
- && BARE_SYMBOL_P (x) \
- && (XLI (x) == XLI (XSYMBOL_WITH_POS (y)->sym))))))
#define lisp_h_FIXNUMP(x) \
(! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \
@@ -412,18 +386,11 @@ typedef EMACS_INT Lisp_Word;
& ((1 << INTTYPEBITS) - 1)))
#define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float)
#define lisp_h_NILP(x) BASE_EQ (x, Qnil)
-#define lisp_h_SET_SYMBOL_VAL(sym, v) \
- (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \
- (sym)->u.s.val.value = (v))
#define lisp_h_SYMBOL_CONSTANT_P(sym) \
(XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE)
#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
-#define lisp_h_SYMBOL_VAL(sym) \
- (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS)
#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol)
-#define lisp_h_SYMBOLP(x) \
- (BARE_SYMBOL_P (x) || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x)))
#define lisp_h_TAGGEDP(a, tag) \
(! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
- (unsigned) (tag)) \
@@ -431,8 +398,6 @@ typedef EMACS_INT Lisp_Word;
#define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike)
#define lisp_h_XCAR(c) XCONS (c)->u.s.car
#define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
-#define lisp_h_XCONS(a) \
- (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons))
#define lisp_h_XHASH(a) XUFIXNUM_RAW (a)
#if USE_LSB_TAG
# define lisp_h_make_fixnum_wrap(n) \
@@ -474,20 +439,15 @@ typedef EMACS_INT Lisp_Word;
# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
# define CONSP(x) lisp_h_CONSP (x)
# define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y)
-# define BASE2_EQ(x, y) lisp_h_BASE2_EQ (x, y)
# define FLOATP(x) lisp_h_FLOATP (x)
# define FIXNUMP(x) lisp_h_FIXNUMP (x)
# define NILP(x) lisp_h_NILP (x)
-# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
-# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
-/* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */ /* X is accessed more than once.
*/
# define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag)
# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
# define XCAR(c) lisp_h_XCAR (c)
# define XCDR(c) lisp_h_XCDR (c)
-# define XCONS(a) lisp_h_XCONS (a)
# define XHASH(a) lisp_h_XHASH (a)
# if USE_LSB_TAG
# define make_fixnum(n) lisp_h_make_fixnum (n)
@@ -518,6 +478,16 @@ typedef EMACS_INT Lisp_Word;
#endif
+/* Lisp_Object tagging scheme:
+ Tag location
+ Upper bits Lower bits Type Payload
+ 000....... .......000 symbol offset from lispsym to struct
Lisp_Symbol
+ 001....... .......001 unused
+ 01........ ........10 fixnum signed integer of FIXNUM_BITS
+ 110....... .......011 cons pointer to struct Lisp_Cons
+ 100....... .......100 string pointer to struct Lisp_String
+ 101....... .......101 vectorlike pointer to union vectorlike_header
+ 111....... .......111 float pointer to struct Lisp_Float */
enum Lisp_Type
{
/* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
@@ -1062,6 +1032,7 @@ enum pvec_type
PVEC_BOOL_VECTOR,
PVEC_BUFFER,
PVEC_HASH_TABLE,
+ PVEC_OBARRAY,
PVEC_TERMINAL,
PVEC_WINDOW_CONFIGURATION,
PVEC_SUBR,
@@ -1121,7 +1092,10 @@ enum More_Lisp_Bits
INLINE bool
PSEUDOVECTORP (Lisp_Object a, int code)
{
- return lisp_h_PSEUDOVECTORP (a, code);
+ return (lisp_h_VECTORLIKEP (a)
+ && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size
+ & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))
+ == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))));
}
INLINE bool
@@ -1137,9 +1111,10 @@ INLINE bool
}
INLINE bool
-(SYMBOLP) (Lisp_Object x)
+SYMBOLP (Lisp_Object x)
{
- return lisp_h_SYMBOLP (x);
+ return (BARE_SYMBOL_P (x)
+ || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x)));
}
INLINE struct Lisp_Symbol_With_Pos *
@@ -1149,6 +1124,27 @@ XSYMBOL_WITH_POS (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos);
}
+INLINE Lisp_Object
+XSYMBOL_WITH_POS_SYM (Lisp_Object a)
+{
+ Lisp_Object sym = XSYMBOL_WITH_POS (a)->sym;
+ eassume (BARE_SYMBOL_P (sym));
+ return sym;
+}
+
+INLINE Lisp_Object
+XSYMBOL_WITH_POS_POS (Lisp_Object a)
+{
+ return XSYMBOL_WITH_POS (a)->pos;
+}
+
+INLINE Lisp_Object
+maybe_remove_pos_from_symbol (Lisp_Object x)
+{
+ return (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x)
+ ? XSYMBOL_WITH_POS_SYM (x) : x);
+}
+
INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
XBARE_SYMBOL (Lisp_Object a)
{
@@ -1163,8 +1159,8 @@ XSYMBOL (Lisp_Object a)
{
if (!BARE_SYMBOL_P (a))
{
- eassert (symbols_with_pos_enabled);
- a = XSYMBOL_WITH_POS (a)->sym;
+ eassume (symbols_with_pos_enabled);
+ a = XSYMBOL_WITH_POS_SYM (a);
}
return XBARE_SYMBOL (a);
}
@@ -1352,20 +1348,15 @@ INLINE bool
return lisp_h_BASE_EQ (x, y);
}
-/* Return true if X and Y are the same object, reckoning X to be the
- same as a bare symbol Y if X is Y with position. */
-INLINE bool
-(BASE2_EQ) (Lisp_Object x, Lisp_Object y)
-{
- return lisp_h_BASE2_EQ (x, y);
-}
-
/* Return true if X and Y are the same object, reckoning a symbol with
position as being the same as the bare symbol. */
INLINE bool
-(EQ) (Lisp_Object x, Lisp_Object y)
+EQ (Lisp_Object x, Lisp_Object y)
{
- return lisp_h_EQ (x, y);
+ return BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x)
+ ? XSYMBOL_WITH_POS_SYM (x) : x),
+ (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y)
+ ? XSYMBOL_WITH_POS_SYM (y) : y));
}
INLINE intmax_t
@@ -1510,9 +1501,10 @@ CHECK_CONS (Lisp_Object x)
}
INLINE struct Lisp_Cons *
-(XCONS) (Lisp_Object a)
+XCONS (Lisp_Object a)
{
- return lisp_h_XCONS (a);
+ eassert (CONSP (a));
+ return XUNTAG (a, Lisp_Cons, struct Lisp_Cons);
}
/* Take the car or cdr of something known to be a cons cell. */
@@ -2297,9 +2289,10 @@ typedef jmp_buf sys_jmp_buf;
/* Value is name of symbol. */
INLINE Lisp_Object
-(SYMBOL_VAL) (struct Lisp_Symbol *sym)
+SYMBOL_VAL (struct Lisp_Symbol *sym)
{
- return lisp_h_SYMBOL_VAL (sym);
+ eassert (sym->u.s.redirect == SYMBOL_PLAINVAL);
+ return sym->u.s.val.value;
}
INLINE struct Lisp_Symbol *
@@ -2322,9 +2315,10 @@ SYMBOL_FWD (struct Lisp_Symbol *sym)
}
INLINE void
-(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v)
+SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v)
{
- lisp_h_SET_SYMBOL_VAL (sym, v);
+ eassert (sym->u.s.redirect == SYMBOL_PLAINVAL);
+ sym->u.s.val.value = v;
}
INLINE void
@@ -2393,6 +2387,118 @@ INLINE int
definition is done by lread.c's define_symbol. */
#define DEFSYM(sym, name) /* empty */
+
+struct Lisp_Obarray
+{
+ union vectorlike_header header;
+
+ /* Array of 2**size_bits values, each being either a (bare) symbol or
+ the fixnum 0. The symbols for each bucket are chained via
+ their s.next field. */
+ Lisp_Object *buckets;
+
+ unsigned size_bits; /* log2(size of buckets vector) */
+ unsigned count; /* number of symbols in obarray */
+};
+
+INLINE bool
+OBARRAYP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_OBARRAY);
+}
+
+INLINE struct Lisp_Obarray *
+XOBARRAY (Lisp_Object a)
+{
+ eassert (OBARRAYP (a));
+ return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Obarray);
+}
+
+INLINE void
+CHECK_OBARRAY (Lisp_Object x)
+{
+ CHECK_TYPE (OBARRAYP (x), Qobarrayp, x);
+}
+
+INLINE Lisp_Object
+make_lisp_obarray (struct Lisp_Obarray *o)
+{
+ eassert (PSEUDOVECTOR_TYPEP (&o->header, PVEC_OBARRAY));
+ return make_lisp_ptr (o, Lisp_Vectorlike);
+}
+
+INLINE ptrdiff_t
+obarray_size (const struct Lisp_Obarray *o)
+{
+ return (ptrdiff_t)1 << o->size_bits;
+}
+
+Lisp_Object check_obarray_slow (Lisp_Object);
+
+/* Return an obarray object from OBARRAY or signal an error. */
+INLINE Lisp_Object
+check_obarray (Lisp_Object obarray)
+{
+ return OBARRAYP (obarray) ? obarray : check_obarray_slow (obarray);
+}
+
+/* Obarray iterator state. Don't access these members directly.
+ The iterator functions must be called in the order followed by DOOBARRAY.
*/
+typedef struct {
+ struct Lisp_Obarray *o;
+ ptrdiff_t idx; /* Current bucket index. */
+ struct Lisp_Symbol *symbol; /* Current symbol, or NULL if at end
+ of current bucket. */
+} obarray_iter_t;
+
+INLINE obarray_iter_t
+make_obarray_iter (struct Lisp_Obarray *oa)
+{
+ return (obarray_iter_t){.o = oa, .idx = -1, .symbol = NULL};
+}
+
+/* Whether IT has reached the end and there are no more symbols.
+ If true, IT is dead and cannot be used any more. */
+INLINE bool
+obarray_iter_at_end (obarray_iter_t *it)
+{
+ if (it->symbol)
+ return false;
+ ptrdiff_t size = obarray_size (it->o);
+ while (++it->idx < size)
+ {
+ Lisp_Object obj = it->o->buckets[it->idx];
+ if (!BASE_EQ (obj, make_fixnum (0)))
+ {
+ it->symbol = XBARE_SYMBOL (obj);
+ return false;
+ }
+ }
+ return true;
+}
+
+/* Advance IT to the next symbol if any. */
+INLINE void
+obarray_iter_step (obarray_iter_t *it)
+{
+ it->symbol = it->symbol->u.s.next;
+}
+
+/* The Lisp symbol at IT, if obarray_iter_at_end returned false. */
+INLINE Lisp_Object
+obarray_iter_symbol (obarray_iter_t *it)
+{
+ return make_lisp_symbol (it->symbol);
+}
+
+/* Iterate IT over the symbols of the obarray OA.
+ The body shouldn't add or remove symbols in OA, but disobeying that rule
+ only risks symbols to be iterated more than once or not at all,
+ not crashes or data corruption. */
+#define DOOBARRAY(oa, it) \
+ for (obarray_iter_t it = make_obarray_iter (oa); \
+ !obarray_iter_at_end (&it); obarray_iter_step (&it))
+
/***********************************************************************
Hash Tables
@@ -2475,14 +2581,11 @@ struct Lisp_Hash_Table
The table is physically split into three vectors (hash, next,
key_and_value) which may or may not be beneficial. */
- hash_idx_t index_size; /* Size of the index vector. */
- hash_idx_t table_size; /* Size of the next and hash vectors. */
-
/* Bucket vector. An entry of -1 indicates no item is present,
and a nonnegative entry is the index of the first item in
a collision chain.
- This vector is index_size entries long.
- If index_size is 1 (and table_size is 0), then this is the
+ This vector is 2**index_bits entries long.
+ If index_bits is 0 (and table_size is 0), then this is the
constant read-only vector {-1}, shared between all instances.
Otherwise it is heap-allocated. */
hash_idx_t *index;
@@ -2514,20 +2617,24 @@ struct Lisp_Hash_Table
/* Index of first free entry in free list, or -1 if none. */
hash_idx_t next_free;
+ hash_idx_t table_size; /* Size of the next and hash vectors. */
+
+ unsigned char index_bits; /* log2 (size of the index vector). */
+
/* Weakness of the table. */
- hash_table_weakness_t weakness : 8;
+ hash_table_weakness_t weakness : 3;
/* Hash table test (only used when frozen in dump) */
- hash_table_std_test_t frozen_test : 8;
+ hash_table_std_test_t frozen_test : 2;
/* True if the table can be purecopied. The table cannot be
changed afterwards. */
- bool purecopy;
+ bool_bf purecopy : 1;
/* True if the table is mutable. Ordinarily tables are mutable, but
pure tables are not, and while a table is being mutated it is
immutable for recursive attempts to mutate it. */
- bool mutable;
+ bool_bf mutable : 1;
/* Next weak hash table if this is a weak hash table. The head of
the list is in weak_hash_tables. Used only during garbage
@@ -2563,8 +2670,12 @@ XHASH_TABLE (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Hash_Table);
}
-#define XSET_HASH_TABLE(VAR, PTR) \
- XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)
+INLINE Lisp_Object
+make_lisp_hash_table (struct Lisp_Hash_Table *h)
+{
+ eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_HASH_TABLE));
+ return make_lisp_ptr (h, Lisp_Vectorlike);
+}
/* Value is the key part of entry IDX in hash table H. */
INLINE Lisp_Object
@@ -2597,6 +2708,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
return h->table_size;
}
+/* Size of the index vector in hash table H. */
+INLINE ptrdiff_t
+hash_table_index_size (const struct Lisp_Hash_Table *h)
+{
+ return (ptrdiff_t)1 << h->index_bits;
+}
+
/* Hash value for KEY in hash table H. */
INLINE hash_hash_t
hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
@@ -2661,6 +2779,28 @@ SXHASH_REDUCE (EMACS_UINT x)
return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK;
}
+/* Reduce an EMACS_UINT hash value to hash_hash_t. */
+INLINE hash_hash_t
+reduce_emacs_uint_to_hash_hash (EMACS_UINT x)
+{
+ verify (sizeof x <= 2 * sizeof (hash_hash_t));
+ return (sizeof x == sizeof (hash_hash_t)
+ ? x
+ : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t)))));
+}
+
+/* Reduce HASH to a value BITS wide. */
+INLINE ptrdiff_t
+knuth_hash (hash_hash_t hash, unsigned bits)
+{
+ /* Knuth multiplicative hashing, tailored for 32-bit indices
+ (avoiding a 64-bit multiply). */
+ uint32_t alpha = 2654435769; /* 2**32/phi */
+ /* Note the cast to uint64_t, to make it work for bits=0. */
+ return (uint64_t)((uint32_t)hash * alpha) >> (32 - bits);
+}
+
+
struct Lisp_Marker
{
union vectorlike_header header;
@@ -2839,22 +2979,6 @@ XOVERLAY (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay);
}
-INLINE Lisp_Object
-SYMBOL_WITH_POS_SYM (Lisp_Object a)
-{
- if (!SYMBOL_WITH_POS_P (a))
- wrong_type_argument (Qsymbol_with_pos_p, a);
- return XSYMBOL_WITH_POS (a)->sym;
-}
-
-INLINE Lisp_Object
-SYMBOL_WITH_POS_POS (Lisp_Object a)
-{
- if (!SYMBOL_WITH_POS_P (a))
- wrong_type_argument (Qsymbol_with_pos_p, a);
- return XSYMBOL_WITH_POS (a)->pos;
-}
-
INLINE bool
USER_PTRP (Lisp_Object x)
{
@@ -4590,7 +4714,6 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *,
ptrdiff_t,
ATTRIBUTE_FORMAT_PRINTF (5, 0);
/* Defined in lread.c. */
-extern Lisp_Object check_obarray (Lisp_Object);
extern Lisp_Object intern_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object);
@@ -4802,7 +4925,7 @@ extern void syms_of_editfns (void);
/* Defined in buffer.c. */
extern bool mouse_face_overlay_overlaps (Lisp_Object);
-extern Lisp_Object disable_line_numbers_overlay_at_eob (void);
+extern bool disable_line_numbers_overlay_at_eob (void);
extern AVOID nsberror (Lisp_Object);
extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t, bool);
extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
@@ -5030,6 +5153,7 @@ extern bool build_details;
/* 0 not a daemon, 1 foreground daemon, 2 background daemon. */
extern int daemon_type;
#define IS_DAEMON (daemon_type != 0)
+/* Non-zero means daemon-initialized has not yet been called. */
#define DAEMON_RUNNING (daemon_type >= 0)
#else /* WINDOWSNT */
extern void *w32_daemon_event;
@@ -5550,7 +5674,7 @@ safe_free_unbind_to (specpdl_ref count, specpdl_ref
sa_count, Lisp_Object val)
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109577
which causes GCC to mistakenly complain about the
memory allocation in SAFE_ALLOCA_LISP_EXTRA. */
-#if GNUC_PREREQ (13, 0, 0)
+#if GNUC_PREREQ (13, 0, 0) && !GNUC_PREREQ (14, 0, 0)
# pragma GCC diagnostic ignored "-Wanalyzer-allocation-size"
#endif
diff --git a/src/lread.c b/src/lread.c
index f35463130a5..f3b7577c270 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2410,8 +2410,14 @@ build_load_history (Lisp_Object filename, bool entire)
front of load-history, the most-recently-loaded position. Also
do this if we didn't find an existing member for the file. */
if (entire || !foundit)
- Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
- Vload_history);
+ {
+ Lisp_Object tem = Fnreverse (Vcurrent_load_list);
+ eassert (EQ (filename, Fcar (tem)));
+ Vload_history = Fcons (tem, Vload_history);
+ /* FIXME: There should be an unbind_to right after calling us which
+ should re-establish the previous value of Vcurrent_load_list. */
+ Vcurrent_load_list = Qt;
+ }
}
static void
@@ -2577,12 +2583,24 @@ readevalloop (Lisp_Object readcharfun,
bool whole_buffer = 0;
/* True on the first time around. */
bool first_sexp = 1;
- Lisp_Object macroexpand = intern ("internal-macroexpand-for-load");
+ Lisp_Object macroexpand = Qinternal_macroexpand_for_load;
bool is_elc = (STRINGP (sourcename) && suffix_p (sourcename, ".elc"));
if (!NILP (sourcename))
CHECK_STRING (sourcename);
+/* <<<<<<< HEAD */
+/* ======= */
+/* macroexpand = Qinternal_macroexpand_for_load; */
+
+/* if (NILP (Ffboundp (macroexpand)) */
+/* || (STRINGP (sourcename) && suffix_p (sourcename, ".elc"))) */
+/* /\* Don't macroexpand before the corresponding function is defined */
+/* and don't bother macroexpanding in .elc files, since it should have
*/
+/* been done already. *\/ */
+/* macroexpand = Qnil; */
+
+/* >>>>>>> master */
if (MARKERP (readcharfun))
{
if (NILP (start))
@@ -3708,7 +3726,7 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object
readcharfun)
Lisp_Object *vec = XVECTOR (obj)->contents;
ptrdiff_t size = ASIZE (obj);
- if (size >= COMPILED_CONSTANTS)
+ if (infile && size >= COMPILED_CONSTANTS)
{
/* Always read 'lazily-loaded' bytecode (generated by the
`byte-compile-dynamic' feature prior to Emacs 30) eagerly, to
@@ -4740,7 +4758,7 @@ read0 (Lisp_Object readcharfun, ptrdiff_t loc_syms)
&longhand_chars,
&longhand_bytes);
- if (SYMBOLP (found))
+ if (BARE_SYMBOL_P (found))
result = found;
else if (longhand)
{
@@ -5170,49 +5188,65 @@ static Lisp_Object initial_obarray;
static size_t oblookup_last_bucket_number;
-/* Get an error if OBARRAY is not an obarray.
- If it is one, return it. */
+static Lisp_Object make_obarray (unsigned bits);
+/* Slow path obarray check: return the obarray to use or signal an error. */
Lisp_Object
-check_obarray (Lisp_Object obarray)
+check_obarray_slow (Lisp_Object obarray)
{
- /* We don't want to signal a wrong-type-argument error when we are
- shutting down due to a fatal error, and we don't want to hit
- assertions in VECTORP and ASIZE if the fatal error was during GC. */
- if (!fatal_error_in_progress
- && (!VECTORP (obarray) || ASIZE (obarray) == 0))
+ /* For compatibility, we accept vectors whose first element is 0,
+ and store an obarray object there. */
+ if (VECTORP (obarray) && ASIZE (obarray) > 0)
{
- /* If Vobarray is now invalid, force it to be valid. */
- if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
- wrong_type_argument (Qvectorp, obarray);
+ Lisp_Object obj = AREF (obarray, 0);
+ if (OBARRAYP (obj))
+ return obj;
+ if (BASE_EQ (obj, make_fixnum (0)))
+ {
+ /* Put an actual obarray object in the first slot.
+ The rest of the vector remains unused. */
+ obj = make_obarray (0);
+ ASET (obarray, 0, obj);
+ return obj;
+ }
}
- return obarray;
+ /* Reset Vobarray to the standard obarray for nicer error handling. */
+ if (BASE_EQ (Vobarray, obarray)) Vobarray = initial_obarray;
+
+ wrong_type_argument (Qobarrayp, obarray);
}
+static void grow_obarray (struct Lisp_Obarray *o);
+
/* Intern symbol SYM in OBARRAY using bucket INDEX. */
+/* FIXME: retype arguments as pure C types */
static Lisp_Object
intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
{
- Lisp_Object *ptr;
-
- XSYMBOL (sym)->u.s.interned = (EQ (obarray, initial_obarray)
- ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
- : SYMBOL_INTERNED);
+ eassert (BARE_SYMBOL_P (sym) && OBARRAYP (obarray) && FIXNUMP (index));
+ struct Lisp_Symbol *s = XBARE_SYMBOL (sym);
+ s->u.s.interned = (BASE_EQ (obarray, initial_obarray)
+ ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
+ : SYMBOL_INTERNED);
- if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
+ if (SREF (s->u.s.name, 0) == ':' && BASE_EQ (obarray, initial_obarray))
{
- make_symbol_constant (sym);
- XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL;
+ s->u.s.trapped_write = SYMBOL_NOWRITE;
+ s->u.s.redirect = SYMBOL_PLAINVAL;
/* Mark keywords as special. This makes (let ((:key 'foo)) ...)
in lexically bound elisp signal an error, as documented. */
- XSYMBOL (sym)->u.s.declared_special = true;
- SET_SYMBOL_VAL (XSYMBOL (sym), sym);
+ s->u.s.declared_special = true;
+ SET_SYMBOL_VAL (s, sym);
}
- ptr = aref_addr (obarray, XFIXNUM (index));
- set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL);
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+ Lisp_Object *ptr = o->buckets + XFIXNUM (index);
+ s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL;
*ptr = sym;
+ o->count++;
+ if (o->count > obarray_size (o))
+ grow_obarray (o);
return sym;
}
@@ -5221,7 +5255,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray,
Lisp_Object index)
Lisp_Object
intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index)
{
- SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil);
+ SET_SYMBOL_VAL (XBARE_SYMBOL (Qobarray_cache), Qnil);
return intern_sym (Fmake_symbol (string), obarray, index);
}
@@ -5234,7 +5268,7 @@ intern_1 (const char *str, ptrdiff_t len)
Lisp_Object obarray = check_obarray (Vobarray);
Lisp_Object tem = oblookup (obarray, str, len, len);
- return (SYMBOLP (tem) ? tem
+ return (BARE_SYMBOL_P (tem) ? tem
/* The above `oblookup' was done on the basis of nchars==nbytes, so
the string has to be unibyte. */
: intern_driver (make_unibyte_string (str, len),
@@ -5247,7 +5281,7 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
Lisp_Object obarray = check_obarray (Vobarray);
Lisp_Object tem = oblookup (obarray, str, len, len);
- if (!SYMBOLP (tem))
+ if (!BARE_SYMBOL_P (tem))
{
Lisp_Object string;
@@ -5299,7 +5333,7 @@ it defaults to the value of `obarray'. */)
&longhand, &longhand_chars,
&longhand_bytes);
- if (!SYMBOLP (tem))
+ if (!BARE_SYMBOL_P (tem))
{
if (longhand)
{
@@ -5348,10 +5382,11 @@ it defaults to the value of `obarray'. */)
{
/* If already a symbol, we don't do shorthand-longhand translation,
as promised in the docstring. */
- string = SYMBOL_NAME (name);
+ Lisp_Object sym = maybe_remove_pos_from_symbol (name);
+ string = XSYMBOL (name)->u.s.name;
tem
= oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
- return EQ (name, tem) ? name : Qnil;
+ return BASE_EQ (sym, tem) ? name : Qnil;
}
}
@@ -5366,13 +5401,16 @@ usage: (unintern NAME OBARRAY) */)
{
register Lisp_Object tem;
Lisp_Object string;
- size_t hash;
if (NILP (obarray)) obarray = Vobarray;
obarray = check_obarray (obarray);
if (SYMBOLP (name))
- string = SYMBOL_NAME (name);
+ {
+ if (!BARE_SYMBOL_P (name))
+ name = XSYMBOL_WITH_POS (name)->sym;
+ string = SYMBOL_NAME (name);
+ }
else
{
CHECK_STRING (name);
@@ -5392,7 +5430,7 @@ usage: (unintern NAME OBARRAY) */)
if (FIXNUMP (tem))
return Qnil;
/* If arg was a symbol, don't delete anything but that symbol itself. */
- if (SYMBOLP (name) && !EQ (name, tem))
+ if (BARE_SYMBOL_P (name) && !BASE_EQ (name, tem))
return Qnil;
/* There are plenty of other symbols which will screw up the Emacs
@@ -5402,41 +5440,42 @@ usage: (unintern NAME OBARRAY) */)
/* if (NILP (tem) || EQ (tem, Qt))
error ("Attempt to unintern t or nil"); */
- XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED;
+ struct Lisp_Symbol *sym = XBARE_SYMBOL (tem);
+ sym->u.s.interned = SYMBOL_UNINTERNED;
- hash = oblookup_last_bucket_number;
+ ptrdiff_t idx = oblookup_last_bucket_number;
+ Lisp_Object *loc = &XOBARRAY (obarray)->buckets[idx];
- if (EQ (AREF (obarray, hash), tem))
- {
- if (XSYMBOL (tem)->u.s.next)
- {
- Lisp_Object sym;
- XSETSYMBOL (sym, XSYMBOL (tem)->u.s.next);
- ASET (obarray, hash, sym);
- }
- else
- ASET (obarray, hash, make_fixnum (0));
- }
+ eassert (BARE_SYMBOL_P (*loc));
+ struct Lisp_Symbol *prev = XBARE_SYMBOL (*loc);
+ if (sym == prev)
+ *loc = sym->u.s.next ? make_lisp_symbol (sym->u.s.next) : make_fixnum (0);
else
- {
- Lisp_Object tail, following;
+ while (1)
+ {
+ struct Lisp_Symbol *next = prev->u.s.next;
+ if (next == sym)
+ {
+ prev->u.s.next = next->u.s.next;
+ break;
+ }
+ prev = next;
+ }
- for (tail = AREF (obarray, hash);
- XSYMBOL (tail)->u.s.next;
- tail = following)
- {
- XSETSYMBOL (following, XSYMBOL (tail)->u.s.next);
- if (EQ (following, tem))
- {
- set_symbol_next (tail, XSYMBOL (following)->u.s.next);
- break;
- }
- }
- }
+ XOBARRAY (obarray)->count--;
return Qt;
}
+
+/* Bucket index of the string STR of length SIZE_BYTE bytes in obarray OA. */
+static ptrdiff_t
+obarray_index (struct Lisp_Obarray *oa, const char *str, ptrdiff_t size_byte)
+{
+ EMACS_UINT hash = hash_string (str, size_byte);
+ return knuth_hash (reduce_emacs_uint_to_hash_hash (hash), oa->size_bits);
+}
+
/* Return the symbol in OBARRAY whose names matches the string
of SIZE characters (SIZE_BYTE bytes) at PTR.
If there is no such symbol, return the integer bucket number of
@@ -5447,35 +5486,27 @@ usage: (unintern NAME OBARRAY) */)
Lisp_Object
oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size,
ptrdiff_t size_byte)
{
- size_t hash;
- size_t obsize;
- register Lisp_Object tail;
- Lisp_Object bucket, tem;
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+ ptrdiff_t idx = obarray_index (o, ptr, size_byte);
+ Lisp_Object bucket = o->buckets[idx];
- obarray = check_obarray (obarray);
- /* This is sometimes needed in the middle of GC. */
- obsize = gc_asize (obarray);
- hash = hash_string (ptr, size_byte) % obsize;
- bucket = AREF (obarray, hash);
- oblookup_last_bucket_number = hash;
- if (BASE_EQ (bucket, make_fixnum (0)))
- ;
- else if (!SYMBOLP (bucket))
- /* Like CADR error message. */
- xsignal2 (Qwrong_type_argument, Qobarrayp,
- build_string ("Bad data in guts of obarray"));
- else
- for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next))
- {
- if (SBYTES (SYMBOL_NAME (tail)) == size_byte
- && SCHARS (SYMBOL_NAME (tail)) == size
- && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
- return tail;
- else if (XSYMBOL (tail)->u.s.next == 0)
- break;
- }
- XSETINT (tem, hash);
- return tem;
+ oblookup_last_bucket_number = idx;
+ if (!BASE_EQ (bucket, make_fixnum (0)))
+ {
+ Lisp_Object sym = bucket;
+ while (1)
+ {
+ struct Lisp_Symbol *s = XBARE_SYMBOL (sym);
+ Lisp_Object name = s->u.s.name;
+ if (SBYTES (name) == size_byte && SCHARS (name) == size
+ && memcmp (SDATA (name), ptr, size_byte) == 0)
+ return sym;
+ if (s->u.s.next == NULL)
+ break;
+ sym = make_lisp_symbol(s->u.s.next);
+ }
+ }
+ return make_fixnum (idx);
}
/* Like 'oblookup', but considers 'Vread_symbol_shorthands',
@@ -5542,24 +5573,134 @@ oblookup_considering_shorthand (Lisp_Object obarray,
const char *in,
}
-void
-map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object),
Lisp_Object arg)
+static struct Lisp_Obarray *
+allocate_obarray (void)
{
- ptrdiff_t i;
- register Lisp_Object tail;
- CHECK_VECTOR (obarray);
- for (i = ASIZE (obarray) - 1; i >= 0; i--)
+ return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Obarray, PVEC_OBARRAY);
+}
+
+static Lisp_Object
+make_obarray (unsigned bits)
+{
+ struct Lisp_Obarray *o = allocate_obarray ();
+ o->count = 0;
+ o->size_bits = bits;
+ ptrdiff_t size = (ptrdiff_t)1 << bits;
+ o->buckets = hash_table_alloc_bytes (size * sizeof *o->buckets);
+ for (ptrdiff_t i = 0; i < size; i++)
+ o->buckets[i] = make_fixnum (0);
+ return make_lisp_obarray (o);
+}
+
+enum {
+ obarray_default_bits = 3,
+ word_size_log2 = word_size < 8 ? 5 : 6, /* good enough */
+ obarray_max_bits = min (8 * sizeof (int),
+ 8 * sizeof (ptrdiff_t) - word_size_log2) - 1,
+};
+
+static void
+grow_obarray (struct Lisp_Obarray *o)
+{
+ ptrdiff_t old_size = obarray_size (o);
+ eassert (o->count > old_size);
+ Lisp_Object *old_buckets = o->buckets;
+
+ int new_bits = o->size_bits + 1;
+ if (new_bits > obarray_max_bits)
+ error ("Obarray too big");
+ ptrdiff_t new_size = (ptrdiff_t)1 << new_bits;
+ o->buckets = hash_table_alloc_bytes (new_size * sizeof *o->buckets);
+ for (ptrdiff_t i = 0; i < new_size; i++)
+ o->buckets[i] = make_fixnum (0);
+ o->size_bits = new_bits;
+
+ /* Rehash symbols.
+ FIXME: this is expensive since we need to recompute the hash for every
+ symbol name. Would it be reasonable to store it in the symbol? */
+ for (ptrdiff_t i = 0; i < old_size; i++)
{
- tail = AREF (obarray, i);
- if (SYMBOLP (tail))
- while (1)
- {
- (*fn) (tail, arg);
- if (XSYMBOL (tail)->u.s.next == 0)
- break;
- XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
- }
+ Lisp_Object obj = old_buckets[i];
+ if (BARE_SYMBOL_P (obj))
+ {
+ struct Lisp_Symbol *s = XBARE_SYMBOL (obj);
+ while (1)
+ {
+ Lisp_Object name = s->u.s.name;
+ ptrdiff_t idx = obarray_index (o, SSDATA (name), SBYTES (name));
+ Lisp_Object *loc = o->buckets + idx;
+ struct Lisp_Symbol *next = s->u.s.next;
+ s->u.s.next = BARE_SYMBOL_P (*loc) ? XBARE_SYMBOL (*loc) : NULL;
+ *loc = make_lisp_symbol (s);
+ if (next == NULL)
+ break;
+ s = next;
+ }
+ }
+ }
+
+ hash_table_free_bytes (old_buckets, old_size * sizeof *old_buckets);
+}
+
+DEFUN ("obarray-make", Fobarray_make, Sobarray_make, 0, 1, 0,
+ doc: /* Return a new obarray of size SIZE.
+The obarray will grow to accommodate any number of symbols; the size, if
+given, is only a hint for the expected number. */)
+ (Lisp_Object size)
+{
+ int bits;
+ if (NILP (size))
+ bits = obarray_default_bits;
+ else
+ {
+ CHECK_FIXNAT (size);
+ EMACS_UINT n = XFIXNUM (size);
+ bits = elogb (n) + 1;
+ if (bits > obarray_max_bits)
+ xsignal (Qargs_out_of_range, size);
}
+ return make_obarray (bits);
+}
+
+DEFUN ("obarrayp", Fobarrayp, Sobarrayp, 1, 1, 0,
+ doc: /* Return t iff OBJECT is an obarray. */)
+ (Lisp_Object object)
+{
+ return OBARRAYP (object) ? Qt : Qnil;
+}
+
+DEFUN ("obarray-clear", Fobarray_clear, Sobarray_clear, 1, 1, 0,
+ doc: /* Remove all symbols from OBARRAY. */)
+ (Lisp_Object obarray)
+{
+ CHECK_OBARRAY (obarray);
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+
+ /* This function does not bother setting the status of its contained symbols
+ to uninterned. It doesn't matter very much. */
+ int new_bits = obarray_default_bits;
+ int new_size = (ptrdiff_t)1 << new_bits;
+ Lisp_Object *new_buckets
+ = hash_table_alloc_bytes (new_size * sizeof *new_buckets);
+ for (ptrdiff_t i = 0; i < new_size; i++)
+ new_buckets[i] = make_fixnum (0);
+
+ int old_size = obarray_size (o);
+ hash_table_free_bytes (o->buckets, old_size * sizeof *o->buckets);
+ o->buckets = new_buckets;
+ o->size_bits = new_bits;
+ o->count = 0;
+
+ return Qnil;
+}
+
+void
+map_obarray (Lisp_Object obarray,
+ void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
+{
+ CHECK_OBARRAY (obarray);
+ DOOBARRAY (XOBARRAY (obarray), it)
+ (*fn) (obarray_iter_symbol (&it), arg);
}
static void
@@ -5580,12 +5721,37 @@ OBARRAY defaults to the value of `obarray'. */)
return Qnil;
}
-#define OBARRAY_SIZE 15121
+DEFUN ("internal--obarray-buckets",
+ Finternal__obarray_buckets, Sinternal__obarray_buckets, 1, 1, 0,
+ doc: /* Symbols in each bucket of OBARRAY. Internal use only. */)
+ (Lisp_Object obarray)
+{
+ obarray = check_obarray (obarray);
+ ptrdiff_t size = obarray_size (XOBARRAY (obarray));
+
+ Lisp_Object ret = Qnil;
+ for (ptrdiff_t i = 0; i < size; i++)
+ {
+ Lisp_Object bucket = Qnil;
+ Lisp_Object sym = XOBARRAY (obarray)->buckets[i];
+ if (BARE_SYMBOL_P (sym))
+ while (1)
+ {
+ bucket = Fcons (sym, bucket);
+ struct Lisp_Symbol *s = XBARE_SYMBOL (sym)->u.s.next;
+ if (!s)
+ break;
+ sym = make_lisp_symbol (s);
+ }
+ ret = Fcons (Fnreverse (bucket), ret);
+ }
+ return Fnreverse (ret);
+}
void
init_obarray_once (void)
{
- Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0));
+ Vobarray = make_obarray (15);
initial_obarray = Vobarray;
staticpro (&initial_obarray);
@@ -5595,14 +5761,14 @@ init_obarray_once (void)
DEFSYM (Qunbound, "unbound");
DEFSYM (Qnil, "nil");
- SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
+ SET_SYMBOL_VAL (XBARE_SYMBOL (Qnil), Qnil);
make_symbol_constant (Qnil);
- XSYMBOL (Qnil)->u.s.declared_special = true;
+ XBARE_SYMBOL (Qnil)->u.s.declared_special = true;
DEFSYM (Qt, "t");
- SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
+ SET_SYMBOL_VAL (XBARE_SYMBOL (Qt), Qt);
make_symbol_constant (Qt);
- XSYMBOL (Qt)->u.s.declared_special = true;
+ XBARE_SYMBOL (Qt)->u.s.declared_special = true;
/* Qt is correct even if not dumping. loadup.el will set to nil at end. */
Vpurify_flag = Qt;
@@ -5626,16 +5792,6 @@ defsubr (union Aligned_Lisp_Subr *aname)
#endif
}
-#ifdef NOTDEF /* Use fset in subr.el now! */
-void
-defalias (struct Lisp_Subr *sname, char *string)
-{
- Lisp_Object sym;
- sym = intern (string);
- XSETSUBR (XSYMBOL (sym)->u.s.function, sname);
-}
-#endif /* NOTDEF */
-
/* Define an "integer variable"; a symbol whose value is forwarded to a
C variable of type intmax_t. Sample call (with "xx" to fool make-docfile):
DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
@@ -5643,9 +5799,9 @@ void
defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring)
{
Lisp_Object sym = intern_c_string (namestring);
- XSYMBOL (sym)->u.s.declared_special = true;
- XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), i_fwd);
+ XBARE_SYMBOL (sym)->u.s.declared_special = true;
+ XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_FWD (XBARE_SYMBOL (sym), i_fwd);
}
/* Similar but define a variable whose value is t if 1, nil if 0. */
@@ -5653,9 +5809,9 @@ void
defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring)
{
Lisp_Object sym = intern_c_string (namestring);
- XSYMBOL (sym)->u.s.declared_special = true;
- XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), b_fwd);
+ XBARE_SYMBOL (sym)->u.s.declared_special = true;
+ XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_FWD (XBARE_SYMBOL (sym), b_fwd);
Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
}
@@ -5668,9 +5824,9 @@ void
defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring)
{
Lisp_Object sym = intern_c_string (namestring);
- XSYMBOL (sym)->u.s.declared_special = true;
- XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), o_fwd);
+ XBARE_SYMBOL (sym)->u.s.declared_special = true;
+ XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_FWD (XBARE_SYMBOL (sym), o_fwd);
}
void
@@ -5687,9 +5843,9 @@ void
defvar_kboard (struct Lisp_Kboard_Objfwd const *ko_fwd, char const *namestring)
{
Lisp_Object sym = intern_c_string (namestring);
- XSYMBOL (sym)->u.s.declared_special = true;
- XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), ko_fwd);
+ XBARE_SYMBOL (sym)->u.s.declared_special = true;
+ XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_FWD (XBARE_SYMBOL (sym), ko_fwd);
}
/* Check that the elements of lpath exist. */
@@ -5978,6 +6134,10 @@ syms_of_lread (void)
defsubr (&Sget_file_char);
defsubr (&Smapatoms);
defsubr (&Slocate_file_internal);
+ defsubr (&Sinternal__obarray_buckets);
+ defsubr (&Sobarray_make);
+ defsubr (&Sobarrayp);
+ defsubr (&Sobarray_clear);
DEFVAR_LISP ("obarray", Vobarray,
doc: /* Symbol table for use by `intern' and `read'.
@@ -5989,7 +6149,7 @@ to find all the symbols in an obarray, use `mapatoms'.
*/);
doc: /* List of values of all expressions which were read,
evaluated and printed.
Order is reverse chronological.
This variable is obsolete as of Emacs 28.1 and should not be used. */);
- XSYMBOL (intern ("values"))->u.s.declared_special = false;
+ XBARE_SYMBOL (intern ("values"))->u.s.declared_special = false;
DEFVAR_LISP ("standard-input", Vstandard_input,
doc: /* Stream for read to get input from.
@@ -6355,4 +6515,7 @@ See Info node `(elisp)Shorthands' for more details. */);
doc: /* List of variables declared dynamic in the current scope.
Only valid during macro-expansion. Internal use only. */);
Vmacroexp__dynvars = Qnil;
+
+ DEFSYM (Qinternal_macroexpand_for_load,
+ "internal-macroexpand-for-load");
}
diff --git a/src/marker.c b/src/marker.c
index 0101e144b4d..2abc951fc76 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -21,7 +21,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <config.h>
/* Work around GCC bug 113253. */
-#if 13 <= __GNUC__
+#if __GNUC__ == 13
# pragma GCC diagnostic ignored "-Wanalyzer-deref-before-check"
#endif
@@ -463,6 +463,18 @@ DEFUN ("marker-position", Fmarker_position,
Smarker_position, 1, 1, 0,
return Qnil;
}
+DEFUN ("marker-last-position", Fmarker_last_position, Smarker_last_position,
1, 1, 0,
+ doc: /* Return last position of MARKER in its buffer.
+This is like `marker-position' with one exception: If the buffer of
+MARKER is dead, it returns the last position of MARKER in that buffer
+before it was killed. */)
+ (Lisp_Object marker)
+{
+ CHECK_MARKER (marker);
+
+ return make_fixnum (XMARKER (marker)->charpos);
+}
+
/* Change M so it points to B at CHARPOS and BYTEPOS. */
static void
@@ -830,6 +842,7 @@ void
syms_of_marker (void)
{
defsubr (&Smarker_position);
+ defsubr (&Smarker_last_position);
defsubr (&Smarker_buffer);
defsubr (&Sset_marker);
defsubr (&Scopy_marker);
diff --git a/src/minibuf.c b/src/minibuf.c
index 7c0c9799a60..df6ca7ce1d8 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1615,13 +1615,15 @@ or from one of the possible completions. */)
ptrdiff_t bestmatchsize = 0;
/* These are in bytes, too. */
ptrdiff_t compare, matchsize;
+ if (VECTORP (collection))
+ collection = check_obarray (collection);
enum { function_table, list_table, obarray_table, hash_table}
type = (HASH_TABLE_P (collection) ? hash_table
- : VECTORP (collection) ? obarray_table
+ : OBARRAYP (collection) ? obarray_table
: ((NILP (collection)
|| (CONSP (collection) && !FUNCTIONP (collection)))
? list_table : function_table));
- ptrdiff_t idx = 0, obsize = 0;
+ ptrdiff_t idx = 0;
int matchcount = 0;
Lisp_Object bucket, zero, end, tem;
@@ -1634,12 +1636,9 @@ or from one of the possible completions. */)
/* If COLLECTION is not a list, set TAIL just for gc pro. */
tail = collection;
+ obarray_iter_t obit;
if (type == obarray_table)
- {
- collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
- }
+ obit = make_obarray_iter (XOBARRAY (collection));
while (1)
{
@@ -1658,24 +1657,10 @@ or from one of the possible completions. */)
}
else if (type == obarray_table)
{
- if (!EQ (bucket, zero))
- {
- if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray");
- elt = bucket;
- eltstring = elt;
- if (XSYMBOL (bucket)->u.s.next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
- else
- XSETFASTINT (bucket, 0);
- }
- else if (++idx >= obsize)
+ if (obarray_iter_at_end (&obit))
break;
- else
- {
- bucket = AREF (collection, idx);
- continue;
- }
+ elt = eltstring = obarray_iter_symbol (&obit);
+ obarray_iter_step (&obit);
}
else /* if (type == hash_table) */
{
@@ -1858,10 +1843,12 @@ with a space are ignored unless STRING itself starts
with a space. */)
{
Lisp_Object tail, elt, eltstring;
Lisp_Object allmatches;
+ if (VECTORP (collection))
+ collection = check_obarray (collection);
int type = HASH_TABLE_P (collection) ? 3
- : VECTORP (collection) ? 2
+ : OBARRAYP (collection) ? 2
: NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
- ptrdiff_t idx = 0, obsize = 0;
+ ptrdiff_t idx = 0;
Lisp_Object bucket, tem, zero;
CHECK_STRING (string);
@@ -1872,12 +1859,9 @@ with a space are ignored unless STRING itself starts
with a space. */)
/* If COLLECTION is not a list, set TAIL just for gc pro. */
tail = collection;
+ obarray_iter_t obit;
if (type == 2)
- {
- collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
- }
+ obit = make_obarray_iter (XOBARRAY (collection));
while (1)
{
@@ -1896,24 +1880,10 @@ with a space are ignored unless STRING itself starts
with a space. */)
}
else if (type == 2)
{
- if (!EQ (bucket, zero))
- {
- if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray");
- elt = bucket;
- eltstring = elt;
- if (XSYMBOL (bucket)->u.s.next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
- else
- XSETFASTINT (bucket, 0);
- }
- else if (++idx >= obsize)
+ if (obarray_iter_at_end (&obit))
break;
- else
- {
- bucket = AREF (collection, idx);
- continue;
- }
+ elt = eltstring = obarray_iter_symbol (&obit);
+ obarray_iter_step (&obit);
}
else /* if (type == 3) */
{
@@ -2059,7 +2029,7 @@ If COLLECTION is a function, it is called with three
arguments:
the values STRING, PREDICATE and `lambda'. */)
(Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
{
- Lisp_Object tail, tem = Qnil, arg = Qnil;
+ Lisp_Object tem = Qnil, arg = Qnil;
CHECK_STRING (string);
@@ -2069,38 +2039,30 @@ the values STRING, PREDICATE and `lambda'. */)
if (NILP (tem))
return Qnil;
}
- else if (VECTORP (collection))
+ else if (OBARRAYP (collection) || VECTORP (collection))
{
+ collection = check_obarray (collection);
/* Bypass intern-soft as that loses for nil. */
tem = oblookup (collection,
SSDATA (string),
SCHARS (string),
SBYTES (string));
- if (completion_ignore_case && !SYMBOLP (tem))
- {
- for (ptrdiff_t i = ASIZE (collection) - 1; i >= 0; i--)
- {
- tail = AREF (collection, i);
- if (SYMBOLP (tail))
- while (1)
- {
- if (BASE_EQ (Fcompare_strings (string, make_fixnum (0),
- Qnil,
- Fsymbol_name (tail),
- make_fixnum (0) , Qnil, Qt),
- Qt))
- {
- tem = tail;
- break;
- }
- if (XSYMBOL (tail)->u.s.next == 0)
- break;
- XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
- }
- }
- }
+ if (completion_ignore_case && !BARE_SYMBOL_P (tem))
+ DOOBARRAY (XOBARRAY (collection), it)
+ {
+ Lisp_Object obj = obarray_iter_symbol (&it);
+ if (BASE_EQ (Fcompare_strings (string, make_fixnum (0),
+ Qnil,
+ Fsymbol_name (obj),
+ make_fixnum (0) , Qnil, Qt),
+ Qt))
+ {
+ tem = obj;
+ break;
+ }
+ }
- if (!SYMBOLP (tem))
+ if (!BARE_SYMBOL_P (tem))
return Qnil;
}
else if (HASH_TABLE_P (collection))
diff --git a/src/pdumper.c b/src/pdumper.c
index ee554cda55a..f0bce09cbde 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2688,7 +2688,7 @@ hash_table_freeze (struct Lisp_Hash_Table *h)
h->hash = NULL;
h->index = NULL;
h->table_size = 0;
- h->index_size = 0;
+ h->index_bits = 0;
h->frozen_test = hash_table_std_test (h->test);
h->test = NULL;
}
@@ -2719,7 +2719,7 @@ dump_hash_table_contents (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_313A489F0A
+#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_0360833954
# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
@@ -2748,6 +2748,51 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object
object)
return offset;
}
+static dump_off
+dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o)
+{
+ dump_align_output (ctx, DUMP_ALIGNMENT);
+ dump_off start_offset = ctx->offset;
+ ptrdiff_t n = obarray_size (o);
+
+ struct dump_flags old_flags = ctx->flags;
+ ctx->flags.pack_objects = true;
+
+ for (ptrdiff_t i = 0; i < n; i++)
+ {
+ Lisp_Object out;
+ const Lisp_Object *slot = &o->buckets[i];
+ dump_object_start (ctx, &out, sizeof out);
+ dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG);
+ dump_object_finish (ctx, &out, sizeof out);
+ }
+
+ ctx->flags = old_flags;
+ return start_offset;
+}
+
+static dump_off
+dump_obarray (struct dump_context *ctx, Lisp_Object object)
+{
+#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_D2757E61AD
+# error "Lisp_Obarray changed. See CHECK_STRUCTS comment in config.h."
+#endif
+ const struct Lisp_Obarray *in_oa = XOBARRAY (object);
+ struct Lisp_Obarray munged_oa = *in_oa;
+ struct Lisp_Obarray *oa = &munged_oa;
+ START_DUMP_PVEC (ctx, &oa->header, struct Lisp_Obarray, out);
+ dump_pseudovector_lisp_fields (ctx, &out->header, &oa->header);
+ DUMP_FIELD_COPY (out, oa, count);
+ DUMP_FIELD_COPY (out, oa, size_bits);
+ dump_field_fixup_later (ctx, out, oa, &oa->buckets);
+ dump_off offset = finish_dump_pvec (ctx, &out->header);
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct Lisp_Obarray, buckets),
+ dump_obarray_buckets (ctx, oa));
+ return offset;
+}
+
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
@@ -2912,17 +2957,17 @@ dump_subr (struct dump_context *ctx, const struct
Lisp_Subr *subr)
dump_object_start (ctx, &out, sizeof (out));
DUMP_FIELD_COPY (&out, subr, header.size);
#ifdef HAVE_NATIVE_COMP
- bool native_comp = !NILP (subr->native_comp_u);
+ bool non_primitive = !NILP (subr->native_comp_u);
#else
- bool native_comp = false;
+ bool non_primitive = false;
#endif
- if (native_comp)
+ if (non_primitive)
out.function.a0 = NULL;
else
dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
DUMP_FIELD_COPY (&out, subr, min_args);
DUMP_FIELD_COPY (&out, subr, max_args);
- if (native_comp)
+ if (non_primitive)
{
dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name);
dump_remember_cold_op (ctx,
@@ -2947,7 +2992,7 @@ dump_subr (struct dump_context *ctx, const struct
Lisp_Subr *subr)
dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL);
#endif
dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out));
- if (native_comp && ctx->flags.dump_object_contents)
+ if (non_primitive && ctx->flags.dump_object_contents)
/* We'll do the final addr relocation during VERY_LATE_RELOCS time
after the compilation units has been loaded. */
dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS],
@@ -3004,7 +3049,7 @@ dump_vectorlike (struct dump_context *ctx,
Lisp_Object lv,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_pvec_type_D8A254BC70
+#if CHECK_STRUCTS && !defined HASH_pvec_type_2D583AC566
# error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Vector *v = XVECTOR (lv);
@@ -3031,6 +3076,8 @@ dump_vectorlike (struct dump_context *ctx,
return dump_bool_vector(ctx, v);
case PVEC_HASH_TABLE:
return dump_hash_table (ctx, lv);
+ case PVEC_OBARRAY:
+ return dump_obarray (ctx, lv);
case PVEC_BUFFER:
return dump_buffer (ctx, XBUFFER (lv));
case PVEC_SUBR:
@@ -5593,10 +5640,7 @@ pdumper_load (const char *dump_filename, char *argv0)
struct dump_header header_buf = { 0 };
struct dump_header *header = &header_buf;
- struct dump_memory_map sections[NUMBER_DUMP_SECTIONS];
-
- /* Use memset instead of "= { 0 }" to work around GCC bug 105961. */
- memset (sections, 0, sizeof sections);
+ struct dump_memory_map sections[NUMBER_DUMP_SECTIONS] = { 0 };
const struct timespec start_time = current_timespec ();
char *dump_filename_copy;
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index b731f52983d..1ec6bfcda4e 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -5825,8 +5825,8 @@ note_mouse_movement (struct frame *frame,
/* Has the mouse moved off the glyph it was on at the last sighting? */
r = &dpyinfo->last_mouse_glyph;
if (frame != dpyinfo->last_mouse_glyph_frame
- || event->x < r->x || event->x >= r->x + r->width
- || event->y < r->y || event->y >= r->y + r->height)
+ || event->x < r->x || event->x >= r->x + (int) r->width
+ || event->y < r->y || event->y >= r->y + (int) r->height)
{
frame->mouse_moved = true;
dpyinfo->last_mouse_scroll_bar = NULL;
diff --git a/src/print.c b/src/print.c
index e2252562915..76c577ec800 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2078,6 +2078,16 @@ print_vectorlike_unreadable (Lisp_Object obj,
Lisp_Object printcharfun,
}
return;
+ case PVEC_OBARRAY:
+ {
+ struct Lisp_Obarray *o = XOBARRAY (obj);
+ /* FIXME: Would it make sense to print the actual symbols (up to
+ a limit)? */
+ int i = sprintf (buf, "#<obarray n=%u>", o->count);
+ strout (buf, i, i, printcharfun);
+ return;
+ }
+
/* Types handled earlier. */
case PVEC_NORMAL_VECTOR:
case PVEC_RECORD:
diff --git a/src/process.c b/src/process.c
index ddab9ed6c01..48a2c0c8e53 100644
--- a/src/process.c
+++ b/src/process.c
@@ -5209,6 +5209,27 @@ wait_reading_process_output_1 (void)
{
}
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY \
+ && defined THREADS_ENABLED
+
+/* Wrapper around `android_select' that exposes a calling interface with
+ an extra argument for compatibility with `thread_pselect'. */
+
+static int
+android_select_wrapper (int nfds, fd_set *readfds, fd_set *writefds,
+ fd_set *exceptfds, const struct timespec *timeout,
+ const sigset_t *sigmask)
+{
+ /* sigmask is not supported. */
+ if (sigmask)
+ emacs_abort ();
+
+ return android_select (nfds, readfds, writefds, exceptfds,
+ (struct timespec *) timeout);
+}
+
+#endif /* HAVE_ANDROID && !ANDROID_STUBIFY && THREADS_ENABLED */
+
/* Read and dispose of subprocess output while waiting for timeout to
elapse and/or keyboard input to be available.
@@ -5701,13 +5722,19 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
timeout = short_timeout;
#endif
- /* Android doesn't support threads and requires using a
- replacement for pselect in android.c to poll for
- events. */
+ /* Android requires using a replacement for pselect in
+ android.c to poll for events. */
#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+#ifndef THREADS_ENABLED
nfds = android_select (max_desc + 1,
&Available, (check_write ? &Writeok : 0),
NULL, &timeout);
+#else /* THREADS_ENABLED */
+ nfds = thread_select (android_select_wrapper,
+ max_desc + 1,
+ &Available, (check_write ? &Writeok : 0),
+ NULL, &timeout, NULL);
+#endif /* THREADS_ENABLED */
#else
/* Non-macOS HAVE_GLIB builds call thread_select in
diff --git a/src/sfnt.c b/src/sfnt.c
index 6df43af4293..8598b052044 100644
--- a/src/sfnt.c
+++ b/src/sfnt.c
@@ -2798,12 +2798,6 @@ sfnt_decompose_compound_glyph (struct sfnt_glyph *glyph,
if (component->flags & 04000) /* SCALED_COMPONENT_OFFSET */
sfnt_transform_coordinates (component, &x, &y, 1,
0, 0);
-
- if (component->flags & 04) /* ROUND_XY_TO_GRID */
- {
- x = sfnt_round_fixed (x);
- y = sfnt_round_fixed (y);
- }
}
else
{
@@ -20800,8 +20794,8 @@ main (int argc, char **argv)
return 1;
}
-#define FANCY_PPEM 12
-#define EASY_PPEM 12
+#define FANCY_PPEM 18
+#define EASY_PPEM 18
interpreter = NULL;
head = sfnt_read_head_table (fd, font);
diff --git a/src/sfntfont.c b/src/sfntfont.c
index 860fc446184..3be770f650e 100644
--- a/src/sfntfont.c
+++ b/src/sfntfont.c
@@ -3308,7 +3308,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity,
ASET (font_object, FONT_TYPE_INDEX, sfnt_vendor_name);
ASET (font_object, FONT_FOUNDRY_INDEX, desc->designer);
ASET (font_object, FONT_FAMILY_INDEX, Fintern (desc->family, Qnil));
- ASET (font_object, FONT_ADSTYLE_INDEX, Qnil);
+ ASET (font_object, FONT_ADSTYLE_INDEX, desc->adstyle);
ASET (font_object, FONT_REGISTRY_INDEX,
sfntfont_registry_for_desc (desc));
@@ -3326,8 +3326,6 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity,
FONT_SET_STYLE (font_object, FONT_SLANT_INDEX,
make_fixnum (desc->slant));
- ASET (font_object, FONT_ADSTYLE_INDEX, Qnil);
-
/* Clear various offsets. */
font_info->font.baseline_offset = 0;
font_info->font.relative_compose = 0;
@@ -3412,7 +3410,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity,
AREF (tem, 3));
FONT_SET_STYLE (font_object, FONT_SLANT_INDEX,
AREF (tem, 4));
- ASET (font_object, FONT_ADSTYLE_INDEX, Qnil);
+ ASET (font_object, FONT_ADSTYLE_INDEX, AREF (tem, 1));
}
}
diff --git a/src/sysdep.c b/src/sysdep.c
index 3a6829dd27a..cf2985b4b89 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1853,11 +1853,7 @@ init_sigbus (void)
#endif
-/* This does not work on Android and interferes with the system
- tombstone generation. */
-
-#if defined HAVE_STACK_OVERFLOW_HANDLING && !defined WINDOWSNT \
- && (!defined HAVE_ANDROID || defined ANDROID_STUBIFY)
+#if defined HAVE_STACK_OVERFLOW_HANDLING && !defined WINDOWSNT
/* Alternate stack used by SIGSEGV handler below. */
@@ -1921,6 +1917,8 @@ stack_overflow (siginfo_t *siginfo)
return 0 <= top - addr && top - addr < (bot - top) >> LG_STACK_HEURISTIC;
}
+/* Signal handler for SIGSEGV before our new handler was installed. */
+static struct sigaction old_sigsegv_handler;
/* Attempt to recover from SIGSEGV caused by C stack overflow. */
@@ -1939,6 +1937,15 @@ handle_sigsegv (int sig, siginfo_t *siginfo, void *arg)
if (!fatal && stack_overflow (siginfo))
siglongjmp (return_to_command_loop, 1);
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ /* Tombstones (crash reports with stack traces) won't be generated on
+ Android unless the original SIGSEGV handler is installed and the
+ signal is resent, such as by returning from the first signal
+ handler called. */
+ sigaction (SIGSEGV, &old_sigsegv_handler, NULL);
+ return;
+#endif /* HAVE_ANDROID && ANDROID_STUBIFY */
+
/* Otherwise we can't do anything with this. */
deliver_fatal_thread_signal (sig);
}
@@ -1961,7 +1968,7 @@ init_sigsegv (void)
sigfillset (&sa.sa_mask);
sa.sa_sigaction = handle_sigsegv;
sa.sa_flags = SA_SIGINFO | SA_ONSTACK | emacs_sigaction_flags ();
- if (sigaction (SIGSEGV, &sa, NULL) < 0)
+ if (sigaction (SIGSEGV, &sa, &old_sigsegv_handler) < 0)
return 0;
return 1;
@@ -1969,16 +1976,12 @@ init_sigsegv (void)
#else /* not HAVE_STACK_OVERFLOW_HANDLING or WINDOWSNT */
-#if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
-
static bool
init_sigsegv (void)
{
return 0;
}
-#endif
-
#endif /* HAVE_STACK_OVERFLOW_HANDLING && !WINDOWSNT */
static void
@@ -2125,10 +2128,8 @@ init_signals (void)
#endif
sigaction (SIGBUS, &thread_fatal_action, 0);
#endif
-#if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
if (!init_sigsegv ())
sigaction (SIGSEGV, &thread_fatal_action, 0);
-#endif
#ifdef SIGSYS
sigaction (SIGSYS, &thread_fatal_action, 0);
#endif
diff --git a/src/textconv.c b/src/textconv.c
index 0d35ec19c55..0941848dd09 100644
--- a/src/textconv.c
+++ b/src/textconv.c
@@ -1705,11 +1705,8 @@ set_composing_region (struct frame *f, ptrdiff_t start,
{
struct text_conversion_action *action, **last;
- if (start > MOST_POSITIVE_FIXNUM)
- start = MOST_POSITIVE_FIXNUM;
-
- if (end > MOST_POSITIVE_FIXNUM)
- end = MOST_POSITIVE_FIXNUM;
+ start = min (start, MOST_POSITIVE_FIXNUM);
+ end = min (end, MOST_POSITIVE_FIXNUM);
action = xmalloc (sizeof *action);
action->operation = TEXTCONV_SET_COMPOSING_REGION;
@@ -1734,8 +1731,7 @@ textconv_set_point_and_mark (struct frame *f, ptrdiff_t
point,
{
struct text_conversion_action *action, **last;
- if (point > MOST_POSITIVE_FIXNUM)
- point = MOST_POSITIVE_FIXNUM;
+ point = min (point, MOST_POSITIVE_FIXNUM);
action = xmalloc (sizeof *action);
action->operation = TEXTCONV_SET_POINT_AND_MARK;
diff --git a/src/thread.c b/src/thread.c
index 040ca39511e..2f5d7a08838 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -106,6 +106,12 @@ post_acquire_global_lock (struct thread_state *self)
{
struct thread_state *prev_thread = current_thread;
+ /* Switch the JNI interface pointer to the environment assigned to the
+ current thread. */
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ android_java_env = self->java_env;
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+
/* Do this early on, so that code below could signal errors (e.g.,
unbind_for_thread_switch might) correctly, because we are already
running in the context of the thread pointed by SELF. */
@@ -126,6 +132,12 @@ post_acquire_global_lock (struct thread_state *self)
set_buffer_internal_2 (current_buffer);
}
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ /* This step is performed in android_select when built without
+ threads. */
+ android_check_query ();
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+
/* We could have been signaled while waiting to grab the global lock
for the first time since this thread was created, in which case
we didn't yet have the opportunity to set up the handlers. Delay
@@ -756,6 +768,11 @@ run_thread (void *state)
struct thread_state *self = state;
struct thread_state **iter;
+#ifdef THREADS_ENABLED
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ jint rc;
+#endif /* #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+#endif /* THREADS_ENABLED */
#ifdef HAVE_NS
/* Allocate an autorelease pool in case this thread calls any
@@ -766,6 +783,16 @@ run_thread (void *state)
void *pool = ns_alloc_autorelease_pool ();
#endif
+#ifdef THREADS_ENABLED
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ rc
+ = (*android_jvm)->AttachCurrentThread (android_jvm, &self->java_env,
+ NULL);
+ if (rc != JNI_OK)
+ emacs_abort ();
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+#endif /* THREADS_ENABLED */
+
self->m_stack_bottom = self->stack_top = &stack_pos.c;
self->thread_id = sys_thread_self ();
@@ -812,6 +839,14 @@ run_thread (void *state)
ns_release_autorelease_pool (pool);
#endif
+#ifdef THREADS_ENABLED
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ rc = (*android_jvm)->DetachCurrentThread (android_jvm);
+ if (rc != JNI_OK)
+ emacs_abort ();
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+#endif /* THREADS_ENABLED */
+
/* Unlink this thread from the list of all threads. Note that we
have to do this very late, after broadcasting our death.
Otherwise the GC may decide to reap the thread_state object,
@@ -1131,6 +1166,10 @@ init_threads (void)
sys_mutex_init (&global_lock);
sys_mutex_lock (&global_lock);
current_thread = &main_thread.s;
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ current_thread->java_env = android_java_env;
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+
main_thread.s.thread_id = sys_thread_self ();
init_bc_thread (&main_thread.s.bc);
}
diff --git a/src/thread.h b/src/thread.h
index 6ce2b7f30df..1844cf03967 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -30,6 +30,12 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <signal.h> /* sigset_t */
#endif
+#ifdef HAVE_ANDROID
+#ifndef ANDROID_STUBIFY
+#include "android.h"
+#endif /* ANDROID_STUBIFY */
+#endif /* HAVE_ANDROID */
+
#include "sysselect.h" /* FIXME */
#include "systhread.h"
@@ -84,6 +90,11 @@ struct thread_state
Lisp_Object event_object;
/* event_object must be the last Lisp field. */
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ /* Pointer to an object to call Java functions through. */
+ JNIEnv *java_env;
+#endif /* HAVE_ANDROID && !ANDROID_STUBIFY */
+
/* An address near the bottom of the stack.
Tells GC how to save a copy of the stack. */
char const *m_stack_bottom;
diff --git a/src/timefns.c b/src/timefns.c
index 1541583b485..0ecbb6e6793 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -225,7 +225,7 @@ tzlookup (Lisp_Object zone, bool settz)
if (NILP (zone))
return local_tz;
- else if (BASE_EQ (zone, make_fixnum (0)) || BASE2_EQ (zone, Qt))
+ else if (BASE_EQ (zone, make_fixnum (0)) || EQ (zone, Qt))
{
zone_string = "UTC0";
new_tz = utc_tz;
@@ -234,7 +234,7 @@ tzlookup (Lisp_Object zone, bool settz)
{
bool plain_integer = FIXNUMP (zone);
- if (BASE2_EQ (zone, Qwall))
+ if (EQ (zone, Qwall))
zone_string = 0;
else if (STRINGP (zone))
zone_string = SSDATA (ENCODE_SYSTEM (zone));
@@ -1548,7 +1548,7 @@ usage: (decode-time &optional TIME ZONE FORM) */)
/* Compute SEC from LOCAL_TM.tm_sec and HZ. */
Lisp_Object hz = lt.hz, sec;
- if (BASE_EQ (hz, make_fixnum (1)) || !BASE2_EQ (form, Qt))
+ if (BASE_EQ (hz, make_fixnum (1)) || !EQ (form, Qt))
sec = make_fixnum (local_tm.tm_sec);
else
{
@@ -1765,10 +1765,8 @@ but new code should not rely on it. */)
well, since we accept it as input? */
struct lisp_time t;
enum timeform input_form = decode_lisp_time (time, false, &t, 0);
- if (NILP (form))
- form = current_time_list ? Qlist : Qt;
- if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (form))
- form = SYMBOL_WITH_POS_SYM (form);
+ form = (!NILP (form) ? maybe_remove_pos_from_symbol (form)
+ : current_time_list ? Qlist : Qt);
if (BASE_EQ (form, Qlist))
return ticks_hz_list4 (t.ticks, t.hz);
if (BASE_EQ (form, Qinteger))
diff --git a/src/treesit.c b/src/treesit.c
index 12915ea9a10..d86ab501187 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -3275,11 +3275,11 @@ treesit_traverse_child_helper (TSTreeCursor *cursor,
static Lisp_Object
treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language)
{
- Lisp_Object cons = assq_no_quit (language, Vtreesit_thing_settings);
+ Lisp_Object cons = assq_no_signal (language, Vtreesit_thing_settings);
if (NILP (cons))
return Qnil;
Lisp_Object definitions = XCDR (cons);
- Lisp_Object entry = assq_no_quit (thing, definitions);
+ Lisp_Object entry = assq_no_signal (thing, definitions);
if (NILP (entry))
return Qnil;
/* ENTRY looks like (THING PRED). */
diff --git a/src/verbose.mk.in b/src/verbose.mk.in
index e72c182f276..6efb6b9416b 100644
--- a/src/verbose.mk.in
+++ b/src/verbose.mk.in
@@ -53,38 +53,39 @@ have_working_info = $(filter notintermediate,$(value
.FEATURES))
# The workaround is done only for AM_V_ELC and AM_V_ELN,
# since the bug is not annoying elsewhere.
-AM_V_AR = @$(info $ AR $@)
+. :=
+AM_V_AR = @$(info $. AR $@)
AM_V_at = @
-AM_V_CC = @$(info $ CC $@)
-AM_V_CXX = @$(info $ CXX $@)
-AM_V_CCLD = @$(info $ CCLD $@)
-AM_V_CXXLD = @$(info $ CXXLD $@)
+AM_V_CC = @$(info $. CC $@)
+AM_V_CXX = @$(info $. CXX $@)
+AM_V_CCLD = @$(info $. CCLD $@)
+AM_V_CXXLD = @$(info $. CXXLD $@)
ifeq ($(HAVE_NATIVE_COMP)-$(NATIVE_DISABLED)-$(ANCIENT),yes--)
ifneq (,$(have_working_info))
-AM_V_ELC = @$(info $ ELC+ELN $@)
-AM_V_ELN = @$(info $ ELN $@)
+AM_V_ELC = @$(info $. ELC+ELN $@)
+AM_V_ELN = @$(info $. ELN $@)
else
AM_V_ELC = @echo " ELC+ELN " $@;
AM_V_ELN = @echo " ELN " $@;
endif
else
ifneq (,$(have_working_info))
-AM_V_ELC = @$(info $ ELC $@)
+AM_V_ELC = @$(info $. ELC $@)
else
AM_V_ELC = @echo " ELC " $@;
endif
AM_V_ELN =
endif
-AM_V_GEN = @$(info $ GEN $@)
-AM_V_GLOBALS = @$(info $ GEN globals.h)
+AM_V_GEN = @$(info $. GEN $@)
+AM_V_GLOBALS = @$(info $. GEN globals.h)
AM_V_NO_PD = --no-print-directory
-AM_V_RC = @$(info $ RC $@)
+AM_V_RC = @$(info $. RC $@)
# These are used for the Android port.
-AM_V_JAVAC = @$(info $ JAVAC $@)
-AM_V_D8 = @$(info $ D8 $@)
-AM_V_AAPT = @$(info $ AAPT $@)
+AM_V_JAVAC = @$(info $. JAVAC $@)
+AM_V_D8 = @$(info $. D8 $@)
+AM_V_AAPT = @$(info $. AAPT $@)
AM_V_SILENT = @
endif
diff --git a/src/window.c b/src/window.c
index 915f591221d..ea761fad8bc 100644
--- a/src/window.c
+++ b/src/window.c
@@ -4151,6 +4151,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer,
buffer);
w->start_at_line_beg = false;
w->force_start = false;
+ /* Flush the base_line cache since it applied to another buffer. */
+ w->base_line_number = 0;
}
wset_redisplay (w);
@@ -5378,7 +5380,14 @@ grow_mini_window (struct window *w, int delta)
grow = call3 (Qwindow__resize_root_window_vertically,
root, make_fixnum (- delta), Qt);
- if (FIXNUMP (grow) && window_resize_check (r, false))
+ if (FIXNUMP (grow)
+ /* It might be impossible to resize the window, in which case
+ calling resize_mini_window_apply will set off an infinite
+ loop where the redisplay cycle so forced returns to
+ resize_mini_window, making endless attempts to expand the
+ minibuffer window to this impossible size. (bug#69140) */
+ && XFIXNUM (grow) != 0
+ && window_resize_check (r, false))
resize_mini_window_apply (w, -XFIXNUM (grow));
}
}
@@ -7100,6 +7109,24 @@ current at the start of the function. If
DONT-SET-MINIWINDOW is non-nil,
the mini-window of the frame doesn't get set to the corresponding element
of CONFIGURATION.
+Normally, this function will try to delete any dead window in
+CONFIGURATION whose buffer has been deleted since CONFIGURATION was
+made. However, if the abnormal hook `window-kept-windows-functions' is
+non-nil, it will preserve such a window in the restored layout and show
+another buffer in it.
+
+After restoring the frame layout, this function runs the abnormal hook
+`window-kept-windows-functions' with two arguments - the frame whose
+layout it has restored and a list of entries for each window whose
+buffer has been found dead when it tried to restore CONFIGURATION: Each
+entry is a list of four elements <window, buffer, start, point> where
+`window' denotes the window whose buffer was found dead, `buffer'
+denotes the dead buffer, and `start' and `point' denote the last known
+positions of `window-start' and `window-point' of the buffer in that
+window. Any function run by this hook should check such a window for
+liveness because another function run by this hook may have deleted it
+in the meantime."
+
If CONFIGURATION was made from a frame that is now deleted,
only frame-independent values can be restored. In this case,
the return value is nil. Otherwise the value is t. */)
@@ -7110,6 +7137,7 @@ the return value is nil. Otherwise the value is t. */)
struct Lisp_Vector *saved_windows;
Lisp_Object new_current_buffer;
Lisp_Object frame;
+ Lisp_Object kept_windows = Qnil;
Lisp_Object old_frame = selected_frame;
struct frame *f;
ptrdiff_t old_point = -1;
@@ -7350,6 +7378,11 @@ the return value is nil. Otherwise the value is t. */)
BUF_PT (XBUFFER (w->contents)),
BUF_PT_BYTE (XBUFFER (w->contents)));
w->start_at_line_beg = true;
+ if (!NILP (Vwindow_kept_windows_functions))
+ kept_windows = Fcons (list4 (window, p->buffer,
+ Fmarker_last_position (p->start),
+ Fmarker_last_position (p->pointm)),
+ kept_windows);
}
else if (!NILP (w->start))
/* Leaf window has no live buffer, get one. */
@@ -7370,6 +7403,11 @@ the return value is nil. Otherwise the value is t. */)
dead_windows = Fcons (window, dead_windows);
/* Make sure window is no more dedicated. */
wset_dedicated (w, Qnil);
+ if (!NILP (Vwindow_kept_windows_functions))
+ kept_windows = Fcons (list4 (window, p->buffer,
+ Fmarker_last_position (p->start),
+ Fmarker_last_position (p->pointm)),
+ kept_windows);
}
}
@@ -7421,12 +7459,13 @@ the return value is nil. Otherwise the value is t. */)
unblock_input ();
/* Scan dead buffer windows. */
- for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows))
- {
- window = XCAR (dead_windows);
- if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f)))
- delete_deletable_window (window);
- }
+ if (!NILP (Vwindow_kept_windows_functions))
+ for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows))
+ {
+ window = XCAR (dead_windows);
+ if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f)))
+ delete_deletable_window (window);
+ }
/* Record the selected window's buffer here. The window should
already be the selected one from the call above. */
@@ -7473,6 +7512,11 @@ the return value is nil. Otherwise the value is t. */)
minibuf_selected_window = data->minibuf_selected_window;
SAFE_FREE ();
+
+ if (!NILP (Vrun_hooks) && !NILP (Vwindow_kept_windows_functions))
+ run_hook_with_args_2 (Qwindow_kept_windows_functions, frame,
+ kept_windows);
+
return FRAME_LIVE_P (f) ? Qt : Qnil;
}
@@ -8470,6 +8514,8 @@ syms_of_window (void)
DEFSYM (Qheader_line_format, "header-line-format");
DEFSYM (Qtab_line_format, "tab-line-format");
DEFSYM (Qno_other_window, "no-other-window");
+ DEFSYM (Qwindow_kept_windows_functions,
+ "window-kept-windows-functions");
DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function,
doc: /* Non-nil means call as function to display a help buffer.
@@ -8627,6 +8673,28 @@ its buffer or its total or body size since the last
redisplay. Each
call is performed with the frame temporarily selected. */);
Vwindow_configuration_change_hook = Qnil;
+ DEFVAR_LISP ("window-kept-windows-functions",
+ Vwindow_kept_windows_functions,
+ doc: /* Functions run after restoring a window configuration or
state.
+These functions are called by `set-window-configuration' and
+`window-state-put'. When the value of this variable is non-nil, these
+functions restore any window whose buffer has been deleted since the
+corresponding configuration or state was saved. Rather than deleting
+such a window, `set-window-configuration' and `window-state-put' show
+some live buffer in it.
+
+The value should be a list of functions that take two arguments. The
+first argument specifies the frame whose configuration has been
+restored. The second argument, if non-nil, specifies a list of entries
+for each window whose buffer has been found dead at the time
+'set-window-configuration' or `window-state-put' tried to restore it in
+that window. Each entry is a list of four values - the window whose
+buffer was found dead, the dead buffer, and the positions of start and
+point of the buffer in that window. Note that the window may be already
+dead since another function on this list may have deleted it in the
+meantime. */);
+ Vwindow_kept_windows_functions = Qnil;
+
DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay,
doc: /* Non-nil means `recenter' redraws entire frame.
If this option is non-nil, then the `recenter' command with a nil
diff --git a/src/xdisp.c b/src/xdisp.c
index 4ff689b2df7..d03769e2a31 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2508,7 +2508,7 @@ get_glyph_string_clip_rects (struct glyph_string *s,
NativeRectangle *rects, int
r.x = s->clip_head->x;
}
if (s->clip_tail)
- if (r.x + r.width > s->clip_tail->x + s->clip_tail->background_width)
+ if (r.x + (int) r.width > s->clip_tail->x + s->clip_tail->background_width)
{
if (s->clip_tail->x + s->clip_tail->background_width >= r.x)
r.width = s->clip_tail->x + s->clip_tail->background_width - r.x;
@@ -2588,7 +2588,7 @@ get_glyph_string_clip_rects (struct glyph_string *s,
NativeRectangle *rects, int
height = max (FRAME_LINE_HEIGHT (s->f), glyph->ascent +
glyph->descent);
if (height < r.height)
{
- max_y = r.y + r.height;
+ max_y = r.y + (int) r.height;
r.y = min (max_y, max (r.y, s->ybase + glyph->descent - height));
r.height = min (max_y - r.y, height);
}
@@ -2629,7 +2629,7 @@ get_glyph_string_clip_rects (struct glyph_string *s,
NativeRectangle *rects, int
if (s->for_overlaps & OVERLAPS_PRED)
{
rs[i] = r;
- if (r.y + r.height > row_y)
+ if (r.y + (int) r.height > row_y)
{
if (r.y < row_y)
rs[i].height = row_y - r.y;
@@ -2643,10 +2643,10 @@ get_glyph_string_clip_rects (struct glyph_string *s,
NativeRectangle *rects, int
rs[i] = r;
if (r.y < row_y + s->row->visible_height)
{
- if (r.y + r.height > row_y + s->row->visible_height)
+ if (r.y + (int) r.height > row_y + s->row->visible_height)
{
rs[i].y = row_y + s->row->visible_height;
- rs[i].height = r.y + r.height - rs[i].y;
+ rs[i].height = r.y + (int) r.height - rs[i].y;
}
else
rs[i].height = 0;
@@ -2831,7 +2831,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy,
NativeRectangle *rect)
text_glyph:
gr = 0; gy = 0;
for (; r <= end_row && r->enabled_p; ++r)
- if (r->y + r->height > y)
+ if (r->y + (int) r->height > y)
{
gr = r; gy = r->y;
break;
@@ -2931,7 +2931,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy,
NativeRectangle *rect)
row_glyph:
gr = 0, gy = 0;
for (; r <= end_row && r->enabled_p; ++r)
- if (r->y + r->height > y)
+ if (r->y + (int) r->height > y)
{
gr = r; gy = r->y;
break;
@@ -4345,10 +4345,7 @@ compute_stop_pos (struct it *it)
}
}
- if (it->cmp_it.id < 0
- && (STRINGP (it->string)
- || ((!it->bidi_p || it->bidi_it.scan_dir >= 0)
- && it->cmp_it.stop_pos <= IT_CHARPOS (*it))))
+ if (it->cmp_it.id < 0)
{
ptrdiff_t stoppos = it->end_charpos;
@@ -4357,7 +4354,9 @@ compute_stop_pos (struct it *it)
characters to that position. */
if (it->bidi_p && it->bidi_it.scan_dir < 0)
stoppos = -1;
- else if (cmp_limit_pos > 0)
+ else if (!STRINGP (it->string)
+ && it->cmp_it.stop_pos <= IT_CHARPOS (*it)
+ && cmp_limit_pos > 0)
stoppos = cmp_limit_pos;
/* Force composition_compute_stop_pos avoid the costly search
for static compositions, since those were already found by
@@ -5062,31 +5061,169 @@ handle_invisible_prop (struct it *it)
{
enum prop_handled handled = HANDLED_NORMALLY;
int invis;
- Lisp_Object prop;
+ ptrdiff_t curpos, endpos;
+ Lisp_Object prop, pos, overlay;
+ /* Get the value of the invisible text property at the current
+ position. Value will be nil if there is no such property. */
if (STRINGP (it->string))
{
- Lisp_Object end_charpos, limit;
+ curpos = IT_STRING_CHARPOS (*it);
+ endpos = SCHARS (it->string);
+ pos = make_fixnum (curpos);
+ prop = Fget_text_property (pos, Qinvisible, it->string);
+ }
+ else /* buffer */
+ {
+ curpos = IT_CHARPOS (*it);
+ endpos = ZV;
+ pos = make_fixnum (curpos);
+ prop = get_char_property_and_overlay (pos, Qinvisible, it->window,
+ &overlay);
+ }
- /* Get the value of the invisible text property at the
- current position. Value will be nil if there is no such
- property. */
- end_charpos = make_fixnum (IT_STRING_CHARPOS (*it));
- prop = Fget_text_property (end_charpos, Qinvisible, it->string);
- invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ /* Do we have anything to do here? */
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ if (invis == 0 || curpos >= it->end_charpos)
+ return handled;
- if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos)
+ /* If not bidi, or the bidi iteration is at base paragraph level, we
+ can use a faster method; otherwise we need to check invisibility
+ of every character while bidi-iterating out of invisible text. */
+ bool slow = it->bidi_p && !BIDI_AT_BASE_LEVEL (it->bidi_it);
+ /* Record whether we have to display an ellipsis for the
+ invisible text. */
+ bool display_ellipsis_p = (invis == 2);
+
+ handled = HANDLED_RECOMPUTE_PROPS;
+
+ if (slow)
+ {
+ if (it->bidi_it.first_elt && it->bidi_it.charpos < endpos)
+ bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true);
+
+ if (STRINGP (it->string))
+ {
+ bool done = false;
+ /* Bidi-iterate out of the invisible part of the string. */
+ do
+ {
+ bidi_move_to_visually_next (&it->bidi_it);
+ if (it->bidi_it.charpos < 0 || it->bidi_it.charpos >= endpos)
+ done = true;
+ else
+ {
+ pos = make_fixnum (it->bidi_it.charpos);
+ prop = Fget_text_property (pos, Qinvisible, it->string);
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ /* If there are adjacent invisible texts, don't lose
+ the second one's ellipsis. */
+ if (invis == 2)
+ display_ellipsis_p = true;
+ }
+ }
+ while (!done && invis != 0);
+
+ if (display_ellipsis_p)
+ it->ellipsis_p = true;
+ IT_STRING_CHARPOS (*it) = it->bidi_it.charpos;
+ IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos;
+ if (IT_STRING_BYTEPOS (*it) >= endpos)
+ {
+ /* The rest of the string is invisible. If this is an
+ overlay string, proceed with the next overlay string
+ or whatever comes and return a character from there. */
+ if (it->current.overlay_string_index >= 0
+ && !display_ellipsis_p)
+ {
+ next_overlay_string (it);
+ /* Don't check for overlay strings when we just
+ finished processing them. */
+ handled = HANDLED_OVERLAY_STRING_CONSUMED;
+ }
+ }
+ }
+ else
{
- /* Record whether we have to display an ellipsis for the
- invisible text. */
- bool display_ellipsis_p = (invis == 2);
- ptrdiff_t len, endpos;
+ bool done = false;
+ /* Bidi-iterate out of the invisible text. */
+ do
+ {
+ bidi_move_to_visually_next (&it->bidi_it);
+ if (it->bidi_it.charpos < BEGV || it->bidi_it.charpos >= endpos)
+ done = true;
+ else
+ {
+ pos = make_fixnum (it->bidi_it.charpos);
+ prop = Fget_char_property (pos, Qinvisible, it->window);
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ /* If there are adjacent invisible texts, don't lose
+ the second one's ellipsis. */
+ if (invis == 2)
+ display_ellipsis_p = true;
+ }
+ }
+ while (!done && invis != 0);
+
+ IT_CHARPOS (*it) = it->bidi_it.charpos;
+ IT_BYTEPOS (*it) = it->bidi_it.bytepos;
+ if (display_ellipsis_p)
+ {
+ /* Make sure that the glyphs of the ellipsis will get
+ correct `charpos' values. See below for detailed
+ explanation why this is needed. */
+ it->position.charpos = IT_CHARPOS (*it) - 1;
+ it->position.bytepos = CHAR_TO_BYTE (it->position.charpos);
+ }
+ /* If there are before-strings at the start of invisible
+ text, and the text is invisible because of a text
+ property, arrange to show before-strings because 20.x did
+ it that way. (If the text is invisible because of an
+ overlay property instead of a text property, this is
+ already handled in the overlay code.) */
+ if (NILP (overlay)
+ && get_overlay_strings (it, it->stop_charpos))
+ {
+ handled = HANDLED_RECOMPUTE_PROPS;
+ if (it->sp > 0)
+ {
+ it->stack[it->sp - 1].display_ellipsis_p = display_ellipsis_p;
+ /* The call to get_overlay_strings above recomputes
+ it->stop_charpos, but it only considers changes
+ in properties and overlays beyond iterator's
+ current position. This causes us to miss changes
+ that happen exactly where the invisible property
+ ended. So we play it safe here and force the
+ iterator to check for potential stop positions
+ immediately after the invisible text. Note that
+ if get_overlay_strings returns true, it
+ normally also pushed the iterator stack, so we
+ need to update the stop position in the slot
+ below the current one. */
+ it->stack[it->sp - 1].stop_charpos
+ = CHARPOS (it->stack[it->sp - 1].current.pos);
+ }
+ }
+ else if (display_ellipsis_p)
+ {
+ it->ellipsis_p = true;
+ /* Let the ellipsis display before
+ considering any properties of the following char.
+ Fixes jasonr@gnu.org 01 Oct 07 bug. */
+ handled = HANDLED_RETURN;
+ }
+ }
+ }
+ else if (STRINGP (it->string))
+ {
+ Lisp_Object end_charpos = pos, limit;
- handled = HANDLED_RECOMPUTE_PROPS;
+ if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos)
+ {
+ ptrdiff_t len = endpos;
/* Get the position at which the next visible text can be
found in IT->string, if any. */
- endpos = len = SCHARS (it->string);
XSETINT (limit, len);
do
{
@@ -5137,7 +5274,7 @@ handle_invisible_prop (struct it *it)
IT_STRING_CHARPOS (*it) = it->bidi_it.charpos;
IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos;
- if (IT_CHARPOS (*it) >= endpos)
+ if (IT_STRING_CHARPOS (*it) >= endpos)
it->prev_stop = endpos;
}
else
@@ -5167,27 +5304,14 @@ handle_invisible_prop (struct it *it)
}
}
}
- else
+ else /* we are iterating over buffer text at base paragraph level */
{
- ptrdiff_t newpos, next_stop, start_charpos, tem;
- Lisp_Object pos, overlay;
-
- /* First of all, is there invisible text at this position? */
- tem = start_charpos = IT_CHARPOS (*it);
- pos = make_fixnum (tem);
- prop = get_char_property_and_overlay (pos, Qinvisible, it->window,
- &overlay);
- invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ ptrdiff_t newpos, next_stop, tem = curpos;
+ Lisp_Object pos;
/* If we are on invisible text, skip over it. */
- if (invis != 0 && start_charpos < it->end_charpos)
+ if (invis != 0 && curpos < it->end_charpos)
{
- /* Record whether we have to display an ellipsis for the
- invisible text. */
- bool display_ellipsis_p = invis == 2;
-
- handled = HANDLED_RECOMPUTE_PROPS;
-
/* Loop skipping over invisible text. The loop is left at
ZV or with IT on the first char being visible again. */
do
@@ -5487,9 +5611,6 @@ display_min_width (struct it *it, ptrdiff_t bufpos,
if (!NILP (it->min_width_property)
&& !EQ (width_spec, it->min_width_property))
{
- if (!it->glyph_row)
- return;
-
/* When called from display_string (i.e., the mode line),
we're being called with a string as the object, and we
may be called with many sub-strings belonging to the same
@@ -18736,6 +18857,14 @@ enum
`scroll-conservatively' and the Emacs manual. */
#define SCROLL_LIMIT 100
+/* The freshness of the w->base_line_number cache is only ensured at every
+ redisplay cycle, so the cache can be used only if there's been
+ no relevant changes to the buffer since the last redisplay. */
+#define BASE_LINE_NUMBER_VALID_P(w) \
+ (eassert (current_buffer == XBUFFER ((w)->contents)), \
+ !current_buffer->clip_changed \
+ && BEG_UNCHANGED >= (w)->base_line_pos)
+
static int
try_scrolling (Lisp_Object window, bool just_this_one_p,
intmax_t arg_scroll_conservatively, intmax_t scroll_step,
@@ -19036,9 +19165,10 @@ try_scrolling (Lisp_Object window, bool
just_this_one_p,
else
{
/* Maybe forget recorded base line for line number display. */
- if (!just_this_one_p
- || current_buffer->clip_changed
- || BEG_UNCHANGED < CHARPOS (startp))
+ /* FIXME: Why do we need this? `try_scrolling` can only be called from
+ `redisplay_window` which should have flushed this cache already when
+ eeded. */
+ if (!BASE_LINE_NUMBER_VALID_P (w))
w->base_line_number = 0;
/* If cursor ends up on a partially visible line,
@@ -19808,9 +19938,6 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
/* Record it now because it's overwritten. */
bool current_matrix_up_to_date_p = false;
bool used_current_matrix_p = false;
- /* This is less strict than current_matrix_up_to_date_p.
- It indicates that the buffer contents and narrowing are unchanged. */
- bool buffer_unchanged_p = false;
bool temp_scroll_step = false;
specpdl_ref count = SPECPDL_INDEX ();
int rc;
@@ -19916,11 +20043,6 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
specbind (Qinhibit_point_motion_hooks, Qt);
- buffer_unchanged_p
- = (w->window_end_valid
- && !current_buffer->clip_changed
- && !window_outdated (w));
-
/* When windows_or_buffers_changed is non-zero, we can't rely
on the window end being valid, so set it to zero there. */
if (windows_or_buffers_changed)
@@ -20060,6 +20182,10 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
}
}
+ if (!BASE_LINE_NUMBER_VALID_P (w))
+ /* Forget any recorded base line for line number display. */
+ w->base_line_number = 0;
+
force_start:
/* Handle case where place to start displaying has been specified,
@@ -20080,10 +20206,6 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
w->preserve_vscroll_p = false;
w->window_end_valid = false;
- /* Forget any recorded base line for line number display. */
- if (!buffer_unchanged_p)
- w->base_line_number = 0;
-
/* Redisplay the mode line. Select the buffer properly for that.
Also, run the hook window-scroll-functions
because we have scrolled. */
@@ -20412,12 +20534,6 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
if (w->cursor.vpos >= 0)
{
- if (!just_this_one_p
- || current_buffer->clip_changed
- || BEG_UNCHANGED < CHARPOS (startp))
- /* Forget any recorded base line for line number display. */
- w->base_line_number = 0;
-
if (!cursor_row_fully_visible_p (w, true, false, false))
{
clear_glyph_matrix (w->desired_matrix);
@@ -20488,10 +20604,6 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
debug_method_add (w, "recenter");
#endif
- /* Forget any previously recorded base line for line number display. */
- if (!buffer_unchanged_p)
- w->base_line_number = 0;
-
/* Determine the window start relative to point. */
init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID);
it.current_y = it.last_visible_y;
@@ -24658,6 +24770,13 @@ maybe_produce_line_number (struct it *it)
if (!last_line)
{
/* If possible, reuse data cached by line-number-mode. */
+ /* NOTE: We use `base_line_number` without checking
+ BASE_LINE_NUMBER_VALID_P because we assume that `redisplay_window`
+ has already flushed this cache for us when needed.
+ NOTE2: Checking BASE_LINE_NUMBER_VALID_P here would be
+ overly pessimistic because it might say that the cache
+ was invalid before entering `redisplay_window` yet the
+ value has just been refreshed. */
if (it->w->base_line_number > 0
&& it->w->base_line_pos > 0
&& it->w->base_line_pos <= IT_CHARPOS (*it)
@@ -24937,7 +25056,7 @@ should_produce_line_number (struct it *it)
because get-char-property always returns nil for ZV, except if
the property is in 'default-text-properties'. */
if (NILP (val) && IT_CHARPOS (*it) >= ZV)
- val = disable_line_numbers_overlay_at_eob ();
+ return !disable_line_numbers_overlay_at_eob ();
return NILP (val) ? true : false;
}
@@ -28050,6 +28169,11 @@ are the selected window and the WINDOW's buffer). */)
init_iterator (&it, w, -1, -1, NULL, face_id);
+ /* Make sure `base_line_number` is fresh in case we encounter a `%l`. */
+ if (current_buffer == XBUFFER ((w)->contents)
+ && !BASE_LINE_NUMBER_VALID_P (w))
+ w->base_line_number = 0;
+
if (no_props)
{
mode_line_target = MODE_LINE_NOPROP;
@@ -28502,30 +28626,29 @@ decode_mode_spec (struct window *w, register int c,
int field_width,
when the buffer's restriction was changed, but the window
wasn't yet redisplayed after that. If that happens, we
need to determine a new base line. */
- if (!(BUF_BEGV_BYTE (b) <= startpos_byte
+ if (current_buffer != XBUFFER (w->contents)
+ || !(BUF_BEGV_BYTE (b) <= startpos_byte
&& startpos_byte <= BUF_ZV_BYTE (b)))
{
startpos = BUF_BEGV (b);
startpos_byte = BUF_BEGV_BYTE (b);
- w->base_line_pos = 0;
- w->base_line_number = 0;
}
/* If we decided that this buffer isn't suitable for line numbers,
- don't forget that too fast. */
+ don't forget that too fast.
+ FIXME: What if `current_buffer != w->contents`? */
if (w->base_line_pos == -1)
goto no_value;
/* If the buffer is very big, don't waste time. */
if (FIXNUMP (Vline_number_display_limit)
&& BUF_ZV (b) - BUF_BEGV (b) > XFIXNUM (Vline_number_display_limit))
- {
- w->base_line_pos = 0;
- w->base_line_number = 0;
- goto no_value;
- }
+ goto no_value;
- if (w->base_line_number > 0
+ /* Callers of `display_mode_element` are in charge of flushing
+ any stale `base_line_number` cache. */
+ if (current_buffer == XBUFFER ((w)->contents)
+ && w->base_line_number > 0
&& w->base_line_pos > 0
&& w->base_line_pos <= startpos)
{
@@ -28551,7 +28674,9 @@ decode_mode_spec (struct window *w, register int c, int
field_width,
or too far away, or if we did not have one.
"Too close" means it's plausible a scroll-down would
go back past it. */
- if (startpos == BUF_BEGV (b))
+ if (current_buffer != XBUFFER (w->contents))
+ ; /* The base line is for another buffer, don't touch it! */
+ else if (startpos == BUF_BEGV (b))
{
w->base_line_number = topline;
w->base_line_pos = BUF_BEGV (b);
@@ -28588,6 +28713,12 @@ decode_mode_spec (struct window *w, register int c,
int field_width,
goto no_value;
}
+ /* NOTE: if `clip_changed` is set or if `BEG_UNCHANGED` is
+ before `position`, this new cached value may get flushed
+ soon needlessly, because we can't reset `BEG_UNCHANGED` or
+ `clip_changed` from here (since they reflect the changes
+ since the last redisplay so they can only be reset from
+ `mark_window_display_accurate_1`). :-( */
w->base_line_number = topline - nlines;
w->base_line_pos = BYTE_TO_CHAR (position);
}
@@ -36329,7 +36460,7 @@ expose_area (struct window *w, struct glyph_row *row,
const Emacs_Rectangle *r,
/* Use a signed int intermediate value to avoid catastrophic
failures due to comparison between signed and unsigned, when
x is negative (can happen for wide images that are hscrolled). */
- int r_end = r->x + r->width;
+ int r_end = r->x + (int) r->width;
while (last < end && x < r_end)
{
x += last->pixel_width;
@@ -36628,7 +36759,7 @@ expose_window (struct window *w, const Emacs_Rectangle
*fr)
/* Use a signed int intermediate value to avoid catastrophic
failures due to comparison between signed and unsigned, when
y0 or y1 is negative (can happen for tall images). */
- int r_bottom = r.y + r.height;
+ int r_bottom = r.y + (int) r.height;
/* We must temporarily switch to the window's buffer, in case
the fringe face has been remapped in that buffer's
@@ -36675,7 +36806,7 @@ expose_window (struct window *w, const Emacs_Rectangle
*fr)
/* We must redraw a row overlapping the exposed area. */
if (y0 < r.y
? y0 + row->phys_height > r.y
- : y0 + row->ascent - row->phys_ascent < r.y +r.height)
+ : y0 + row->ascent - row->phys_ascent < r.y + (int) r.height)
{
if (first_overlapping_row == NULL)
first_overlapping_row = row;
@@ -36854,7 +36985,7 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1,
const Emacs_Rectangle *r2,
const Emacs_Rectangle *upper, *lower;
bool intersection_p = false;
- /* Rearrange so that R1 is the left-most rectangle. */
+ /* Rearrange so that left is the left-most rectangle. */
if (r1->x < r2->x)
left = r1, right = r2;
else
@@ -36862,13 +36993,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1,
const Emacs_Rectangle *r2,
/* X0 of the intersection is right.x0, if this is inside R1,
otherwise there is no intersection. */
- if (right->x <= left->x + left->width)
+ if (right->x <= left->x + (int) left->width)
{
result->x = right->x;
/* The right end of the intersection is the minimum of
the right ends of left and right. */
- result->width = (min (left->x + left->width, right->x + right->width)
+ result->width = (min (left->x + (int) left->width,
+ right->x + (int) right->width)
- result->x);
/* Same game for Y. */
@@ -36879,14 +37011,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1,
const Emacs_Rectangle *r2,
/* The upper end of the intersection is lower.y0, if this is inside
of upper. Otherwise, there is no intersection. */
- if (lower->y <= upper->y + upper->height)
+ if (lower->y <= upper->y + (int) upper->height)
{
result->y = lower->y;
/* The lower end of the intersection is the minimum of the lower
ends of upper and lower. */
- result->height = (min (lower->y + lower->height,
- upper->y + upper->height)
+ result->height = (min (lower->y + (int) lower->height,
+ upper->y + (int) upper->height)
- result->y);
intersection_p = true;
}
diff --git a/src/xfaces.c b/src/xfaces.c
index b9a78328661..a558e7328c0 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -2245,20 +2245,20 @@ merge_face_heights (Lisp_Object from, Lisp_Object to,
Lisp_Object invalid)
/* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
store the resulting attributes in TO, which must be already be
- completely specified and contain only absolute attributes.
- Every specified attribute of FROM overrides the corresponding
- attribute of TO; relative attributes in FROM are merged with the
- absolute value in TO and replace it. NAMED_MERGE_POINTS is used
- internally to detect loops in face inheritance/remapping; it should
- be 0 when called from other places. If window W is non-NULL, use W
- to interpret face specifications. */
+ completely specified and contain only absolute attributes. Every
+ specified attribute of FROM overrides the corresponding attribute of
+ TO; merge relative attributes in FROM with the absolute value in TO,
+ which attributes also replace it. Use NAMED_MERGE_POINTS internally
+ to detect loops in face inheritance/remapping; it should be 0 when
+ called from other places. If window W is non-NULL, use W to
+ interpret face specifications. */
static void
merge_face_vectors (struct window *w,
struct frame *f, const Lisp_Object *from, Lisp_Object *to,
struct named_merge_point *named_merge_points)
{
int i;
- Lisp_Object font = Qnil;
+ Lisp_Object font = Qnil, tospec, adstyle;
/* If FROM inherits from some other faces, merge their attributes into
TO before merging FROM's direct attributes. Note that an :inherit
@@ -2318,6 +2318,25 @@ merge_face_vectors (struct window *w,
to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font);
if (! NILP (AREF (font, FONT_WIDTH_INDEX)))
to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font);
+
+ if (!NILP (AREF (font, FONT_ADSTYLE_INDEX)))
+ {
+ /* If an adstyle is specified in FROM's font spec, create a
+ font spec for TO if none exists, and transfer the adstyle
+ there. */
+
+ tospec = to[LFACE_FONT_INDEX];
+ adstyle = AREF (font, FONT_ADSTYLE_INDEX);
+
+ if (!NILP (tospec))
+ tospec = copy_font_spec (tospec);
+ else
+ tospec = Ffont_spec (0, NULL);
+
+ to[LFACE_FONT_INDEX] = tospec;
+ ASET (tospec, FONT_ADSTYLE_INDEX, adstyle);
+ }
+
ASET (font, FONT_SIZE_INDEX, Qnil);
}
diff --git a/test/Makefile.in b/test/Makefile.in
index d19b71a431b..e5730d88046 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -92,6 +92,10 @@ export TEST_LOAD_EL ?= \
# Additional settings for ert.
ert_opts =
+# Supply a path to local tree-sitter installations, as we run tests
+# without a valid HOME.
+ert_opts += --eval "(setq treesit-extra-load-path
'(\"$(HOME)/.emacs.d/tree-sitter\"))"
+
# Maximum length of lines in ert backtraces; nil for no limit.
# (if empty, use the default ert-batch-backtrace-right-margin).
TEST_BACKTRACE_LINE_LENGTH =
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
index 8e583fade9f..d79072b06b5 100644
--- a/test/infra/Dockerfile.emba
+++ b/test/infra/Dockerfile.emba
@@ -126,7 +126,7 @@ RUN src/emacs -Q --batch \
(java "https://github.com/tree-sitter/tree-sitter-java";) \
(javascript "https://github.com/tree-sitter/tree-sitter-javascript";) \
(json "https://github.com/tree-sitter/tree-sitter-json";) \
- (lua "https://github.com/MunifTanjim/tree-sitter-lua";) \
+ (lua "https://github.com/tree-sitter-grammars/tree-sitter-lua";) \
(python "https://github.com/tree-sitter/tree-sitter-python";) \
(ruby "https://github.com/tree-sitter/tree-sitter-ruby";) \
(tsx "https://github.com/tree-sitter/tree-sitter-typescript"; "master"
"tsx/src") \
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index bfdfac8be1b..cdd1a7832d3 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -57,12 +57,10 @@
(ert-deftest abbrev-make-abbrev-table-test ()
;; Table without properties:
(let ((table (make-abbrev-table)))
- (should (abbrev-table-p table))
- (should (= (length table) obarray-default-size)))
+ (should (abbrev-table-p table)))
;; Table with one property 'foo with value 'bar:
(let ((table (make-abbrev-table '(foo bar))))
(should (abbrev-table-p table))
- (should (= (length table) obarray-default-size))
(should (eq (abbrev-table-get table 'foo) 'bar))))
(ert-deftest abbrev--table-symbols-test ()
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index 0a3c1cce590..c091a7dd060 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -33,8 +33,8 @@
(require 'secrets)
(defun auth-source-ensure-ignored-backend (source)
- (auth-source-validate-backend source '((:source . "")
- (:type . ignore))))
+ (auth-source-validate-backend source '((source . "")
+ (type . ignore))))
(defun auth-source-validate-backend (source validation-alist)
(let ((backend (auth-source-backend-parse source)))
@@ -44,84 +44,101 @@
(ert-deftest auth-source-backend-parse-macos-keychain ()
(auth-source-validate-backend '(:source (:macos-keychain-generic foobar))
- '((:source . "foobar")
- (:type . macos-keychain-generic)
- (:search-function .
auth-source-macos-keychain-search)
- (:create-function .
auth-source-macos-keychain-create))))
+ '((source . "foobar")
+ (type . macos-keychain-generic)
+ (search-function .
auth-source-macos-keychain-search)
+ (create-function .
auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-generic-string ()
(auth-source-validate-backend "macos-keychain-generic:foobar"
- '((:source . "foobar")
- (:type . macos-keychain-generic)
- (:search-function .
auth-source-macos-keychain-search)
- (:create-function .
auth-source-macos-keychain-create))))
+ '((source . "foobar")
+ (type . macos-keychain-generic)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-internet-string ()
(auth-source-validate-backend "macos-keychain-internet:foobar"
- '((:source . "foobar")
- (:type . macos-keychain-internet)
- (:search-function .
auth-source-macos-keychain-search)
- (:create-function .
auth-source-macos-keychain-create))))
+ '((source . "foobar")
+ (type . macos-keychain-internet)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-internet-symbol ()
(auth-source-validate-backend 'macos-keychain-internet
- '((:source . "default")
- (:type . macos-keychain-internet)
- (:search-function .
auth-source-macos-keychain-search)
- (:create-function .
auth-source-macos-keychain-create))))
+ '((source . "default")
+ (type . macos-keychain-internet)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-generic-symbol ()
(auth-source-validate-backend 'macos-keychain-generic
- '((:source . "default")
- (:type . macos-keychain-generic)
- (:search-function .
auth-source-macos-keychain-search)
- (:create-function .
auth-source-macos-keychain-create))))
+ '((source . "default")
+ (type . macos-keychain-generic)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-internet-default-string
()
(auth-source-validate-backend 'macos-keychain-internet
- '((:source . "default")
- (:type . macos-keychain-internet)
- (:search-function .
auth-source-macos-keychain-search)
- (:create-function .
auth-source-macos-keychain-create))))
+ '((source . "default")
+ (type . macos-keychain-internet)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-plstore ()
(auth-source-validate-backend '(:source "foo.plist")
- '((:source . "foo.plist")
- (:type . plstore)
- (:search-function .
auth-source-plstore-search)
- (:create-function .
auth-source-plstore-create))))
+ '((source . "foo.plist")
+ (type . plstore)
+ (search-function .
auth-source-plstore-search)
+ (create-function
+ . auth-source-plstore-create))))
(ert-deftest auth-source-backend-parse-netrc ()
(auth-source-validate-backend '(:source "foo")
- '((:source . "foo")
- (:type . netrc)
- (:search-function . auth-source-netrc-search)
- (:create-function .
auth-source-netrc-create))))
+ '((source . "foo")
+ (type . netrc)
+ (search-function . auth-source-netrc-search)
+ (create-function
+ . auth-source-netrc-create))))
(ert-deftest auth-source-backend-parse-netrc-string ()
(auth-source-validate-backend "foo"
- '((:source . "foo")
- (:type . netrc)
- (:search-function . auth-source-netrc-search)
- (:create-function .
auth-source-netrc-create))))
+ '((source . "foo")
+ (type . netrc)
+ (search-function . auth-source-netrc-search)
+ (create-function
+ . auth-source-netrc-create))))
(ert-deftest auth-source-backend-parse-secrets ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
(auth-source-validate-backend '(:source (:secrets "foo"))
- '((:source . "foo")
- (:type . secrets)
- (:search-function .
auth-source-secrets-search)
- (:create-function .
auth-source-secrets-create)))))
+ '((source . "foo")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create)))))
(ert-deftest auth-source-backend-parse-secrets-strings ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
(auth-source-validate-backend "secrets:foo"
- '((:source . "foo")
- (:type . secrets)
- (:search-function .
auth-source-secrets-search)
- (:create-function .
auth-source-secrets-create)))))
+ '((source . "foo")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create)))))
(ert-deftest auth-source-backend-parse-secrets-alias ()
(provide 'secrets) ; simulates the presence of the `secrets' package
@@ -129,10 +146,12 @@
;; Redefine `secrets-get-alias' to map 'foo to "foo"
(cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo")))
(auth-source-validate-backend '(:source (:secrets foo))
- '((:source . "foo")
- (:type . secrets)
- (:search-function .
auth-source-secrets-search)
- (:create-function .
auth-source-secrets-create))))))
+ '((source . "foo")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create))))))
(ert-deftest auth-source-backend-parse-secrets-symbol ()
(provide 'secrets) ; simulates the presence of the `secrets' package
@@ -140,10 +159,12 @@
;; Redefine `secrets-get-alias' to map 'default to "foo"
(cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo")))
(auth-source-validate-backend 'default
- '((:source . "foo")
- (:type . secrets)
- (:search-function .
auth-source-secrets-search)
- (:create-function .
auth-source-secrets-create))))))
+ '((source . "foo")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create))))))
(ert-deftest auth-source-backend-parse-secrets-no-alias ()
(provide 'secrets) ; simulates the presence of the `secrets' package
@@ -152,10 +173,12 @@
;; "Login" is used by default
(cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) nil)))
(auth-source-validate-backend '(:source (:secrets foo))
- '((:source . "Login")
- (:type . secrets)
- (:search-function .
auth-source-secrets-search)
- (:create-function .
auth-source-secrets-create))))))
+ '((source . "Login")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create))))))
(ert-deftest auth-source-backend-parse-invalid-or-nil-source ()
(provide 'secrets) ; simulates the presence of the `secrets' package
diff --git a/test/lisp/completion-preview-tests.el
b/test/lisp/completion-preview-tests.el
index 190764e9125..5b2c28bd3dd 100644
--- a/test/lisp/completion-preview-tests.el
+++ b/test/lisp/completion-preview-tests.el
@@ -181,4 +181,19 @@ instead."
(completion-preview--post-command))
(completion-preview-tests--check-preview "barbaz" 'exact)))
+(ert-deftest completion-preview-mid-symbol-cycle ()
+ "Test cycling the completion preview with point at the middle of a symbol."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("foobar" "foobaz"))))
+ (insert "fooba")
+ (forward-char -2)
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "r")
+ (completion-preview-next-candidate 1)
+ (completion-preview-tests--check-preview "z")))
+
;;; completion-preview-tests.el ends here
diff --git
a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
index 94b0e80c979..571f7f6f095 100644
--- a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
@@ -1,3 +1,4 @@
;;; -*- lexical-binding: t -*-
(defun foo ()
-
"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
+
"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
+ nil)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index cc9f872e785..b947cb8edfd 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -800,6 +800,9 @@ inner loops respectively."
;; Aristotelian identity optimization
(let ((x (bytecomp-test-identity 1)))
(list (eq x x) (eql x x) (equal x x)))
+
+ ;; Legacy single-arg `apply' call
+ (apply '(* 2 3))
)
"List of expressions for cross-testing interpreted and compiled code.")
@@ -848,6 +851,22 @@ byte-compiled. Run with dynamic binding."
(should (equal (bytecomp-tests--eval-interpreted form)
(bytecomp-tests--eval-compiled form)))))))
+(ert-deftest bytecomp--fun-value-as-head ()
+ ;; Check that (FUN-VALUE ...) is a valid call, for compatibility (bug#68931).
+ ;; (There is also a warning but this test does not check that.)
+ (dolist (lb '(nil t))
+ (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ")
+ (let* ((lexical-binding lb)
+ (s-int '(lambda (x) (1+ x)))
+ (s-comp (byte-compile s-int))
+ (v-int (lambda (x) (1+ x)))
+ (v-comp (byte-compile v-int))
+ (comp (lambda (f) (funcall (byte-compile `(lambda () (,f 3)))))))
+ (should (equal (funcall comp s-int) 4))
+ (should (equal (funcall comp s-comp) 4))
+ (should (equal (funcall comp v-int) 4))
+ (should (equal (funcall comp v-comp) 4))))))
+
(defmacro bytecomp-tests--with-fresh-warnings (&rest body)
`(let ((macroexp--warned ; oh dear
(make-hash-table :test #'equal :weakness 'key)))
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 086ac399352..990fa580c54 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -319,5 +319,19 @@ Edebug symbols (Bug#42672)."
(and (eq 'error (car err))
(string-match "Stray.*declare" (cadr err)))))))
+(cl-defmethod cl-generic-tests--print-quoted-method ((function (eql '4)))
+ (+ function 1))
+
+(ert-deftest cl-generic-tests--print-quoted ()
+ (with-temp-buffer
+ (cl--generic-describe 'cl-generic-tests--print-quoted-method)
+ (goto-char (point-min))
+ ;; Bug#54628: We don't want (function (eql '4)) to turn into #'(eql '4)
+ (should-not (re-search-forward "#'" nil t))
+ (goto-char (point-min))
+ ;; But we don't want (eql '4) to turn into (eql (quote 4)) either.
+ (should (re-search-forward "(eql '4)" nil t))))
+
+
(provide 'cl-generic-tests)
;;; cl-generic-tests.el ends here
diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el
b/test/lisp/emacs-lisp/comp-cstr-tests.el
index edc70b12d4b..991ab1f40eb 100644
--- a/test/lisp/emacs-lisp/comp-cstr-tests.el
+++ b/test/lisp/emacs-lisp/comp-cstr-tests.el
@@ -169,7 +169,7 @@ The arg is an alist of: type specifier -> expected type
specifier."
((and symbol (not symbol)) . nil)
;; 61
((and atom (not symbol)) . atom)
- ;; 62
+ ;; 62 Conservative FIXME
((and atom (not string)) . (or array sequence atom))
;; 63 Conservative
((and symbol (not (member foo))) . symbol)
diff --git a/test/lisp/emacs-lisp/edebug-tests.el
b/test/lisp/emacs-lisp/edebug-tests.el
index 8c0f729dc39..29adbcff947 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -860,8 +860,7 @@ test and possibly others should be updated."
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
(insert "`1"))
- (with-suppressed-warnings ((obsolete edebug-eval-defun))
- (edebug-eval-defun nil))
+ (eval-defun nil)
;; `eval-defun' outputs its message to the echo area in a rather
;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed
;; there in separate pieces (via `print' rather than via `message').
@@ -871,18 +870,21 @@ test and possibly others should be updated."
(setq edebug-initial-mode 'go)
;; In Bug#23651 Edebug would hang reading `1.
- (with-suppressed-warnings ((obsolete edebug-eval-defun))
- (edebug-eval-defun t))))
+ (eval-defun t)
+ (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)")
+ edebug-tests-messages))))
(ert-deftest edebug-tests-trivial-comma ()
"Edebug can read a trivial comma expression (Bug#23651)."
(edebug-tests-with-normal-env
- (read-only-mode -1)
- (delete-region (point-min) (point-max))
- (insert ",1")
- (read-only-mode)
- (with-suppressed-warnings ((obsolete edebug-eval-defun))
- (should-error (edebug-eval-defun t)))))
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (insert ",1"))
+ ;; FIXME: This currently signals a "Source has changed" error, which is
+ ;; itself a bug (the source hasn't changed). All we're testing here
+ ;; is that the Edebug gets past the step of reading the sexp.
+ (should-error (let ((eval-expression-debug-on-error nil))
+ (eval-defun t)))))
(ert-deftest edebug-tests-circular-read-syntax ()
"Edebug can instrument code using circular read object syntax (Bug#23660)."
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
index b244a56779a..fb2c6ea3b68 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
@@ -259,7 +259,7 @@
(ans '(
(:PRIMARY D)
(:PRIMARY D-base1)
- ;; (:PRIMARY D-base2)
+ (:PRIMARY D-base2)
(:PRIMARY D-base0)
)))
(eitest-F (D nil))
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 83fc476c911..bc226757ff2 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -1011,24 +1011,24 @@ Subclasses to override slot attributes."))
(B (clone A :b "bb"))
(C (clone B :a "aa")))
- (should (string= "aa" (oref C :a)))
- (should (string= "bb" (oref C :b)))
+ (should (string= "aa" (oref C a)))
+ (should (string= "bb" (oref C b)))
- (should (slot-boundp A :a))
- (should-not (slot-boundp A :b))
- (should-not (slot-boundp A :c))
+ (should (slot-boundp A 'a))
+ (should-not (slot-boundp A 'b))
+ (should-not (slot-boundp A 'c))
- (should-not (slot-boundp B :a))
- (should (slot-boundp B :b))
- (should-not (slot-boundp A :c))
+ (should-not (slot-boundp B 'a))
+ (should (slot-boundp B 'b))
+ (should-not (slot-boundp A 'c))
- (should (slot-boundp C :a))
- (should-not (slot-boundp C :b))
- (should-not (slot-boundp C :c))
+ (should (slot-boundp C 'a))
+ (should-not (slot-boundp C 'b))
+ (should-not (slot-boundp C 'c))
- (should (eieio-instance-inheritor-slot-boundp C :a))
- (should (eieio-instance-inheritor-slot-boundp C :b))
- (should-not (eieio-instance-inheritor-slot-boundp C :c))))
+ (should (eieio-instance-inheritor-slot-boundp C 'a))
+ (should (eieio-instance-inheritor-slot-boundp C 'b))
+ (should-not (eieio-instance-inheritor-slot-boundp C 'c))))
;;;; Interaction with defstruct
diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el
b/test/lisp/emacs-lisp/macroexp-resources/vk.el
index 460b7a8e516..5358bcaeb5c 100644
--- a/test/lisp/emacs-lisp/macroexp-resources/vk.el
+++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el
@@ -25,7 +25,7 @@
(if (macroexp--dynamic-variable-p var) ''dyn ''lex))
(defvar vk-a 1)
-(defconst vk-b 2)
+(defvar vk-b 2)
(defvar vk-c)
(defun vk-f1 (x)
diff --git a/test/lisp/emacs-lisp/tabulated-list-tests.el
b/test/lisp/emacs-lisp/tabulated-list-tests.el
index 8be2be3139e..e53268b3f14 100644
--- a/test/lisp/emacs-lisp/tabulated-list-tests.el
+++ b/test/lisp/emacs-lisp/tabulated-list-tests.el
@@ -130,4 +130,45 @@
(should-error (tabulated-list-sort) :type 'user-error)
(should-error (tabulated-list-sort 4) :type 'user-error)))
+(ert-deftest tabulated-list-groups ()
+ (with-temp-buffer
+ (tabulated-list-mode)
+ (setq tabulated-list-groups
+ (reverse
+ (seq-group-by (lambda (b) (concat "* " (aref (cadr b) 3)))
+ tabulated-list--test-entries)))
+ (setq tabulated-list-format tabulated-list--test-format)
+ (setq tabulated-list-padding 7)
+ (tabulated-list-init-header)
+ (tabulated-list-print)
+ ;; Basic printing.
+ (should (string-equal
+ (buffer-substring-no-properties (point-min) (point-max))
+ "\
+* installed
+ zzzz-game zzzz-game 2113 installed play zzzz in Emacs
+ mode mode 1128 installed A simple mode for editing
Actionscript 3 files
+* available
+ abc-mode abc-mode 944 available Major mode for editing abc
music files
+* obsolete
+ 4clojure 4clojure 1507 obsolete Open and evaluate
4clojure.com questions
+"))
+ ;; Sort and preserve position.
+ (forward-line 2)
+ (let ((pos (thing-at-point 'line)))
+ (tabulated-list-next-column 2)
+ (tabulated-list-sort)
+ (should (equal (thing-at-point 'line) pos))
+ (should (string-equal
+ (buffer-substring-no-properties (point-min) (point-max))
+ "\
+* installed
+ mode mode 1128 installed A simple mode for editing
Actionscript 3 files
+ zzzz-game zzzz-game 2113 installed play zzzz in Emacs
+* available
+ abc-mode abc-mode 944 available Major mode for editing abc
music files
+* obsolete
+ 4clojure 4clojure 1507 obsolete Open and evaluate
4clojure.com questions
+")))))
+
;;; tabulated-list-tests.el ends here
diff --git a/test/lisp/erc/erc-button-tests.el
b/test/lisp/erc/erc-button-tests.el
index ba6fe9fd8c1..603b3745a27 100644
--- a/test/lisp/erc/erc-button-tests.el
+++ b/test/lisp/erc/erc-button-tests.el
@@ -20,14 +20,13 @@
;;; Commentary:
;;; Code:
+(require 'erc-button)
(require 'ert-x) ; cl-lib
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-button)
-
(ert-deftest erc-button-alist--url ()
(erc-tests-common-init-server-proc "sleep" "1")
(with-current-buffer (erc--open-target "#chan")
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 0f19b481f37..3c4ad04abd7 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -23,13 +23,13 @@
;; scenarios.
;;; Code:
+(require 'erc-fill)
+
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-fill)
-
(defvar erc-fill-tests--buffers nil)
(defvar erc-fill-tests--current-time-value nil)
@@ -52,6 +52,7 @@
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
+ (erc--fill-wrap-scrolltobottom-exempt-p t)
(erc-stamp--tz t)
(erc-fill-function 'erc-fill-wrap)
(pre-command-hook pre-command-hook)
diff --git a/test/lisp/erc/erc-goodies-tests.el
b/test/lisp/erc/erc-goodies-tests.el
index 170e28bda96..7013ce0c8fc 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -19,13 +19,13 @@
;;; Commentary:
;;; Code:
+(require 'erc-goodies)
+
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-goodies)
-
(defun erc-goodies-tests--assert-face (beg end-str present &optional absent)
(setq beg (+ beg (point-min)))
(let ((end (+ beg (1- (length end-str)))))
diff --git a/test/lisp/erc/erc-networks-tests.el
b/test/lisp/erc/erc-networks-tests.el
index 53cff8f489c..90b8aa99741 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -18,6 +18,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+(require 'erc-compat)
(require 'ert-x) ; cl-lib
(eval-and-compile
diff --git a/test/lisp/erc/erc-scenarios-base-renick.el
b/test/lisp/erc/erc-scenarios-base-renick.el
index ca22728b152..e0fcb8b9366 100644
--- a/test/lisp/erc/erc-scenarios-base-renick.el
+++ b/test/lisp/erc/erc-scenarios-base-renick.el
@@ -281,12 +281,12 @@
(should-not (get-buffer "rando@barnet"))
(with-current-buffer "frenemy@foonet"
- (funcall expect 1 "now known as")
- (funcall expect 1 "doubly so"))
+ (funcall expect 10 "now known as")
+ (funcall expect 10 "doubly so"))
(with-current-buffer "frenemy@barnet"
- (funcall expect 1 "now known as")
- (funcall expect 1 "reality picture"))
+ (funcall expect 10 "now known as")
+ (funcall expect 10 "reality picture"))
(when noninteractive
(with-current-buffer "frenemy@barnet" (kill-buffer))
diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el
b/test/lisp/erc/erc-scenarios-misc-commands.el
index d6ed53b5358..da6855caf57 100644
--- a/test/lisp/erc/erc-scenarios-misc-commands.el
+++ b/test/lisp/erc/erc-scenarios-misc-commands.el
@@ -123,4 +123,94 @@
(should (string= (erc-server-user-host (erc-get-server-user "tester"))
"some.host.test.cc"))))))
+;; This tests four related slash commands, /AMSG, /GMSG, /AME, /GME,
+;; the latter three introduced by bug#68401. It mainly asserts
+;; correct routing behavior, especially not sending or inserting
+;; messages in buffers belonging to disconnected sessions. Left
+;; unaddressed are interactions with the `command-indicator' module
+;; (`erc-noncommands-list') and whatever future `echo-message'
+;; implementation manifests out of bug#49860.
+(ert-deftest erc-scenarios-misc-commands--AMSG-GMSG-AME-GME ()
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "commands")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server-foonet (erc-d-run "localhost" t "srv-foonet" 'amsg-foonet))
+ (dumb-server-barnet (erc-d-run "localhost" t "srv-barnet" 'amsg-barnet))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet and join #foo")
+ (with-current-buffer
+ (erc :server "127.0.0.1"
+ :port (process-contact dumb-server-foonet :service)
+ :nick "tester")
+ (funcall expect 10 "debug mode")
+ (erc-cmd-JOIN "#foo")))
+
+ (ert-info ("Connect to barnet and join #bar")
+ (with-current-buffer
+ (erc :server "127.0.0.1"
+ :port (process-contact dumb-server-barnet :service)
+ :nick "tester")
+ (funcall expect 10 "debug mode")
+ (erc-cmd-JOIN "#bar")))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo"))
+ (funcall expect 10 "welcome"))
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar"))
+ (funcall expect 10 "welcome"))
+
+ (ert-info ("/AMSG only sent to issuing context's server")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/amsg 1 foonet only"))
+ (with-current-buffer "barnet"
+ (erc-scenarios-common-say "/amsg 2 barnet only"))
+ (with-current-buffer "#foo"
+ (funcall expect 10 "<tester> 1 foonet only")
+ (funcall expect 10 "<alice> bob: Our queen and all"))
+ (with-current-buffer "#bar"
+ (funcall expect 10 "<tester> 2 barnet only")
+ (funcall expect 10 "<joe> mike: And secretly to greet")))
+
+ (ert-info ("/AME only sent to issuing context's server")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/ame 3 foonet only"))
+ (with-current-buffer "barnet"
+ (erc-scenarios-common-say "/ame 4 barnet only"))
+ (with-current-buffer "#foo"
+ (funcall expect 10 "* tester 3 foonet only")
+ (funcall expect 10 "<alice> bob: You have discharged this"))
+ (with-current-buffer "#bar"
+ (funcall expect 10 "* tester 4 barnet only")
+ (funcall expect 10 "<joe> mike: That same Berowne")))
+
+ (ert-info ("/GMSG and /GME sent to all servers")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/gmsg 5 all nets")
+ (erc-scenarios-common-say "/gme 6 all nets"))
+ (with-current-buffer "#bar"
+ (funcall expect 10 "<tester> 5 all nets")
+ (funcall expect 10 "* tester 6 all nets")
+ (funcall expect 10 "<joe> mike: Mehercle! if their sons")))
+
+ (ert-info ("/GMSG and /GME only sent to connected servers")
+ (with-current-buffer "barnet"
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "ERC finished"))
+ (with-current-buffer "#foo"
+ (funcall expect 10 "<tester> 5 all nets")
+ (funcall expect 10 "* tester 6 all nets")
+ (funcall expect 10 "<alice> bob: Stand you!"))
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/gmsg 7 all live nets")
+ (erc-scenarios-common-say "/gme 8 all live nets"))
+ ;; Message *not* inserted in disconnected buffer.
+ (with-current-buffer "#bar"
+ (funcall expect -0.1 "<tester> 7 all live nets")
+ (funcall expect -0.1 "* tester 8 all live nets")))
+
+ (with-current-buffer "#foo"
+ (funcall expect 10 "<tester> 7 all live nets")
+ (funcall expect 10 "* tester 8 all live nets")
+ (funcall expect 10 "<bob> alice: Live, and be prosperous;"))))
+
;;; erc-scenarios-misc-commands.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 70ca224ac74..a49173ffa2f 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -20,14 +20,14 @@
;;; Commentary:
;;; Code:
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-stamp)
-(require 'erc-goodies) ; for `erc-make-read-only'
-
;; These display-oriented tests are brittle because many factors
;; influence how text properties are applied. We should just
;; rework these into full scenarios.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 1649617f4b8..53b11104384 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -20,13 +20,13 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+(require 'erc-ring)
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-ring)
(ert-deftest erc--read-time-period ()
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
@@ -1066,7 +1066,8 @@
(ert-deftest erc--get-isupport-entry ()
(let ((erc--isupport-params (make-hash-table))
- (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")))
+ (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")
+ ("SPAM" . "")))
(items (lambda ()
(cl-loop for k being the hash-keys of erc--isupport-params
using (hash-values v) collect (cons k v)))))
@@ -1087,7 +1088,9 @@
(should (equal (erc--get-isupport-entry 'FOO) '(FOO "1")))
(should (equal (funcall items)
- '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))))
+ '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))
+ (should (equal (erc--get-isupport-entry 'SPAM) '(SPAM)))
+ (should-not (erc--get-isupport-entry 'SPAM 'single))))
(ert-deftest erc-server-005 ()
(let* ((hooked 0)
@@ -1105,34 +1108,41 @@
(lambda (_ _ _ line) (push line calls))))
(ert-info ("Baseline")
- (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...")
+ (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+"
+ "are supp...")
parsed (make-erc-response :command-args args :command "005"))
(setq verify
(lambda ()
(should (equal erc-server-parameters
'(("PREFIX" . "(ov)@+") ("EXCEPTS")
+ ;; Should be ("CHANTYPES") but
+ ;; retained for compatibility.
+ ("CHANTYPES" . "")
("BOT" . "B"))))
(should (zerop (hash-table-count erc--isupport-params)))
(should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t)))
(should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS)))
(should (equal "B" (erc--get-isupport-entry 'BOT t)))
- (should (string= (pop calls)
- "BOT=B EXCEPTS PREFIX=(ov)@+ are supp..."))
+ (should (string=
+ (pop calls)
+ "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp..."))
(should (equal args (erc-response.command-args parsed)))))
(erc-call-hooks nil parsed))
(ert-info ("Negated, updated")
- (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...")
+ (setq args '("tester" "-EXCEPTS" "-CHANTYPES" "-FAKE" "PREFIX=(ohv)@%+"
+ "are su...")
parsed (make-erc-response :command-args args :command "005"))
(setq verify
(lambda ()
(should (equal erc-server-parameters
'(("PREFIX" . "(ohv)@%+") ("BOT" . "B"))))
- (should (string= (pop calls)
- "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su..."))
+ (should (string-prefix-p
+ "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ "
+ (pop calls)))
(should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t)))
(should (equal "B" (erc--get-isupport-entry 'BOT t)))
(should-not (erc--get-isupport-entry 'EXCEPTS))
@@ -1169,25 +1179,37 @@
(should (equal (erc-downcase "\\O/") "|o/" )))))
(ert-deftest erc-channel-p ()
- (let ((erc--isupport-params (make-hash-table))
- erc-server-parameters)
-
- (should (erc-channel-p "#chan"))
- (should (erc-channel-p "##chan"))
- (should (erc-channel-p "&chan"))
- (should (erc-channel-p "+chan"))
- (should (erc-channel-p "!chan"))
- (should-not (erc-channel-p "@chan"))
-
- (push '("CHANTYPES" . "#&@+!") erc-server-parameters)
+ (erc-tests-common-make-server-buf)
- (should (erc-channel-p "!chan"))
- (should (erc-channel-p "#chan"))
+ (should (erc-channel-p "#chan"))
+ (should (erc-channel-p "##chan"))
+ (should (erc-channel-p "&chan"))
+ (should-not (erc-channel-p "+chan"))
+ (should-not (erc-channel-p "!chan"))
+ (should-not (erc-channel-p "@chan"))
+
+ ;; Server sends "CHANTYPES=#&+!"
+ (should-not erc-server-parameters)
+ (setq erc-server-parameters '(("CHANTYPES" . "#&+!")))
+ (should (erc-channel-p "#chan"))
+ (should (erc-channel-p "&chan"))
+ (should (erc-channel-p "+chan"))
+ (should (erc-channel-p "!chan"))
+
+ (with-current-buffer (erc--open-target "#chan")
+ (should (erc-channel-p (current-buffer))))
+ (with-current-buffer (erc--open-target "+chan")
+ (should (erc-channel-p (current-buffer))))
+ (should (erc-channel-p (get-buffer "#chan")))
+ (should (erc-channel-p (get-buffer "+chan")))
+
+ ;; Server sends "CHANTYPES=" because it's query only.
+ (puthash 'CHANTYPES '("CHANTYPES") erc--isupport-params)
+ (should-not (erc-channel-p "#spam"))
+ (should-not (erc-channel-p "&spam"))
+ (should-not (erc-channel-p (save-excursion (erc--open-target "#spam"))))
- (with-current-buffer (get-buffer-create "#chan")
- (setq erc--target (erc--target-from-string "#chan")))
- (should (erc-channel-p (get-buffer "#chan"))))
- (kill-buffer "#chan"))
+ (erc-tests-common-kill-buffers))
(ert-deftest erc--valid-local-channel-p ()
(ert-info ("Local channels not supported")
@@ -1290,7 +1312,7 @@
(setq erc-server-current-nick "tester")
(setq-local erc-last-input-time 0)
(should-not (local-variable-if-set-p 'erc-send-completed-hook))
- (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals)
+ (setq-local erc-send-completed-hook nil) ; skip t (globals)
;; Just in case erc-ring-mode is already on
(setq-local erc--input-review-functions erc--input-review-functions)
(add-hook 'erc--input-review-functions #'erc-add-to-input-ring)
diff --git a/test/lisp/erc/resources/commands/amsg-barnet.eld
b/test/lisp/erc/resources/commands/amsg-barnet.eld
new file mode 100644
index 00000000000..53b3e18651a
--- /dev/null
+++ b/test/lisp/erc/resources/commands/amsg-barnet.eld
@@ -0,0 +1,54 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :unknown")
+ (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
+ (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version
oragono-2.6.0-7481bf0385b95b16")
+ (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021
05:06:19 UTC")
+ (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16
BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii
CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=#
ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this
server")
+ (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100
NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
+ (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this
server")
+ (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1
server(s)")
+ (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.barnet.org 253 tester 0 :unregistered connections")
+ (0 ":irc.barnet.org 254 tester 1 :channels formed")
+ (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
+
+((mode-user 10 "MODE tester +i")
+ (0 ":irc.barnet.org 221 tester +i")
+ (0 ":irc.barnet.org NOTICE tester :This server is in debug mode and is
logging all user I/O. If you do not wish for everything you send to be readable
by the server owner(s), please disconnect."))
+
+((join 10 "JOIN #bar")
+ (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #bar")
+ (0 ":irc.barnet.org 353 tester = #bar :@mike joe tester")
+ (0 ":irc.barnet.org 366 tester #bar :End of NAMES list"))
+
+((mode-bar 10 "MODE #bar")
+ (0 ":irc.barnet.org 324 tester #bar +nt")
+ (0 ":irc.barnet.org 329 tester #bar 1620104779")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Whipp'd first, sir, and
hang'd after.")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: We have yet many among us
can gripe as hard as Cassibelan; I do not say I am one, but I have a hand. Why
tribute ? why should we pay tribute ? If C sar can hide the sun from us with a
blanket, or put the moon in his pocket, we will pay him tribute for light;
else, sir, no more tribute, pray you now."))
+
+((privmsg-2 10 "PRIVMSG #bar :2 barnet only")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Double and treble
admonition, and still forfeit in the same kind ? This would make mercy swear,
and play the tyrant.")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: And secretly to greet the
empress' friends."))
+
+((privmsg-4 10 "PRIVMSG #bar :\1ACTION 4 barnet only\1")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: You have not been
inquired after: I have sat here all day.")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: That same Berowne I'll
torture ere I go."))
+
+((privmsg-5 10 "PRIVMSG #bar :5 all nets"))
+
+((privmsg-6 10 "PRIVMSG #bar :\1ACTION 6 all nets\1")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: For mine own part,no
offence to the general, nor any man of quality,I hope to be saved.")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: Mehercle! if their sons
be ingenuous, they shall want no instruction; if their daughters be capable, I
will put it to them. But, vir sapit qui pauca loquitur. A soul feminine
saluteth us."))
+
+((quit 5 "QUIT :\2ERC\2")
+ (0 ":tester!~u@jnu48g2wrycbw.irc QUIT :Quit"))
+
+((drop 0 DROP))
diff --git a/test/lisp/erc/resources/commands/amsg-foonet.eld
b/test/lisp/erc/resources/commands/amsg-foonet.eld
new file mode 100644
index 00000000000..eb3d84d646a
--- /dev/null
+++ b/test/lisp/erc/resources/commands/amsg-foonet.eld
@@ -0,0 +1,56 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :unknown")
+ (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version
oragono-2.6.0-7481bf0385b95b16")
+ (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021
05:06:18 UTC")
+ (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16
BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii
CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=#
ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this
server")
+ (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100
NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
+ (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this
server")
+ (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1
server(s)")
+ (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0 ":irc.foonet.org 254 tester 1 :channels formed")
+ (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
+
+((mode-user 10 "MODE tester +i")
+ (0 ":irc.foonet.org 221 tester +i")
+ (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is
logging all user I/O. If you do not wish for everything you send to be readable
by the server owner(s), please disconnect."))
+
+((join 10 "JOIN #foo")
+ (0 ":tester!~u@9g6b728983yd2.irc JOIN #foo")
+ (0 ":irc.foonet.org 353 tester = #foo :alice tester @bob")
+ (0 ":irc.foonet.org 366 tester #foo :End of NAMES list"))
+
+((mode-foo 10 "MODE #foo")
+ (0 ":irc.foonet.org 324 tester #foo +nt")
+ (0 ":irc.foonet.org 329 tester #foo 1620104779")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: But, as it seems, did
violence on herself.")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Well, this is the forest
of Arden."))
+
+((privmsg-1 10 "PRIVMSG #foo :1 foonet only")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Signior Iachimo will not
from it. Pray, let us follow 'em.")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Our queen and all her
elves come here anon."))
+
+((privmsg-3 10 "PRIVMSG #foo :\1ACTION 3 foonet only\1")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: The ground is bloody;
search about the churchyard.")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: You have discharged this
honestly: keep it to yourself. Many likelihoods informed me of this before,
which hung so tottering in the balance that I could neither believe nor
misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for
your honest care. I will speak with you further anon."))
+
+((privmsg-5 10 "PRIVMSG #foo :5 all nets"))
+
+((privmsg-6 10 "PRIVMSG #foo :\1ACTION 6 all nets\1")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Give me that mattock,
and the wrenching iron.")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Stand you! You have land
enough of your own; but he added to your having, gave you some ground."))
+
+((privmsg-6 10 "PRIVMSG #foo :7 all live nets")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Excellent workman! Thou
canst not paint a man so bad as is thyself."))
+
+((privmsg-6 10 "PRIVMSG #foo :\1ACTION 8 all live nets\1")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: And will you, being a
man of your breeding, be married under a bush, like a beggar ? Get you to
church, and have a good priest that can tell you what marriage is: this fellow
will but join you together as they join wainscot; then one of you will prove a
shrunk panel, and like green timber, warp, warp.")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Live, and be prosperous;
and farewell, good fellow."))
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el
b/test/lisp/erc/resources/erc-scenarios-common.el
index 042b3a8c05b..9ad5ce49429 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -94,7 +94,8 @@
(require 'erc)
(eval-when-compile (require 'erc-join)
- (require 'erc-services))
+ (require 'erc-services)
+ (require 'erc-fill))
(declare-function erc-network "erc-networks")
(defvar erc-network)
@@ -148,6 +149,7 @@
(timer-list (copy-sequence timer-list))
(timer-idle-list (copy-sequence timer-idle-list))
(erc-auth-source-parameters-join-function nil)
+ (erc--fill-wrap-scrolltobottom-exempt-p t)
(erc-autojoin-channels-alist nil)
(erc-server-auto-reconnect nil)
(erc-after-connect nil)
diff --git a/test/lisp/eshell/em-glob-tests.el
b/test/lisp/eshell/em-glob-tests.el
index 6d922666ea3..fc460a59eed 100644
--- a/test/lisp/eshell/em-glob-tests.el
+++ b/test/lisp/eshell/em-glob-tests.el
@@ -61,6 +61,9 @@ component ending in \"symlink\" is treated as a symbolic
link."
;;; Tests:
+
+;; Glob expansion
+
(ert-deftest em-glob-test/expand/splice-results ()
"Test that globs are spliced into the argument list when
`eshell-glob-splice-results' is non-nil."
@@ -115,6 +118,33 @@ value of `eshell-glob-splice-results'."
(eshell-command-result-equal "list ${listify *.no}"
'(("*.no"))))))))
+
+;; Glob conversion
+
+(ert-deftest em-glob-test/convert/current-start-directory ()
+ "Test converting a glob starting in the current directory."
+ (should (equal (eshell-glob-convert "*.el")
+ '("./" (("\\`.*\\.el\\'" . "\\`\\.")) nil))))
+
+(ert-deftest em-glob-test/convert/relative-start-directory ()
+ "Test converting a glob starting in a relative directory."
+ (should (equal (eshell-glob-convert "some/where/*.el")
+ '("./some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil))))
+
+(ert-deftest em-glob-test/convert/absolute-start-directory ()
+ "Test converting a glob starting in an absolute directory."
+ (should (equal (eshell-glob-convert "/some/where/*.el")
+ '("/some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil))))
+
+(ert-deftest em-glob-test/convert/remote-start-directory ()
+ "Test converting a glob starting in a remote directory."
+ (should (equal (eshell-glob-convert "/ssh:nowhere.invalid:some/where/*.el")
+ '("/ssh:nowhere.invalid:/some/where/"
+ (("\\`.*\\.el\\'" . "\\`\\.")) nil))))
+
+
+;; Glob matching
+
(ert-deftest em-glob-test/match-any-string ()
"Test that \"*\" pattern matches any string."
(with-fake-files '("a.el" "b.el" "c.txt" "dir/a.el")
diff --git a/test/lisp/eshell/esh-opt-tests.el
b/test/lisp/eshell/esh-opt-tests.el
index 8d6e0c1e426..4e5373e53cd 100644
--- a/test/lisp/eshell/esh-opt-tests.el
+++ b/test/lisp/eshell/esh-opt-tests.el
@@ -29,13 +29,15 @@
(eshell--process-args
"sudo" '("-a")
'((?a "all" nil show-all
- "do not ignore entries starting with .")))))
+ "do not ignore entries starting with ."))
+ '(show-all))))
(should
(equal '("root" "world")
(eshell--process-args
"sudo" '("-u" "root" "world")
'((?u "user" t user
- "execute a command as another USER"))))))
+ "execute a command as another USER"))
+ '(user)))))
(ert-deftest esh-opt-test/process-args-parse-leading-options-only ()
"Test behavior of :parse-leading-options-only in `eshell--process-args'."
@@ -45,20 +47,23 @@
"sudo" '("emerge" "-uDN" "world")
'((?u "user" t user
"execute a command as another USER")
- :parse-leading-options-only))))
+ :parse-leading-options-only)
+ '(user))))
(should
(equal '("root" "emerge" "-uDN" "world")
(eshell--process-args
"sudo" '("-u" "root" "emerge" "-uDN" "world")
'((?u "user" t user
"execute a command as another USER")
- :parse-leading-options-only))))
+ :parse-leading-options-only)
+ '(user))))
(should
(equal '("DN" "emerge" "world")
(eshell--process-args
"sudo" '("-u" "root" "emerge" "-uDN" "world")
'((?u "user" t user
- "execute a command as another USER"))))))
+ "execute a command as another USER"))
+ '(user)))))
(ert-deftest esh-opt-test/process-args-external ()
"Test behavior of :external in `eshell--process-args'."
@@ -69,7 +74,8 @@
"ls" '("/some/path")
'((?a "all" nil show-all
"do not ignore entries starting with .")
- :external "ls")))))
+ :external "ls")
+ '(show-all)))))
(cl-letf (((symbol-function 'eshell-search-path) #'identity))
(should
(equal '(no-catch eshell-ext-command "ls")
@@ -78,7 +84,8 @@
"ls" '("-u" "/some/path")
'((?a "all" nil show-all
"do not ignore entries starting with .")
- :external "ls"))
+ :external "ls")
+ '(show-all))
:type 'no-catch))))
(cl-letf (((symbol-function 'eshell-search-path) #'ignore))
(should-error
@@ -86,7 +93,8 @@
"ls" '("-u" "/some/path")
'((?a "all" nil show-all
"do not ignore entries starting with .")
- :external "ls"))
+ :external "ls")
+ '(show-all))
:type 'error)))
(ert-deftest esh-opt-test/eval-using-options-short ()
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index e01e033e25e..e58b5a14ed9 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -153,7 +153,7 @@ insert the queued one at the next prompt, and finally run
it."
"Test flushing of previous output"
(with-temp-eshell
(eshell-insert-command "echo alpha")
- (eshell-kill-output)
+ (eshell-delete-output)
(should (eshell-match-output
(concat "^" (regexp-quote "*** output flushed ***\n") "$")))))
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 11af1f75574..28f4d5fa181 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -74,8 +74,8 @@
(defvar file-notify--test-events nil)
(defvar file-notify--test-monitors nil)
-(defun file-notify--test-read-event ()
- "Read one event.
+(defun file-notify--test-wait-event ()
+ "Wait for one event.
There are different timeouts for local and remote file notification libraries."
(read-event
nil nil
@@ -87,7 +87,8 @@ There are different timeouts for local and remote file
notification libraries."
;; for any monitor.
((file-notify--test-monitor) 7)
((file-remote-p temporary-file-directory) 0.1)
- (t 0.01))))
+ (t 0.01)))
+ nil)
(defun file-notify--test-timeout ()
"Timeout to wait for arriving a bunch of events, in seconds."
@@ -103,7 +104,7 @@ There are different timeouts for local and remote file
notification libraries."
TIMEOUT is the maximum time to wait for, in seconds."
`(with-timeout (,timeout (ignore))
(while (null ,until)
- (file-notify--test-read-event))))
+ (file-notify--test-wait-event))))
(defun file-notify--test-no-descriptors ()
"Check that `file-notify-descriptors' is an empty hash table.
@@ -452,7 +453,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Check, that removing watch descriptors out of order do not
;; harm. This fails on cygwin because of timing issues unless a
;; long `sit-for' is added before the call to
- ;; `file-notify--test-read-event'.
+ ;; `file-notify--test-wait-event'.
(unless (eq system-type 'cygwin)
(let (results)
(cl-flet ((first-callback (event)
@@ -480,7 +481,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Remove first watch.
(file-notify-rm-watch file-notify--test-desc)
;; Only the second callback shall run.
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile)
(file-notify--test-wait-for-events
(file-notify--test-timeout) results)
@@ -622,7 +623,7 @@ delivered."
(cons 'file-notify while-no-input-ignore-events))
create-lockfiles)
;; Flush pending actions.
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(file-notify--test-wait-for-events
(file-notify--test-timeout)
(not (input-pending-p)))
@@ -671,7 +672,7 @@ delivered."
(t '(created changed deleted stopped)))
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile))
(file-notify-rm-watch file-notify--test-desc)
@@ -707,7 +708,7 @@ delivered."
(changed changed deleted stopped))))
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile))
(file-notify-rm-watch file-notify--test-desc)
@@ -755,7 +756,7 @@ delivered."
(t '(created changed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-directory file-notify--test-tmpdir 'recursive))
(file-notify-rm-watch file-notify--test-desc)
@@ -805,14 +806,14 @@ delivered."
deleted deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
;; The next two events shall not be visible.
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(set-file-modes file-notify--test-tmpfile 000 'nofollow)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(set-file-times file-notify--test-tmpfile '(0 0) 'nofollow)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-directory file-notify--test-tmpdir 'recursive))
(file-notify-rm-watch file-notify--test-desc)
@@ -860,10 +861,10 @@ delivered."
(t '(created changed renamed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(rename-file file-notify--test-tmpfile file-notify--test-tmpfile1)
;; After the rename, we won't get events anymore.
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-directory file-notify--test-tmpdir 'recursive))
(file-notify-rm-watch file-notify--test-desc)
@@ -912,11 +913,11 @@ delivered."
(t '(attribute-changed attribute-changed)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(set-file-modes file-notify--test-tmpfile 000 'nofollow)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(set-file-times file-notify--test-tmpfile '(0 0) 'nofollow)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile))
(file-notify-rm-watch file-notify--test-desc)
@@ -1087,7 +1088,7 @@ delivered."
(changed changed deleted stopped))))
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile))
;; After deleting the file, the descriptor is not valid anymore.
(should-not (file-notify-valid-p file-notify--test-desc))
@@ -1134,7 +1135,7 @@ delivered."
(t '(created changed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-directory file-notify--test-tmpdir 'recursive))
;; After deleting the parent directory, the descriptor must
;; not be valid anymore.
@@ -1247,9 +1248,9 @@ delivered."
(let ((source-file-list source-file-list)
(target-file-list target-file-list))
(while (and source-file-list target-file-list)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(write-region "" nil (pop source-file-list) nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(write-region "" nil (pop target-file-list) nil 'no-message))))
(file-notify--test-with-actions
(cond
@@ -1272,11 +1273,11 @@ delivered."
(let ((source-file-list source-file-list)
(target-file-list target-file-list))
(while (and source-file-list target-file-list)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(rename-file (pop source-file-list) (pop target-file-list) t))))
(file-notify--test-with-actions (make-list n 'deleted)
(dolist (file target-file-list)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file)))
(delete-directory file-notify--test-tmpfile)
(if (or (string-equal (file-notify--test-library) "w32notify")
@@ -1464,7 +1465,7 @@ the file watch."
;; does not report the `changed' event.
(make-list (/ n 2) 'created)))
(dotimes (i n)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(if (zerop (mod i 2))
(write-region
"any text" nil file-notify--test-tmpfile1 t 'no-message)
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 718ecd51f8b..d4c1ef3ba67 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1656,30 +1656,47 @@ The door of all subtleties!
(should (equal (file-name-base "foo") "foo"))
(should (equal (file-name-base "foo/bar") "bar")))
-(defun files-tests--check-shebang (shebang expected-mode)
- "Assert that mode for SHEBANG derives from EXPECTED-MODE."
- (let ((actual-mode
- (ert-with-temp-file script-file
- :text shebang
- (find-file script-file)
- (if (derived-mode-p expected-mode)
- expected-mode
- major-mode))))
- ;; Tuck all the information we need in the `should' form: input
- ;; shebang, expected mode vs actual.
- (should
- (equal (list shebang actual-mode)
- (list shebang expected-mode)))))
+(defvar sh-shell)
+
+(defun files-tests--check-shebang (shebang expected-mode &optional
expected-dialect)
+ "Assert that mode for SHEBANG derives from EXPECTED-MODE.
+
+If EXPECTED-MODE is sh-base-mode, DIALECT says what `sh-shell' should be
+set to."
+ (ert-with-temp-file script-file
+ :text shebang
+ (find-file script-file)
+ (let ((actual-mode (if (derived-mode-p expected-mode)
+ expected-mode
+ major-mode)))
+ ;; Tuck all the information we need in the `should' form: input
+ ;; shebang, expected mode vs actual.
+ (should
+ (equal (list shebang actual-mode)
+ (list shebang expected-mode)))
+ (when (eq expected-mode 'sh-base-mode)
+ (should (eq sh-shell expected-dialect))))))
(ert-deftest files-tests-auto-mode-interpreter ()
"Test that `set-auto-mode' deduces correct modes from shebangs."
- (files-tests--check-shebang "#!/bin/bash" 'sh-mode)
- (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-mode)
+ ;; Straightforward interpreter invocation.
+ (files-tests--check-shebang "#!/bin/bash" 'sh-base-mode 'bash)
+ (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode)
+ ;; Invocation through env.
+ (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-base-mode 'bash)
(files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode)
(files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode)
+ ;; Invocation through env, with supplementary arguments.
+ (files-tests--check-shebang "#!/usr/bin/env --split-string=bash -eux"
'sh-base-mode 'bash)
+ (files-tests--check-shebang "#!/usr/bin/env --split-string=-iv
--default-signal bash -eux" 'sh-base-mode 'bash)
(files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v
OFS=\"\\t\" -f" 'awk-mode)
(files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode)
- (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode))
+ (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode
'bash)
+ (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash
-eux" 'sh-base-mode 'bash)
+ (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux"
'sh-base-mode 'bash)
+ (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux"
'sh-base-mode 'bash)
+ ;; Invocation through env, with modified environment.
+ (files-tests--check-shebang "#!/usr/bin/env -S PYTHONPATH=/...:${PYTHONPATH}
python" 'python-base-mode))
(ert-deftest files-test-dir-locals-auto-mode-alist ()
"Test an `auto-mode-alist' entry in `.dir-locals.el'"
diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el
index 0dfdbf417e8..8020a7419cf 100644
--- a/test/lisp/info-tests.el
+++ b/test/lisp/info-tests.el
@@ -28,18 +28,20 @@
(require 'ert-x)
(ert-deftest test-info-urls ()
+ (should (equal (Info-url-for-node "(tramp)Top")
+ "https://www.gnu.org/software/emacs/manual/html_node/tramp/";))
(should (equal (Info-url-for-node "(emacs)Minibuffer")
-
"https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer";))
+
"https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html";))
(should (equal (Info-url-for-node "(emacs)Minibuffer File")
-
"https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File";))
+
"https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html";))
(should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving")
-
"https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving";))
+
"https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html";))
(should (equal (Info-url-for-node "(eintr)car & cdr")
-
"https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr";))
+
"https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr.html";))
(should (equal (Info-url-for-node "(emacs-mime)\tIndex")
-
"https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index";))
- (should (equal (Info-url-for-node "(gnus) Don't Panic")
-
"https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic";))
+
"https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index.html";))
+ (should (equal (Info-url-for-node "(gnus) Don't Panic")
+
"https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic.html";))
(should-error (Info-url-for-node "(nonexistent)Example")))
;;; info-tests.el ends here
diff --git a/test/lisp/international/mule-tests.el
b/test/lisp/international/mule-tests.el
index 5c742451a57..9a80ced55ae 100644
--- a/test/lisp/international/mule-tests.el
+++ b/test/lisp/international/mule-tests.el
@@ -96,10 +96,10 @@
;;; Testing `sgml-html-meta-auto-coding-function'.
-(defconst sgml-html-meta-pre "<!doctype html><html><head>"
+(defvar sgml-html-meta-pre "<!doctype html><html><head>"
"The beginning of a minimal HTML document.")
-(defconst sgml-html-meta-post "</head></html>"
+(defvar sgml-html-meta-post "</head></html>"
"The end of a minimal HTML document.")
(defun sgml-html-meta-run (coding-system)
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 07c4dbc3197..c4a7de9e51f 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -201,6 +201,13 @@
'completions-first-difference)
return pos))
+(ert-deftest completion-test--pcm-bug38458 ()
+ (should (equal (let ((completion-ignore-case t))
+ (completion-pcm--merge-try '("tes" point "ing")
+ '("Testing" "testing")
+ "" ""))
+ '("testing" . 4))))
+
(ert-deftest completion-pcm-test-1 ()
;; Point is at end, this does not match anything
(should (null
diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el
new file mode 100644
index 00000000000..bd00893d503
--- /dev/null
+++ b/test/lisp/net/eww-tests.el
@@ -0,0 +1,180 @@
+;;; eww-tests.el --- tests for eww.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'eww)
+
+(defvar eww-test--response-function (lambda (url) (concat "\n" url))
+ "A function for returning a mock response for URL.
+The default just returns an empty list of headers and the URL as the
+body.")
+
+(defmacro eww-test--with-mock-retrieve (&rest body)
+ "Evaluate BODY with a mock implementation of `eww-retrieve'.
+This avoids network requests during our tests. Additionally, prepare a
+temporary EWW buffer for our tests."
+ (declare (indent 1))
+ `(cl-letf (((symbol-function 'eww-retrieve)
+ (lambda (url callback args)
+ (with-temp-buffer
+ (insert (funcall eww-test--response-function url))
+ (apply callback nil args)))))
+ (with-temp-buffer
+ (eww-mode)
+ ,@body)))
+
+(defun eww-test--history-urls ()
+ (mapcar (lambda (elem) (plist-get elem :url)) eww-history))
+
+;;; Tests:
+
+(ert-deftest eww-test/history/new-page ()
+ "Test that when visiting a new page, the previous one goes into the history."
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (should (equal (eww-test--history-urls)
+ '("http://one.invalid/";)))
+ (eww "three.invalid")
+ (should (equal (eww-test--history-urls)
+ '("http://two.invalid/";
+ "http://one.invalid/";)))))
+
+(ert-deftest eww-test/history/back-forward ()
+ "Test that navigating through history just changes our history position.
+See bug#69232."
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (let ((url-history '("http://three.invalid/";
+ "http://two.invalid/";
+ "http://one.invalid/";)))
+ ;; Go back one page. This should add "three.invalid" to the
+ ;; history, making our position in the list 2.
+ (eww-back-url)
+ (should (equal (eww-test--history-urls) url-history))
+ (should (= eww-history-position 2))
+ ;; Go back again.
+ (eww-back-url)
+ (should (equal (eww-test--history-urls) url-history))
+ (should (= eww-history-position 3))
+ ;; At the beginning of the history, so trying to go back should
+ ;; signal an error.
+ (should-error (eww-back-url))
+ ;; Go forward once.
+ (eww-forward-url)
+ (should (equal (eww-test--history-urls) url-history))
+ (should (= eww-history-position 2))
+ ;; Go forward again.
+ (eww-forward-url)
+ (should (equal (eww-test--history-urls) url-history))
+ (should (= eww-history-position 1))
+ ;; At the end of the history, so trying to go forward should
+ ;; signal an error.
+ (should-error (eww-forward-url)))))
+
+(ert-deftest eww-test/history/reload-in-place ()
+ "Test that reloading historical pages updates their history entry in-place.
+See bug#69232."
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (eww-back-url)
+ ;; Make sure our history has the original page text.
+ (should (equal (plist-get (nth 1 eww-history) :text)
+ "http://two.invalid/";))
+ (should (= eww-history-position 2))
+ ;; Reload the page.
+ (let ((eww-test--response-function
+ (lambda (url) (concat "\nreloaded " url))))
+ (eww-reload)
+ (should (= eww-history-position 2)))
+ ;; Go to another page, and make sure the history is correct,
+ ;; including the reloaded page text.
+ (eww "four.invalid")
+ (should (equal (eww-test--history-urls) '("http://two.invalid/";
+ "http://one.invalid/";)))
+ (should (equal (plist-get (nth 0 eww-history) :text)
+ "reloaded http://two.invalid/";))
+ (should (= eww-history-position 0))))
+
+(ert-deftest eww-test/history/before-navigate/delete-future-history ()
+ "Test that going to a new page from a historical one deletes future history.
+See bug#69232."
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (eww-back-url)
+ (eww "four.invalid")
+ (eww "five.invalid")
+ (should (equal (eww-test--history-urls) '("http://four.invalid/";
+ "http://two.invalid/";
+ "http://one.invalid/";)))
+ (should (= eww-history-position 0))))
+
+(ert-deftest eww-test/history/before-navigate/ignore-history ()
+ "Test that going to a new page from a historical one preserves history.
+This sets `eww-before-browse-history-function' to `ignore' to preserve
+history. See bug#69232."
+ (let ((eww-before-browse-history-function #'ignore))
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (eww-back-url)
+ (eww "four.invalid")
+ (eww "five.invalid")
+ (should (equal (eww-test--history-urls) '("http://four.invalid/";
+ "http://three.invalid/";
+ "http://two.invalid/";
+ "http://one.invalid/";)))
+ (should (= eww-history-position 0)))))
+
+(ert-deftest eww-test/history/before-navigate/clone-previous ()
+ "Test that going to a new page from a historical one clones prior history.
+This sets `eww-before-browse-history-function' to
+`eww-clone-previous-history' to clone the history. See bug#69232."
+ (let ((eww-before-browse-history-function #'eww-clone-previous-history))
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (eww-back-url)
+ (eww "four.invalid")
+ (eww "five.invalid")
+ (should (equal (eww-test--history-urls)
+ '(;; New page and cloned history.
+ "http://four.invalid/";
+ "http://two.invalid/";
+ "http://one.invalid/";
+ ;; Original history.
+ "http://three.invalid/";
+ "http://two.invalid/";
+ "http://one.invalid/";)))
+ (should (= eww-history-position 0)))))
+
+(provide 'eww-tests)
+;; eww-tests.el ends here
diff --git a/test/lisp/net/tramp-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index 978342b1bb1..1ca2fa9b9b3 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -77,7 +77,7 @@ A resource file is in the resource directory as per
`ert-resource-directory'."
`(expand-file-name ,file (ert-resource-directory)))))
-(defconst tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz")
+(defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz")
"The test file archive.")
(defun tramp-archive-test-file-archive-hexlified ()
@@ -86,7 +86,7 @@ Do not hexlify \"/\". This hexlified string is used in
`file:///' URLs."
(let* ((url-unreserved-chars (cons ?/ url-unreserved-chars)))
(url-hexify-string tramp-archive-test-file-archive)))
-(defconst tramp-archive-test-archive
+(defvar tramp-archive-test-archive
(file-name-as-directory tramp-archive-test-file-archive)
"The test archive.")
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 489b682d0c3..cdd2a1efdb2 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -265,8 +265,8 @@ is greater than 10.
`(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
(debug-ignored-errors
(append
- '("^make-symbolic-link not supported$"
- "^error with add-name-to-file")
+ '("\\`make-symbolic-link not supported\\'"
+ "\\`error with add-name-to-file")
debug-ignored-errors))
inhibit-message)
(unwind-protect
@@ -379,7 +379,7 @@ is greater than 10.
(let (tramp-mode)
(should-not (tramp-tramp-file-p "/method:user@host:")))
;; `tramp-ignored-file-name-regexp' suppresses Tramp.
- (let ((tramp-ignored-file-name-regexp "^/method:user@host:"))
+ (let ((tramp-ignored-file-name-regexp "\\`/method:user@host:"))
(should-not (tramp-tramp-file-p "/method:user@host:")))
;; Methods shall be at least two characters, except the
;; default method.
@@ -3493,6 +3493,8 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(skip-unless (not (tramp--test-rsync-p)))
;; Wildcards are not supported in tramp-crypt.el.
(skip-unless (not (tramp--test-crypt-p)))
+ ;; Wildcards are not supported with "docker cp ..." or "podman cp ...".
+ (skip-unless (not (tramp--test-container-oob-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
@@ -3815,15 +3817,24 @@ This tests also `access-file', `file-readable-p',
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))))))
+(defun tramp--test-set-ert-test-documentation (test command)
+ "Set the documentation string for a derived test.
+The test is derived from TEST and COMMAND."
+ (let ((test-doc
+ (split-string (ert-test-documentation (get test 'ert--test)) "\n")))
+ ;; The first line must be extended.
+ (setcar
+ test-doc (format "%s Use the \"%s\" command." (car test-doc) command))
+ (setf (ert-test-documentation
+ (get (intern (format "%s-with-%s" test command)) 'ert--test))
+ (string-join test-doc "\n"))))
+
(defmacro tramp--test-deftest-with-stat (test)
"Define ert `TEST-with-stat'."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) ()
- ;; This is the docstring. However, it must be expanded to a
- ;; string inside the macro. No idea.
- ;; (concat (ert-test-documentation (get ',test 'ert--test))
- ;; "\nUse the \"stat\" command.")
:tags '(:expensive-test)
+ (tramp--test-set-ert-test-documentation ',test "stat")
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-stat tramp-test-vec))
@@ -3842,11 +3853,8 @@ This tests also `access-file', `file-readable-p',
"Define ert `TEST-with-perl'."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) ()
- ;; This is the docstring. However, it must be expanded to a
- ;; string inside the macro. No idea.
- ;; (concat (ert-test-documentation (get ',test 'ert--test))
- ;; "\nUse the \"perl\" command.")
:tags '(:expensive-test)
+ (tramp--test-set-ert-test-documentation ',test "perl")
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-perl tramp-test-vec))
@@ -3870,11 +3878,8 @@ This tests also `access-file', `file-readable-p',
"Define ert `TEST-with-ls'."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) ()
- ;; This is the docstring. However, it must be expanded to a
- ;; string inside the macro. No idea.
- ;; (concat (ert-test-documentation (get ',test 'ert--test))
- ;; "\nUse the \"ls\" command.")
:tags '(:expensive-test)
+ (tramp--test-set-ert-test-documentation ',test "ls")
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(if-let ((default-directory ert-remote-temporary-file-directory)
@@ -6376,33 +6381,35 @@ INPUT, if non-nil, is a string sent to the process."
(setq tramp-remote-path orig-tramp-remote-path)
;; We make a super long `tramp-remote-path'.
- (make-directory tmp-name)
- (should (file-directory-p tmp-name))
- (while (tramp-compat-length< (string-join orig-exec-path ":") 5000)
- (let ((dir (make-temp-file (file-name-as-directory tmp-name)
'dir)))
- (should (file-directory-p dir))
- (setq tramp-remote-path
- (append
- tramp-remote-path `(,(file-remote-p dir 'localname)))
- orig-exec-path
- (append
- (butlast orig-exec-path)
- `(,(file-remote-p dir 'localname))
- (last orig-exec-path)))))
- (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (should (equal (exec-path) orig-exec-path))
- ;; Ignore trailing newline.
- (setq path (substring (shell-command-to-string "echo $PATH") nil -1))
- ;; The shell doesn't handle such long strings.
- (unless (tramp-compat-length>
- path
- (tramp-get-connection-property
- tramp-test-vec "pipe-buf" 4096))
- ;; The last element of `exec-path' is `exec-directory'.
- (should
- (string-equal path (string-join (butlast orig-exec-path) ":"))))
- ;; The shell "sh" shall always exist.
- (should (executable-find "sh" 'remote)))
+ (unless (tramp--test-container-oob-p)
+ (make-directory tmp-name)
+ (should (file-directory-p tmp-name))
+ (while (tramp-compat-length< (string-join orig-exec-path ":") 5000)
+ (let ((dir (make-temp-file
+ (file-name-as-directory tmp-name) 'dir)))
+ (should (file-directory-p dir))
+ (setq tramp-remote-path
+ (append
+ tramp-remote-path `(,(file-remote-p dir 'localname)))
+ orig-exec-path
+ (append
+ (butlast orig-exec-path)
+ `(,(file-remote-p dir 'localname))
+ (last orig-exec-path)))))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug
'keep-password)
+ (should (equal (exec-path) orig-exec-path))
+ ;; Ignore trailing newline.
+ (setq path (substring (shell-command-to-string "echo $PATH") nil
-1))
+ ;; The shell doesn't handle such long strings.
+ (unless (tramp-compat-length>
+ path
+ (tramp-get-connection-property
+ tramp-test-vec "pipe-buf" 4096))
+ ;; The last element of `exec-path' is `exec-directory'.
+ (should
+ (string-equal path (string-join (butlast orig-exec-path) ":"))))
+ ;; The shell "sh" shall always exist.
+ (should (executable-find "sh" 'remote))))
;; Cleanup.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
@@ -7053,17 +7060,24 @@ This is used in tests which we don't want to tag
(not (and (tramp--test-adb-p)
(string-match-p (rx multibyte) default-directory)))))
-(defun tramp--test-crypt-p ()
- "Check, whether the remote directory is encrypted."
- (tramp-crypt-file-name-p ert-remote-temporary-file-directory))
-
(defun tramp--test-container-p ()
"Check, whether a container method is used.
This does not support some special file names."
(string-match-p
- (rx bol (| "docker" "podman") eol)
+ (rx bol (| "docker" "podman"))
(file-remote-p ert-remote-temporary-file-directory 'method)))
+(defun tramp--test-container-oob-p ()
+ "Check, whether the dockercp or podmancp method is used.
+They does not support wildcard copy."
+ (string-match-p
+ (rx bol (| "dockercp" "podmancp") eol)
+ (file-remote-p ert-remote-temporary-file-directory 'method)))
+
+(defun tramp--test-crypt-p ()
+ "Check, whether the remote directory is encrypted."
+ (tramp-crypt-file-name-p ert-remote-temporary-file-directory))
+
(defun tramp--test-expensive-test-p ()
"Whether expensive tests are run.
This is used in tests which we don't want to tag `:expensive'
@@ -7480,7 +7494,8 @@ This requires restrictions of file name syntax."
(tramp--test-gvfs-p)
(tramp--test-windows-nt-or-smb-p))
"?foo?bar?baz?")
- (unless (or (tramp--test-ftp-p)
+ (unless (or (tramp--test-container-oob-p)
+ (tramp--test-ftp-p)
(tramp--test-gvfs-p)
(tramp--test-windows-nt-or-smb-p))
"*foo+bar*baz+")
@@ -7500,7 +7515,10 @@ This requires restrictions of file name syntax."
(unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
"<foo>bar<baz>")
"(foo)bar(baz)"
- (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
+ (unless (or (tramp--test-container-oob-p)
+ (tramp--test-ftp-p)
+ (tramp--test-gvfs-p))
+ "[foo]bar[baz]")
"{foo}bar{baz}")))
;; Simplify test in order to speed up.
(apply #'tramp--test-check-files
diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el
index d7e547fcf29..f9f97dba535 100644
--- a/test/lisp/obarray-tests.el
+++ b/test/lisp/obarray-tests.el
@@ -32,27 +32,18 @@
(should-not (obarrayp "aoeu"))
(should-not (obarrayp '()))
(should-not (obarrayp []))
- (should (obarrayp (make-vector 7 0))))
-
-(ert-deftest obarrayp-unchecked-content-test ()
- "Should fail to check content of passed obarray."
- :expected-result :failed
(should-not (obarrayp ["a" "b" "c"]))
- (should-not (obarrayp [1 2 3])))
-
-(ert-deftest obarray-make-default-test ()
- (let ((table (obarray-make)))
- (should (obarrayp table))
- (should (eq (obarray-size table) obarray-default-size))))
+ (should-not (obarrayp [1 2 3]))
+ (should-not (obarrayp (make-vector 7 0)))
+ (should-not (obarrayp (vector (obarray-make))))
+ (should (obarrayp (obarray-make)))
+ (should (obarrayp (obarray-make 7))))
(ert-deftest obarray-make-with-size-test ()
;; FIXME: Actually, `wrong-type-argument' is not the right error to signal,
;; so we shouldn't enforce this misbehavior in tests!
(should-error (obarray-make -1) :type 'wrong-type-argument)
- (should-error (obarray-make 0) :type 'wrong-type-argument)
- (let ((table (obarray-make 1)))
- (should (obarrayp table))
- (should (eq (obarray-size table) 1))))
+ (should-error (obarray-make 'a) :type 'wrong-type-argument))
(ert-deftest obarray-get-test ()
(let ((table (obarray-make 3)))
@@ -88,5 +79,15 @@
(obarray-map collect-names table)
(should (equal (sort syms #'string<) '("a" "b" "c")))))
+(ert-deftest obarray-clear ()
+ (let ((o (obarray-make)))
+ (intern "a" o)
+ (intern "b" o)
+ (intern "c" o)
+ (obarray-clear o)
+ (let ((n 0))
+ (mapatoms (lambda (_) (setq n (1+ n))) o)
+ (should (equal n 0)))))
+
(provide 'obarray-tests)
;;; obarray-tests.el ends here
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 62b7fdab7f7..9d9718f719c 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -1431,6 +1431,25 @@ cperl-mode fontifies text after the delimiter as Perl
code."
(should (equal (get-text-property (point) 'face)
font-lock-comment-face))))
+(ert-deftest cperl-test-bug-69604 ()
+ "Verify that $\" in a double-quoted string does not end the string.
+Both `perl-mode' and `cperl-mode' treat ?$ as a quoting/escaping char to
+avoid issues with punctuation variables. In a string, however, this is
+not appropriate."
+ (let ((strings
+ '("\"$\\\" in string ---\"; # \"" ; $ must not quote \
+ "$\" . \" in string ---\"; # \"" ; $ must quote \
+ "\"\\$\" . \" in string ---\"; # \""))) ; \$ must not quote
+ (dolist (string strings)
+ (with-temp-buffer
+ (insert string)
+ (funcall cperl-test-mode)
+ (font-lock-ensure)
+ (goto-char (point-min))
+ (search-forward "in string")
+ (should (equal (get-text-property (point) 'face)
+ font-lock-string-face))))))
+
(ert-deftest test-indentation ()
(ert-test-erts-file (ert-resource-file "cperl-indents.erts")))
diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts
b/test/lisp/progmodes/java-ts-mode-resources/indent.erts
index 4fca74dd2e1..514d2e08977 100644
--- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts
@@ -110,3 +110,34 @@ public class Java {
}
}
=-=-=
+
+Name: Opening bracket on separate line (bug#67556)
+
+=-=
+public class Java {
+ void foo(
+ String foo)
+ {
+ for (var f : rs)
+ return new String[]
+ {
+ "foo",
+ "bar"
+ };
+ if (a == 0)
+ {
+ return 0;
+ } else if (a == 1)
+ {
+ return 1;
+ }
+
+ switch(expr)
+ {
+ case x:
+ // code block
+ break;
+ }
+ }
+}
+=-=-=
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 59957ff0712..1ceee690cfb 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -55,21 +55,27 @@ BODY is code to be executed within the temp buffer. Point
is
always located at the beginning of buffer. Native completion is
turned off. Shell buffer will be killed on exit."
(declare (indent 1) (debug t))
- `(with-temp-buffer
- (let ((python-indent-guess-indent-offset nil)
- (python-shell-completion-native-enable nil))
- (python-mode)
- (unwind-protect
- (progn
- (run-python nil t)
- (insert ,contents)
- (goto-char (point-min))
- (python-tests-shell-wait-for-prompt)
- ,@body)
- (when (python-shell-get-buffer)
- (python-shell-with-shell-buffer
- (let (kill-buffer-hook kill-buffer-query-functions)
- (kill-buffer))))))))
+ (let ((dir (make-symbol "dir")))
+ `(with-temp-buffer
+ (let ((python-indent-guess-indent-offset nil)
+ (python-shell-completion-native-enable nil))
+ (python-mode)
+ (unwind-protect
+ ;; Prevent test failures when Jedi is used as a completion
+ ;; backend, either directly or indirectly (e.g., via
+ ;; IPython). Jedi needs to store cache, but the
+ ;; "/nonexistent" HOME directory is not writable.
+ (ert-with-temp-directory ,dir
+ (with-environment-variables (("XDG_CACHE_HOME" ,dir))
+ (run-python nil t)
+ (insert ,contents)
+ (goto-char (point-min))
+ (python-tests-shell-wait-for-prompt)
+ ,@body))
+ (when (python-shell-get-buffer)
+ (python-shell-with-shell-buffer
+ (let (kill-buffer-hook kill-buffer-query-functions)
+ (kill-buffer)))))))))
(defmacro python-tests-with-temp-file (contents &rest body)
"Create a `python-mode' enabled file with CONTENTS.
@@ -4799,6 +4805,111 @@ def foo():
(end-of-line 0)
(should-not (nth 2 (python-shell-completion-at-point))))))
+(defun python-tests--completion-module ()
+ "Check if modules can be completed in Python shell."
+ (insert "import datet")
+ (completion-at-point)
+ (beginning-of-line)
+ (should (looking-at-p "import datetime"))
+ (kill-line)
+ (insert "from datet")
+ (completion-at-point)
+ (beginning-of-line)
+ (should (looking-at-p "from datetime"))
+ (end-of-line)
+ (insert " import timed")
+ (completion-at-point)
+ (beginning-of-line)
+ (should (looking-at-p "from datetime import timedelta"))
+ (kill-line))
+
+(defun python-tests--completion-parameters ()
+ "Check if parameters can be completed in Python shell."
+ (insert "import re")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "re.split('b', 'abc', maxs")
+ (completion-at-point)
+ (should (string= "re.split('b', 'abc', maxsplit="
+ (buffer-substring (line-beginning-position) (point))))
+ (insert "0, ")
+ (should (python-shell-completion-at-point))
+ ;; Test if cache is used.
+ (cl-letf (((symbol-function 'python-shell-completion-get-completions)
+ 'ignore)
+ ((symbol-function 'python-shell-completion-native-get-completions)
+ 'ignore))
+ (insert "fla")
+ (completion-at-point)
+ (should (string= "re.split('b', 'abc', maxsplit=0, flags="
+ (buffer-substring (line-beginning-position) (point)))))
+ (beginning-of-line)
+ (kill-line))
+
+(defun python-tests--completion-extra-context ()
+ "Check if extra context is used for completion."
+ (insert "re.split('b', 'abc',")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "maxs")
+ (completion-at-point)
+ (should (string= "maxsplit="
+ (buffer-substring (line-beginning-position) (point))))
+ (insert "0)")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "from re import (")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "IGN")
+ (completion-at-point)
+ (should (string= "IGNORECASE"
+ (buffer-substring (line-beginning-position) (point)))))
+
+(defun python-tests--pythonstartup-file ()
+ "Return Jedi readline setup file if PYTHONSTARTUP is not set."
+ (or (getenv "PYTHONSTARTUP")
+ (with-temp-buffer
+ (if (eql 0 (call-process python-tests-shell-interpreter
+ nil t nil "-m" "jedi" "repl"))
+ (string-trim (buffer-string))
+ ""))))
+
+(ert-deftest python-shell-completion-at-point-jedi-completer ()
+ "Check if Python shell completion works when Jedi completer is used."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (with-environment-variables
+ (("PYTHONSTARTUP" (python-tests--pythonstartup-file)))
+ (python-tests-with-temp-buffer-with-shell
+ ""
+ (python-shell-with-shell-buffer
+ (python-shell-completion-native-turn-on)
+ (skip-unless (string= python-shell-readline-completer-delims ""))
+ (python-tests--completion-module)
+ (python-tests--completion-parameters)
+ (python-tests--completion-extra-context)))))
+
+(ert-deftest python-shell-completion-at-point-ipython ()
+ "Check if Python shell completion works for IPython."
+ (let ((python-shell-interpreter "ipython")
+ (python-shell-interpreter-args "-i --simple-prompt"))
+ (skip-unless
+ (and
+ (executable-find python-shell-interpreter)
+ (eql (call-process python-shell-interpreter nil nil nil "--version") 0)))
+ (with-environment-variables
+ (("PYTHONSTARTUP" (python-tests--pythonstartup-file)))
+ (python-tests-with-temp-buffer-with-shell
+ ""
+ (python-shell-with-shell-buffer
+ (python-shell-completion-native-turn-off)
+ (python-tests--completion-module)
+ (python-tests--completion-parameters)
+ (python-shell-completion-native-turn-on)
+ (skip-unless (string= python-shell-readline-completer-delims ""))
+ (python-tests--completion-module)
+ (python-tests--completion-parameters)
+ (python-tests--completion-extra-context))))))
;;; PDB Track integration
@@ -4945,11 +5056,6 @@ import abc
(ert-deftest python-ffap-module-path-1 ()
(skip-unless (executable-find python-tests-shell-interpreter))
- ;; Skip the test on macOS, since the standard Python installation uses
- ;; libedit rather than readline which confuses the running of an inferior
- ;; interpreter in this case (see bug#59477 and bug#25753).
- (skip-when (eq system-type 'darwin))
- (trace-function 'python-shell-output-filter)
(python-tests-with-temp-buffer-with-shell
"
import abc
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index ba51f375cc6..e50738f1122 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -92,6 +92,8 @@
("1@example.com" 1 email "1@example.com")
;; email addresses user portion containing dots
("foo.bar@example.com" 1 email "foo.bar@example.com")
+ ("foo.bar@example.com" 5 email "foo.bar@example.com")
+ (" fo.ba@example.com" 6 email "fo.ba@example.com")
(".foobar@example.com" 1 email nil)
(".foobar@example.com" 2 email "foobar@example.com")
;; email addresses domain portion containing dots and dashes
@@ -180,6 +182,13 @@ position to retrieve THING.")
(should (thing-at-point-looking-at "2abcd"))
(should (equal (match-data) m2)))))
+(ert-deftest thing-at-point-looking-at-overlapping-matches ()
+ (with-temp-buffer
+ (insert "foo.bar.baz")
+ (goto-char (point-max))
+ (should (thing-at-point-looking-at "[a-z]+\\.[a-z]+"))
+ (should (string= "bar.baz" (match-string 0)))))
+
(ert-deftest test-symbol-thing-1 ()
(with-temp-buffer
(insert "foo bar zot")
diff --git a/test/src/comp-resources/comp-test-funcs.el
b/test/src/comp-resources/comp-test-funcs.el
index 4cee084e211..dc4abf50767 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -367,11 +367,11 @@
(while (consp insn)
(let ((newcar (car insn)))
(if (or (consp (car insn)) (comp-mvar-p (car insn)))
- (setf newcar (comp-copy-insn (car insn))))
+ (setf newcar (comp--copy-insn (car insn))))
(push newcar result))
(setf insn (cdr insn)))
(nconc (nreverse result)
- (if (comp-mvar-p insn) (comp-copy-insn insn) insn)))
+ (if (comp-mvar-p insn) (comp--copy-insn insn) insn)))
(if (comp-mvar-p insn)
(copy-comp-mvar insn)
insn)))
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index e1c90feb09a..187dc2f34d5 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -282,26 +282,39 @@ expressions works for identifiers starting with period."
(should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d)
:type 'cyclic-variable-indirection))
-(defvar eval-tests/global-var 'value)
-(defvar-local eval-tests/buffer-local-var 'value)
+(defvar eval-tests/global-var 'global-value)
+(defvar-local eval-tests/buffer-local-var 'default-value)
(ert-deftest eval-tests/default-value ()
;; `let' overrides the default value for global variables.
(should (default-boundp 'eval-tests/global-var))
- (should (eq 'value (default-value 'eval-tests/global-var)))
- (should (eq 'value eval-tests/global-var))
- (let ((eval-tests/global-var 'bar))
- (should (eq 'bar (default-value 'eval-tests/global-var)))
- (should (eq 'bar eval-tests/global-var)))
+ (should (eq 'global-value (default-value 'eval-tests/global-var)))
+ (should (eq 'global-value eval-tests/global-var))
+ (let ((eval-tests/global-var 'let-value))
+ (should (eq 'let-value (default-value 'eval-tests/global-var)))
+ (should (eq 'let-value eval-tests/global-var)))
;; `let' overrides the default value everywhere, but leaves
;; buffer-local values unchanged in current buffer and in the
;; buffers where there is no explicitly set buffer-local value.
(should (default-boundp 'eval-tests/buffer-local-var))
- (should (eq 'value (default-value 'eval-tests/buffer-local-var)))
- (should (eq 'value eval-tests/buffer-local-var))
+ (should (eq 'default-value (default-value 'eval-tests/buffer-local-var)))
+ (should (eq 'default-value eval-tests/buffer-local-var))
(with-temp-buffer
- (let ((eval-tests/buffer-local-var 'bar))
- (should (eq 'bar (default-value 'eval-tests/buffer-local-var)))
- (should (eq 'bar eval-tests/buffer-local-var)))))
+ (let ((eval-tests/buffer-local-var 'let-value))
+ (should (eq 'let-value (default-value 'eval-tests/buffer-local-var)))
+ (should (eq 'let-value eval-tests/buffer-local-var))))
+ ;; When current buffer has explicit buffer-local binding, `let' does
+ ;; not alter the default binding.
+ (with-temp-buffer
+ (setq-local eval-tests/buffer-local-var 'local-value)
+ (let ((eval-tests/buffer-local-var 'let-value))
+ ;; Let in a buffer with local binding does not change the
+ ;; default value for variable.
+ (should (eq 'default-value (default-value 'eval-tests/buffer-local-var)))
+ (should (eq 'let-value eval-tests/buffer-local-var))
+ (with-temp-buffer
+ ;; We are in a new buffer - `eval-tests/buffer-local-var' has its
global default value.
+ (should (eq 'default-value (default-value
'eval-tests/buffer-local-var)))
+ (should (eq 'default-value eval-tests/buffer-local-var))))))
(ert-deftest eval-tests--handler-bind ()
;; A `handler-bind' has no effect if no error is signaled.
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el
index 14d160df25c..99d522d1856 100644
--- a/test/src/minibuf-tests.el
+++ b/test/src/minibuf-tests.el
@@ -34,7 +34,7 @@
(let ((num 0))
(mapcar (lambda (str) (cons str (cl-incf num))) list)))
(defun minibuf-tests--strings-to-obarray (list)
- (let ((ob (make-vector 7 0)))
+ (let ((ob (obarray-make 7)))
(mapc (lambda (str) (intern str ob)) list)
ob))
(defun minibuf-tests--strings-to-string-hashtable (list)
@@ -61,6 +61,9 @@
;;; Testing functions that are agnostic to type of COLLECTION.
+(defun minibuf-tests--set-equal (a b)
+ (null (cl-set-exclusive-or a b :test #'equal)))
+
(defun minibuf-tests--try-completion (xform-collection)
(let* ((abcdef (funcall xform-collection '("abc" "def")))
(+abba (funcall xform-collection '("abc" "abba" "def"))))
@@ -101,7 +104,8 @@
(let* ((abcdef (funcall xform-collection '("abc" "def")))
(+abba (funcall xform-collection '("abc" "abba" "def"))))
(should (equal (all-completions "a" abcdef) '("abc")))
- (should (equal (all-completions "a" +abba) '("abc" "abba")))
+ (should (minibuf-tests--set-equal (all-completions "a" +abba)
+ '("abc" "abba")))
(should (equal (all-completions "abc" +abba) '("abc")))
(should (equal (all-completions "abcd" +abba) nil))))
@@ -111,7 +115,8 @@
(+abba (funcall xform-collection '("abc" "abba" "def")))
(+abba-member (funcall collection-member +abba)))
(should (equal (all-completions "a" abcdef abcdef-member) '("abc")))
- (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba")))
+ (should (minibuf-tests--set-equal (all-completions "a" +abba +abba-member)
+ '("abc" "abba")))
(should (equal (all-completions "abc" +abba +abba-member) '("abc")))
(should (equal (all-completions "abcd" +abba +abba-member) nil))
(should-not (all-completions "a" abcdef #'ignore))
@@ -124,7 +129,8 @@
(+abba (funcall xform-collection '("abc" "abba" "def"))))
(let ((completion-regexp-list '(".")))
(should (equal (all-completions "a" abcdef) '("abc")))
- (should (equal (all-completions "a" +abba) '("abc" "abba")))
+ (should (minibuf-tests--set-equal (all-completions "a" +abba)
+ '("abc" "abba")))
(should (equal (all-completions "abc" +abba) '("abc")))
(should (equal (all-completions "abcd" +abba) nil)))
(let ((completion-regexp-list '("X")))
diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el
index a89bf1298c0..bdc9630c783 100644
--- a/test/src/treesit-tests.el
+++ b/test/src/treesit-tests.el
@@ -254,7 +254,7 @@
(should (eq nil (treesit-node-text
(treesit-search-subtree
subarray "\\["))))
- ;; If ALL=nil, searching for number should still find the
+ ;; If ALL=t, searching for number should still find the
;; numbers.
(should (equal "1" (treesit-node-text
(treesit-search-subtree