[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/comp-static-data 15a32ea1998 1/2: Merge branch 'master' into scr
|
From: |
Vibhav Pant |
|
Subject: |
scratch/comp-static-data 15a32ea1998 1/2: Merge branch 'master' into scratch/comp-static-data |
|
Date: |
Thu, 9 Mar 2023 00:51:19 -0500 (EST) |
branch: scratch/comp-static-data
commit 15a32ea199854a2ca975da86d52135c37f92a0e3
Merge: 82226254c86 5ff018524c7
Author: Vibhav Pant <vibhavp@gmail.com>
Commit: Vibhav Pant <vibhavp@gmail.com>
Merge branch 'master' into scratch/comp-static-data
---
ChangeLog.2 | 2 +-
ChangeLog.3 | 432 ++++++++++++++-
admin/git-bisect-start | 35 +-
admin/make-tarball.txt | 5 +-
.../html-manual/Multiple-Languages.html | 6 +-
admin/notes/tree-sitter/starter-guide | 4 +-
admin/notes/tree-sitter/treesit_record_change | 2 +-
configure.ac | 13 +-
doc/emacs/anti.texi | 15 +-
doc/emacs/building.texi | 37 +-
doc/emacs/dired.texi | 44 +-
doc/emacs/display.texi | 10 +-
doc/emacs/files.texi | 8 +-
doc/emacs/maintaining.texi | 59 +-
doc/emacs/misc.texi | 10 +-
doc/emacs/modes.texi | 9 +-
doc/emacs/programs.texi | 19 +-
doc/emacs/text.texi | 7 +-
doc/emacs/vc1-xtra.texi | 8 +-
doc/emacs/windows.texi | 4 +-
doc/lispref/commands.texi | 14 +-
doc/lispref/compile.texi | 88 ++-
doc/lispref/display.texi | 56 +-
doc/lispref/elisp.texi | 1 +
doc/lispref/eval.texi | 17 +-
doc/lispref/files.texi | 17 +-
doc/lispref/frames.texi | 41 +-
doc/lispref/functions.texi | 167 ++++--
doc/lispref/internals.texi | 2 +-
doc/lispref/lists.texi | 25 +-
doc/lispref/loading.texi | 25 +-
doc/lispref/modes.texi | 118 +++-
doc/lispref/parsing.texi | 29 +-
doc/lispref/positions.texi | 88 ++-
doc/lispref/text.texi | 47 +-
doc/lispref/windows.texi | 239 ++++++---
doc/misc/calc.texi | 24 +-
doc/misc/efaq.texi | 120 +++++
doc/misc/eglot.texi | 9 +
doc/misc/erc.texi | 14 +-
doc/misc/eshell.texi | 2 -
doc/misc/gnus-faq.texi | 16 +-
doc/misc/gnus.texi | 35 +-
doc/misc/modus-themes.org | 591 ++++++++++++++++-----
doc/misc/org.org | 19 +-
doc/misc/tramp.texi | 41 +-
doc/misc/transient.texi | 35 +-
etc/AUTHORS | 24 +-
etc/ERC-NEWS | 127 +++--
etc/HISTORY | 2 +
etc/NEWS | 185 +++++--
etc/NEWS.29 | 119 ++++-
etc/compilation.txt | 14 +
etc/emacsclient-mail.desktop | 7 +-
etc/publicsuffix.txt | 149 +++++-
etc/refcards/orgcard.tex | 4 +-
etc/themes/modus-operandi-deuteranopia-theme.el | 35 +-
etc/themes/modus-operandi-theme.el | 17 +-
etc/themes/modus-operandi-tinted-theme.el | 27 +-
etc/themes/modus-themes.el | 337 ++++++++----
etc/themes/modus-vivendi-deuteranopia-theme.el | 19 +-
etc/themes/modus-vivendi-theme.el | 13 +-
etc/themes/modus-vivendi-tinted-theme.el | 25 +-
leim/SKK-DIC/SKK-JISYO.L | 4 +-
lib-src/ebrowse.c | 5 -
lib-src/etags.c | 6 +-
lib/getopt-pfx-core.h | 2 +-
lib/limits.in.h | 13 +-
lib/string.in.h | 4 +
lib/unistd.in.h | 18 +
lib/verify.h | 2 +
lisp/bs.el | 2 +-
lisp/calc/calc-ext.el | 5 +-
lisp/calc/calc-help.el | 238 +++++----
lisp/calc/calc-misc.el | 44 +-
lisp/calc/calc.el | 20 +-
lisp/calendar/lunar.el | 56 +-
lisp/comint.el | 3 +-
lisp/cus-theme.el | 7 +-
lisp/custom.el | 1 +
lisp/dired-aux.el | 23 +-
lisp/dired.el | 19 +-
lisp/display-fill-column-indicator.el | 3 +
lisp/display-line-numbers.el | 49 +-
lisp/dnd.el | 4 +-
lisp/edmacro.el | 9 +-
lisp/emacs-lisp/byte-opt.el | 366 +++++++++----
lisp/emacs-lisp/bytecomp.el | 21 +-
lisp/emacs-lisp/cconv.el | 77 ++-
lisp/emacs-lisp/comp-cstr.el | 2 +-
lisp/emacs-lisp/comp.el | 88 +--
lisp/emacs-lisp/debug-early.el | 8 +-
lisp/emacs-lisp/edebug.el | 6 +-
lisp/emacs-lisp/eldoc.el | 17 +-
lisp/emacs-lisp/lisp-mode.el | 3 +
lisp/emacs-lisp/lisp.el | 1 +
lisp/emacs-lisp/macroexp.el | 23 +-
lisp/emacs-lisp/package-vc.el | 63 ++-
lisp/emacs-lisp/package.el | 7 +-
lisp/emacs-lisp/regexp-opt.el | 1 +
lisp/emacs-lisp/rmc.el | 27 +-
lisp/emacs-lisp/shortdoc.el | 3 +
lisp/emacs-lisp/subr-x.el | 7 +
lisp/emacs-lisp/unsafep.el | 2 +-
lisp/emulation/viper-cmd.el | 14 +-
lisp/env.el | 1 +
lisp/erc/erc-backend.el | 40 +-
lisp/erc/erc-button.el | 2 +-
lisp/erc/erc-common.el | 3 -
lisp/erc/erc-match.el | 2 +-
lisp/erc/erc-sasl.el | 55 +-
lisp/erc/erc-services.el | 6 +-
lisp/erc/erc.el | 53 +-
lisp/eshell/em-banner.el | 1 -
lisp/eshell/em-basic.el | 5 +-
lisp/eshell/em-cmpl.el | 27 +-
lisp/eshell/em-dirs.el | 35 +-
lisp/eshell/em-extpipe.el | 15 +
lisp/eshell/em-glob.el | 5 +-
lisp/eshell/em-hist.el | 8 +-
lisp/eshell/em-ls.el | 31 +-
lisp/eshell/em-pred.el | 2 +-
lisp/eshell/em-prompt.el | 2 -
lisp/eshell/em-rebind.el | 1 -
lisp/eshell/em-smart.el | 5 +-
lisp/eshell/em-term.el | 1 -
lisp/eshell/em-tramp.el | 3 +-
lisp/eshell/em-xtra.el | 2 -
lisp/eshell/esh-arg.el | 8 +-
lisp/eshell/esh-cmd.el | 83 ++-
lisp/eshell/esh-mode.el | 31 +-
lisp/eshell/esh-module.el | 32 +-
lisp/eshell/esh-opt.el | 5 +
lisp/eshell/esh-proc.el | 5 +-
lisp/eshell/esh-util.el | 34 ++
lisp/eshell/esh-var.el | 94 ++--
lisp/eshell/eshell.el | 38 +-
lisp/faces.el | 6 +-
lisp/files.el | 46 +-
lisp/font-lock.el | 25 +-
lisp/frame.el | 10 +-
lisp/gnus/message.el | 12 +-
lisp/help-fns.el | 6 +-
lisp/hi-lock.el | 1 +
lisp/icomplete.el | 43 +-
lisp/ido.el | 7 +-
lisp/iimage.el | 16 +-
lisp/image/exif.el | 47 +-
lisp/image/image-converter.el | 71 ++-
lisp/image/image-crop.el | 48 +-
lisp/image/image-dired-dired.el | 56 +-
lisp/image/image-dired-external.el | 52 +-
lisp/image/image-dired-tags.el | 20 +-
lisp/image/image-dired-util.el | 8 +-
lisp/image/image-dired.el | 106 ++--
lisp/image/wallpaper.el | 8 +-
lisp/imenu.el | 21 +-
lisp/international/emoji.el | 274 +++++-----
lisp/international/mule-conf.el | 14 +
lisp/international/mule.el | 1 +
lisp/isearch.el | 21 +-
lisp/keymap.el | 18 +-
lisp/kmacro.el | 45 +-
lisp/ldefs-boot.el | 199 ++++---
lisp/loadup.el | 2 +-
lisp/macros.el | 16 +-
lisp/mail/hashcash.el | 18 +-
lisp/mail/rmailsum.el | 6 +-
lisp/man.el | 27 +-
lisp/minibuffer.el | 6 +-
lisp/net/mailcap.el | 2 +-
lisp/net/tramp-adb.el | 13 +-
lisp/net/tramp-compat.el | 13 +
lisp/net/tramp-gvfs.el | 21 +-
lisp/net/tramp-integration.el | 20 +-
lisp/net/tramp-sh.el | 209 ++++----
lisp/net/tramp-smb.el | 4 +-
lisp/net/tramp-sudoedit.el | 13 +-
lisp/net/tramp.el | 211 ++++++--
lisp/net/trampver.el | 2 +-
lisp/org/ob-eval.el | 2 +-
lisp/org/ob-octave.el | 4 +-
lisp/org/ob-sql.el | 2 +-
lisp/org/org-agenda.el | 4 +-
lisp/org/org-clock.el | 10 +-
lisp/org/org-compat.el | 12 +-
lisp/org/org-cycle.el | 3 +
lisp/org/org-element.el | 51 +-
lisp/org/org-footnote.el | 2 +-
lisp/org/org-version.el | 2 +-
lisp/org/org.el | 76 +--
lisp/org/ox-texinfo.el | 16 +-
lisp/paren.el | 27 +-
lisp/pcomplete.el | 38 +-
lisp/progmodes/antlr-mode.el | 2 +-
lisp/progmodes/bug-reference.el | 40 +-
lisp/progmodes/c-ts-common.el | 137 +++--
lisp/progmodes/c-ts-mode.el | 301 ++++++++---
lisp/progmodes/cc-engine.el | 46 +-
lisp/progmodes/cc-fonts.el | 61 ++-
lisp/progmodes/cc-langs.el | 13 +-
lisp/progmodes/cmake-ts-mode.el | 7 +-
lisp/progmodes/compile.el | 65 ++-
lisp/progmodes/cperl-mode.el | 5 +-
lisp/progmodes/csharp-mode.el | 78 ++-
lisp/progmodes/eglot.el | 518 ++++++++++++------
lisp/progmodes/elisp-mode.el | 13 +-
lisp/progmodes/gdb-mi.el | 61 ++-
lisp/progmodes/go-ts-mode.el | 55 +-
lisp/progmodes/grep.el | 66 +++
lisp/progmodes/java-ts-mode.el | 55 +-
lisp/progmodes/js.el | 42 +-
lisp/progmodes/json-ts-mode.el | 2 +-
lisp/progmodes/project.el | 33 +-
lisp/progmodes/python.el | 61 ++-
lisp/progmodes/ruby-mode.el | 190 +++----
lisp/progmodes/ruby-ts-mode.el | 110 +++-
lisp/progmodes/rust-ts-mode.el | 171 ++++--
lisp/progmodes/sh-script.el | 34 +-
lisp/progmodes/typescript-ts-mode.el | 43 +-
lisp/progmodes/verilog-mode.el | 3 +-
lisp/progmodes/xref.el | 9 +-
lisp/repeat.el | 18 +-
lisp/simple.el | 45 +-
lisp/startup.el | 15 +-
lisp/subr.el | 220 ++++++--
lisp/textmodes/css-mode.el | 5 +-
lisp/textmodes/emacs-news-mode.el | 27 +-
lisp/textmodes/ispell.el | 9 +-
lisp/textmodes/paragraphs.el | 12 +-
lisp/textmodes/reftex-ref.el | 2 +-
lisp/textmodes/toml-ts-mode.el | 4 +-
lisp/textmodes/yaml-ts-mode.el | 12 +-
lisp/time.el | 6 +
lisp/transient.el | 485 ++++++++---------
lisp/treesit.el | 266 +++++++---
lisp/url/url-auth.el | 5 +-
lisp/url/url-domsuf.el | 22 +-
lisp/url/url-gw.el | 57 +-
lisp/vc/diff-mode.el | 34 +-
lisp/vc/ediff-init.el | 5 +-
lisp/vc/emerge.el | 2 +-
lisp/vc/vc.el | 58 +-
lisp/wdired.el | 1 +
lisp/window.el | 182 ++++++-
lisp/woman.el | 4 +-
lisp/xwidget.el | 3 +-
m4/assert_h.m4 | 14 +-
m4/fdopendir.m4 | 14 +-
m4/gnulib-common.m4 | 219 ++++++--
m4/limits-h.m4 | 1 +
m4/lstat.m4 | 5 +-
m4/malloc.m4 | 4 +-
m4/pselect.m4 | 4 +-
m4/readlink.m4 | 8 +-
m4/realloc.m4 | 4 +-
m4/symlink.m4 | 4 +-
msdos/sedlibmk.inp | 2 +
nt/mingw-cfg.site | 3 +
src/.gdbinit | 2 +-
src/alloc.c | 11 +-
src/bidi.c | 16 +-
src/buffer.c | 51 +-
src/buffer.h | 2 +-
src/bytecode.c | 4 +-
src/comp.c | 105 ++--
src/data.c | 65 +--
src/editfns.c | 118 ++--
src/emacs.c | 3 +-
src/eval.c | 9 +-
src/fileio.c | 100 ++--
src/fns.c | 17 +-
src/frame.c | 2 +-
src/haikufont.c | 2 +-
src/indent.c | 2 +-
src/insdel.c | 38 ++
src/intervals.c | 3 +
src/keyboard.c | 31 +-
src/lisp.h | 6 +
src/macros.c | 6 +-
src/nsxwidget.h | 2 +
src/nsxwidget.m | 100 +++-
src/pdumper.c | 2 +-
src/profiler.c | 3 +
src/regex-emacs.c | 18 +
src/textconv.c | 313 +++++++++++
src/textconv.h | 109 ++++
src/treesit.c | 82 ++-
src/window.c | 55 +-
src/xdisp.c | 59 +-
src/xfaces.c | 4 +-
src/xfns.c | 303 ++++++++++-
src/xterm.c | 47 +-
src/xwidget.c | 63 ++-
test/lisp/calendar/lunar-tests.el | 29 +-
test/lisp/emacs-lisp/bytecomp-tests.el | 40 +-
test/lisp/emacs-lisp/cconv-tests.el | 25 +
test/lisp/emacs-lisp/nadvice-tests.el | 8 +-
test/lisp/erc/erc-scenarios-base-reuse-buffers.el | 36 --
test/lisp/erc/erc-scenarios-internal.el | 3 +
test/lisp/erc/erc-tests.el | 4 +-
test/lisp/eshell/em-cmpl-tests.el | 44 +-
test/lisp/eshell/em-prompt-tests.el | 8 +-
test/lisp/eshell/esh-cmd-tests.el | 17 +
test/lisp/eshell/eshell-tests-unload.el | 99 ++++
test/lisp/eshell/eshell-tests.el | 28 +
test/lisp/help-fns-tests.el | 4 -
test/lisp/hi-lock-tests.el | 143 ++---
test/lisp/international/mule-tests.el | 9 +-
test/lisp/kmacro-tests.el | 14 +
test/lisp/net/tramp-tests.el | 299 +++++++++--
.../progmodes/c-ts-mode-resources/indent-bsd.erts | 2 +-
.../c-ts-mode-resources/indent-preproc.erts | 99 ++++
.../lisp/progmodes/c-ts-mode-resources/indent.erts | 210 +++++++-
test/lisp/progmodes/c-ts-mode-tests.el | 4 +
test/lisp/progmodes/compile-tests.el | 6 +-
test/lisp/progmodes/eglot-tests.el | 27 +-
test/lisp/progmodes/elisp-mode-tests.el | 5 +
.../progmodes/go-ts-mode-resources/indent.erts | 47 ++
.../go-ts-mode-tests.el} | 17 +-
test/lisp/progmodes/grep-tests.el | 14 +
.../progmodes/java-ts-mode-resources/indent.erts | 91 +++-
test/lisp/progmodes/python-tests.el | 62 ++-
.../ruby-after-operator-indent.rb | 4 +
test/lisp/progmodes/ruby-mode-resources/ruby.rb | 5 +
test/lisp/progmodes/ruby-ts-mode-tests.el | 16 +
test/lisp/progmodes/sh-script-tests.el | 18 +
test/lisp/subr-tests.el | 70 ++-
.../{toggle-tag.erts => cycle-tag.erts} | 89 ++++
test/lisp/textmodes/emacs-news-mode-tests.el | 6 +-
test/lisp/url/url-domsuf-tests.el | 4 +
test/lisp/wdired-tests.el | 40 +-
test/manual/indent/shell.sh | 1 +
test/src/buffer-tests.el | 106 ++++
test/src/data-tests.el | 36 ++
test/src/fns-tests.el | 2 +-
test/src/lread-tests.el | 12 +-
test/src/regex-emacs-tests.el | 11 +
test/src/treesit-tests.el | 46 +-
339 files changed, 10903 insertions(+), 4346 deletions(-)
diff --git a/ChangeLog.2 b/ChangeLog.2
index cde9e63df88..11e6049b0bd 100644
--- a/ChangeLog.2
+++ b/ChangeLog.2
@@ -111,7 +111,7 @@
2017-03-21 Noam Postavsky <npostavs@gmail.com>
- Narrow scope of modification hook renabling in org-src fontification
+ Narrow scope of modification hook re-enabling in org-src fontification
Modification hooks should be enabled while modifying text in the
org-src temp buffer, but in 2017-01-29 "Call modification hooks in
diff --git a/ChangeLog.3 b/ChangeLog.3
index 3d733804e39..85cccf0d6ed 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1,3 +1,431 @@
+2022-02-18 Stefan Kangas <stefankangas@gmail.com>
+
+ * Version 28.3 released.
+
+2023-02-17 Stefan Kangas <stefankangas@gmail.com>
+
+ Update HISTORY for Emacs 28.3
+
+2023-02-17 Stefan Kangas <stefankangas@gmail.com>
+
+ Bump Emacs version to 28.3
+
+ * README:
+ * configure.ac:
+ * msdos/sed2v2.inp:
+ * nt/README.W32: Bump Emacs version to 28.3.
+
+2023-02-17 Stefan Kangas <stefankangas@gmail.com>
+
+ Update NEWS for Emacs 28.3
+
+ * etc/NEWS: Update for Emacs 28.3.
+
+2023-02-17 Stefan Kangas <stefankangas@gmail.com>
+
+ Update ChangeLog and AUTHORS for Emacs 28.3
+
+ * ChangeLog.3:
+ * etc/AUTHORS: Update for Emacs 28.3.
+
+2023-02-17 Xi Lu <lx@shellcodes.org>
+
+ Fix etags local command injection vulnerability
+
+ * lib-src/etags.c: (escape_shell_arg_string): New function.
+ (process_file_name): Use it to quote file names passed to the
+ shell. (Bug#59817)
+
+ (cherry picked from commit 01a4035c869b91c153af9a9132c87adb7669ea1c)
+
+2023-02-17 Xi Lu <lx@shellcodes.org>
+
+ Fixed ctags local command execute vulnerability
+
+ * lib-src/etags.c:
+
+ (clean_matched_file_tag): New function
+ (do_move_file): New function
+ (readline_internal):
+ Add `leave_cr` parameter, if true, include the \r character
+
+ * test/manual/etags/CTAGS.good_crlf: New file
+ * test/manual/etags/CTAGS.good_update: New file
+ * test/manual/etags/crlf: New file
+ * test/manual/etags/Makefile: Add `ctags -u` test cases
+
+ (cherry picked from commit d48bb4874bc6cd3e69c7a15fc3c91cc141025c51)
+
+2023-02-17 Xi Lu <lx@shellcodes.org>
+
+ Fix ruby-mode.el local command injection vulnerability (bug#60268)
+
+ * lisp/progmodes/ruby-mode.el
+ (ruby-find-library-file): Fix local command injection vulnerability.
+
+ (cherry picked from commit 9a3b08061feea14d6f37685ca1ab8801758bfd1c)
+
+2023-02-17 Xi Lu <lx@shellcodes.org>
+
+ Fix htmlfontify.el command injection vulnerability.
+
+ * lisp/htmlfontify.el (hfy-text-p): Fix command injection
+ vulnerability. (Bug#60295)
+
+ (cherry picked from commit 1b4dc4691c1f87fc970fbe568b43869a15ad0d4c)
+
+2022-12-19 Eli Zaretskii <eliz@gnu.org>
+
+ Fix storing email into nnmail by Gnus
+
+ Backporting suggested by Florian Weimer, since this is
+ a denial-of-service issue.
+ * lisp/gnus/nnml.el (nnml--encode-headers): Wrap
+ 'rfc2047-encode-string' calls with 'ignore-errors', to avoid
+ disrupting email workflows due to possibly-invalid headers.
+ Reported by Florian Weimer <fweimer@redhat.com>.
+
+ (cherry picked from commit 23f7c9c2a92e4619b7c4d2286d4249f812cd695d)
+
+2022-11-14 Robert Pluim <rpluim@gmail.com>
+
+ Explain how to bind keys to non-ASCII sequences
+
+ * doc/emacs/custom.texi (Init Rebinding): Explain how to use `kbd'
+ when binding keys to non-ASCII sequences.
+
+2022-11-12 Eli Zaretskii <eliz@gnu.org>
+
+ Document that 'transient-mark-mode' is off in batch mode
+
+ * doc/emacs/mark.texi (Mark, Disabled Transient Mark): Document,
+ belatedly, that 'transient-mark-mode' is turned on by default only
+ in interactive sessions. (Bug#59201)
+
+2022-10-14 Eli Zaretskii <eliz@gnu.org>
+
+ Document how to control where the *.eln files are written
+
+ * doc/lispref/compile.texi (Native Compilation): Document the
+ trick of pointing $HOME to a non-existent directory.
+ (Native-Compilation Variables): Document the role of
+ 'native-comp-eln-load-path' in determining where *.eln files are
+ written.
+
+2022-10-14 Robert Pluim <rpluim@gmail.com>
+
+ Add cross-reference to alternative syntaxes for Unicode
+
+ These alternative syntaxes allow you to specify Unicode codepoints
+ using only ASCII, which helps avoid decoding issues.
+
+ * doc/emacs/custom.texi (Init Non-ASCII): Add cross reference to
+ "General Escape Syntax" in the Emacs Lisp Reference Manual.
+
+2022-10-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Update name of hs-mouse-toggle-hiding in Emacs manual
+
+ * doc/emacs/programs.texi (Hideshow): Update the name of
+ hs-mouse-toggle-hiding (bug#58331).
+
+2022-10-06 Stefan Kangas <stefankangas@gmail.com>
+
+ Fix typo in `(emacs) Lisp Doc'
+
+ * doc/emacs/programs.texi (Lisp Doc): Fix reference to
+ 'eldoc-echo-area-display-truncation-message'. (Bug#58324)
+
+2022-10-06 Stefan Kangas <stefankangas@gmail.com>
+
+ Fix references to 'default-indent-new-line'
+
+ * doc/emacs/programs.texi (Comment Commands)
+ (Multi-Line Comments): Fix references to
+ 'default-indent-new-line'. (Bug#58325)
+
+2022-10-04 Andreas Schwab <schwab@linux-m68k.org>
+
+ * src/emacs.c (load_pdump): Propery handle case when executable
+ wasn't found.
+
+2022-10-04 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid assertion violations in STRING_CHAR
+
+ * src/xdisp.c (handle_composition_prop):
+ * src/editfns.c (styled_format): Don't call 'STRING_CHAR' on
+ unibyte strings. This avoids assertion violation in
+ 'string_char_and_length'.
+
+ (cherry picked from commit d52d6e1e106117eb4bba81a65e256e2e793037b6)
+
+2022-10-03 Stefan Kangas <stefankangas@gmail.com>
+
+ Fix documentation of 'TAB' in cc-mode
+
+ * doc/emacs/programs.texi (C Indent): Fix documentation of 'TAB'
+ in cc-mode. (Bug#58258)
+
+2022-10-03 Stefan Kangas <stefankangas@gmail.com>
+
+ Fix 'org-export-dispatch' command name in manual
+
+ * doc/emacs/text.texi (Org Authoring): Fix 'org-export-dispatch'
+ command name. (Bug#58260)
+
+2022-10-02 Andreas Schwab <schwab@linux-m68k.org>
+
+ * src/emacs.c (load_pdump): Fix use of xpalloc.
+
+2022-10-02 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid assertion violation in 'xpalloc'
+
+ * src/emacs.c (load_pdump): Ensure the 3rd argument of xpalloc is
+ always positive. (Bug#58232)
+
+2022-09-30 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix connection property incompatibility in Tramp
+
+ * lisp/net/tramp.el (tramp-get-remote-tmpdir): Remove obsolete
+ connection property "tmpdir". (Bug#57800)
+
+2022-09-29 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Update some Gnus documentation in the Emacs manual
+
+ * doc/emacs/misc.texi (Gnus Group Buffer, Gnus Summary Buffer):
+ Update documentation (bug#58145).
+
+2022-09-28 Eli Zaretskii <eliz@gnu.org>
+
+ Clarify image file search
+
+ * doc/lispref/display.texi (Defining Images, Image Descriptors):
+ * lisp/image.el (create-image): Clarify that non-absolute image
+ files are searched along 'image-load-path'. (Bug#52931)
+
+2022-09-28 Stefan Kangas <stefankangas@gmail.com>
+
+ .mailcap: Some additional fixes.
+
+2022-09-28 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid assertion violations in 'pop_it'
+
+ * src/xdisp.c (pop_it): Avoid assertion violations when handling
+ lists or vectors of display properties. (Bug#58122)
+
+2022-09-28 Stefan Kangas <stefankangas@gmail.com>
+
+ Add .mailmap for proper git log output
+
+ This file is used to fix a few misspelled names in various git
+ listings (e.g., "git log"). This can be used to fix incorrect
+ attribution, poor display, or names showing up more than once.
+ It also allows updating an old email addresses to a new one.
+ See "man git-shortlog" for more information on the format.
+
+ * .mailmap: New file.
+
+2022-09-27 Stefan Kangas <stefankangas@gmail.com>
+
+ * doc/emacs/ack.texi (Acknowledgments): Update maintainers.
+
+2022-09-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/hideshow.el (hs-toggle-hiding): Fix `interactive` form
+
+ This fixes the first part of bug#52092, which is a regression
+ introduced by commit d0e9113de97.
+
+2022-09-23 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ Fix shaping with bitmap-only fonts on HarfBuzz 5.2.0 (Bug#57976)
+
+ * src/ftcrfont.c (ftcrhbfont_begin_hb_font): Undo last change for
+ HarfBuzz 5.2.0.
+
+2022-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/text-modes/tex-mode.el (tex-mode): Fix AUCTeX regression
+
+ As discussed in
+ https://lists.gnu.org/r/auctex/2022-08/msg00004.html
+ AUCTeX installs its own advice to redefine `tex-mode`, and that
+ advice used to take precedence before commit 6075a7c5ae3fa456cd.
+
+2022-09-20 Robert Pluim <rpluim@gmail.com>
+
+ Add vc-annotate-switches to manual
+
+ * doc/emacs/maintaining.texi (Old Revisions): Add description of
+ `vc-annotate-switches' and `vc-BACKEND-annotate-switches'.
+
+2022-09-20 Robert Pluim <rpluim@gmail.com>
+
+ Remove mention of non-existent `annotate-switches'
+
+ * lisp/vc/vc.el (vc-annotate-switches): Remove mention of
+ `annotate-switches'. As far as I can tell this has never existed in
+ Emacs.
+
+2022-09-20 Robert Pluim <rpluim@gmail.com>
+
+ Mention that src/macuvs.h sometimes needs committing
+
+ * admin/notes/unicode: src/macuvs.h is generated, but needs to be
+ committed sometimes.
+
+2022-09-19 Gerd Möllmann <gerd@gnu.org>
+
+ MacOS ld warning from native compilation (bug#57849)
+
+ * lisp/emacs-lisp/comp.el (native-comp-driver-options): Add "-Wl,-w"
+ on Darwin systems.
+ * etc/NEWS: Describe change.
+
+2022-09-18 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Tramp error with eshell integration
+
+ * lisp/net/tramp-integration.el (tramp-eshell-directory-change):
+ Respect local `default-directory'. (Bug#57556)
+
+2022-09-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.5.3.2. Don't merge with master
+
+ * doc/misc/tramp.texi (Android shell setup): Rework.
+ (Frequently Asked Questions): Improve recommendations for speeding up.
+
+ * doc/misc/trampver.texi:
+ * lisp/net/trampver.el: Change version to "2.5.4-pre".
+
+ * lisp/net/tramp-adb.el (tramp-methods): Use "%d".
+ (tramp-adb-handle-directory-files-and-attributes): Fix "." and
+ ".." in listing.
+ (tramp-adb-handle-file-attributes)
+ (tramp-adb-handle-directory-files-and-attributes)
+ (tramp-adb-handle-file-name-all-completions): Pipe "ls" output
+ through "cat", in order to avoid quoting special characters.
+ (tramp-adb-maybe-open-connection): Compute args from `tramp-login-args'.
+
+ * lisp/net/tramp-compat.el (tramp-compat-replace-regexp-in-region):
+ New defalias.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file):
+ Adapt check for proper remote command.
+
+ * lisp/net/tramp.el (tramp-methods): Adapt docstring.
+ (tramp-handle-make-process): Check for adb device if indicated.
+ (tramp-get-remote-tmpdir): Cache result in temporary connection
+ property.
+
+ * test/lisp/net/tramp-tests.el (tramp-test17-insert-directory)
+ (tramp-test22-file-times, tramp--test-utf8): Adapt tests.
+ (tramp--test-shell-file-name): Do not depend on `tramp--test-adb-p'.
+ (tramp-test46-unload): Ignore autoload functions in
+ `tramp-file-name' structure tests, since `tramp-file-name-handler'
+ is also autoloaded in Emacs 29.
+
+2022-09-17 Stefan Kangas <stefankangas@gmail.com>
+
+ Simplify regexp in make-news-html-file
+
+ * admin/admin.el (make-news-html-file): Simplify regexp.
+ Suggested by Mattias Engdegård <mattiase@acm.org>.
+
+2022-09-16 Stefan Kangas <stefankangas@gmail.com>
+
+ * admin/admin.el (make-news-html-file): Set id on correct tag.
+
+2022-09-16 Stefan Kangas <stefankangas@gmail.com>
+
+ Add version headlines to HTML NEWS export
+
+ This allows linking to, e.g. "NEWS.28.html#28.1" to go directly to
+ those release notes.
+ * admin/admin.el (admin--org-export-headers-format)
+ (make-news-html-file): Add XX.Y version headlines with an HTML anchor.
+
+2022-09-16 Stefan Kangas <stefankangas@gmail.com>
+
+ Improve HTML export of NEWS file
+
+ * admin/admin.el (admin--org-export-headers-format)
+ (admin--org-html-postamble): New variables.
+ (admin--require-external-package): New function.
+ (make-news-html-file): Improve HTML export.
+
+2022-09-16 Stefan Kangas <stefankangas@gmail.com>
+
+ Delete "etc/NEWS*.html" from .gitignore
+
+ We actually do want to see it when preparing a release, so that we
+ don't include it in a tarball by mistake.
+ * .gitignore: Don't ignore "etc/NEWS*.html".
+
+2022-09-16 Stefan Kangas <stefankangas@gmail.com>
+
+ Recommend NonGNU ELPA over MELPA
+
+ * doc/misc/org.org (Using CDLaTeX to enter math, Footnotes): Recommend
+ NonGNU ELPA over MELPA.
+
+2022-09-16 Stefan Kangas <stefankangas@gmail.com>
+
+ Minor doc fixes in picture.el
+
+ * lisp/textmodes/picture.el: Improve Commentary.
+ (picture-forward-column, picture-backward-column)
+ (picture-move-down, picture-move-up, picture-movement-nw)
+ (picture-movement-ne, picture-movement-sw, picture-movement-se)
+ (picture-set-motion, picture-clear-line, picture-newline)
+ (picture-tab, picture-yank-rectangle)
+ (picture-yank-rectangle-from-register, picture-insert-rectangle)
+ (picture-draw-rectangle): Minor doc fixes.
+
+2022-09-16 Stefan Kangas <stefankangas@gmail.com>
+
+ * lisp/textmodes/page-ext.el: Improve Commentary.
+
+2022-09-14 Stefan Kangas <stefankangas@gmail.com>
+
+ Automate exporting etc/NEWS to HTML
+
+ * admin/admin.el (make-news-html-file): New function.
+ * .gitignore: Ignore generated "etc/NEWS*.html" file.
+
+2022-09-14 Eli Zaretskii <eliz@gnu.org>
+
+ * Makefile.in (uninstall): Remove the *.eln files. (Bug#57771)
+
+2022-09-12 Stefan Kangas <stefankangas@gmail.com>
+
+ Update HISTORY for Emacs 28.2
+
+ * etc/HISTORY: Update for the Emacs 28.2 release.
+
+2022-09-07 Stefan Kangas <stefankangas@gmail.com>
+
+ Bump Emacs version to 28.2
+
+ * README:
+ * configure.ac:
+ * msdos/sed2v2.inp:
+ * nt/README.W32: Bump Emacs version to 28.2.
+
+2022-09-07 Stefan Kangas <stefankangas@gmail.com>
+
+ Update ChangeLog and AUTHORS for Emacs 28.2
+
+ * ChangeLog.3:
+ * etc/AUTHORS:
+ * etc/NEWS: Update for Emacs 28.2.
+
2022-09-06 Stefan Kangas <stefankangas@gmail.com>
* doc/misc/idlwave.texi (Troubleshooting): Don't say "Emacsen".
@@ -204741,7 +205169,7 @@
2017-03-21 Noam Postavsky <npostavs@gmail.com>
- Narrow scope of modification hook renabling in org-src fontification
+ Narrow scope of modification hook re-enabling in org-src fontification
Modification hooks should be enabled while modifying text in the
org-src temp buffer, but in 2017-01-29 "Call modification hooks in
@@ -236920,7 +237348,7 @@
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
-commit ddabb03a0176beb4b7fc8d4f2267d459fd2ebded (inclusive).
+commit f7bd5ac55211ad0ae2e473f0dff46df1e60f99bf (inclusive).
See ChangeLog.2 for earlier changes.
;; Local Variables:
diff --git a/admin/git-bisect-start b/admin/git-bisect-start
index a439ee7fe15..65bfffc0ad6 100755
--- a/admin/git-bisect-start
+++ b/admin/git-bisect-start
@@ -82,7 +82,7 @@ done
# SKIP-BRANCH 58cc931e92ece70c3e64131ee12a799d65409100
## The list below is the exhaustive list of all commits between Dec 1
-## 2016 and Dec 31 2022 on which building Emacs with the default
+## 2016 and Jan 31 2023 on which building Emacs with the default
## options, on a GNU/Linux computer and with GCC, fails. It is
## possible (though unlikely) that building Emacs with non-default
## options, with other compilers, or on other platforms, would succeed
@@ -1674,3 +1674,36 @@ $REAL_GIT bisect skip $(cat $0 | grep '^# SKIP-SINGLE '
| sed 's/^# SKIP-SINGLE
# SKIP-SINGLE 8c13e8497821881b5197a1717e9e53b9991859d0
# SKIP-SINGLE a6db8464e150c49724c71c5969b97f205ee2dec5
# SKIP-SINGLE cfbfd393b450d4eb7ac0b7922b44208688553c9e
+# SKIP-SINGLE 382e018856a884a96a94ad551dbc1d7b0317b2e5
+# SKIP-SINGLE 8360e12f0ea3a3ccf0305adab3c7ea7e38af36c1
+# SKIP-SINGLE 56e8607dc99b90c43f82001cbf073e58a4698298
+# SKIP-SINGLE 956889d8ff1c79db45ca9b1711f406961e71c272
+# SKIP-SINGLE e2e937300f5a68ce1e2a349a583859a29394ac5f
+# SKIP-SINGLE 176830fe2bb1c80ee128e515f6223cddc8b0a2ca
+# SKIP-SINGLE 3f069bd796b0024033640051b5f74ba9834985f8
+# SKIP-SINGLE 435ba92ccc4c46914c261de57f71ac6d92c20178
+# SKIP-SINGLE ad6d8f7df180a9563d3f064f29c6366f114b8de0
+# SKIP-SINGLE 8d7ad65665833ae99b7e7119dae37afa438968a4
+# SKIP-SINGLE 10032f424ccf611783f5b92742e91e70595587c4
+# SKIP-SINGLE 4b1714571c8c6cf7ae2ee2602c66b7c903c45a4a
+# SKIP-SINGLE f27a330b99eebbe7f4690163358b4cacbd4e17a1
+# SKIP-SINGLE b73539832d9c4e802925cb8f261a13473da383b3
+# SKIP-SINGLE f50cb7d7c4b37cd8e4bb1ffa5d3f9273c7e19e10
+# SKIP-SINGLE 96015c9c8cc1720e8ee7cd9cea4de48126dd9122
+# SKIP-SINGLE 2bd0b9475384adfb4dd2cc794bbe1d8621546717
+# SKIP-SINGLE d9a2673ee95cf7172a622dc0229ddf72aec8e8c1
+# SKIP-SINGLE 0116e27b26cb4a98f2de8dca12d8e9d90d222992
+# SKIP-SINGLE 96601cd90ba1b8a650d0e41dad2a58cb9e270f1b
+# SKIP-SINGLE 99e40959f4036debe099f144ed2664a38e23563d
+# SKIP-SINGLE 207a0d9408cb97b9ae78469e2487e3075ade03f8
+# SKIP-SINGLE 64fee21d5f85db465198970a4d636cb17d500f26
+# SKIP-SINGLE 48bd17923a98f49a30bdce2f3a52e03fe45d63f0
+# SKIP-SINGLE 9058601308db4892fbc3e599b83fe4326fef9886
+# SKIP-SINGLE a3003492ace0571e5179500b42bbe44cb9763dbb
+# SKIP-SINGLE 197f994384cb37ae4ae7a771815bbe565d4ae242
+# SKIP-SINGLE 1970726e26a979243925fabe32686ba2ee757c6b
+# SKIP-SINGLE 1de6ebf2878485a0ef6b778df7d6a14d5b22a01c
+# SKIP-SINGLE 013ab7e2a83afa7fb577c356ae686439a2906f34
+# SKIP-SINGLE 1c3ca3bb649b7e812a84b4a559463462d4357080
+# SKIP-SINGLE 48ed4228a75907ae1bb7a2d4314ffb3277c75e3a
+# SKIP-SINGLE b9025c507a3a7dae4de19b18cafaa09b18183832
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 45da3ed6be5..232053e5e96 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -150,10 +150,11 @@ General steps (for each step, check for possible errors):
4. autoreconf -i -I m4 --force
make bootstrap
+ The below script checks for any mistakes in the source text of
+ manual pages. Fix any errors and re-run the script to verify.
+
./admin/check-man-pages
- The above script checks for any mistakes in the source text of
- manual pages. Fix any errors and re-run the script to verify.
Then do this:
make -C etc/refcards
diff --git a/admin/notes/tree-sitter/html-manual/Multiple-Languages.html
b/admin/notes/tree-sitter/html-manual/Multiple-Languages.html
index 65507687d51..390d9082590 100644
--- a/admin/notes/tree-sitter/html-manual/Multiple-Languages.html
+++ b/admin/notes/tree-sitter/html-manual/Multiple-Languages.html
@@ -223,9 +223,9 @@ ranges for <acronym>CSS</acronym> and JavaScript parsers:
</p>
<div class="example">
<pre class="example">;; Create parsers.
-(setq html (treesit-get-parser-create 'html))
-(setq css (treesit-get-parser-create 'css))
-(setq js (treesit-get-parser-create 'javascript))
+(setq html (treesit-parser-create 'html))
+(setq css (treesit-parser-create 'css))
+(setq js (treesit-parser-create 'javascript))
</pre><pre class="example">
</pre><pre class="example">;; Set CSS ranges.
diff --git a/admin/notes/tree-sitter/starter-guide
b/admin/notes/tree-sitter/starter-guide
index 606f7891dfa..b8910aab5ca 100644
--- a/admin/notes/tree-sitter/starter-guide
+++ b/admin/notes/tree-sitter/starter-guide
@@ -45,7 +45,7 @@ You can use this script that I put together here:
You can also find them under this directory in /build-modules.
This script automatically pulls and builds language definitions for C,
-C++, Rust, JSON, Go, HTML, Javascript, CSS, Python, Typescript,
+C++, Rust, JSON, Go, HTML, JavaScript, CSS, Python, Typescript,
and C#. Better yet, I pre-built these language definitions for
GNU/Linux and macOS, they can be downloaded here:
@@ -271,7 +271,7 @@ Matchers and anchors are functions that takes (NODE PARENT
BOL &rest
_). Matches return nil/non-nil for no match/match, and anchors return
the anchor point. Below are some convenient builtin matchers and anchors.
-For MATHCER we have
+For MATCHER we have
(parent-is TYPE) => matches if PARENT’s type matches TYPE as regexp
(node-is TYPE) => matches NODE’s type
diff --git a/admin/notes/tree-sitter/treesit_record_change
b/admin/notes/tree-sitter/treesit_record_change
index bb0f9edc353..0dc6491e2d1 100644
--- a/admin/notes/tree-sitter/treesit_record_change
+++ b/admin/notes/tree-sitter/treesit_record_change
@@ -5,7 +5,7 @@ buffer, lest tree-sitter's parse tree would be corrupted/out of
sync.
All buffer changes in Emacs are made through functions in insdel.c
(and casefiddle.c), I augmented functions in those files with calls to
-treesit_record_change. Below is a manifest of all the relavent
+treesit_record_change. Below is a manifest of all the relevant
functions in insdel.c as of Emacs 29:
Function Calls
diff --git a/configure.ac b/configure.ac
index fc17dbd8318..b484ebdc8ba 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3583,8 +3583,12 @@ XWIDGETS_OBJ=
if test "$with_xwidgets" != "no"; then
if test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none"; then
WEBKIT_REQUIRED=2.12
- WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED"
+ WEBKIT_MODULES="webkit2gtk-4.1 >= $WEBKIT_REQUIRED"
EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES])
+ if test "$HAVE_WEBKIT" = "no"; then
+ WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED"
+ EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES])
+ fi
HAVE_XWIDGETS=$HAVE_WEBKIT
XWIDGETS_OBJ="xwidget.o"
if test "$HAVE_X_WINDOWS" = "yes" && test "${with_cairo}" = "no"; then
@@ -6502,6 +6506,12 @@ if test "$window_system" != "none"; then
AC_DEFINE([POLL_FOR_INPUT], [1],
[Define if you poll periodically to detect C-g.])
WINDOW_SYSTEM_OBJ="fontset.o fringe.o image.o"
+
+ if test "$window_system" = "x11"; then
+ AC_DEFINE([HAVE_TEXT_CONVERSION], [1],
+ [Define if the window system has text conversion support.])
+ WINDOW_SYSTEM_OBJ="$WINDOW_SYSTEM_OBJ textconv.o"
+ fi
fi
AC_SUBST([WINDOW_SYSTEM_OBJ])
@@ -6627,6 +6637,7 @@ AC_DEFINE_UNQUOTED([EMACS_CONFIG_FEATURES],
["${emacs_config_features}"],
[Summary of some of the main features enabled by configure.])
AS_ECHO([" Does Emacs use -lXaw3d?
${HAVE_XAW3D}
+ Does Emacs use the X Double Buffer Extension? ${HAVE_XDBE}
Does Emacs use -lXpm? ${HAVE_XPM}
Does Emacs use -ljpeg? ${HAVE_JPEG}
Does Emacs use -ltiff? ${HAVE_TIFF}
diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi
index c46110a530d..b25d8a8e3cc 100644
--- a/doc/emacs/anti.texi
+++ b/doc/emacs/anti.texi
@@ -69,13 +69,14 @@ idea anyway.
@item
In line with simplifying and eventually removing the
native-compilation option, we've deleted the
-@code{inhibit-automatic-native-compilation} variable and its support
-code. This greatly simplifies how native compilation works and makes
-your configure-time decision regarding native compilation in Emacs
-clear-cut: either Emacs always compiles Lisp to native code before
-using it, or it never does so; no more half measures and special
-exceptions. For similar reasons, @code{native-compile-prune-cache}
-and @code{startup-redirect-eln-cache} features are no longer part of
+@option{--with-native-compilation=aot} configure-time option. This
+greatly simplifies how native compilation works and makes your
+configure-time decision regarding native compilation in Emacs
+clear-cut: either Emacs compiles non-preloaded Lisp packages to native
+code only before using it, or it never uses native compilation at all;
+no more half measures and special exceptions. For similar reasons,
+@code{native-compile-prune-cache} and
+@code{startup-redirect-eln-cache} features are no longer part of
Emacs.
@item
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 3f6a418de1a..f82b605598e 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -1556,18 +1556,26 @@ command prompts for a @dfn{library name} rather than a
file name; it
searches through each directory in the Emacs Lisp load path, trying to
find a file matching that library name. If the library name is
@samp{@var{foo}}, it tries looking for files named
-@file{@var{foo}.elc}, @file{@var{foo}.el}, and @file{@var{foo}}. The
-default behavior is to load the first file found. This command
-prefers @file{.elc} files over @file{.el} files because compiled files
-load and run faster. If it finds that @file{@var{lib}.el} is newer
-than @file{@var{lib}.elc}, it issues a warning, in case someone made
-changes to the @file{.el} file and forgot to recompile it, but loads
-the @file{.elc} file anyway. (Due to this behavior, you can save
-unfinished edits to Emacs Lisp source files, and not recompile until
-your changes are ready for use.) If you set the option
-@code{load-prefer-newer} to a non-@code{nil} value, however, then
-rather than the procedure described above, Emacs loads whichever
-version of the file is newest.
+@file{@var{foo}.elc}, @file{@var{foo}.el}, and @file{@var{foo}}. (If
+Emacs was built with native compilation enabled, @code{load-library}
+looks for a @samp{.eln} file that corresponds to @file{@var{foo}.el}
+and loads it instead of @file{@var{foo}.elc}.) The default behavior
+is to load the first file found. This command prefers @file{.eln}
+files over @file{.elc} files, and prefers @file{.elc} files over
+@file{.el} files, because compiled files load and run faster. If it
+finds that @file{@var{lib}.el} is newer than @file{@var{lib}.elc}, it
+issues a warning, in case someone made changes to the @file{.el} file
+and forgot to recompile it, but loads the @file{.elc} file anyway.
+(Due to this behavior, you can save unfinished edits to Emacs Lisp
+source files, and not recompile until your changes are ready for use.)
+If you set the option @code{load-prefer-newer} to a non-@code{nil}
+value, however, then rather than the procedure described above, Emacs
+loads whichever version of the file is newest. If Emacs was built
+with native compilation, and it cannot find the @samp{.eln} file
+corresponding to @file{@var{lib}.el}, it will load a
+@file{@var{lib}.elc} and start native compilation of
+@file{@var{lib}.el} in the background, then load the @samp{.eln} file
+when it finishes compilation.
Emacs Lisp programs usually load Emacs Lisp files using the
@code{load} function. This is similar to @code{load-library}, but is
@@ -1604,6 +1612,11 @@ It is customary to put locally installed libraries in the
@code{load-path}, or in some subdirectory of @file{site-lisp}. This
way, you don't need to modify the default value of @code{load-path}.
+@vindex native-comp-eln-load-path
+ Similarly to @code{load-path}, the list of directories where Emacs
+looks for @file{*.eln} files with natively-compiled Lisp code is
+specified by the variable @code{native-comp-eln-load-path}.
+
@cindex autoload
Some commands are @dfn{autoloaded}; when you run them, Emacs
automatically loads the associated library first. For instance, the
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index cae8207990e..77c4e09c826 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -715,6 +715,10 @@ Otherwise, the command operates on the current file only.
Certain other Dired commands, such as @kbd{!} and the @samp{%}
commands, use the same conventions to decide which files to work on.
+ In addition to Dired commands described here, you can also invoke
+Version Control (VC) commands on one or more files shown in a Dired
+buffer. @xref{Version Control}.
+
@vindex dired-dwim-target
@cindex two directories (in Dired)
Commands which ask for a destination directory, such as those which
@@ -1655,11 +1659,11 @@ become available.
@findex image-dired-display-previous
With point in the thumbnail buffer, you can type @key{RET}
(@code{image-dired-display-this}) to display the image in another
-window. Use the arrow keys to move around in the thumbnail buffer.
-For easy browsing, use @key{SPC} (@code{image-dired-display-next}) to
-advance and display the next image. Typing @key{DEL}
-(@code{image-dired-display-previous}) backs up to the previous
-thumbnail and displays that instead.
+window. Use the standard Emacs movement key bindings or the arrow
+keys to move around in the thumbnail buffer. For easy browsing, use
+@key{SPC} (@code{image-dired-display-next}) to advance and display the
+next image. Typing @key{DEL} (@code{image-dired-display-previous})
+backs up to the previous thumbnail and displays that instead.
@vindex image-dired-external-viewer
Type @kbd{C-@key{RET}}
@@ -1669,9 +1673,19 @@ in an external viewer. You must first configure
You can delete images through Image-Dired also. Type @kbd{d}
(@code{image-dired-flag-thumb-original-file}) to flag the image file
-for deletion in the Dired buffer. You can also delete the thumbnail
-image from the thumbnail buffer with @kbd{C-d}
-(@code{image-dired-delete-char}).
+for deletion in the Dired buffer. Alternatively, you can remove an
+image's thumbnail from the thumbnail buffer without flagging the image
+for deletion, by typing @kbd{C-d} (@code{image-dired-delete-char}).
+
+@findex image-dired-dired-toggle-marked-thumbs
+@findex image-dired-dired-display-external
+@findex image-dired-dired-display-image
+ You could also use Image-Dired for ``inline'' operations (i.e.,
+right into the Dired buffer). Type @kbd{C-t C-t}, and the thumbnails
+of the selected images in Dired will appear in front of their names
+(@code{image-dired-dired-toggle-marked-thumbs}). @kbd{C-t i} and
+@kbd{C-t x} will display the image under the point in Emacs or with
+the external viewer, respectively.
More advanced features include @dfn{image tags}, which are metadata
used to categorize image files. The tags are stored in a plain text
@@ -1684,14 +1698,18 @@ in the minibuffer. To mark files having a certain tag,
type @kbd{C-t f}
(@code{image-dired-mark-tagged-files}). After marking image files
with a certain tag, you can use @kbd{C-t d} to view them.
+@findex image-dired-dired-comment-files
+@findex image-dired-dired-edit-comment-and-tags
You can also tag a file directly from the thumbnail buffer by typing
-@kbd{t t} and you can remove a tag by typing @kbd{t r}. There is also
-a special tag called ``comment'' for each file (it is not a tag in
-the exact same sense as the other tags, it is handled slightly
-differently). That is used to enter a comment or description about the
-image. You comment a file from the thumbnail buffer by typing
+@kbd{t t}, and you can remove a tag by typing @kbd{t r}. There is
+also a special tag called ``comment'' for each file (it is not a tag
+in the exact same sense as the other tags, it is handled slightly
+differently). That is used to enter a comment or description about
+the image. You comment a file from the thumbnail buffer by typing
@kbd{c}. You will be prompted for a comment. Type @kbd{C-t c} to add
a comment from Dired (@code{image-dired-dired-comment-files}).
+@kbd{C-t e} will bring a buffer to edit comment and tags
+(@code{image-dired-dired-edit-comment-and-tags}).
@vindex image-dired-thumb-visible-marks
Files that are marked in Dired will also be marked in Image-Dired if
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 97732b65e32..7ec843180b8 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1159,11 +1159,11 @@ function definitions.
This level adds fontification of keywords, strings, and data types.
@item Level 3
This is the default level; it adds fontification of assignments,
-numbers, properties, etc.
+numbers, etc.
@item Level 4
This level adds everything else that can be fontified: operators,
delimiters, brackets, other punctuation, function names in function
-calls, variables, etc.
+calls, property look ups, variables, etc.
@end table
@vindex treesit-font-lock-feature-list
@@ -1402,7 +1402,11 @@ right-to-left paragraphs.
functionality especially in @code{prog-mode} and its descendants
(@pxref{Major Modes}) to indicate the position of a specific column
that has some special meaning for formatting the source code of a
-program.
+program. This assumes the buffer uses a fixed-pitch font, where all
+the characters (with the possible exception of double-width
+characters) have the same width on display. If the buffer uses
+variable-pitch fonts, the fill-column indicators on different lines
+might appear unaligned.
To activate the fill-column indication display, use the minor modes
@code{display-fill-@-column-indicator-mode} and
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 664b9d5d9a3..a9ae4696a06 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -1737,9 +1737,13 @@ only the hunks within the region.
Re-generate the current hunk (@code{diff-refresh-hunk}).
@item C-c C-w
+@vindex diff-ignore-whitespace-switches
@findex diff-ignore-whitespace-hunk
-Re-generate the current hunk, disregarding changes in whitespace
-(@code{diff-ignore-whitespace-hunk}).
+Re-generate the current hunk, disregarding changes in whitespace.
+With a non-@code{nil} prefix arg, re-generate all the hunks
+(@code{diff-ignore-whitespace-hunk}). This calls @code{diff-command}
+with @code{diff-ignore-whitespace-switches}, which defaults to
+@samp{-b}, meaning ignore changes in whitespace only.
@item C-x 4 A
@findex diff-add-change-log-entries-other-window
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 5191bb2918d..f5bbc4d65c0 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -94,6 +94,20 @@ is useful when you perform version control commands outside
Emacs
different version control system, or remove it from version control
entirely.
+@cindex VC commands, in Dired buffers
+@cindex filesets, VC, in Dired buffers
+ VC is also enabled automatically in Dired buffers (@pxref{Dired})
+showing directories whose files are controlled by a VCS@. All VC
+commands described in this section can be invoked from any Dired
+buffer showing a directory with VC-controlled files; any files that
+are marked in a Dired buffer (@pxref{Marks vs Flags}) are considered
+to belong to the current fileset, and VC commands operate on the files
+in this fileset. This allows you to construct VC filesets including
+any files you want, regardless of their VC state. (If no files are
+marked when a VC command is invoked from a Dired buffer, the file
+shown on the current line in the buffer is considered the only file in
+the fileset.)
+
@menu
* Introduction to VC:: How version control works in general.
* VC Mode Line:: How the mode line shows version control status.
@@ -471,7 +485,10 @@ collection of one or more files that a VC operation acts
on. When you
type VC commands in a buffer visiting a version-controlled file, the
VC fileset is simply that one file. When you type them in a VC
Directory buffer, and some files in it are marked, the VC fileset
-consists of the marked files (@pxref{VC Directory Mode}).
+consists of the marked files (@pxref{VC Directory Mode}). Likewise,
+when you invoke a VC command from a Dired buffer, the VC fileset
+consists of the marked files (@pxref{Marks vs Flags}), defaulting to
+the file shown on the current line if no files are marked.
On modern changeset-based version control systems (@pxref{VCS
Changesets}), VC commands handle multi-file VC filesets as a group.
@@ -495,7 +512,9 @@ action on the current VC fileset: either registering it
with a version
control system, or committing it, or unlocking it, or merging changes
into it. The precise actions are described in detail in the following
subsections. You can use @kbd{C-x v v} either in a file-visiting
-buffer, in a Dired buffer, or in a VC Directory buffer.
+buffer, in a Dired buffer, or in a VC Directory buffer; in the latter
+two cases the command operates on the fileset consisting of the marked
+files.
Note that VC filesets are distinct from the named filesets used
for viewing and visiting files in functional groups
@@ -840,7 +859,7 @@ details.
If you invoke @kbd{C-x v =} or @kbd{C-u C-x v =} from a Dired buffer
(@pxref{Dired}), the file listed on the current line is treated as the
-current VC fileset.
+current VC fileset. The VC fileset can also include several marked files.
@ifnottex
@findex vc-ediff
@@ -1000,16 +1019,25 @@ Search the change history for a specified pattern.
@findex vc-print-log
@kbd{C-x v l} (@code{vc-print-log}) displays a buffer named
@file{*vc-change-log*}, showing the history of changes made to the
-current file, including who made the changes, the dates, and the log
-entry for each change (these are the same log entries you would enter
-via the @file{*vc-log*} buffer; @pxref{Log Buffer}). Point is
-centered at the revision of the file currently being visited. With a
-prefix argument, the command prompts for the revision to center on,
-and the maximum number of revisions to display.
-
- If you call @kbd{C-x v l} from a VC Directory buffer (@pxref{VC
-Directory Mode}) or a Dired buffer (@pxref{Dired}), it applies to the
-file listed on the current line.
+current fileset in the long form, including who made the changes, the
+dates, and the log entry for each change (these are the same log
+entries you would enter via the @file{*vc-log*} buffer; @pxref{Log
+Buffer}). When invoked from a buffer visiting a file, the current
+fileset consists of that single file, and point in the displayed
+@file{*vc-change-log*} buffer is centered at the revision of that
+file. When invoked from a VC Directory buffer (@pxref{VC Directory
+Mode}) or from a Dired buffer (@pxref{Dired}), the fileset consists of
+all the marked files, defaulting to the file shown on the current line
+in the directory buffer if no file is marked.
+
+ If the fileset includes one or more directories, the resulting
+@file{*vc-change-log*} buffer shows a short log of changes (one line
+for each change), if the VC backend supports that; otherwise it shows
+the log in the long form.
+
+ With a prefix argument, the command prompts for the revision to
+center on in the @file{*vc-change-log*} buffer and for the maximum
+number of revisions to display.
@kindex C-x v L
@findex vc-print-root-log
@@ -1215,6 +1243,11 @@ called PCL-CVS which is specialized for CVS@.
@xref{Top, , About
PCL-CVS, pcl-cvs, PCL-CVS---The Emacs Front-End to CVS}.
@end ifnottex
+ You can also invoke VC commands from Dired buffers (@pxref{Dired}).
+In that case, any VC command you invoke considers the marked files as
+the current fileset (@pxref{Basic VC Editing}), defaulting to the file
+on the current line if no files are marked.
+
@menu
* Buffer: VC Directory Buffer. What the buffer looks like and means.
* Commands: VC Directory Commands. Commands to use in a VC directory buffer.
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index a5e1689b6c7..37da6b5956d 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -2745,10 +2745,12 @@ desktop reloading, since it bypasses the init file,
where
@findex desktop-revert
You can have separate saved desktop configurations in different
directories; starting Emacs from a directory where you have a saved
-desktop configuration will restore that configuration. You can save
-the current desktop and reload the one saved in another directory by
-typing @kbd{M-x desktop-change-dir}. Typing @kbd{M-x desktop-revert}
-reverts to the previously reloaded desktop.
+desktop configuration will restore that configuration, provided that
+you customize @code{desktop-path} to prepend @file{.} (the current
+directory) to the other directories there. You can save the current
+desktop and reload the one saved in another directory by typing
+@kbd{M-x desktop-change-dir}. Typing @kbd{M-x desktop-revert} reverts
+to the previously reloaded desktop.
@vindex desktop-load-locked-desktop
The file in which Emacs saves the desktop is locked while the
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index 0e4b15fb514..d2f96af0b55 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -473,9 +473,12 @@ specify which mode you prefer.
If you have changed the major mode of a buffer, you can return to
the major mode Emacs would have chosen automatically, by typing
@kbd{M-x normal-mode}. This is the same function that
-@code{find-file} calls to choose the major mode. It also processes
-the file's @samp{-*-} line or local variables list (if any).
-@xref{File Variables}.
+@code{find-file} calls to choose the major mode. If the buffer is
+visiting a file, this command also processes the file's @samp{-*-}
+line and file-local variables list (if any). @xref{File Variables}.
+If the buffer doesn't visit a file, the command processes only the
+major mode specification, if any, in the @samp{-*-} line and in the
+file-local variables list.
@vindex change-major-mode-with-file-name
The commands @kbd{C-x C-w} and @code{set-visited-file-name} change to
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index d983c2b59c6..62df88a731e 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -619,15 +619,18 @@ declaration (@code{c-indent-defun} in CC mode,
@kindex C-M-q @r{(C mode)}
@findex c-indent-exp
@findex prog-indent-sexp
-Reindent each line in the balanced expression that follows point. In
-CC mode, this invokes @code{c-indent-exp}; in tree-sitter based
-@code{c-ts-mode} this invokes a more general @code{prog-indent-sexp}.
-A prefix argument inhibits warning messages about invalid syntax.
+Reindent each line in the balanced expression (@pxref{Expressions}),
+also known as ``sexp'', that follows point. In CC mode, this invokes
+@code{c-indent-exp}; in tree-sitter based @code{c-ts-mode} this
+invokes a more general @code{prog-indent-sexp}. A prefix argument
+inhibits warning messages about invalid syntax.
@item @key{TAB}
@findex c-indent-line-or-region
Reindent the current line, active region, or block starting on this
-line (@code{c-indent-line-or-region}).
+line (@code{c-indent-line-or-region}). With prefix argument, rigidly
+reindent the balanced expression which starts on the current line, if
+the current line needs reindentation.
@vindex c-tab-always-indent
If @code{c-tab-always-indent} is @code{t}, this command always reindents
@@ -1384,6 +1387,12 @@ this, change the value of the variable
@code{Man-switches} to
@kbd{M-p} to switch between man pages in different sections. The mode
line shows how many manual pages are available.
+@vindex Man-prefer-synchronous-call
+ By default, @kbd{M-x man} calls the @code{man} program
+asynchronously. You can force the invocation to be synchronous by
+customizing @code{Man-prefer-synchronous-calls} to a non-@code{nil}
+value.
+
@findex woman
@cindex manual pages, on MS-DOS/MS-Windows
An alternative way of reading manual pages is the @kbd{M-x woman}
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 18f2274cfa6..3d3f2562617 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -623,7 +623,12 @@ variable @code{fill-column}. The default value
(@pxref{Locals}) is
is to use the command @kbd{C-x f} (@code{set-fill-column}). With a
numeric argument, it uses that as the new fill column. With just
@kbd{C-u} as argument, it sets @code{fill-column} to the current
-horizontal position of point.
+horizontal position of point. Note that, by its very nature,
+@code{fill-column} is measured in column units; the actual position of
+that column on a graphical display depends on the font being used. In
+particular, using variable-pitch fonts will cause the
+@code{fill-column} occupy different horizontal positions on display in
+different lines.
@cindex centering
@findex center-line
diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index 22b415613cb..3785e565676 100644
--- a/doc/emacs/vc1-xtra.texi
+++ b/doc/emacs/vc1-xtra.texi
@@ -288,16 +288,16 @@ is about to run.
@findex vc-prepare-patch
When collaborating on projects it is common to send patches via email,
-to share changes. If you wish to do this using VC, you can use the
+to share changes. You can do this using VC with the
@code{vc-prepare-patch} command. This will prompt you for the
revisions you wish to share, and which destination email address(es)
-to use. The revisions are separated using commas (or whatever was
-configured by @var{crm-separator}). The command will then prepare
+to use. Separate the revisions using the value of
+@var{crm-separator}, commas by default. The command will then prepare
those revisions using your @abbr{MUA, Mail User Agent} for you to
review and send.
When invoked interactively in a Log View buffer with marked revisions,
-these revisions will be used.
+those marked revisions will be used.
@vindex vc-prepare-patches-separately
Depending on the value of the user option
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index 239b5b2956b..e4abdef76be 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -310,8 +310,8 @@ the space that it occupied is given to an adjacent window
(but not the
minibuffer window, even if that is active at the time). Deleting the
window has no effect on the buffer it used to display; the buffer
continues to exist, and you can still switch to it with @kbd{C-x b}.
-The option @code{delete-window-choose-selected} allows to choose which
-window becomes the new selected window instead (@pxref{Deleting
+The option @code{delete-window-choose-selected} controls which
+window is chosen as the new selected window instead (@pxref{Deleting
Windows,,, elisp, The Emacs Lisp Reference Manual}).
@findex kill-buffer-and-window
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index dc78adc4520..20be706bebd 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -99,6 +99,12 @@ is removed from the hook.
emacs, The GNU Emacs Manual}) runs these two hooks just as a keyboard
command does.
+ Note that, when the buffer text includes very long lines, these two
+hooks are called as if they were in a @code{with-restriction} form
+(@pxref{Narrowing}), with a
+@code{long-line-optimizations-in-command-hooks} label and with the
+buffer narrowed to a portion around point.
+
@node Defining Commands
@section Defining Commands
@cindex defining commands
@@ -319,10 +325,10 @@ function @code{oclosure-interactive-form}.
@defun oclosure-interactive-form function
Just like @code{interactive-form}, this function takes a command and
returns its interactive form. The difference is that it is a generic
-function and it is only called when @var{function} is an OClosure.
-The purpose is to make it possible for some OClosure types to compute
-their interactive forms dynamically instead of carrying it in one of
-their slots.
+function and it is only called when @var{function} is an OClosure
+(@pxref{OClosures}). The purpose is to make it possible for some
+OClosure types to compute their interactive forms dynamically instead
+of carrying it in one of their slots.
This is used for example for @code{kmacro} functions in order to
reduce their memory size, since they all share the same interactive
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index be2125a9ab3..6ae6755ad76 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -849,7 +849,12 @@ from writing its results, the @file{*.eln} files, into a
subdirectory
of @code{user-emacs-directory} (@pxref{Init File}). You can do that
by either changing the value of @code{native-comp-eln-load-path}
(@pxref{Native-Compilation Variables}) or by temporarily pointing the
-@env{HOME} environment variable to a non-existing directory.
+@env{HOME} environment variable to a non-existing directory. Note
+that the latter technique might still produce a small number of
+@file{*.eln} files if Emacs needs to generate @dfn{trampolines}, which
+are used if Lisp primitives are advised or redefined in your Lisp code
+that is being natively compiled. @xref{Native-Compilation Variables,
+trampolines}.
@menu
* Native-Compilation Functions:: Functions to natively-compile Lisp.
@@ -981,24 +986,6 @@ whether native-compilation is available should use this
predicate.
This section documents the variables that control
native-compilation.
-@defvar inhibit-automatic-native-compilation
-If your Emacs has support for native compilation, Emacs will (by
-default) compile the Lisp files you're loading in the background, and
-then install the native-compiled versions of the functions. If you
-wish to disable this, you can set this variable to non-@code{nil}. If
-you want to set it permanently, this should probably be done from the
-early init file, since setting it in the normal init file is probably
-too late.
-
-While setting this variable disables automatic compilation of Lisp
-files, the compiler may still be invoked to install @dfn{trampolines}
-if any built-in functions are redefined. However, these trampolines
-will not get written to your cache directory.
-
-You can also use the @samp{EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION}
-environment variable to disable native compilation.
-@end defvar
-
@defopt native-comp-speed
This variable specifies the optimization level for native compilation.
Its value should be a number between @minus{}1 and 3. Values between
@@ -1093,3 +1080,66 @@ The directories in this list are also used for writing
the
specifically, Emacs will write these files into the first writable
directory in the list. Thus, you can control where native-compilation
stores the results by changing the value of this variable.
+
+@cindex disable asynchronous native compilation
+@cindex inhibit asynchronous native compilation
+@cindex asynchronous native compilation, disable
+@defvar native-comp-jit-compilation
+This variable, if non-@code{nil}, enables asynchronous (a.k.a.@:
+@dfn{just-in-time}, or @acronym{JIT}) native compilation of the
+@file{*.elc} files loaded by Emacs for which the corresponding
+@file{*.eln} files do not already exist. This JIT compilation uses
+separate Emacs sub-processes running in batch mode, according to the
+value of @code{native-comp-async-jobs-number}. When the JIT
+compilation of a Lisp file finishes successfully, the resulting
+@file{.eln} file is loaded and its code replaces the definition of
+functions provided by the @file{.elc} file.
+@end defvar
+
+@cindex trampolines, in native compilation
+ Setting the value of @code{native-comp-jit-compilation} to@code{nil}
+disables JIT native compilation. However, even when JIT native
+compilation is disabled, Emacs might still need to start asynchronous
+native compilation subprocesses to produce @dfn{trampolines}. To
+control this, use a separate variable, described below.
+
+@defvar native-comp-enable-subr-trampolines
+This variable controls generation of trampolines. A trampoline is a
+small piece of native code required to allow calling Lisp primitives,
+which were advised or redefined, from Lisp code that was
+natively-compiled with @code{native-comp-speed} set to 2 or greater.
+Emacs stores the generated trampolines on separate @file{*.eln} files.
+By default, this variable's value is @code{t}, which enables the
+generation of trampoline files; setting it to @code{nil} disables the
+generation of trampolines. Note that if a trampoline needed for
+advising or redefining a primitive is not available and cannot be
+generated, calls to that primitive from natively-compiled Lisp will
+ignore redefinitions and advices, and will behave as if the primitive
+was called directly from C. Therefore, we don't recommend disabling
+the trampoline generation, unless you know that all the trampolines
+needed by your Lisp programs are already compiled and accessible to
+Emacs.
+
+The value of this variable can also be a string, in which case it
+specifies the name of a directory in which to store the generated
+trampoline @file{*.eln} files, overriding the directories in
+@code{native-comp-eln-load-path}. This is useful if you want the
+trampolines to be generated as needed, but don't want to store them
+under the user's @env{HOME} directory or in the other public
+directories where @file{*.eln} files are kept. However, unlike with
+directories in @code{native-comp-eln-load-path}, the trampolines will
+be stored in the directory given by the value of this variable, not in
+its version-specific subdirectory. If the name of this directory is
+not absolute, it is interpreted relative to
+@code{invocation-directory} (@pxref{System Environment})
+
+If this variable is non-@code{nil}, and Emacs needs to produce a
+trampoline, but it cannot find any writable directory to store the
+trampoline, it will store it inside @code{temporary-file-directory}
+(@pxref{Unique File Names}).
+
+Trampolines produced when no writable directory is found to store
+them, or when this variable is a string, will only be available for
+the duration of the current Emacs session, because Emacs doesn't look
+for trampolines in either of these places.
+@end defvar
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 5a9a9f95f7b..a8311f5c9a2 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -3501,11 +3501,11 @@ function finishes are the ones that really matter.
For efficiency, we recommend writing these functions so that they
usually assign faces to around 400 to 600 characters at each call.
-When the buffer text includes very long lines, these functions are
-called with the buffer narrowed to a relatively small region around
-@var{pos}, and with narrowing locked, so the functions cannot use
-@code{widen} to gain access to the rest of the buffer.
-@xref{Narrowing}.
+Note that, when the buffer text includes very long lines, these
+functions are called as if they were in a @code{with-restriction} form
+(@pxref{Narrowing}), with a
+@code{long-line-optimizations-in-fontification-functions} label and
+with the buffer narrowed to a portion around @var{pos}.
@end defvar
@node Basic Faces
@@ -5285,9 +5285,10 @@ space taken by the line-number display.
The @code{left}, @code{center}, and @code{right} positions can be
used with @code{:align-to} to specify a position relative to the left
edge, center, or right edge of the text area. When the window
-displays line numbers, the @code{left} and the @code{center} positions
-are offset to account for the screen space taken by the line-number
-display.
+displays line numbers, and @code{:align-to} is used in display
+properties of buffer text (as opposed to header line, see below), the
+@code{left} and the @code{center} positions are offset to account for
+the screen space taken by the line-number display.
Any of the above window elements (except @code{text}) can also be
used with @code{:align-to} to specify that the position is relative to
@@ -5301,11 +5302,11 @@ the left-margin, use
:align-to (+ left-margin (0.5 . left-margin))
@end example
- If no specific base offset is set for alignment, it is always relative
-to the left edge of the text area. For example, @samp{:align-to 0} in a
-header-line aligns with the first text column in the text area. When
-the window displays line numbers, the text is considered to start where
-the space used for line-number display ends.
+ If no specific base offset is set for alignment, it is always
+relative to the left edge of the text area. For example,
+@samp{:align-to 0} aligns with the first text column in the text area.
+When the window displays line numbers, the text is considered to start
+where the space used for line-number display ends.
A value of the form @code{(@var{num} . @var{expr})} stands for the
product of the values of @var{num} and @var{expr}. For example,
@@ -5317,6 +5318,35 @@ product of the values of @var{num} and @var{expr}. For
example,
expressions. The form @code{(- @var{expr} ...)} negates or subtracts
the value of the expressions.
+@vindex header-line-format@r{, and } :align-to
+@cindex aligning header line, when line numbers are displayed
+@cindex header line alignment when line numbers are displayed
+ Text shown in the header line that uses @code{:align-to} display
+specifications is not automatically realigned when
+@code{display-line-numbers-mode} is turned on and off, or when the
+width of line numbers on display changes. To arrange for the
+header-line text alignment to be updated, thus keeping the header-line
+text aligned with the buffer text, turn on the
+@code{header-line-indent-mode} in the buffer and use its two
+variables, @code{header-line-indent} and
+@code{header-line-indent-width}, in the display specification.
+@xref{Header Lines}. Here's a simple example:
+
+@lisp
+(setq header-line-format
+ (concat (propertize " "
+ 'display
+ '(space :align-to
+ (+ header-line-indent-width 10)))
+ "Column"))
+@end lisp
+
+@noindent
+This will keep the text @samp{Column} on the header line aligned with
+column 10 of buffer text, regardless of whether
+@code{display-line-numbers-mode} is on or off, and also when
+line-number display changes its width.
+
@node Other Display Specs
@subsection Other Display Specifications
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index c7dc330441f..a1d7b51b609 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -569,6 +569,7 @@ Functions
* Function Cells:: Accessing or setting the function definition
of a symbol.
* Closures:: Functions that enclose a lexical environment.
+* OClosures:: Function objects with meta-data.
* Advising Functions:: Adding to the definition of a function.
* Obsolete Functions:: Declaring functions obsolete.
* Inline Functions:: Defining functions that the compiler
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 88e899de1e8..a45517287b7 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -252,11 +252,8 @@ the original symbol. If the contents are another symbol,
this
process, called @dfn{symbol function indirection}, is repeated until
it obtains a non-symbol. @xref{Function Names}, for more information
about symbol function indirection.
-
- One possible consequence of this process is an infinite loop, in the
-event that a symbol's function cell refers to the same symbol.
-Otherwise, we eventually obtain a non-symbol, which ought to be a
-function or other suitable object.
+We eventually obtain a non-symbol, which ought to be a function or
+other suitable object.
@kindex invalid-function
More precisely, we should now have a Lisp function (a lambda
@@ -332,19 +329,17 @@ or just
The built-in function @code{indirect-function} provides an easy way to
perform symbol function indirection explicitly.
-@defun indirect-function function &optional noerror
+@defun indirect-function function
@anchor{Definition of indirect-function}
This function returns the meaning of @var{function} as a function. If
@var{function} is a symbol, then it finds @var{function}'s function
definition and starts over with that value. If @var{function} is not a
symbol, then it returns @var{function} itself.
-This function returns @code{nil} if the final symbol is unbound. It
-signals a @code{cyclic-function-indirection} error if there is a loop
-in the chain of symbols.
+This function returns @code{nil} if the final symbol is unbound.
-The optional argument @var{noerror} is obsolete, kept for backward
-compatibility, and has no effect.
+There is also a second, optional argument that is obsolete and has no
+effect.
Here is how you could define @code{indirect-function} in Lisp:
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index ad01e0f2886..b15f2ab4d29 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -893,6 +893,12 @@ permissions of the file itself.)
If the file does not exist, or if there was trouble determining
whether the file exists, this function returns @code{nil}.
+@cindex empty file name, and @code{file-exists-p}
+Since a file name that is an empty string is interpreted relative to
+the current buffer's default directory (@pxref{Relative File Names}),
+calling @code{file-exists-p} with an argument that is an empty string
+will report about the buffer's default directory.
+
@cindex dangling symlinks, testing for existence
Directories are files, so @code{file-exists-p} can return @code{t}
when given a directory. However, because @code{file-exists-p} follows
@@ -1982,7 +1988,11 @@ all.
@defun file-modes-number-to-symbolic modes
This function converts a numeric file mode specification in
-@var{modes} into the equivalent symbolic form.
+@var{modes} into the equivalent string form. The string which this
+function returns is in the same format produced by the shell command
+@kbd{ls -l} and by @code{file-attributes}, @emph{not} the symbolic
+form accepted by @code{file-modes-symbolic-to-number} and the
+@command{chmod} shell command.
@end defun
@defun set-file-times filename &optional time flag
@@ -2352,6 +2362,10 @@ form.
@end example
@end defun
+@cindex empty file name
+ A file name that is an empty string stands for the current buffer's
+default directory.
+
@node Directory Names
@subsection Directory Names
@cindex directory name
@@ -2541,6 +2555,7 @@ This is for the sake of filesystems that have the concept
of a
superroot above the root directory @file{/}. On other filesystems,
@file{/../} is interpreted exactly the same as @file{/}.
+@cindex empty file names, and @code{expand-file-name}
Expanding @file{.} or the empty string returns the default directory:
@example
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 68f31e500bb..e0766ad0b43 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -1474,19 +1474,24 @@ in this frame. Its value is @code{color},
@code{grayscale} or
@vindex title@r{, a frame parameter}
@item title
-If a frame has a non-@code{nil} title, it appears in the window
+If a frame has a non-@code{nil} title, that title appears in the window
system's title bar at the top of the frame, and also in the mode line
of windows in that frame if @code{mode-line-frame-identification} uses
@samp{%F} (@pxref{%-Constructs}). This is normally the case when
Emacs is not using a window system, and can only display one frame at
-a time. @xref{Frame Titles}.
+a time. When Emacs is using a window system, this parameter, if
+non-@code{nil}, overrides the title determined by the @code{name}
+parameter and the implicit title calculated according to
+@code{frame-title-format}. It also overrides the title determined by
+@code{icon-title-format} for iconified frames. @xref{Frame Titles}.
@vindex name@r{, a frame parameter}
@item name
-The name of the frame. The frame name serves as a default for the frame
-title, if the @code{title} parameter is unspecified or @code{nil}. If
-you don't specify a name, Emacs sets the frame name automatically
-(@pxref{Frame Titles}).
+The name of the frame. If you don't specify a name via this
+parameter, Emacs sets the frame name automatically, as specified by
+@code{frame-title-format} and @code{icon-title-format}, and that is
+the frame's title that will appear on display when Emacs uses a window
+system (unless the @code{title} parameter overrides it).
If you specify the frame name explicitly when you create the frame, the
name is also used (instead of the name of the Emacs executable) when
@@ -2630,17 +2635,27 @@ frame name automatically based on a template stored in
the variable
frame is redisplayed.
@defvar frame-title-format
-This variable specifies how to compute a name for a frame when you have
-not explicitly specified one. The variable's value is actually a mode
+This variable specifies how to compute a name for a frame when you
+have not explicitly specified one (via the frame's parameters;
+@pxref{Basic Parameters}). The variable's value is actually a mode
line construct, just like @code{mode-line-format}, except that the
-@samp{%c}, @samp{%C}, and @samp{%l} constructs are ignored. @xref{Mode Line
-Data}.
+@samp{%c}, @samp{%C}, and @samp{%l} constructs are ignored.
+@xref{Mode Line Data}.
@end defvar
@defvar icon-title-format
-This variable specifies how to compute the name for an iconified frame,
-when you have not explicitly specified the frame title. This title
-appears in the icon itself.
+This variable specifies how to compute the name for an iconified frame
+when you have not explicitly specified the frame's name via the
+frame's parameters. The resulting title appears in the frame's icon
+itself. If the value is a string, is should be a mode line construct
+like that of @code{frame-title-format}. The value can also be
+@code{t}, which means to use @code{frame-title-format} instead; this
+avoids problems with some window managers and desktop environments,
+where a change in a frame's title (when a frame is iconified) is
+interpreted as a request to raise the frame and/or give it input
+focus. It is also useful if you want the frame's title to be the same
+no matter if the frame is iconified or not. The default value is a
+string identical to the default value of @code{frame-title-format}.
@end defvar
@defvar multiple-frames
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index f5572e447d3..e9841821431 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -22,7 +22,7 @@ define them.
* Function Cells:: Accessing or setting the function definition
of a symbol.
* Closures:: Functions that enclose a lexical environment.
-* OClosures:: Function objects
+* OClosures:: Function objects with meta-data.
* Advising Functions:: Adding to the definition of a function.
* Obsolete Functions:: Declaring functions obsolete.
* Inline Functions:: Functions that the compiler will expand inline.
@@ -737,9 +737,12 @@ explicitly in the source file being loaded. This is
because
By contrast, in programs that manipulate function definitions for other
purposes, it is better to use @code{fset}, which does not keep such
records. @xref{Function Cells}.
+
+If the resulting function definition chain would be circular, then
+Emacs will signal a @code{cyclic-function-indirection} error.
@end defun
-@defun function-alias-p object &optional noerror
+@defun function-alias-p object
Checks whether @var{object} is a function alias. If it is, it returns
a list of symbols representing the function alias chain, else
@code{nil}. For instance, if @code{a} is an alias for @code{b}, and
@@ -750,9 +753,8 @@ a list of symbols representing the function alias chain,
else
@result{} (b c)
@end example
-If there's a loop in the definitions, an error will be signaled. If
-@var{noerror} is non-@code{nil}, the non-looping parts of the chain is
-returned instead.
+There is also a second, optional argument that is obsolete and has no
+effect.
@end defun
You cannot create a new primitive function with @code{defun} or
@@ -1539,6 +1541,9 @@ is not a function, e.g., a keyboard macro
(@pxref{Keyboard Macros}):
If you wish to use @code{fset} to make an alternate name for a
function, consider using @code{defalias} instead. @xref{Definition of
defalias}.
+
+If the resulting function definition chain would be circular, then
+Emacs will signal a @code{cyclic-function-indirection} error.
@end defun
@node Closures
@@ -1581,56 +1586,69 @@ examining or altering the structure of closure objects.
@node OClosures
@section Open Closures
+@cindex oclosures
+@cindex open closures
-Traditionally, functions are opaque objects which offer no other
-functionality but to call them. Emacs Lisp functions aren't fully
+ Traditionally, functions are opaque objects which offer no other
+functionality but to call them. (Emacs Lisp functions aren't fully
opaque since you can extract some info out of them such as their
docstring, their arglist, or their interactive spec, but they are
-mostly opaque. This is usually what we want, but occasionally we need
-functions to expose a bit more information about themselves.
+still mostly opaque.) This is usually what we want, but occasionally
+we need functions to expose a bit more information about themselves.
-OClosures are functions which carry additional type information,
-and expose some information in the form of slots which you can access
+ @dfn{Open closures}, or @dfn{OClosures} for short, are function
+objects which carry additional type information and expose some
+information about themselves in the form of slots which you can access
via accessor functions.
-They are defined in two steps: first @code{oclosure-define} is used to
-define new OClosure types by specifying the slots carried by those
-OClosures, and then @code{oclosure-lambda} is used to create an
-OClosure object of a given type.
+ OClosures are defined in two steps: first you use
+@code{oclosure-define} to define a new OClosure type by specifying the
+slots carried by the OClosures of this type, and then you use
+@code{oclosure-lambda} to create an OClosure object of a given type.
+
+Let's say we want to define keyboard macros, i.e.@: interactive
+functions which re-execute a sequence of key events (@pxref{Keyboard
+Macros}). You could do it with a plain function as follows:
-Say we want to define keyboard macros, i.e. interactive functions
-which re-execute a sequence of key events. You could do it with
-a plain function as follows:
@example
(defun kbd-macro (key-sequence)
(lambda (&optional arg)
(interactive "P")
(execute-kbd-macro key-sequence arg)))
@end example
+
+@noindent
But with such a definition there is no easy way to extract the
@var{key-sequence} from that function, for example to print it.
We can solve this problem using OClosures as follows. First we define
the type of our keyboard macros (to which we decided to add
a @code{counter} slot while at it):
+
@example
(oclosure-define kbd-macro
"Keyboard macro."
keys (counter :mutable t))
@end example
+
+@noindent
After which we can rewrite our @code{kbd-macro} function:
+
@example
(defun kbd-macro (key-sequence)
(oclosure-lambda (kbd-macro (keys key-sequence) (counter 0))
(&optional arg)
- (interactive "p")
+ (interactive "P")
(execute-kbd-macro keys arg)
(setq counter (1+ counter))))
@end example
+
+@noindent
As you can see, the @code{keys} and @code{counter} slots of the
OClosure can be accessed as local variables from within the body
of the OClosure. But we can now also access them from outside of the
body of the OClosure, for example to describe a keyboard macro:
+
@example
(defun describe-kbd-macro (km)
(if (not (eq 'kbd-macro (oclosure-type km)))
@@ -1639,55 +1657,90 @@ body of the OClosure, for example to describe a
keyboard macro:
(counter (kbd-macro--counter km)))
(message "Keys=%S, called %d times" keys counter))))
@end example
+
+@noindent
Where @code{kbd-macro--keys} and @code{kbd-macro--counter} are
-accessor functions generated by the @code{oclosure-define} macro.
+accessor functions generated by the @code{oclosure-define} macro for
+oclosures whose type is @code{kbd-macro}.
-@defmac oclosure-define name &optional docstring &rest slots
+@defmac oclosure-define oname &optional docstring &rest slots
This macro defines a new OClosure type along with accessor functions
-for its slots. @var{name} can be a symbol (the name of
-the new type), or a list of the form @code{(@var{name} . @var{type-props})} in
-which case @var{type-props} is a list of additional properties.
-@var{slots} is a list of slot descriptions where each slot can be
-either a symbol (the name of the slot) or it can be of the form
-@code{(@var{slot-name} . @var{slot-props})} where @var{slot-props} is
-a property list.
-
-For each slot, the macro creates an accessor function named
-@code{@var{name}--@var{slot-name}}. By default slots are immutable.
-If you need a slot to be mutable, you need to specify it with the
-@code{:mutable} slot property, after which it can be mutated for
-example with @code{setf}.
-
-Beside slot accessors, the macro can create a predicate and
-functional update functions according to @var{type-props}:
-a @code{(:predicate @var{pred-name})} in the @var{type-props} causes
-the definition of a predicate function under the name @var{pred-name},
-and @code{(:copier @var{copier-name} @var{copier-arglist})} causes the
-definition of a functional update function which takes an OClosure of
-type @var{name} as first argument and returns a copy of it with the
-slots named in @var{copier-arglist} modified to the value passed in the
-corresponding argument.
+for its @var{slots}. @var{oname} can be a symbol (the name of the new
+type), or a list of the form
+@w{@code{(@var{oname} . @var{type-props})}}, in which case
+@var{type-props} is a list of additional properties of this oclosure
+type. @var{slots} is a list of slot descriptions where each slot can
+be either a symbol (the name of the slot) or it can be of the form
+@w{@code{(@var{slot-name} . @var{slot-props})}}, where
+@var{slot-props} is a property list of the corresponding slot
+@var{slot-name}.
+The OClosure type's properties specified by @var{type-props} can
+include the following:
+
+@table @code
+@item (:predicate @var{pred-name})
+This requests creation of a predicate function named @var{pred-name}.
+This function will be used to recognize OClosures of the type
+@var{oname}. If this type property is not specified,
+@code{oclosure-define} will generate a default name for the
+predicate.
+@item (:parent @var{otype})
+This makes type @var{otype} of OClosures be the parent of the type
+@var{oname}. The OClosures of type @var{oname} inherit the
+@var{slots} defined by their parent type.
+@c FIXME: Is the above description of :parent correct?
+@item (:copier @var{copier-name} @var{copier-args})
+This causes the definition of a functional update function, knows as
+the @dfn{copier}, which takes an OClosure of type @var{oname} as its
+first argument and returns a copy of it with the slots named in
+@var{copier-args} modified to contain the value passed in the
+corresponding argument in the actual call to @var{copier-name}.
+@end table
+
+For each slot in @var{slots}, the @code{oclosure-define} macro creates
+an accessor function named @code{@var{oname}--@var{slot-name}}; these
+can be used to access the values of the slots. The slot definitions
+in @var{slots} can specify the following properties of the slots:
+
+@table @code
+@item :mutable @var{val}
+By default, slots are immutable, but if you specify the
+@code{:mutable} property with a non-@code{nil} value, the slot can be
+mutated, for example with @code{setf} (@pxref{Setting Generalized
+Variables}).
+@c FIXME: Some rationale and meaning of immutable slot is probably in
+@c order here.
+@item :type @var{val-type}
+This specifies the type of the values expected to appear in the slot.
+@c FIXME: What will happen if the value is of a different type? error?
+@end table
@end defmac
@defmac oclosure-lambda (type . slots) arglist &rest body
-This macro creates an anonymous OClosure of type @var{type}.
-@var{slots} should be a list of elements of the form @code{(@var{slot-name}
-@var{exp})}.
-At run time, each @var{exp} is evaluated, in order, after which
-the OClosure is created with its slots initialized with the
-resulting values.
-
-When called as a function, the OClosure will accept arguments
-according to @var{arglist} and will execute the code in @var{body}.
-@var{body} can refer to the value of any of its slot directly as if it
-were a local variable that had been captured by static scoping.
+This macro creates an anonymous OClosure of type @var{type}, which
+should have been defined with @code{oclosure-define}. @var{slots}
+should be a list of elements of the form
+@w{@code{(@var{slot-name} @var{expr})}}. At run time, each @var{expr}
+is evaluated, in order, after which the OClosure is created with its
+slots initialized with the resulting values.
+
+When called as a function (@pxref{Calling Functions}), the OClosure
+created by this macro will accept arguments according to @var{arglist}
+and will execute the code in @var{body}. @var{body} can refer to the
+value of any of its slot directly as if it were a local variable that
+had been captured by static scoping.
@end defmac
@defun oclosure-type object
-This function returns the OClosure type (a symbol) of @var{object} if it is an
-OClosure, and @code{nil} otherwise.
+This function returns the OClosure type (a symbol) of @var{object} if
+it is an OClosure, and @code{nil} otherwise.
@end defun
+One other function related to OClosures is
+@code{oclosure-interactive-form}, which allows some types of OClosures
+to compute their interactive forms dynamically. @xref{Using
+Interactive, oclosure-interactive-form}.
+
@node Advising Functions
@section Advising Emacs Lisp Functions
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index deb1021283f..55f07e86f76 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -2553,7 +2553,7 @@ variable names have underscores replaced with dashes.
For instance,
@code{mode_line_format} stores the value of @code{mode-line-format}.
@item overlays
-The inveral tree containing this buffer's overlays.
+The interval tree containing this buffer's overlays.
@item last_selected_window
This is the last window that was selected with this buffer in it, or @code{nil}
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 44b7058e19d..3478049c84f 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -79,7 +79,10 @@ circular or dotted. If a program doesn't look far enough
down the
list to see the @sc{cdr} of the final cons cell, it won't care.
However, some functions that operate on lists demand proper lists and
signal errors if given a dotted list. Most functions that try to find
-the end of a list enter infinite loops if given a circular list.
+the end of a list enter infinite loops if given a circular list. You
+can use the function @code{proper-list-p}, described in the next
+section (@pxref{List-related Predicates, proper-list-p}), to determine
+whether a list is a proper one.
@cindex list structure
Because most cons cells are used as part of lists, we refer to any
@@ -702,7 +705,20 @@ same way.
Normally, when @var{tree} is anything other than a cons cell,
@code{copy-tree} simply returns @var{tree}. However, if @var{vecp} is
non-@code{nil}, it copies vectors too (and operates recursively on
-their elements).
+their elements). This function cannot cope with circular lists.
+@end defun
+
+@defun safe-copy-tree tree &optional vecp
+This function returns a copy of the tree @var{tree}. If @var{tree} is
+a cons cell, this make a new cons cell with the same @sc{car} and
+@sc{cdr}, then recursively copies the @sc{car} and @sc{cdr} in the
+same way.
+
+Normally, when @var{tree} is anything other than a cons cell,
+@code{copy-tree} simply returns @var{tree}. However, if @var{vecp} is
+non-@code{nil}, it copies vectors and records too (and operates
+recursively on their elements). This function handles circular lists
+and vectors, and is thus slower than @code{copy-tree} for typical cases.
@end defun
@defun flatten-tree tree
@@ -1914,6 +1930,11 @@ properties. Every symbol possesses a list of
properties, used to
record miscellaneous information about the symbol; these properties
are stored in the form of a property list. @xref{Symbol Properties}.
+@defun plistp object
+This predicate function returns non-@code{nil} if @var{object} is a
+valid property list.
+@end defun
+
@menu
* Plists and Alists:: Comparison of the advantages of property
lists and association lists.
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index dbbdc767738..5c84ba4b1eb 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -75,17 +75,20 @@ file exists, and Emacs was compiled with native-compilation
support
(@pxref{Native Compilation}), @code{load} attempts to find a
corresponding @samp{.eln} file, and if found, loads it instead of
@file{@var{filename}.elc}. Otherwise, it loads
-@file{@var{filename}.elc}. If there is no file by that name, then
-@code{load} looks for a file named @file{@var{filename}.el}. If that
-file exists, it is loaded. If Emacs was compiled with support for
-dynamic modules (@pxref{Dynamic Modules}), @code{load} next looks for
-a file named @file{@var{filename}.@var{ext}}, where @var{ext} is a
-system-dependent file-name extension of shared libraries. Finally, if
-neither of those names is found, @code{load} looks for a file named
-@var{filename} with nothing appended, and loads it if it exists. (The
-@code{load} function is not clever about looking at @var{filename}.
-In the perverse case of a file named @file{foo.el.el}, evaluation of
-@code{(load "foo.el")} will indeed find it.)
+@file{@var{filename}.elc} (and starts a background native compilation
+to produce the missing @samp{.eln} file, followed by loading that
+file). If there is no @file{@var{filename}.elc}, then @code{load}
+looks for a file named @file{@var{filename}.el}. If that file exists,
+it is loaded. If Emacs was compiled with support for dynamic modules
+(@pxref{Dynamic Modules}), @code{load} next looks for a file named
+@file{@var{filename}.@var{ext}}, where @var{ext} is a system-dependent
+file-name extension of shared libraries (@samp{.so} on GNU and Unix
+systems). Finally, if neither of those names is found, @code{load}
+looks for a file named @var{filename} with nothing appended, and loads
+it if it exists. (The @code{load} function is not clever about
+looking at @var{filename}. In the perverse case of a file named
+@file{foo.el.el}, evaluation of @code{(load "foo.el")} will indeed
+find it.)
If Auto Compression mode is enabled, as it is by default, then if
@code{load} can not find a file, it searches for a compressed version
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index fe5eb8a1b8d..fff1ea65b07 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -2578,21 +2578,70 @@ header line, for windows displaying the buffer. The
format of the value
is the same as for @code{mode-line-format} (@pxref{Mode Line Data}).
It is normally @code{nil}, so that ordinary buffers have no header
line.
+@end defvar
+
+If @code{display-line-numbers-mode} is turned on in a buffer
+(@pxref{Display Custom, display-line-numbers-mode,, emacs, The GNU
+Emacs Manual}), the buffer text is indented on display by the amount
+of screen space needed to show the line numbers. By contrast, text of
+the header line is not automatically indented, because a header line
+never displays a line number, and because the text of the header line
+is not necessarily directly related to buffer text below it. If a
+Lisp program needs the header-line text to be aligned with buffer text
+(for example, if the buffer displays columnar data, like
+@code{tabulated-list-mode} does, @pxref{Tabulated List Mode}), it
+should turn on the minor mode @code{header-line-indent-mode}.
+
+@deffn Command header-line-indent-mode
+This buffer-local minor mode tracks the changes of the width of the
+line-number display on screen (which may vary depending on the range
+of line numbers shown in the window), and allows Lisp programs to
+arrange that header-line text is always aligned with buffer text when
+the line-number width changes. Such Lisp programs should turn on this
+mode in the buffer, and use the variables @code{header-line-indent}
+and @code{header-line-indent-width} in the @code{header-line-format}
+to ensure it is adjusted to the text indentation at all times.
+@end deffn
-@findex header-line-indent-mode
-If @code{display-line-numbers-mode} is used, and you want the header
-line to be indented by the same amount as the buffer contents, you can
-use the @code{header-line-indent-mode} minor mode. This minor mode
-keeps the @code{header-line-indent} variable updated, so that you can
-say something like:
+@defvar header-line-indent
+This variable's value is a whitespace string whose width is kept equal
+to the current width of line-numbers on display, provided that
+@code{header-line-indent-mode} is turned on in the buffer shown in the
+window. The number of spaces is calculated under the assumption that
+the face of the header-line text uses the same font, including size,
+as the frame's default font; if that assumption is false, use
+@code{header-line-indent-width}, described below, instead. This
+variable is intended to be used in simple situations where the
+header-line text needs to be indented as a whole to be realigned with
+buffer text, by prepending this variable's value to the actual
+header-line text. For example, the following definition of
+@code{header-line-format}:
@lisp
(setq header-line-format
- `("" header-line-format ,my-header-line))
+ `("" header-line-indent ,my-header-line))
@end lisp
-This can be useful if you're displaying columnar data, and the header
-line should align with that data in the buffer.
+@noindent
+where @code{my-header-line} is the format string that produces the
+actual text of the header line, will make sure the header-line text
+is always indented like the buffer text below it.
+@end defvar
+
+@defvar header-line-indent-width
+This variable's value is kept updated to provide the current width, in
+units of the frame's canonical character width, used for displaying
+the line numbers, provided that @code{header-line-indent-mode} is
+turned on in the buffer shown in the window. It can be used for
+aligning the header-line text with the buffer text when
+@code{header-line-indent} is not flexible enough. For example, if the
+header line uses a font whose metrics is different from the default
+face's font, your Lisp program can calculate the width of line-number
+display in pixels, by multiplying the value of this variable by the
+value returned by @code{frame-char-width} (@pxref{Frame Font}), and
+then use the result to align header-line text using the
+@code{:align-to} display property spec (@pxref{Specified Space}) in
+pixels on the relevant parts of @code{header-line-frormat}.
@end defvar
@defun window-header-line-height &optional window
@@ -3630,10 +3679,20 @@ in C.
@vindex font-lock-function-name-face
for the name of a function being defined or declared.
+@item font-lock-function-call-face
+@vindex font-lock-function-call-face
+for the name of a function being called. This face inherits, by
+default, from @code{font-lock-function-name-face}.
+
@item font-lock-variable-name-face
@vindex font-lock-variable-name-face
for the name of a variable being defined or declared.
+@item font-lock-variable-use-face
+@vindex font-lock-variable-use-face
+for the name of a variable being referenced. This face inherits, by
+default, from @code{font-lock-variable-name-face}.
+
@item font-lock-keyword-face
@vindex font-lock-keyword-face
for a keyword with special syntactic significance, like @samp{for} and
@@ -3707,11 +3766,16 @@ for numbers.
@vindex font-lock-operator-face
for operators.
-@item font-lock-property-face
-@vindex font-lock-property-face
-for properties of an object, such as the declaration and use of fields
-in a struct.
-This face inherits, by default, from @code{font-lock-variable-name-face}.
+@item font-lock-property-name-face
+@vindex font-lock-property-name-face
+for properties of an object, such as the declaration of fields in a
+struct. This face inherits, by default, from
+@code{font-lock-variable-name-face}.
+
+@item font-lock-property-use-face
+@vindex font-lock-property-use-face
+for properties of an object, such as use of fields in a struct. This
+face inherits, by default, from @code{font-lock-property-name-face}.
For example,
@@ -5000,6 +5064,9 @@ first child where parent is @code{argument_list}, use
(match nil "argument_list" nil nil 0 0)
@end example
+In addition, @var{node-type} can be a special value @code{null},
+which matches when the value of @var{node} is @code{nil}.
+
@item n-p-gp
Short for ``node-parent-grandparent'', this matcher is a function of 3
arguments: @var{node-type}, @var{parent-type}, and
@@ -5029,7 +5096,15 @@ This anchor is a function that is called with 3
arguments: @var{node},
@item parent-bol
This anchor is a function that is called with 3 arguments: @var{node},
@var{parent}, and @var{bol}, and returns the first non-space character
-on the line of @var{parent}.
+on the line which @var{parent}'s start is on.
+
+@item parent-bol
+This anchor is a function that is called with 3 arguments: @var{node},
+@var{parent}, and @var{bol}. It finds the first ancestor node
+(parent, grandparent, etc) of @var{node} that starts on its own line,
+and return the start of that node. ``Starting on its own line'' means
+there is only whitespace character before the node on the line which
+the node's start is on.
@item prev-sibling
This anchor is a function that is called with 3 arguments: @var{node},
@@ -5045,10 +5120,10 @@ This anchor is a function that is called with 3
arguments: @var{node},
@var{parent}, and @var{bol}, and returns the first non-whitespace
character on the previous line.
-@item point-min
+@item column-0
This anchor is a function that is called with 3 arguments: @var{node},
-@var{parent}, and @var{bol}, and returns the beginning of the buffer.
-This is useful as the beginning of the buffer is always at column 0.
+@var{parent}, and @var{bol}, and returns the beginning of the current
+line, which is at column 0.
@item comment-start
This anchor is a function that is called with 3 arguments: @var{node},
@@ -5062,8 +5137,11 @@ This anchor is a function that is called with 3
arguments: @var{node},
@var{parent}, and @var{bol}. It tries to go to the beginning of the
previous non-empty line, and matches @code{adaptive-fill-regexp}. If
there is a match, this function returns the end of the match,
-otherwise it returns nil. This anchor is useful for a
-@code{indent-relative}-like indent behavior for block comments.
+otherwise it returns nil. However, if the current line begins with a
+prefix (e.g., ``-''), return the beginning of the prefix of the
+previous line instead, so that the two prefixes aligns. This anchor
+is useful for a @code{indent-relative}-like indent behavior for block
+comments.
@end ftable
@end defvar
diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi
index cebb59b6501..fd65fa3e75b 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -734,7 +734,7 @@ is non-@code{nil}, it looks for smallest named child.
@heading Searching for node
-@defun treesit-search-subtree node predicate &optional backward all limit
+@defun treesit-search-subtree node predicate &optional backward all depth
This function traverses the subtree of @var{node} (including
@var{node} itself), looking for a node for which @var{predicate}
returns non-@code{nil}. @var{predicate} is a regexp that is matched
@@ -745,9 +745,9 @@ the first node that matches, or @code{nil} if none does.
By default, this function only traverses named nodes, but if @var{all}
is non-@code{nil}, it traverses all the nodes. If @var{backward} is
non-@code{nil}, it traverses backwards (i.e., it visits the last child
-first when traversing down the tree). If @var{limit} is
+first when traversing down the tree). If @var{depth} is
non-@code{nil}, it must be a number that limits the tree traversal to
-that many levels down the tree. If @var{limit} is @code{nil}, it
+that many levels down the tree. If @var{depth} is @code{nil}, it
defaults to 1000.
@end defun
@@ -805,7 +805,7 @@ Arguments @var{predicate}, @var{backward} and @var{all} are
the same
as in @code{treesit-search-forward}.
@end defun
-@defun treesit-induce-sparse-tree root predicate &optional process-fn limit
+@defun treesit-induce-sparse-tree root predicate &optional process-fn depth
This function creates a sparse tree from @var{root}'s subtree.
It takes the subtree under @var{root}, and combs it so only the nodes
@@ -836,8 +836,8 @@ b 1 2 b | | b c d
If @var{process-fn} is non-@code{nil}, instead of returning the
matched nodes, this function passes each node to @var{process-fn} and
-uses the returned value instead. If non-@code{nil}, @var{limit} is
-the number of levels to go down from @var{root}. If @var{limit} is
+uses the returned value instead. If non-@code{nil}, @var{depth} is
+the number of levels to go down from @var{root}. If @var{depth} is
@code{nil}, it defaults to 1000.
Each node in the returned tree looks like
@@ -970,10 +970,15 @@ A node ``has error'' if the text it spans contains a
syntax error. It
can be that the node itself has an error, or one of its descendants
has an error.
+@cindex tree-sitter, live parsing node
+@cindex live node, tree-sitter
+A node is considered @dfn{live} if its parser is not deleted, and the
+buffer to which it belongs to is a live buffer (@pxref{Killing Buffers}).
+
@defun treesit-node-check node property
-This function checks if @var{node} has the specified @var{property}.
-@var{property} can be @code{named}, @code{missing}, @code{extra},
-@code{outdated}, or @code{has-error}.
+This function returns non-@code{nil} if @var{node} has the specified
+@var{property}. @var{property} can be @code{named}, @code{missing},
+@code{extra}, @code{outdated}, @code{has-error}, or @code{live}.
@end defun
@defun treesit-node-type node
@@ -1584,9 +1589,9 @@ ranges for @acronym{CSS} and JavaScript parsers:
@example
@group
;; Create parsers.
-(setq html (treesit-get-parser-create 'html))
-(setq css (treesit-get-parser-create 'css))
-(setq js (treesit-get-parser-create 'javascript))
+(setq html (treesit-parser-create 'html))
+(setq css (treesit-parser-create 'css))
+(setq js (treesit-parser-create 'javascript))
@end group
@group
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index 838877b6282..edc7c86533c 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -1071,11 +1071,13 @@ positions.
In an interactive call, @var{start} and @var{end} are set to the bounds
of the current region (point and the mark, with the smallest first).
-Note that, in rare circumstances, Emacs may decide to leave, for
-performance reasons, the accessible portion of the buffer unchanged
-after a call to @code{narrow-to-region}. This can happen when a Lisp
-program is called via low-level hooks, such as
-@code{jit-lock-functions}, @code{post-command-hook}, etc.
+However, when the narrowing has been set by @code{with-restriction} with
+a label argument (see below), @code{narrow-to-region} can be used only
+within the limits of that narrowing. If @var{start} or @var{end} are
+outside these limits, the corresponding limit set by
+@code{with-restriction} is used instead. To gain access to other
+portions of the buffer, use @code{without-restriction} with the same
+label.
@end deffn
@deffn Command narrow-to-page &optional move-count
@@ -1099,13 +1101,13 @@ It is equivalent to the following expression:
@example
(narrow-to-region 1 (1+ (buffer-size)))
@end example
-@end deffn
-Note that, in rare circumstances, Emacs may decide to leave, for
-performance reasons, the accessible portion of the buffer unchanged
-after a call to @code{widen}. This can happen when a Lisp program is
-called via low-level hooks, such as @code{jit-lock-functions},
-@code{post-command-hook}, etc.
+However, when a narrowing has been set by @code{with-restriction} with a
+label argument (see below), the limits set by @code{with-restriction}
+are restored, instead of canceling the narrowing. To gain access to
+other portions of the buffer, use @code{without-restriction} with the
+same label.
+@end deffn
@defun buffer-narrowed-p
This function returns non-@code{nil} if the buffer is narrowed, and
@@ -1120,6 +1122,9 @@ in effect. The state of narrowing is restored even in
the event of an
abnormal exit via @code{throw} or error (@pxref{Nonlocal Exits}).
Therefore, this construct is a clean way to narrow a buffer temporarily.
+This construct also saves and restores the narrowings that were set by
+@code{with-restriction} with a label argument (see below).
+
The value returned by @code{save-restriction} is that returned by the
last form in @var{body}, or @code{nil} if no body forms were given.
@@ -1169,3 +1174,64 @@ This is the contents of foo@point{}
@end group
@end example
@end defspec
+
+@defspec with-restriction start end [:label label] body
+This special form saves the current bounds of the accessible portion
+of the buffer, sets the accessible portion to start at @var{start} and
+end at @var{end}, evaluates the @var{body} forms, and restores the
+saved bounds. In that case it is equivalent to
+
+@example
+(save-restriction
+ (narrow-to-region start end)
+ body)
+@end example
+
+@cindex labeled narrowing
+When the optional argument @var{label}, a symbol, is present, the
+narrowing is @dfn{labeled}. A labeled narrowing differs from a
+non-labeled one in several ways:
+
+@itemize @bullet
+@item
+During the evaluation of the @var{body} form, @code{narrow-to-region}
+and @code{widen} can be used only within the @var{start} and @var{end}
+limits.
+
+@item
+To lift the restriction introduced by @code{with-restriction} and gain
+access to other portions of the buffer, use @code{without-restriction}
+with the same @var{label} argument. (Another way to gain access to
+other portions of the buffer is to use an indirect buffer
+(@pxref{Indirect Buffers}).)
+
+@item
+Labeled narrowings can be nested.
+
+@item
+Labeled narrowings can only be used in Lisp programs: they are never
+visible on display, and never interfere with narrowings set by the
+user.
+@end itemize
+
+If you use @code{with-restriction} with the optional @var{label}
+argument, we recommend documenting the @var{label} in the doc strings
+of the functions which use it, so that other Lisp programs your code
+calls could lift the labeled narrowing if and when it needs.
+@end defspec
+
+@defspec without-restriction [:label label] body
+This special form saves the current bounds of the accessible portion
+of the buffer, widens the buffer, evaluates the @var{body} forms, and
+restores the saved bounds. In that case it is equivalent to
+
+@example
+(save-restriction
+ (widen)
+ body)
+@end example
+
+When the optional argument @var{label} is present, the narrowing set
+by @code{with-restriction} with the same @var{label} argument is
+lifted.
+@end defspec
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 326c111cac5..0a48beab8b8 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4947,16 +4947,38 @@ computed for the whole of @var{object}.
If the argument @var{binary} is omitted or @code{nil}, the function
returns the @dfn{text form} of the hash, as an ordinary Lisp string.
If @var{binary} is non-@code{nil}, it returns the hash in @dfn{binary
-form}, as a sequence of bytes stored in a unibyte string.
+form}, as a sequence of bytes stored in a unibyte string. The length
+of the returned string depends on @var{algorithm}:
+
+@itemize
+@item
+For @code{md5}: 32 characters (32 bytes if @var{binary} is
+non-@code{nil}).
+@item
+For @code{sha1}: 40 characters (40 bytes if @var{binary} is
+non-@code{nil}).
+@item
+For @code{sha224}: 56 characters (56 bytes if @var{binary} is
+non-@code{nil}).
+@item
+For @code{sha256}: 64 characters (64 bytes if @var{binary} is
+non-@code{nil}).
+@item
+For @code{sha384}: 96 characters (96 bytes if @var{binary} is
+non-@code{nil}).
+@item
+For @code{sha512}: 128 characters (128 bytes if @var{binary} is
+non-@code{nil}).
+@end itemize
This function does not compute the hash directly from the internal
representation of @var{object}'s text (@pxref{Text Representations}).
Instead, it encodes the text using a coding system (@pxref{Coding
Systems}), and computes the hash from that encoded text. If
@var{object} is a buffer, the coding system used is the one which
-would be chosen by default for writing the text into a file. If
-@var{object} is a string, the user's preferred coding system is used
-(@pxref{Recognize Coding,,, emacs, GNU Emacs Manual}).
+would be chosen by default for writing the text of that buffer into a
+file. If @var{object} is a string, the user's preferred coding system
+is used (@pxref{Recognize Coding,,, emacs, GNU Emacs Manual}).
@end defun
@defun md5 object &optional start end coding-system noerror
@@ -4964,7 +4986,7 @@ This function returns an MD5 hash. It is semi-obsolete,
since for
most purposes it is equivalent to calling @code{secure-hash} with
@code{md5} as the @var{algorithm} argument. The @var{object},
@var{start} and @var{end} arguments have the same meanings as in
-@code{secure-hash}.
+@code{secure-hash}. The function returns a 32-character string.
If @var{coding-system} is non-@code{nil}, it specifies a coding system
to use to encode the text; if omitted or @code{nil}, the default
@@ -4987,7 +5009,20 @@ It should be somewhat more efficient on larger buffers
than
@code{secure-hash} is, and should not allocate more memory.
@c Note that we do not document what hashing function we're using, or
@c even whether it's a cryptographic hash, since that may change
-@c according to what we find useful.
+@c according to what we find useful. We also don't document the
+@c length of the hash string it returns, since that can be used to
+@c guess the hashing function being used.
+@end defun
+
+@defun sha1 object &optional start end binary
+This function is equivalent to calling @code{secure-hash} like this:
+
+@lisp
+(secure-hash 'sha1 object start end binary)
+@end lisp
+
+It returns a 40-character string if @var{binary} is @code{nil}, or a
+40-byte unibyte string otherwise.
@end defun
@node Suspicious Text
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 441e7f1b16d..01ac6fb901a 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -629,6 +629,12 @@ example, by calling @code{select-window} with argument
@var{norecord}
@code{nil}. Hence, this macro is the preferred way to temporarily work
with @var{window} as the selected window without needlessly running
@code{buffer-list-update-hook}.
+
+Note that this macro temporarily puts the window management code in an
+unstable state. In particular, the most recently used window (see below)
+will not necessarily match the selected one. Hence, functions like
+@code{get-lru-window} and @code{get-mru-window} may return unexpected
+results when called from the body of this macro.
@end defmac
@defmac with-selected-frame frame forms@dots{}
@@ -650,15 +656,17 @@ The @dfn{use time} of a window is not really a time
value, but an
integer that does increase monotonically with each call of
@code{select-window} with a @code{nil} @var{norecord} argument. The
window with the lowest use time is usually called the least recently
-used window while the window with the highest use time is called the
-most recently used one (@pxref{Cyclic Window Ordering}).
+used window. The window with the highest use time is called the most
+recently used one (@pxref{Cyclic Window Ordering}) and is usually the
+selected window unless @code{with-selected-window} has been used.
@end defun
@defun window-bump-use-time &optional window
-This function marks @var{window} as being the most recently used
-one. This can be useful when writing certain @code{pop-to-buffer}
-scenarios (@pxref{Switching Buffers}). @var{window} must be a live
-window and defaults to the selected one.
+This function marks @var{window} as being the second most recently
+used one (after the selected window). It does nothing if @var{window}
+is the selected window or the selected window does not have the
+highest use time among all windows which may happen within the scope
+of @code{with-selected-window}.
@end defun
@anchor{Window Group}Sometimes several windows collectively and
@@ -2755,14 +2763,40 @@ before.
@defun display-buffer-use-some-window buffer alist
This function tries to display @var{buffer} by choosing an existing
-window and displaying the buffer in that window. It can fail if all
-windows are dedicated to other buffers (@pxref{Dedicated Windows}).
+window and displaying the buffer in that window. It first tries to find
+a window that has not been used recently (@pxref{Cyclic Window
+Ordering}) on any frame specified by a @code{lru-frames} @var{alist}
+entry, falling back to the selected frame if no such entry exists. It
+also prefers windows that satisfy the constraints specified by
+@code{window-min-width} and @code{window-min-height} @var{alist}
+entries; preferring full-width windows if no @code{window-min-width}
+entry is found. Finally, it will not return a window whose use time is
+higher than that specified by any @code{lru-time} entry provided by
+@var{alist}.
+
+If no less recently used window is found, this function will try to use
+some other window, preferably a large window on some visible frame. It
+can fail if all windows are dedicated to other buffers (@pxref{Dedicated
+Windows}).
@end defun
@defun display-buffer-use-least-recent-window buffer alist
-This function is like @code{display-buffer-use-some-window}, but will
-not reuse the current window, and will use the least recently
-switched-to window.
+This function is similar to @code{display-buffer-use-some-window}, but
+will try harder to not use the a recently used window. In particular,
+it does not use the selected window. In addition, it will first try to
+reuse a window that shows @var{buffer} already, base the decision
+whether it should use a window showing another buffer on that window's
+use time alone and pop up a new window if no usable window is found.
+
+Finally, this function will bump the use time (@pxref{Selecting
+Windows}) of any window it returns in order to avoid that further
+invocations will use that window for showing another buffer. An
+application that wants to display several buffers in a row can help this
+function by providing a @code{lru-time} @var{alist} entry it has
+initially set to the value of the selected window's use time. Each
+invocation of this function will then bump the use time of the window
+returned to a value higher than that and a subsequent invocation will
+inhibit this function to use a window it returned earlier.
@end defun
@defun display-buffer-in-direction buffer alist
@@ -3032,12 +3066,40 @@ The value specifies an alist of window parameters to
give the chosen
window. All action functions that choose a window should process this
entry.
+@vindex window-min-width@r{, a buffer display action alist entry}
+@item window-min-width
+The value specifies a minimum width of the window used, in canonical
+frame columns. The special value @code{full-width} means the chosen
+window should be one that has no other windows on the left or right of
+it in its frame.
+
+This entry is currently honored by @code{display-buffer-use-some-window}
+and @code{display-buffer-use-least-recent-window}, which try hard to avoid
+returning a less recently used window that does not satisfy the entry.
+
+Note that providing such an entry alone does not necessarily make the
+window as wide as specified by its value. To actually resize an
+existing window or make a new window as wide as specified by this
+entry's value, a @code{window-width} entry specifying that value
+should be provided as well. Such a @code{window-width} entry can,
+however, specify a completely different value, or ask the window width
+to fit that of its buffer, in which case the
+@code{window-min-width} entry provides the guaranteed minimum width of
+the window.
+
@vindex window-min-height@r{, a buffer display action alist entry}
@item window-min-height
-The value specifies a minimum height of the window used, in lines. If
-a window is not or cannot be made as high as specified by this entry,
-the window is not considered for use. The only client of this entry
-is presently @code{display-buffer-below-selected}.
+The value specifies a minimum height of the window used, in canonical
+frame lines. The special value @code{full-height} means the chosen
+window should be a full-height window, one that has no other windows
+above or below it in its frame.
+
+This entry is currently honored by @code{display-buffer-below-selected}
+which does not use a window that is not as high as specified by this
+entry. It's also honored by @code{display-buffer-use-some-window} and
+@code{display-buffer-use-least-recent-window} which try hard to avoid
+returning a less recently used window if it does not satisfy this
+constraint.
Note that providing such an entry alone does not necessarily make the
window as tall as specified by its value. To actually resize an
@@ -3166,6 +3228,40 @@ preserve both, its width and its height. This entry
should be
processed only under certain conditions which are specified right
after this list.
+@vindex lru-frames@r{, a buffer display action alist entry}
+@item lru-frames
+The value specifies the set of frames to search for a window that can be
+used to display the buffer. It is honored by
+@code{display-buffer-use-some-window} and
+@code{display-buffer-use-least-recent-window} when trying to find a less
+recently used window showing some other buffer. Its values are the same
+as for the @code{reusable-frames} entry described above.
+
+@vindex lru-time@r{, a buffer display action alist entry}
+@item lru-time
+The value is supposed to specify a use time (@pxref{Selecting Windows}).
+This entry is honored by @code{display-buffer-use-some-window} and
+@code{display-buffer-use-least-recent-window} when trying to find a less
+recently used window showing some other buffer. If a window's use time
+is higher than the value specified by this option, these action
+functions will not consider such a window for displaying the buffer.
+
+@vindex bump-use-time@r{, a buffer display action alist entry}
+@item bump-use-time
+If non-@code{nil}, such an entry will cause @code{display-buffer} to
+bump the use time (@pxref{Selecting Windows}) of the window it uses.
+This should avoid later use of this window by action functions
+like @code{display-buffer-use-some-window} and
+@code{display-buffer-use-least-recent-window} for showing another
+buffer.
+
+There is a fine difference between using this entry and using the action
+function @code{display-buffer-use-least-recent-window}. Calling the
+latter means to only bump the use times of windows that function uses
+for displaying the buffer. The entry described here will cause
+@code{display-buffer} to bump the use time of @emph{any} window used for
+displaying a buffer.
+
@vindex pop-up-frame-parameters@r{, a buffer display action alist entry}
@item pop-up-frame-parameters
The value specifies an alist of frame parameters to give a new frame,
@@ -3321,13 +3417,6 @@ window has at least that many columns. If the value is
@code{nil},
that means not to split this way.
@end defopt
-@defopt display-buffer-avoid-small-windows
-If non-@code{nil}, this should be a number. Windows that have fewer
-lines than that will be avoided when choosing an existing window. The
-value is interpreted in units of the frame's canonical line height,
-like @code{window-total-height} does (@pxref{Window Sizes}).
-@end defopt
-
@defopt even-window-sizes
This variable, if non-@code{nil}, causes @code{display-buffer} to even
window sizes whenever it reuses an existing window, and that window is
@@ -3992,53 +4081,79 @@ related to the new window. For non-input related
actions
@code{display-buffer-below-selected} might be preferable because the
selected window usually already has the user's attention.
-@item Handle subsequent invocations of @code{display-buffer}
-@code{display-buffer} is not overly well suited for displaying several
-buffers in sequence and making sure that all these buffers are shown
-orderly in the resulting window configuration. Again, the standard
-action functions @code{display-buffer-pop-up-window} and
-@code{display-buffer-use-some-window} are not very suited for this
-purpose due to their somewhat chaotic nature in more complex
-configurations.
+@item Take care which window is selected
+Many applications call @code{display-buffer} from within window
+excursions produced by @code{with-selected-window} or
+@code{select-window} calls with a non-@code{nil} @var{norecord}
+argument. This is almost always a bad idea because the window selected
+within such an excursion is usually not the window selected in the
+configuration presented to the user.
+
+If, for example, a user had added an @code{inhibit-same-window} alist
+entry, that entry would have avoided the window selected within the
+scope of the excursion and not the window selected in the resulting
+configuration. Even if no such entry has been added, the resulting
+behavior might be strange. While in a frame containing one live
+window, evaluating the following form
- To produce a window configuration displaying multiple buffers (or
-different views of one and the same buffer) in one and the same
-display cycle, Lisp programmers will unavoidably have to write
-their own action functions. A few tricks listed below might help in
-this regard.
+@example
+@group
+(progn
+ (split-window)
+ (display-buffer "*Messages*"))
+@end group
+@end example
-@itemize @bullet
-@item
-Making windows atomic (@pxref{Atomic Windows}) avoids breaking an
-existing window composition when popping up a new window.
-The new window will pop up outside the composition instead.
+@noindent
+will display a window showing the @file{*Messages*} buffer at the bottom
+and leave the other window selected. Evaluating the next form
-@item
-Temporarily dedicating windows to their buffers (@pxref{Dedicated
-Windows}) avoids using a window for displaying a different
-buffer. A non-dedicated window will be used instead.
+@example
+@group
+(with-selected-window (split-window)
+ (display-buffer "*Messages*"))
+@end group
+@end example
-@item
-Calling @code{window-preserve-size} (@pxref{Preserving Window Sizes})
-will try to keep the size of the argument window unchanged when
-popping up a new window. You have to make sure that another window in
-the same combination can be shrunk instead, though.
+@noindent
+will display @file{*Messages*} in a window on the top and select it
+which is usually not what @code{display-buffer} is supposed to do.
-@item
-Side windows (@pxref{Side Windows}) can be used for displaying
-specific buffers always in a window at the same position of a frame.
-This permits grouping buffers that do not compete for being shown at
-the same time on a frame and showing any such buffer in the same window
-without disrupting the display of other buffers.
+On the other hand, while evaluating the following form
-@item
-Child frames (@pxref{Child Frames}) can be used to display a buffer
-within the screen estate of the selected frame without disrupting that
-frame's window configuration and without the overhead associated with
-full-fledged frames as inflicted by @code{display-buffer-pop-up-frame}.
-@end itemize
-@end table
+@example
+@group
+(progn
+ (split-window)
+ (pop-to-buffer "*Messages*"))
+@end group
+@end example
+@noindent
+will correctly select the @file{*Messages*} buffer, the next form
+
+@example
+@group
+(progn
+ (split-window)
+ (with-selected-window (selected-window)
+ (pop-to-buffer "*Messages*")))
+@end group
+@end example
+
+@noindent
+will not.
+
+Also, invocations of action functions like
+@code{display-buffer-use-some-window} and
+@code{display-buffer-use-least-recent-window} that expect the selected
+window to have the highest use time among all windows, may fail to
+produce a window according to their specifications.
+
+Hence, an application that relies on using a window excursion should try
+to postpone the @code{display-buffer} call until after the excursion has
+terminated.
+@end table
@node Window History
@section Window History
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 5424995534e..044c018080c 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -232,7 +232,8 @@ series of calculators, its many features include:
@itemize @bullet
@item
-Choice of algebraic or RPN (stack-based) entry of calculations.
+Choice of algebraic or Reverse Polish notation (RPN),
+i.e. stack-based, entry of calculations.
@item
Arbitrary precision integers and floating-point numbers.
@@ -421,8 +422,8 @@ difference between lower-case and upper-case letters.
Remember,
@key{RET}, @key{TAB}, @key{DEL}, and @key{SPC} are the Return, Tab,
Delete, and Space keys.
-@strong{RPN calculation.} In RPN, you type the input number(s) first,
-then the command to operate on the numbers.
+@strong{RPN calculation.} In Reverse Polish notation (RPN), you type
+the input number(s) first, then the command to operate on the numbers.
@noindent
Type @kbd{2 @key{RET} 3 + Q} to compute
@@ -1348,18 +1349,19 @@ to control various modes of the Calculator.
@subsection RPN Calculations and the Stack
@cindex RPN notation
+@cindex Reverse Polish notation
@noindent
@ifnottex
-Calc normally uses RPN notation. You may be familiar with the RPN
-system from Hewlett-Packard calculators, FORTH, or PostScript.
-(Reverse Polish Notation, RPN, is named after the Polish mathematician
-Jan Lukasiewicz.)
+Calc normally uses Reverse Polish notation (RPN). You may be familiar
+with the RPN system from Hewlett-Packard calculators, FORTH, or
+PostScript. (Reverse Polish Notation is named after the Polish
+mathematician Jan Lukasiewicz.)
@end ifnottex
@tex
-Calc normally uses RPN notation. You may be familiar with the RPN
-system from Hewlett-Packard calculators, FORTH, or PostScript.
-(Reverse Polish Notation, RPN, is named after the Polish mathematician
-Jan \L ukasiewicz.)
+Calc normally uses Reverse Polish notation (RPN). You may be familiar
+with the RPN system from Hewlett-Packard calculators, FORTH, or
+PostScript. (Reverse Polish Notation is named after the Polish
+mathematician Jan \L ukasiewicz.)
@end tex
The central component of an RPN calculator is the @dfn{stack}. A
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 396a4753842..4a8c863230f 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -847,6 +847,7 @@ in the Emacs development repository (@pxref{Latest version
of Emacs}).
@menu
* Origin of the term Emacs::
* Latest version of Emacs::
+* New in Emacs 29::
* New in Emacs 28::
* New in Emacs 27::
* New in Emacs 26::
@@ -919,6 +920,125 @@ Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}).
You can give
this command a prefix argument to read about which features were new
in older versions.
+@node New in Emacs 29
+@section What is different about Emacs 29?
+@cindex Differences between Emacs 28 and Emacs 29
+@cindex Emacs 29, new features in
+
+Here's a list of the most important changes in Emacs 29 as compared to
+Emacs 28 (the full list is too long, and can be read in the Emacs
+@file{NEWS} file by typing @kbd{C-h n} inside Emacs).
+
+@itemize
+@item
+Emacs can now be built with the
+@uref{https://tree-sitter.github.io/tree-sitter/, tree-sitter
+library}, which provides incremental parsing capabilities for several
+programming languages. Emacs comes with several major modes which use
+this library for syntax highlighting (a.k.a. ``fontification''),
+indentation, Imenu support, etc. These modes have names
+@code{@var{lang}-ts-mode}, where @var{lang} is the programming
+language. For example, @code{c-ts-mode}, @code{ruby-ts-mode}, etc.
+There are several new font-lock faces, such as
+@code{font-lock-number-face} and @code{font-lock-operator-face},
+intended to be used with these modes.
+
+@item
+Emacs can now be built in the PGTK (``pure GTK'') configuration, which
+supports running Emacs on window systems other than X, such as Wayland
+and Broadway.
+
+@item
+Emacs now has built-in support for accessing SQLite databases. This
+requires Emacs to be built with the optional @file{sqlite3} library.
+
+@item
+Emacs comes with the popular @code{use-package} package bundled.
+
+@item
+Emacs can now display WebP images, if it was built with the optional
+@file{libwebp} library.
+
+@item
+On X window system, Emacs now supports the XInput2 specification for
+input events.
+
+@item
+Emacs now comes with a client library for using Language Server
+Protocol (@acronym{LSP}) servers. This library, named @file{eglot.el}
+(the name stands for ``Emacs polyGlot'') provides LSP support for
+various software development and maintenance features, such as
+@code{xref}, Imenu, ElDoc, etc.
+
+@item
+Emacs can now cope with files with very long lines much better. It no
+longer hangs when displaying such long lines, and allows
+reasonably-responsive editing when such lines are present in the
+visible portion of a buffer.
+
+@item
+Emacs now supports the latest version 15.0 of the Unicode Standard.
+
+@item
+The new mode @code{pixel-scroll-precision-mode} allows precise and
+smooth scrolling of the display at pixel resolution, if your mouse
+supports this.
+
+@item
+Emacs now supports 24-bit true colors on more terminals.
+
+@item
+On capable X terminal emulators, Emacs now supports setting the X
+primary selection on TTY frames.
+
+@item
+New convenient commands are now available for inserting, searching,
+listing, and describing Emoji. These commands are on the @w{@kbd{C-x
+8 e}} prefix key. The commands @kbd{C-u C-x =}
+(@code{what-cursor-position}) and @kbd{M-x describe-char} now show the
+names of Emoji sequences at point.
+
+@item
+The Help commands were enhanced:
+
+@itemize @minus
+@item
+@kbd{M-x apropos-variable} shows the values of the matching variables.
+@item
+@kbd{C-h b} activates @code{outline-minor-mode} in the buffer, which
+makes it easier to browse long lists of key bindings.
+@item
+@kbd{I} in the @file{*Help*} buffer displays the corresponding
+documentation in the Emacs Lisp Reference manual.
+@item
+New command @code{help-quick} displays a buffer with overview of
+common Help commands.
+@end itemize
+
+@item
+Outline Minor mode uses buttons to hide and show outlines.
+
+@item
+Deleted frames can now be undeleted using @kbd{C-x 5 u}, if the
+optional @code{undelete-frame-mode} is enabled.
+
+@item
+You can now delete the entire composed sequence of characters with
+@key{Delete} and edits the composed sequence by turning on the
+@code{composition-break-at-point} option.
+
+@item
+Support is added for many old scripts and writing systems, such as Tai
+Tham, Brahmi, Tirhuta, Modi, Lepcha, and many others.
+
+@item
+New translations of the Emacs tutorial: Ukrainian and Greek.
+
+@item
+New major modes for Typescript, Csharp, CMake, Go, Rust, and Yaml.
+@end itemize
+
+
@node New in Emacs 28
@section What is different about Emacs 28?
@cindex Differences between Emacs 27 and Emacs 28
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
index 56151b5482f..eed9744b9f0 100644
--- a/doc/misc/eglot.texi
+++ b/doc/misc/eglot.texi
@@ -502,6 +502,15 @@ project. The command @kbd{M-x eglot-code-actions} will
pop up a menu
of code applicable actions at point.
@end table
+@item M-x eglot-inlay-hints-mode
+This command toggles LSP ``inlay hints'' on and off for the current
+buffer. Inlay hints are small text annotations to specific parts of
+the whole buffer, not unlike diagnostics, but designed to help
+readability instead of indicating problems. For example, a C++ LSP
+server can serve hints about positional parameter names in function
+calls and a variable's automatically deduced type. Inlay hints help
+the user not have to remember these things by heart.
+
@end itemize
Not all servers support the full set of LSP capabilities, but most of
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 8030dfa4bb7..b80affbc954 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -2,7 +2,7 @@
@c %**start of header
@setfilename ../../info/erc.info
@settitle ERC Manual
-@set ERCVER 5.4.1
+@set ERCVER 5.5
@set ERCDIST as distributed with Emacs @value{EMACSVER}
@include docstyle.texi
@syncodeindex fn cp
@@ -90,7 +90,8 @@ Advanced Usage
@chapter Introduction
ERC is a powerful, modular, and extensible IRC client for Emacs.
-It is distributed with Emacs since version 22.1.
+It has been included in Emacs since 2006 (@pxref{History}) and is also
+available on GNU ELPA.
IRC is short for Internet Relay Chat. When using IRC, you can
communicate with other users on the same IRC network. There are many
@@ -1463,6 +1464,7 @@ or if you have bugs to report, there are several places
you can go.
@item
@uref{https://www.emacswiki.org/emacs/ERC} is the
emacswiki.org page for ERC@. Anyone may add tips, hints, etc.@: to it.
+If you do so, please help keep it up to date.
@item
You can ask questions about using ERC on the Emacs mailing list,
@@ -1471,7 +1473,13 @@ You can ask questions about using ERC on the Emacs
mailing list,
@item
You can visit the IRC Libera.Chat channel @samp{#emacs}. Many of the
contributors are frequently around and willing to answer your
-questions.
+questions. You can also try the relatively quiet @samp{#erc}, on the
+same network, for more involved questions.
+
+@item
+You can check GNU ELPA between Emacs releases to see if a newer
+version is available that might contain a fix for your issue:
+@uref{https://elpa.gnu.org/packages/erc.html}.
@item
To report a bug in ERC, use @kbd{M-x erc-bug}.
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index e51e2cf799b..1c33c04f647 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -2189,8 +2189,6 @@ Hitting space during a process invocation, such as
@command{make}, will
cause it to track the bottom of the output; but backspace no longer
scrolls back.
-@item It's not possible to fully @code{unload-feature} Eshell
-
@item Menu support was removed, but never put back
@item If an interactive process is currently running, @kbd{M-!} doesn't work
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index f7d528511a0..eb416fe47d6 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -76,16 +76,15 @@ misprints are the Gnus team's fault, sorry.
@subsection Installation FAQ
@menu
-* FAQ 1-1:: What is the latest version of Gnus?
-* FAQ 1-2:: Where and how to get Gnus?
-* FAQ 1-3:: I sometimes read references to No Gnus and Oort Gnus,
+* FAQ 1-1:: Where can I get the latest version of Gnus?
+* FAQ 1-2:: I sometimes read references to No Gnus and Oort Gnus,
what are those?
@end menu
@node FAQ 1-1
@subsubheading Question 1.1
-What is the latest version of Gnus?
+What is the latest version of Gnus and where can I find it?
@subsubheading Answer
@@ -94,15 +93,6 @@ The latest version of Gnus is bundled with Emacs.
@node FAQ 1-2
@subsubheading Question 1.2
-Where and how to get Gnus?
-
-@subsubheading Answer
-
-Gnus is bundled with Emacs.
-
-@node FAQ 1-3
-@subsubheading Question 1.3
-
I sometimes read references to No Gnus and Oort Gnus,
what are those?
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 1769b70c9bc..f0d3c75d055 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -3853,15 +3853,6 @@ The dribble file will be saved, though (@pxref{Auto
Save}).
@code{gnus-after-exiting-gnus-hook} is called as the final item when
exiting Gnus.
-Note:
-
-@quotation
-Miss Lisa Cannifax, while sitting in English class, felt her feet go
-numbly heavy and herself fall into a hazy trance as the boy sitting
-behind her drew repeated lines with his pencil across the back of her
-plastic chair.
-@end quotation
-
@node Group Topics
@section Group Topics
@@ -14518,13 +14509,23 @@ Here's an example method that's more complex:
@end example
@table @code
+@vindex nnimap-address
@item nnimap-address
The address of the server, like @samp{imap.gmail.com}.
+@vindex nnimap-user
+@item nnimap-user
+Username to use for authentication to the @acronym{IMAP} server. This
+corresponds to the value of the @samp{login} token in your
+@file{~/.authinfo} file. Set this variable if you want to access
+multiple accounts from the same @acronym{IMAP} server.
+
+@vindex nnimap-server-port
@item nnimap-server-port
If the server uses a non-standard port, that can be specified here. A
typical port would be @code{"imap"} or @code{"imaps"}.
+@vindex nnimap-stream
@item nnimap-stream
How @code{nnimap} should connect to the server. Possible values are:
@@ -14555,6 +14556,7 @@ Non-encrypted and unsafe straight socket connection.
@end table
+@vindex nnimap-authenticator
@item nnimap-authenticator
Some @acronym{IMAP} servers allow anonymous logins. In that case,
this should be set to @code{anonymous}. If this variable isn't set,
@@ -14564,6 +14566,7 @@ specific login method to be used, you can set this
variable to either
@code{plain}, @code{cram-md5} or @code{xoauth2}. (The latter method
requires using the @file{oauth2.el} library.)
+@vindex nnimap-expunge
@item nnimap-expunge
When to expunge deleted messages. If @code{never}, deleted articles
are marked with the IMAP @code{\\Delete} flag but not automatically
@@ -14579,27 +14582,32 @@ EXPUNGE nil is equivalent to @code{never}, while t
will immediately
expunge ALL articles that are currently flagged as deleted
(i.e., potentially not only the article that was just deleted).
+@vindex nnimap-streaming
@item nnimap-streaming
Virtually all @acronym{IMAP} server support fast streaming of data.
If you have problems connecting to the server, try setting this to
@code{nil}.
+@vindex nnimap-fetch-partial-articles
@item nnimap-fetch-partial-articles
If non-@code{nil}, fetch partial articles from the server. If set to
a string, then it's interpreted as a regexp, and parts that have
matching types will be fetched. For instance, @samp{"text/"} will
fetch all textual parts, while leaving the rest on the server.
+@vindex nnimap-record-commands
@item nnimap-record-commands
If non-@code{nil}, record all @acronym{IMAP} commands in the
@samp{"*imap log*"} buffer.
+@vindex nnimap-use-namespaces
@item nnimap-use-namespaces
If non-@code{nil}, omit the IMAP namespace prefix in nnimap group
names. If your IMAP mailboxes are called something like @samp{INBOX}
and @samp{INBOX.Lists.emacs}, but you'd like the nnimap group names to
be @samp{INBOX} and @samp{Lists.emacs}, you should enable this option.
+@vindex nnimap-keepalive-intervals
@item nnimap-keepalive-intervals
By default, nnimap will send occasional @samp{NOOP} (keepalive)
commands to the server, to keep the connection alive. This option
@@ -19817,10 +19825,11 @@ locally stored articles.
@chapter Scoring
@cindex scoring
-Other people use @dfn{kill files}, but we here at Gnus Towers like
-scoring better than killing, so we'd rather switch than fight. They do
-something completely different as well, so sit up straight and pay
-attention!
+Other people use @dfn{kill files} (@pxref{Kill Files}, but we here at
+Gnus Towers like scoring better than killing, so we'd rather switch
+than fight. Scoring and score files processing are more powerful and
+faster than processing of kill files. Scoring also does something
+completely different as well, so sit up straight and pay attention!
@vindex gnus-summary-mark-below
All articles have a default score (@code{gnus-summary-default-score}),
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index 1273fd8a3ad..47d3e6c03e3 100644
--- a/doc/misc/modus-themes.org
+++ b/doc/misc/modus-themes.org
@@ -4,9 +4,9 @@
#+language: en
#+options: ':t toc:nil author:t email:t num:t
#+startup: content
-#+macro: stable-version 4.0.0
-#+macro: release-date 2023-01-01
-#+macro: development-version 4.1.0-dev
+#+macro: stable-version 4.1.0
+#+macro: release-date 2023-02-22
+#+macro: development-version 4.2.0-dev
#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
#+macro: space @@texinfo:@: @@
#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
@@ -155,8 +155,8 @@ Emacs and of the themes across the years.
:end:
In the following example, we are assuming that your Emacs files are
-stored in =~/.emacs.d= and that you want to place the Modus themes in
-=~/.emacs.d/modus-themes=.
+stored in {{{file(~/.emacs.d)}}} and that you want to place the Modus
+themes in {{{file(~/.emacs.d/modus-themes)}}}.
1. Get the source and store it in the desired path by running the
following in the command line shell:
@@ -230,17 +230,17 @@ They are now ready to be used:
[[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable
:custom_id: h:e6268471-e847-4c9d-998f-49a83257b7f1
:end:
-From time to time, we receive bug reports pertaining to errors with byte
-compilation. These seldom have to do with faulty code in the themes: it
-might be a shortcoming of =package.el=, some regression in the current
-development target of Emacs, a misconfiguration in an otherwise exotic
-setup, and the like.
+From time to time, we receive bug reports pertaining to errors with
+byte compilation. These seldom have to do with faulty code in the
+themes: it might be a shortcoming of {{{file(package.el)}}}, some
+regression in the current development target of Emacs, a
+misconfiguration in an otherwise exotic setup, and the like.
The common solution with a stable version of Emacs is to:
-1. Delete the =modus-themes= package.
+1. Delete the ~modus-themes~ package.
2. Close the current Emacs session.
-3. Install the =modus-themes= again.
+3. Install the ~modus-themes~ again.
For those building Emacs directly from source, the solution may involve
reverting to an earlier commit in emacs.git.
@@ -265,7 +265,7 @@ wrong.
NOTE that Emacs can load multiple themes, which typically produces
undesirable results and undoes the work of the designer. Use the
~disable-theme~ command if you are trying other themes beside the
-Modus collection.
+Modus collection ([[#h:adb0c49a-f1f9-4690-868b-013a080eed68][Option for
disabling other themes while loading Modus]]).
Users of the built-in themes cannot ~require~ the package as usual
because there is no package to speak of. Instead, things are simpler
@@ -292,17 +292,18 @@ One can activate a theme with something like the
following expression,
replacing ~modus-operandi~ with their preferred Modus theme:
#+begin_src emacs-lisp
-(load-theme 'modus-operandi :no-confim)
+(load-theme 'modus-operandi :no-confirm)
#+end_src
Changes to the available customization options must always be evaluated
before loading a theme
([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). Reload a
theme for
new changes to take effect.
-This is how a basic setup could look like:
+This is how a basic setup could look like
([[#h:b66b128d-54a4-4265-b59f-4d1ea2feb073][The require-theme for built-in
Emacs themes]]):
#+begin_src emacs-lisp
;;; For the built-in themes which cannot use `require'.
+(require-theme 'modus-themes)
;; Add all your customizations prior to loading the themes.
(setq modus-themes-italic-constructs t
@@ -326,13 +327,41 @@ This is how a basic setup could look like:
modus-themes-bold-constructs nil)
;; Load the theme of your choice.
-(load-theme 'modus-operandi :no-confim)
+(load-theme 'modus-operandi :no-confirm)
(define-key global-map (kbd "<f5>") #'modus-themes-toggle)
#+end_src
[[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration with and
without use-package]].
+** The ~require-theme~ for built-in Emacs themes
+:PROPERTIES:
+:CUSTOM_ID: h:b66b128d-54a4-4265-b59f-4d1ea2feb073
+:END:
+
+The version of the Modus themes that is included in Emacs CANNOT use
+the standard ~require~. This is because the built-in themes are not
+included in the ~load-path~ (not my decision). The ~require-theme~
+function must be used in this case as a replacement. For example:
+
+#+begin_src emacs-lisp
+(require-theme 'modus-themes)
+
+;; All customizations here
+(setq modus-themes-bold-constructs t
+ modus-themes-italic-constructs t)
+
+;; Maybe define some palette overrides, such as by using our presets
+(setq modus-themes-common-palette-overrides
+ modus-themes-preset-overrides-intense)
+
+;; Load the theme of choice (built-in themes are always "safe" so they
+;; do not need the `no-require' argument of `load-theme').
+(load-theme 'modus-operandi)
+
+(define-key global-map (kbd "<f5>") #'modus-themes-toggle)
+#+end_src
+
** Sample configuration with and without use-package
:properties:
:custom_id: h:e979734c-a9e1-4373-9365-0f2cd36107b8
@@ -349,54 +378,57 @@ package configurations in their setup. We use this as an
example:
#+begin_src emacs-lisp
;;; For the built-in themes which cannot use `require'.
(use-package emacs
- :init
+ :config
+ (require-theme 'modus-themes) ; `require-theme' is ONLY for the built-in
Modus themes
+
;; Add all your customizations prior to loading the themes
(setq modus-themes-italic-constructs t
modus-themes-bold-constructs nil)
- :config
+
+ ;; Maybe define some palette overrides, such as by using our presets
+ (setq modus-themes-common-palette-overrides
+ modus-themes-preset-overrides-intense)
+
;; Load the theme of your choice.
(load-theme 'modus-operandi)
- :bind ("<f5>" . modus-themes-toggle))
+
+ (define-key global-map (kbd "<f5>") #'modus-themes-toggle))
;;; For packaged versions which must use `require'.
(use-package modus-themes
- :ensure
- :init
+ :ensure t
+ :config
;; Add all your customizations prior to loading the themes
(setq modus-themes-italic-constructs t
modus-themes-bold-constructs nil)
- :config
+
+ ;; Maybe define some palette overrides, such as by using our presets
+ (setq modus-themes-common-palette-overrides
+ modus-themes-preset-overrides-intense)
+
;; Load the theme of your choice.
- (load-theme 'modus-operandi :no-confim)
- :bind ("<f5>" . modus-themes-toggle))
+ (load-theme 'modus-operandi)
+
+ (define-key global-map (kbd "<f5>") #'modus-themes-toggle))
#+end_src
The same without ~use-package~:
#+begin_src emacs-lisp
-;;; For the built-in themes which cannot use `require':
-;; Add all your customizations prior to loading the themes
-(setq modus-themes-italic-constructs t
- modus-themes-bold-constructs nil)
-
-;; Load the theme of your choice:
-(load-theme 'modus-operandi) ;; OR (load-theme 'modus-vivendi)
-
-(define-key global-map (kbd "<f5>") #'modus-themes-toggle)
-
-
-
-;;; For packaged versions which must use `require':
-(require 'modus-themes)
+(require 'modus-themes) ; OR for the built-in themes: (require-theme
'modus-themes)
;; Add all your customizations prior to loading the themes
(setq modus-themes-italic-constructs t
modus-themes-bold-constructs nil)
+;; Maybe define some palette overrides, such as by using our presets
+(setq modus-themes-common-palette-overrides
+ modus-themes-preset-overrides-intense)
+
;; Load the theme of your choice:
-(load-theme 'modus-operandi :no-confim) ;; OR (load-theme 'modus-vivendi
:no-confim)
+(load-theme 'modus-operandi :no-confirm)
(define-key global-map (kbd "<f5>") #'modus-themes-toggle)
#+end_src
@@ -482,6 +514,7 @@ reloaded for changes to take effect.
modus-themes-mixed-fonts t
modus-themes-variable-pitch-ui nil
modus-themes-custom-auto-reload t
+ modus-themes-disable-other-themes t
;; Options for `modus-themes-prompts' are either nil (the
;; default), or a list of properties that may include any of those
@@ -545,6 +578,38 @@ UI or related functions such as ~customize-set-variable~
and ~setopt~
With a nil value, changes to user options have no further consequences:
the user must manually reload the theme
([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]).
+** Option for disabling other themes while loading Modus
+:properties:
+:alt_title: Disable other themes
+:description: Determine whether loading a Modus themes disables all others
+:custom_id: h:adb0c49a-f1f9-4690-868b-013a080eed68
+:end:
+#+vindex: modus-themes-disable-other-themes
+
+Brief: Disable all other themes when loading a Modus theme.
+
+Symbol: ~modus-themes-disable-other-themes~ (=boolean= type)
+
+Possible values:
+
+1. ~nil~
+2. ~t~ (default)
+
+When the value is non-nil, the commands ~modus-themes-toggle~ and
+~modus-themes-select~, as well as the ~modus-themes-load-theme~
+function, will disable all other themes while loading the specified
+Modus theme. This is done to ensure that Emacs does not blend two or
+more themes: such blends lead to awkward results that undermine the
+work of the designer.
+
+When the value is nil, the aforementioned commands and function will
+only disable other themes within the Modus collection.
+
+This option is provided because Emacs themes are not necessarily
+limited to colors/faces: they can consist of an arbitrary set of
+customizations. Users who use such customization bundles must set
+this variable to a nil value.
+
** Option for more bold constructs
:properties:
:alt_title: Bold constructs
@@ -707,14 +772,14 @@ Brief: Set the overall style of completion framework
interfaces.
Symbol: ~modus-themes-completions~ (=alist= type properties)
This affects Company, Corfu, Flx, Icomplete/Fido, Ido, Ivy, Orderless,
-Vertico. The value is an alist of expressions, each of which takes
-the form of =(KEY . LIST-OF-PROPERTIES)=. =KEY= is a symbol, while
-=PROPERTIES= is a list. Here is a sample, followed by a description
-of the particularities:
+Vertico, and the standard =*Completions*= buffer. The value is an
+alist of expressions, each of which takes the form of =(KEY .
LIST-OF-PROPERTIES)=.
+=KEY= is a symbol, while =PROPERTIES= is a list. Here is a sample,
+followed by a description of the particularities:
#+begin_src emacs-lisp
(setq modus-themes-completions
- '((matches . (extrabold background))
+ '((matches . (extrabold underline))
(selection . (semibold italic))))
#+end_src
@@ -984,8 +1049,6 @@ values and semantic color mappings:
given named color from the palette, like =(heading-2 yellow-faint)=.
Both elements of the list are symbols, though the ~cadr~ (value) can
be a string that specifies a color, such as =(heading-2 "#354fcf")=.
- Semantic color mappings cannot be recursive: their value must be
- either a named color or a hexadecimal RGB value.
#+vindex: modus-themes-common-palette-overrides
Both of those subsets can be overridden, thus refashioning the theme.
@@ -1186,9 +1249,18 @@ set their color to that of the underlying background.
;; common overrides are best used for changes to semantic color
;; mappings, as we show below.
+;; Remove the border
(setq modus-themes-common-palette-overrides
'((border-mode-line-active unspecified)
(border-mode-line-inactive unspecified)))
+
+;; Keep the border but make it the same color as the background of the
+;; mode line (thus appearing borderless). The difference with the
+;; above is that this version is a bit thicker because the border are
+;; still there.
+(setq modus-themes-common-palette-overrides
+ '((border-mode-line-active bg-mode-line-active)
+ (border-mode-line-inactive bg-mode-line-inactive)))
#+end_src
**** Make the active mode line colorful
@@ -1218,7 +1290,7 @@ have a blue mode line for ~modus-operandi~ and a red one
for
;; Blue background, neutral foreground, intense blue border
(setq modus-themes-common-palette-overrides
- '((bg-mode-line-active bg-blue)
+ '((bg-mode-line-active bg-blue-intense)
(fg-mode-line-active fg-main)
(border-mode-line-active blue-intense)))
@@ -1235,6 +1307,58 @@ have a blue mode line for ~modus-operandi~ and a red one
for
(border-mode-line-active bg-red-subtle)))
#+end_src
+**** Make the tab bar more or less colorful
+:PROPERTIES:
+:CUSTOM_ID: h:096658d7-a0bd-4a99-b6dc-9b20a20cda37
+:END:
+
+This is one of our practical examples to override the semantic colors
+of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic
variants using palette overrides]]).
+Here we show how to affect the colors of the built-in ~tab-bar-mode~
+and ~tab-line-mode~.
+
+For consistent theme-wide results, consider changing the mode line,
+fringes, and line numbers. These are shown in other sections of this
+manual.
+
+#+begin_src emacs-lisp
+;; These overrides are common to all Modus themes. We also provide
+;; theme-specific options, such as `modus-operandi-palette-overrides'.
+;;
+;; In general, the theme-specific overrides are better for overriding
+;; color values, such as redefining what `blue-faint' looks like. The
+;; common overrides are best used for changes to semantic color
+;; mappings, as we show below.
+
+
+;; Make the `tab-bar-mode' mode subtle while keepings its original
+;; gray aesthetic.
+(setq modus-themes-common-palette-overrides
+ '((bg-tab-bar bg-main)
+ (bg-tab-current bg-active)
+ (bg-tab-other bg-dim)))
+
+;; Like the above, but the current tab has a colorful background and
+;; the inactive tabs have a slightly more noticeable gray background.
+(setq modus-themes-common-palette-overrides
+ '((bg-tab-bar bg-main)
+ (bg-tab-current bg-cyan-intense)
+ (bg-tab-other bg-inactive)))
+
+;; Make the tabs colorful, using a monochromatic pattern (e.g. shades
+;; of cyan).
+(setq modus-themes-common-palette-overrides
+ '((bg-tab-bar bg-cyan-nuanced)
+ (bg-tab-current bg-cyan-intense)
+ (bg-tab-other bg-cyan-subtle)))
+
+;; Like the above, but with a dichromatic pattern (cyan and magenta).
+(setq modus-themes-common-palette-overrides
+ '((bg-tab-bar bg-cyan-nuanced)
+ (bg-tab-current bg-magenta-intense)
+ (bg-tab-other bg-cyan-subtle)))
+#+end_src
+
**** Make the fringe invisible or another color
:PROPERTIES:
:CUSTOM_ID: h:c312dcac-36b6-4a1f-b1f5-ab1c9abe27b0
@@ -1352,7 +1476,8 @@ three different degrees of intensity.
;; mappings, as we show below.
;; Add a nuanced background color to completion matches, while keeping
-;; their foreground intact.
+;; their foreground intact (foregrounds do not need to be specified in
+;; this case, but we do it for didactic purposes).
(setq modus-themes-common-palette-overrides
'((fg-completion-match-0 blue)
(fg-completion-match-1 magenta-warmer)
@@ -1893,9 +2018,8 @@ do not show every possible permutation.
(prose-todo red)
(prose-verbatim magenta-warmer)))
-;; Make code block delimiters use a shade of red, tone down
-;; =verbatim=, ~code~, and {{{macro}}}, and amplify the style of
-;; property drawers
+;; Make code block delimiters use a shade of red, tone down verbatim,
+;; code, and macro, and amplify the style of property drawers
(setq modus-themes-common-palette-overrides
'((prose-block red-faint)
(prose-code fg-dim)
@@ -1995,6 +2119,8 @@ Here we show how to make the region respect the
underlying text colors
or how to make the background more/less intense while combining it
with an appropriate foreground value.
+[[#h:a5140c9c-18b2-45db-8021-38d0b5074116][Do not extend the region
background]].
+
#+begin_src emacs-lisp
;; These overrides are common to all Modus themes. We also provide
;; theme-specific options, such as `modus-operandi-palette-overrides'.
@@ -2126,6 +2252,121 @@ this section we show how to affect the
~display-line-numbers-mode~.
(bg-line-number-active bg-cyan-intense)))
#+end_src
+**** Make diffs use only a foreground
+:PROPERTIES:
+:CUSTOM_ID: h:b3761482-bcbf-4990-a41e-4866fb9dad15
+:END:
+
+This is one of our practical examples to override the semantic colors
+of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic
variants using palette overrides]]). In
+this section we show how to change diff buffers (e.g. in ~magit~) to
+only use color-coded text without any added background. What we
+basically do is to disable the applicable backgrounds and then
+intensify the foregrounds. Since the deuteranopia-optimized themes do
+not use the red-green color coding, we make an extra set of
+adjustments for them by overriding their palettes directly instead of
+just using the "common" overrides.
+
+#+begin_src emacs-lisp
+;; Diffs with only foreground colours. Word-wise ("refined") diffs
+;; have a gray background to draw attention to themselves.
+(setq modus-themes-common-palette-overrides
+ '((bg-added unspecified)
+ (bg-added-faint unspecified)
+ (bg-added-refine bg-inactive)
+ (fg-added green)
+ (fg-added-intense green-intense)
+
+ (bg-changed unspecified)
+ (bg-changed-faint unspecified)
+ (bg-changed-refine bg-inactive)
+ (fg-changed yellow)
+ (fg-changed-intense yellow-intense)
+
+ (bg-removed unspecified)
+ (bg-removed-faint unspecified)
+ (bg-removed-refine bg-inactive)
+ (fg-removed red)
+ (fg-removed-intense red-intense)
+
+ (bg-diff-context unspecified)))
+
+;; Because deuteranopia cannot use the typical red-yellow-green
+;; combination, we need to arrange for a yellow-purple-blue sequence.
+;; Notice that the above covers the "common" overrides, so we do not
+;; need to reproduce the whole list of them.
+(setq modus-operandi-deuteranopia-palette-overrides
+ '((fg-added blue)
+ (fg-added-intense blue-intense)
+
+ (fg-changed magenta-cooler)
+ (fg-changed-intense magenta-intense)
+
+ (fg-removed yellow-warmer)
+ (fg-removed-intense yellow-intense)))
+
+(setq modus-vivendi-deuteranopia-palette-overrides
+ '((fg-added blue)
+ (fg-added-intense blue-intense)
+
+ (fg-changed magenta-cooler)
+ (fg-changed-intense magenta-intense)
+
+ (fg-removed yellow)
+ (fg-removed-intense yellow-intense)))
+#+end_src
+
+**** Make deuteranopia diffs red and blue instead of yellow and blue
+:PROPERTIES:
+:CUSTOM_ID: h:16389ea1-4cb6-4b18-9409-384324113541
+:END:
+
+This is one of our practical examples to override the semantic colors
+of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic
variants using palette overrides]]). In
+this section we show how to implement a red+blue color coding for
+diffs in the themes ~modus-operandi-deuteranopia~ and
+~modus-vivendi-deuteranopia~. As those themes are optimized for users
+with red-green color deficiency, they do not use the typical red+green
+color coding for diffs, defaulting instead to yellow+blue which are
+discernible. Users with deuteranomaly or, generally, those who like a
+different aesthetic, can use the following to make diffs use the
+red+yellow+blue color coding for removed, changed, and added lines
+respectively. This is achieved by overriding the "changed" and
+"removed" entries to use the colors of regular ~modus-operandi~ and
+~modus-vivendi~.
+
+#+begin_src emacs-lisp
+(setq modus-operandi-deuteranopia-palette-overrides
+ '((bg-changed "#ffdfa9")
+ (bg-changed-faint "#ffefbf")
+ (bg-changed-refine "#fac090")
+ (bg-changed-fringe "#d7c20a")
+ (fg-changed "#553d00")
+ (fg-changed-intense "#655000")
+
+ (bg-removed "#ffd8d5")
+ (bg-removed-faint "#ffe9e9")
+ (bg-removed-refine "#f3b5af")
+ (bg-removed-fringe "#d84a4f")
+ (fg-removed "#8f1313")
+ (fg-removed-intense "#aa2222")))
+
+(setq modus-vivendi-deuteranopia-palette-overrides
+ '((bg-changed "#363300")
+ (bg-changed-faint "#2a1f00")
+ (bg-changed-refine "#4a4a00")
+ (bg-changed-fringe "#8a7a00")
+ (fg-changed "#efef80")
+ (fg-changed-intense "#c0b05f")
+
+ (bg-removed "#4f1119")
+ (bg-removed-faint "#380a0f")
+ (bg-removed-refine "#781a1f")
+ (bg-removed-fringe "#b81a1f")
+ (fg-removed "#ffbfbf")
+ (fg-removed-intense "#ff9095")))
+#+end_src
+
* Advanced customization
:properties:
:custom_id: h:f4651d55-8c07-46aa-b52b-bed1e53463bb
@@ -2248,22 +2489,25 @@ xterm*color15: #ffffff
#+cindex: Preview named colors or semantic color mappings
#+findex: modus-themes-list-colors
+The command ~modus-themes-list-colors~ uses minibuffer completion to
+select an item from the Modus themes and then produces a buffer with
+previews of its color palette entries. The buffer has a naming scheme
+that reflects the given choice, like =modus-operandi-list-colors= for
+the ~modus-operandi~ theme.
+
#+findex: modus-themes-list-colors-current
-The command ~modus-themes-list-colors~ prompts for a choice between
-=modus-operandi= and =modus-vivendi= to produce a help buffer that
-shows a preview of the named colors in the given theme's palette. The
-command ~modus-themes-list-colors-current~ skips the prompt, using the
-current Modus theme.
+The command ~modus-themes-list-colors-current~ skips the minibuffer
+selection process and just produces a preview for the current Modus
+theme.
When called with a prefix argument (=C-u= with the default key
bindings), these commands will show a preview of the palette's
-semantic color mappings instead of the named colors.
-
-In this context, "named colors" are entries that associate a symbol to
-a string color value, such as =(blue-warmer "#354fcf")=. Whereas
-"semantic color mappings" associate a named color to a symbol, like
-=(string blue-warmer)=, thus making the theme render all string
-constructs in the =blue-warmer= color value
([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]).
+semantic color mappings instead of the named colors. In this context,
+"named colors" are entries that associate a symbol to a string color
+value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color
+mappings" associate a named color to a symbol, like =(string
+blue-warmer)=, thus making the theme render all string constructs in
+the =blue-warmer= color value
([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]).
#+findex: modus-themes-preview-colors
#+findex: modus-themes-preview-colors-current
@@ -2314,12 +2558,70 @@ equivalent the themes provide.
For a more elaborate design, it is better to inspect the source code of
~modus-themes-toggle~ and relevant functions.
+** Get a single color from the palette
+:PROPERTIES:
+:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e
+:END:
+
+[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with
modus-themes-with-colors]].
+
+#+findex: modus-themes-get-color-value
+The fuction ~modus-themes-get-color-value~ can be called from Lisp to
+return the value of a color from the active Modus theme palette. It
+takea a =COLOR= argument and an optional =OVERRIDES=.
+
+=COLOR= is a symbol that represents a named color entry in the
+palette.
+
+[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]].
+
+If the value is the name of another color entry in the palette (so a
+mapping), this function recurs until it finds the underlying color
+value.
+
+With an optional =OVERRIDES= argument as a non-nil value, it accounts
+for palette overrides. Else it reads only the default palette.
+
+[[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]].
+
+With optional =THEME= as a symbol among ~modus-themes-items~, use the
+palette of that item. Else use the current Modus theme.
+
+If =COLOR= is not present in the palette, this function returns the
+~unspecified~ symbol, which is safe when used as a face attribute's
+value.
+
+An example with ~modus-operandi~ to show how this function behaves
+with/without overrides and when recursive mappings are introduced.
+
+#+begin_src emacs-lisp
+;; Here we show the recursion of palette mappings. In general, it is
+;; better for the user to specify named colors to avoid possible
+;; confusion with their configuration, though those still work as
+;; expected.
+(setq modus-themes-common-palette-overrides
+ '((cursor red)
+ (fg-mode-line-active cursor)
+ (border-mode-line-active fg-mode-line-active)))
+
+;; Ignore the overrides and get the original value.
+(modus-themes-get-color-value 'border-mode-line-active)
+;; => "#5a5a5a"
+
+;; Read from the overrides and deal with any recursion to find the
+;; underlying value.
+(modus-themes-get-color-value 'border-mode-line-active :overrides)
+;; => "#a60000"
+#+end_src
+
** Use theme colors in code with modus-themes-with-colors
:properties:
:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae
:end:
#+cindex: Use colors from the palette anywhere
+[[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the
palette]].
+
Note that users most probably do not need the following. Just rely on
the comprehensive overrides we provide
([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]).
@@ -2354,6 +2656,32 @@ We provide commands to inspect those
([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d]
Others sections in this manual show how to use the aforementioned
macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]).
+Because the ~modus-themes-with-colors~ will most likely be used to
+customize faces, note that any function that calls it must be run at
+startup after the theme loads. The same function must also be
+assigned to the ~modus-themes-after-load-theme-hook~ for its effects
+to persist and be updated when switching between Modus themes (e.g. to
+update the exact value of =blue-warmer= when toggling between
+~modus-operandi~ to ~modus-vivendi~.
+
+** Do not extend the region background
+:PROPERTIES:
+:CUSTOM_ID: h:a5140c9c-18b2-45db-8021-38d0b5074116
+:END:
+
+By the default, the background of the ~region~ face extends from the
+end of the line to the edge of the window. To limit it to the end of
+the line, we need to override the face's =:extend= attribute. Adding
+this to the Emacs configuration file will suffice:
+
+#+begin_src emacs-lisp
+;; Do not extend `region' background past the end of the line.
+(custom-set-faces
+ '(region ((t :extend nil))))
+#+end_src
+
+[[#h:c8605d37-66e1-42aa-986e-d7514c3af6fe][Make the region preserve text
colors, plus other styles]].
+
** Add padding to mode line
:PROPERTIES:
:CUSTOM_ID: h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c
@@ -2981,9 +3309,9 @@ While we do provide ~modus-themes-toggle~ to manually
switch between the
themes, users may also set up their system to perform such a task
automatically at sunrise and sunset.
-This can be accomplished by specifying the coordinates of one's location
-using the built-in {{{file(solar.el)}}} and then configuring the =circadian=
-package:
+This can be accomplished by specifying the coordinates of one's
+location using the built-in {{{file(solar.el)}}} and then configuring
+the ~circadian~ package:
#+begin_src emacs-lisp
(use-package solar ; built-in
@@ -2992,7 +3320,7 @@ package:
calendar-longitude 33.36))
(use-package circadian ; you need to install this
- :ensure
+ :ensure t
:after solar
:config
(setq circadian-themes '((:sunrise . modus-operandi)
@@ -3022,9 +3350,10 @@ To remap the buffer's backdrop, we start with a function
like this one:
#+begin_src emacs-lisp
(defun my-pdf-tools-backdrop ()
- (face-remap-add-relative
- 'default
- `(:background ,(modus-themes-color 'bg-alt))))
+ (modus-themes-with-colors
+ (face-remap-add-relative
+ 'default
+ `(:background ,bg-dim))))
(add-hook 'pdf-tools-enabled-hook #'my-pdf-tools-backdrop)
#+end_src
@@ -3043,9 +3372,10 @@ at something like the following, which builds on the
above example:
#+begin_src emacs-lisp
(defun my-pdf-tools-backdrop ()
- (face-remap-add-relative
- 'default
- `(:background ,(modus-themes-color 'bg-alt))))
+ (modus-themes-with-colors
+ (face-remap-add-relative
+ 'default
+ `(:background ,bg-dim))))
(defun my-pdf-tools-midnight-mode-toggle ()
(when (derived-mode-p 'pdf-view-mode)
@@ -3154,11 +3484,12 @@ need to (provided they understand the implications).
:CUSTOM_ID: h:2ef83a21-2f0a-441e-9634-473feb940743
:END:
-The =hl-todo= package provides the user option ~hl-todo-keyword-faces~:
-it specifies a pair of keyword and corresponding color value. The Modus
-themes configure that option in the interest of legibility. While this
-works for our purposes, users may still prefer to apply their custom
-values, in which case the following approach is necessary:
+The ~hl-todo~ package provides the user option
+~hl-todo-keyword-faces~: it specifies a pair of keyword and
+corresponding color value. The Modus themes configure that option in
+the interest of legibility. While this works for our purposes, users
+may still prefer to apply their custom values, in which case the
+following approach is necessary:
#+begin_src emacs-lisp
(defun my-modus-themes-hl-todo-faces ()
@@ -3192,7 +3523,7 @@ otherwise the defaults are not always legible.
:CUSTOM_ID: h:439c9e46-52e2-46be-b1dc-85841dd99671
:END:
-The =solaire-mode= package dims the background of what it considers
+The ~solaire-mode~ package dims the background of what it considers
ancillary "UI" buffers, such as the minibuffer and Dired buffers. The
Modus themes used to support Solaire on the premise that the user was
(i) opting in to it, (ii) understood why certain buffers were more gray,
@@ -3222,7 +3553,7 @@ arrangement that compromises on our accessibility
standards and/or
hinders our efforts to provide the best possible experience while using
the Modus themes.
-As such, =solaire-mode= is not---and will not be---supported by the
+As such, ~solaire-mode~ is not---and will not be---supported by the
Modus themes (or any other of my themes, for that matter). Users who
want it must style the faces manually. Below is some sample code, based
on what we cover at length elsewhere in this manual:
@@ -3305,6 +3636,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ csv-mode
+ ctrlf
+ custom (what you get with {{{kbd(M-x customize)}}})
+- dashboard
+ deadgrep
+ deft
+ devdocs
@@ -3612,11 +3944,12 @@ anew.
:CUSTOM_ID: h:a195e37c-e58c-4148-b254-8ba1ed8a731a
:END:
-The =git-gutter= and =git-gutter-fr= packages default to drawing bitmaps
-for the indicators they display (e.g. bitmap of a plus sign for added
-lines). In Doom Emacs, these bitmaps are replaced with contiguous lines
-which may look nicer, but require a change to the foreground of the
-relevant faces to yield the desired color combinations.
+The ~git-gutter~ and ~git-gutter-fr~ packages default to drawing
+bitmaps for the indicators they display (e.g. bitmap of a plus sign
+for added lines). In Doom Emacs, these bitmaps are replaced with
+contiguous lines which may look nicer, but require a change to the
+foreground of the relevant faces to yield the desired color
+combinations.
Since this is Doom-specific, we urge users to apply changes in their
local setup. Below is some sample code, based on what we cover at
@@ -3668,7 +4001,7 @@ If the above does not work, try this instead:
:END:
Depending on your build of Emacs and/or the environment it runs in,
-multiline comments in PHP with the =php-mode= package use the
+multiline comments in PHP with the ~php-mode~ package use the
~font-lock-doc-face~ instead of ~font-lock-comment-face~.
This seems to make all comments use the appropriate face:
@@ -3797,10 +4130,10 @@ For example:
:CUSTOM_ID: h:24bab397-dcb2-421d-aa6e-ec5bd622b913
:END:
-The =highlight-parentheses= package provides contextual coloration of
+The ~highlight-parentheses~ package provides contextual coloration of
surrounding parentheses, highlighting only those which are around the
-point. The package expects users to customize the applicable colors on
-their own by configuring certain variables.
+point. The package expects users to customize the applicable colors
+on their own by configuring certain variables.
To make the Modus themes work as expected with this, we need to use some
of the techniques that are discussed at length in the various
@@ -3984,10 +4317,11 @@ implements an alternative to the typical coloration of
code. Instead of
highlighting the syntactic constructs, it applies color to different
levels of depth in the code structure.
-As =prism.el= offers a broad range of customizations, we cannot style
-it directly at the theme level: that would run contrary to the spirit
-of the package. Instead, we may offer preset color schemes. Those
-should offer a starting point for users to adapt to their needs.
+As {{{file(prism.el)}}} offers a broad range of customizations, we
+cannot style it directly at the theme level: that would run contrary
+to the spirit of the package. Instead, we may offer preset color
+schemes. Those should offer a starting point for users to adapt to
+their needs.
In the following code snippets, we employ the ~modus-themes-with-colors~
macro: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code
with modus-themes-with-colors]].
@@ -4146,10 +4480,10 @@ Consult the doc string of ~shr-use-colors~.
:end:
#+cindex: Fonts in EWW, Elfeed, Ement, and SHR
-By default, packages that build on top of the Simple HTML Remember (=shr=)
-use proportionately spaced fonts. This is controlled by the user option
-~shr-use-fonts~, which is set to non-~nil~ by default. To use the standard
-font instead, set that variable to nil.
+By default, packages that build on top of the Simple HTML Remember
+(~shr~) use proportionately spaced fonts. This is controlled by the
+user option ~shr-use-fonts~, which is set to non-~nil~ by default. To
+use the standard font instead, set that variable to nil.
[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and
others]].
@@ -4166,9 +4500,10 @@ This is a non-exhaustive list.
:custom_id: h:8e636056-356c-4ca7-bc78-ebe61031f585
:end:
-The =ement.el= library by Adam Porter (also known as "alphapapa") defaults
-to a method of colorizing usernames in a rainbow style. This is
-controlled by the user option ~ement-room-prism~ and can be disabled with:
+The {{{file(ement.el)}}} library by Adam Porter (also known as
+"alphapapa") defaults to a method of colorizing usernames in a rainbow
+style. This is controlled by the user option ~ement-room-prism~ and
+can be disabled with:
#+begin_src emacs-lisp
(setq ement-room-prism nil)
@@ -4182,7 +4517,7 @@ slightly below our nominal target. Try this instead:
(setq ement-room-prism-minimum-contrast 7)
#+end_src
-With regard to fonts, Ement depends on =shr=
([[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note on SHR fonts]]).
+With regard to fonts, Ement depends on ~shr~
([[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note on SHR fonts]]).
Since we are here, here is an excerpt from Ement's source code:
@@ -4271,7 +4606,7 @@ those buttons. Disabling the logo fixes the problem:
The built-in ~goto-address-mode~ uses heuristics to identify URLs and
email addresses in the current buffer. It then applies a face to them
-to change their style. Some packages, such as =notmuch=, use this
+to change their style. Some packages, such as ~notmuch~, use this
minor-mode automatically.
The faces are not declared with ~defface~, meaning that it is better
@@ -4768,41 +5103,43 @@ The Modus themes are a collective effort. Every bit of
work matters.
Le Gouguec, Koen van Greevenbroek, Kostadin Ninev, Madhavan
Krishnan, Manuel Giraud, Markus Beppler, Matthew Stevenson, Mauro
Aranda, Nicolas De Jaeghere, Paul David, Philip Kaludercic, Pierre
- Téchoueyres, Rudolf Adamkovič, Stephen Gildea, Shreyas Ragavan,
- Stefan Kangas, Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen
- Xie, okamsn.
+ Téchoueyres, Rudolf Adamkovič, Sergey Nichiporchik, Stephen Gildea,
+ Shreyas Ragavan, Stefan Kangas, Utkarsh Singh, Vincent Murphy,
+ Xinglu Chen, Yuanchen Xie, okamsn.
+ Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers,
Adrian Manea, Aleksei Pirogov, Alex Griffin, Alex Koen, Alex
Peitsinis, Alexey Shmalko, Alok Singh, Anders Johansson, André
Alexandre Gomes, Andrew Tropin, Antonio Hernández Blas, Arif Rezai,
- Augusto Stoffel, Basil L.{{{space()}}} Contovounesios, Burgess
- Chang, Charlotte Van Petegem, Christian Tietze, Christopher Dimech,
- Christopher League, Damien Cassou, Daniel Mendler, Dario
- Gjorgjevski, David Edmondson, Davor Rotim, Divan Santana, Eliraz
- Kedmi, Emanuele Michele Alberto Monterosso, Farasha Euker, Feng Shu,
- Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia, Gonçalo Marrafa,
- Guilherme Semente, Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken,
- Iris Garcia, Ivan Popovych, James Ferguson, Jeremy Friesen, Jerry
- Zhang, Johannes Grødem, John Haman, Jonas Collberg, Jorge Morais,
- Joshua O'Connor, Julio C. Villasante, Kenta Usami, Kevin Fleming,
- Kévin Le Gouguec, Kevin Kainan Li, Kostadin Ninev, Laith Bahodi, Len
- Trigg, Lennart C. Karssen, Luis Miguel Castañeda, Magne Hov, Manuel
- Uberti, Mark Bestley, Mark Burton, Mark Simpson, Markus Beppler,
+ Augusto Stoffel, Basil L.{{{space()}}} Contovounesios, Bernd
+ Rellermeyer, Burgess Chang, Charlotte Van Petegem, Christian Tietze,
+ Christopher Dimech, Christopher League, Damien Cassou, Daniel
+ Mendler, Dario Gjorgjevski, David Edmondson, Davor Rotim, Divan
+ Santana, Eliraz Kedmi, Emanuele Michele Alberto Monterosso, Farasha
+ Euker, Feng Shu, Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia,
+ Gonçalo Marrafa, Guilherme Semente, Gustavo Barros, Hörmetjan
+ Yiltiz, Ilja Kocken, Imran Khan, Iris Garcia, Ivan Popovych, James
+ Ferguson, Jeremy Friesen, Jerry Zhang, Johannes Grødem, John Haman,
+ Jonas Collberg, Jorge Morais, Joshua O'Connor, Julio C. Villasante,
+ Kenta Usami, Kevin Fleming, Kévin Le Gouguec, Kevin Kainan Li,
+ Kostadin Ninev, Laith Bahodi, Len Trigg, Lennart C. Karssen, Luis
+ Miguel Castañeda, Magne Hov, Manuel Giraud, Manuel Uberti, Mark
+ Bestley, Mark Burton, Mark Simpson, Marko Kocic, Markus Beppler,
Matt Armstrong, Matthias Fuchs, Mattias Engdegård, Mauro Aranda,
Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan Willcock,
Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Pablo
Stafforini, Paul Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu,
Philip Kaludercic, Pierre Téchoueyres, Przemysław Kryger, Robert
- Hepple, Roman Rudakov, Ryan Phillips, Rytis Paškauskas, Rudolf
- Adamkovič, Sam Kleinman, Samuel Culpepper, Saša Janiška, Shreyas
- Ragavan, Simon Pugnet, Tassilo Horn, Thibaut Verron, Thomas
- Heartman, Togan Muftuoglu, Tony Zorman, Trey Merkley, Tomasz
- Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh, Vincent Foley. As
- well as users: Ben, CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux,
- Fredrik, Moesasji, Nick, Summer Emacs, TheBlob42, Trey, bepolymathe,
- bit9tream, derek-upham, doolio, fleimgruber, gitrj95, iSeeU, jixiuf,
- okamsn, pRot0ta1p, soaringbird, tumashu, wakamenod.
+ Hepple, Roman Rudakov, Russell Sim, Ryan Phillips, Rytis Paškauskas,
+ Rudolf Adamkovič, Sam Kleinman, Samuel Culpepper, Saša Janiška,
+ Shreyas Ragavan, Simon Pugnet, Tassilo Horn, Thanos Apollo, Thibaut
+ Verron, Thomas Heartman, Togan Muftuoglu, Tony Zorman, Trey Merkley,
+ Tomasz Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh, Vincent
+ Foley, Zoltan Kiraly. As well as users: Ben, CsBigDataHub1, Emacs
+ Contrib, Eugene, Fourchaux, Fredrik, Moesasji, Nick, Summer Emacs,
+ TheBlob42, TitusMu, Trey, bepolymathe, bit9tream, bangedorrunt,
+ derek-upham, doolio, fleimgruber, gitrj95, iSeeU, jixiuf, okamsn,
+ pRot0ta1p, soaringbird, tumashu, wakamenod.
+ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii,
Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core
diff --git a/doc/misc/org.org b/doc/misc/org.org
index 14699e77395..7ff0933de75 100644
--- a/doc/misc/org.org
+++ b/doc/misc/org.org
@@ -5291,7 +5291,7 @@ The following commands help to work with properties:
Set a property in the current entry. Both the property and the
value can be inserted using completion.
-- {{{kbd(S-RIGHT)}}} (~org-property-next-allowed-values~), {{{kbd(S-LEFT)}}}
(~org-property-previous-allowed-value~) ::
+- {{{kbd(S-RIGHT)}}} (~org-property-next-allowed-value~), {{{kbd(S-LEFT)}}}
(~org-property-previous-allowed-value~) ::
#+kindex: S-RIGHT
#+kindex: S-LEFT
@@ -10252,9 +10252,9 @@ the other commands, point needs to be in the desired
line.
Unmark entry for bulk action.
-- {{{kbd(U)}}} (~org-agenda-bulk-remove-all-marks~) ::
+- {{{kbd(U)}}} (~org-agenda-bulk-unmark-all~) ::
#+kindex: U
- #+findex: org-agenda-bulk-remove-all-marks
+ #+findex: org-agenda-bulk-unmark-all
Unmark all marked entries for bulk action.
@@ -11692,9 +11692,9 @@ When the variable ~org-export-dispatch-use-expert-ui~
is set to
a non-~nil~ value, Org prompts in the minibuffer. To switch back to
the hierarchical menu, press {{{kbd(?)}}}.
-- {{{kbd(C-c C-e)}}} (~org-export~) ::
+- {{{kbd(C-c C-e)}}} (~org-export-dispatch~) ::
#+kindex: C-c C-e
- #+findex: org-export
+ #+findex: org-export-dispatch
Invokes the export dispatcher interface. The options show default
settings. The {{{kbd(C-u)}}} prefix argument preserves options from
@@ -12232,7 +12232,7 @@ with the custom ID =theory=, you can use
The following command allows navigating to the included document:
-- {{{kbd(C-c ')}}} (~org-edit~special~) ::
+- {{{kbd(C-c ')}}} (~org-edit-special~) ::
#+kindex: C-c '
#+findex: org-edit-special
@@ -14363,10 +14363,10 @@ executable. Without it, export cannot finish.
:DESCRIPTION: Invoking export.
:END:
-- {{{kbd(C-c C-e o o)}}} (~org-export-to-odt~) ::
+- {{{kbd(C-c C-e o o)}}} (~org-odt-export-to-odt~) ::
#+kindex: C-c C-e o o
- #+findex: org-export-to-odt
+ #+findex: org-odt-export-to-odt
Export as OpenDocument Text file.
#+cindex: @samp{EXPORT_FILE_NAME}, property
@@ -18096,7 +18096,8 @@ evaluating untrusted code blocks by prompting for a
confirmation.
- =yes= ::
- Org always evaluates the source code without asking permission.
+ Org evaluates the source code, possibly asking permission according
+ to ~org-confirm-babel-evaluate~.
- =never= or =no= ::
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index d344feb2d63..acf32726895 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2728,6 +2728,7 @@ entry, @option{Seconds between keepalives} option. Set
this to 5.
There is no counter which could be set.
+@anchor{Using ssh connection sharing}
@subsection Using ssh connection sharing
@vindex ControlPath@r{, ssh option}
@@ -2758,19 +2759,32 @@ Note how @samp{%r}, @samp{%h} and @samp{%p} must be
encoded as
@samp{%%r}, @samp{%%h} and @samp{%%p}.
@vindex tramp-use-ssh-controlmaster-options
-If the @file{~/.ssh/config} file is configured appropriately for the
-above behavior, then any changes to @command{ssh} can be suppressed
-with this @code{nil} setting:
+Using a predefined string in @code{tramp-ssh-controlmaster-options},
+or puzzling an own string, happens only when user option
+@code{tramp-use-ssh-controlmaster-options} is set to @code{t}. If the
+@file{~/.ssh/config} file is configured appropriately for the above
+behavior, then any changes to @command{ssh} can be suppressed with
+this @code{nil} setting:
@lisp
(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@end lisp
+Sometimes, it is not possible to use OpenSSH's @option{ControlMaster}
+option for remote processes. This could result in concurrent access
+to the OpenSSH socket when reading data by different processes, which
+could block Emacs. In this case, setting
+@code{tramp-use-ssh-controlmaster-options} to @code{suppress} disables
+shared access. It is not needed to set this user option permanently
+to @code{suppress}, binding the user option prior calling
+@code{make-process} is sufficient. @value{tramp} does this for
+esxample for compilation processes on its own.
+
@vindex ProxyCommand@r{, ssh option}
@vindex ProxyJump@r{, ssh option}
-This should also be set to @code{nil} if you use the
-@option{ProxyCommand} or @option{ProxyJump} options in your
-@command{ssh} configuration.
+@code{tramp-use-ssh-controlmaster-options} should also be set to
+@code{nil} or @code{suppress} if you use the @option{ProxyCommand} or
+@option{ProxyJump} options in your @command{ssh} configuration.
In order to use the @option{ControlMaster} option, @value{tramp} must
check whether the @command{ssh} client supports this option. This is
@@ -3469,12 +3483,7 @@ much more appropriate.
@value{tramp} can complete the following @value{tramp} file name
components: method names, user names, host names, and file names
-located on remote hosts. User name and host name completion is
-activated only, if file name completion has one of the styles
-@code{basic}, @code{emacs21}, or @code{emacs22}.
-@ifinfo
-@xref{Completion Styles, , , emacs}.
-@end ifinfo
+located on remote hosts.
For example, type @kbd{C-x C-f @value{prefixwithspace} s @key{TAB}},
@value{tramp} completion choices show up as
@@ -3508,10 +3517,7 @@ directory @file{/sbin} on your local host.
Type @kbd{s h @value{postfixhop}} for the minibuffer completion to
@samp{@value{prefix}ssh@value{postfixhop}}. Typing @kbd{@key{TAB}}
shows host names @value{tramp} extracts from @file{~/.ssh/config}
-@c bug#50387
-file, for example@footnote{Some completion styles, like
-@code{substring} or @code{flex}, require to type at least one
-character after the trailing @samp{@value{postfixhop}}.}.
+file, for example:
@example
@group
@@ -4296,7 +4302,8 @@ In order to gain even more performance, it is recommended
to bind
@code{start-file-process}. Furthermore, you might set
@code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to
bypass @value{tramp}'s handling of the @option{ControlMaster} options,
-and use your own settings in @file{~/.ssh/config}.
+and use your own settings in @file{~/.ssh/config}, @ref{Using ssh
+connection sharing}.
@node Cleanup remote connections
diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi
index 8ac5df9904c..850930a290f 100644
--- a/doc/misc/transient.texi
+++ b/doc/misc/transient.texi
@@ -1061,18 +1061,6 @@ For example, the scope of the
@code{magit-branch-configure} transient is
the branch whose variables are being configured.
@end defmac
-It is possible to define one or more groups independently of a prefix
-definition, which is useful when those groups are to be used by more
-than just one prefix command.
-
-@defmac transient-define-groups name group...
-This macro defines one or more groups of infix and suffix commands
-and stores them in a property of the symbol @var{NAME}. @var{GROUP} has the
-same form as for @code{transient-define-prefix}. Subsequently @var{NAME} can
-be used in a @var{GROUP} of @code{transient-define-prefix}, as described in the
-next section.
-@end defmac
-
@node Binding Suffix and Infix Commands
@section Binding Suffix and Infix Commands
@@ -1199,22 +1187,8 @@ a table.
Inside group specifications, including inside contained suffix
specifications, nothing has to be quoted and quoting anyway is
-invalid.
-
-How symbols are treated, depends on context. Inside suffix
-specifications they often name functions. However if they appear in
-a place where a group is expected, then they are treated as indirect
-group specifications. Such a symbol must have an associated group
-specification, created using @code{transient-define-groups}.
-
-Likewise a symbol can appear in a place where a suffix specification
-is expected. The value of the @code{transient--layout} property of that
-symbol must be a single suffix specification or a list of such
-specifications. Currently no macro exist that would create such a
-symbol, and this feature should usually not be used.
-
-The value following a keyword, can be explicitly unquoted using @code{,}.
-This feature is experimental and should be avoided as well.
+invalid. The value following a keyword, can be explicitly unquoted
+using @code{,}. This feature is experimental and should be avoided.
The form of suffix specifications is documented in the next node.
@@ -1240,7 +1214,7 @@ Suffix specifications have this form:
@lisp
([@var{LEVEL}]
- [@var{KEY}] [@var{DESCRIPTION}]
+ [@var{KEY} [@var{DESCRIPTION}]]
@var{COMMAND}|@var{ARGUMENT} [@var{KEYWORD} @var{VALUE}]...)
@end lisp
@@ -1279,8 +1253,7 @@ Any command will do; it does not need to have an object
associated
with it (as would be the case if @code{transient-define-suffix} or
@code{transient-define-infix} were used to define it).
-Anonymous, dynamically defined suffix commands are also supported.
-See information about the @code{:setup-children} function in @ref{Group
Specifications}.
+COMMAND can also be a @code{lambda} expression.
As mentioned above, the object that is associated with a command can
be used to set the default for certain values that otherwise have to
diff --git a/etc/AUTHORS b/etc/AUTHORS
index 26593958988..647b73aea4e 100644
--- a/etc/AUTHORS
+++ b/etc/AUTHORS
@@ -325,9 +325,9 @@ Andreas Politz: changed filenotify.el inotify.c
buffer-tests.el
Andreas Rottmann: changed emacsclient.1 emacsclient.c misc.texi server.el
Andreas Schwab: changed configure.ac lisp.h xdisp.c process.c alloc.c
- coding.c Makefile.in files.el fileio.c keyboard.c lread.c xterm.c fns.c
- src/Makefile.in editfns.c emacs.c print.c eval.c font.c xfns.c sysdep.c
- and 656 other files
+ coding.c Makefile.in files.el fileio.c keyboard.c emacs.c lread.c
+ xterm.c fns.c src/Makefile.in editfns.c print.c eval.c font.c xfns.c
+ sysdep.c and 656 other files
Andreas Seltenreich: changed nnweb.el gnus.texi message.el gnus-sum.el
gnus.el nnslashdot.el gnus-srvr.el gnus-util.el mm-url.el mm-uu.el
@@ -1575,7 +1575,7 @@ and co-wrote help-tests.el
and changed xdisp.c display.texi w32.c msdos.c w32fns.c simple.el
files.el fileio.c emacs.c keyboard.c w32term.c text.texi dispnew.c
w32proc.c files.texi frames.texi configure.ac lisp.h dispextern.h
- process.c ms-w32.h and 1236 other files
+ process.c editfns.c and 1237 other files
Eliza Velasquez: changed server.el
@@ -1984,7 +1984,7 @@ Gerd Möllmann: wrote authors.el ebrowse.el jit-lock.el
tooltip.el
and changed xdisp.c xterm.c dispnew.c dispextern.h xfns.c xfaces.c
window.c keyboard.c lisp.h faces.el alloc.c buffer.c startup.el xterm.h
fns.c simple.el term.c configure.ac frame.c xmenu.c emacs.c
- and 609 other files
+ and 610 other files
Gergely Nagy: changed erc.el
@@ -4787,8 +4787,8 @@ Robert P. Goldman: changed org.texi ob-exp.el org.el
ox-latex.el
Robert Pluim: wrote nsm-tests.el
and changed configure.ac process.c blocks.awk network-stream-tests.el
font.c processes.texi ftfont.c gtkutil.c vc-git.el process-tests.el
- emoji-zwj.awk gnutls.el network-stream.el nsm.el tramp.texi mml-sec.el
- nsterm.m unicode xfns.c auth.texi composite.c and 139 other files
+ custom.texi emoji-zwj.awk gnutls.el network-stream.el nsm.el tramp.texi
+ unicode mml-sec.el nsterm.m xfns.c auth.texi and 140 other files
Robert Thorpe: changed cus-start.el indent.el rmail.texi
@@ -5182,7 +5182,7 @@ and co-wrote help-tests.el keymap-tests.el
and changed efaq.texi checkdoc.el package.el cperl-mode.el bookmark.el
help.el keymap.c subr.el simple.el erc.el ediff-util.el idlwave.el
time.el bytecomp-tests.el comp.el emacs-lisp-intro.texi speedbar.el
- bytecomp.el edebug.el flyspell.el ibuffer.el and 1348 other files
+ bytecomp.el edebug.el flyspell.el ibuffer.el and 1352 other files
Stefan Merten: co-wrote rst.el
@@ -5937,7 +5937,7 @@ W. Trevor King: changed xterm.el
Xavier Maillard: changed gnus-faq.texi gnus-score.el mh-utils.el spam.el
-Xi Lu: changed etags.c tramp-sh.el
+Xi Lu: changed etags.c htmlfontify.el ruby-mode.el tramp-sh.el
Xu Chunyang: changed eww.el dom.el gud.el netrc.el
@@ -5953,8 +5953,8 @@ Yair F: changed hebrew.el
Yamamoto Mitsuharu: wrote uvs.el
and changed macterm.c macfns.c mac-win.el xterm.c mac.c macterm.h image.c
- macmenu.c macgui.h xdisp.c ftfont.c xfns.c keyboard.c macselect.c
- ftcrfont.c macfont.m configure.ac w32term.c dispextern.h
+ macmenu.c macgui.h xdisp.c ftfont.c xfns.c ftcrfont.c keyboard.c
+ macselect.c macfont.m configure.ac w32term.c dispextern.h
src/Makefile.in unexmacosx.c and 111 other files
Yan Gajdos: changed vc-git.el
@@ -6005,7 +6005,7 @@ Yuchen Pei: changed calendar.texi diary-lib.el
icalendar-tests.el
Yue Daian: wrote cl-font-lock.el
-Yuga Ego: changed emacs-lisp-intro.texi
+Yuga Ego: changed custom.texi emacs-lisp-intro.texi
Yu-ji Hosokawa: changed README.W32
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 9d09172401f..434bfab94e9 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -44,21 +44,26 @@ The 'networks' module is now all but required for everyday
interactive
use. A default member of 'erc-modules' since ERC 5.3, 'networks' has
grown increasingly integral to core client operations over the years.
From now on, only the most essential operations will be officially
-supported in its absence, and users will see a warning upon
-entry-point invocation when it's not present.
+supported in its absence, and users will see a warning upon invoking
+an entry point, like 'erc-tls', when that's the case.
-** Tighter auth-source integration with bigger changes on the horizon.
+On a related note, the function 'erc-network' now always returns
+non-nil in buffers created by a successfully established IRC
+connection, even after that connection has been closed. This was done
+to aid the overall effort to improve buffer association.
+
+** Tighter auth-source integration.
The days of hit-and-miss auth-source queries are hopefully behind us.
With the overhaul of the services module temporarily shelved and the
transition to SASL-based authentication still underway, users may feel
left in the lurch to endure yet another release cycle of backtick
hell. For some, auth-source may provide a workaround in the form of
-nonstandard server passwords. See the section titled "auth-source" in
-the Integrations chapter of ERC's manual.
+nonstandard server passwords. See the section entitled "auth-source"
+in the Integrations chapter of ERC's manual.
** Rudimentary SASL support has arrived.
-A new module, 'erc-sasl', now ships with ERC 5.5. See the SASL
-section in the manual for details.
+A new module, 'erc-sasl', now ships with ERC. See Info node "(erc)
+SASL" in the manual for details.
** Username argument for entry-point commands.
Commands 'erc' and 'erc-tls' now accept a ':user' keyword argument,
@@ -77,19 +82,36 @@ now avoids any hijacking of the active window as well.
Beyond this, additional flexibility is now available for controlling
the behavior of newly created target buffers during reconnection.
+See the option 'erc-reconnect-display' for more.
** Improved handling of multiline prompt input.
This means better detection and handling of intervening and trailing
blanks when 'erc-send-whitespace-lines' is active. New options have
also been added for warning when input spans multiple lines. Although
-off by default, new users are encouraged to enable them.
+off by default, new users are encouraged to enable them. See options
+'erc-inhibit-multiline-input' and 'erc-ask-about-multiline-input'.
** URL handling has improved.
Clicking on 'irc://' and 'ircs://' links elsewhere in Emacs now does
the right thing most of the time. However, for security reasons,
users are now prompted to confirm connection parameters prior to lift
-off. See the new '(erc) Integrations' section in the Info manual to
-override this.
+off. See the new '(erc) Integrations' section in the Info manual for
+details.
+
+** ERC's major-mode hook now runs slightly later.
+The function 'erc-open' now delays running 'erc-mode-hook' until ERC's
+prompt and its bounding markers and many essential local variables
+have been initialized. Those essentials include the familiar
+'erc-default-recipients', 'erc-server-users', and 'erc-network', as
+well as the various "session" variables, like 'erc-session-connector'.
+ERC activates "local modules" immediately afterward, just before
+running 'erc-connect-pre-hook', which is still useful for gaining a
+full accounting of what's been set.
+
+In similar news, 'erc-open' no longer calls 'erc-update-modules'.
+However, it still activates modules in a similar fashion, meaning,
+among other things, global-module setup still occurs before major-mode
+activation (something that's here to stay for compatibility reasons).
** Miscellaneous behavioral changes impacting the user experience.
A bug has been fixed that saw prompts being mangled, doubled, or
@@ -99,52 +121,61 @@ now collapse into an alternate form designated by the
option
but can be fine-tuned via the repurposed, formerly abandoned option
'erc-hide-prompt'.
-Certain commands provided by the 'erc-match' module, such as
-'erc-add-keyword', 'erc-add-pal', and others, now optionally ask
-whether to 'regexp-quote' the current input. A new option,
-'erc-match-quote-when-adding', has been added to allow for retaining
-the old behavior, if desired.
-
-A bug has been fixed affecting users of the Soju bouncer: outgoing
-messages during periods of heavy traffic no longer disappear.
-
-Although rare, server passwords containing white space are now handled
-correctly.
-
-** Miscellaneous behavioral changes in the library API.
-A number of core macros and other definitions have been moved to a new
-file called erc-common.el. This was done to further lessen the
-various complications arising from the mutual dependency between 'erc'
-and 'erc-backend'.
+Another fix-turned-feature involves certain commands provided by the
+'erc-match' module, such as 'erc-add-keyword', 'erc-add-pal', and
+others, which now optionally offer to 'regexp-quote' the current
+input. The old behavior, if desired, can still be had via the new
+option 'erc-match-quote-when-adding'.
-The function 'erc-network' always returns non-nil in server and target
-buffers belonging to a successfully established IRC connection, even
-after that connection has been closed. (Also see the note in the
-section above about the 'networks' module basically being mandatory.)
-
-In 5.4, support for network symbols as keys was added for
+In 5.4, support for using network symbols as keys was added for
'erc-autojoin-channels-alist'. This has been extended to include
explicit symbols passed to 'erc-tls' and 'erc' as so-called
network-context identifiers via a new ':id' keyword. The latter
carries wider significance beyond autojoin and can be used for
unequivocally identifying a connection in a human-readable way.
-The function 'erc-auto-query' was deemed too difficult to reason
-through and has thus been deprecated with no public replacement; it
-has also been removed from the client code path.
-
-The function 'erc-open' now delays running 'erc-mode-hook' members
-until most local session variables have been initialized (minus those
-connection-related ones in erc-backend). 'erc-open' also no longer
-calls 'erc-update-modules', although modules are still activated
-in an identical fashion.
-
-Some groundwork has been laid for what may become a new breed of ERC
-module, namely, "connection-local" (or simply "local") modules.
+A number of UX-centric bug fixes accompany this release. For example,
+spaces are now possible in server passwords, and users of the Soju
+bouncer should no longer see outgoing messages pile up during periods
+of heavy traffic. See the Emacs change log for the full complement.
-A few internal variables have been introduced that could just as well
-have been made public, possibly as user options. Likewise for some
-internal functions. As always, users needing such functionality
+** Miscellaneous behavioral changes in the library API.
+A number of core macros and other definitions have been moved to a new
+file called erc-common.el. This was done to help mitigate various
+complications arising from the mutual dependency between 'erc' and
+'erc-backend'.
+
+Also on the maintainability front, ERC now relies on the Compat
+library from GNU ELPA to supply forward compatibility shims for users
+running older versions of Emacs. The required Compat version resides
+atop ERC's main library file, in the 'Package-Requires' header.
+Third-party modules should benefit automatically from its adoption.
+
+In an effort to help further tame ERC's complexity, the variable
+'erc-default-recipients' is now expected to hold but a single target.
+As a consequence, functions like 'erc-add-default-channel' that
+imagine an alternate, aspirational model of buffer-target relations
+have been deprecated. See Emacs change-log entries from around July
+of 2022 for specifics.
+
+A number of less consequential deprecations also debut in this
+release. For example, the function 'erc-auto-query' was deemed too
+difficult to understand, behavior wise, and has thus been stricken
+from the client code path with no public replacement. Although likely
+uncontroversial, such changes may still spell disruption for some. If
+you find yourself among them and in need of explanations, please see
+related entries in the change log and discussions on the bug tracker.
+
+Although this release is light on API features, some groundwork has
+been laid for what may become a new breed of ERC module, namely,
+"connection-local" (or simply "local") modules. This marks a small
+but crucial step forward toward a more flexible and granular revamping
+of ERC's long touted extensibility. See the Info node "(erc) Local
+Modules" for details.
+
+Lastly, a few internal variables have been introduced that could just
+as well have been made public, possibly as user options. Likewise for
+some internal functions. As always, users needing such functionality
officially exposed are encouraged to write to emacs-erc@gnu.org.
diff --git a/etc/HISTORY b/etc/HISTORY
index 9e4becc946e..8b80473e321 100644
--- a/etc/HISTORY
+++ b/etc/HISTORY
@@ -228,6 +228,8 @@ GNU Emacs 28.1 (2022-04-04) emacs-28.1
GNU Emacs 28.2 (2022-09-12) emacs-28.2
+GNU Emacs 28.3 (2023-02-17) emacs-28.3
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/NEWS b/etc/NEWS
index e0175bacfdf..540b59a628f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -56,58 +56,29 @@ This allows the user to customize the prompt that is
appended by
'yes-or-no-p' when asking questions. The default value is
"(yes or no) ".
+---
+** New face 'display-time-date-and-time'.
+This is used for displaying the time and date components of
+'display-time-mode'.
+
* Editing Changes in Emacs 30.1
+---
+** On X, Emacs now supports input methods which perform "string conversion".
+This means an input method can now ask Emacs to delete text
+surrounding point and replace it with something else, as well as query
+Emacs for surrounding text. If your input method allows you to "undo"
+mistaken compositions, this will now work as well.
+
---
** New command 'kill-matching-buffers-no-ask'.
This works like 'kill-matching-buffers', but without asking for
confirmation.
-+++
-** New helper variable 'transpose-sexps-function'.
-Emacs now can set this variable to customize the behavior of the
-'transpose-sexps' function.
-
-+++
-** New function 'transpose-sexps-default-function'.
-The previous implementation is moved into its own function, to be
-bound by 'transpose-sexps-function'.
-
-** New function 'treesit-transpose-sexps'.
-Tree-sitter now unconditionally sets 'transpose-sexps-function' for all
-tree-sitter enabled modes. This functionality utilizes the new
-'transpose-sexps-function'.
-
-** Commands and variables to move by program statements
-
-*** New variable 'forward-sentence-function'.
-Major modes can now set this variable to customize the behavior of the
-'forward-sentence' command.
-
-*** New function 'forward-sentence-default-function'.
-The previous implementation of 'forward-sentence' is moved into its
-own function, to be bound by 'forward-sentence-function'.
-
-*** New buffer-local variable 'treesit-sentence-type-regexp'.
-Similarly to 'treesit-defun-type-regexp', this variable is used to
-define "sentences" in tree-sitter enabled modes.
-
-*** New function 'treesit-forward-sentence'.
-All tree-sitter enabled modes that define 'treesit-sentence-type-regexp'
-now set 'forward-sentence-function' to call 'treesit-forward-sentence'.
-
-*** New buffer-local variable 'treesit-sexp-type-regexp'.
-Similarly to 'treesit-defun-type-regexp', this variable is used to
-define "sexps" in tree-sitter enabled modes.
-
-*** New function 'treesit-forward-sexp'.
-Tree-sitter conditionally sets 'forward-sexp-function' for major modes
-that have defined 'treesit-sexp-type-regexp' to enable sexp-related
-motion commands.
-
* Changes in Specialized Modes and Packages in Emacs 30.1
+
---
** Variable order and truncation can now be configured in 'gdb-many-windows'.
The new user option 'gdb-locals-table-row-config' allows users to
@@ -124,6 +95,15 @@ If you want to get back the old behavior, set the user
option to the value
(setopt gdb-locals-table-row-config
`((type . 0) (name . 0) (value . ,gdb-locals-value-limit)))
+** Compile
+
+*** New user option 'grep-use-headings'.
+When non-nil, the output of Grep is split into sections, one for each
+file, instead of having file names prefixed to each line. It is
+equivalent to the "--heading" option of some tools such as 'git grep'
+and 'rg'. The headings are displayed using the new 'grep-heading'
+face.
+
** VC
---
@@ -132,6 +112,20 @@ This is a string or a list of strings that specifies the
Git log
switches for shortlogs, such as the one produced by 'C-x v L'.
'vc-git-log-switches' is no longer used for shortlogs.
+** Diff Mode
+
++++
+*** 'diff-ignore-whitespace-hunk' can now be applied to all hunks.
+When called with a non-nil prefix argument,
+'diff-ignore-whitespace-hunk' now iterates over all the hunks in the
+current diff, regenerating them without whitespace changes.
+
++++
+*** New user option 'diff-ignore-whitespace-switches'.
+This allows changing which type of whitespace changes are ignored when
+regenerating hunks with 'diff-ignore-whitespace-hunk'. Defaults to
+the previously hard-coded "-b".
+
** Buffer Selection
---
@@ -165,6 +159,11 @@ this to your configuration:
(keymap-set eshell-mode-map "<home>" #'eshell-bol-ignoring-prompt)
+---
+*** You can now properly unload Eshell.
+Calling '(unload-feature 'eshell)' no longer signals an error, and now
+correctly unloads Eshell and all of its modules.
+
+++
*** 'eshell-read-aliases-list' is now an interactive command.
After manually editing 'eshell-aliases-file', you can use this command
@@ -185,6 +184,12 @@ point is not in a comment or a string. It is by default
bound to
*** New connection method "toolbox".
This allows accessing system containers provided by Toolbox.
++++
+*** New value 'suppress' for user option 'tramp-use-ssh-controlmaster-options'.
+This user option allows now the values t, nil, and 'suppress'. The
+latter suppresses also "ControlMaster" settings in the user's
+"~/.ssh/config" file.
+
** EWW
+++
@@ -202,10 +207,17 @@ This command adds a docstring comment to the current
defun. If a
comment already exists, point is only moved to the comment. It is
bound to 'C-c C-d' in 'go-ts-mode'.
+** Man-mode
+
++++
+*** New user option 'Man-prefer-synchronous-call'.
+When this is non-nil, call the 'man' program synchronously rather than
+asynchronously (which is the default behavior).
+
* New Modes and Packages in Emacs 30.1
-** New major modes based on the tree-sitter library.
+** New major modes based on the tree-sitter library
+++
*** New major mode 'html-ts-mode'.
@@ -230,9 +242,61 @@ their customization options.
This user option has been obsoleted in Emacs 27, use
'remote-file-name-inhibit-cache' instead.
+---
+** User options 'eshell-NAME-unload-hook' are now obsolete.
+These hooks were named incorrectly, and so they never actually ran
+when unloading the correspending feature. Instead, you should use
+hooks named after the feature name, like 'esh-mode-unload-hook'.
+
* Lisp Changes in Emacs 30.1
+** Functions and variables to transpose sexps
+
++++
+*** New helper variable 'transpose-sexps-function'.
+Emacs now can set this variable to customize the behavior of the
+'transpose-sexps' function.
+
++++
+*** New function 'transpose-sexps-default-function'.
+The previous implementation is moved into its own function, to be
+bound by 'transpose-sexps-function'.
+
+*** New function 'treesit-transpose-sexps'.
+Tree-sitter now unconditionally sets 'transpose-sexps-function' for all
+tree-sitter enabled modes. This functionality utilizes the new
+'transpose-sexps-function'.
+
+** Functions and variables to move by program statements
+
+*** New variable 'forward-sentence-function'.
+Major modes can now set this variable to customize the behavior of the
+'forward-sentence' command.
+
+*** New function 'forward-sentence-default-function'.
+The previous implementation of 'forward-sentence' is moved into its
+own function, to be bound by 'forward-sentence-function'.
+
+*** New buffer-local variable 'treesit-sentence-type-regexp'.
+Similarly to 'treesit-defun-type-regexp', this variable is used to
+define "sentences" in tree-sitter enabled modes.
+
+*** New function 'treesit-forward-sentence'.
+All tree-sitter enabled modes that define 'treesit-sentence-type-regexp'
+now set 'forward-sentence-function' to call 'treesit-forward-sentence'.
+
+** Functions and variables to move by program sexps
+
+*** New buffer-local variable 'treesit-sexp-type-regexp'.
+Similarly to 'treesit-defun-type-regexp', this variable is used to
+define "sexps" in tree-sitter enabled modes.
+
+*** New function 'treesit-forward-sexp'.
+Tree-sitter conditionally sets 'forward-sexp-function' for major modes
+that have defined 'treesit-sexp-type-regexp' to enable sexp-related
+motion commands.
+
** New or changed byte-compilation warnings
---
@@ -279,12 +343,47 @@ compared reliably at all.
This warning can be suppressed using 'with-suppressed-warnings' with
the warning name 'suspicious'.
+---
+*** Warn about 'condition-case' without handlers.
+The compiler now warns when the 'condition-case' form is used without
+any actual handlers, as in
+
+ (condition-case nil (read buffer))
+
+because it has no effect other than the execution of the body form.
+In particular, no errors are caught or suppressed. If the intention
+was to catch all errors, add an explicit handler for 'error', or use
+'ignore-error' or 'ignore-errors'.
+
+This warning can be suppressed using 'with-suppressed-warnings' with
+the warning name 'suspicious'.
+
++++
+** New function 'safe-copy-tree'
+This function is a version of copy-tree which handles circular lists
+and circular vectors/records.
+
+++
** New function 'file-user-uid'.
This function is like 'user-uid', but is aware of file name handlers,
so it will return the remote UID for remote files (or -1 if the
connection has no associated user).
++++
+** 'fset' and 'defalias' now signal an error for circular alias chains.
+Previously, 'fset' and 'defalias' could be made to build circular
+function indirection chains as in
+
+ (defalias 'able 'baker)
+ (defalias 'baker 'able)
+
+but trying to call them would often make Emacs hang. Now, an attempt
+to create such a loop results in an error.
+
+Since circular alias chains now cannot occur, 'function-alias-p' and
+'indirect-function' will never signal an error. Their second
+'noerror' arguments have no effect and are therefore obsolete.
+
* Changes in Emacs 30.1 on Non-Free Operating Systems
diff --git a/etc/NEWS.29 b/etc/NEWS.29
index e3cbeb84d30..01ab4b8a1db 100644
--- a/etc/NEWS.29
+++ b/etc/NEWS.29
@@ -199,13 +199,6 @@ load time.
** Native Compilation
+++
-*** New variable 'inhibit-automatic-native-compilation'.
-If set, Emacs will inhibit native compilation (and won't write
-anything to the eln cache automatically). The variable is initialized
-during Emacs startup from the environment variable
-'EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION'.
-
----
*** New command 'native-compile-prune-cache'.
This command deletes old subdirectories of the eln cache (but not the
ones for the current Emacs version). Note that subdirectories of the
@@ -570,7 +563,7 @@ documented from day one; it just didn't behave according to
documentation. It turns out some Lisp programs were using this
coding-system on the wrong assumption that the "auto" part means some
automagic handling of the end-of-line (EOL) format conversion; those
-program will now start to fail, because BOM signature in UTF-8 encoded
+programs will now start to fail, because BOM signature in UTF-8 encoded
text is rarely expected. That is the reason we mention this bugfix
here.
@@ -615,8 +608,19 @@ with 'C-x x t', or try disabling all known slow minor
modes with
and the major mode with 'M-x so-long-mode', or visit the file with
'M-x find-file-literally' instead of the usual 'C-x C-f'.
-Note that the display optimizations in these cases may cause the
-buffer to be occasionally mis-fontified.
+In buffers in which these display optimizations are in effect, the
+'fontification-functions', 'pre-command-hook' and 'post-command-hook'
+hooks are executed on a narrowed portion of the buffer, whose size is
+controlled by the variables 'long-line-optimizations-region-size' and
+'long-line-optimizations-bol-search-limit', as if they were in a
+'with-restriction' form. This may, in particular, cause occasional
+mis-fontifications in these buffers. Modes which are affected by
+these optimizations and by the fact that the buffer is narrowed,
+should adapt and either modify their algorithm so as not to expect the
+entire buffer to be accessible, or, if accessing outside of the
+narrowed region doesn't hurt performance, use the
+'without-restriction' form to temporarily lift the restriction and
+access portions of the buffer outside of the narrowed region.
The new function 'long-line-optimizations-p' returns non-nil when
these optimizations are in effect in the current buffer.
@@ -825,10 +829,11 @@ filter/sentinel error has been handled.
** New faces for font-lock.
These faces are primarily meant for use with tree-sitter. They are:
'font-lock-bracket-face', 'font-lock-delimiter-face',
-'font-lock-escape-face', 'font-lock-misc-punctuation-face',
-'font-lock-number-face', 'font-lock-operator-face',
-'font-lock-property-face', and 'font-lock-punctuation-face',
-'font-lock-regexp-face'.
+'font-lock-escape-face', 'font-lock-function-call-face',
+'font-lock-misc-punctuation-face', 'font-lock-number-face',
+'font-lock-operator-face', 'font-lock-property-name-face',
+'font-lock-property-use-face', 'font-lock-punctuation-face',
+'font-lock-regexp-face', and 'font-lock-variable-use-face'.
+++
** New face 'variable-pitch-text'.
@@ -1157,12 +1162,6 @@ and 'C-x w 3', respectively. A number of other useful
window-related
commands are now available with key sequences that start with the
'C-x w' prefix.
-+++
-*** New user option 'display-buffer-avoid-small-windows'.
-If non-nil, this should be a window height in lines, a number.
-Windows smaller than this will be avoided by 'display-buffer', if
-possible.
-
+++
*** New display action 'display-buffer-full-frame'.
This action removes other windows from the frame when displaying a
@@ -1177,6 +1176,33 @@ For example, a 'display-buffer-alist' entry of
will make the body of the chosen window 40 columns wide. For the
height use 'window-height' and 'body-lines', respectively.
++++
+*** 'display-buffer' provides more options for using an existing window.
+The display buffer action functions 'display-buffer-use-some-window' and
+'display-buffer-use-least-recent-window' now honor the action alist
+entry 'window-min-height' as well as the entries listed below to make
+the display of several buffers in a row more amenable.
+
++++
+*** New buffer display action alist entry 'lru-frames'.
+This allows to specify which frames 'display-buffer' should consider
+when using a window that shows another buffer.
+
++++
+*** New buffer display action alist entry 'lru-time'.
+'display-buffer' will ignore windows with a use time higher than that
+when using a window that shows another buffer.
+
++++
+*** New buffer display action alist entry 'bump-use-time'.
+This has 'display-buffer' bump the use time of any window it returns,
+making it a less likely candidate for displaying another buffer.
+
++++
+*** New buffer display action alist entry 'window-min-width'.
+This allows to specify a minimum width of the window used to display a
+buffer.
+
---
*** You can customize on which window 'scroll-other-window' operates.
This is controlled by the new 'other-window-scroll-default' variable.
@@ -1191,6 +1217,14 @@ the most recently deleted frame. With a numerical
prefix argument
between 1 and 16, where 1 is the most recently deleted frame, undelete
the corresponding deleted frame.
++++
+*** The variable 'icon-title-format' can now have the value t.
+That value means to use 'frame-title-format' for iconified frames.
+This is useful with some window managers and desktop environments
+which treat changes in frame's title as requests to raise the frame
+and/or give it input focus, or if you want the frame's title to be the
+same no matter if the frame is iconified or not.
+
** Tab Bars and Tab Lines
---
@@ -2051,6 +2085,18 @@ command accepts the Unicode name of an Emoji (for
example, "smiling
face" or "heart with arrow"), like 'C-x 8 e e', with minibuffer
completion, and adds the Emoji into the search string.
+** GDB/MI
+
+---
+*** New user option 'gdb-debuginfod-enable-setting'.
+On capable platforms, GDB 10.1 and later can download missing source
+and debug info files from special-purpose servers, called "debuginfod
+servers". Use this new option to control whether 'M-x gdb' instructs
+GDB to download missing files from debuginfod servers when you debug
+the corresponding programs. The default is to ask you at the
+beginning of each debugging session whether to download the files for
+that session.
+
** Glyphless Characters
+++
@@ -2135,6 +2181,10 @@ before execution. For example, in a Git repository, you
can produce a
log of more than one branch by typing 'C-x v ! C-x v b l' and then
appending additional branch names to the 'git log' command.
+The intention is that this command can be used to access a wide
+variety of version control system-specific functionality from VC
+without complexifying either the VC command set or the backend API.
+
---
*** 'C-x v v' in a diffs buffer allows to commit only some of the changes.
This command is intended to allow you to commit only some of the
@@ -3193,8 +3243,11 @@ manually if needed, using the new user options
'wallpaper-command' and
+++
** New package 'oclosure'.
-This allows the creation of "functions with slots" or "function
-objects" via the macros 'oclosure-define' and 'oclosure-lambda'.
+This allows the creation of OClosures, which are "functions with
+slots" or "function objects" that expose additional information about
+themselves. Use the new macros 'oclosure-define' and
+'oclosure-lambda' to create OClosures. See the "(elisp) OClosures"
+node for more information.
+++
*** New generic function 'oclosure-interactive-form'.
@@ -3240,8 +3293,10 @@ for which a "built-in" mode would be turned on. For
example:
(add-to-list 'major-mode-remap-alist '(ruby-mode . ruby-ts-mode))
If you try these modes and don't like them, you can go back to the
-"built-in" modes by restarting Emacs. But please tell us why you
-didn't like the tree-sitter based modes, so that we could try
+"built-in" modes by restarting Emacs. (If you use desktop.el to save
+and restore Emacs sessions, make sure no buffer under these modes is
+recorded in the desktop file, before restarting.) But please tell us
+why you didn't like the tree-sitter based modes, so that we could try
improving them.
Each major mode based on tree-sitter needs a language grammar library,
@@ -3814,6 +3869,14 @@ TIMEOUT is the idle time after which to deactivate the
transient map.
The default timeout value can be defined by the new variable
'set-transient-map-timeout'.
++++
+** New forms 'with-restriction' and 'without-restriction'.
+These forms can be used as enhanced alternatives to the
+'save-restriction' form combined with, respectively,
+'narrow-to-region' and 'widen'. They also accept an optional label
+argument, with which labeled narrowings can be created and lifted.
+See the "(elisp) Narrowing" node for details.
+
** Connection Local Variables
+++
@@ -3946,9 +4009,11 @@ This argument can be used to override values of
print-related settings.
+++
** New minor mode 'header-line-indent-mode'.
-This is meant to be used in modes that have a header line that should
-be kept aligned with the buffer contents when the user switches
-'display-line-numbers-mode' on or off.
+This is meant to be used by Lisp programs that show a header line
+which should be kept aligned with the buffer contents when the user
+switches 'display-line-numbers-mode' on or off, and when the width of
+line-number display changes. See the "(elisp) Header Lines" node in
+the Emacs Lisp Reference manual for more information.
+++
** New global minor mode 'lost-selection-mode'.
diff --git a/etc/compilation.txt b/etc/compilation.txt
index 672cbebafff..5f6ecb09cc2 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -639,6 +639,20 @@ symbol: weblint
index.html (13:1) Unknown element <fdjsk>
+* Typescript prior to tsc version 2.7, "plain" format
+
+symbol: typescript-tsc-plain
+
+greeter.ts(30,12): error TS2339: Property 'foo' does not exist.
+
+
+* Typescript after tsc version 2.7, "pretty" format
+
+symbol: typescript-tsc-pretty
+
+src/resources/document.ts:140:22 - error TS2362: something.
+
+
* Directory tracking
Directories are matched via 'compilation-directory-matcher'. Files which are
diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop
index 91df122c594..49c6f99f317 100644
--- a/etc/emacsclient-mail.desktop
+++ b/etc/emacsclient-mail.desktop
@@ -1,7 +1,10 @@
[Desktop Entry]
Categories=Network;Email;
Comment=GNU Emacs is an extensible, customizable text editor - and more
-Exec=sh -c "exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\"
--eval \\"(message-mailto \\\\\\"\\$1\\\\\\")\\"" sh %u
+# We want to pass the following commands to the shell wrapper:
+# u=${1//\\/\\\\}; u=${u//\"/\\\"}; exec emacsclient --alternate-editor=
--display="$DISPLAY" --eval "(message-mailto \"$u\")"
+# Special chars '"', '$', and '\' must be escaped as '\\"', '\\$', and '\\\\'.
+Exec=bash -c "u=\\${1//\\\\\\\\/\\\\\\\\\\\\\\\\};
u=\\${u//\\\\\\"/\\\\\\\\\\\\\\"}; exec emacsclient --alternate-editor=
--display=\\"\\$DISPLAY\\" --eval \\"(message-mailto \\\\\\"\\$u\\\\\\")\\""
bash %u
Icon=emacs
Name=Emacs (Mail, Client)
MimeType=x-scheme-handler/mailto;
@@ -13,7 +16,7 @@ Actions=new-window;new-instance;
[Desktop Action new-window]
Name=New Window
-Exec=sh -c "exec emacsclient --alternate-editor= --create-frame --eval
\\"(message-mailto \\\\\\"\\$1\\\\\\")\\"" sh %u
+Exec=bash -c "u=\\${1//\\\\\\\\/\\\\\\\\\\\\\\\\};
u=\\${u//\\\\\\"/\\\\\\\\\\\\\\"}; exec emacsclient --alternate-editor=
--create-frame --eval \\"(message-mailto \\\\\\"\\$u\\\\\\")\\"" bash %u
[Desktop Action new-instance]
Name=New Instance
diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt
index 54988c7187c..3b920e67ed0 100644
--- a/etc/publicsuffix.txt
+++ b/etc/publicsuffix.txt
@@ -380,11 +380,29 @@ org.bi
// biz : https://en.wikipedia.org/wiki/.biz
biz
-// bj : https://en.wikipedia.org/wiki/.bj
+// bj : https://nic.bj/bj-suffixes.txt
+// submitted by registry <contact@nic.bj>
bj
-asso.bj
-barreau.bj
-gouv.bj
+africa.bj
+agro.bj
+architectes.bj
+assur.bj
+avocats.bj
+co.bj
+com.bj
+eco.bj
+econo.bj
+edu.bj
+info.bj
+loisirs.bj
+money.bj
+net.bj
+org.bj
+ote.bj
+resto.bj
+restaurant.bj
+tourism.bj
+univ.bj
// bm : http://www.bermudanic.bm/dnr-text.txt
bm
@@ -7171,7 +7189,7 @@ org.zw
// newGTLDs
-// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2022-12-07T15:13:11Z
+// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2023-02-22T15:15:03Z
// This list is auto-generated, don't edit it manually.
// aaa : 2015-02-26 American Automobile Association, Inc.
aaa
@@ -8370,7 +8388,7 @@ glass
// gle : 2014-07-24 Charleston Road Registry Inc.
gle
-// global : 2014-04-17 Dot Global Domain Registry Limited
+// global : 2014-04-17 Identity Digital Limited
global
// globo : 2013-12-19 Globo Comunicação e Participações S.A
@@ -8913,9 +8931,6 @@ locker
// locus : 2015-06-25 Locus Analytics LLC
locus
-// loft : 2015-07-30 Annco, Inc.
-loft
-
// lol : 2015-01-30 XYZ.COM LLC
lol
@@ -9456,7 +9471,7 @@ pub
// pwc : 2015-10-29 PricewaterhouseCoopers LLP
pwc
-// qpon : 2013-11-14 dotCOOL, Inc.
+// qpon : 2013-11-14 dotQPON LLC
qpon
// quebec : 2013-12-19 PointQuébec Inc
@@ -9702,9 +9717,6 @@ sener
// services : 2014-02-27 Binky Moon, LLC
services
-// ses : 2015-07-23 SES
-ses
-
// seven : 2015-08-06 Seven West Media Ltd
seven
@@ -9789,7 +9801,7 @@ smart
// smile : 2014-12-18 Amazon Registry Services, Inc.
smile
-// sncf : 2015-02-19 Société Nationale des Chemins de fer Francais S N C F
+// sncf : 2015-02-19 Société Nationale SNCF
sncf
// soccer : 2015-03-26 Binky Moon, LLC
@@ -10026,7 +10038,7 @@ toray
// toshiba : 2014-04-10 TOSHIBA Corporation
toshiba
-// total : 2015-08-06 TOTAL SE
+// total : 2015-08-06 TotalEnergies SE
total
// tours : 2015-01-22 Binky Moon, LLC
@@ -10665,6 +10677,11 @@ adobeaemcloud.net
hlx.page
hlx3.page
+// Adobe Developer Platform : https://developer.adobe.com
+// Submitted by Jesse MacFadyen<jessem@adobe.com>
+adobeio-static.net
+adobeioruntime.net
+
// Agnat sp. z o.o. : https://domena.pl
// Submitted by Przemyslaw Plewa <it-admin@domena.pl>
beep.pl
@@ -10679,6 +10696,24 @@ airkitapps.eu
// Submitted by Etienne Stalmans <security@aiven.io>
aivencloud.com
+// Akamai : https://www.akamai.com/
+// Submitted by Akamai Team <publicsuffixlist@akamai.com>
+akadns.net
+akamai.net
+akamai-staging.net
+akamaiedge.net
+akamaiedge-staging.net
+akamaihd.net
+akamaihd-staging.net
+akamaiorigin.net
+akamaiorigin-staging.net
+akamaized.net
+akamaized-staging.net
+edgekey.net
+edgekey-staging.net
+edgesuite.net
+edgesuite-staging.net
+
// alboto.ca : http://alboto.ca
// Submitted by Anton Avramov <avramov@alboto.ca>
barsy.ca
@@ -10923,6 +10958,10 @@ cdn.prod.atlassian-dev.net
// Submitted by Lukas Reschke <lukas@authentick.net>
translated.page
+// Autocode : https://autocode.com
+// Submitted by Jacob Lee <jacob@autocode.com>
+autocode.dev
+
// AVM : https://avm.de
// Submitted by Andreas Weise <a.weise@avm.de>
myfritz.net
@@ -11051,6 +11090,11 @@ cafjs.com
// Submitted by Marcus Popp <admin@callidomus.com>
mycd.eu
+// Canva Pty Ltd : https://canva.com/
+// Submitted by Joel Aquilina <publicsuffixlist@canva.com>
+canva-apps.cn
+canva-apps.com
+
// Carrd : https://carrd.co
// Submitted by AJ <aj@carrd.co>
drr.ac
@@ -11968,6 +12012,7 @@ u.channelsdvr.net
// Fastly Inc. : http://www.fastly.com/
// Submitted by Fastly Security <security@fastly.com>
edgecompute.app
+fastly-edge.com
fastly-terrarium.com
fastlylb.net
map.fastlylb.net
@@ -12482,6 +12527,10 @@ ngo.ng
edu.scot
sch.so
+// HostFly : https://www.ie.ua
+// Submitted by Bohdan Dub <support@hostfly.com.ua>
+ie.ua
+
// HostyHosting (hostyhosting.com)
hostyhosting.io
@@ -12940,6 +12989,7 @@ cloudapp.net
azurestaticapps.net
1.azurestaticapps.net
2.azurestaticapps.net
+3.azurestaticapps.net
centralus.azurestaticapps.net
eastasia.azurestaticapps.net
eastus2.azurestaticapps.net
@@ -13006,7 +13056,19 @@ netlify.app
// ngrok : https://ngrok.com/
// Submitted by Alan Shreve <alan@ngrok.com>
+ngrok.app
+ngrok-free.app
+ngrok.dev
+ngrok-free.dev
ngrok.io
+ap.ngrok.io
+au.ngrok.io
+eu.ngrok.io
+in.ngrok.io
+jp.ngrok.io
+sa.ngrok.io
+us.ngrok.io
+ngrok.pizza
// Nimbus Hosting Ltd. : https://www.nimbushosting.co.uk/
// Submitted by Nicholas Ford <nick@nimbushosting.co.uk>
@@ -13526,6 +13588,56 @@ rocky.page
спб.рус
я.рус
+// SAKURA Internet Inc. : https://www.sakura.ad.jp/
+// Submitted by Internet Service Department <rs-vendor-ml@sakura.ad.jp>
+180r.com
+dojin.com
+sakuratan.com
+sakuraweb.com
+x0.com
+2-d.jp
+bona.jp
+crap.jp
+daynight.jp
+eek.jp
+flop.jp
+halfmoon.jp
+jeez.jp
+matrix.jp
+mimoza.jp
+ivory.ne.jp
+mail-box.ne.jp
+mints.ne.jp
+mokuren.ne.jp
+opal.ne.jp
+sakura.ne.jp
+sumomo.ne.jp
+topaz.ne.jp
+netgamers.jp
+nyanta.jp
+o0o0.jp
+rdy.jp
+rgr.jp
+rulez.jp
+s3.isk01.sakurastorage.jp
+s3.isk02.sakurastorage.jp
+saloon.jp
+sblo.jp
+skr.jp
+tank.jp
+uh-oh.jp
+undo.jp
+rs.webaccel.jp
+user.webaccel.jp
+websozai.jp
+xii.jp
+squares.net
+jpn.org
+kirara.st
+x0.to
+from.tv
+sakura.tv
+
// Salesforce.com, Inc. https://salesforce.com/
// Submitted by Michael Biven <mbiven@salesforce.com>
*.builder.code.com
@@ -13678,6 +13790,9 @@ vp4.me
// Snowflake Inc : https://www.snowflake.com/
// Submitted by Faith Olapade <faith.olapade@snowflake.com>
+snowflake.app
+privatelink.snowflake.app
+streamlit.app
streamlitapp.com
// Snowplow Analytics : https://snowplowanalytics.com/
@@ -13953,6 +14068,10 @@ hk.org
ltd.hk
inc.hk
+// UK Intis Telecom LTD : https://it.com
+// Submitted by ITComdomains <to@it.com>
+it.com
+
// UNIVERSAL DOMAIN REGISTRY : https://www.udr.org.yt/
// see also: whois -h whois.udr.org.yt help
// Submitted by Atanunu Igbunuroghene <publicsuffixlist@udr.org.yt>
diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex
index 093dfceafa7..dc222719b7e 100644
--- a/etc/refcards/orgcard.tex
+++ b/etc/refcards/orgcard.tex
@@ -1,6 +1,6 @@
% Reference Card for Org Mode
\def\orgversionnumber{9.6.1}
-\def\versionyear{2021} % latest update
+\def\versionyear{2023} % latest update
\input emacsver.tex
%**start of header
@@ -329,7 +329,7 @@
\key{archive subtree using the default command}{C-c C-x C-a}
\key{move subtree to archive file}{C-c C-x C-s}
\key{toggle ARCHIVE tag / to ARCHIVE sibling}{C-c C-x a/A}
-\key{force cycling of an ARCHIVEd tree}{C-TAB}
+\key{force cycling of an ARCHIVEd tree}{C-c C-TAB}
\section{Filtering and Sparse Trees}
diff --git a/etc/themes/modus-operandi-deuteranopia-theme.el
b/etc/themes/modus-operandi-deuteranopia-theme.el
index 2bee995c570..fff62e3da9f 100644
--- a/etc/themes/modus-operandi-deuteranopia-theme.el
+++ b/etc/themes/modus-operandi-deuteranopia-theme.el
@@ -83,7 +83,7 @@ standard).")
(yellow-faint "#624416")
(yellow-intense "#808000")
(blue "#0031a9")
- (blue-warmer "#354fcf")
+ (blue-warmer "#3548cf")
(blue-cooler "#0000b0")
(blue-faint "#003497")
(blue-intense "#0000ff")
@@ -157,7 +157,7 @@ standard).")
(bg-completion "#c0deff")
(bg-hover "#97dfed")
(bg-hover-secondary "#f5d0a0")
- (bg-hl-line "#d0d6ec")
+ (bg-hl-line "#dae5ec")
(bg-region "#bdbdbd")
(fg-region "#000000")
@@ -182,26 +182,28 @@ standard).")
;;; Diffs
- (bg-added "#d5d5ff")
+ (bg-added "#d5d7ff")
(bg-added-faint "#e6e6ff")
- (bg-added-refine "#b5b5ef")
- (bg-added-intense "#579acc")
- (fg-added "#333399")
- (fg-added-intense "#3333cc")
+ (bg-added-refine "#babcef")
+ (bg-added-fringe "#275acc")
+ (fg-added "#303099")
+ (fg-added-intense "#0303cc")
(bg-changed "#eecfdf")
(bg-changed-faint "#f0dde5")
(bg-changed-refine "#e0b0d0")
- (bg-changed-intense "#9f7abf")
+ (bg-changed-fringe "#9f6ab0")
(fg-changed "#6f1343")
- (fg-changed-intense "#7f1f5f")
+ (fg-changed-intense "#7f0f9f")
- (bg-removed "#fff585")
- (bg-removed-faint "#f2f2bb")
- (bg-removed-refine "#f0e068")
- (bg-removed-intense "#d7c20a")
+ (bg-removed "#f4f099")
+ (bg-removed-faint "#f6f6b7")
+ (bg-removed-refine "#f0e56f")
+ (bg-removed-fringe "#c0b200")
(fg-removed "#553d00")
- (fg-removed-intense "#655000")
+ (fg-removed-intense "#7f6f00")
+
+ (bg-diff-context "#f3f3f3")
;;; Paren match
@@ -380,10 +382,7 @@ as a symbol and the latter as a string.
Semantic color mappings have the form (MAPPING-NAME COLOR-NAME)
with both as symbols. The latter is a named color that already
-exists in the palette and is associated with a HEX-VALUE.
-
-Semantic color mappings cannot be recursive: their value must be
-either COLOR-NAME or HEX-VALUE.")
+exists in the palette and is associated with a HEX-VALUE.")
(defcustom modus-operandi-deuteranopia-palette-overrides nil
"Overrides for `modus-operandi-deuteranopia-palette'.
diff --git a/etc/themes/modus-operandi-theme.el
b/etc/themes/modus-operandi-theme.el
index 09ca8888073..0705f926de6 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -81,7 +81,7 @@ which corresponds to a minimum contrast in relative luminance
of
(yellow-faint "#624416")
(yellow-intense "#808000")
(blue "#0031a9")
- (blue-warmer "#354fcf")
+ (blue-warmer "#3548cf")
(blue-cooler "#0000b0")
(blue-faint "#003497")
(blue-intense "#0000ff")
@@ -155,7 +155,7 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-completion "#c0deff")
(bg-hover "#94d4ff")
(bg-hover-secondary "#f5d0a0")
- (bg-hl-line "#d0d6ec")
+ (bg-hl-line "#dae5ec")
(bg-region "#bdbdbd")
(fg-region "#000000")
@@ -183,24 +183,26 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-added "#c1f2d1")
(bg-added-faint "#d8f8e1")
(bg-added-refine "#aee5be")
- (bg-added-intense "#8cca8c")
+ (bg-added-fringe "#6cc06c")
(fg-added "#005000")
(fg-added-intense "#006700")
(bg-changed "#ffdfa9")
(bg-changed-faint "#ffefbf")
(bg-changed-refine "#fac090")
- (bg-changed-intense "#d7c20a")
+ (bg-changed-fringe "#d7c20a")
(fg-changed "#553d00")
(fg-changed-intense "#655000")
(bg-removed "#ffd8d5")
(bg-removed-faint "#ffe9e9")
(bg-removed-refine "#f3b5af")
- (bg-removed-intense "#d84a4f")
+ (bg-removed-fringe "#d84a4f")
(fg-removed "#8f1313")
(fg-removed-intense "#aa2222")
+ (bg-diff-context "#f3f3f3")
+
;;; Paren match
(bg-paren-match "#5fcfff")
@@ -378,10 +380,7 @@ as a symbol and the latter as a string.
Semantic color mappings have the form (MAPPING-NAME COLOR-NAME)
with both as symbols. The latter is a named color that already
-exists in the palette and is associated with a HEX-VALUE.
-
-Semantic color mappings cannot be recursive: their value must be
-either COLOR-NAME or HEX-VALUE.")
+exists in the palette and is associated with a HEX-VALUE.")
(defcustom modus-operandi-palette-overrides nil
"Overrides for `modus-operandi-palette'.
diff --git a/etc/themes/modus-operandi-tinted-theme.el
b/etc/themes/modus-operandi-tinted-theme.el
index 52024ceee95..4bb820cf686 100644
--- a/etc/themes/modus-operandi-tinted-theme.el
+++ b/etc/themes/modus-operandi-tinted-theme.el
@@ -80,7 +80,7 @@ which corresponds to a minimum contrast in relative luminance
of
(yellow-faint "#624416")
(yellow-intense "#808000")
(blue "#0031a9")
- (blue-warmer "#354fcf")
+ (blue-warmer "#3548cf")
(blue-cooler "#0000b0")
(blue-faint "#003497")
(blue-intense "#0000ff")
@@ -121,12 +121,12 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
- (bg-red-nuanced "#fff1f0")
- (bg-green-nuanced "#ecf7ed")
- (bg-yellow-nuanced "#fff3da")
- (bg-blue-nuanced "#f3f3ff")
- (bg-magenta-nuanced "#fdf0ff")
- (bg-cyan-nuanced "#ebf6fa")
+ (bg-red-nuanced "#ffe8f0")
+ (bg-green-nuanced "#e0f5e0")
+ (bg-yellow-nuanced "#f9ead0")
+ (bg-blue-nuanced "#ebebff")
+ (bg-magenta-nuanced "#f6e7ff")
+ (bg-cyan-nuanced "#e1f3fc")
;;; Uncommon accent backgrounds
@@ -182,24 +182,26 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-added "#c3ebc1")
(bg-added-faint "#dcf8d1")
(bg-added-refine "#acd6a5")
- (bg-added-intense "#8cca8c")
+ (bg-added-fringe "#6cc06c")
(fg-added "#005000")
(fg-added-intense "#006700")
(bg-changed "#ffdfa9")
(bg-changed-faint "#ffefbf")
(bg-changed-refine "#fac090")
- (bg-changed-intense "#d7c20a")
+ (bg-changed-fringe "#c0b200")
(fg-changed "#553d00")
(fg-changed-intense "#655000")
(bg-removed "#f4d0cf")
(bg-removed-faint "#ffe9e5")
(bg-removed-refine "#f3b5a7")
- (bg-removed-intense "#d84a4f")
+ (bg-removed-fringe "#d84a4f")
(fg-removed "#8f1313")
(fg-removed-intense "#aa2222")
+ (bg-diff-context "#efe9df")
+
;;; Paren match
(bg-paren-match "#7fdfcf")
@@ -377,10 +379,7 @@ as a symbol and the latter as a string.
Semantic color mappings have the form (MAPPING-NAME COLOR-NAME)
with both as symbols. The latter is a named color that already
-exists in the palette and is associated with a HEX-VALUE.
-
-Semantic color mappings cannot be recursive: their value must be
-either COLOR-NAME or HEX-VALUE.")
+exists in the palette and is associated with a HEX-VALUE.")
(defcustom modus-operandi-tinted-palette-overrides nil
"Overrides for `modus-operandi-tinted-palette'.
diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el
index f4f33aa36e0..805f25b458f 100644
--- a/etc/themes/modus-themes.el
+++ b/etc/themes/modus-themes.el
@@ -6,7 +6,7 @@
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
-;; Version: 4.0.1
+;; Version: 4.1.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -88,6 +88,14 @@ cover the blue-cyan-magenta side of the spectrum."
:version "30.1"
:group 'modus-themes-faces))
+(dolist (color '(red green yellow blue magenta cyan))
+ (custom-declare-face
+ (intern (format "modus-themes-nuanced-%s" color))
+ nil (format "Nuanced %s background." color)
+ :package-version '(modus-themes . "4.1.0")
+ :version "30.1"
+ :group 'modus-themes-faces))
+
(dolist (color '(red green yellow blue magenta cyan))
(custom-declare-face
(intern (format "modus-themes-subtle-%s" color))
@@ -329,6 +337,29 @@ Will set SYM to VAL, and reload the current theme, unless
(theme (modus-themes--current-theme)))
(modus-themes-load-theme theme))))
+(defcustom modus-themes-disable-other-themes t
+ "Disable all other themes when loading a Modus theme.
+
+When the value is non-nil, the commands `modus-themes-toggle' and
+`modus-themes-select', as well as the `modus-themes-load-theme'
+function, will disable all other themes while loading the
+specified Modus theme. This is done to ensure that Emacs does
+not blend two or more themes: such blends lead to awkward results
+that undermine the work of the designer.
+
+When the value is nil, the aforementioned commands and function
+will only disable other themes within the Modus collection.
+
+This option is provided because Emacs themes are not necessarily
+limited to colors/faces: they can consist of an arbitrary set of
+customizations. Users who use such customization bundles must
+set this variable to a nil value."
+ :group 'modus-themes
+ :package-version '(modus-themes . "4.1.0")
+ :version "30.1"
+ :type 'boolean
+ :link '(info-link "(modus-themes) Disable other themes"))
+
(defconst modus-themes-items
'( modus-operandi modus-vivendi
modus-operandi-tinted modus-vivendi-tinted
@@ -615,13 +646,14 @@ is non-nil. While quote/verse blocks require setting
"Control the style of completion user interfaces.
This affects Company, Corfu, Flx, Icomplete/Fido, Ido, Ivy,
-Orderless, Vertico. The value is an alist of expressions, each
-of which takes the form of (KEY . LIST-OF-PROPERTIES). KEY is a
-symbol, while PROPERTIES is a list. Here is a sample, followed
-by a description of the particularities:
+Orderless, Vertico, and the standard *Completions* buffer. The
+value is an alist of expressions, each of which takes the form
+of (KEY . LIST-OF-PROPERTIES). KEY is a symbol, while PROPERTIES
+is a list. Here is a sample, followed by a description of the
+particularities:
(setq modus-themes-completions
- (quote ((matches . (extrabold background))
+ (quote ((matches . (extrabold underline))
(selection . (semibold italic)))))
The `matches' key refers to the highlighted characters that
@@ -682,6 +714,12 @@ Is the same as:
(cons :tag "Selection"
(const selection)
(set :tag "Style of selection" :greedy t
+ ,modus-themes--weight-widget
+ (const :tag "Italic font (oblique or slanted forms)"
italic)
+ (const :tag "Underline" underline)))
+ (cons :tag "Fallback for both matches and selection"
+ (const t)
+ (set :tag "Style of both matches and selection" :greedy t
,modus-themes--weight-widget
(const :tag "Italic font (oblique or slanted forms)"
italic)
(const :tag "Underline" underline))))
@@ -759,7 +797,25 @@ represents."
:group 'modus-themes
:package-version '(modus-themes . "4.0.0")
:version "30.1"
- :type '(repeat (list symbol (choice symbol string))) ; TODO 2022-12-18:
Refine overrides' :type
+ :type '(repeat (list symbol (choice symbol string)))
+ ;; ;; NOTE 2023-01-07: The following is a functioning version of the
+ ;; ;; intended :type. However, I think the Custom UI is really
+ ;; ;; awkward for this specific case. Maybe the generic type I have
+ ;; ;; above is better, as it encourages the user to write out the
+ ;; ;; code and read the manual. Counter-arguments are welcome.
+ ;;
+ ;; :type `(repeat (list (radio :tag "Palette key to override"
+ ;; ,@(mapcar (lambda (x)
+ ;; (list 'const x))
+ ;; (mapcar #'car
(modus-themes--current-theme-palette))))
+ ;; (choice :tag "Value to assign" :value unspecified
+ ;; (const :tag "`unspecified' (remove the
original color)" unspecified)
+ ;; (string :tag "String with color name (e.g.
\"gray50\") or hex RGB (e.g. \"#123456\")"
+ ;; :match-inline (color-supported-p
val))
+ ;; (radio :tag "Palette key to map to"
+ ;; ,@(mapcar (lambda (x)
+ ;; (list 'const x))
+ ;; (mapcar #'car
(modus-themes--current-theme-palette)))))))
:set #'modus-themes--set-option
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Palette overrides"))
@@ -1020,7 +1076,8 @@ C1 and C2 are color values written in hexadecimal RGB."
(defun modus-themes--current-theme ()
"Return first enabled Modus theme."
- (car (modus-themes--list-enabled-themes)))
+ (car (or (modus-themes--list-enabled-themes)
+ (modus-themes--list-known-themes))))
(defun modus-themes--palette-symbol (theme &optional overrides)
"Return THEME palette as a symbol.
@@ -1052,13 +1109,71 @@ overrides."
(modus-themes--palette-value theme))
(user-error "No enabled Modus theme could be found")))
+(defun modus-themes--disable-themes ()
+ "Disable themes per `modus-themes-disable-other-themes'."
+ (mapc #'disable-theme
+ (if modus-themes-disable-other-themes
+ custom-enabled-themes
+ (modus-themes--list-known-themes))))
+
(defun modus-themes-load-theme (theme)
- "Load THEME while disabling other Modus themes.
-Run `modus-themes-after-load-theme-hook'."
- (mapc #'disable-theme (modus-themes--list-known-themes))
+ "Load THEME while disabling other themes.
+
+Which themes are disabled is determined by the user option
+`modus-themes-disable-other-themes'.
+
+Run the `modus-themes-after-load-theme-hook' as the final step
+after loading the THEME."
+ (modus-themes--disable-themes)
(load-theme theme :no-confirm)
(run-hooks 'modus-themes-after-load-theme-hook))
+(defun modus-themes--retrieve-palette-value (color palette)
+ "Return COLOR from PALETTE.
+Use recursion until COLOR is retrieved as a string. Refrain from
+doing so if the value of COLOR is not a key in the PALETTE.
+
+Return `unspecified' if the value of COLOR cannot be determined.
+This symbol is accepted by faces and is thus harmless.
+
+This function is used in the macros `modus-themes-theme',
+`modus-themes-with-colors'."
+ (let ((value (car (alist-get color palette))))
+ (cond
+ ((or (stringp value)
+ (eq value 'unspecified))
+ value)
+ ((and (symbolp value)
+ (memq value (mapcar #'car palette)))
+ (modus-themes--retrieve-palette-value value palette))
+ (t
+ 'unspecified))))
+
+(defun modus-themes-get-color-value (color &optional overrides theme)
+ "Return color value of named COLOR for current Modus theme.
+
+COLOR is a symbol that represents a named color entry in the
+palette.
+
+If the value is the name of another color entry in the
+palette (so a mapping), recur until you find the underlying color
+value.
+
+With optional OVERRIDES as a non-nil value, account for palette
+overrides. Else use the default palette.
+
+With optional THEME as a symbol among `modus-themes-items', use
+the palette of that item. Else use the current Modus theme.
+
+If COLOR is not present in the palette, return the `unspecified'
+symbol, which is safe when used as a face attribute's value."
+ (if-let* ((palette (if theme
+ (modus-themes--palette-value theme overrides)
+ (modus-themes--current-theme-palette overrides)))
+ (value (modus-themes--retrieve-palette-value color palette)))
+ value
+ 'unspecified))
+
;;;; Commands
(make-obsolete 'modus-themes-load-themes nil "4.0.0")
@@ -1080,7 +1195,8 @@ Run `modus-themes-after-load-theme-hook'."
;;;###autoload
(defun modus-themes-select (theme)
"Load a Modus THEME using minibuffer completion.
-Run `modus-themes-after-load-theme-hook' after loading the theme."
+Run `modus-themes-after-load-theme-hook' after loading the theme.
+Disable other themes per `modus-themes-disable-other-themes'."
(interactive (list (modus-themes--select-prompt)))
(modus-themes-load-theme theme))
@@ -1100,7 +1216,8 @@ If `modus-themes-to-toggle' does not specify two Modus
themes,
prompt with completion for a theme among our collection (this is
practically the same as the `modus-themes-select' command).
-Run `modus-themes-after-load-theme-hook' after loading the theme."
+Run `modus-themes-after-load-theme-hook' after loading the theme.
+Disable other themes per `modus-themes-disable-other-themes'."
(interactive)
(if-let* ((themes (modus-themes--toggle-theme-p))
(one (car themes))
@@ -1114,15 +1231,12 @@ Run `modus-themes-after-load-theme-hook' after loading
the theme."
"Render colors in BUFFER from THEME for `modus-themes-list-colors'.
Optional MAPPINGS changes the output to only list the semantic
color mappings of the palette, instead of its named colors."
- (let* ((current (modus-themes--palette-value theme :overrides))
+ (let* ((current-palette (modus-themes--palette-value theme mappings))
(palette (if mappings
(seq-remove (lambda (cell)
- (or (stringp (cadr cell))
- (eq (cadr cell) 'unspecified)))
- current)
- (seq-remove (lambda (cell)
- (symbolp (cadr cell)))
- current)))
+ (stringp (cadr cell)))
+ current-palette)
+ current-palette))
(current-buffer buffer)
(current-theme theme))
(with-help-window buffer
@@ -1136,28 +1250,27 @@ color mappings of the palette, instead of its named
colors."
(insert " ")
(dolist (cell palette)
(let* ((name (car cell))
- (color (cadr cell))
- (mapping (if mappings
- (cadr (seq-find (lambda (c)
- (eq (car c) color))
- current))
- color))
- (fg (readable-foreground-color mapping))
- (pad (make-string 5 ?\s)))
+ (color (modus-themes-get-color-value name mappings theme))
+ (pad (make-string 10 ?\s))
+ (fg (if (eq color 'unspecified)
+ (progn
+ (readable-foreground-color
(modus-themes-get-color-value 'bg-main nil theme))
+ (setq pad (make-string 6 ?\s)))
+ (readable-foreground-color color))))
(let ((old-point (point)))
- (insert (format "%s %s" mapping pad))
- (put-text-property old-point (point) 'face `( :foreground
,mapping)))
+ (insert (format "%s %s" color pad))
+ (put-text-property old-point (point) 'face `( :foreground
,color)))
(let ((old-point (point)))
- (insert (format " %s %s %s\n" mapping pad name))
+ (insert (format " %s %s %s\n" color pad name))
(put-text-property old-point (point)
- 'face `( :background ,mapping
+ 'face `( :background ,color
:foreground ,fg
:extend t)))
;; We need this to properly render the last line.
(insert " ")))
(setq-local revert-buffer-function
(lambda (_ignore-auto _noconfirm)
- (modus-themes--list-colors-render current-buffer
current-theme)))))))
+ (modus-themes--list-colors-render current-buffer
current-theme mappings)))))))
(defvar modus-themes--list-colors-prompt-history '()
"Minibuffer history for `modus-themes--list-colors-prompt'.")
@@ -1319,7 +1432,7 @@ Optional OL is the color of an overline."
(eq modus-themes-org-blocks 'greyscale))))
(list :inherit 'modus-themes-fixed-pitch
:background (if gray bg 'unspecified)
- :foreground fg
+ :foreground (if gray 'unspecified fg)
:extend (if gray t 'unspecified))))
(defun modus-themes--completion-line (bg)
@@ -1408,6 +1521,13 @@ FG and BG are the main colors."
`(modus-themes-fg-cyan-cooler ((,c :foreground ,cyan-cooler)))
`(modus-themes-fg-cyan-faint ((,c :foreground ,cyan-faint)))
`(modus-themes-fg-cyan-intense ((,c :foreground ,cyan-intense)))
+;;;;; nuanced colored backgrounds
+ `(modus-themes-nuanced-red ((,c :background ,bg-red-nuanced :extend t)))
+ `(modus-themes-nuanced-green ((,c :background ,bg-green-nuanced :extend
t)))
+ `(modus-themes-nuanced-yellow ((,c :background ,bg-yellow-nuanced :extend
t)))
+ `(modus-themes-nuanced-blue ((,c :background ,bg-blue-nuanced :extend t)))
+ `(modus-themes-nuanced-magenta ((,c :background ,bg-magenta-nuanced
:extend t)))
+ `(modus-themes-nuanced-cyan ((,c :background ,bg-cyan-nuanced :extend t)))
;;;;; subtle colored backgrounds
`(modus-themes-subtle-red ((,c :background ,bg-red-subtle :foreground
,fg-main)))
`(modus-themes-subtle-green ((,c :background ,bg-green-subtle :foreground
,fg-main)))
@@ -1494,6 +1614,7 @@ FG and BG are the main colors."
`(header-line-highlight ((,c :inherit highlight)))
`(help-argument-name ((,c :inherit modus-themes-slant :foreground
,variable)))
`(help-key-binding ((,c :inherit modus-themes-key-binding)))
+ `(highlight ((,c :background ,bg-hover :foreground ,fg-main)))
`(homoglyph ((,c :foreground ,warning)))
`(ibuffer-locked-buffer ((,c :foreground ,warning)))
`(icon-button ((,c :inherit modus-themes-button)))
@@ -1509,7 +1630,7 @@ FG and BG are the main colors."
`(read-multiple-choice-face ((,c :inherit (bold modus-themes-mark-alt))))
`(rectangle-preview ((,c :inherit secondary-selection)))
`(region ((,c :background ,bg-region :foreground ,fg-region)))
- `(secondary-selection ((,c :background ,bg-hover-secondary)))
+ `(secondary-selection ((,c :background ,bg-hover-secondary :foreground
,fg-main)))
`(separator-line ((,c :underline ,bg-active)))
`(shadow ((,c :foreground ,fg-dim)))
`(success ((,c :inherit bold :foreground ,info)))
@@ -1519,7 +1640,7 @@ FG and BG are the main colors."
`(button ((,c :background ,bg-link :foreground ,fg-link :underline
,underline-link)))
`(link ((,c :inherit button)))
`(link-visited ((,c :background ,bg-link-visited :foreground
,fg-link-visited :underline ,underline-link-visited)))
- `(tooltip ((,c :background ,bg-active)))
+ `(tooltip ((,c :background ,bg-active :foreground ,fg-main)))
;;;;; agda2-mode
`(agda2-highlight-bound-variable-face ((,c :inherit
font-lock-variable-name-face)))
`(agda2-highlight-catchall-clause-face ((,c :background ,bg-inactive)))
@@ -1778,7 +1899,7 @@ FG and BG are the main colors."
`(company-scrollbar-bg ((,c :background ,bg-active)))
`(company-scrollbar-fg ((,c :background ,fg-main)))
`(company-template-field ((,c :background ,bg-active)))
- `(company-tooltip ((,c :background ,bg-inactive)))
+ `(company-tooltip ((,c :background ,bg-dim)))
`(company-tooltip-annotation ((,c :inherit completions-annotations)))
`(company-tooltip-common ((,c :inherit company-echo-common)))
`(company-tooltip-deprecated ((,c :inherit company-tooltip :strike-through
t)))
@@ -1796,16 +1917,18 @@ FG and BG are the main colors."
`(compilation-mode-line-exit ((,c :inherit bold)))
`(compilation-mode-line-fail ((,c :inherit bold :foreground
,modeline-err)))
`(compilation-mode-line-run ((,c :inherit bold :foreground
,modeline-warning)))
- `(compilation-warning ((,c :inherit warning)))
+ `(compilation-warning ((,c :inherit modus-themes-bold :foreground
,warning)))
;;;;; completions
`(completions-annotations ((,c :inherit modus-themes-slant :foreground
,docstring)))
`(completions-common-part ((,c :inherit modus-themes-completion-match-0)))
`(completions-first-difference ((,c :inherit
modus-themes-completion-match-1)))
;;;;; consult
`(consult-async-split ((,c :inherit error)))
+ `(consult-file ((,c :inherit modus-themes-bold :foreground ,info)))
`(consult-key ((,c :inherit modus-themes-key-binding)))
`(consult-imenu-prefix ((,c :inherit shadow)))
`(consult-line-number ((,c :inherit shadow)))
+ `(consult-line-number-prefix ((,c :inherit shadow)))
;;;;; corfu
`(corfu-current ((,c :inherit modus-themes-completion-selected)))
`(corfu-bar ((,c :background ,fg-dim)))
@@ -1838,7 +1961,7 @@ FG and BG are the main colors."
`(csv-separator-face ((,c :foreground ,red-intense)))
;;;;; ctrlf
`(ctrlf-highlight-active ((,c :inherit modus-themes-search-current)))
- `(ctrlf-highlight-line ((,c :inherit highlight)))
+ `(ctrlf-highlight-line ((,c :background ,bg-hl-line :extend t)))
`(ctrlf-highlight-passive ((,c :inherit modus-themes-search-lazy)))
;;;;; custom (M-x customize)
`(custom-button ((,c :inherit modus-themes-button)))
@@ -1858,6 +1981,9 @@ FG and BG are the main colors."
`(custom-group-tag ((,c :inherit bold :foreground ,builtin)))
`(custom-group-tag-1 ((,c :inherit bold :foreground ,constant)))
`(custom-variable-tag ((,c :inherit bold :foreground ,variable)))
+;;;;; dashboard
+ `(dashboard-heading ((,c :foreground ,name)))
+ `(dashboard-items-face (( ))) ; use the underlying style of all-the-icons
;;;;; deadgrep
`(deadgrep-filename-face ((,c :inherit bold :foreground ,name)))
`(deadgrep-match-face ((,c :inherit match)))
@@ -1879,18 +2005,18 @@ FG and BG are the main colors."
`(dictionary-word-definition-face (( )))
`(dictionary-word-entry-face ((,c :inherit font-lock-comment-face)))
;;;;; diff-hl
- `(diff-hl-change ((,c :background ,bg-changed-intense)))
- `(diff-hl-delete ((,c :background ,bg-removed-intense)))
- `(diff-hl-insert ((,c :background ,bg-added-intense)))
+ `(diff-hl-change ((,c :background ,bg-changed-fringe)))
+ `(diff-hl-delete ((,c :background ,bg-removed-fringe)))
+ `(diff-hl-insert ((,c :background ,bg-added-fringe)))
`(diff-hl-reverted-hunk-highlight ((,c :background ,fg-main :foreground
,bg-main)))
;;;;; diff-mode
- `(diff-added ((,c :background ,bg-added)))
- `(diff-changed ((,c :background ,bg-changed :extend t)))
+ `(diff-added ((,c :background ,bg-added :foreground ,fg-added)))
+ `(diff-changed ((,c :background ,bg-changed :foreground ,fg-changed
:extend t)))
`(diff-changed-unspecified ((,c :inherit diff-changed)))
- `(diff-removed ((,c :background ,bg-removed)))
- `(diff-refine-added ((,c :background ,bg-added-refine)))
- `(diff-refine-changed ((,c :background ,bg-changed-refine)))
- `(diff-refine-removed ((,c :background ,bg-removed-refine)))
+ `(diff-removed ((,c :background ,bg-removed :foreground ,fg-removed)))
+ `(diff-refine-added ((,c :background ,bg-added-refine :foreground
,fg-added)))
+ `(diff-refine-changed ((,c :background ,bg-changed-refine :foreground
,fg-changed)))
+ `(diff-refine-removed ((,c :background ,bg-removed-refine :foreground
,fg-removed)))
`(diff-indicator-added ((,c :inherit diff-added :foreground
,fg-added-intense)))
`(diff-indicator-changed ((,c :inherit diff-changed :foreground
,fg-changed-intense)))
`(diff-indicator-removed ((,c :inherit diff-removed :foreground
,fg-removed-intense)))
@@ -2001,18 +2127,18 @@ FG and BG are the main colors."
`(doom-modeline-urgent ((,c :inherit bold-italic :foreground
,modeline-err)))
`(doom-modeline-warning ((,c :inherit warning)))
;;;;; ediff
- `(ediff-current-diff-A ((,c :inherit diff-removed)))
+ `(ediff-current-diff-A ((,c :background ,bg-removed :foreground
,fg-removed)))
`(ediff-current-diff-Ancestor ((,c :background ,bg-region))) ; TODO
2022-11-29: Needs review
- `(ediff-current-diff-B ((,c :inherit diff-added)))
- `(ediff-current-diff-C ((,c :inherit diff-changed)))
- `(ediff-even-diff-A ((,c :background ,bg-dim)))
- `(ediff-even-diff-Ancestor ((,c :background ,bg-dim)))
- `(ediff-even-diff-B ((,c :background ,bg-dim)))
- `(ediff-even-diff-C ((,c :background ,bg-dim)))
- `(ediff-fine-diff-A ((,c :inherit diff-refine-removed)))
- `(ediff-fine-diff-Ancestor ((,c :inherit diff-refine-cyan)))
- `(ediff-fine-diff-B ((,c :inherit diff-refine-added)))
- `(ediff-fine-diff-C ((,c :inherit diff-refine-changed)))
+ `(ediff-current-diff-B ((,c :background ,bg-added :foreground ,fg-added)))
+ `(ediff-current-diff-C ((,c :background ,bg-changed :foreground
,fg-changed)))
+ `(ediff-even-diff-A ((,c :background ,bg-diff-context)))
+ `(ediff-even-diff-Ancestor ((,c :background ,bg-diff-context)))
+ `(ediff-even-diff-B ((,c :background ,bg-diff-context)))
+ `(ediff-even-diff-C ((,c :background ,bg-diff-context)))
+ `(ediff-fine-diff-A ((,c :background ,bg-removed-refine :foreground
,fg-removed)))
+ `(ediff-fine-diff-Ancestor ((,c :inherit modus-themes-subtle-cyan)))
+ `(ediff-fine-diff-B ((,c :background ,bg-added-refine :foreground
,fg-added)))
+ `(ediff-fine-diff-C ((,c :background ,bg-changed-refine :foreground
,fg-changed)))
`(ediff-odd-diff-A ((,c :inherit ediff-even-diff-A)))
`(ediff-odd-diff-Ancestor ((,c :inherit ediff-even-diff-Ancestor)))
`(ediff-odd-diff-B ((,c :inherit ediff-even-diff-B)))
@@ -2025,7 +2151,7 @@ FG and BG are the main colors."
`(ein:markdowncell-input-area-face (( )))
`(ein:notification-tab-normal ((,c :underline t)))
;;;;; eglot
- `(eglot-mode-line ((,c :inherit bold :foreground ,modeline-info)))
+ `(eglot-mode-line ((,c :inherit modus-themes-bold :foreground
,modeline-info)))
;;;;; el-search
`(el-search-highlight-in-prompt-face ((,c :inherit italic)))
`(el-search-match ((,c :inherit modus-themes-search-current)))
@@ -2236,15 +2362,15 @@ FG and BG are the main colors."
`(git-commit-overlong-summary ((,c :inherit warning)))
`(git-commit-summary ((,c :inherit bold :foreground ,blue)))
;;;;; git-gutter
- `(git-gutter:added ((,c :background ,bg-added-intense)))
- `(git-gutter:deleted ((,c :background ,bg-removed-intense)))
- `(git-gutter:modified ((,c :background ,bg-changed-intense)))
+ `(git-gutter:added ((,c :background ,bg-added-fringe)))
+ `(git-gutter:deleted ((,c :background ,bg-removed-fringe)))
+ `(git-gutter:modified ((,c :background ,bg-changed-fringe)))
`(git-gutter:separator ((,c :inherit modus-themes-intense-cyan)))
`(git-gutter:unchanged ((,c :inherit modus-themes-intense-magenta)))
;;;;; git-gutter-fr
- `(git-gutter-fr:added ((,c :background ,bg-added-intense)))
- `(git-gutter-fr:deleted ((,c :background ,bg-removed-intense)))
- `(git-gutter-fr:modified ((,c :background ,bg-changed-intense)))
+ `(git-gutter-fr:added ((,c :background ,bg-added-fringe)))
+ `(git-gutter-fr:deleted ((,c :background ,bg-removed-fringe)))
+ `(git-gutter-fr:modified ((,c :background ,bg-changed-fringe)))
;;;;; git-rebase
`(git-rebase-comment-hash ((,c :inherit (bold font-lock-comment-face)
:foreground ,identifier)))
`(git-rebase-comment-heading ((,c :inherit (bold
font-lock-comment-face))))
@@ -2377,7 +2503,6 @@ FG and BG are the main colors."
:background "white" :foreground "#af6400" :inverse-video t)
(((class color) (min-colors 88) (background dark))
:background "black" :foreground "#faea00" :inverse-video t)))
- `(highlight ((,c :background ,bg-hover)))
`(highlight-changes ((,c :foreground ,warning :underline nil)))
`(highlight-changes-delete ((,c :foreground ,err :underline t)))
`(hl-line ((,c :background ,bg-hl-line :extend t)))
@@ -2551,8 +2676,8 @@ FG and BG are the main colors."
`(kaocha-runner-success-face ((,c :inherit success)))
`(kaocha-runner-warning-face ((,c :inherit warning)))
;;;;; keycast
- `(keycast-command ((,c :inherit bold :foreground ,keybind)))
- `(keycast-key ((,c :background ,keybind :foreground ,bg-main :box
,keybind)))
+ `(keycast-command ((,c :inherit bold)))
+ `(keycast-key ((,c :background ,keybind :foreground ,bg-main)))
;;;;; ledger-mode
`(ledger-font-auto-xact-face ((,c :inherit font-lock-builtin-face)))
`(ledger-font-account-name-face ((,c :foreground ,name)))
@@ -2563,7 +2688,7 @@ FG and BG are the main colors."
`(ledger-font-payee-cleared-face ((,c :inherit success)))
`(ledger-font-payee-pending-face ((,c :inherit warning)))
`(ledger-font-payee-uncleared-face ((,c :inherit error)))
- `(ledger-font-xact-highlight-face ((,c :inherit highlight)))
+ `(ledger-font-xact-highlight-face ((,c :background ,bg-hl-line :extend t)))
;;;;; leerzeichen
`(leerzeichen ((,c :background ,bg-inactive)))
;;;;; line numbers (display-line-numbers-mode and global variant)
@@ -2595,7 +2720,7 @@ FG and BG are the main colors."
`(magit-diff-base ((,c :background ,bg-changed-faint :foreground
,fg-changed)))
`(magit-diff-base-highlight ((,c :background ,bg-changed :foreground
,fg-changed)))
`(magit-diff-context ((,c :inherit shadow)))
- `(magit-diff-context-highlight ((,c :background ,bg-dim)))
+ `(magit-diff-context-highlight ((,c :background ,bg-diff-context)))
`(magit-diff-file-heading ((,c :inherit bold :foreground ,accent-0)))
`(magit-diff-file-heading-highlight ((,c :inherit magit-diff-file-heading
:background ,bg-inactive)))
`(magit-diff-file-heading-selection ((,c :inherit bold :background
,bg-hover-secondary)))
@@ -2668,7 +2793,7 @@ FG and BG are the main colors."
`(marginalia-archive ((,c :foreground ,accent-0)))
`(marginalia-char ((,c :foreground ,accent-2)))
`(marginalia-date ((,c :foreground ,date-common)))
- `(marginalia-documentation ((,c :inherit italic :foreground ,docstring)))
+ `(marginalia-documentation ((,c :inherit modus-themes-slant :foreground
,docstring)))
`(marginalia-file-name (( )))
`(marginalia-file-owner ((,c :inherit shadow)))
`(marginalia-file-priv-dir ((,c :foreground ,accent-0)))
@@ -2720,7 +2845,7 @@ FG and BG are the main colors."
`(markdown-table-face ((,c :inherit modus-themes-fixed-pitch :foreground
,prose-table)))
`(markdown-url-face ((,c :foreground ,fg-alt)))
;;;;; markup-faces (`adoc-mode')
- `(markup-attribute-face ((,c :inherit (italic markup-meta-face))))
+ `(markup-attribute-face ((,c :inherit (modus-themes-slant
markup-meta-face))))
`(markup-bold-face ((,c :inherit bold)))
`(markup-code-face ((,c :foreground ,prose-code)))
`(markup-comment-face ((,c :inherit font-lock-comment-face)))
@@ -2809,7 +2934,7 @@ FG and BG are the main colors."
`(mu4e-footer-face ((,c :inherit italic :foreground ,fg-alt)))
`(mu4e-forwarded-face ((,c :inherit italic :foreground ,info)))
`(mu4e-header-face ((,c :inherit shadow)))
- `(mu4e-header-highlight-face ((,c :inherit highlight)))
+ `(mu4e-header-highlight-face ((,c :background ,bg-hl-line :extend t)))
`(mu4e-header-key-face ((,c :inherit message-header-name)))
`(mu4e-header-marks-face ((,c :inherit mu4e-special-header-value-face)))
`(mu4e-header-title-face ((,c :foreground ,fg-alt)))
@@ -2920,7 +3045,7 @@ FG and BG are the main colors."
`(orderless-match-face-3 ((,c :inherit modus-themes-completion-match-3)))
;;;;; org
`(org-agenda-calendar-event ((,c :foreground ,date-event)))
- `(org-agenda-calendar-sexp ((,c :inherit (italic
org-agenda-calendar-event))))
+ `(org-agenda-calendar-sexp ((,c :inherit (modus-themes-slant
org-agenda-calendar-event))))
`(org-agenda-clocking ((,c :inherit modus-themes-mark-alt)))
`(org-agenda-column-dateline ((,c :background ,bg-inactive)))
`(org-agenda-current-time ((,c :foreground ,date-now)))
@@ -2964,7 +3089,7 @@ FG and BG are the main colors."
`(org-headline-todo ((,c :inherit org-todo)))
`(org-hide ((,c :foreground ,bg-main)))
`(org-indent ((,c :inherit (fixed-pitch org-hide))))
- `(org-imminent-deadline ((,c :inherit bold :foreground ,date-deadline)))
+ `(org-imminent-deadline ((,c :inherit modus-themes-bold :foreground
,date-deadline)))
`(org-latex-and-related ((,c :foreground ,type)))
`(org-level-1 ((,c :inherit modus-themes-heading-1)))
`(org-level-2 ((,c :inherit modus-themes-heading-2)))
@@ -2985,7 +3110,7 @@ FG and BG are the main colors."
`(org-quote ((,c :inherit org-block)))
`(org-scheduled ((,c :foreground ,date-scheduled)))
`(org-scheduled-previously ((,c :inherit org-scheduled)))
- `(org-scheduled-today ((,c :inherit (bold org-scheduled))))
+ `(org-scheduled-today ((,c :inherit (modus-themes-bold org-scheduled))))
`(org-sexp-date ((,c :foreground ,date-common)))
`(org-special-keyword ((,c :inherit org-drawer)))
`(org-table ((,c :inherit modus-themes-fixed-pitch :foreground
,prose-table)))
@@ -3007,8 +3132,8 @@ FG and BG are the main colors."
`(org-habit-clear-future-face ((,c :background ,bg-graph-blue-1)))
`(org-habit-overdue-face ((,c :background ,bg-graph-red-0)))
`(org-habit-overdue-future-face ((,c :background ,bg-graph-red-1)))
- `(org-habit-ready-face ((,c :background ,bg-graph-blue-0 :foreground
"black"))) ; fg is special case
- `(org-habit-ready-future-face ((,c :background ,bg-graph-blue-1)))
+ `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground
"black"))) ; fg is special case
+ `(org-habit-ready-future-face ((,c :background ,bg-graph-green-1)))
;;;;; org-journal
`(org-journal-calendar-entry-face ((,c :inherit modus-themes-slant
:foreground ,date-common)))
`(org-journal-calendar-scheduled-face ((,c :inherit (modus-themes-slant
org-scheduled))))
@@ -3097,7 +3222,7 @@ FG and BG are the main colors."
`(popup-tip-face ((,c :inherit modus-themes-intense-yellow)))
;;;;; powerline
`(powerline-active0 ((,c :background ,fg-dim :foreground ,bg-main)))
- `(powerline-active1 ((,c :inherit mode-line-active)))
+ `(powerline-active1 ((,c :inherit mode-line)))
`(powerline-active2 ((,c :inherit mode-line-inactive)))
`(powerline-inactive0 ((,c :background ,bg-active :foreground ,fg-dim)))
`(powerline-inactive1 ((,c :background ,bg-main :foreground ,fg-dim)))
@@ -3320,7 +3445,7 @@ FG and BG are the main colors."
`(swiper-background-match-face-2 ((,c :inherit
modus-themes-completion-match-0)))
`(swiper-background-match-face-3 ((,c :inherit
modus-themes-completion-match-1)))
`(swiper-background-match-face-4 ((,c :inherit
modus-themes-completion-match-2)))
- `(swiper-line-face ((,c :inherit highlight)))
+ `(swiper-line-face ((,c :background ,bg-hl-line :extend t)))
`(swiper-match-face-1 (( )))
`(swiper-match-face-2 ((,c :inherit modus-themes-completion-match-0)))
`(swiper-match-face-3 ((,c :inherit modus-themes-completion-match-1)))
@@ -3753,24 +3878,24 @@ FG and BG are the main colors."
(if (or (eq modus-themes-org-blocks 'tinted-background)
(eq modus-themes-org-blocks 'rainbow))
`(org-src-block-faces
- `(("emacs-lisp" (:inherit modus-themes-subtle-magenta :extend t))
- ("elisp" (:inherit modus-themes-subtle-magenta :extend t))
- ("clojure" (:inherit modus-themes-subtle-magenta :extend t))
- ("clojurescript" (:inherit modus-themes-subtle-magenta :extend t))
- ("c" (:inherit modus-themes-subtle-blue :extend t))
- ("c++" (:inherit modus-themes-subtle-blue :extend t))
- ("sh" (:inherit modus-themes-subtle-green :extend t))
- ("shell" (:inherit modus-themes-subtle-green :extend t))
- ("html" (:inherit modus-themes-subtle-yellow :extend t))
- ("xml" (:inherit modus-themes-subtle-yellow :extend t))
- ("css" (:inherit modus-themes-subtle-red :extend t))
- ("scss" (:inherit modus-themes-subtle-red :extend t))
- ("python" (:inherit modus-themes-subtle-green :extend t))
- ("ipython" (:inherit modus-themes-subtle-magenta :extend t))
- ("r" (:inherit modus-themes-subtle-cyan :extend t))
- ("yaml" (:inherit modus-themes-subtle-cyan :extend t))
- ("conf" (:inherit modus-themes-subtle-cyan :extend t))
- ("docker" (:inherit modus-themes-subtle-cyan :extend t))))
+ `(("emacs-lisp" modus-themes-nuanced-magenta)
+ ("elisp" modus-themes-nuanced-magenta)
+ ("clojure" modus-themes-nuanced-magenta)
+ ("clojurescript" modus-themes-nuanced-magenta)
+ ("c" modus-themes-nuanced-blue)
+ ("c++" modus-themes-nuanced-blue)
+ ("sh" modus-themes-nuanced-green)
+ ("shell" modus-themes-nuanced-green)
+ ("html" modus-themes-nuanced-yellow)
+ ("xml" modus-themes-nuanced-yellow)
+ ("css" modus-themes-nuanced-red)
+ ("scss" modus-themes-nuanced-red)
+ ("python" modus-themes-nuanced-green)
+ ("ipython" modus-themes-nuanced-magenta)
+ ("r" modus-themes-nuanced-cyan)
+ ("yaml" modus-themes-nuanced-cyan)
+ ("conf" modus-themes-nuanced-cyan)
+ ("docker" modus-themes-nuanced-cyan)))
`(org-src-block-faces '())))
"Custom variables for `modus-themes-theme'.")
@@ -3792,14 +3917,10 @@ corresponding entries."
(let ((sym (gensym))
(colors (mapcar #'car (symbol-value palette))))
`(let* ((c '((class color) (min-colors 256)))
- (,sym (append ,overrides modus-themes-common-palette-overrides
,palette))
+ (,sym (modus-themes--palette-value ',name ',overrides))
,@(mapcar (lambda (color)
(list color
- `(let* ((value (car (alist-get ',color ,sym))))
- (if (or (stringp value)
- (eq value 'unspecified))
- value
- (car (alist-get value ,sym))))))
+ `(modus-themes--retrieve-palette-value ',color
,sym)))
colors))
(ignore c ,@colors) ; Silence unused variable warnings
(custom-theme-set-faces ',name ,@modus-themes-faces)
@@ -3821,11 +3942,7 @@ corresponding entries."
(,sym (modus-themes--current-theme-palette :overrides))
,@(mapcar (lambda (color)
(list color
- `(let* ((value (car (alist-get ',color ,sym))))
- (if (or (stringp value)
- (eq value 'unspecified))
- value
- (car (alist-get value ,sym))))))
+ `(modus-themes--retrieve-palette-value ',color
,sym)))
colors))
(ignore c ,@colors) ; Silence unused variable warnings
,@body)))
diff --git a/etc/themes/modus-vivendi-deuteranopia-theme.el
b/etc/themes/modus-vivendi-deuteranopia-theme.el
index 2c3ecd72a03..57241c59b96 100644
--- a/etc/themes/modus-vivendi-deuteranopia-theme.el
+++ b/etc/themes/modus-vivendi-deuteranopia-theme.el
@@ -184,23 +184,25 @@ standard).")
(bg-added "#003066")
(bg-added-faint "#001a4f")
(bg-added-refine "#0f4a77")
- (bg-added-intense "#0f4fbf")
+ (bg-added-fringe "#006fff")
(fg-added "#c4d5ff")
- (fg-added-intense "#a0afff")
+ (fg-added-intense "#8080ff")
(bg-changed "#2f123f")
(bg-changed-faint "#1f022f")
(bg-changed-refine "#3f325f")
- (bg-changed-intense "#7f42af")
+ (bg-changed-fringe "#7f55a0")
(fg-changed "#e3cfff")
- (fg-changed-intense "#c0a4ff")
+ (fg-changed-intense "#cf9fe2")
(bg-removed "#3d3d00")
(bg-removed-faint "#281f00")
(bg-removed-refine "#515100")
- (bg-removed-intense "#dfd23a")
+ (bg-removed-fringe "#d0c03f")
(fg-removed "#d4d48f")
- (fg-removed-intense "#c0b05f")
+ (fg-removed-intense "#d0b05f")
+
+ (bg-diff-context "#1a1a1a")
;;; Paren match
@@ -379,10 +381,7 @@ as a symbol and the latter as a string.
Semantic color mappings have the form (MAPPING-NAME COLOR-NAME)
with both as symbols. The latter is a named color that already
-exists in the palette and is associated with a HEX-VALUE.
-
-Semantic color mappings cannot be recursive: their value must be
-either COLOR-NAME or HEX-VALUE.")
+exists in the palette and is associated with a HEX-VALUE.")
(defcustom modus-vivendi-deuteranopia-palette-overrides nil
"Overrides for `modus-vivendi-deuteranopia-palette'.
diff --git a/etc/themes/modus-vivendi-theme.el
b/etc/themes/modus-vivendi-theme.el
index d2ec3fd2753..5012f8fb7f8 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -182,24 +182,26 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-added "#00381f")
(bg-added-faint "#002910")
(bg-added-refine "#034f2f")
- (bg-added-intense "#237f3f")
+ (bg-added-fringe "#237f3f")
(fg-added "#a0e0a0")
(fg-added-intense "#80e080")
(bg-changed "#363300")
(bg-changed-faint "#2a1f00")
(bg-changed-refine "#4a4a00")
- (bg-changed-intense "#8a7a00")
+ (bg-changed-fringe "#8a7a00")
(fg-changed "#efef80")
(fg-changed-intense "#c0b05f")
(bg-removed "#4f1119")
(bg-removed-faint "#380a0f")
(bg-removed-refine "#781a1f")
- (bg-removed-intense "#b81a1f")
+ (bg-removed-fringe "#b81a1f")
(fg-removed "#ffbfbf")
(fg-removed-intense "#ff9095")
+ (bg-diff-context "#1a1a1a")
+
;;; Paren match
(bg-paren-match "#2f7f9f")
@@ -377,10 +379,7 @@ as a symbol and the latter as a string.
Semantic color mappings have the form (MAPPING-NAME COLOR-NAME)
with both as symbols. The latter is a named color that already
-exists in the palette and is associated with a HEX-VALUE.
-
-Semantic color mappings cannot be recursive: their value must be
-either COLOR-NAME or HEX-VALUE.")
+exists in the palette and is associated with a HEX-VALUE.")
(defcustom modus-vivendi-palette-overrides nil
diff --git a/etc/themes/modus-vivendi-tinted-theme.el
b/etc/themes/modus-vivendi-tinted-theme.el
index 001a8470986..79e7fc9e3d8 100644
--- a/etc/themes/modus-vivendi-tinted-theme.el
+++ b/etc/themes/modus-vivendi-tinted-theme.el
@@ -121,12 +121,12 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
- (bg-red-nuanced "#2c0614")
- (bg-green-nuanced "#001904")
- (bg-yellow-nuanced "#221000")
- (bg-blue-nuanced "#0f0e39")
- (bg-magenta-nuanced "#230631")
- (bg-cyan-nuanced "#041529")
+ (bg-red-nuanced "#350f14")
+ (bg-green-nuanced "#002718")
+ (bg-yellow-nuanced "#2c1f00")
+ (bg-blue-nuanced "#131c4d")
+ (bg-magenta-nuanced "#2f133f")
+ (bg-cyan-nuanced "#04253f")
;;; Graphs
@@ -176,24 +176,26 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-added "#003a2f")
(bg-added-faint "#002922")
(bg-added-refine "#035542")
- (bg-added-intense "#237f4f")
+ (bg-added-fringe "#23884f")
(fg-added "#a0e0a0")
(fg-added-intense "#80e080")
(bg-changed "#363300")
(bg-changed-faint "#2a1f00")
(bg-changed-refine "#4a4a00")
- (bg-changed-intense "#8a7a00")
+ (bg-changed-fringe "#8f7a30")
(fg-changed "#efef80")
(fg-changed-intense "#c0b05f")
(bg-removed "#4f1127")
(bg-removed-faint "#380a19")
(bg-removed-refine "#781a3a")
- (bg-removed-intense "#b81a26")
+ (bg-removed-fringe "#b81a26")
(fg-removed "#ffbfbf")
(fg-removed-intense "#ff9095")
+ (bg-diff-context "#1a1f30")
+
;;; Uncommon accent backgrounds
(bg-ochre "#442c2f")
@@ -377,10 +379,7 @@ as a symbol and the latter as a string.
Semantic color mappings have the form (MAPPING-NAME COLOR-NAME)
with both as symbols. The latter is a named color that already
-exists in the palette and is associated with a HEX-VALUE.
-
-Semantic color mappings cannot be recursive: their value must be
-either COLOR-NAME or HEX-VALUE.")
+exists in the palette and is associated with a HEX-VALUE.")
(defcustom modus-vivendi-tinted-palette-overrides nil
"Overrides for `modus-vivendi-tinted-palette'.
diff --git a/leim/SKK-DIC/SKK-JISYO.L b/leim/SKK-DIC/SKK-JISYO.L
index 2d4f6198984..792f5318269 100644
--- a/leim/SKK-DIC/SKK-JISYO.L
+++ b/leim/SKK-DIC/SKK-JISYO.L
@@ -73335,7 +73335,7 @@ zyklus /
�������礯 /����/
������ /����/����/
������ /�»�/
-����
/����;engineer/����;(���̾����)/����/����/����/����/����;�ܻҤʤ�/����/����/��;-������/��/
+����
/����;engineer/����;(���̾����)/����/����/����/����/����;�ܻҤʤ�/����/����/��;-������/��/
������ /����/
�������Ƥ� /����Ū/
�������礦 /����Ĺ/
@@ -87687,7 +87687,7 @@ zyklus /
��������ۤ��� /�ĸ�����/
�������� /�ͷ�/
�������� /�з�/
-�������� /�Ƹ�;represent/�ݸ�;limits.��-̵����/
+�������� /�Ƹ�;reproduce/�ݸ�;limits.��-̵����/
�������Τ� /�Ƹ���ǽ/
�������� /�Ƹ���/
��������Ƥ���� /�Ƹ����/
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c
index 469e90d04bb..371fa6c938b 100644
--- a/lib-src/ebrowse.c
+++ b/lib-src/ebrowse.c
@@ -31,11 +31,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <min-max.h>
#include <unlocked-io.h>
-/* The SunOS compiler doesn't have SEEK_END. */
-#ifndef SEEK_END
-#define SEEK_END 2
-#endif
-
/* Files are read in chunks of this number of bytes. */
enum { READ_CHUNK_SIZE = 100 * 1024 };
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 2628849d78e..2c6b4e7a630 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -978,8 +978,8 @@ Relative ones are stored relative to the output file's
directory.\n");
puts
("\tand create tags for extern variables unless --no-globals is used.");
- puts ("In Mercury, tag both declarations starting a line with ':-' and
first\n\
- predicates or functions in clauses.");
+ puts ("\tIn Mercury, tag both declarations starting a line with ':-' and\n\
+ first predicates or functions in clauses.");
if (CTAGS)
puts ("-d, --defines\n\
@@ -1732,6 +1732,8 @@ process_file_name (char *file, language *lang)
char *cmd = xmalloc (buf_len);
snprintf (cmd, buf_len, "%s %s > %s",
compr->command, new_real_name, new_tmp_name);
+ free (new_real_name);
+ free (new_tmp_name);
#endif
inf = (system (cmd) == -1
? NULL
diff --git a/lib/getopt-pfx-core.h b/lib/getopt-pfx-core.h
index 3a2fde5ad4f..095e3930feb 100644
--- a/lib/getopt-pfx-core.h
+++ b/lib/getopt-pfx-core.h
@@ -47,7 +47,7 @@
# define optind __GETOPT_ID (optind)
# define optopt __GETOPT_ID (optopt)
-/* Work around a a problem on macOS, which declares getopt with a
+/* Work around a problem on macOS, which declares getopt with a
trailing __DARWIN_ALIAS(getopt) that would expand to something like
__asm("_" "rpl_getopt" "$UNIX2003") were it not for the following
hack to suppress the macOS declaration <https://bugs.gnu.org/40205>. */
diff --git a/lib/limits.in.h b/lib/limits.in.h
index eaeac472299..a01b4c6a280 100644
--- a/lib/limits.in.h
+++ b/lib/limits.in.h
@@ -119,11 +119,14 @@
/* Macros specified by C23. */
-#if (! defined BOOL_WIDTH \
- && (defined _GNU_SOURCE \
- || (defined __STDC_VERSION__ && 201710 < __STDC_VERSION__)))
-# define BOOL_MAX 1
-# define BOOL_WIDTH 1
+#if (defined _GNU_SOURCE \
+ || (defined __STDC_VERSION__ && 201710 < __STDC_VERSION__))
+# if ! defined BOOL_WIDTH
+# define BOOL_WIDTH 1
+# define BOOL_MAX 1
+# elif ! defined BOOL_MAX
+# define BOOL_MAX ((((1U << (BOOL_WIDTH - 1)) - 1) << 1) + 1)
+# endif
#endif
#endif /* _@GUARD_PREFIX@_LIMITS_H */
diff --git a/lib/string.in.h b/lib/string.in.h
index aa088213927..b6bf432e1f1 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -126,7 +126,11 @@
# if (@REPLACE_FREE@ && !defined free \
&& !(defined __cplusplus && defined GNULIB_NAMESPACE))
/* We can't do '#define free rpl_free' here. */
+# if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2)
+_GL_EXTERN_C void rpl_free (void *) throw ();
+# else
_GL_EXTERN_C void rpl_free (void *);
+# endif
# undef _GL_ATTRIBUTE_DEALLOC_FREE
# define _GL_ATTRIBUTE_DEALLOC_FREE _GL_ATTRIBUTE_DEALLOC (rpl_free, 1)
# else
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index bfc501e5a7d..8ba9867894e 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -40,6 +40,24 @@
# undef _GL_INCLUDING_UNISTD_H
#endif
+/* Avoid lseek bugs in FreeBSD, macOS <https://bugs.gnu.org/61386>.
+ This bug is fixed after FreeBSD 13; see <https://bugs.freebsd.org/256205>.
+ Use macOS "9999" to stand for a future fixed macOS version. */
+#if defined __FreeBSD__ && __FreeBSD__ < 14
+# undef SEEK_DATA
+# undef SEEK_HOLE
+#elif defined __APPLE__ && defined __MACH__ && defined SEEK_DATA
+# ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__
+# include <AvailabilityMacros.h>
+# endif
+# if (!defined MAC_OS_X_VERSION_MIN_REQUIRED \
+ || MAC_OS_X_VERSION_MIN_REQUIRED < 99990000)
+# include <sys/fcntl.h> /* It also defines the two macros. */
+# undef SEEK_DATA
+# undef SEEK_HOLE
+# endif
+#endif
+
/* Get all possible declarations of gethostname(). */
#if @GNULIB_GETHOSTNAME@ && @UNISTD_H_HAVE_WINSOCK2_H@ \
&& !defined _GL_INCLUDING_WINSOCK2_H
diff --git a/lib/verify.h b/lib/verify.h
index 8f786af7f5a..f0b3fc5851b 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -265,6 +265,8 @@ template <int w>
# define _GL_SA3 static_assert
# define _GL_SA_PICK(x1,x2,x3,x4,...) x4
# define static_assert(...)
_GL_EXPAND(_GL_SA_PICK(__VA_ARGS__,_GL_SA3,_GL_SA2,_GL_SA1)) (__VA_ARGS__)
+/* Avoid "fatal error C1189: #error: The C++ Standard Library forbids
macroizing keywords." */
+# define _ALLOW_KEYWORD_MACROS 1
# else
# define static_assert _Static_assert /* C11 requires this #define. */
# endif
diff --git a/lisp/bs.el b/lisp/bs.el
index 5f31530f068..70868591196 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -933,7 +933,7 @@ WHAT is a value of nil, `never', or `always'."
(end-of-line)
(if (eobp) (point) (1+ (point)))))
(when (eobp)
- (backward-delete-char 1)
+ (delete-char -1)
(beginning-of-line)
(recenter -1))
(bs--set-window-height)))
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index bb0ecd2c84f..52c0fa4f69f 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1297,12 +1297,13 @@ calc-kill calc-kill-region calc-yank))))
0))
(let ((msg (nth calc-prefix-help-phase msgs)))
(message "%s" (if msg
- (concat group ": " msg ":"
+ (concat group ": " (substitute-command-keys msg)
":"
(make-string
(- (apply #'max (mapcar #'length msgs))
(length msg))
?\s)
- " [MORE]"
+ (substitute-command-keys
+ " [\\`?'=MORE]")
(if key
(concat " " (char-to-string key)
"-")
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index d0052472836..6b3e5cd64b1 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -39,8 +39,11 @@
(or calc-dispatch-help (sit-for echo-keystrokes))
(let ((key (calc-read-key-sequence
(if calc-dispatch-help
- "Calc Help options: Help, Info, Tutorial, Summary; Key,
Function; ?=more"
- (format "%s (Type ? for a list of Calc Help options)"
+ (substitute-command-keys
+ (concat "Calc Help options: \\`h'elp, \\`i'nfo,
\\`t'utorial, "
+ "\\`s'ummary; \\`k'ey, \\`f'unction; \\`?'=more"))
+ (format (substitute-command-keys
+ "%s (Type \\`?' for a list of Calc Help options)")
(key-description (this-command-keys))))
calc-help-map)))
(setq key (lookup-key calc-help-map key))
@@ -76,7 +79,10 @@
(describe-function 'calc-help-for-help)
(select-window (get-buffer-window "*Help*"))
(while (progn
- (message "Calc Help options: Help, Info, ... press SPC, DEL
to scroll, C-g to cancel")
+ (message (substitute-command-keys
+ (concat
+ "Calc Help options: \\`h'elp, \\`i'nfo, ...
press "
+ "\\`SPC', \\`DEL' to scroll, \\`C-g' to
cancel")))
(memq (setq key (read-event))
'(? ?\C-h ?\C-? ?\C-v ?\M-v)))
(condition-case nil
@@ -453,47 +459,47 @@
(defun calc-h-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Help; Bindings; Info, Tutorial, Summary; News"
- "describe: Key, C (briefly), Function, Variable")
+ '("\\`h'elp; \\`b'indings; \\`i'nfo, \\`t'utorial, \\`s'ummary; \\`n'ews"
+ "describe: \\`k'ey, \\`c' (briefly), \\`f'unction, \\`v'ariable")
"help" ?h))
(defun calc-inverse-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("I + S (arcsin), C (arccos), T (arctan); Q (square)"
- "I + E (ln), L (exp), B (alog: B^X); f E (lnp1), f L (expm1)"
- "I + F (ceiling), R (truncate); a S (invert func)"
- "I + a m (match-not); c h (from-hms); k n (prev prime)"
- "I + f G (gamma-Q); f e (erfc); k B (etc., lower-tail dists)"
- "I + V S (reverse sort); V G (reverse grade)"
- "I + v s (remove subvec); v h (tail)"
- "I + t + (alt sum), t M (mean with error)"
- "I + t S (pop std dev), t C (pop covar)")
+ '("\\`I' + \\`S' (arcsin), \\`C' (arccos), \\`T' (arctan); \\`Q' (square)"
+ "\\`I' + \\`E' (ln), \\`L' (exp), \\`B' (alog: B^X); \\`f E' (lnp1), \\`f
L' (expm1)"
+ "\\`I' + \\`F' (ceiling), \\`R' (truncate); \\`a S' (invert func)"
+ "\\`I' + \\`a m' (match-not); \\`c h' (from-hms); \\`k n' (prev prime)"
+ "\\`I' + \\`f G' (gamma-Q); \\`f e' (erfc); \\`k B' (etc., lower-tail
dists)"
+ "\\`I' + \\`V S' (reverse sort); \\`V G' (reverse grade)"
+ "\\`I' + \\`v s' (remove subvec); \\`v h' (tail)"
+ "\\`I' + \\`t' + (alt sum), \\`t M' (mean with error)"
+ "\\`I' + \\`t S' (pop std dev), \\`t C' (pop covar)")
"inverse" nil))
(defun calc-hyperbolic-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("H + S (sinh), C (cosh), T (tanh); E (exp10), L (log10)"
- "H + F (float floor), R (float round); P (constant \"e\")"
- "H + a d (total derivative); k c (permutations)"
- "H + k b (bern-poly), k e (euler-poly); k s (stirling-2)"
- "H + f G (gamma-g), f B (beta-B); v h (rhead), v k (rcons)"
- "H + v e (expand w/filler); V H (weighted histogram)"
- "H + a S (general solve eqn), j I (general isolate)"
- "H + a R (widen/root), a N (widen/min), a X (widen/max)"
- "H + t M (median), t S (variance), t C (correlation coef)"
- "H + c f/F/c (pervasive float/frac/clean)")
+ '("\\`H' + \\`S' (sinh), \\`C' (cosh), \\`T' (tanh); \\`E' (exp10), \\`L'
(log10)"
+ "\\`H' + \\`F' (float floor), \\`R' (float round); \\`P' (constant \"e\")"
+ "\\`H' + \\`a d' (total derivative); \\`k c' (permutations)"
+ "\\`H' + \\`k b' (bern-poly), \\`k e' (euler-poly); \\`k s' (stirling-2)"
+ "\\`H' + \\`f G' (gamma-g), \\`f B' (beta-B); \\`v h' (rhead), \\`v k'
(rcons)"
+ "\\`H' + \\`v e' (expand w/filler); \\`V H' (weighted histogram)"
+ "\\`H' + \\`a S' (general solve eqn), \\`j I' (general isolate)"
+ "\\`H' + \\`a R' (widen/root), \\`a N' (widen/min), \\`a X' (widen/max)"
+ "\\`H' + \\`t M' (median), \\`t S' (variance), \\`t C' (correlation coef)"
+ "\\`H' + \\`c' \\`f'/\\`F'/\\`c' (pervasive float/frac/clean)")
"hyperbolic" nil))
(defun calc-inv-hyp-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("I H + S (arcsinh), C (arccosh), T (arctanh)"
- "I H + E (log10), L (exp10); f G (gamma-G)"
- "I H + F (float ceiling), R (float truncate)"
- "I H + t S (pop variance)"
- "I H + a S (general invert func); v h (rtail)")
+ '("\\`I H' + \\`S' (arcsinh), \\`C' (arccosh), \\`T' (arctanh)"
+ "\\`I H' + \\`E' (log10), \\`L' (exp10); \\`f G' (gamma-G)"
+ "\\`I H' + \\`F' (float ceiling), \\`R' (float truncate)"
+ "\\`I H' + \\`t S' (pop variance)"
+ "\\`I H' + \\`a S' (general invert func); \\`v h' (rtail)")
"inverse-hyperbolic" nil))
(defun calc-option-prefix-help ()
@@ -505,10 +511,10 @@
(defun calc-f-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("miN, maX; Hypot; Im, Re; Sign; [, ] (incr/decr)"
- "Gamma, Beta, Erf, besselJ, besselY"
- "SHIFT + int-sQrt; Int-log, Exp(x)-1, Ln(x+1); arcTan2"
- "SHIFT + Abssqr; Mantissa, eXponent, Scale"
+ '("mi\\`n', ma\\`x'; \\`h'ypot; \\`i'm, \\`r'e; \\`s'ign; \\`[', \\`]'
(incr/decr)"
+ "\\`g'amma, \\`b'eta, \\`e'rf, bessel\\`j', bessel\\`y'"
+ "int-s\\`Q'rt; \\`I'nt-log, \\`E'xp(x)-1, \\`L'n(x+1); arc\\`T'an2"
+ "\\`A'bssqr; \\`M'antissa, e\\`X'ponent, \\`S'cale"
"SHIFT + incomplete: Gamma-P, Beta-I")
"functions" ?f))
@@ -516,165 +522,165 @@
(defun calc-s-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Store, inTo, Xchg, Unstore; Recall, 0-9; : (:=); = (=>)"
- "Let; Copy, K=copy constant; Declare; Insert, Perm; Edit"
- "Negate, +, -, *, /, ^, &, |, [, ]; Map"
- "SHIFT + Decls, GenCount, TimeZone, Holidays; IntegLimit"
- "SHIFT + LineStyles, PointStyles, plotRejects; Units"
- "SHIFT + Eval-, AlgSimp-, ExtSimp-, FitRules")
+ '("\\`s'tore, in\\`t'o, \\`x'chg, \\`u'nstore; \\`r'ecall, \\`0'-\\`9';
\\`:' (:=); \\`=' (=>)"
+ "\\`l'et; \\`c'opy, \\`k'=copy constant; \\`d'eclare; \\`i'nsert,
\\`p'erm; \\`e'dit"
+ "\\`n'egate, \\`+', \\`-', \\`*', \\`/', \\`^', \\`&', \\`|', \\`[',
\\`]'; Map"
+ "\\`D'ecls, \\`G'enCount, \\`T'imeZone, \\`H'olidays; \\`I'ntegLimit"
+ "\\`L'ineStyles, \\`P'ointStyles, plot\\`R'ejects; \\`U'nits"
+ "\\`E'val-, \\`A'lgSimp-, e\\`X'tSimp-, \\`F'itRules")
"store" ?s))
(defun calc-r-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("digits 0-9: recall, same as `s r 0-9'"
- "Save to register, Insert from register")
+ '("digits \\`0'-\\`9': recall, same as \\`s r' \\`0'-\\`9'"
+ "\\`s'ave to register, \\`i'nsert from register")
"recall/register" ?r))
(defun calc-j-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Select, Additional, Once; eVal, Formula; Rewrite"
- "More, Less, 1-9, Next, Previous"
- "Unselect, Clear; Display; Enable; Breakable"
- "\\=' (replace), \\=` (edit), +, -, *, /, RET (grab), DEL"
- "SHIFT + swap: Left, Right; maybe: Select, Once"
- "SHIFT + Commute, Merge, Distrib, jump-Eqn, Isolate"
- "SHIFT + Negate, & (invert); Unpack")
+ '("\\`s'elect, \\`a'dditional, \\`o'nce; e\\`v'al, \\`f'ormula; \\`r'ewrite"
+ "\\`m'ore, \\`l'ess, \\`1'-\\`9', \\`n'ext, \\`p'revious"
+ "\\`u'nselect, \\`c'lear; \\`d'isplay; \\`e'nable; \\`b'reakable"
+ "\\=' (replace), \\=` (edit), \\`+', \\`-', \\`*', \\`/', \\`RET' (grab),
\\`DEL'"
+ "swap: \\`L'eft, \\`R'ight; maybe: \\`S'elect, \\`O'nce"
+ "\\`C'ommute, \\`M'erge, \\`D'istrib, jump-\\`E'qn, \\`I'solate"
+ "\\`N'egate, \\`&' (invert); \\`U'npack")
"select" ?j))
(defun calc-a-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Simplify, Extended-simplify, eVal; \" (exp-formula)"
- "eXpand, Collect, Factor, Apart, Norm-rat"
- "GCD, /, \\, % (polys); Polint"
- "Derivative, Integral, Taylor; _ (subscr)"
- "suBstitute; Rewrite, Match"
- "SHIFT + Solve; Root, miN, maX; Poly-roots; Fit"
- "SHIFT + Map; Tabulate, + (sum), * (prod); num-Integ"
- "relations: =, # (not =), <, >, [ (< or =), ] (> or =)"
- "logical: & (and), | (or), ! (not); : (if)"
- "misc: { (in-set); . (rmeq)")
+ '("\\`s'implify, \\`e'xtended-simplify, e\\`v'al; \\`\"' (exp-formula)"
+ "e\\`x'pand, \\`c'ollect, \\`f'actor, \\`a'part, \\`n'orm-rat"
+ "\\`g' (GCD), \\`/', \\`\\', \\`%' (polys); \\`p'olint"
+ "\\`d'erivative, \\`i'ntegral, \\`t'aylor; \\`_' (subscr)"
+ "su\\`b'stitute; \\`r'ewrite, \\`m'atch"
+ "\\`S'olve; \\`R'oot, mi\\`N', ma\\`X'; \\`P'oly-roots; \\`F'it"
+ "\\`M'ap; \\`T'abulate, \\`+' (sum), \\`*' (prod); num-\\`I'nteg"
+ "relations: \\`=', \\`#' (not =), \\`<', \\`>', \\`[' (< or =), \\`]' (>
or =)"
+ "logical: \\`&' (and), \\`|' (or), \\`!' (not); \\`:' (if)"
+ "misc: \\`{' (in-set); \\`.' (rmeq)")
"algebra" ?a))
(defun calc-b-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("And, Or, Xor, Diff, Not; Wordsize, Clip"
- "Lshift, Rshift, roTate; SHIFT + signed Lshift, Rshift"
- "SHIFT + business: Pv, Npv, Fv, pMt, #pmts, raTe, Irr"
- "SHIFT + business: Sln, sYd, Ddb; %ch")
+ '("\\`a'nd, \\`o'r, \\`x'or, \\`d'iff, \\`n'ot; \\`w'ordsize, \\`c'lip"
+ "\\`l'shift, \\`r'shift, ro\\`t'ate; signed \\`L'shift, \\`R'shift"
+ "business: \\`P'v, \\`N'pv, \\`F'v, p\\`M't, \\`#'pmts, ra\\`T'e, \\`I'rr"
+ "business: \\`S'ln, s\\`Y'd, \\`D'db; \\`%'ch")
"binary/bus" ?b))
(defun calc-c-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Deg, Rad, HMS; Float; Polar/rect; Clean, 0-9; %"
- "SHIFT + Fraction")
+ '("\\`d'eg, \\`r'ad, \\`h'ms; \\`f'loat; \\`p'olar/rect; \\`c'lean,
\\`0'-\\`9'; \\`%'"
+ "\\`F'raction")
"convert" ?c))
(defun calc-d-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Group, \",\"; Normal, Fix, Sci, Eng, \".\"; Over"
- "Radix, Zeros, 2, 8, 0, 6; Hms; Date; Complex, I, J"
- "Why; Line-nums, line-Breaks; <, =, > (justify); Plain"
- "\" (strings); Truncate, [, ]; SPC (refresh), RET, @"
- "SHIFT + language: Normal, One-line, Big, Unformatted"
- "SHIFT + language: C, Pascal, Fortran; TeX, LaTeX, Eqn"
- "SHIFT + language: Yacas, X=Maxima, A=Giac"
- "SHIFT + language: Mathematica, W=Maple")
+ '("\\`g'roup, \\`,'; \\`n'ormal, \\`f'ix, \\`s'ci, \\`e'ng, \\`.'; \\`o'ver"
+ "\\`r'adix, \\`z'eros, \\`2', \\`8', \\`0', \\`6'; \\`h'ms; \\`d'ate;
\\`c'omplex, \\`i', \\`j'"
+ "\\`w'hy; \\`l'ine-nums, line-\\`b'reaks; \\`<', \\`=', \\`>' (justify);
\\`p'lain"
+ "\\`\"' (strings); \\`t'runcate, \\`[', \\`]'; \\`SPC' (refresh),
\\`RET', \\`@'"
+ "language: \\`N'ormal, \\`O'ne-line, \\`B'ig, \\`U'nformatted"
+ "language: \\`C', \\`P'ascal, \\`F'ortran; \\`T'eX, \\`L'aTeX, \\`E'qn"
+ "language: \\`Y'acas, \\`X'=Maxima, \\`A'=Giac"
+ "language: \\`M'athematica, \\`W'=Maple")
"display" ?d))
(defun calc-g-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Fast; Add, Delete, Juggle; Plot, Clear; Quit"
- "Header, Name, Grid, Border, Key; View-commands, X-display"
- "x-axis: Range, Title, Log, Zero; lineStyle"
- "SHIFT + y-axis: Range, Title, Log, Zero; pointStyle"
- "SHIFT + Print; Device, Output-file; X-geometry"
- "SHIFT + Num-pts; Command, Kill, View-trail"
- "SHIFT + 3d: Fast, Add; CTRL + z-axis: Range, Title, Log")
+ '("\\`f'ast; \\`a'dd, \\`d'elete, \\`j'uggle; \\`p'lot, \\`c'lear; \\`q'uit"
+ "\\`h'eader, \\`n'ame, \\`g'rid, \\`b'order, \\`k'ey; \\`v'iew-commands,
\\`x'-display"
+ "x-axis: \\`r'ange, \\`t'itle, \\`l'og, \\`z'ero; line\\`s'tyle"
+ "y-axis: \\`R'ange, \\`T'itle, \\`L'og, \\`Z'ero; point\\`S'tyle"
+ "\\`P'rint; \\`D'evice, \\`O'utput-file; \\`X'-geometry"
+ "\\`N'um-pts; \\`C'ommand, \\`K'ill, \\`V'iew-trail"
+ "3d: \\`F'ast, \\`A'dd; z-axis: \\`C-r' (range), \\`C-t' (title), \\`C-l'
(log)")
"graph" ?g))
(defun calc-k-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("GCD, LCM; Choose (binomial), Double-factorial"
- "Random, random-Again, sHuffle"
- "Factors, Prime-test, Next-prime, Totient, Moebius"
- "Bernoulli, Euler, Stirling"
- "SHIFT + Extended-gcd"
- "SHIFT + dists: Binomial, Chi-square, F, Normal"
- "SHIFT + dists: Poisson, student's-T")
+ '("\\`g' (GCD), \\`l' (LCM); \\`c'hoose (binomial), \\`d'ouble-factorial"
+ "\\`r'andom, random-\\`a'gain, s\\`h'uffle"
+ "\\`f'actors, \\`p'rime-test, \\`n'ext-prime, \\`t'otient, \\`m'oebius"
+ "\\`b'ernoulli, \\`e'uler, \\`s'tirling"
+ "\\`E'xtended-gcd"
+ "dists: \\`B'inomial, \\`C'hi-square, \\`F', \\`N'ormal"
+ "dists: \\`P'oisson, student\\='s-\\`T'")
"combinatorics" ?k))
(defun calc-m-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Deg, Rad, HMS; Frac; Polar; Inf; Alg, Total; Symb; Vec/mat"
- "Working; Xtensions; Mode-save; preserve Embedded modes"
- "SHIFT + Shifted-prefixes, mode-Filename; Record; reCompute"
- "SHIFT + simplify: Off, Num, basIc, Algebraic, Bin, Ext, Units")
+ '("\\`d'eg, \\`r'ad, \\`h' (HMS); \\`f'rac; \\`p'olar; \\`i'nf; \\`a'lg,
\\`t'otal; \\`s'ymb; \\`v'ec/mat"
+ "\\`w'orking; \\`x'tensions; \\`m'ode-save; preserve \\`e'mbedded modes"
+ "\\`S'hifted-prefixes, mode-\\`F'ilename; \\`R'ecord; re\\`C'ompute"
+ "simplify: \\`O'ff, \\`N'um, bas\\`I'c, \\`A'lgebraic, \\`B'in, \\`E'xt,
\\`U'nits")
"mode" ?m))
(defun calc-t-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Display; Fwd, Back; Next, Prev, Here, [, ]; Yank"
- "Search, Rev; In, Out; <, >; Kill; Marker; . (abbrev)"
- "SHIFT + time: Now; Part; Date, Julian, Unix, Czone"
- "SHIFT + time: newWeek, newMonth, newYear; Incmonth"
- "SHIFT + time: +, - (business days)"
- "digits 0-9: store-to, same as `s t 0-9'")
+ '("\\`d'isplay; \\`f'wd, \\`b'ack; \\`n'ext, \\`p'rev, \\`h'ere, \\`[',
\\`]'; \\`y'ank"
+ "\\`s'earch, \\`r'ev; \\`i'n, \\`o'ut; \\`<', \\`>'; \\`k'ill;
\\`m'arker; \\`.' (abbrev)"
+ "time: \\`N'ow; \\`P'art; \\`D'ate, \\`J'ulian, \\`U'nix, \\`C'zone"
+ "time: new\\`W'eek, new\\`M'onth, new\\`Y'ear; \\`I'ncmonth"
+ "time: \\`+', \\`-' (business days)"
+ "digits \\`0'-\\`9': store-to, same as \\`s t' \\`0'-\\`9'")
"trail/time" ?t))
(defun calc-u-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Simplify, Convert, coNvert exact, Temperature-convert, Base-units"
- "Autorange; Remove, eXtract; Explain; View-table; 0-9"
- "Define, Undefine, Get-defn, Permanent"
- "SHIFT + View-table-other-window"
- "SHIFT + stat: Mean, G-mean, Std-dev, Covar, maX, miN"
- "SHIFT + stat: + (sum), - (asum), * (prod), # (count)")
+ '("\\`s'implify, \\`c'onvert, co\\`n'vert exact, \\`t'emperature-convert,
\\`b'ase-units"
+ "\\`a'utorange; \\`r'emove, e\\`x'tract; \\`e'xplain; \\`v'iew-table;
\\`0'-\\`9'"
+ "\\`d'efine, \\`u'ndefine, \\`g'et-defn, \\`p'ermanent"
+ "\\`V'iew-table-other-window"
+ "stat: \\`M'ean, \\`G'-mean, \\`S'td-dev, \\`C'ovar, ma\\`X', mi\\`N'"
+ "stat: \\`+' (sum), \\`-' (asum), \\`*' (prod), \\`#' (count)")
"units/stat" ?u))
(defun calc-l-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Quantity, DB level, Np level"
- "+, -, *, /"
- "Scientific pitch notation, Midi number, Frequency"
+ '("\\`q'uantity, \\`d' (DB level), \\`n' (NP level)"
+ "\\`+', \\`-', \\`*', \\`/'"
+ "\\`s'cientific pitch notation, \\`m'idi number, \\`f'requency"
)
"log units" ?l))
(defun calc-v-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Pack, Unpack, Identity, Diagonal, indeX, Build"
- "Row, Column, Subvector; Length; Find; Mask, Expand"
- "Transpose, Arrange, reVerse; Head, Kons; rNorm"
- "SHIFT + Det, & (inverse), LUD, Trace, conJtrn, Cross"
- "SHIFT + Sort, Grade, Histogram; cNorm"
- "SHIFT + Apply, Map, Reduce, accUm, Inner-, Outer-prod"
- "SHIFT + sets: V (union), ^ (intersection), - (diff)"
- "SHIFT + sets: Xor, ~ (complement), Floor, Enum"
- "SHIFT + sets: : (span), # (card), + (rdup)"
- "<, =, > (justification); , (commas); [, {, ( (brackets)"
- "} (matrix brackets); . (abbreviate); / (multi-lines)")
+ '("\\`p'ack, \\`u'npack, \\`i'dentity, \\`d'iagonal, inde\\`x', \\`b'uild"
+ "\\`r'ow, \\`c'olumn, \\`s'ubvector; \\`l'ength; \\`f'ind; \\`m'ask,
\\`e'xpand"
+ "\\`t'ranspose, \\`a'rrange, re\\`v'erse; \\`h'ead, \\`k'ons; r\\`n'orm"
+ "\\`D'et, \\`&' (inverse), \\`L'UD, \\`T'race, con\\`J'trn, \\`C'ross"
+ "\\`S'ort, \\`G'rade, \\`H'istogram; c\\`N'orm"
+ "\\`A'pply, \\`M'ap, \\`R'educe, acc\\`U'm, \\`I'nner-, \\`O'uter-prod"
+ "sets: \\`V' (union), \\`^' (intersection), \\`-' (diff)"
+ "sets: \\`X'or, \\`~' (complement), \\`F'loor, \\`E'num"
+ "sets: \\`:' (span), \\`#' (card), \\`+' (rdup)"
+ "\\`<', \\`=', \\`>' (justification); \\`,' (commas); \\`[', \\`{', \\`('
(brackets)"
+ "\\`}' (matrix brackets); \\`.' (abbreviate); \\`/' (multi-lines)")
"vec/mat" ?v))
(provide 'calc-help)
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 613fb0a0154..93de04a586d 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -114,8 +114,11 @@ Calc user interface as before (either \\`C-x * C' or
\\`C-x * K'; initially \\`C
(let (key)
(select-window win)
(while (progn
- (message "Calc options: Calc, Keypad, ... %s"
- "press SPC, DEL to scroll, C-g to cancel")
+ (message
+ (substitute-command-keys
+ (concat
+ "Calc options: \\`c'alc, \\`k'eypad, ... "
+ "press \\`SPC', \\`DEL' to scroll, \\`C-g' to
cancel")))
(memq (setq key (read-event))
'(? ?\C-h ?\C-? ?\C-v ?\M-v)))
(condition-case nil
@@ -216,27 +219,26 @@ Calc user interface as before (either \\`C-x * C' or
\\`C-x * K'; initially \\`C
(defun calc-help ()
(interactive)
(let ((msgs
- ;; FIXME: Change these to `substitute-command-keys' syntax.
(mapcar #'substitute-command-keys
'("Press \\`h' for complete help; press \\`?' repeatedly for a
summary"
- "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit"
- "Letter keys: SHIFT + Undo, reDo; Inverse, Hyperbolic, Option"
- "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB"
- "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi"
- "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro;
Keep-args"
- "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
- "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
- "Other keys: \\=' (alg-entry), = (eval), \\=` (edit); M-RET
(last-args)"
- "Other keys: \\`SPC'/\\`RET' (enter/dup), LFD (over); < > (scroll
horiz)"
- "Other keys: \\`DEL' (drop), \\`M-DEL' (drop-above); { } (scroll
vert)"
+ "Letter keys: \\`n'egate; \\`p'recision; \\`y'ank; \\`w'hy;
\\`x'tended cmd; \\`q'uit"
+ "Letter keys: \\`U'ndo, re\\`D'o; \\`I'nverse, \\`H'yperbolic,
\\`O'ption"
+ "Letter keys: s\\`Q'rt; \\`S'in, \\`C'os, \\`T'an; \\`E'xp,
\\`L'n, log\\`B'"
+ "Letter keys: \\`F'loor, \\`R'ound; \\`A'bs, con\\`J', ar\\`G';
\\`P'i"
+ "Letter keys: \\`N'um-eval; \\`M'ore-recn; e\\`X'ec-kbd-macro;
\\`K'eep-args"
+ "Other keys: \\`+', \\`-', \\`*', \\`/', \\`^', \\`\\' (int div),
\\`:' (frac div)"
+ "Other keys: \\`&' (1/x), \\`|' (concat), \\`%' (modulo), \\`!'
(factorial)"
+ "Other keys: \\=' (alg-entry), \\`=' (eval), \\=` (edit);
\\`M-RET' (last-args)"
+ "Other keys: \\`SPC'/\\`RET' (enter/dup), \\`LFD' (over); \\`<'
\\`>' (scroll horiz)"
+ "Other keys: \\`DEL' (drop), \\`M-DEL' (drop-above); \\`{' \\`}'
(scroll vert)"
"Other keys: \\`TAB' (swap/roll-dn), \\`M-TAB' (roll-up)"
- "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)"
- "Prefix keys: Algebra, Binary/business, Convert, Display"
- "Prefix keys: Functions, Graphics, Help, J (select)"
- "Prefix keys: Kombinatorics/statistics, Modes, Store/recall"
- "Prefix keys: Trail/time, Units/statistics, Vector/matrix"
- "Prefix keys: Z (user), SHIFT + Z (define)"
- "Prefix keys: prefix + ? gives further help for that prefix"
+ "Other keys: \\`[' \\`,' \\`;' \\`]' (vector), \\`(' \\`,' \\`)'
(complex), \\`(' \\`;' \\`)' (polar)"
+ "Prefix keys: \\`a'lgebra, \\`b'inary/business, \\`c'onvert,
\\`d'isplay"
+ "Prefix keys: \\`f'unctions, \\`g'raphics, \\`h'elp, \\`j'
(select)"
+ "Prefix keys: \\`k'ombinatorics/statistics, \\`m'odes,
\\`s'tore/recall"
+ "Prefix keys: \\`t'rail/time, \\`u'nits/statistics,
\\`v'ector/matrix"
+ "Prefix keys: \\`z' (user), \\`Z' (define)"
+ "Prefix keys: prefix + \\`?' gives further help for that prefix"
" Calc by Dave Gillespie, daveg@synaptics.com"))))
(if calc-full-help-flag
msgs
@@ -260,7 +262,7 @@ Calc user interface as before (either \\`C-x * C' or \\`C-x
* K'; initially \\`C
msgs))
(length msg))
?\ )
- " [?=MORE]")
+ (substitute-command-keys "
[\\`?'=MORE]"))
""))))))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 39e54c89e06..a1545edba19 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1188,8 +1188,12 @@ Used by `calc-user-invocation'.")
"Start the Calculator."
(let ((key (calc-read-key-sequence
(if calc-dispatch-help
- "Calc options: Calc, Keypad, Quick, Embed; eXit; Info,
Tutorial; Grab; ?=more"
- (format "%s (Type ? for a list of Calc options)"
+ (substitute-command-keys
+ (concat
+ "Calc options: \\`c'alc, \\`k'eypad, \\`q'uick, \\`e'mbed;
"
+ "e\\`x'it; \\`i'nfo, \\`t'utorial; \\`g'rab; \\`?'=more"))
+ (format (substitute-command-keys
+ "%s (Type \\`?' for a list of Calc options)")
(key-description (this-command-keys))))
calc-dispatch-map)))
(setq key (lookup-key calc-dispatch-map key))
@@ -1282,16 +1286,17 @@ the trail buffer."
(defun calc-mode ()
"Calculator major mode.
-This is an RPN calculator featuring arbitrary-precision integer, rational,
-floating-point, complex, matrix, and symbolic arithmetic.
+This is a Reverse Polish notation (RPN) calculator featuring
+arbitrary-precision integer, rational, floating-point, complex,
+matrix, and symbolic arithmetic.
RPN calculation: 2 RET 3 + produces 5.
Algebraic style: \\=' 2+3 RET produces 5.
Basic operators are +, -, *, /, ^, & (reciprocal), % (modulo), n (change-sign).
-Press ? repeatedly for more complete help. Press `h i' to read the
-Calc manual on-line, `h s' to read the summary, or `h t' for the tutorial.
+Press \\`?' repeatedly for more complete help. Press \\`h i' to read the
+Calc manual, \\`h s' to read the summary, or \\`h t' for the tutorial.
Notations: 3.14e6 3.14 * 10^6
_23 negative number -23 (or type `23 n')
@@ -2477,7 +2482,8 @@ the United States."
(interactive)
(cond ((eq last-command 'calcDigit-start)
(erase-buffer))
- (t (backward-delete-char 1)))
+ (t (with-suppressed-warnings ((interactive-only backward-delete-char))
+ (backward-delete-char 1))))
(if (= (calc-minibuffer-size) 0)
(progn
(setq last-command-event 13)
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 0db811417af..5b22043102d 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -85,13 +85,16 @@ remainder mod 4 gives the phase: 0 new moon, 1 first
quarter, 2 full moon,
(* 0.0107306 time time)
(* 0.00001236 time time time))
360.0))
+ ;; moon-lat is the argument of latitude, which is the angle
+ ;; of the moon measured from the ascending node of its orbit
+ ;; (i.e. argument of perigee + true anomaly).
(moon-lat (mod
(+ 21.2964
(* 390.67050646 index)
(* -0.0016528 time time)
(* -0.00000239 time time time))
360.0))
- (eclipse (eclipse-check moon-lat phase))
+ (eclipse (lunar-check-for-eclipse moon-lat phase))
(adjustment
(if (memq phase '(0 2))
(+ (* (- 0.1734 (* 0.000393 time))
@@ -151,22 +154,22 @@ remainder mod 4 gives the phase: 0 new moon, 1 first
quarter, 2 full moon,
;; from "Astronomy with your Personal Computer", Subroutine Eclipse
;; Line 7000 Peter Duffett-Smith Cambridge University Press 1990
-(defun eclipse-check (moon-lat phase)
- (let* ((moon-lat (* (/ float-pi 180) moon-lat))
- (moon-lat (abs (- moon-lat (* (floor (/ moon-lat float-pi))
- float-pi))))
- (moon-lat (if (> moon-lat 0.37)
- (- float-pi moon-lat)
- moon-lat))
- (phase-name (cond ((= phase 0) "Solar")
- ((= phase 2) "Lunar")
- (t ""))))
- (cond ((< moon-lat 2.42600766e-1)
- (concat "** " phase-name " Eclipse **"))
- ((< moon-lat 0.37)
- (concat "** " phase-name " Eclipse possible **"))
- (t
- ""))))
+(defun lunar-check-for-eclipse (moon-lat phase)
+ "Check if a solar or lunar eclipse can occur for MOON-LAT and PHASE.
+MOON-LAT is the argument of latitude. PHASE is the lunar phase:
+0 new moon, 1 first quarter, 2 full moon, 3 last quarter.
+Return a string describing the eclipse (empty if no eclipse)."
+ (let* ((node-dist (mod moon-lat 180))
+ ;; Absolute angular distance from the ascending or descending
+ ;; node, whichever is nearer.
+ (node-dist (min node-dist (- 180 node-dist)))
+ (type (cond ((= phase 0) "Solar")
+ ((= phase 2) "Lunar"))))
+ (cond ((not type) "")
+ ;; Limits 13.9° and 21.0° from Meeus (1991), page 350.
+ ((< node-dist 13.9) (concat "** " type " Eclipse **"))
+ ((< node-dist 21.0) (concat "** " type " Eclipse possible **"))
+ (t ""))))
(defconst lunar-cycles-per-year 12.3685 ; 365.25/29.530588853
"Mean number of lunar cycles per 365.25 day year.")
@@ -242,10 +245,11 @@ use instead of point."
(insert
(mapconcat
(lambda (x)
- (format "%s: %s %s %s" (calendar-date-string (car x))
- (lunar-phase-name (nth 2 x))
- (cadr x)
- (car (last x))))
+ (let ((eclipse (nth 3 x)))
+ (concat (calendar-date-string (car x)) ": "
+ (lunar-phase-name (nth 2 x)) " "
+ (cadr x) (unless (string-empty-p eclipse) " ")
+ eclipse)))
(lunar-phase-list m1 y1) "\n")))
(message "Computing phases of the moon...done"))))
@@ -280,9 +284,13 @@ use when highlighting the day in the calendar."
(while (calendar-date-compare phase (list date))
(setq index (1+ index)
phase (lunar-phase index)))
- (if (calendar-date-equal (car phase) date)
- (cons mark (concat (lunar-phase-name (nth 2 phase)) " "
- (cadr phase))))))
+ (and (calendar-date-equal (car phase) date)
+ (cons mark
+ (let ((eclipse (nth 3 phase)))
+ (concat (lunar-phase-name (nth 2 phase)) " "
+ (cadr phase)
+ (unless (string-empty-p eclipse) " ")
+ eclipse))))))
;; For the Chinese calendar the calculations for the new moon need to be more
;; accurate than those above, so we use more terms in the approximation.
diff --git a/lisp/comint.el b/lisp/comint.el
index c5589324a14..9d2c245247f 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -383,7 +383,8 @@ This variable is buffer-local."
"\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)"
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?"
;; "[[:alpha:]]" used to be "for", which fails to match non-English.
- "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:space:]]*\\'"
+ "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*"
+ "[" (apply #'string password-colon-equivalents) "][[:space:]]*\\'"
;; The ccrypt encryption dialog doesn't end with a colon, so
;; treat it specially.
"\\|^Enter encryption key: (repeat) *\\'"
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index dea5dbe9410..5d3f2585976 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -68,13 +68,16 @@ Do not call this mode function yourself. It is meant for
internal use."
font-lock-comment-delimiter-face font-lock-comment-face
font-lock-constant-face font-lock-delimiter-face
font-lock-doc-face font-lock-doc-markup-face
- font-lock-escape-face font-lock-function-name-face
+ font-lock-escape-face font-lock-function-call-face
+ font-lock-function-name-face
font-lock-keyword-face font-lock-negation-char-face
font-lock-number-face font-lock-misc-punctuation-face
font-lock-operator-face font-lock-preprocessor-face
- font-lock-property-face font-lock-punctuation-face
+ font-lock-property-name-face font-lock-property-use-face
+ font-lock-punctuation-face
font-lock-regexp-grouping-backslash font-lock-regexp-grouping-construct
font-lock-string-face font-lock-type-face font-lock-variable-name-face
+ font-lock-variable-use-face
font-lock-warning-face button link link-visited fringe
header-line tooltip mode-line mode-line-buffer-id
mode-line-emphasis mode-line-highlight mode-line-inactive
diff --git a/lisp/custom.el b/lisp/custom.el
index 0522bdd447b..fa77e5c2c56 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -665,6 +665,7 @@ If NOSET is non-nil, don't bother autoloading LOAD when
setting the variable."
A customizable variable is either (i) a variable whose property
list contains a non-nil `standard-value' or `custom-autoload'
property, or (ii) an alias for another customizable variable."
+ (declare (side-effect-free t))
(when (symbolp variable)
(setq variable (indirect-variable variable))
(or (get variable 'standard-value)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index c390017e190..96ac9da4508 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -3730,7 +3730,7 @@ of the target of the link instead."
(process-file "file" nil t t "-L" "--" file)
(process-file "file" nil t t "--" file))
(when (bolp)
- (backward-delete-char 1))
+ (delete-char -1))
(message "%s" (buffer-string)))))
@@ -3741,12 +3741,21 @@ of the target of the link instead."
;;;###autoload
(defun dired-vc-next-action (verbose)
- "Do the next version control operation on marked files/directories.
-When only files are marked then call `vc-next-action' with the
-same value of the VERBOSE argument.
-When also directories are marked then call `vc-dir' and mark
-the same files/directories in the VC-Dir buffer that were marked
-in the Dired buffer."
+ "Do the next logical version control operation on marked files/directories.
+The VC control operation will operate on a fileset which includes
+the marked files/directories. If no files/directories are marked, the
+fileset will include the single file/directory shown on the current line.
+
+If only regular files are in the fileset, call `vc-next-action' with
+the same value of the VERBOSE argument (interactively, the prefix
+argument).
+
+If one or more directories are in the fileset, start `vc-dir' in the root
+directory of the repository that includes the current directory, with
+the same files/directories marked in the VC-Directory buffer that were
+marked in the original Dired buffer. If the current directory doesn't
+belong to a VCS repository, prompt for a repository directory. In this
+case, the VERBOSE argument is ignored."
(interactive "P")
(let* ((marked-files
(dired-get-marked-files nil nil nil nil t))
diff --git a/lisp/dired.el b/lisp/dired.el
index 76499d0f520..8e3244356fe 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -490,6 +490,11 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
(string :tag "Switches"))
:version "29.1")
+(defcustom dired-hide-details-preserved-columns nil
+ "List of columns which are not hidden in `dired-hide-details-mode'."
+ :type '(repeat integer)
+ :version "30.1")
+
;;; Internal variables
@@ -1880,8 +1885,15 @@ other marked file as well. Otherwise, unmark all files."
(put-text-property (line-beginning-position)
(1+ (line-end-position))
'invisible 'dired-hide-details-information))
- (put-text-property (+ (line-beginning-position) 1) (1- (point))
- 'invisible 'dired-hide-details-detail)
+ (save-excursion
+ (let ((end (1- (point)))
+ (opoint (goto-char (1+ (pos-bol))))
+ (i 0))
+ (put-text-property opoint end 'invisible
'dired-hide-details-detail)
+ (while (re-search-forward "[^ ]+" end t)
+ (when (member (cl-incf i) dired-hide-details-preserved-columns)
+ (put-text-property opoint (point) 'invisible nil))
+ (setq opoint (point)))))
(when (and dired-mouse-drag-files (fboundp 'x-begin-drag))
(put-text-property (point)
(save-excursion
@@ -2728,7 +2740,8 @@ directory in another window."
(defun dired--find-possibly-alternative-file (file)
"Find FILE, but respect `dired-kill-when-opening-new-dired-buffer'."
(if (and dired-kill-when-opening-new-dired-buffer
- (file-directory-p file))
+ (file-directory-p file)
+ (< (length (get-buffer-window-list)) 2))
(progn
(set-buffer-modified-p nil)
(dired--find-file #'find-alternate-file file))
diff --git a/lisp/display-fill-column-indicator.el
b/lisp/display-fill-column-indicator.el
index 7ad09de0765..45bdca2f5a5 100644
--- a/lisp/display-fill-column-indicator.el
+++ b/lisp/display-fill-column-indicator.el
@@ -53,6 +53,9 @@ customize `display-fill-column-indicator-column'. You can
change the
character for the indicator setting `display-fill-column-indicator-character'.
The globalized version is `global-display-fill-column-indicator-mode',
which see.
+This minor mode assumes the buffer uses a fixed-pitch font; if you
+use variable-pitch fonts, the indicators on different lines might
+not appear aligned.
See Info node `Displaying Boundaries' for details."
:lighter nil
(if display-fill-column-indicator-mode
diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el
index 37cf7ade46e..4f87ffd0e22 100644
--- a/lisp/display-line-numbers.el
+++ b/lisp/display-line-numbers.el
@@ -112,19 +112,27 @@ the mode is on, set `display-line-numbers' directly."
;;;###autoload
(defvar header-line-indent ""
- "String to indent at the start if the header line.
-This is used in `header-line-indent-mode', and buffers that have
-this switched on should have a `header-line-format' that look like:
+ "String of spaces to indent the beginning of header-line due to line numbers.
+This is intended to be used in `header-line-format', and requires
+the `header-line-indent-mode' to be turned on, in order for the width
+of this string to be kept updated when the line-number width changes
+on display. An example of a `header-line-format' that uses this
+variable might look like this:
(\"\" header-line-indent THE-REST...)
+where THE-REST is the format string which produces the actual text
+of the header-line.
Also see `header-line-indent-width'.")
;;;###autoload
(defvar header-line-indent-width 0
- "The width of the current line numbers displayed.
-This is updated when `header-line-indent-mode' is switched on.
-
+ "The width of the current line number display in the window.
+This is measured in units of the frame's canonical columns.
+This is updated when `header-line-indent-mode' is switched on,
+and is intended for use in `:align-to' display specifications
+that are part of `header-line-format', when portions of header-line
+text should be aligned to respective parts of buffer text.
Also see `header-line-indent'.")
(defun header-line-indent--line-number-width ()
@@ -155,21 +163,30 @@ Also see `header-line-indent'.")
;;;###autoload
(define-minor-mode header-line-indent-mode
- "Mode to indent the header line in `display-line-numbers-mode' buffers.
-This means that the header line will be kept indented so that it
-has blank space that's as wide as the displayed line numbers in
-the buffer.
+ "Minor mode to help with alignment of header line when line numbers are
shown.
+This minor mode should be turned on in buffers which display header-line
+that needs to be aligned with buffer text when `display-line-numbers-mode'
+is turned on in the buffer.
-Buffers that have this switched on should have a
-`header-line-format' that look like:
+Buffers that have this switched on should have a `header-line-format'
+that uses the `header-line-indent' or the `header-line-indent-width'
+variables, which this mode will keep up-to-date with the current
+display of line numbers. For example, a `header-line-format' that
+looks like this:
(\"\" header-line-indent THE-REST...)
-The `header-line-indent-width' variable is also kept updated, and
-has the width of `header-line-format'. This can be used, for
-instance, in `:align-to' specs, like:
+will make sure the text produced by THE-REST (which should be
+a header-line format string) is always indented to be aligned on
+display with the first column of buffer text.
+
+The `header-line-indent-width' variable is also kept updated,
+and can be used, for instance, in `:align-to' specs as part
+of `header-line-format', like this:
+
+ (space :align-to (+ header-line-indent-width 10))
- (space :align-to (+ header-line-indent-width 10))"
+See also `line-number-display-width'."
:lighter nil
(if header-line-indent-mode
(progn
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 3abb108a4a7..67907ec403e 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -108,11 +108,11 @@ program."
(defcustom dnd-direct-save-remote-files 'x
"Whether or not to perform a direct save of remote files.
-This is compatible with less programs, but means dropped files
+This is compatible with fewer programs, but means dropped files
will be saved with their actual file names, and not a temporary
file name provided by TRAMP.
-This defaults to `x', which means only to drop that way on X
+This defaults to `x', which means to save that way only on X
Windows."
:type '(choice (const :tag "Only use direct save on X Windows" x)
(const :tag "Use direct save everywhere" t)
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index c0723dc8dfe..8734f7cbebe 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -156,9 +156,9 @@ With a prefix argument, format the macro in a more concise
way."
(setq mac cmd)
(setq cmd nil)))
(when (kmacro-p mac)
- (setq mac (kmacro--keys mac)
- mac-counter (kmacro--counter mac)
- mac-format (kmacro--format mac)))
+ (setq mac-counter (kmacro--counter mac)
+ mac-format (kmacro--format mac)
+ mac (kmacro--keys mac)))
(unless (arrayp mac)
(error "Key sequence %s is not a keyboard macro"
(key-description keys)))
@@ -626,8 +626,7 @@ The string represents the same events; Meta is indicated by
bit 7.
This function assumes that the events can be stored in a string."
(setq seq (copy-sequence seq))
(cl-loop for i below (length seq) do
- (when (/= (logand (aref seq i) 128) 0)
- (setf (aref seq i) (logand (aref seq i) 127))))
+ (setf (aref seq i) (logand (aref seq i) 127)))
seq)
;; These are needed in a --without-x build.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index e0c769c7e60..3c7aeb89525 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -272,6 +272,14 @@ for speeding up processing.")
. ,(cdr case)))
cases)))
+(defsubst byte-opt--fget (f prop)
+ "Simpler and faster version of `function-get'."
+ (let ((val nil))
+ (while (and (symbolp f) f
+ (null (setq val (get f prop))))
+ (setq f (symbol-function f)))
+ val))
+
(defun byte-optimize-form-code-walker (form for-effect)
;;
;; For normal function calls, We can just mapcar the optimizer the cdr. But
@@ -431,13 +439,12 @@ for speeding up processing.")
(byte-optimize-body (cdr clause) for-effect))))
clauses)))
- ;; `unwind-protect' is a special form which here takes the shape
- ;; (unwind-protect EXPR :fun-body UNWIND-FUN).
- ;; We can treat it as if it were a plain function at this point,
- ;; although there are specific optimizations possible.
- ;; In particular, the return value of UNWIND-FUN is never used
- ;; so its body should really be compiled for-effect, but we
- ;; don't do that right now.
+ (`(unwind-protect ,protected-expr :fun-body ,unwind-fun)
+ ;; FIXME: The return value of UNWIND-FUN is never used so we
+ ;; could potentially optimise it for-effect, but we don't do
+ ;; that right no.
+ `(,fn ,(byte-optimize-form protected-expr for-effect)
+ :fun-body ,(byte-optimize-form unwind-fun)))
(`(catch ,tag . ,exps)
`(,fn ,(byte-optimize-form tag nil)
@@ -497,7 +504,7 @@ for speeding up processing.")
form)
((guard (when for-effect
- (if-let ((tmp (get fn 'side-effect-free)))
+ (if-let ((tmp (byte-opt--fget fn 'side-effect-free)))
(or byte-compile-delete-errors
(eq tmp 'error-free)
(progn
@@ -507,16 +514,14 @@ for speeding up processing.")
form)
nil)))))
(byte-compile-log " %s called for effect; deleted" fn)
- ;; appending a nil here might not be necessary, but it can't hurt.
- (byte-optimize-form
- (cons 'progn (append (cdr form) '(nil))) t))
+ (byte-optimize-form (cons 'progn (cdr form)) t))
(_
;; Otherwise, no args can be considered to be for-effect,
;; even if the called function is for-effect, because we
;; don't know anything about that function.
(let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
- (if (get fn 'pure)
+ (if (byte-opt--fget fn 'pure)
(byte-optimize-constant-args form)
form))))))
@@ -538,7 +543,7 @@ for speeding up processing.")
;; until a fixpoint has been reached.
(and (consp form)
(symbolp (car form))
- (let ((opt (function-get (car form) 'byte-optimizer)))
+ (let ((opt (byte-opt--fget (car form) 'byte-optimizer)))
(and opt
(let ((old form)
(new (funcall opt form)))
@@ -1019,16 +1024,14 @@ for speeding up processing.")
(t form))))
(defun byte-optimize-constant-args (form)
- (let ((ok t)
- (rest (cdr form)))
- (while (and rest ok)
- (setq ok (macroexp-const-p (car rest))
- rest (cdr rest)))
- (if ok
- (condition-case ()
- (list 'quote (eval form))
- (error form))
- form)))
+ (let ((rest (cdr form)))
+ (while (and rest (macroexp-const-p (car rest)))
+ (setq rest (cdr rest)))
+ (if rest
+ form
+ (condition-case ()
+ (list 'quote (eval form t))
+ (error form)))))
(defun byte-optimize-identity (form)
(if (and (cdr form) (null (cdr (cdr form))))
@@ -1036,8 +1039,19 @@ for speeding up processing.")
form))
(defun byte-optimize--constant-symbol-p (expr)
- "Whether EXPR is a constant symbol."
- (and (macroexp-const-p expr) (symbolp (eval expr))))
+ "Whether EXPR is a constant symbol, like (quote hello), nil, t, or :keyword."
+ (if (consp expr)
+ (and (memq (car expr) '(quote function))
+ (symbolp (cadr expr)))
+ (or (memq expr '(nil t))
+ (keywordp expr))))
+
+(defsubst byteopt--eval-const (expr)
+ "Evaluate EXPR which must be a constant (quoted or self-evaluating).
+Ie, (macroexp-const-p EXPR) must be true."
+ (if (consp expr)
+ (cadr expr) ; assumed to be 'VALUE or #'SYMBOL
+ expr))
(defun byte-optimize--fixnump (o)
"Return whether O is guaranteed to be a fixnum in all Emacsen.
@@ -1074,7 +1088,7 @@ See Info node `(elisp) Integer Basics'."
(byte-optimize--fixnump (nth 1 form))
(let ((arg2 (nth 2 form)))
(and (macroexp-const-p arg2)
- (let ((listval (eval arg2)))
+ (let ((listval (byteopt--eval-const arg2)))
(and (listp listval)
(not (memq nil (mapcar
(lambda (o)
@@ -1123,21 +1137,31 @@ See Info node `(elisp) Integer Basics'."
form))
(defun byte-optimize-concat (form)
- "Merge adjacent constant arguments to `concat'."
+ "Merge adjacent constant arguments to `concat' and flatten nested forms."
(let ((args (cdr form))
(newargs nil))
(while args
- (let ((strings nil)
- val)
- (while (and args (macroexp-const-p (car args))
- (progn
- (setq val (eval (car args)))
- (and (or (stringp val)
- (and (or (listp val) (vectorp val))
- (not (memq nil
- (mapcar #'characterp val))))))))
- (push val strings)
- (setq args (cdr args)))
+ (let ((strings nil))
+ (while
+ (and args
+ (let ((arg (car args)))
+ (pcase arg
+ ;; Merge consecutive constant arguments.
+ ((pred macroexp-const-p)
+ (let ((val (byteopt--eval-const arg)))
+ (and (or (stringp val)
+ (and (or (listp val) (vectorp val))
+ (not (memq nil
+ (mapcar #'characterp val)))))
+ (progn
+ (push val strings)
+ (setq args (cdr args))
+ t))))
+ ;; Flatten nested `concat' form.
+ (`(concat . ,nested-args)
+ (setq args (append nested-args (cdr args)))
+ t)))))
+
(when strings
(let ((s (apply #'concat (nreverse strings))))
(when (not (zerop (length s)))
@@ -1528,7 +1552,7 @@ See Info node `(elisp) Integer Basics'."
(cond
((macroexp-const-p arg)
;; constant arg
- (let ((val (eval arg)))
+ (let ((val (byteopt--eval-const arg)))
(cond
;; Elide empty arguments (nil, empty string, etc).
((zerop (length val))
@@ -1538,7 +1562,7 @@ See Info node `(elisp) Integer Basics'."
(loop (cdr args)
(cons
(list 'quote
- (append (eval prev) val nil))
+ (append (byteopt--eval-const prev) val nil))
(cdr newargs))))
(t (loop (cdr args) (cons arg newargs))))))
@@ -1628,7 +1652,7 @@ See Info node `(elisp) Integer Basics'."
capitalize car-less-than-car car cdr ceiling char-after char-before
char-equal char-to-string char-width compare-strings
window-configuration-equal-p concat coordinates-in-window-p
- copy-alist copy-sequence copy-marker copysign cos count-lines
+ copy-alist copy-sequence copy-marker copysign cos
current-time-string current-time-zone
decode-char
decode-time default-boundp default-value documentation downcase
@@ -1637,76 +1661,68 @@ See Info node `(elisp) Integer Basics'."
file-directory-p file-exists-p file-locked-p file-name-absolute-p
file-name-concat
file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
- float float-time floor format format-time-string frame-first-window
- frame-root-window frame-selected-window
+ float float-time floor format format-message format-time-string
+ frame-first-window frame-root-window frame-selected-window
frame-visible-p fround ftruncate
- get gethash get-buffer get-buffer-window getenv get-file-buffer
+ get gethash get-buffer get-buffer-window get-file-buffer
hash-table-count
- int-to-string intern-soft isnan
+ intern-soft isnan
keymap-parent
- lax-plist-get ldexp
+ ldexp
length length< length> length=
line-beginning-position line-end-position pos-bol pos-eol
local-variable-if-set-p local-variable-p locale-info
- log log10 logand logb logcount logior lognot logxor lsh
- make-byte-code make-list make-string make-symbol mark marker-buffer max
+ log logand logb logcount logior lognot logxor
+ make-byte-code make-list make-string make-symbol marker-buffer max
match-beginning match-end
member memq memql min minibuffer-selected-window minibuffer-window
mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
- parse-colon-path
prefix-numeric-value previous-window prin1-to-string propertize
- degrees-to-radians
- radians-to-degrees rassq rassoc read-from-string regexp-opt
+ rassq rassoc read-from-string
regexp-quote region-beginning region-end reverse round
- sin sqrt string string< string= string-equal string-lessp
- string> string-greaterp string-empty-p string-blank-p
+ sin sqrt string string-equal string-lessp
string-search string-to-char
- string-to-number string-to-syntax substring
- sxhash sxhash-equal sxhash-eq sxhash-eql
- symbol-function symbol-name symbol-plist symbol-value
string-make-unibyte
+ string-to-number string-to-syntax substring substring-no-properties
+ sxhash-equal sxhash-eq sxhash-eql
+ symbol-function symbol-name symbol-plist symbol-value
+ string-make-unibyte
string-make-multibyte string-as-multibyte string-as-unibyte
string-to-multibyte
take tan time-convert truncate
unibyte-char-to-multibyte upcase user-full-name
- user-login-name user-original-login-name custom-variable-p
+ user-login-name
vconcat
- window-absolute-pixel-edges window-at window-body-height
+ window-at window-body-height
window-body-width window-buffer window-dedicated-p window-display-table
- window-combination-limit window-edges window-frame window-fringes
- window-height window-hscroll window-inside-edges
- window-inside-absolute-pixel-edges window-inside-pixel-edges
+ window-combination-limit window-frame window-fringes
+ window-hscroll
window-left-child window-left-column window-margins window-minibuffer-p
window-next-buffers window-next-sibling window-new-normal
window-new-total window-normal-size window-parameter window-parameters
- window-parent window-pixel-edges window-point window-prev-buffers
+ window-parent window-point window-prev-buffers
window-prev-sibling window-scroll-bars
window-start window-text-height window-top-child window-top-line
window-total-height window-total-width window-use-time window-vscroll
- window-width zerop))
+ ))
(side-effect-and-error-free-fns
- '(always arrayp atom
- bignump bobp bolp bool-vector-p
- buffer-end buffer-list buffer-size buffer-string bufferp
+ '(arrayp atom
+ bobp bolp bool-vector-p
+ buffer-list buffer-size buffer-string bufferp
car-safe case-table-p cdr-safe char-or-string-p characterp
charsetp commandp cons consp
current-buffer current-global-map current-indentation
current-local-map current-minor-mode-maps current-time
- eobp eolp eq equal eventp
- fixnump floatp following-char framep
- get-largest-window get-lru-window
+ eobp eolp eq equal
+ floatp following-char framep
hash-table-p
- ;; `ignore' isn't here because we don't want calls to it elided;
- ;; see `byte-compile-ignore'.
- identity integerp integer-or-marker-p interactive-p
+ identity indirect-function integerp integer-or-marker-p
invocation-directory invocation-name
keymapp keywordp
list listp
make-marker mark-marker markerp max-char
- memory-limit
- mouse-movement-p
- natnump nlistp not null number-or-marker-p numberp
- one-window-p overlayp
- point point-marker point-min point-max preceding-char primary-charset
+ natnump nlistp null number-or-marker-p numberp
+ overlayp
+ point point-marker point-min point-max preceding-char
processp proper-list-p
recent-keys recursion-depth
safe-length selected-frame selected-window sequencep
@@ -1742,7 +1758,7 @@ See Info node `(elisp) Integer Basics'."
;; values if a marker is moved.
(let ((pure-fns
- '(concat regexp-opt regexp-quote
+ '(concat regexp-quote
string-to-char string-to-syntax symbol-name
eq eql
= /= < <= >= > min max
@@ -1751,30 +1767,28 @@ See Info node `(elisp) Integer Basics'."
copysign isnan ldexp float logb
floor ceiling round truncate
ffloor fceiling fround ftruncate
- string= string-equal string< string-lessp string> string-greaterp
- string-empty-p string-blank-p
+ string-equal string-lessp
string-search
consp atom listp nlistp proper-list-p
sequencep arrayp vectorp stringp bool-vector-p hash-table-p
- null not
+ null
numberp integerp floatp natnump characterp
integer-or-marker-p number-or-marker-p char-or-string-p
symbolp keywordp
type-of
- identity ignore
+ identity
;; The following functions are pure up to mutation of their
;; arguments. This is pure enough for the purposes of
;; constant folding, but not necessarily for all kinds of
;; code motion.
- car cdr car-safe cdr-safe nth nthcdr last take
+ car cdr car-safe cdr-safe nth nthcdr take
equal
length safe-length
memq memql member
;; `assoc' and `assoc-default' are excluded since they are
;; impure if the test function is (consider `string-match').
assq rassq rassoc
- lax-plist-get
aref elt
base64-decode-string base64-encode-string base64url-encode-string
bool-vector-subsetp
@@ -2023,6 +2037,22 @@ If FOR-EFFECT is non-nil, the return value is assumed to
be of no importance."
(let ((side-effect-free (if byte-compile-delete-errors
byte-compile-side-effect-free-ops
byte-compile-side-effect-and-error-free-ops))
+ ;; Ops taking and produce a single value on the stack.
+ (unary-ops '( byte-not byte-length byte-list1 byte-nreverse
+ byte-car byte-cdr byte-car-safe byte-cdr-safe
+ byte-symbolp byte-consp byte-stringp
+ byte-listp byte-integerp byte-numberp
+ byte-add1 byte-sub1 byte-negate
+ ;; There are more of these but the list is
+ ;; getting long and the gain is typically small.
+ ))
+ ;; Ops producing a single result without looking at the stack.
+ (producer-ops '( byte-constant byte-varref
+ byte-point byte-point-max byte-point-min
+ byte-following-char byte-preceding-char
+ byte-current-column
+ byte-eolp byte-eobp byte-bolp byte-bobp
+ byte-current-buffer byte-widen))
(add-depth 0)
(keep-going 'first-time)
;; Create a cons cell as head of the list so that removing the first
@@ -2132,31 +2162,39 @@ If FOR-EFFECT is non-nil, the return value is assumed
to be of no importance."
;; be larger than necessary.
(setq add-depth 1))
t)))))
- ;;
- ;; dup varset-X discard --> varset-X
- ;; dup varbind-X discard --> varbind-X
- ;; dup stack-set-X discard --> stack-set-X-1
- ;; (the varbind variant can emerge from other optimizations)
- ;;
- ((and (eq 'byte-dup (car lap0))
- (eq 'byte-discard (car lap2))
- (memq (car lap1) '(byte-varset byte-varbind
- byte-stack-set)))
- (setq keep-going t)
+ ;;
+ ;; dup varset discard(N) --> varset discard(N-1)
+ ;; dup varbind discard(N) --> varbind discard(N-1)
+ ;; dup stack-set(M) discard(N) --> stack-set(M-1) discard(N-1),
M>1
+ ;; (the varbind variant can emerge from other optimizations)
+ ;;
+ ((and (eq 'byte-dup (car lap0))
+ (memq (car lap2) '(byte-discard byte-discardN))
+ (or (memq (car lap1) '(byte-varset byte-varbind))
+ (and (eq (car lap1) 'byte-stack-set)
+ (> (cdr lap1) 1))))
(setcdr prev (cdr rest)) ; remove dup
- (setcdr (cdr rest) (cdddr rest)) ; remove discard
- (cond ((not (eq (car lap1) 'byte-stack-set))
- (byte-compile-log-lap " %s %s %s\t-->\t%s"
- lap0 lap1 lap2 lap1))
- ((eql (cdr lap1) 1)
- (byte-compile-log-lap " %s %s %s\t-->\t<deleted>"
- lap0 lap1 lap2))
- (t
- (let ((n (1- (cdr lap1))))
- (byte-compile-log-lap " %s %s %s\t-->\t%s"
- lap0 lap1 lap2
- (cons (car lap1) n))
- (setcdr lap1 n)))))
+ (let ((new1 (if (eq (car lap1) 'byte-stack-set)
+ (cons 'byte-stack-set (1- (cdr lap1)))
+ lap1))
+ (n (if (eq (car lap2) 'byte-discard) 1 (cdr lap2))))
+ (setcar (cdr rest) new1)
+ (cl-assert (> n 0))
+ (cond
+ ((> n 1)
+ (let ((new2 (if (> n 2)
+ (cons 'byte-discardN (1- n))
+ (cons 'byte-discard nil))))
+ (byte-compile-log-lap " %s %s %s\t-->\t%s %s"
+ lap0 lap1 lap2 new1 new2)
+ (setcar (cddr rest) new2)))
+ (t
+ (byte-compile-log-lap " %s %s %s\t-->\t%s"
+ lap0 lap1 lap2 new1)
+ ;; discard(0) = nop, remove
+ (setcdr (cdr rest) (cdddr rest)))))
+ (setq keep-going t))
+
;;
;; not goto-X-if-nil --> goto-X-if-non-nil
;; not goto-X-if-non-nil --> goto-X-if-nil
@@ -2396,11 +2434,13 @@ If FOR-EFFECT is non-nil, the return value is assumed
to be of no importance."
(setq keep-going t))
;;
- ;; OP const return --> const return
- ;; where OP is side-effect-free (or mere stack manipulation).
+ ;; NOEFFECT PRODUCER return --> PRODUCER return
+ ;; where NOEFFECT lacks effects beyond stack change,
+ ;; PRODUCER pushes a result without looking at the stack:
+ ;; const, varref, point etc.
;;
- ((and (eq (car lap1) 'byte-constant)
- (eq (car (nth 2 rest)) 'byte-return)
+ ((and (eq (car (nth 2 rest)) 'byte-return)
+ (memq (car lap1) producer-ops)
(or (memq (car lap0) '( byte-discard byte-discardN
byte-discardN-preserve-tos
byte-stack-set))
@@ -2411,6 +2451,24 @@ If FOR-EFFECT is non-nil, the return value is assumed to
be of no importance."
(byte-compile-log-lap " %s %s %s\t-->\t%s %s"
lap0 lap1 (nth 2 rest) lap1 (nth 2 rest)))
+ ;;
+ ;; (discardN-preserve-tos|dup) UNARY return --> UNARY return
+ ;; where UNARY takes and produces a single value on the stack
+ ;;
+ ;; FIXME: ideally we should run this backwards, so that we could
do
+ ;; discardN-preserve-tos OP1...OPn return -> OP1..OPn return
+ ;; but that would require a different approach.
+ ;;
+ ((and (eq (car (nth 2 rest)) 'byte-return)
+ (memq (car lap1) unary-ops)
+ (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup))
+ (and (eq (car lap0) 'byte-stack-set)
+ (eql (cdr lap0) 1))))
+ (setq keep-going t)
+ (setcdr prev (cdr rest)) ; eat lap0
+ (byte-compile-log-lap " %s %s %s\t-->\t%s %s"
+ lap0 lap1 (nth 2 rest) lap1 (nth 2 rest)))
+
;;
;; goto-*-else-pop X ... X: goto-if-* --> whatever
;; goto-*-else-pop X ... X: discard --> whatever
@@ -2640,6 +2698,63 @@ If FOR-EFFECT is non-nil, the return value is assumed to
be of no importance."
(setcdr prev (cdr rest))
(byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1))
+ ;;
+ ;; stack-ref(X) discardN-preserve-tos(Y)
+ ;; --> discard(Y) stack-ref(X-Y), X≥Y
+ ;; discard(X) discardN-preserve-tos(Y-X-1), X<Y
+ ;; where: stack-ref(0) = dup (works both ways)
+ ;; discard(0) = no-op
+ ;; discardN-preserve-tos(0) = no-op
+ ;;
+ ((and (memq (car lap0) '(byte-stack-ref byte-dup))
+ (or (eq (car lap1) 'byte-discardN-preserve-tos)
+ (and (eq (car lap1) 'byte-stack-set)
+ (eql (cdr lap1) 1)))
+ ;; Don't apply if immediately preceding a `return',
+ ;; since there are more effective rules for that case.
+ (not (eq (car lap2) 'byte-return)))
+ (let ((x (if (eq (car lap0) 'byte-dup) 0 (cdr lap0)))
+ (y (cdr lap1)))
+ (cl-assert (> y 0))
+ (cond
+ ((>= x y) ; --> discard(Y) stack-ref(X-Y)
+ (let ((new0 (if (= y 1)
+ (cons 'byte-discard nil)
+ (cons 'byte-discardN y)))
+ (new1 (if (= x y)
+ (cons 'byte-dup nil)
+ (cons 'byte-stack-ref (- x y)))))
+ (byte-compile-log-lap " %s %s\t-->\t%s %s"
+ lap0 lap1 new0 new1)
+ (setcar rest new0)
+ (setcar (cdr rest) new1)))
+ ((= x 0) ; --> discardN-preserve-tos(Y-1)
+ (setcdr prev (cdr rest)) ; eat lap0
+ (if (> y 1)
+ (let ((new (cons 'byte-discardN-preserve-tos (- y 1))))
+ (byte-compile-log-lap " %s %s\t-->\t%s"
+ lap0 lap1 new)
+ (setcar (cdr prev) new))
+ (byte-compile-log-lap " %s %s\t-->\t<deleted>" lap0 lap1)
+ (setcdr prev (cddr prev)))) ; eat lap1
+ ((= y (+ x 1)) ; --> discard(X)
+ (setcdr prev (cdr rest)) ; eat lap0
+ (let ((new (if (= x 1)
+ (cons 'byte-discard nil)
+ (cons 'byte-discardN x))))
+ (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 new)
+ (setcar (cdr prev) new)))
+ (t ; --> discard(X) discardN-preserve-tos(Y-X-1)
+ (let ((new0 (if (= x 1)
+ (cons 'byte-discard nil)
+ (cons 'byte-discardN x)))
+ (new1 (cons 'byte-discardN-preserve-tos (- y x 1))))
+ (byte-compile-log-lap " %s %s\t-->\t%s %s"
+ lap0 lap1 new0 new1)
+ (setcar rest new0)
+ (setcar (cdr rest) new1)))))
+ (setq keep-going t))
+
;;
;; goto-X ... X: discard ==> discard goto-Y ... X: discard Y:
;;
@@ -2673,14 +2788,32 @@ If FOR-EFFECT is non-nil, the return value is assumed
to be of no importance."
(push newjmp (cdr rest)))
t)))))
+ ;;
+ ;; UNARY discardN-preserve-tos --> discardN-preserve-tos UNARY
+ ;; where UNARY takes and produces a single value on the stack
+ ;;
+ ((and (memq (car lap0) unary-ops)
+ (or (eq (car lap1) 'byte-discardN-preserve-tos)
+ (and (eq (car lap1) 'byte-stack-set)
+ (eql (cdr lap1) 1)))
+ ;; unless followed by return (which will eat the discard)
+ (not (eq (car lap2) 'byte-return)))
+ (setq keep-going t)
+ (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0)
+ (setcar rest lap1)
+ (setcar (cdr rest) lap0))
+
;;
- ;; const discardN-preserve-tos ==> discardN const
- ;; const stack-set(1) ==> discard const
+ ;; PRODUCER discardN-preserve-tos(X) --> discard(X) PRODUCER
+ ;; where PRODUCER pushes a result without looking at the stack:
+ ;; const, varref, point etc.
;;
- ((and (eq (car lap0) 'byte-constant)
+ ((and (memq (car lap0) producer-ops)
(or (eq (car lap1) 'byte-discardN-preserve-tos)
(and (eq (car lap1) 'byte-stack-set)
- (eql (cdr lap1) 1))))
+ (eql (cdr lap1) 1)))
+ ;; unless followed by return (which will eat the discard)
+ (not (eq (car lap2) 'byte-return)))
(setq keep-going t)
(let ((newdiscard (if (eql (cdr lap1) 1)
(cons 'byte-discard nil)
@@ -2689,6 +2822,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to
be of no importance."
" %s %s\t-->\t%s %s" lap0 lap1 newdiscard lap0)
(setf (car rest) newdiscard)
(setf (cadr rest) lap0)))
+
(t
;; If no rule matched, advance and try again.
(setq prev (cdr prev))))))))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e8a8fe37756..12850c27b88 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -530,11 +530,12 @@ Return the compile-time value of FORM."
;; or byte-compile-file-form.
(let* ((print-symbols-bare t) ; Possibly
redundant binding.
(expanded
- (byte-run-strip-symbol-positions
- (macroexpand--all-toplevel
- form
- macroexpand-all-environment))))
- (eval expanded lexical-binding)
+ (macroexpand--all-toplevel
+ form
+ macroexpand-all-environment)))
+ (eval (byte-run-strip-symbol-positions
+ (safe-copy-tree expanded))
+ lexical-binding)
expanded)))))
(with-suppressed-warnings
. ,(lambda (warnings &rest body)
@@ -3417,7 +3418,7 @@ lambda-expression."
(let* ((fn (car form))
(handler (get fn 'byte-compile))
(interactive-only
- (or (get fn 'interactive-only)
+ (or (function-get fn 'interactive-only)
(memq fn byte-compile-interactive-only-functions))))
(when (memq fn '(set symbol-value run-hooks ;; add-to-list
add-hook remove-hook run-hook-with-args
@@ -3444,7 +3445,7 @@ lambda-expression."
(format "; %s"
(substitute-command-keys
interactive-only)))
- ((and (symbolp 'interactive-only)
+ ((and (symbolp interactive-only)
(not (eq interactive-only t)))
(format-message "; use `%s' instead."
interactive-only))
@@ -4591,6 +4592,7 @@ Return (TAIL VAR TEST CASES), where:
(if switch-prefix
(progn
(byte-compile-cond-jump-table (cdr switch-prefix) donetag)
+ (setq clause nil)
(setq clauses (car switch-prefix)))
(setq clause (car clauses))
(cond ((or (eq (car clause) t)
@@ -5080,7 +5082,10 @@ binding slots have been popped."
(defun byte-compile-suppressed-warnings (form)
(let ((byte-compile--suppressed-warnings
(append (cadadr form) byte-compile--suppressed-warnings)))
- (byte-compile-form (macroexp-progn (cddr form)))))
+ ;; Propagate the for-effect mode explicitly so that warnings about
+ ;; ignored return values can be detected and suppressed correctly.
+ (byte-compile-form (macroexp-progn (cddr form)) byte-compile--for-effect)
+ (setq byte-compile--for-effect nil)))
;; Warn about misuses of make-variable-buffer-local.
(byte-defop-compiler-1 make-variable-buffer-local
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e8d639903c1..601e2c13d61 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -463,7 +463,7 @@ places where they originally did not directly appear."
; first element is lambda expression
(`(,(and `(lambda . ,_) fun) . ,args)
;; FIXME: it's silly to create a closure just to call it.
- ;; Running byte-optimize-form earlier will resolve this.
+ ;; Running byte-optimize-form earlier would resolve this.
`(funcall
,(cconv-convert `(function ,fun) env extend)
,@(mapcar (lambda (form)
@@ -477,23 +477,40 @@ places where they originally did not directly appear."
branch))
cond-forms)))
- (`(function (lambda ,args . ,body) . ,_)
+ (`(function (lambda ,args . ,body) . ,rest)
(let* ((docstring (if (eq :documentation (car-safe (car body)))
(cconv-convert (cadr (pop body)) env extend)))
(bf (if (stringp (car body)) (cdr body) body))
(if (when (eq 'interactive (car-safe (car bf)))
(gethash form cconv--interactive-form-funs)))
- (wrapped (pcase if (`#'(lambda (_cconv--dummy) .,_) t) (_ nil)))
+ (wrapped (pcase if (`#'(lambda (&rest _cconv--dummy) .,_) t) (_
nil)))
(cif (when if (cconv-convert if env extend)))
- (_ (pcase cif
- ('nil nil)
- (`#',f
- (setf (cadr (car bf)) (if wrapped (nth 2 f) cif))
- (setq cif nil))
- ;; The interactive form needs special treatment, so the form
- ;; inside the `interactive' won't be used any further.
- (_ (setf (cadr (car bf)) nil))))
- (cf (cconv--convert-function args body env form docstring)))
+ (cf nil))
+ ;; TODO: Because we need to non-destructively modify body, this code
+ ;; is particularly ugly. This should ideally be moved to
+ ;; cconv--convert-function.
+ (pcase cif
+ ('nil (setq bf nil))
+ (`#',f
+ (pcase-let ((`((,f1 . (,_ . ,f2)) . ,f3) bf))
+ (setq bf `((,f1 . (,(if wrapped (nth 2 f) cif) . ,f2)) . ,f3)))
+ (setq cif nil))
+ ;; The interactive form needs special treatment, so the form
+ ;; inside the `interactive' won't be used any further.
+ (_ (pcase-let ((`((,f1 . (,_ . ,f2)) . ,f3) bf))
+ (setq bf `((,f1 . (nil . ,f2)) . ,f3)))))
+ (when bf
+ ;; If we modified bf, re-build body and form as
+ ;; copies with the modified bits.
+ (setq body (if (stringp (car body))
+ (cons (car body) bf)
+ bf)
+ form `(function (lambda ,args . ,body) . ,rest))
+ ;; Also, remove the current old entry on the alist, replacing
+ ;; it with the new one.
+ (let ((entry (pop cconv-freevars-alist)))
+ (push (cons body (cdr entry)) cconv-freevars-alist)))
+ (setq cf (cconv--convert-function args body env form docstring))
(if (not cif)
;; Normal case, the interactive form needs no special treatment.
cf
@@ -747,7 +764,7 @@ This function does not return anything but instead fills the
(let ((if (cadr (car bf))))
(unless (macroexp-const-p if) ;Optimize this common case.
(let ((f (if (eq 'function (car-safe if)) if
- `#'(lambda (_cconv--dummy) ,if))))
+ `#'(lambda (&rest _cconv--dummy) ,if))))
(setf (gethash form cconv--interactive-form-funs) f)
(cconv-analyze-form f env))))))
(cconv--analyze-function vrs body-forms env form))
@@ -834,10 +851,13 @@ This function does not return anything but instead fills
the
(define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form
"25.1")
(defun cconv-fv (form lexvars dynvars)
- "Return the list of free variables in FORM.
-LEXVARS is the list of statically scoped vars in the context
-and DYNVARS is the list of dynamically scoped vars in the context.
-Returns a pair (LEXV . DYNV) of those vars actually used by FORM."
+ "Return the free variables used in FORM.
+FORM is usually a function #\\='(lambda ...), but may be any valid
+form. LEXVARS is a list of symbols, each of which is lexically
+bound in FORM's context. DYNVARS is a list of symbols, each of
+which is dynamically bound in FORM's context.
+Returns a cons (LEXV . DYNV), the car and cdr being lists of the
+lexically and dynamically bound symbols actually used by FORM."
(let* ((fun
;; Wrap FORM into a function because the analysis code we
;; have only computes freevars for functions.
@@ -875,11 +895,26 @@ Returns a pair (LEXV . DYNV) of those vars actually used
by FORM."
(cons fvs dyns)))))
(defun cconv-make-interpreted-closure (fun env)
+ "Make a closure for the interpreter.
+This is intended to be called at runtime by the ELisp interpreter (when
+the code has not been compiled).
+FUN is the closure's source code, must be a lambda form.
+ENV is the runtime representation of the lexical environment,
+i.e. a list whose elements can be either plain symbols (which indicate
+that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE)
+for the lexical bindings."
(cl-assert (eq (car-safe fun) 'lambda))
(let ((lexvars (delq nil (mapcar #'car-safe env))))
- (if (null lexvars)
- ;; The lexical environment is empty, so there's no need to
- ;; look for free variables.
+ (if (or (null lexvars)
+ ;; Functions with a `:closure-dont-trim-context' marker
+ ;; should keep their whole context untrimmed (bug#59213).
+ (and (eq :closure-dont-trim-context (nth 2 fun))
+ ;; Check the function doesn't just return the magic keyword.
+ (nthcdr 3 fun)))
+ ;; The lexical environment is empty, or needs to be preserved,
+ ;; so there's no need to look for free variables.
+ ;; Attempting to replace ,(cdr fun) by a macroexpanded version
+ ;; causes bootstrap to fail.
`(closure ,env . ,(cdr fun))
;; We could try and cache the result of the macroexpansion and
;; `cconv-fv' analysis. Not sure it's worth the trouble.
@@ -896,7 +931,7 @@ Returns a pair (LEXV . DYNV) of those vars actually used by
FORM."
(pcase expanded-form
(`#'(lambda . ,cdr) cdr)
(_ (cdr fun))))
-
+
(dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env)))
(fvs (cconv-fv expanded-form lexvars dynvars))
(newenv (nconc (mapcar (lambda (fv) (assq fv env)) (car fvs))
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 98e50f53b5f..d4200c16c19 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -483,7 +483,7 @@ Return them as multiple value."
;;; Union specific code.
(defun comp-cstr-union-homogeneous-no-range (dst &rest srcs)
- "As `comp-cstr-union' but escluding the irange component.
+ "As `comp-cstr-union' but excluding the irange component.
All SRCS constraints must be homogeneously negated or non-negated."
;; Type propagation.
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 1beff421038..68021364291 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -92,13 +92,17 @@ into the eln output. "
:type 'boolean
:version "28.1")
-(defcustom native-comp-deferred-compilation-deny-list
+(defcustom native-comp-jit-compilation-deny-list
'()
"List of regexps to exclude matching files from deferred native compilation.
Files whose names match any regexp are excluded from native compilation."
:type '(repeat regexp)
:version "28.1")
+(make-obsolete-variable 'native-comp-deferred-compilation-deny-list
+ 'native-comp-jit-compilation-deny-list
+ "29.1")
+
(defcustom native-comp-bootstrap-deny-list
'()
"List of regexps to exclude files from native compilation during bootstrap.
@@ -112,7 +116,11 @@ during bootstrap."
;; correctly (see comment in `advice--add-function'). DO NOT
;; REMOVE.
macroexpand rename-buffer)
- "Primitive functions to exclude from trampoline optimization."
+ "Primitive functions to exclude from trampoline optimization.
+
+Primitive functions included in this list will not be called
+directly by the natively-compiled code, which makes trampolines for
+those primitives unnecessary in case of function redefinition/advice."
:type '(repeat symbol)
:version "28.1")
@@ -697,12 +705,23 @@ Useful to hook into pass checkers.")
(defvar comp-no-spawn nil
"Non-nil don't spawn native compilation processes.")
+(defconst comp-warn-primitives
+ '(null memq gethash and subrp not subr-native-elisp-p
+ comp--install-trampoline concat if symbolp symbol-name make-string
+ length aset aref length> mapcar expand-file-name
+ file-name-as-directory file-exists-p native-elisp-load)
+ "List of primitives we want to warn about in case of redefinition.
+This are essential for the trampoline machinery to work properly.")
+
;; Moved early to avoid circularity when comp.el is loaded and
;; `macroexpand' needs to be advised (bug#47049).
;;;###autoload
(defun comp-subr-trampoline-install (subr-name)
"Make SUBR-NAME effectively advice-able when called from native code."
- (unless (or (null comp-enable-subr-trampolines)
+ (when (memq subr-name comp-warn-primitives)
+ (warn "Redefining `%s' might break native compilation of trampolines."
+ subr-name))
+ (unless (or (null native-comp-enable-subr-trampolines)
(memq subr-name native-comp-never-optimize-functions)
(gethash subr-name comp-installed-trampolines-h))
(cl-assert (subr-primitive-p (symbol-function subr-name)))
@@ -1128,10 +1147,12 @@ with `message'. Otherwise, log with
`comp-log-to-buffer'."
(comp-cstr-to-type-spec mvar)))
(defun comp-prettyformat-insn (insn)
- (cl-typecase insn
- (comp-mvar (comp-prettyformat-mvar insn))
- (atom (prin1-to-string insn))
- (cons (concat "(" (mapconcat #'comp-prettyformat-insn insn " ") ")"))))
+ (cond
+ ((comp-mvar-p insn)
+ (comp-prettyformat-mvar insn))
+ ((proper-list-p insn)
+ (concat "(" (mapconcat #'comp-prettyformat-insn insn " ") ")"))
+ (t (prin1-to-string insn))))
(defun comp-log-func (func verbosity)
"Log function FUNC at VERBOSITY.
@@ -3802,6 +3823,31 @@ Return the trampoline if found or nil otherwise."
when (file-exists-p filename)
do (cl-return (native-elisp-load filename))))
+(defun comp--trampoline-abs-filename (subr-name)
+ "Return the absolute filename for a trampoline for SUBR-NAME."
+ (cl-loop
+ with dirs = (if (stringp native-comp-enable-subr-trampolines)
+ (list (expand-file-name native-comp-enable-subr-trampolines
+ invocation-directory))
+ (if native-compile-target-directory
+ (list (expand-file-name comp-native-version-dir
+ native-compile-target-directory))
+ (comp-eln-load-path-eff)))
+ with rel-filename = (comp-trampoline-filename subr-name)
+ for dir in dirs
+ for abs-filename = (expand-file-name rel-filename dir)
+ unless (file-exists-p dir)
+ do (ignore-errors
+ (make-directory dir t)
+ (cl-return abs-filename))
+ when (file-writable-p abs-filename)
+ do (cl-return abs-filename)
+ ;; Default to some temporary directory if no better option was
+ ;; found.
+ finally (cl-return
+ (make-temp-file (file-name-sans-extension rel-filename) nil ".eln"
+ nil))))
+
(defun comp-trampoline-compile (subr-name)
"Synthesize compile and return a trampoline for SUBR-NAME."
(let* ((lambda-list (comp-make-lambda-list-from-subr
@@ -3826,25 +3872,7 @@ Return the trampoline if found or nil otherwise."
(lexical-binding t))
(comp--native-compile
form nil
- ;; If we've disabled nativecomp, don't write the trampolines to
- ;; the eln cache (but create them).
- (unless inhibit-automatic-native-compilation
- (cl-loop
- for dir in (if native-compile-target-directory
- (list (expand-file-name comp-native-version-dir
-
native-compile-target-directory))
- (comp-eln-load-path-eff))
- for f = (expand-file-name
- (comp-trampoline-filename subr-name)
- dir)
- unless (file-exists-p dir)
- do (ignore-errors
- (make-directory dir t)
- (cl-return f))
- when (file-writable-p f)
- do (cl-return f)
- finally (error "Cannot find suitable directory for output in \
-`native-comp-eln-load-path'"))))))
+ (comp--trampoline-abs-filename subr-name))))
;; Some entry point support code.
@@ -4134,14 +4162,12 @@ the deferred compilation mechanism."
data
;; So we return the compiled function.
(native-elisp-load data)))
- ;; We may have created a temporary file when we're being
- ;; called with something other than a file as the argument.
- ;; Delete it if we can.
(when (and (not (stringp function-or-file))
(not output)
comp-ctxt
(comp-ctxt-output comp-ctxt)
(file-exists-p (comp-ctxt-output comp-ctxt)))
+ ;; NOTE: Not sure if we want to remove this or being cautious.
(cond ((eq 'windows-nt system-type)
;; We may still be using the temporary .eln file.
(ignore-errors (delete-file (comp-ctxt-output comp-ctxt))))
@@ -4161,11 +4187,11 @@ LOAD and SELECTOR work as described in
`native--compile-async'."
(t (error "SELECTOR must be a function a regexp or nil")))
;; Also exclude files from deferred compilation if
;; any of the regexps in
- ;; `native-comp-deferred-compilation-deny-list' matches.
+ ;; `native-comp-jit-compilation-deny-list' matches.
(and (eq load 'late)
(cl-some (lambda (re)
(string-match-p re file))
- native-comp-deferred-compilation-deny-list))))
+ native-comp-jit-compilation-deny-list))))
(defun native--compile-async (files &optional recursively load selector)
;; BEWARE, this function is also called directly from C.
diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el
index 395498f2206..e393daee879 100644
--- a/lisp/emacs-lisp/debug-early.el
+++ b/lisp/emacs-lisp/debug-early.el
@@ -46,10 +46,10 @@ of the build process."
(print-escape-control-characters t)
(print-escape-nonascii t)
(prin1 (if (and (fboundp 'cl-prin1)
- ;; If we're being called while
- ;; bootstrapping, we won't be able to load
- ;; cl-print.
- (require 'cl-print nil t))
+ (fboundp 'cl-defmethod) ;Used by `cl-print'.
+ (condition-case nil
+ (require 'cl-print)
+ (error nil)))
#'cl-prin1
#'prin1)))
(mapbacktrace
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 2f7d03e9d79..552526b6efc 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1225,8 +1225,10 @@ purpose by adding an entry to this alist, and setting
;; But the list will just be reversed.
,@(nreverse edebug-def-args))
'nil)
- (function (lambda () ,@forms))
- ))
+ ;; Make sure `forms' is not nil so we don't accidentally return
+ ;; the magic keyword. Mark the closure so we don't throw away
+ ;; unused vars (bug#59213).
+ #'(lambda () :closure-dont-trim-context ,@(or forms '(nil)))))
(defvar edebug-form-begin-marker) ; the mark for def being instrumented
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 3f5cf0ad0dc..74bef264bf1 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -296,13 +296,9 @@ reflect the change."
This function displays the message produced by formatting ARGS
with FORMAT-STRING on the mode line when the current buffer is a minibuffer.
Otherwise, it displays the message like `message' would."
- (if (minibufferp)
+ (if (or (bound-and-true-p edebug-mode) (minibufferp))
(progn
- (add-hook 'minibuffer-exit-hook
- (lambda () (setq eldoc-mode-line-string nil
- ;; https://debbugs.gnu.org/16920
- eldoc-last-message nil))
- nil t)
+ (add-hook 'post-command-hook #'eldoc-minibuffer--cleanup)
(with-current-buffer
(window-buffer
(or (window-in-direction 'above (minibuffer-window))
@@ -321,6 +317,13 @@ Otherwise, it displays the message like `message' would."
(force-mode-line-update)))
(apply #'message format-string args)))
+(defun eldoc-minibuffer--cleanup ()
+ (unless (or (bound-and-true-p edebug-mode) (minibufferp))
+ (setq eldoc-mode-line-string nil
+ ;; https://debbugs.gnu.org/16920
+ eldoc-last-message nil)
+ (remove-hook 'post-command-hook #'eldoc-minibuffer--cleanup)))
+
(make-obsolete
'eldoc-message "use `eldoc-documentation-functions' instead." "eldoc-1.1.0")
(defun eldoc-message (&optional string) (eldoc--message string))
@@ -570,7 +573,7 @@ known to be truncated."
Honor `eldoc-echo-area-use-multiline-p' and
`eldoc-echo-area-prefer-doc-buffer'."
(cond
- (;; Check if he wave permission to mess with echo area at all. For
+ (;; Check if we have permission to mess with echo area at all. For
;; example, if this-command is non-nil while running via an idle
;; timer, we're still in the middle of executing a command, e.g. a
;; query-replace where it would be annoying to overwrite the echo
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 367f59e8785..d44c9d6e23d 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -181,8 +181,11 @@ to a package-local <package>-loaddefs.el file.")
(put 'define-category 'doc-string-elt 2)
;; CL
(put 'defconstant 'doc-string-elt 3)
+(put 'define-compiler-macro 'doc-string-elt 3)
+(put 'define-setf-expander 'doc-string-elt 3)
(put 'defparameter 'doc-string-elt 3)
(put 'defstruct 'doc-string-elt 2)
+(put 'deftype 'doc-string-elt 3)
(defvar lisp-doc-string-elt-property 'doc-string-elt
"The symbol property that holds the docstring position info.")
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index e3ed28f097a..417c218c6d7 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -519,6 +519,7 @@ major mode's decisions about context.")
"Return the \"far end\" position of the buffer, in direction ARG.
If ARG is positive, that's the end of the buffer.
Otherwise, that's the beginning of the buffer."
+ (declare (side-effect-free error-free))
(if (> arg 0) (point-max) (point-min)))
(defun end-of-defun (&optional arg interactive)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index c909ffb6933..8cb67c3b8b5 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -339,14 +339,19 @@ Assumes the caller has bound
`macroexpand-all-environment'."
(`(cond . ,clauses)
(macroexp--cons fn (macroexp--all-clauses clauses) form))
(`(condition-case . ,(or `(,err ,body . ,handlers)
pcase--dontcare))
- (macroexp--cons
- fn
- (macroexp--cons err
- (macroexp--cons (macroexp--expand-all body)
- (macroexp--all-clauses handlers
1)
- (cddr form))
- (cdr form))
- form))
+ (let ((exp-body (macroexp--expand-all body)))
+ (if handlers
+ (macroexp--cons fn
+ (macroexp--cons
+ err (macroexp--cons
+ exp-body
+ (macroexp--all-clauses handlers 1)
+ (cddr form))
+ (cdr form))
+ form)
+ (macroexp-warn-and-return
+ (format-message "`condition-case' without handlers")
+ exp-body (list 'suspicious 'condition-case) t form))))
(`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
(push name macroexp--dynvars)
(macroexp--all-forms form 2))
@@ -496,7 +501,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; Record which arguments expect functions, so we can warn when those
;; are accidentally quoted with ' rather than with #'
(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash
- map-char-table map-keymap map-keymap-internal))
+ mapcan map-char-table map-keymap map-keymap-internal))
(put f 'funarg-positions '(1)))
(dolist (f '( add-hook remove-hook advice-remove advice--remove-function
defalias fset global-set-key run-after-idle-timeout
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index 33bd0bfd5cd..ea2766b8dc4 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -134,7 +134,10 @@ the `clone' function."
(package-vc-install name spec))
((listp spec)
(package-vc--archives-initialize)
- (package-vc--unpack (cadr pkg-descs) spec)))))))
+ (package-vc--unpack
+ (or (cadr (assoc name package-archive-contents))
+ (package-desc-create :name name :kind 'vc))
+ spec)))))))
;;;###autoload
(defcustom package-vc-selected-packages '()
@@ -269,9 +272,9 @@ Populate `package-vc--archive-spec-alist' with the result.
If optional argument ASYNC is non-nil, perform the downloads
asynchronously."
(dolist (archive package-archives)
- (condition-case-unless-debug nil
+ (condition-case err
(package--download-one-archive archive "elpa-packages.eld" async)
- (error (message "Failed to download `%s' archive." (car archive))))))
+ (error (message "Failed to download `%s' archive: %S" (car archive)
err)))))
(add-hook 'package-read-archive-hook #'package-vc--read-archive-data 20)
@@ -306,7 +309,6 @@ asynchronously."
(directory (file-name-concat
(or (package-desc-dir pkg-desc)
(expand-file-name name package-user-dir))
- (plist-get pkg-spec :lisp-dir)
(and-let* ((extras (package-desc-extras pkg-desc)))
(alist-get :lisp-dir extras))))
(file (or (plist-get pkg-spec :main-file)
@@ -426,27 +428,32 @@ version of that package."
((let* ((pac package-archive-contents)
(desc (cadr (assoc (car pkg) pac))))
(if desc
- (let ((reqs (package-desc-reqs pkg)))
- (push pkg to-install)
+ (let ((reqs (package-desc-reqs desc)))
+ (push desc to-install)
(mapc #'search reqs))
(push pkg missing))))))
(version-order (a b)
"Predicate to sort packages in order."
- (version-list-< (cadr b) (cadr a)))
+ (version-list-<
+ (package-desc-version b)
+ (package-desc-version a)))
(duplicate-p (a b)
"Are A and B the same package?"
- (eq (car a) (car b)))
+ (eq (package-desc-name a) (package-desc-name b)))
(depends-on-p (target package)
"Does PACKAGE depend on TARGET?"
(or (eq target package)
(let* ((pac package-archive-contents)
(desc (cadr (assoc package pac))))
- (seq-some
- (apply-partially #'depends-on-p target)
- (package-desc-reqs desc)))))
+ (and desc (seq-some
+ (apply-partially #'depends-on-p target)
+ (package-desc-reqs desc))))))
(dependent-order (a b)
- (or (not (depends-on-p (car b) (car a)))
- (depends-on-p (car a) (car b)))))
+ (let ((desc-a (package-desc-name a))
+ (desc-b (package-desc-name b)))
+ (or (not desc-a) (not desc-b)
+ (not (depends-on-p desc-b desc-a))
+ (depends-on-p desc-a desc-b)))))
(mapc #'search requirements)
(cl-callf sort to-install #'version-order)
(cl-callf seq-uniq to-install #'duplicate-p)
@@ -594,18 +601,27 @@ attribute in PKG-SPEC."
(vc-retrieve-tag dir release-rev)
(message "No release revision was found, continuing...")))))
+(defvar package-vc-non-code-file-names
+ '(".dir-locals.el" ".dir-locals-2.el")
+ "List of file names that do not contain Emacs Lisp code.
+This list is used by `package-vc--unpack' to better check if the
+user is fetching code from a repository that does not contain any
+Emacs Lisp files.")
+
(defun package-vc--unpack (pkg-desc pkg-spec &optional rev)
"Install the package described by PKG-DESC.
PKG-SPEC is a package specification, a property list describing
how to fetch and build the package. See `package-vc--archive-spec-alist'
for details. The optional argument REV specifies a specific revision to
checkout. This overrides the `:branch' attribute in PKG-SPEC."
- (unless pkg-desc
- (setq pkg-desc (package-desc-create :name (car pkg-spec) :kind 'vc)))
+ (unless (eq (package-desc-kind pkg-desc) 'vc)
+ (let ((copy (copy-package-desc pkg-desc)))
+ (setf (package-desc-kind copy) 'vc
+ pkg-desc copy)))
(pcase-let* (((map :lisp-dir) pkg-spec)
(name (package-desc-name pkg-desc))
(dirname (package-desc-full-name pkg-desc))
- (pkg-dir (expand-file-name dirname package-user-dir)))
+ (pkg-dir (file-name-as-directory (expand-file-name dirname
package-user-dir))))
(when (string-empty-p name)
(user-error "Empty package name"))
(setf (package-desc-dir pkg-desc) pkg-dir)
@@ -614,6 +630,17 @@ checkout. This overrides the `:branch' attribute in
PKG-SPEC."
(package--delete-directory pkg-dir)
(error "There already exists a checkout for %s" name)))
(package-vc--clone pkg-desc pkg-spec pkg-dir rev)
+ (when (directory-empty-p pkg-dir)
+ (delete-directory pkg-dir)
+ (error "Empty checkout for %s" name))
+ (unless (seq-remove
+ (lambda (file)
+ (member (file-name-nondirectory file)
package-vc-non-code-file-names))
+ (directory-files-recursively pkg-dir "\\.el\\'" nil))
+ (when (yes-or-no-p (format "No Emacs Lisp files found when fetching
\"%s\", \
+abort installation?" name))
+ (delete-directory pkg-dir t)
+ (user-error "Installation aborted")))
;; When nothing is specified about a `lisp-dir', then should
;; heuristically check if there is a sub-directory with lisp
@@ -802,9 +829,7 @@ regular package, but it will not remove a VC package.
rev)))
((and-let* ((desc (assoc package package-archive-contents #'string=)))
(package-vc--unpack
- (let ((copy (copy-package-desc (cadr desc))))
- (setf (package-desc-kind copy) 'vc)
- copy)
+ (cadr desc)
(or (package-vc--desc->spec (cadr desc))
(and-let* ((extras (package-desc-extras (cadr desc)))
(url (alist-get :url extras))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 09917cd29b1..a0bb5e75393 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -378,10 +378,8 @@ If so, and variable `package-check-signature' is
`allow-unsigned', return `allow-unsigned', otherwise return the
value of variable `package-check-signature'."
(if (eq package-check-signature 'allow-unsigned)
- (progn
- (require 'epg-config)
- (and (epg-find-configuration 'OpenPGP)
- 'allow-unsigned))
+ (and (epg-find-configuration 'OpenPGP)
+ 'allow-unsigned)
package-check-signature))
(defcustom package-unsigned-archives nil
@@ -958,7 +956,6 @@ Newer versions are always activated, regardless of FORCE."
"Untar the current buffer.
This uses `tar-untar-buffer' from Tar mode. All files should
untar into a directory named DIR; otherwise, signal an error."
- (require 'tar-mode)
(tar-mode)
;; Make sure everything extracts into DIR.
(let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index e64a3dcea1e..fd9fbbe25a4 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -130,6 +130,7 @@ usually more efficient than that of a simplified version:
(concat (car parens)
(mapconcat \\='regexp-quote strings \"\\\\|\")
(cdr parens))))"
+ (declare (pure t) (side-effect-free t))
(save-match-data
;; Recurse on the sorted list.
(let* ((max-lisp-eval-depth 10000)
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 542c96512f5..bfd7434be9a 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -162,8 +162,10 @@ dialogs. Otherwise, the function will always use
text-mode dialogs.
The return value is the matching entry from the CHOICES list.
-If LONG-FORM, do a `completing-read' over the NAME elements in
-CHOICES instead.
+If LONG-FORM is non-nil, do a `completing-read' over the NAME elements
+in CHOICES instead. In this case, GUI dialog is not used, regardless
+of the value of `use-dialog-box' and whether the function was invoked
+via a mouse gesture.
Usage example:
@@ -177,8 +179,9 @@ Usage example:
prompt choices help-string show-help)))
(defun read-multiple-choice--short-answers (prompt choices help-string
show-help)
- (let* ((prompt-choices
- (if show-help choices (append choices '((?? "?")))))
+ (let* ((dialog-p (use-dialog-box-p))
+ (prompt-choices
+ (if (or show-help dialog-p) choices (append choices '((?? "?")))))
(altered-names (mapcar #'rmc--add-key-description prompt-choices))
(full-prompt
(format
@@ -192,16 +195,14 @@ Usage example:
(setq buf (rmc--show-help prompt help-string show-help
choices altered-names)))
(while (not tchar)
- (message "%s%s"
- (if wrong-char
- "Invalid choice. "
- "")
- full-prompt)
+ (unless dialog-p
+ (message "%s%s"
+ (if wrong-char
+ "Invalid choice. "
+ "")
+ full-prompt))
(setq tchar
- (if (and (display-popup-menus-p)
- last-input-event ; not during startup
- (consp last-nonmenu-event)
- use-dialog-box)
+ (if dialog-p
(x-popup-dialog
t
(cons prompt
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index ed4e205d204..c49960c2ee6 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1167,6 +1167,9 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eg-result-string "#<process foo>")
(processp
:eval (processp t))
+ (process-status
+ :no-eval (process-status process)
+ :eg-result exit)
(delete-process
:no-value (delete-process process))
(kill-process
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 8cdbdf1ef6a..947390b3de3 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -102,6 +102,7 @@ threading."
"Join all STRINGS using SEPARATOR.
Optional argument SEPARATOR must be a string, a vector, or a list of
characters; nil stands for the empty string."
+ (declare (pure t) (side-effect-free t))
(mapconcat #'identity strings separator))
(define-obsolete-function-alias 'string-reverse 'reverse "25.1")
@@ -112,6 +113,7 @@ characters; nil stands for the empty string."
When truncating, \"...\" is always prepended to the string, so
the resulting string may be longer than the original if LENGTH is
3 or smaller."
+ (declare (pure t) (side-effect-free t))
(let ((strlen (length string)))
(if (<= strlen length)
string
@@ -124,16 +126,19 @@ the resulting string may be longer than the original if
LENGTH is
"Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and
carriage return."
+ (declare (pure t) (side-effect-free t))
(string-match-p "\\`[ \t\n\r]*\\'" string))
(defsubst string-remove-prefix (prefix string)
"Remove PREFIX from STRING if present."
+ (declare (pure t) (side-effect-free t))
(if (string-prefix-p prefix string)
(substring string (length prefix))
string))
(defsubst string-remove-suffix (suffix string)
"Remove SUFFIX from STRING if present."
+ (declare (pure t) (side-effect-free t))
(if (string-suffix-p suffix string)
(substring string 0 (- (length string) (length suffix)))
string))
@@ -252,6 +257,7 @@ is done.
If START is nil (or not present), the padding is done to the end
of the string, and if non-nil, padding is done to the start of
the string."
+ (declare (pure t) (side-effect-free t))
(unless (natnump length)
(signal 'wrong-type-argument (list 'natnump length)))
(let ((pad-length (- length (length string))))
@@ -261,6 +267,7 @@ the string."
(defun string-chop-newline (string)
"Remove the final newline (if any) from STRING."
+ (declare (pure t) (side-effect-free t))
(string-remove-suffix "\n" string))
(defun replace-region-contents (beg end replace-fn
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index 1d3cde69392..e722cbc52dd 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -237,7 +237,7 @@ Otherwise result is a reason code."
((eq (car-safe fun) 'lambda)
(unsafep fun unsafep-vars))
((not (and (symbolp fun)
- (or (get fun 'side-effect-free)
+ (or (function-get fun 'side-effect-free)
(eq (get fun 'safe-function) t)
(eq safe-functions t)
(memq fun safe-functions))))
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 0eb58565b37..2a37c383f81 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -466,6 +466,12 @@
;; Viper mode-changing commands and utilities
+(defcustom viper-enable-minibuffer-faces t
+ "If non-nil, viper uses distinct faces in the minibuffer."
+ :type 'boolean
+ :version "30.1"
+ :group 'viper-misc)
+
;; Modifies mode-line-buffer-identification.
(defun viper-refresh-mode-line ()
(setq-local viper-mode-string
@@ -561,14 +567,14 @@
))
;; minibuffer faces
- (if (viper-has-face-support-p)
+ (if (and (viper-has-face-support-p) viper-enable-minibuffer-faces)
(setq viper-minibuffer-current-face
(cond ((eq state 'emacs-state) viper-minibuffer-emacs-face)
((eq state 'vi-state) viper-minibuffer-vi-face)
((memq state '(insert-state replace-state))
viper-minibuffer-insert-face))))
- (if (viper-is-in-minibuffer)
+ (if (and (viper-is-in-minibuffer) viper-enable-minibuffer-faces)
(viper-set-minibuffer-overlay))
)
@@ -1705,8 +1711,8 @@ to in the global map, instead of cycling through the
insertion ring."
(if (eq viper-current-state 'replace-state)
(undo 1)
(if viper-last-inserted-string-from-insertion-ring
- (backward-delete-char
- (length viper-last-inserted-string-from-insertion-ring))))
+ (delete-char
+ (- (length viper-last-inserted-string-from-insertion-ring)))))
)
;;first search through insertion history
(setq viper-temp-insertion-ring (ring-copy viper-insertion-ring)))
diff --git a/lisp/env.el b/lisp/env.el
index 33c02f6f920..faafcb6250f 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -204,6 +204,7 @@ parameter.
Otherwise, this function searches `process-environment' for
VARIABLE. If it is not found there, then it continues the search
in the environment list of the selected frame."
+ (declare (side-effect-free t))
(interactive (list (read-envvar-name "Get environment variable: " t)))
(let ((value (getenv-internal (if (multibyte-string-p variable)
(encode-coding-string
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 1da701aebc4..567443f5329 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -425,7 +425,7 @@ Called with a server buffer as its only argument.
Potential uses
include exponential backoff and probing for connectivity prior to
dialing. Use `erc-schedule-reconnect' to instead try again later
and optionally alter the attempts tally."
- :package-version '(ERC . "5.4.1") ; FIXME on next release
+ :package-version '(ERC . "5.5")
:type '(choice (function-item erc-server-delayed-reconnect)
function))
@@ -883,24 +883,22 @@ Conditionally try to reconnect and take appropriate
action."
(erc--unhide-prompt)))
(defun erc--hide-prompt (proc)
- (erc-with-all-buffers-of-server
- proc nil ; sorta wish this was indent 2
- (when (and erc-hide-prompt
- (or (eq erc-hide-prompt t)
- ;; FIXME use `erc--target' after bug#48598
- (memq (if (erc-default-target)
- (if (erc-channel-p (car erc-default-recipients))
- 'channel
- 'query)
- 'server)
- erc-hide-prompt))
- (marker-position erc-insert-marker)
- (marker-position erc-input-marker)
- (get-text-property erc-insert-marker 'erc-prompt))
- (with-silent-modifications
- (add-text-properties erc-insert-marker (1- erc-input-marker)
- `(display ,erc-prompt-hidden)))
- (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 0 t))))
+ (erc-with-all-buffers-of-server proc nil
+ (when (and erc-hide-prompt
+ (or (eq erc-hide-prompt t)
+ (memq (if erc--target
+ (if (erc--target-channel-p erc--target)
+ 'channel
+ 'query)
+ 'server)
+ erc-hide-prompt))
+ (marker-position erc-insert-marker)
+ (marker-position erc-input-marker)
+ (get-text-property erc-insert-marker 'erc-prompt))
+ (with-silent-modifications
+ (add-text-properties erc-insert-marker (1- erc-input-marker)
+ `(display ,erc-prompt-hidden)))
+ (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t))))
(defun erc-process-sentinel (cproc event)
"Sentinel function for ERC process."
@@ -1167,7 +1165,7 @@ Note that future bundled modules providing IRCv3
functionality
will not be compatible with the legacy format. User code should
eventually transition to expecting this \"5.5+ variant\" and set
this option to nil."
- :package-version '(ERC . "5.4.1") ; FIXME increment on next release
+ :package-version '(ERC . "5.5")
:type '(choice (const nil)
(const legacy)
(const overridable)))
@@ -1201,7 +1199,7 @@ instead, leave them as a single string."
(get 'erc-parse-tags 'erc-v3-warned-p))
(put 'erc-parse-tags 'erc-v3-warned-p t)
(display-warning
- 'ERC
+ 'erc
(concat
"Legacy ERC tags behavior is currently in effect, but other modules,"
" including those bundled with ERC, may override this in future"
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 1be47c3e665..c28dddefa0e 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -176,7 +176,7 @@ PAR is a number of a regexp grouping whose text will be
passed to
CALLBACK. There can be several PAR arguments. If REGEXP is
`nicknames', these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
- :version "29.1"
+ :package-version '(ERC . "5.5")
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 994555acecf..0279b0a0bc4 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -48,9 +48,6 @@
;; User data
nickname host login full-name info
;; Buffers
- ;;
- ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where
- ;; CHANNEL-DATA is either nil or an erc-channel-user struct.
(buffers nil))
(cl-defstruct (erc-channel-user (:type vector) :named)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 499bcaf5724..52ee5c855f3 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -244,7 +244,7 @@ server and other miscellaneous functions."
"Whether to `regexp-quote' when adding to a match list interactively.
When the value is a boolean, the opposite behavior will be made
available via universal argument."
- :package-version '(ERC . "5.4.1") ; FIXME increment on next release
+ :package-version '(ERC . "5.5")
:type '(choice (const ask)
(const t)
(const nil)))
diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el
index a0b36d07613..9265691c2d7 100644
--- a/lisp/erc/erc-sasl.el
+++ b/lisp/erc/erc-sasl.el
@@ -24,13 +24,13 @@
;;
;; https://lists.gnu.org/archive/html/erc-discuss/2012-02/msg00001.html
;;
-;; See options and Info manual for usage.
+;; See M-x customize-group RET erc-sasl RET and (info "(erc) SASL")
+;; for usage.
;;
;; TODO:
;;
-;; - Find a way to obfuscate the password in memory (via something
-;; like `auth-source--obfuscate'); it's currently visible in
-;; backtraces.
+;; - Obfuscate non-auth-source passwords in memory. They're currently
+;; visible in backtraces.
;;
;; - Implement a proxy mechanism that chooses the strongest available
;; mechanism for you. Requires CAP 3.2 (see bug#49860).
@@ -52,7 +52,7 @@
(defgroup erc-sasl nil
"SASL for ERC."
:group 'erc
- :package-version '(ERC . "5.4.1")) ; FIXME increment on next release
+ :package-version '(ERC . "5.5"))
(defcustom erc-sasl-mechanism 'plain
"SASL mechanism to connect with.
@@ -67,29 +67,28 @@ Note that any value other than nil or `external' likely
requires
(defcustom erc-sasl-user :user
"Account username to send when authenticating.
-This is also referred to as the authentication identity or
+This option specifies the SASL authentication identity, or
\"authcid\". A value of `:user' or `:nick' indicates that the
-corresponding connection parameter on file should be used. These
-are most often derived from arguments provided to the `erc' and
-`erc-tls' entry points. In the case of `:nick', a downcased
-version is used."
+corresponding connection parameter on file should be used. ERC
+typically obtains these from arguments given to its entry-point
+commands, `erc' and `erc-tls'."
:type '(choice string (const :user) (const :nick)))
(defcustom erc-sasl-password :password
"Optional account password to send when authenticating.
-When `erc-sasl-auth-source-function' is a function, ERC will
-attempt an auth-source query and prompt for input if it fails.
-Otherwise, when the value is a nonempty string, ERC will use it
-unconditionally for most mechanisms. Likewise with `:password',
-except ERC will instead use the \"session password\" on file, if
-any, which often originates from the entry-point commands `erc'
-or `erc-tls'. As with auth-source, ERC will prompt for input as
-a fallback.
-
-Note that, with `:password', ERC will forgo sending a traditional
+When `erc-sasl-auth-source-function' is a function, ERC attempts
+an auth-source query and prompts for input if it fails.
+Otherwise, when the value of this option is a nonempty string,
+ERC uses it unconditionally for most mechanisms. Likewise with a
+value of `:password', except ERC instead uses the \"session
+password\" on file, if any, which often originates from the
+entry-point commands `erc' or `erc-tls'. As with auth-source,
+ERC prompts for input as a fallback.
+
+Note that, with `:password', ERC forgoes sending a traditional
server password via the IRC \"PASS\" command. Also, when
-`erc-sasl-mechanism' is set to `ecdsa-nist256p-challenge', this
-option should hold the file name of the key."
+`erc-sasl-mechanism' is set to `ecdsa-nist256p-challenge', ERC
+expects this option to hold the file name of the key."
:type '(choice (const nil) (const :password) string symbol))
(defcustom erc-sasl-auth-source-function nil
@@ -101,9 +100,8 @@ though ERC itself only specifies `:user' paired with a
ERC binds all options defined in this library, such as
`erc-sasl-password', to their values from entry-point invocation.
In return, ERC expects a string to send as the SASL password, or
-nil, in which case, ERC will prompt the for input. See info
-node `(erc) auth-source' for details on ERC's auth-source
-integration."
+nil, in which case, ERC prompts for input. See Info node `(erc)
+auth-source' for details on ERC's auth-source integration."
:type '(choice (function-item erc-sasl-auth-source-password-as-host)
(function-item erc-auth-source-search)
(const nil)
@@ -129,7 +127,7 @@ integration."
(defun erc-sasl--get-user ()
(pcase (alist-get 'user erc-sasl--options)
(:user erc-session-username)
- (:nick (erc-downcase (erc-current-nick)))
+ (:nick (erc-current-nick))
(v v)))
(defun erc-sasl-auth-source-password-as-host (&rest plist)
@@ -407,7 +405,7 @@ This doesn't solicit or validate a suite of supported
mechanisms."
(erc-sasl--destroy proc))
(define-erc-response-handler (908)
- "Handle a RPL_SASLALREADY response." nil
+ "Handle a RPL_SASLMECHS response." nil
(erc-display-message parsed '(notice error) 'active 's908
?m (alist-get 'mechanism erc-sasl--options)
?s (string-join (cdr (erc-response.command-args parsed))
@@ -428,7 +426,8 @@ Otherwise, expect it to disappear in subsequent versions.")
(erc-server-send (if erc-sasl--send-cap-ls "CAP LS" "CAP REQ :sasl"))
(let ((erc-session-password
(and erc-session-password
- (not (eq :password (alist-get 'password
erc-sasl--options)))
+ (not (eq :password
+ (alist-get 'password erc-sasl--options)))
erc-session-password))
(erc-session-username
;; The username may contain a colon or a space
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 1c2fc2fcdc8..2e6959cc3f0 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -180,9 +180,9 @@ Called with a subset of keyword parameters known to
`auth-source-search' and relevant to authenticating to nickname
services. In return, ERC expects a string to send as the
password, or nil, to fall through to the next method, such as
-prompting. See info node `(erc) auth-source' for details."
- :package-version '(ERC . "5.4.1") ; FIXME update when publishing to ELPA
- :type '(choice (const erc-auth-source-search)
+prompting. See Info node `(erc) auth-source' for details."
+ :package-version '(ERC . "5.5")
+ :type '(choice (function-item erc-auth-source-search)
(const nil)
function))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ff1820cfaf2..69bdb5d71b1 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -12,8 +12,8 @@
;; David Edmondson (dme@dme.org)
;; Michael Olson (mwolson@gnu.org)
;; Kelvin White (kwhite@gnu.org)
-;; Version: 5.4.1
-;; Package-Requires: ((emacs "27.1") (compat "28.1.2.0"))
+;; Version: 5.5
+;; Package-Requires: ((emacs "27.1") (compat "29.1.3.4"))
;; Keywords: IRC, chat, client, Internet
;; URL: https://www.gnu.org/software/emacs/erc.html
@@ -71,7 +71,7 @@
(require 'iso8601)
(eval-when-compile (require 'subr-x) (require 'url-parse))
-(defconst erc-version "5.4.1"
+(defconst erc-version "5.5"
"This version of ERC.")
(defvar erc-official-location
@@ -86,7 +86,8 @@
'(ERC ("5.2" . "22.1")
("5.3" . "23.1")
("5.4" . "28.1")
- ("5.4.1" . "29.1")))
+ ("5.4.1" . "29.1")
+ ("5.5" . "29.1")))
(defgroup erc nil
"Emacs Internet Relay Chat client."
@@ -217,8 +218,8 @@ parameters and authentication."
This variable only exists for legacy reasons. It's not customizable and
is limited to a single server password. Users looking for similar
-functionality should consider auth-source instead. See info
-node `(auth) Top' and info node `(erc) auth-source'.")
+functionality should consider auth-source instead. See Info
+node `(auth) Top' and Info node `(erc) auth-source'.")
(make-obsolete-variable 'erc-password "use auth-source instead" "29.1")
@@ -250,19 +251,19 @@ node `(auth) Top' and info node `(erc) auth-source'.")
Issue an error when the number of input lines submitted for
sending exceeds this value. The value t means disallow more
than 1 line of input."
- :package-version '(ERC . "5.4.1") ; FIXME match to next release
+ :package-version '(ERC . "5.5")
:group 'erc
:type '(choice integer boolean))
(defcustom erc-ask-about-multiline-input nil
"Whether to ask to ignore `erc-inhibit-multiline-input' when tripped."
- :package-version '(ERC . "5.4.1") ; FIXME match to next release
+ :package-version '(ERC . "5.5")
:group 'erc
:type 'boolean)
(defcustom erc-prompt-hidden ">"
"Text to show in lieu of the prompt when hidden."
- :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
+ :package-version '(ERC . "5.5")
:group 'erc-display
:type 'string)
@@ -272,7 +273,7 @@ To unhide, type something in the input area. Once
revealed, a
prompt remains unhidden until the next disconnection. Channel
prompts are unhidden upon rejoining. See
`erc-unhide-query-prompt' for behavior concerning query prompts."
- :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
+ :package-version '(ERC . "5.5")
:group 'erc-display
:type '(choice (const :tag "Always hide prompt" t)
(set (const server)
@@ -284,7 +285,7 @@ prompts are unhidden upon rejoining. See
Otherwise, prompts in a connection's query buffers remain hidden
until the user types in the input area or a new message arrives
from the target."
- :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
+ :package-version '(ERC . "5.5")
:group 'erc-display
;; Extensions may one day offer a way to discover whether a target
;; is online. When that happens, this can be expanded accordingly.
@@ -1479,7 +1480,7 @@ The available choices are:
`bury' - bury it in a new buffer,
`buffer' - in place of the current buffer,
any other value - in place of the current buffer."
- :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
+ :package-version '(ERC . "5.5")
:group 'erc-buffers
:type '(choice (const :tag "Split window and select" window)
(const :tag "Split window, don't select" window-noselect)
@@ -1495,7 +1496,7 @@ This only affects automatic reconnections and is ignored
when
issuing a /reconnect command or reinvoking `erc-tls' with the
same args (assuming success, of course). See `erc-join-buffer'
for a description of possible values."
- :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
+ :package-version '(ERC . "5.5")
:group 'erc-buffers
:type '(choice (const :tag "Use value of `erc-join-buffer'" nil)
(const :tag "Split window and select" window)
@@ -2319,7 +2320,7 @@ Example usage:
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 USER
+See Info node `(erc) Network Identifier' for details. Like USER
and CLIENT-CERTIFICATE, this parameter cannot be specified
interactively."
(interactive (let ((erc-default-port erc-default-port-tls))
@@ -3258,10 +3259,10 @@ if any. In return, ERC expects a string to send as the
server
password, or nil, to skip the \"PASS\" command completely. An
explicit `:password' argument to entry-point commands `erc' and
`erc-tls' also inhibits lookup, as does setting this option to
-nil. See info node `(erc) auth-source' for details."
- :package-version '(ERC . "5.4.1") ; FIXME update when publishing to ELPA
+nil. See Info node `(erc) auth-source' for details."
+ :package-version '(ERC . "5.5")
:group 'erc
- :type '(choice (const erc-auth-source-search)
+ :type '(choice (function-item erc-auth-source-search)
(const nil)
function))
@@ -3272,11 +3273,11 @@ Called with a subset of keyword arguments known to
channel. In return, ERC expects a string to use as the channel
\"key\", or nil to just join the channel normally. Setting the
option itself to nil tells ERC to always forgo consulting
-auth-source for channel keys. For more information, see info
+auth-source for channel keys. For more information, see Info
node `(erc) auth-source'."
- :package-version '(ERC . "5.4.1") ; FIXME update when publishing to ELPA
+ :package-version '(ERC . "5.5")
:group 'erc
- :type '(choice (const erc-auth-source-search)
+ :type '(choice (function-item erc-auth-source-search)
(const nil)
function))
@@ -6837,8 +6838,8 @@ shortened server name instead."
;; erc-goodies is required at end of this file.
-;; FIXME when 29.1 is cut and `format-spec' is added to ELPA Compat,
-;; remove the function invocations from the spec form below.
+;; TODO when ERC drops Emacs 28, replace the expressions in the format
+;; spec below with functions.
(defun erc-update-mode-line-buffer (buffer)
"Update the mode line in a single ERC buffer BUFFER."
(with-current-buffer buffer
@@ -7213,7 +7214,7 @@ See also `format-spec'."
(defcustom erc-kill-server-hook '(erc-kill-server
erc-networks-shrink-ids-and-buffer-names)
"Invoked whenever a live server buffer is killed via `kill-buffer'."
- :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
+ :package-version '(ERC . "5.5")
:group 'erc-hooks
:type 'hook)
@@ -7222,7 +7223,7 @@ See also `format-spec'."
erc-networks-shrink-ids-and-buffer-names
erc-networks-rename-surviving-target-buffer)
"Invoked whenever a channel-buffer is killed via `kill-buffer'."
- :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
+ :package-version '(ERC . "5.5")
:group 'erc-hooks
:type 'hook)
@@ -7232,7 +7233,7 @@ See also `format-spec'."
"Hook run whenever a query buffer is killed.
See also `kill-buffer'."
- :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
+ :package-version '(ERC . "5.5")
:group 'erc-hooks
:type 'hook)
@@ -7311,7 +7312,7 @@ Called with a string meant to represent a URL scheme, like
\"ircs\", followed by any number of keyword arguments recognized
by `erc' and `erc-tls'."
:group 'erc
- :package-version '(ERC . "5.4.1") ; FIXME increment on release
+ :package-version '(ERC . "5.5")
:type '(choice (const nil) function))
(defun erc--url-default-connect-function (scheme &rest plist)
diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el
index 8bc497bdeb3..2bee50b80a4 100644
--- a/lisp/eshell/em-banner.el
+++ b/lisp/eshell/em-banner.el
@@ -43,7 +43,6 @@
(require 'esh-util)
(require 'esh-mode)
-(require 'eshell)
;;;###autoload
(progn
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index bfff3bdf56e..016afe811b2 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -53,9 +53,10 @@
;;; Code:
-(require 'esh-util)
-(require 'eshell)
+(require 'esh-cmd)
+(require 'esh-io)
(require 'esh-opt)
+(require 'esh-util)
;;;###autoload
(progn
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 2439f1ed804..5dfd10d6e4c 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -74,9 +74,7 @@
(require 'esh-util)
(require 'em-dirs)
-(eval-when-compile
- (require 'cl-lib)
- (require 'eshell))
+(eval-when-compile (require 'cl-lib))
;;;###autoload
(progn
@@ -319,8 +317,7 @@ to writing a completion function."
(eshell--pcomplete-insert-tab))
(let ((end (point-marker))
(begin (save-excursion (beginning-of-line) (point)))
- (posns (list t))
- args delim)
+ args posns delim)
(when (and pcomplete-allow-modifications
(memq this-command '(pcomplete-expand
pcomplete-expand-and-complete)))
@@ -332,21 +329,25 @@ to writing a completion function."
(catch 'eshell-incomplete
(ignore
(setq args (eshell-parse-arguments begin end)))))
- (cond ((memq (car delim) '(?\{ ?\<))
+ (cond ((member (car delim) '("{" "${" "$<"))
(setq begin (1+ (cadr delim))
args (eshell-parse-arguments begin end)))
- ((eq (car delim) ?\()
+ ((member (car delim) '("$'" "$\""))
+ ;; Add the (incomplete) argument to our arguments, and
+ ;; note its position.
+ (setq args (append (nth 2 delim) (list (car delim))))
+ (push (- (nth 1 delim) 2) posns))
+ ((member (car delim) '("(" "$("))
(throw 'pcompleted (elisp-completion-at-point)))
(t
(eshell--pcomplete-insert-tab))))
(when (get-text-property (1- end) 'comment)
(eshell--pcomplete-insert-tab))
- (let ((pos begin))
- (while (< pos end)
- (if (get-text-property pos 'arg-begin)
- (nconc posns (list pos)))
- (setq pos (1+ pos))))
- (setq posns (cdr posns))
+ (let ((pos (1- end)))
+ (while (>= pos begin)
+ (when (get-text-property pos 'arg-begin)
+ (push pos posns))
+ (setq pos (1- pos))))
(cl-assert (= (length args) (length posns)))
(let ((a args) (i 0) new-start)
(while a
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index 0d02b64b084..eb679b80cb5 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -281,15 +281,32 @@ Thus, this does not include the current directory.")
(let ((arg (pcomplete-actual-arg)))
(when (string-match "\\`~[a-z]*\\'" arg)
(setq pcomplete-stub (substring arg 1)
- pcomplete-last-completion-raw t)
- (throw 'pcomplete-completions
- (progn
- (eshell-read-user-names)
- (pcomplete-uniquify-list
- (mapcar
- (lambda (user)
- (file-name-as-directory (cdr user)))
- eshell-user-names)))))))
+ pcomplete-last-completion-raw t)
+ (eshell-read-user-names)
+ (let ((names (pcomplete-uniquify-list
+ (mapcar (lambda (user)
+ (file-name-as-directory (cdr user)))
+ eshell-user-names))))
+ (throw 'pcomplete-completions
+ ;; Provide a programmed completion table. This works
+ ;; just like completing over the list of names, except
+ ;; it always returns the completed string for
+ ;; `try-completion', never `t'. That's because this is
+ ;; only completing a directory name, and so the
+ ;; completion isn't actually finished yet.
+ (lambda (string pred action)
+ (pcase action
+ ('nil ; try-completion
+ (let ((result (try-completion string names pred)))
+ (if (eq result t) string result)))
+ ('t ; all-completions
+ (all-completions string names pred))
+ ('lambda ; test-completion
+ (test-completion string names pred))
+ ('metadata
+ '(metadata (category . file)))
+ (`(boundaries . ,suffix)
+ `(boundaries 0 . ,(string-search "/" suffix))))))))))
(defun eshell/pwd (&rest _args)
"Change output from `pwd' to be cleaner."
diff --git a/lisp/eshell/em-extpipe.el b/lisp/eshell/em-extpipe.el
index 9078c44ed9f..5c9a0a85934 100644
--- a/lisp/eshell/em-extpipe.el
+++ b/lisp/eshell/em-extpipe.el
@@ -36,6 +36,21 @@
(eval-when-compile (require 'files-x))
+;;;###autoload
+(progn
+(defgroup eshell-extpipe nil
+ "Native shell pipelines.
+
+This module lets you construct pipelines that use your operating
+system's shell instead of Eshell's own pipelining support. This
+is especially relevant when executing commands on a remote
+machine using Eshell's Tramp integration: using the remote
+shell's pipelining avoids copying the data which will flow
+through the pipeline to local Emacs buffers and then right back
+again."
+ :tag "External pipelines"
+ :group 'eshell-module))
+
;;; Functions:
(defun eshell-extpipe-initialize () ;Called from `eshell-mode' via intern-soft!
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 716f5c32b87..8a2ba13b2ad 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -49,8 +49,9 @@
;;; Code:
+(require 'esh-arg)
+(require 'esh-module)
(require 'esh-util)
-(eval-when-compile (require 'eshell))
;;;###autoload
(progn
@@ -170,7 +171,7 @@ interpretation."
(end (eshell-find-delimiter
delim (if (eq delim ?\[) ?\] ?\)))))
(if (not end)
- (throw 'eshell-incomplete delim)
+ (throw 'eshell-incomplete (char-to-string delim))
(if (and (eshell-using-module 'eshell-pred)
(eshell-arg-delimiter (1+ end)))
(ignore (goto-char here))
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 6e0e471d910..2c199ec160f 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -59,8 +59,6 @@
(require 'ring)
(require 'esh-opt)
(require 'esh-mode)
-(require 'em-pred)
-(require 'eshell)
;;;###autoload
(progn
@@ -82,6 +80,7 @@
(remove-hook 'kill-emacs-hook 'eshell-save-some-history)))
"A hook that gets run when `eshell-hist' is unloaded."
:type 'hook)
+(make-obsolete-variable 'eshell-hist-unload-hook nil "30.1")
(defcustom eshell-history-file-name
(expand-file-name "history" eshell-directory-name)
@@ -769,6 +768,8 @@ matched."
(defun eshell-hist-parse-modifier (hist reference)
"Parse a history modifier beginning for HIST in REFERENCE."
+ (cl-assert (eshell-using-module 'em-pred))
+ (declare-function eshell-parse-modifiers "em-pred" ())
(let ((here (point)))
(insert reference)
(prog1
@@ -1037,6 +1038,9 @@ If N is negative, search backwards for the -Nth previous
match."
(isearch-done)
(eshell-send-input))
+(defun em-hist-unload-function ()
+ (remove-hook 'kill-emacs-hook 'eshell-save-some-history))
+
(provide 'em-hist)
;; Local Variables:
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 7e2a7578ef9..56c5f262789 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -62,24 +62,27 @@ This is useful for enabling human-readable format (-h), for
example."
This is useful for enabling human-readable format (-h), for example."
:type '(repeat :tag "Arguments" string))
+(defun eshell-ls-enable-in-dired ()
+ "Use `eshell-ls' to read directories in Dired."
+ (require 'dired)
+ (advice-add 'insert-directory :around #'eshell-ls--insert-directory)
+ (advice-add 'dired :around #'eshell-ls--dired))
+
+(defun eshell-ls-disable-in-dired ()
+ "Stop using `eshell-ls' to read directories in Dired."
+ (advice-remove 'insert-directory #'eshell-ls--insert-directory)
+ (advice-remove 'dired #'eshell-ls--dired))
+
(defcustom eshell-ls-use-in-dired nil
"If non-nil, use `eshell-ls' to read directories in Dired.
Changing this without using customize has no effect."
:set (lambda (symbol value)
- (cond (value
- (require 'dired)
- (advice-add 'insert-directory :around
- #'eshell-ls--insert-directory)
- (advice-add 'dired :around #'eshell-ls--dired))
- (t
- (advice-remove 'insert-directory
- #'eshell-ls--insert-directory)
- (advice-remove 'dired #'eshell-ls--dired)))
+ (if value
+ (eshell-ls-enable-in-dired)
+ (eshell-ls-disable-in-dired))
(set symbol value))
:type 'boolean
:require 'em-ls)
-(add-hook 'eshell-ls-unload-hook #'eshell-ls-unload-function)
-
(defcustom eshell-ls-default-blocksize 1024
"The default blocksize to use when display file sizes with -s."
@@ -954,10 +957,8 @@ to use, and each member of which is the width of that
column
(car file)))))
(car file))
-(defun eshell-ls-unload-function ()
- (advice-remove 'insert-directory #'eshell-ls--insert-directory)
- (advice-remove 'dired #'eshell-ls--dired)
- nil)
+(defun em-ls-unload-function ()
+ (eshell-ls-disable-in-dired))
(provide 'em-ls)
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index 14fa27aba06..2ccca092b86 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -293,7 +293,7 @@ This function is specially for adding onto
`eshell-parse-argument-hook'."
(forward-char)
(let ((end (eshell-find-delimiter ?\( ?\))))
(if (not end)
- (throw 'eshell-incomplete ?\()
+ (throw 'eshell-incomplete "(")
(when (eshell-arg-delimiter (1+ end))
(save-restriction
(narrow-to-region (point) end)
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index b3a0fadf618..9f9e58e83d7 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -27,8 +27,6 @@
;;; Code:
(require 'esh-mode)
-(eval-when-compile (require 'eshell))
-
(require 'text-property-search)
;;;###autoload
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index f147d432300..75a2848a9d5 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -24,7 +24,6 @@
;;; Code:
(require 'esh-mode)
-(eval-when-compile (require 'eshell))
;;;###autoload
(progn
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index ca04c429785..d8b7fadc2c2 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -69,7 +69,6 @@
;;; Code:
(require 'esh-mode)
-(eval-when-compile (require 'eshell))
;;;###autoload
(progn
@@ -100,6 +99,7 @@ it to get a real sense of how it works."
"A hook that gets run when `eshell-smart' is unloaded."
:type 'hook
:group 'eshell-smart)
+(make-obsolete-variable 'eshell-smart-unload-hook nil "30.1")
(defcustom eshell-review-quick-commands nil
"If t, always review commands.
@@ -322,6 +322,9 @@ and the end of the buffer are still visible."
(if clear
(remove-hook 'pre-command-hook 'eshell-smart-display-move t))))
+(defun em-smart-unload-hook ()
+ (remove-hook 'window-configuration-change-hook #'eshell-refresh-windows))
+
(provide 'em-smart)
;; Local Variables:
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index a4d777e4a0d..ab26da857b7 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -34,7 +34,6 @@
(require 'cl-lib)
(require 'esh-util)
(require 'esh-ext)
-(eval-when-compile (require 'eshell))
(require 'term)
;;;###autoload
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index 13dd62e1617..94eb9797033 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -29,8 +29,7 @@
(require 'esh-cmd)
(eval-when-compile
- (require 'esh-mode)
- (require 'eshell))
+ (require 'esh-mode))
(require 'tramp)
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index defaa7b2887..45c3ea3c0fc 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -25,8 +25,6 @@
(require 'cl-lib)
(require 'esh-util)
-(eval-when-compile
- (require 'eshell))
;; There are no items in this custom group, but eshell modules (ab)use
;; custom groups.
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 6c882471aee..cb0b2e0938c 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -421,7 +421,7 @@ backslash is in a quoted string, the backslash and the
character
after are both returned."
(when (eq (char-after) ?\\)
(when (eshell-looking-at-backslash-return (point))
- (throw 'eshell-incomplete ?\\))
+ (throw 'eshell-incomplete "\\"))
(forward-char 2) ; Move one char past the backslash.
(let ((special-chars (if eshell-current-quoted
eshell-special-chars-inside-quoting
@@ -447,7 +447,7 @@ after are both returned."
(if (eq (char-after) ?\')
(let ((end (eshell-find-delimiter ?\' ?\')))
(if (not end)
- (throw 'eshell-incomplete ?\')
+ (throw 'eshell-incomplete "'")
(let ((string (buffer-substring-no-properties (1+ (point)) end)))
(goto-char (1+ end))
(while (string-match "''" string)
@@ -460,7 +460,7 @@ after are both returned."
(let* ((end (eshell-find-delimiter ?\" ?\" nil nil t))
(eshell-current-quoted t))
(if (not end)
- (throw 'eshell-incomplete ?\")
+ (throw 'eshell-incomplete "\"")
(prog1
(save-restriction
(forward-char)
@@ -514,7 +514,7 @@ If the form has no `type', the syntax is parsed as if
`type' were
t)) ;; buffer-p is non-nil by default.
(end (eshell-find-delimiter ?\< ?\>)))
(when (not end)
- (throw 'eshell-incomplete ?\<))
+ (throw 'eshell-incomplete "#<"))
(if (eshell-arg-delimiter (1+ end))
(prog1
(list (if buffer-p 'get-buffer-create 'get-process)
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index b5f1d60ff18..d609711402a 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -681,7 +681,7 @@ This means an exit code of 0."
(not (eq (char-after (1+ (point))) ?\}))))
(let ((end (eshell-find-delimiter ?\{ ?\})))
(if (not end)
- (throw 'eshell-incomplete ?\{)
+ (throw 'eshell-incomplete "{")
(when (eshell-arg-delimiter (1+ end))
(prog1
`(eshell-as-subcommand
@@ -698,7 +698,7 @@ This means an exit code of 0."
(condition-case nil
(read (current-buffer))
(end-of-file
- (throw 'eshell-incomplete ?\()))))
+ (throw 'eshell-incomplete "(")))))
(if (eshell-arg-delimiter)
`(eshell-command-to-value
(eshell-lisp-command (quote ,obj)))
@@ -741,18 +741,24 @@ if none)."
;; The structure of the following macros is very important to
;; `eshell-do-eval' [Iterative evaluation]:
;;
-;; @ Don't use forms that conditionally evaluate their arguments, such
-;; as `setq', `if', `while', `let*', etc. The only special forms
-;; that can be used are `let', `condition-case' and
-;; `unwind-protect'.
+;; @ Don't use special forms that conditionally evaluate their
+;; arguments, such as `let*', unless Eshell explicitly supports
+;; them. Eshell supports the following special forms: `catch',
+;; `condition-case', `if', `let', `prog1', `progn', `quote', `setq',
+;; `unwind-protect', and `while'.
;;
-;; @ The main body of a `let' can contain only one form. Use `progn'
-;; if necessary.
+;; @ When using `if' or `while', first let-bind `eshell-test-body' and
+;; `eshell-command-body' to '(nil). Eshell uses these variables to
+;; handle conditional evaluation.
;;
;; @ The two `special' variables are `eshell-current-handles' and
;; `eshell-current-subjob-p'. Bind them locally with a `let' if you
;; need to change them. Change them directly only if your intention
;; is to change the calling environment.
+;;
+;; These rules likewise apply to any other code that generates forms
+;; that `eshell-do-eval' will evaluated, such as command rewriting
+;; hooks (see `eshell-rewrite-command-hook' and friends).
(defmacro eshell-do-subjob (object)
"Evaluate a command OBJECT as a subjob.
@@ -1095,9 +1101,17 @@ produced by `eshell-parse-command'."
(eshell-debug-command ,(concat "done " (eval tag)) form))))
(defun eshell-do-eval (form &optional synchronous-p)
- "Evaluate form, simplifying it as we go.
+ "Evaluate FORM, simplifying it as we go.
Unless SYNCHRONOUS-P is non-nil, throws `eshell-defer' if it needs to
-be finished later after the completion of an asynchronous subprocess."
+be finished later after the completion of an asynchronous subprocess.
+
+As this function evaluates FORM, it will gradually replace
+subforms with the (quoted) result of evaluating them. For
+example, a function call is replaced with the result of the call.
+This allows us to resume evaluation of FORM after something
+inside throws `eshell-defer' simply by calling this function
+again. Any forms preceding one that throw `eshell-defer' will
+have been replaced by constants."
(cond
((not (listp form))
(list 'quote (eval form)))
@@ -1161,21 +1175,48 @@ be finished later after the completion of an
asynchronous subprocess."
(setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
(eval form))
((eq (car form) 'let)
- (if (not (eq (car (cadr args)) 'eshell-do-eval))
- (eshell-manipulate "evaluating let args"
- (dolist (letarg (car args))
- (if (and (listp letarg)
- (not (eq (cadr letarg) 'quote)))
- (setcdr letarg
- (list (eshell-do-eval
- (cadr letarg) synchronous-p)))))))
+ (when (not (eq (car (cadr args)) 'eshell-do-eval))
+ (eshell-manipulate "evaluating let args"
+ (dolist (letarg (car args))
+ (when (and (listp letarg)
+ (not (eq (cadr letarg) 'quote)))
+ (setcdr letarg
+ (list (eshell-do-eval
+ (cadr letarg) synchronous-p)))))))
(cl-progv
- (mapcar (lambda (binding) (if (consp binding) (car binding)
binding))
+ (mapcar (lambda (binding)
+ (if (consp binding) (car binding) binding))
(car args))
;; These expressions should all be constants now.
- (mapcar (lambda (binding) (if (consp binding) (eval (cadr
binding))))
+ (mapcar (lambda (binding)
+ (when (consp binding) (eval (cadr binding))))
(car args))
- (eshell-do-eval (macroexp-progn (cdr args)) synchronous-p)))
+ (let (deferred result)
+ ;; Evaluate the `let' body, catching `eshell-defer' so we
+ ;; can handle it below.
+ (setq deferred
+ (catch 'eshell-defer
+ (ignore (setq result (eshell-do-eval
+ (macroexp-progn (cdr args))
+ synchronous-p)))))
+ ;; If something threw `eshell-defer', we need to update
+ ;; the let-bindings' values so that those values are
+ ;; correct when we resume evaluation of this form.
+ (when deferred
+ (eshell-manipulate "rebinding let args after `eshell-defer'"
+ (let ((bindings (car args)))
+ (while bindings
+ (let ((binding (if (consp (car bindings))
+ (caar bindings)
+ (car bindings))))
+ (setcar bindings
+ (list binding
+ (list 'quote (symbol-value binding)))))
+ (pop bindings))))
+ (throw 'eshell-defer deferred))
+ ;; If we get here, there was no `eshell-defer' thrown, so
+ ;; just return the `let' body's result.
+ result)))
((memq (car form) '(catch condition-case unwind-protect))
;; `condition-case' and `unwind-protect' have to be
;; handled specially, because we only want to call
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 503d9ba1b63..0c381dbb86a 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -58,10 +58,16 @@
;;; Code:
-(require 'esh-util)
-(require 'esh-module)
+;; Load the core Eshell modules; we'll call their initialization
+;; functions below in `eshell-mode'.
+(require 'esh-arg)
(require 'esh-cmd)
-(require 'esh-arg) ;For eshell-parse-arguments
+(require 'esh-ext)
+(require 'esh-io)
+(require 'esh-module)
+(require 'esh-proc)
+(require 'esh-util)
+(require 'esh-var)
(defgroup eshell-mode nil
"This module contains code for handling input from the user."
@@ -73,6 +79,7 @@
(defcustom eshell-mode-unload-hook nil
"A hook that gets run when `eshell-mode' is unloaded."
:type 'hook)
+(make-obsolete-variable 'eshell-mode-unload-hook nil "30.1")
(defcustom eshell-mode-hook nil
"A hook that gets run when `eshell-mode' is entered."
@@ -166,7 +173,10 @@ inserted. They return the string as it should be
inserted."
:type 'hook)
(defcustom eshell-password-prompt-regexp
- (format "\\(%s\\)[^:：៖]*[:：៖]\\s *\\'" (regexp-opt
password-word-equivalents))
+ (format "%s[^%s]*[%s]\\s *\\'"
+ (regexp-opt password-word-equivalents t)
+ (apply #'string password-colon-equivalents)
+ (apply #'string password-colon-equivalents))
"Regexp matching prompts for passwords in the inferior process.
This is used by `eshell-watch-for-password-prompt'."
:type 'regexp
@@ -191,6 +201,11 @@ This is used by `eshell-watch-for-password-prompt'."
(defvar eshell-first-time-p t
"A variable which is non-nil the first time Eshell is loaded.")
+(defvar eshell-non-interactive-p nil
+ "A variable which is non-nil when Eshell is not running interactively.
+Modules should use this variable so that they don't clutter
+non-interactive sessions, such as when using `eshell-command'.")
+
;; Internal Variables:
;; these are only set to nil initially for the sake of the
@@ -525,9 +540,7 @@ Putting this function on `eshell-pre-command-hook' will
mimic Plan 9's
(defun eshell-interactive-print (string)
"Print STRING to the eshell display buffer."
(when string
- (add-text-properties 0 (length string)
- '(field command-output rear-nonsticky (field))
- string)
+ (eshell--mark-as-output 0 (length string) string)
(eshell-interactive-filter nil string)))
(defsubst eshell-begin-on-new-line ()
@@ -567,7 +580,7 @@ will return the parsed command."
(setq command (eshell-parse-command (cons beg end)
args t)))))
(ignore
- (message "Expecting completion of delimiter %c ..."
+ (message "Expecting completion of delimiter %s ..."
(if (listp delim)
(car delim)
delim)))
@@ -891,7 +904,7 @@ If USE-CURRENT-REGION is non-nil, return the current
region."
(let ((inhibit-field-text-motion)
(end (point)))
(beginning-of-line)
- (buffer-substring (point) end)))))
+ (buffer-substring-no-properties (point) end)))))
(defun eshell-copy-old-input ()
"Insert after prompt old input at point as new input to be edited."
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index 651e793ad98..7fc74d38796 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -47,6 +47,7 @@ customizing the variable `eshell-modules-list'."
"A hook run when `eshell-module' is unloaded."
:type 'hook
:group 'eshell-module)
+(make-obsolete-variable 'eshell-module-unload-hook nil "30.1")
(defcustom eshell-modules-list
'(eshell-alias
@@ -85,20 +86,37 @@ Changes will only take effect in future Eshell buffers."
;;; Code:
+(defsubst eshell-module--feature-name (module &optional kind)
+ "Get the feature name for the specified Eshell MODULE."
+ (let ((module-name (symbol-name module))
+ (prefix (cond ((eq kind 'core) "esh-")
+ ((memq kind '(extension nil)) "em-")
+ (t (error "unknown module kind %s" kind)))))
+ (if (string-match "^eshell-\\(.*\\)" module-name)
+ (concat prefix (match-string 1 module-name))
+ (error "Invalid Eshell module name: %s" module))))
+
(defsubst eshell-using-module (module)
"Return non-nil if a certain Eshell MODULE is in use.
The MODULE should be a symbol corresponding to that module's
customization group. Example: `eshell-cmpl' for that module."
(memq module eshell-modules-list))
+(defun eshell-unload-modules (modules &optional kind)
+ "Try to unload the specified Eshell MODULES."
+ (dolist (module modules)
+ (let ((module-feature (intern (eshell-module--feature-name module kind))))
+ (when (featurep module-feature)
+ (message "Unloading %s..." (symbol-name module))
+ (condition-case-unless-debug _
+ (progn
+ (unload-feature module-feature)
+ (message "Unloading %s...done" (symbol-name module)))
+ (error (message "Unloading %s...failed" (symbol-name module))))))))
+
(defun eshell-unload-extension-modules ()
- "Unload any memory resident extension modules."
- (dolist (module (eshell-subgroups 'eshell-module))
- (if (featurep module)
- (ignore-errors
- (message "Unloading %s..." (symbol-name module))
- (unload-feature module)
- (message "Unloading %s...done" (symbol-name module))))))
+ "Try to unload all currently-loaded Eshell extension modules."
+ (eshell-unload-modules (eshell-subgroups 'eshell-module)))
(provide 'esh-module)
;;; esh-module.el ends here
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index 9253f9a4a7d..09c19767a19 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -29,6 +29,11 @@
;; defined in esh-util.
(require 'esh-util)
+(defgroup eshell-opt nil
+ "Functions for argument parsing in Eshell commands."
+ :tag "Option parsing"
+ :group 'eshell)
+
(defmacro eshell-eval-using-options (name macro-args options &rest body-forms)
"Process NAME's MACRO-ARGS using a set of command line OPTIONS.
After doing so, stores settings in local symbols as declared by OPTIONS;
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 27cd521e82e..a86e7502795 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -24,6 +24,7 @@
;;; Code:
(require 'esh-io)
+(require 'esh-util)
(defgroup eshell-proc nil
"When Eshell invokes external commands, it always does so
@@ -411,9 +412,7 @@ Used only on systems which do not support async
subprocesses.")
"Send the output from PROCESS (STRING) to the interactive display.
This is done after all necessary filtering has been done."
(when string
- (add-text-properties 0 (length string)
- '(field command-output rear-nonsticky (field))
- string)
+ (eshell--mark-as-output 0 (length string) string)
(require 'esh-mode)
(declare-function eshell-interactive-filter "esh-mode" (buffer string))
(eshell-interactive-filter (if process (process-buffer process)
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 9549e7f1a10..c0685757789 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -132,6 +132,19 @@ function `string-to-number'.")
(defvar eshell-user-timestamp nil
"A timestamp of when the user file was read.")
+(defvar eshell-command-output-properties
+ `( field command-output
+ front-sticky (field)
+ rear-nonsticky (field)
+ ;; Text inserted by a user in the middle of process output
+ ;; should be marked as output. This is needed for commands
+ ;; such as `yank' or `just-one-space' which don't use
+ ;; `insert-and-inherit' and thus bypass default text property
+ ;; inheritance.
+ insert-in-front-hooks (,#'eshell--mark-as-output
+ ,#'eshell--mark-yanked-as-output))
+ "A list of text properties to apply to command output.")
+
;;; Obsolete variables:
(define-obsolete-variable-alias 'eshell-host-names
@@ -157,6 +170,27 @@ Otherwise, evaluates FORM with no error handling."
,@handlers)
form))
+(defun eshell--mark-as-output (start end &optional object)
+ "Mark the text from START to END as Eshell output.
+OBJECT can be a buffer or string. If nil, mark the text in the
+current buffer."
+ (with-silent-modifications
+ (add-text-properties start end eshell-command-output-properties
+ object)))
+
+(defun eshell--mark-yanked-as-output (start end)
+ "Mark yanked text from START to END as Eshell output."
+ ;; `yank' removes the field text property from the text it inserts
+ ;; due to `yank-excluded-properties', so arrange for this text
+ ;; property to be reapplied in the `after-change-functions'.
+ (letrec ((hook
+ (lambda (start1 end1 _len1)
+ (remove-hook 'after-change-functions hook t)
+ (when (and (= start start1)
+ (= end end1))
+ (eshell--mark-as-output start1 end1)))))
+ (add-hook 'after-change-functions hook nil t)))
+
(defun eshell-find-delimiter
(open close &optional bound reverse-p backslash-p)
"From point, find the CLOSE delimiter corresponding to OPEN.
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 60aab92b33e..5d6299af564 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -434,9 +434,14 @@ the values of nil for each."
(defun eshell-envvar-names (&optional environment)
"Return a list of currently visible environment variable names."
- (mapcar (lambda (x)
- (substring x 0 (string-search "=" x)))
- (or environment process-environment)))
+ (delete-dups
+ (append
+ ;; Real environment variables
+ (mapcar (lambda (x)
+ (substring x 0 (string-search "=" x)))
+ (or environment process-environment))
+ ;; Eshell variable aliases
+ (mapcar #'car eshell-variable-aliases-list))))
(defun eshell-environment-variables ()
"Return a `process-environment', fully updated.
@@ -503,7 +508,7 @@ Possible variable references are:
((eq (char-after) ?{)
(let ((end (eshell-find-delimiter ?\{ ?\})))
(if (not end)
- (throw 'eshell-incomplete ?\{)
+ (throw 'eshell-incomplete "${")
(forward-char)
(prog1
`(eshell-apply-indices
@@ -527,7 +532,7 @@ Possible variable references are:
((eq (char-after) ?\<)
(let ((end (eshell-find-delimiter ?\< ?\>)))
(if (not end)
- (throw 'eshell-incomplete ?\<)
+ (throw 'eshell-incomplete "$<")
(let* ((temp (make-temp-file temporary-file-directory))
(cmd (concat (buffer-substring (1+ (point)) end)
" > " temp)))
@@ -560,15 +565,19 @@ Possible variable references are:
(current-buffer)))))
indices ,eshell-current-quoted)
(end-of-file
- (throw 'eshell-incomplete ?\())))
+ (throw 'eshell-incomplete "$("))))
((looking-at (rx-to-string
`(or "'" ,(if eshell-current-quoted "\\\"" "\""))))
(eshell-with-temp-command
(or (eshell-unescape-inner-double-quote (point-max))
(cons (point) (point-max)))
- (let ((name (if (eq (char-after) ?\')
- (eshell-parse-literal-quote)
- (eshell-parse-double-quote))))
+ (let (name)
+ (when-let ((delim
+ (catch 'eshell-incomplete
+ (ignore (setq name (if (eq (char-after) ?\')
+ (eshell-parse-literal-quote)
+ (eshell-parse-double-quote)))))))
+ (throw 'eshell-incomplete (concat "$" delim)))
(when name
`(eshell-get-variable ,(eval name) indices
,eshell-current-quoted)))))
((assoc (char-to-string (char-after))
@@ -597,7 +606,7 @@ For example, \"[0 1][2]\" becomes:
(while (eq (char-after) ?\[)
(let ((end (eshell-find-delimiter ?\[ ?\])))
(if (not end)
- (throw 'eshell-incomplete ?\[)
+ (throw 'eshell-incomplete "[")
(forward-char)
(eshell-with-temp-command (or (eshell-unescape-inner-double-quote
end)
(cons (point) end))
@@ -816,41 +825,56 @@ START and END."
(let ((arg (pcomplete-actual-arg)))
(when (string-match
(rx "$" (? (or "#" "@"))
- (? (group (regexp eshell-variable-name-regexp)))
- string-end)
+ (? (or (group-n 1 (regexp eshell-variable-name-regexp)
+ string-end)
+ (seq (group-n 2 (or "'" "\""))
+ (group-n 1 (+ anychar))))))
arg)
(setq pcomplete-stub (substring arg (match-beginning 1)))
+ (let ((delimiter (match-string 2 arg)))
+ ;; When finished with completion, insert the trailing
+ ;; delimiter, if any, and add a trailing slash if the variable
+ ;; refers to a directory.
+ (add-function
+ :before-until (var pcomplete-exit-function)
+ (lambda (variable status)
+ (when (eq status 'finished)
+ (when delimiter
+ (if (looking-at (regexp-quote delimiter))
+ (goto-char (match-end 0))
+ (insert delimiter)))
+ (let ((non-essential t)
+ (value (eshell-get-variable variable)))
+ (when (and (stringp value) (file-directory-p value))
+ (insert "/")
+ ;; Tell Pcomplete not to insert its own termination
+ ;; string.
+ t))))))
(throw 'pcomplete-completions (eshell-variables-list)))))
(defun eshell-variables-list ()
"Generate list of applicable variables."
- (let ((argname pcomplete-stub)
- completions)
- (dolist (alias eshell-variable-aliases-list)
- (if (string-match (concat "^" argname) (car alias))
- (setq completions (cons (car alias) completions))))
+ (let ((argname pcomplete-stub))
(sort
- (append
- (mapcar
- (lambda (varname)
- (let ((value (eshell-get-variable varname)))
- (if (and value
- (stringp value)
- (file-directory-p value))
- (concat varname "/")
- varname)))
- (eshell-envvar-names (eshell-environment-variables)))
- (all-completions argname obarray 'boundp)
- completions)
- 'string-lessp)))
+ (append (eshell-envvar-names)
+ (all-completions argname obarray #'boundp))
+ #'string-lessp)))
(defun eshell-complete-variable-assignment ()
"If there is a variable assignment, allow completion of entries."
- (let ((arg (pcomplete-actual-arg)) pos)
- (when (string-match (concat "\\`" eshell-variable-name-regexp "=") arg)
- (setq pos (match-end 0))
- (if (string-match "\\(:\\)[^:]*\\'" arg)
- (setq pos (match-end 1)))
+ (catch 'not-assignment
+ ;; The current argument can only be a variable assignment if all
+ ;; arguments leading up to it are also variable assignments. See
+ ;; `eshell-handle-local-variables'.
+ (dotimes (offset (1+ pcomplete-index))
+ (unless (string-match (concat "\\`" eshell-variable-name-regexp "=")
+ (pcomplete-actual-arg 'first offset))
+ (throw 'not-assignment nil)))
+ ;; We have a variable assignment. Handle it.
+ (let ((arg (pcomplete-actual-arg))
+ (pos (match-end 0)))
+ (when (string-match "\\(:\\)[^:]*\\'" arg)
+ (setq pos (match-end 1)))
(setq pcomplete-stub (substring arg pos))
(throw 'pcomplete-completions (pcomplete-entries)))))
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 7a7ece5cb7c..7d2c0335db2 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -199,10 +199,11 @@ shells such as bash, zsh, rc, 4dos."
:type 'hook
:group 'eshell)
-(defcustom eshell-unload-hook '(eshell-unload-all-modules)
+(defcustom eshell-unload-hook nil
"A hook run when Eshell is unloaded from memory."
:type 'hook
:group 'eshell)
+(make-obsolete-variable 'eshell-unload-hook nil "30.1")
(defcustom eshell-buffer-name "*eshell*"
"The basename used for Eshell buffers.
@@ -267,10 +268,7 @@ information on Eshell, see Info node `(eshell)Top'."
(define-obsolete-function-alias 'eshell-return-exits-minibuffer
#'eshell-command-mode "28.1")
-(defvar eshell-non-interactive-p nil
- "A variable which is non-nil when Eshell is not running interactively.
-Modules should use this variable so that they don't clutter
-non-interactive sessions, such as when using `eshell-command'.")
+(defvar eshell-non-interactive-p) ; Defined in esh-mode.el.
(declare-function eshell-add-input-to-history "em-hist" (input))
@@ -373,28 +371,14 @@ corresponding to a successful execution."
(set status-var eshell-last-command-status))
(cadr result))))))
-;;; Code:
-
-(defun eshell-unload-all-modules ()
- "Unload all modules that were loaded by Eshell, if possible.
-If the user has require'd in any of the modules, or customized a
-variable with a :require tag (such as `eshell-prefer-to-shell'), it
-will be impossible to unload Eshell completely without restarting
-Emacs."
- ;; if the user set `eshell-prefer-to-shell' to t, but never loaded
- ;; Eshell, then `eshell-subgroups' will be unbound
- (when (fboundp 'eshell-subgroups)
- (dolist (module (eshell-subgroups 'eshell))
- ;; this really only unloads as many modules as possible,
- ;; since other `require' references (such as by customizing
- ;; `eshell-prefer-to-shell' to a non-nil value) might make it
- ;; impossible to unload Eshell completely
- (if (featurep module)
- (ignore-errors
- (message "Unloading %s..." (symbol-name module))
- (unload-feature module)
- (message "Unloading %s...done" (symbol-name module)))))
- (message "Unloading eshell...done")))
+(defun eshell-unload-function ()
+ (eshell-unload-extension-modules)
+ ;; Wait to unload core modules until after `eshell' has finished
+ ;; unloading. `eshell' depends on several of them, so they can't be
+ ;; unloaded immediately.
+ (run-at-time 0 nil #'eshell-unload-modules
+ (reverse (eshell-subgroups 'eshell)) 'core)
+ nil)
(run-hooks 'eshell-load-hook)
diff --git a/lisp/faces.el b/lisp/faces.el
index 4933b495a6c..8bf7e4429d9 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -191,7 +191,7 @@ For internal use only."
(let ((face-id (car (gethash face face--new-frame-defaults))))
(push `(,face-id ,face . ,spec) faces)))
(frame--face-hash-table frame))
- (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
+ (mapcar #'cdr (sort faces (lambda (f1 f2) (> (car f1) (car f2)))))))
(defun face-list ()
"Return a list of all defined faces."
@@ -199,7 +199,7 @@ For internal use only."
(maphash (lambda (face spec)
(push `(,(car spec) . ,face) faces))
face--new-frame-defaults)
- (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
+ (mapcar #'cdr (sort faces (lambda (f1 f2) (> (car f1) (car f2)))))))
(defun make-face (face)
"Define a new face with name FACE, a symbol.
@@ -2226,7 +2226,7 @@ the X resource \"reverseVideo\" is present, handle that."
(unwind-protect
(progn
(x-setup-function-keys frame)
- (dolist (face (nreverse (face-list)))
+ (dolist (face (face-list))
(face-spec-recalc face frame))
(x-handle-reverse-video frame parameters)
(frame-set-background-mode frame t)
diff --git a/lisp/files.el b/lisp/files.el
index 9da82446112..6f02aac33d3 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2775,7 +2775,11 @@ not set local variables (though we do notice a mode
specified with -*-.)
`enable-local-variables' is ignored if you run `normal-mode' interactively,
or from Lisp without specifying the optional argument FIND-FILE;
-in that case, this function acts as if `enable-local-variables' were t."
+in that case, this function acts as if `enable-local-variables' were t.
+
+If invoked in a buffer that doesn't visit a file, this function
+processes only the major mode specification in the -*- line and
+the local variables spec."
(interactive)
(kill-all-local-variables)
(unless delay-mode-hooks
@@ -3925,9 +3929,6 @@ variables.
Uses `hack-local-variables-apply' to apply the variables.
-See `hack-local-variables--find-variables' for the meaning of
-HANDLE-MODE.
-
If `enable-local-variables' or `local-enable-local-variables' is
nil, or INHIBIT-LOCALS is non-nil, this function disregards all
normal local variables. If `inhibit-local-variables-regexps'
@@ -3937,7 +3938,14 @@ applied.
Variables present in `permanently-enabled-local-variables' will
still be evaluated, even if local variables are otherwise
-inhibited."
+inhibited.
+
+If HANDLE-MODE is t, the function only checks whether a \"mode:\"
+is specified, and returns the corresponding mode symbol, or nil.
+In this case, try to ignore minor-modes, and return only a major-mode.
+If HANDLE-MODE is nil, the function gathers all the specified local
+variables. If HANDLE-MODE is neither nil nor t, the function gathers
+all the specified local variables, but ignores any settings of \"mode:\"."
;; We don't let inhibit-local-variables-p influence the value of
;; enable-local-variables, because then it would affect dir-local
;; variables. We don't want to search eg tar files for file local
@@ -4017,6 +4025,7 @@ major-mode."
(forward-line 1)
(let ((startpos (point))
endpos
+ (selective-p (eq selective-display t))
(thisbuf (current-buffer)))
(save-excursion
(unless (let ((case-fold-search t))
@@ -4033,7 +4042,8 @@ major-mode."
(with-temp-buffer
(insert-buffer-substring thisbuf startpos endpos)
(goto-char (point-min))
- (subst-char-in-region (point) (point-max) ?\^m ?\n)
+ (if selective-p
+ (subst-char-in-region (point) (point-max) ?\r ?\n))
(while (not (eobp))
;; Discard the prefix.
(if (looking-at prefix)
@@ -6358,7 +6368,18 @@ If FILE1 or FILE2 does not exist, the return value is
unspecified."
(let (f1-attr f2-attr)
(and (setq f1-attr (file-attributes (file-truename file1)))
(setq f2-attr (file-attributes (file-truename file2)))
- (equal f1-attr f2-attr))))))
+ (progn
+ ;; Haiku systems change the file's last access timestamp
+ ;; every time `stat' is called. Make sure to not compare
+ ;; the timestamps in that case.
+ (or (equal f1-attr f2-attr)
+ (when (and (eq system-type 'haiku)
+ (consp (nthcdr 4 f1-attr))
+ (consp (nthcdr 4 f2-attr)))
+ (ignore-errors
+ (setcar (nthcdr 4 f1-attr) nil)
+ (setcar (nthcdr 4 f2-attr) nil))
+ (equal f1-attr f2-attr)))))))))
(defun file-in-directory-p (file dir)
"Return non-nil if DIR is a parent directory of FILE.
@@ -8393,11 +8414,14 @@ as in \"og+rX-w\"."
num-rights))
(defun file-modes-number-to-symbolic (mode &optional filetype)
- "Return a string describing a file's MODE.
+ "Return a description of a file's MODE as a string of 10 letters and dashes.
+The returned string is like the mode description produced by \"ls -l\".
For instance, if MODE is #o700, then it produces `-rwx------'.
-FILETYPE if provided should be a character denoting the type of file,
-such as `?d' for a directory, or `?l' for a symbolic link and will override
-the leading `-' char."
+Note that this is NOT the same as the \"chmod\" style symbolic description
+accepted by `file-modes-symbolic-to-number'.
+FILETYPE, if provided, should be a character denoting the type of file,
+such as `?d' for a directory, or `?l' for a symbolic link, and will override
+the leading `-' character."
(string
(or filetype
(pcase (ash mode -12)
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 1fa45379b9f..f8815c1698a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1154,6 +1154,8 @@ Put first the functions more likely to cause a change and
cheaper to compute.")
"Fontify the text between BEG and END.
If LOUDLY is non-nil, print status messages while fontifying.
This function is the default `font-lock-fontify-region-function'."
+ (or (<= end (point-max))
+ (setq end (point-max)))
(with-silent-modifications
;; Use the fontification syntax table, if any.
(with-syntax-table (or font-lock-syntax-table (syntax-table))
@@ -2024,6 +2026,12 @@ as the constructs of Haddock, Javadoc and similar
systems."
"Font Lock mode face used to highlight function names."
:group 'font-lock-faces)
+(defface font-lock-function-call-face
+ '((t :inherit font-lock-function-name-face))
+ "Font Lock mode face used to highlight function calls."
+ :group 'font-lock-faces
+ :version "29.1")
+
(defface font-lock-variable-name-face
'((((class grayscale) (background light))
:foreground "Gray90" :weight bold :slant italic)
@@ -2038,6 +2046,12 @@ as the constructs of Haddock, Javadoc and similar
systems."
"Font Lock mode face used to highlight variable names."
:group 'font-lock-faces)
+(defface font-lock-variable-use-face
+ '((t :inherit font-lock-variable-name-face))
+ "Font Lock mode face used to highlight variable references."
+ :group 'font-lock-faces
+ :version "29.1")
+
(defface font-lock-type-face
'((((class grayscale) (background light)) :foreground "Gray90" :weight bold)
(((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
@@ -2113,10 +2127,17 @@ as the constructs of Haddock, Javadoc and similar
systems."
:group 'font-lock-faces
:version "29.1")
-(defface font-lock-property-face
+(defface font-lock-property-name-face
'((t :inherit font-lock-variable-name-face))
"Font Lock mode face used to highlight properties of an object.
-For example, the declaration and use of fields in a struct."
+For example, the declaration of fields in a struct."
+ :group 'font-lock-faces
+ :version "29.1")
+
+(defface font-lock-property-use-face
+ '((t :inherit font-lock-property-name-face))
+ "Font Lock mode face used to highlight property references.
+For example, property lookup of fields in a struct."
:group 'font-lock-faces
:version "29.1")
diff --git a/lisp/frame.el b/lisp/frame.el
index fa376788eb0..d9255a55171 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -873,6 +873,11 @@ the new frame according to its own rules."
(interactive)
(let* ((display (cdr (assq 'display parameters)))
(w (cond
+ ;; When running in a batch session, don't create a GUI
+ ;; frame. (Batch sessions don't set a SIGIO handler on
+ ;; relevant platforms, so attempting this would terminate
+ ;; Emacs.)
+ (noninteractive nil)
((assq 'terminal parameters)
(let ((type (terminal-live-p
(cdr (assq 'terminal parameters)))))
@@ -2120,8 +2125,9 @@ frame's display)."
;; a toggle.
(featurep 't-mouse)
;; No way to check whether a w32 console has a mouse, assume
- ;; it always does.
- (boundp 'w32-use-full-screen-buffer))))))
+ ;; it always does, except in batch invocations.
+ (and (not noninteractive)
+ (boundp 'w32-use-full-screen-buffer)))))))
(defun display-popup-menus-p (&optional display)
"Return non-nil if popup menus are supported on DISPLAY.
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index c697b8d7a7f..8d3fe010af4 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1926,9 +1926,10 @@ no, only reply back to the author."
"Whether to generate X-Hashcash: headers.
If t, always generate hashcash headers. If `opportunistic',
only generate hashcash headers if it can be done without the user
-waiting (i.e., only asynchronously).
+waiting (i.e., only asynchronously). If nil, don't generate
+hashcash headers.
-You must have the \"hashcash\" binary installed, see `hashcash-path'."
+You must have the \"hashcash\" binary installed, see `hashcash-program'."
:version "24.1"
:group 'message-headers
:link '(custom-manual "(message)Mail Headers")
@@ -6861,10 +6862,9 @@ are not included."
(defun message-setup-1 (headers &optional yank-action actions return-action)
(dolist (action actions)
- (condition-case nil
- ;; FIXME: Use functions rather than expressions!
- (add-to-list 'message-send-actions
- `(apply #',(car action) ',(cdr action)))))
+ ;; FIXME: Use functions rather than expressions!
+ (add-to-list 'message-send-actions
+ `(apply #',(car action) ',(cdr action))))
(setq message-return-action return-action)
(setq message-reply-buffer
(if (and (consp yank-action)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 8bf8af73d30..50e60b68e17 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -769,7 +769,7 @@ the C sources, too."
(and (symbolp function)
(not (eq (car-safe (symbol-function function)) 'macro))
(let* ((interactive-only
- (or (get function 'interactive-only)
+ (or (function-get function 'interactive-only)
(if (boundp 'byte-compile-interactive-only-functions)
(memq function
byte-compile-interactive-only-functions)))))
@@ -778,7 +778,7 @@ the C sources, too."
;; Cf byte-compile-form.
(cond ((stringp interactive-only)
(format ";\n in Lisp code %s" interactive-only))
- ((and (symbolp 'interactive-only)
+ ((and (symbolp interactive-only)
(not (eq interactive-only t)))
(format-message ";\n in Lisp code use `%s' instead."
interactive-only))
@@ -996,7 +996,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
(symbol-name function)))))))
(real-def (cond
((and aliased (not (subrp def)))
- (car (function-alias-p real-function t)))
+ (car (function-alias-p real-function)))
((subrp def) (intern (subr-name def)))
(t def))))
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 78fc5e6f716..5c536b190fb 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -611,6 +611,7 @@ then remove all hi-lock highlighting."
(cond
(current-prefix-arg (list t))
((and (display-popup-menus-p)
+ last-nonmenu-event
(listp last-nonmenu-event)
use-dialog-box)
(catch 'snafu
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 014f38b2024..49c0c78fe73 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -137,10 +137,11 @@ See `icomplete-delay-completions-threshold'."
"Maximum number of initial chars to apply `icomplete-compute-delay'."
:type 'integer)
-(defvar icomplete-in-buffer nil
+(defcustom icomplete-in-buffer nil
"If non-nil, also use Icomplete when completing in non-mini buffers.
This affects commands like `completion-in-region', but not commands
-that use their own completions setup.")
+that use their own completions setup."
+ :type 'boolean)
(defcustom icomplete-minibuffer-setup-hook nil
"Icomplete-specific customization of minibuffer setup.
@@ -215,15 +216,29 @@ the default otherwise."
;; calculated, This causes the first cached completion to
;; be taken (i.e. the one that the user sees highlighted)
completion-all-sorted-completions)
- (minibuffer-force-complete-and-exit)
+ (if (window-minibuffer-p)
+ (minibuffer-force-complete-and-exit)
+ (minibuffer-force-complete (icomplete--field-beg)
+ (icomplete--field-end)
+ 'dont-cycle)
+ (completion-in-region-mode -1))
;; Otherwise take the faster route...
- (minibuffer-complete-and-exit)))
+ (if (window-minibuffer-p)
+ (minibuffer-complete-and-exit)
+ (completion-complete-and-exit
+ (icomplete--field-beg)
+ (icomplete--field-end)
+ (lambda () (completion-in-region-mode -1))))))
(defun icomplete-force-complete ()
"Complete the icomplete minibuffer."
(interactive)
;; We're not at all interested in cycling here (bug#34077).
- (minibuffer-force-complete nil nil 'dont-cycle))
+ (if (window-minibuffer-p)
+ (minibuffer-force-complete nil nil 'dont-cycle)
+ (minibuffer-force-complete (icomplete--field-beg)
+ (icomplete--field-end)
+ 'dont-cycle)))
;; Apropos `icomplete-scroll', we implement "scrolling icomplete"
;; within classic icomplete, which is "rotating", by contrast.
@@ -405,6 +420,16 @@ if that doesn't produce a completion match."
"C-." #'icomplete-forward-completions
"C-," #'icomplete-backward-completions)
+(defun icomplete--fido-ccd ()
+ "Make value for `completion-category-defaults' prioritizing `flex'."
+ (cl-loop
+ for (cat . alist) in completion-category-defaults collect
+ `(,cat . ,(cl-loop
+ for entry in alist for (prop . val) = entry
+ if (eq prop 'styles)
+ collect `(,prop . (flex ,@(delq 'flex val)))
+ else collect entry))))
+
(defun icomplete--fido-mode-setup ()
"Setup `fido-mode''s minibuffer."
(when (and icomplete-mode (icomplete-simple-completing-p))
@@ -416,6 +441,7 @@ if that doesn't produce a completion match."
icomplete-scroll (not (null icomplete-vertical-mode))
completion-styles '(flex)
completion-flex-nospace nil
+ completion-category-defaults (icomplete--fido-ccd)
completion-ignore-case t
read-buffer-completion-ignore-case t
read-file-name-completion-ignore-case t)))
@@ -429,9 +455,12 @@ more like `ido-mode' than regular `icomplete-mode'."
:global t
(remove-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup)
(remove-hook 'minibuffer-setup-hook #'icomplete--fido-mode-setup)
+ (remove-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup)
(when fido-mode
(icomplete-mode -1)
(setq icomplete-mode t)
+ (when icomplete-in-buffer
+ (add-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup))
(add-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup)
(add-hook 'minibuffer-setup-hook #'icomplete--fido-mode-setup)))
@@ -686,11 +715,13 @@ If it's on, just add the vertical display."
Should be run via minibuffer `post-command-hook'.
See `icomplete-mode' and `minibuffer-setup-hook'."
(when (and icomplete-mode
+ ;; Check if still in the right buffer (bug#61308)
+ (or (window-minibuffer-p) completion-in-region--data)
(icomplete-simple-completing-p)) ;Shouldn't be necessary.
(let ((saved-point (point)))
(save-excursion
(goto-char (icomplete--field-end))
- ; Insert the match-status information:
+ ;; Insert the match-status information:
(when (and (or icomplete-show-matches-on-no-input
(not (equal (icomplete--field-string)
icomplete--initial-input)))
diff --git a/lisp/ido.el b/lisp/ido.el
index 98633d5d798..00a2e57f7ba 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -565,11 +565,12 @@ the `ido-work-directory-list' list."
(defcustom ido-use-filename-at-point nil
"Non-nil means that Ido shall look for a filename at point.
-May use `ffap-guesser' to guess whether text at point is a filename.
-If found, use that as the starting point for filename selection."
+Value `guess' means use `ffap-guesser' to guess whether text at
+point is a filename. If found, use that as the starting point
+for filename selection."
:type '(choice
(const :tag "Disabled" nil)
- (const :tag "Guess filename" guess)
+ (const :tag "Guess filename using ffap-guesser" guess)
(other :tag "Use literal filename" t)))
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 96ab963bff4..b4c175a7b63 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -64,9 +64,15 @@
`((,(concat "\\(`?file://\\|\\[\\[\\|<\\|`\\)?"
"\\(" iimage-mode-image-filename-regex "\\)"
"\\(\\]\\]\\|>\\|'\\)?") . 2))
- "Alist of filename REGEXP vs NUM.
-Each element looks like (REGEXP . NUM).
-NUM specifies which parenthesized expression in the regexp.
+ "Alist that specifies how to detect filenames of images to be displayed
inline.
+The value should be an alist whose elements have the form
+
+ (REGEXP . NUM)
+
+where REGEXP is a regular expression to search buffer text for what
+might be a specification of an inline image, and NUM is the number
+of a parenthesized sub-expression of REGEXP which gives the name of
+the image file to look up.
Examples of image filename patterns to match:
file://foo.png
@@ -93,7 +99,7 @@ Examples of image filename patterns to match:
(iimage-mode 0))
(defun iimage-modification-hook (beg end)
- "Remove display property if a display region is modified."
+ "Remove display property if a display region BEG..END is modified."
;;(debug-print "ii1 begin %d, end %d\n" beg end)
(let ((inhibit-modification-hooks t)
(beg (previous-single-property-change end 'display
@@ -112,8 +118,8 @@ Examples of image filename patterns to match:
file)
(with-silent-modifications
(save-excursion
- (goto-char (point-min))
(dolist (pair iimage-mode-image-regex-alist)
+ (goto-char (point-min))
(while (re-search-forward (car pair) nil t)
(when (and (setq file (match-string (cdr pair)))
(setq file (locate-file file image-path)))
diff --git a/lisp/image/exif.el b/lisp/image/exif.el
index 50428c3a31a..4807df0fbbb 100644
--- a/lisp/image/exif.el
+++ b/lisp/image/exif.el
@@ -110,7 +110,7 @@ from the return value of this function."
(exif-parse-buffer)))
(defun exif-parse-buffer (&optional buffer)
- "Parse BUFFER (which should be a JPEG file) and return the Exif data, if any.
+ "Parse BUFFER (which should visit a JPEG file) and return Exif data, if any.
The return value is a list of Exif items.
If the data is invalid, an `exif-error' is signaled.
@@ -134,17 +134,17 @@ from the return value of this function."
(exif--parse-exif-chunk app1))))))
(defun exif-field (field data)
- "Return raw FIELD from EXIF.
+ "Return raw FIELD from Exif DATA.
If FIELD is not present in the data, return nil.
FIELD is a symbol in the cdr of `exif-tag-alist'.
-DATA is the result of calling `exif-parse-file'."
+DATA is the result of calling `exif-parse-file' or `exif-parse-buffer'."
(plist-get (seq-find (lambda (e)
(eq field (plist-get e :tag-name)))
data)
:value))
(defun exif-orientation (exif)
- "Return the orientation (in degrees) in EXIF.
+ "Return the orientation (in degrees) in EXIF data.
If the orientation isn't present in the data, return nil."
(let ((code (exif-field 'orientation exif)))
(cadr (assq code exif--orientation))))
@@ -255,21 +255,24 @@ If the orientation isn't present in the data, return nil."
;; We've reached the end of the directories.
dir))))
-(defun exif--direct-ascii-value (value bytes le)
- "Make VALUE into a zero-terminated string.
-VALUE is an integer representing BYTES characters."
+(defun exif--direct-ascii-value (value nbytes le)
+ "Make a string representing VALUE with NBYTES bytes according to LE
endianness.
+VALUE is an integer value of NBYTES bytes.
+The return value is a null-terminated unibyte string whose length is
+NBYTES+1 bytes. If LE is non-nil, the returned string representation of
+VALUE is little-endian, otherwise it is big-endian."
(with-temp-buffer
(set-buffer-multibyte nil)
(if le
- (dotimes (i bytes)
+ (dotimes (i nbytes)
(insert (logand (ash value (* i -8)) 255)))
- (dotimes (i bytes)
- (insert (logand (ash value (* (- (1- bytes) i) -8)) 255))))
+ (dotimes (i nbytes)
+ (insert (logand (ash value (* (- (1- nbytes) i) -8)) 255))))
(insert 0)
(buffer-string)))
(defun exif--process-value (value type le)
- "Do type-based post-processing of the value."
+ "Do type-based post-processing of the VALUE whose endianness is per LE."
(cl-case type
;; Chop off trailing zero byte.
(ascii (substring value 0 (1- (length value))))
@@ -282,7 +285,8 @@ VALUE is an integer representing BYTES characters."
(otherwise value)))
(defun exif--read-chunk (bytes)
- "Return BYTES octets from the buffer and advance point that much."
+ "Return BYTES octets from the current buffer and advance point that much.
+This function assumes that the current buffer is unibyte."
(when (> (+ (point) bytes) (point-max))
(signal 'exif-error '("Premature end of file")))
(prog1
@@ -290,8 +294,9 @@ VALUE is an integer representing BYTES characters."
(forward-char bytes)))
(defun exif--read-number-be (bytes)
- "Read BYTES octets from the buffer as a chunk of big-endian bytes.
-Advance point to after the read bytes."
+ "Read BYTES octets from the current buffer as a chunk of big-endian bytes.
+Advance point to after the read bytes.
+This function assumes that the current buffer is unibyte."
(when (> (+ (point) bytes) (point-max))
(signal 'exif-error '("Premature end of file")))
(let ((sum 0))
@@ -301,8 +306,9 @@ Advance point to after the read bytes."
sum))
(defun exif--read-number-le (bytes)
- "Read BYTES octets from the buffer as a chunk of low-endian bytes.
-Advance point to after the read bytes."
+ "Read BYTES octets from the current buffer as a chunk of little-endian bytes.
+Advance point to after the read bytes.
+This function assumes that the current buffer is unibyte."
(when (> (+ (point) bytes) (point-max))
(signal 'exif-error '("Premature end of file")))
(let ((sum 0))
@@ -311,10 +317,11 @@ Advance point to after the read bytes."
(forward-char 1))
sum))
-(defun exif--read-number (bytes lower-endian)
- "Read BYTES octets from the buffer with endianness determined by
LOWER-ENDIAN.
-Advance point to after the read bytes."
- (if lower-endian
+(defun exif--read-number (bytes little-endian)
+ "Read BYTES octets from current buffer with endianness given by
LITTLE-ENDIAN.
+Advance point to after the read bytes.
+This function assumes that the current buffer is unibyte."
+ (if little-endian
(exif--read-number-le bytes)
(exif--read-number-be bytes)))
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index 596e623357e..ff9d4ad0d82 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -38,9 +38,9 @@ If nil, Emacs will try to find one of the supported converters
installed on the system.
The actual range of image formats that will be converted depends
-on what image formats the chosen converter reports being able to
-handle. `auto-mode-alist' is then used to further filter what
-formats that are to be supported: Only the suffixes that map to
+on the image formats which the chosen converter is able to
+handle. `auto-mode-alist' is then used to further filter the
+formats that are to be supported: only the suffixes that map to
`image-mode' will be handled."
:group 'image
:type 'symbol
@@ -48,16 +48,16 @@ formats that are to be supported: Only the suffixes that
map to
(defcustom image-convert-to-format "png"
"The image format to convert to.
-This should be a string like \"png\" or \"ppm\" or some
+This should be a string like \"png\" or \"ppm\", or some
other (preferably lossless) format that Emacs understands
-natively. The converter chosen has to support the format, and if
-not, conversion will fail."
+natively. The converter chosen has to support this format; if
+not, the conversion will fail."
:group 'image
:version "29.1"
:type 'string)
(defvar image-converter-regexp nil
- "A regexp that matches the file name suffixes that can be converted.")
+ "A regexp that matches the file name suffixes which can be converted.")
(defvar image-converter-file-name-extensions nil
"A list of file name suffixes that can be converted.")
@@ -66,7 +66,7 @@ not, conversion will fail."
'((graphicsmagick :command ("gm" "convert") :probe ("-list" "format"))
(ffmpeg :command "ffmpeg" :probe "-decoders")
(imagemagick :command "convert" :probe ("-list" "format")))
- "List of supported image converters to try.")
+ "List of supported image converters to try and required command-line
switches.")
(defvar image-converter--extra-converters (make-hash-table :test #'equal))
@@ -80,8 +80,8 @@ This also determines which external formats we can parse."
"Return `image-convert' if SOURCE is an image that can be converted.
SOURCE can either be a file name or a string containing image
data. In the latter case, DATA-P should be non-nil. If DATA-P
-is a string, it should be a MIME format string like
-\"image/gif\"."
+is a string, it should be a MIME format string specifying the image type,
+like \"image/gif\"."
(image-converter-initialize)
;; When image-converter was customized
(when (and image-converter (not image-converter-regexp))
@@ -101,22 +101,21 @@ is a string, it should be a MIME format string like
'image-convert))
(defun image-convert (image &optional image-format)
- "Convert IMAGE file to an image format Emacs understands.
-This will usually be \"png\", but this is controlled by the
-`image-convert-to-format' user option.
+ "Convert IMAGE to an image format which Emacs understands.
+This will usually be \"png\", but is controlled by the value
+of the `image-convert-to-format' user option.
-IMAGE can either be a file name or image data.
-
-To pass in image data, IMAGE should a string containing the image
-data, and IMAGE-FORMAT should be a symbol with a MIME format name
-like \"image/webp\". For instance:
+IMAGE can either be a file name, an image object returned
+by `create-image', or a string with image data. In the latter
+case, IMAGE-FORMAT should be a symbol whose name is a MIME
+specification of image format, such as \"image/webp\".
+For instance:
(image-convert data-string \\='image/bmp)
-IMAGE can also be an image object as returned by `create-image'.
-
-This function converts the image the preferred format, and the
-converted image data is returned as a string."
+This function converts the image to the preferred format, per
+the value of `image-convert-to-format', and returns the
+converted image data as a string."
(image-converter-initialize)
(unless image-converter
(error "No external image converters available"))
@@ -152,14 +151,14 @@ converted image data is returned as a string."
(buffer-string))))
(defun image-converter--value (type elem)
- "Return the value of ELEM of image converter TYPE."
+ "Return the value of property ELEM for image converter TYPE."
(let ((value (plist-get (cdr (assq type image-converter--converters)) elem)))
(if (stringp value)
(list value)
value)))
(cl-defmethod image-converter--probe ((type (eql 'graphicsmagick)))
- "Check whether the system has GraphicsMagick installed."
+ "Check whether the system has GraphicsMagick installed that's usable
converter."
(with-temp-buffer
(let ((command (image-converter--value type :command))
formats)
@@ -177,7 +176,7 @@ converted image data is returned as a string."
(nreverse formats)))))
(cl-defmethod image-converter--probe ((type (eql 'imagemagick)))
- "Check whether the system has ImageMagick installed."
+ "Check whether the system has ImageMagick installed that's a usable
converter."
(with-temp-buffer
(let ((command (image-converter--value type :command))
formats)
@@ -197,7 +196,7 @@ converted image data is returned as a string."
(nreverse formats))))
(cl-defmethod image-converter--probe ((type (eql 'ffmpeg)))
- "Check whether the system has ffmpeg installed."
+ "Check whether the system has ffmpeg installed that's a usable converter."
(with-temp-buffer
(let ((command (image-converter--value type :command))
formats)
@@ -215,7 +214,7 @@ converted image data is returned as a string."
(nreverse formats)))))
(defun image-converter--find-converter ()
- "Find an installed image converter."
+ "Find an installed image converter Emacs can use."
(catch 'done
(dolist (elem image-converter--converters)
(when-let ((formats (image-converter--filter-formats
@@ -239,12 +238,12 @@ Only suffixes that map to `image-mode' are returned."
(cl-defmethod image-converter--convert ((type (eql 'graphicsmagick)) source
image-format)
- "Convert using GraphicsMagick."
+ "Convert image in SOURCE using GraphicsMagick."
(image-converter--convert-magick type source image-format))
(cl-defmethod image-converter--convert ((type (eql 'imagemagick)) source
image-format)
- "Convert using ImageMagick."
+ "Convert image in SOURCE using ImageMagick."
(image-converter--convert-magick type source image-format))
(defun image-converter--mime-type (image-format)
@@ -281,7 +280,7 @@ Only suffixes that map to `image-mode' are returned."
(cl-defmethod image-converter--convert ((type (eql 'ffmpeg)) source
image-format)
- "Convert using ffmpeg."
+ "Convert image in SOURCE using ffmpeg."
(let ((command (image-converter--value type :command))
(coding-system-for-read 'no-conversion))
(unless (zerop (if image-format
@@ -308,12 +307,12 @@ Only suffixes that map to `image-mode' are returned."
;;;###autoload
(defun image-converter-add-handler (suffix converter)
- "Make Emacs use CONVERTER to parse image files that end with SUFFIX.
-CONVERTER is a function with two parameters, where the first is
-the file name or a string with the image data, and the second is
-non-nil if the first parameter is image data. The converter
-should output the image in the current buffer, converted to
-`image-convert-to-format'."
+ "Make Emacs use CONVERTER to parse image files whose names end with SUFFIX.
+CONVERTER is a function with two arguments, the file name or a string
+with the image data, and a non-nil value if the first argument is image data.
+The converter should produce the image in the current buffer, converted to
+the format given by `image-convert-to-format'.
+SUFFIX should not include the leading dot."
(cl-pushnew suffix image-converter-file-name-extensions :test #'equal)
(setq image-converter-file-name-extensions
(sort image-converter-file-name-extensions #'string<))
diff --git a/lisp/image/image-crop.el b/lisp/image/image-crop.el
index e6e5abf53d8..be6e22bc606 100644
--- a/lisp/image/image-crop.el
+++ b/lisp/image/image-crop.el
@@ -41,71 +41,71 @@
:group 'image)
(defvar image-crop-exif-rotate nil
- "If non-nil, rotate images by updating exif data.
+ "If non-nil, rotate images by updating Exif data.
If nil, rotate the images \"physically\".")
(defcustom image-crop-resize-command '("convert" "-resize" "%wx" "-" "%f:-")
- "Command to resize an image.
-The following `format-spec' elements are allowed:
+ "List of command and command-line arguments to resize an image.
+The following `format-spec' elements are allowed in the value:
%w: Width.
-%f: Result file type."
+%f: File type to produce."
:type '(repeat string)
:version "29.1")
(defcustom image-crop-cut-command '("convert" "-draw" "rectangle %l,%t %r,%b"
"-fill" "%c"
"-" "%f:-")
- "Command to cut a rectangle out of an image.
+ "List of command and its command-line arguments to cut a rectangle out of
image.
-The following `format-spec' elements are allowed:
+The following `format-spec' elements are allowed in the value:
%l: Left.
%t: Top.
%r: Right.
%b: Bottom.
%c: Color.
-%f: Result file type."
+%f: File type to produce."
:type '(repeat string)
:version "29.1")
(defcustom image-crop-crop-command '("convert" "+repage" "-crop" "%wx%h+%l+%t"
"-" "%f:-")
- "Command to crop an image.
+ "List of command and its command-line arguments to crop an image.
-The following `format-spec' elements are allowed:
+The following `format-spec' elements are allowed in the value:
%l: Left.
%t: Top.
%w: Width.
%h: Height.
-%f: Result file type."
+%f: File type to produce."
:type '(repeat string)
:version "29.1")
(defcustom image-crop-rotate-command '("convert" "-rotate" "%r" "-" "%f:-")
- "Command to rotate an image.
+ "List of command and its command-line arguments to rotate an image.
-The following `format-spec' elements are allowed:
+The following `format-spec' elements are allowed in the value:
%r: Rotation (in degrees).
-%f: Result file type."
+%f: File type to produce."
:type '(repeat string)
:version "29.1")
(defvar image-crop-buffer-text-function #'image-crop--default-buffer-text
- "Function to return the buffer text for the cropped image.
-After cropping an image, the displayed image will be updated to
-show the cropped image in the buffer. Different modes will have
-different ways to represent this image data in a buffer. For
-instance, an HTML-based mode might want to represent the image
-with <img src=\"data:...base64...\">, but that's up to the mode.
+ "Function to return the buffer text corresponding to the cropped image.
+After cropping an image, the displayed image in the buffer will be updated
+to show the cropped image. Different modes will have different ways to
+represent this image data in a buffer, but that's up to the mode. For
+instance, an HTML-based mode might want to represent the image with
+<img src=\"data:...base64...\">.
-The default action is to not alter the buffer text at all.
+The default action is to not alter the image's text in the buffer, and
+just return it.
-The function is called with two arguments: The first is the
-original buffer text, and the second parameter is the cropped
-image data.")
+The function is called with two arguments: the original buffer text,
+and the cropped image data.")
(defcustom image-cut-color "black"
- "Color to use for the rectangle cut from the image."
+ "Color to use for the rectangle that was cut from the image."
:type 'string
:version "29.1")
diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el
index 85bdd537c27..6b932601df0 100644
--- a/lisp/image/image-dired-dired.el
+++ b/lisp/image/image-dired-dired.el
@@ -57,11 +57,12 @@ Dired and you might want to turn it off."
;;;###autoload
(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
- "Toggle thumbnails in front of file names in the Dired buffer.
-If no marked file could be found, insert or hide thumbnails on the
-current line. ARG, if non-nil, specifies the files to use instead
-of the marked files. If ARG is an integer, use the next ARG (or
-previous -ARG, if ARG<0) files."
+ "Toggle thumbnails in front of marked file names in the Dired buffer.
+If no file is marked, toggle display of thumbnail on the current file's line.
+ARG, if non-nil (interactively, the prefix argument), specifies the files
+whose thumbnail display to toggle instead of the marked files: if ARG is an
+integer, use the next ARG (or previous -ARG, if ARG<0) files; any other
+value of ARG means toggle thumbnail display of the current line's file."
(interactive "P" dired-mode)
(setq image-dired--generate-thumbs-start (current-time))
(dired-map-over-marks
@@ -91,8 +92,8 @@ previous -ARG, if ARG<0) files."
(defun image-dired-dired-after-readin-hook ()
"Relocate existing thumbnail overlays in Dired buffer after reverting.
-Move them to their corresponding files if they still exist.
-Otherwise, delete overlays.
+Move each overlay to its corresponding file if it still exists.
+Otherwise, delete the overlay.
Used by `image-dired-dired-toggle-marked-thumbs'."
(mapc (lambda (overlay)
(when (overlay-get overlay 'put-image)
@@ -104,7 +105,7 @@ Used by `image-dired-dired-toggle-marked-thumbs'."
(overlays-in (point-min) (point-max))))
(defun image-dired-next-line-and-display ()
- "Move to next Dired line and display thumbnail image."
+ "Move to next Dired line and display its thumbnail image."
(interactive nil dired-mode)
(dired-next-line 1)
(image-dired-display-thumbs t image-dired-dired-append-when-browsing t)
@@ -112,7 +113,7 @@ Used by `image-dired-dired-toggle-marked-thumbs'."
(image-dired-dired-display-properties)))
(defun image-dired-previous-line-and-display ()
- "Move to previous Dired line and display thumbnail image."
+ "Move to previous Dired line and display its thumbnail image."
(interactive nil dired-mode)
(dired-previous-line 1)
(image-dired-display-thumbs t image-dired-dired-append-when-browsing t)
@@ -130,7 +131,7 @@ Used by `image-dired-dired-toggle-marked-thumbs'."
"off")))
(defun image-dired-mark-and-display-next ()
- "Mark current file in Dired and display next thumbnail image."
+ "Mark current file in Dired and display the next thumbnail image."
(interactive nil dired-mode)
(dired-mark 1)
(image-dired-display-thumbs t image-dired-dired-append-when-browsing t)
@@ -148,7 +149,7 @@ Used by `image-dired-dired-toggle-marked-thumbs'."
"off")))
(defun image-dired-track-thumbnail ()
- "Track current Dired file's thumb in `image-dired-thumbnail-buffer'.
+ "Move to thumbnail of the current Dired file in
`image-dired-thumbnail-buffer'.
This is almost the same as what `image-dired-track-original-file' does,
but the other way around."
(let ((file (dired-get-filename))
@@ -170,18 +171,18 @@ but the other way around."
(image-dired--update-header-line))))))
(defun image-dired-dired-next-line (&optional arg)
- "Call `dired-next-line', then track thumbnail.
+ "Call `dired-next-line', while tracking the file's thumbnail.
This can safely replace `dired-next-line'.
-With prefix argument, move ARG lines."
+With prefix argument ARG, move that many lines."
(interactive "P" dired-mode)
(dired-next-line (or arg 1))
(if image-dired-track-movement
(image-dired-track-thumbnail)))
(defun image-dired-dired-previous-line (&optional arg)
- "Call `dired-previous-line', then track thumbnail.
+ "Call `dired-previous-line', while tracking the file's thumbnail.
This can safely replace `dired-previous-line'.
-With prefix argument, move ARG lines."
+With prefix argument ARG, move that many lines."
(interactive "P" dired-mode)
(dired-previous-line (or arg 1))
(if image-dired-track-movement
@@ -307,7 +308,8 @@ With prefix argument ARG, create thumbnails even if they
already exist
;;;###autoload
(defun image-dired-dired-display-external ()
- "Display file at point using an external viewer."
+ "Display file at point using an external viewer.
+The viewer is specified by the value of `image-dired-external-viewer'."
(interactive nil dired-mode)
(let ((file (dired-get-filename)))
(start-process "image-dired-external" nil
@@ -323,15 +325,15 @@ See documentation for `image-dired-display-image' for
more information."
(defun image-dired-copy-with-exif-file-name ()
"Copy file with unique name to main image directory.
-Copy current or all marked files in Dired to a new file in your
-main image directory, using a file name generated by
+Copy current or all files marked in Dired to new file(s) in your
+main image directory, using file name(s) generated by
`image-dired-get-exif-file-name'. A typical usage for this if when
copying images from a digital camera into the image directory.
- Typically, you would open up the folder with the incoming
+Typically, you would open up the folder with the incoming
digital images, mark the files to be copied, and execute this
-function. The result is a couple of new files in
-`image-dired-main-image-directory' called
+command. The result is one or more new files in
+`image-dired-main-image-directory', named like
2005_05_08_12_52_00_dscn0319.jpg,
2005_05_08_14_27_45_dscn0320.jpg etc."
(interactive nil dired-mode)
@@ -350,11 +352,11 @@ function. The result is a couple of new files in
;;;###autoload
(defun image-dired-mark-tagged-files (regexp)
- "Use REGEXP to mark files with matching tag.
+ "Mark files whose tag matches REGEXP.
A `tag' is a keyword, a piece of meta data, associated with an
image file and stored in image-dired's database file. This command
-lets you input a regexp and this will be matched against all tags
-on all image files in the database file. The files that have a
+prompts for a regexp, and then matches it against all the tags
+of all the image files in the database file. The files that have a
matching tag will be marked in the Dired buffer."
(interactive "sMark tagged files (regexp): " dired-mode)
(image-dired-sane-db-file)
@@ -386,7 +388,7 @@ matching tag will be marked in the Dired buffer."
(message "%d files with matching tag marked" hits)))
(defun image-dired-dired-display-properties ()
- "Display properties for Dired file in the echo area."
+ "Show in the echo area the image-related properties of a file in Dired
buffer."
(interactive nil dired-mode)
(let* ((file-name (dired-get-filename))
(dired-buf (buffer-name (current-buffer)))
@@ -405,8 +407,4 @@ matching tag will be marked in the Dired buffer."
(provide 'image-dired-dired)
-;; Local Variables:
-;; nameless-current-name: "image-dired"
-;; End:
-
;;; image-dired-dired.el ends here
diff --git a/lisp/image/image-dired-external.el
b/lisp/image/image-dired-external.el
index b3ee4b36ad3..9f35e17a7e6 100644
--- a/lisp/image/image-dired-external.el
+++ b/lisp/image/image-dired-external.el
@@ -86,15 +86,15 @@ using the NeuQuant algorithm."
(if (executable-find "pngquant")
'("--ext" "-nq8.png" "%t") ; same extension as "pngnq"
'("-f" "%t"))
- "Arguments to pass `image-dired-cmd-pngnq-program'.
-Available format specifiers are the same as in
+ "Arguments to pass to `image-dired-cmd-pngnq-program'.
+Value can use the same format specifiers as in
`image-dired-cmd-create-thumbnail-options'."
:type '(repeat (string :tag "Argument"))
:version "29.1")
(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush")
"The file name of the `pngcrush' program.
-It optimizes the compression of PNG images. Also it adds PNG textual chunks
+It optimizes the compression of PNG images. It also adds PNG textual chunks
with the information required by the Thumbnail Managing Standard."
:type '(choice (const :tag "Not Set" nil) file))
@@ -110,7 +110,7 @@ with the information required by the Thumbnail Managing
Standard."
"-text" "b" "Thumb::URI" "file://%f"
"%q" "%t")
"Arguments for `image-dired-cmd-pngcrush-program'.
-The available %-format specifiers are the same as in
+The value can use the same %-format specifiers as in
`image-dired-cmd-create-thumbnail-options', with \"%q\" for a
temporary file name (typically generated by pnqnq)."
:version "26.1"
@@ -123,7 +123,7 @@ temporary file name (typically generated by pnqnq)."
(defcustom image-dired-cmd-optipng-options '("-o5" "%t")
"Arguments passed to `image-dired-cmd-optipng-program'.
-Available format specifiers are described in
+The value can use format specifiers described in
`image-dired-cmd-create-thumbnail-options'."
:version "26.1"
:type '(repeat (string :tag "Argument"))
@@ -139,14 +139,14 @@ Available format specifiers are described in
"-thumbnail" "%wx%h>" "png:%t")))
(if (executable-find "gm") (cons "convert" opts) opts))
"Options for creating thumbnails according to the Thumbnail Managing
Standard.
-The available %-format specifiers are the same as in
+The value can use the same %-format specifiers as in
`image-dired-cmd-create-thumbnail-options', with \"%m\" for file
modification time."
:type '(repeat (string :tag "Argument"))
:version "29.1")
(defcustom image-dired-cmd-rotate-original-program "jpegtran"
- "Executable used to rotate original image.
+ "Executable program used to rotate original image.
Used together with `image-dired-cmd-rotate-original-options'."
:type 'file)
@@ -154,11 +154,11 @@ Used together with
`image-dired-cmd-rotate-original-options'."
'("-rotate" "%d" "-copy" "all" "-outfile" "%t" "%o")
"Arguments of command used to rotate original image.
Used with `image-dired-cmd-rotate-original-program'.
-Available format specifiers are: %d which is replaced by the
-number of (positive) degrees to rotate the image, normally 90 or
-270 \(for 90 degrees right and left), %o which is replaced by the
-original image file name and %t which is replaced by
-`image-dired-temp-image-file'."
+The value can use the following format specifiers:
+%d which is replaced by the number of (positive) degrees
+to rotate the image, normally 90 or 270 (for 90 degrees right and left),
+%o which is replaced by the original image file name
+and %t which is replaced by `image-dired-temp-image-file'."
:version "26.1"
:type '(repeat (string :tag "Argument")))
@@ -176,9 +176,10 @@ Used together with
`image-dired-cmd-write-exif-data-options'."
(defcustom image-dired-cmd-write-exif-data-options '("-%t=%v" "%f")
"Arguments of command used to write EXIF data.
Used with `image-dired-cmd-write-exif-data-program'.
-Available format specifiers are: %f which is replaced by
-the image file name, %t which is replaced by the tag name and %v
-which is replaced by the tag value."
+The value can use the following format specifiers are:
+%f which is replaced by the image file name,
+%t which is replaced by the tag name
+and %v which is replaced by the tag value."
:version "26.1"
:type '(repeat (string :tag "Argument")))
@@ -206,7 +207,7 @@ which is replaced by the tag value."
"Time when `display-thumbs' was called.")
(defvar image-dired-queue nil
- "List of items in the queue.
+ "List of items in the Image-Dired queue.
Each item has the form (ORIGINAL-FILE TARGET-FILE).")
(defvar image-dired-queue-active-jobs 0
@@ -214,13 +215,13 @@ Each item has the form (ORIGINAL-FILE TARGET-FILE).")
(defvar image-dired-queue-active-limit (min 4 (max 2 (/ (num-processors) 2)))
"Maximum number of concurrent jobs permitted for generating images.
-Increase at own risk. If you want to experiment with this,
+Increase at your own risk. If you want to experiment with this,
consider setting `image-dired-debug' to a non-nil value to see
the time spent on generating thumbnails. Run `clear-image-cache'
and remove the cached thumbnail files between each trial run.")
(defun image-dired-pngnq-thumb (spec)
- "Quantize thumbnail described by format SPEC with pngnq(1)."
+ "Quantize thumbnail described by format SPEC with command `pngnq'."
(let ((process
(apply #'start-process "image-dired-pngnq" nil
image-dired-cmd-pngnq-program
@@ -243,7 +244,7 @@ and remove the cached thumbnail files between each trial
run.")
process))
(defun image-dired-pngcrush-thumb (spec)
- "Optimize thumbnail described by format SPEC with pngcrush(1)."
+ "Optimize thumbnail described by format SPEC with command `pngcrush'."
;; If pngnq wasn't run, then the THUMB-nq8.png file does not exist.
;; pngcrush needs an infile and outfile, so we just copy THUMB to
;; THUMB-nq8.png and use the latter as a temp file.
@@ -268,7 +269,7 @@ and remove the cached thumbnail files between each trial
run.")
process))
(defun image-dired-optipng-thumb (spec)
- "Optimize thumbnail described by format SPEC with optipng(1)."
+ "Optimize thumbnail described by format SPEC with command `optipng'."
(let ((process
(apply #'start-process "image-dired-optipng" nil
image-dired-cmd-optipng-program
@@ -354,7 +355,8 @@ and remove the cached thumbnail files between each trial
run.")
(defun image-dired-thumb-queue-run ()
"Run a queued job if one exists and not too many jobs are running.
-Queued items live in `image-dired-queue'."
+Queued items live in `image-dired-queue'.
+Number of simultaneous jobs is limited by `image-dired-queue-active-limit'."
(while (and image-dired-queue
(< image-dired-queue-active-jobs
image-dired-queue-active-limit))
@@ -414,7 +416,7 @@ The new file will be named THUMBNAIL-FILE."
The file name should be unique as long as you do not take more than
one picture per second. The original file name is suffixed at the end
for traceability. The format of the returned file name is
-YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from
+YYYY_MM_DD_HH_MM_ss_ORIG_FILE_NAME.jpg. Used from
`image-dired-copy-with-exif-file-name'."
(let (data no-exif-data-found)
(if (not (eq 'jpeg (image-type (expand-file-name file))))
@@ -434,7 +436,7 @@ YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from
(file-name-nondirectory file))))
(defun image-dired-thumbnail-set-image-description ()
- "Set the ImageDescription EXIF tag for the original image.
+ "Set the ImageDescription EXIF tag for the original image at point.
If the image already has a value for this tag, it is used as the
default value at the prompt."
(interactive nil image-dired-thumbnail-mode)
@@ -466,8 +468,4 @@ default value at the prompt."
(provide 'image-dired-external)
-;; Local Variables:
-;; nameless-current-name: "image-dired"
-;; End:
-
;;; image-dired-external.el ends here
diff --git a/lisp/image/image-dired-tags.el b/lisp/image/image-dired-tags.el
index 039a7a6617a..b9c1a811850 100644
--- a/lisp/image/image-dired-tags.el
+++ b/lisp/image/image-dired-tags.el
@@ -39,7 +39,7 @@
(defmacro image-dired--with-db-file (&rest body)
"Run BODY in a temp buffer containing `image-dired-tags-db-file'.
-Return the last form in BODY."
+Return the value of last form in BODY."
(declare (indent 0) (debug t))
`(with-temp-buffer
(if (file-exists-p image-dired-tags-db-file)
@@ -91,7 +91,8 @@ FILE-TAGS is an alist in the following form:
(save-buffer))))
(defun image-dired-remove-tag (files tag)
- "For all FILES, remove TAG from the image database."
+ "For each file in FILES, remove TAG from the image database.
+FILES can be a name of a single file (a string) or a list of file names."
(image-dired-sane-db-file)
(image-dired--with-db-file
(setq buffer-file-name image-dired-tags-db-file)
@@ -119,7 +120,8 @@ FILE-TAGS is an alist in the following form:
(save-buffer)))
(defun image-dired-list-tags (file)
- "Read all tags for image FILE from the image database."
+ "Read all tags for image FILE from the image database.
+Value is a list of all tags for FILE."
(image-dired-sane-db-file)
(image-dired--with-db-file
(let (end (tags ""))
@@ -136,7 +138,8 @@ FILE-TAGS is an alist in the following form:
;;;###autoload
(defun image-dired-tag-files (arg)
- "Tag marked file(s) in Dired. With prefix ARG, tag file at point."
+ "Tag file(s) which are marked in a Dired buffer.
+With prefix ARG, tag the file at point."
(interactive "P" dired-mode)
(let ((tag (completing-read
"Tags to add (separate tags with a semicolon): "
@@ -187,8 +190,7 @@ With prefix argument ARG, remove tag from file at point."
'tags (image-dired-list-tags (image-dired-original-file-name))))))
(defun image-dired-write-comments (file-comments)
- "Write file comments to database.
-Write file comments to one or more files.
+ "Write file comments specified by FILE-COMMENTS comments to database.
FILE-COMMENTS is an alist on the following form:
((FILE . COMMENT) ... )"
(image-dired-sane-db-file)
@@ -224,7 +226,7 @@ FILE-COMMENTS is an alist on the following form:
(save-buffer))))
(defun image-dired-update-property (prop value)
- "Update text property PROP with value VALUE at point."
+ "Set text property PROP of text at point to have the given VALUE."
(let ((inhibit-read-only t))
(put-text-property
(point) (1+ (point))
@@ -378,8 +380,4 @@ tags to their respective image file. Internal function
used by
(provide 'image-dired-tags)
-;; Local Variables:
-;; nameless-current-name: "image-dired"
-;; End:
-
;;; image-dired-tags.el ends here
diff --git a/lisp/image/image-dired-util.el b/lisp/image/image-dired-util.el
index c03f9d2e3d3..a80b3afc0f3 100644
--- a/lisp/image/image-dired-util.el
+++ b/lisp/image/image-dired-util.el
@@ -110,11 +110,11 @@ See also `image-dired-thumbnail-storage'."
(abbreviate-file-name f)))
(defun image-dired-associated-dired-buffer ()
- "Get associated Dired buffer at point."
+ "Get associated Dired buffer for thumbnail at point."
(get-text-property (point) 'associated-dired-buffer))
(defmacro image-dired--with-dired-buffer (&rest body)
- "Run BODY in associated Dired buffer.
+ "Run BODY in the Dired buffer associated with thumbnail at point.
Should be used by commands in `image-dired-thumbnail-mode'."
(declare (indent defun) (debug t))
(let ((file (make-symbol "file"))
@@ -179,8 +179,4 @@ Should be used by commands in `image-dired-thumbnail-mode'."
(provide 'image-dired-util)
-;; Local Variables:
-;; nameless-current-name: "image-dired"
-;; End:
-
;;; image-dired-util.el ends here
diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el
index 0c6fd74392c..6ecb307ce12 100644
--- a/lisp/image/image-dired.el
+++ b/lisp/image/image-dired.el
@@ -167,34 +167,33 @@ to use the Thumbnail Managing Standard; they will be
saved in
There are three ways that Image-Dired can store and generate
thumbnails:
- 1. According to the \"Thumbnail Managing Standard\", which allows
+ 1. According to the Thumbnail Managing Standard, which allows
sharing of thumbnails across different programs. Thumbnails
will be stored in \"$XDG_CACHE_HOME/thumbnails/\"
- Set this user option to one of the following values:
+ Set this user option to one of the following symbols:
- `standard' means use thumbnails sized 128x128.
- `standard-large' means use thumbnails sized 256x256.
- `standard-x-large' means use thumbnails sized 512x512.
- `standard-xx-large' means use thumbnails sized 1024x1024.
- 2. In the Image-Dired specific directory indicated by
+ 2. In the Image-Dired specific directory, as indicated by
`image-dired-dir'.
- Set this user option to `image-dired' to use it (or
- `use-image-dired-dir', which means the same thing for
- backwards-compatibility reasons).
+ Set this user option to `image-dired' (`use-image-dired-dir'
+ also works, for backward-compatibility reasons).
3. In a subdirectory \".image-dired\" in the same directory
- where the image files are.
+ as the image files.
- Set this user option to `per-directory' to use it.
+ Set this user option to `per-directory'.
-To change the default size of thumbnails with (2) and (3) above,
-customize `image-dired-thumb-size'.
+To control the default size of thumbnails for alternatives (2)
+and (3) above, customize the value of `image-dired-thumb-size'.
With Thumbnail Managing Standard, save thumbnails in the PNG
-format, as mandated by that standard, and otherwise as JPEG.
+format, as mandated by that standard; otherwise save them as JPEG.
For more information on the Thumbnail Managing Standard, see:
https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html";
@@ -216,13 +215,13 @@
https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html
'image-dired-tags-db-file "29.1")
(defcustom image-dired-tags-db-file
(expand-file-name ".image-dired_db" image-dired-dir)
- "Database file where file names and their associated tags are stored."
+ "Database file where image-dired file names and associated tags are stored."
:type 'file)
(defcustom image-dired-rotate-original-ask-before-overwrite t
- "Confirm overwrite of original file after rotate operation.
+ "Confirm overwriting of original file after image-rotate operation.
If non-nil, ask user for confirmation before overwriting the
-original file with `image-dired-temp-rotate-image-file'."
+original image file by `image-dired-temp-rotate-image-file'."
:type 'boolean)
(defcustom image-dired-thumb-size
@@ -261,11 +260,12 @@ deletion."
(defcustom image-dired-line-up-method 'dynamic
"Default method for line-up of thumbnails in thumbnail buffer.
-Used by `image-dired-display-thumbs' and other functions that needs
-to line-up thumbnails. Dynamic means to use the available width of
-the window containing the thumbnail buffer, Fixed means to use
-`image-dired-thumbs-per-row', Interactive is for asking the user,
-and No line-up means that no automatic line-up will be done."
+Used by `image-dired-display-thumbs' and other functions that need
+to line-up thumbnails. The value `dynamic' means to use the
+available width of the window containing the thumbnail buffer,
+the value `fixed' means to use `image-dired-thumbs-per-row',
+the value `interactive' means ask the user, and the
+value `none' means that no automatic line-up will be done."
:type '(choice :tag "Default line-up method"
(const :tag "Dynamic" dynamic)
(const :tag "Fixed" fixed)
@@ -277,8 +277,8 @@ and No line-up means that no automatic line-up will be
done."
:type 'natnum)
(defcustom image-dired-track-movement t
- "The current state of the tracking and mirroring.
-For more information, see the documentation for
+ "The current state of the Image-Dired tracking and mirroring of thumbnails.
+For more information, see the documentation of
`image-dired-toggle-movement-tracking'."
:type 'boolean)
@@ -286,14 +286,14 @@ For more information, see the documentation for
"Display format for thumbnail properties.
This is used for the header line in the Image-Dired buffer.
-The following %-specs are replaced by `format-spec' before
+The following %-specs in the value are replaced by `format-spec' before
displaying:
\"%f\" The file name (without a directory) of the
original image file.
\"%n\" The number of this image out of the total (e.g. 1/10).
\"%b\" The associated Dired buffer name.
- \"%d\" The name of the directory that the file is in.
+ \"%d\" The name of the file's directory.
\"%s\" The image file size.
\"%t\" The list of tags (from the Image-Dired database).
\"%c\" The comment (from the Image-Dired database)."
@@ -310,9 +310,9 @@ displaying:
((executable-find "xli") "xli")
((executable-find "qiv") "qiv -t")
((executable-find "xloadimage") "xloadimage"))
- "Name of external viewer.
-Including parameters. Used when displaying original image from
-`image-dired-thumbnail-mode'."
+ "Shell command to invoke the external image viewer program.
+Should include command-line arguments if needed. Used when displaying
+original image from `image-dired-thumbnail-mode'."
:version "29.1"
:type '(choice string
(const :tag "Not Set" nil)))
@@ -325,14 +325,14 @@ Used by `image-dired-copy-with-exif-file-name'."
:version "29.1")
(defcustom image-dired-show-all-from-dir-max-files 1000
- "Maximum number of files in directory before prompting.
+ "Maximum number of files in directory to show before prompting.
-If there are more image files than this in a selected directory,
+If there are more image files in a selected directory than this number,
the `image-dired-show-all-from-dir' command will ask for
confirmation before creating the thumbnail buffer. If this
-variable is nil, it will never ask."
+variable is nil, never ask."
:type '(choice integer
- (const :tag "Disable warning" nil))
+ (const :tag "Don't ask for confirmation" nil))
:version "29.1")
(defcustom image-dired-marking-shows-next t
@@ -401,7 +401,7 @@ This affects the following commands:
(image-file-name-regexp)))
(defun image-dired-insert-image (file type relief margin)
- "Insert image FILE of image TYPE, using RELIEF and MARGIN, at point."
+ "Insert at point image FILE of image TYPE, using RELIEF and MARGIN."
(let ((i `(image :type ,type
:file ,file
:relief ,relief
@@ -495,9 +495,9 @@ by exactly one space or one newline character."
Convenience command that:
- - Opens Dired in folder DIR
- - Splits windows in most useful (?) way
- - Sets `truncate-lines' to t
+ - opens Dired in folder DIR;
+ - splits windows in most useful (?) way; and
+ - sets `truncate-lines' to t
After the command has finished, you would typically mark some
image files in Dired and type
@@ -525,7 +525,7 @@ calling `image-dired-restore-window-configuration'."
(other-window -2)))))
(defun image-dired-restore-window-configuration ()
- "Restore window configuration.
+ "Restore window configuration altered by Image-Dired.
Restore any changes to the window configuration made by calling
`image-dired-dired-with-window-configuration'."
(interactive nil image-dired-thumbnail-mode)
@@ -546,7 +546,7 @@ Restore any changes to the window configuration made by
calling
(t
(image-dired-line-up-dynamic))))
-(defvar-local image-dired--number-of-thumbnails nil)
+(defvar-local image-dired--number-of-thumbnails 0)
;;;###autoload
(defun image-dired-display-thumbs (&optional arg append do-not-pop)
@@ -585,14 +585,17 @@ thumbnail buffer to be selected."
(erase-buffer))
(goto-char (point-max)))
(dolist (file files)
- (let ((thumb (image-dired--get-create-thumbnail-file file)))
+ (when (string-match-p (image-dired--file-name-regexp) file)
(image-dired-insert-thumbnail
- thumb file dired-buf
+ (image-dired--get-create-thumbnail-file file) file dired-buf
(cl-incf image-dired--number-of-thumbnails)))))
- (if do-not-pop
- (display-buffer buf)
- (pop-to-buffer buf))
- (image-dired--line-up-with-method))))
+ (if (> image-dired--number-of-thumbnails 0)
+ (if do-not-pop
+ (display-buffer buf)
+ (pop-to-buffer buf))
+ (message "No images selected"))
+ (image-dired--line-up-with-method)
+ (image-dired--update-header-line))))
;;;###autoload
(defun image-dired-show-all-from-dir (dir)
@@ -632,7 +635,7 @@ never ask for confirmation."
;;; Movement tracking
(defun image-dired-track-original-file ()
- "Track the original file in the associated Dired buffer.
+ "Track in the associated Dired buffer the file that corresponds to thumbnail.
See `image-dired-toggle-movement-tracking'. Interactive use is
only useful if `image-dired-track-movement' is nil."
(interactive nil image-dired-thumbnail-mode image-dired-image-mode)
@@ -646,8 +649,8 @@ only useful if `image-dired-track-movement' is nil."
(defun image-dired-toggle-movement-tracking ()
"Turn on and off `image-dired-track-movement'.
Tracking of the movements between thumbnail and Dired buffer so that
-they are \"mirrored\" in the dired buffer. When this is on, moving
-around in the thumbnail or dired buffer will find the matching
+the movements are \"mirrored\" in the Dired buffer. When this is on,
+moving around in the thumbnail or Dired buffer will move to the matching
position in the other buffer."
(interactive nil image-dired-thumbnail-mode image-dired-image-mode)
(setq image-dired-track-movement (not image-dired-track-movement))
@@ -751,7 +754,9 @@ On reaching end or beginning of buffer, stop and show a
message."
;;; Header line
(defun image-dired-format-properties-string (buf file image-count props
comment)
- "Format display properties.
+ "Format display properties for Image-Dired.
+The properties are formatted according to specification
+in `image-dired-display-properties-format', which see.
BUF is the associated Dired buffer, FILE is the original image
file name, IMAGE-COUNT is a string like \"N/M\" where N is the
number of this image and M is the total number of images, PROPS
@@ -816,7 +821,7 @@ for. The default is to look for `dired-marker-char'."
(image-dired-dired-file-marked-p dired-del-marker))
(defmacro image-dired--on-file-in-dired-buffer (&rest body)
- "Run BODY with point on file at point in Dired buffer.
+ "Run BODY in associated Dired buffer with point on current file's line.
Should be called from commands in `image-dired-thumbnail-mode'."
(declare (indent defun) (debug t))
`(if-let ((file-name (image-dired-original-file-name)))
@@ -1192,7 +1197,8 @@ Ask user how many thumbnails should be displayed per row."
;;; Display image from thumbnail buffer
(defun image-dired-thumbnail-display-external ()
- "Display original image for thumbnail at point using external viewer."
+ "Display original image for thumbnail at point using external viewer.
+The viewer command is specified by `image-dired-external-viewer'."
(interactive nil image-dired-thumbnail-mode)
(let ((file (image-dired-original-file-name)))
(if (not (image-dired-image-at-point-p))
@@ -1205,7 +1211,7 @@ Ask user how many thumbnails should be displayed per row."
(defun image-dired-display-image (file &optional _ignored)
"Display image FILE in the image buffer window.
-If it is an image, the window will use `image-dired-image-mode'
+If FILE is an image, the window will use `image-dired-image-mode'
which is based on `image-mode'."
(declare (advertised-calling-convention (file) "29.1"))
(setq file (expand-file-name file))
@@ -1293,7 +1299,7 @@ overwritten. This confirmation can be turned off using
(defun image-dired-copy-filename-as-kill (&optional arg)
"Copy names of marked (or next ARG) files into the kill ring.
-This works as `dired-copy-filename-as-kill' (which see)."
+This works like `dired-copy-filename-as-kill' (which see)."
(interactive "P" image-dired-thumbnail-mode)
(image-dired--with-dired-buffer
(dired-copy-filename-as-kill arg)))
diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el
index c497e1f429b..a2f175e4628 100644
--- a/lisp/image/wallpaper.el
+++ b/lisp/image/wallpaper.el
@@ -109,7 +109,7 @@ COMMAND is the executable to run to set the wallpaper.
ARGS is the default list of command line arguments for COMMAND.
PREDICATE is a function that will be called without any arguments
-and returns non-nil if this setter should be used.
+and should return non-nil if this setter should be used.
INIT-ACTION is a function that will be called without any
arguments before trying to set the wallpaper.
@@ -304,7 +304,7 @@ order in which they appear.")
(throw 'found setter))))))))
(defun wallpaper--find-command ()
- "Return a valid command to set the wallpaper in this environment."
+ "Return the appropriate command to set the wallpaper."
(when-let ((setter (wallpaper--find-setter)))
(wallpaper-setter-command setter)))
@@ -437,7 +437,7 @@ See also `wallpaper-default-width'.")
On a graphical display, try using the same monitor as the current
frame.
On a non-graphical display, try to get the name by connecting to
-the display server directly, and run \"xrandr\" if that doesn't
+the display server directly, or run \"xrandr\" if that doesn't
work. Prompt for the monitor name if neither method works.
This function is meaningful only on X and is used only there."
@@ -469,7 +469,7 @@ This function is meaningful only on X and is used only
there."
(read-string (format-prompt "Monitor name" nil)))))
(defun wallpaper--format-arg (format file)
- "Format a `wallpaper-command-args' argument ARG.
+ "Format a `wallpaper-command-args' argument ARG using FORMAT.
FILE is the image file name."
(format-spec
format
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 25a02004570..fd23a65c7b3 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -756,9 +756,11 @@ Returns t for rescan and otherwise an element or
subelement of INDEX-ALIST."
(setq index-alist (imenu--split-submenus index-alist))
(let* ((menu (imenu--split-menu index-alist (or title (buffer-name))))
(map (imenu--create-keymap (car menu)
- (cdr (if (< 1 (length (cdr menu)))
- menu
- (car (cdr menu)))))))
+ (cdr (if (and (null (cddr menu))
+ (stringp (caadr menu))
+ (consp (cdadr menu)))
+ (cadr menu)
+ menu)))))
(popup-menu map event)))
(defun imenu-choose-buffer-index (&optional prompt alist)
@@ -854,13 +856,12 @@ A trivial interface to `imenu-add-to-menubar' suitable
for use in a hook."
(buffer-name)))
(menu1 (imenu--create-keymap
(car menu)
- (cdr (if (or (< 1 (length (cdr menu)))
- ;; Have we a non-nested single entry?
- (atom (cdadr menu))
- (atom (cadadr menu)))
- menu
- (car (cdr menu))))
- 'imenu--menubar-select)))
+ (cdr (if (and (null (cddr menu))
+ (stringp (caadr menu))
+ (consp (cdadr menu)))
+ (cadr menu)
+ menu))
+ 'imenu--menubar-select)))
(setcdr imenu--menubar-keymap (cdr menu1)))))))
(defun imenu--menubar-select (item)
diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el
index 2d17cf639b0..fec3e637f0c 100644
--- a/lisp/international/emoji.el
+++ b/lisp/international/emoji.el
@@ -68,38 +68,86 @@ representing names. For instance:
(defvar emoji--all-bases nil)
(defvar emoji--derived nil)
(defvar emoji--names (make-hash-table :test #'equal))
-(defvar emoji--done-derived nil)
(define-multisession-variable emoji--recent (list "😀" "😖"))
(defvar emoji--insert-buffer)
-;;;###autoload
-(defun emoji-insert ()
+;;;###autoload (autoload 'emoji-insert "emoji" nil t)
+(transient-define-prefix emoji-insert ()
"Choose and insert an emoji glyph."
+ :variable-pitch t
+ [:class transient-columns
+ :setup-children emoji--setup-suffixes
+ :description emoji--group-description]
(interactive "*")
(emoji--init)
- (unless (fboundp 'emoji--command-Emoji)
- (emoji--define-transient))
- (funcall (intern "emoji--command-Emoji")))
+ (emoji--setup-prefix 'emoji-insert "Emoji" nil
+ `(("Recent" ,@(multisession-value emoji--recent))
+ ,@emoji--labels)))
-;;;###autoload
-(defun emoji-recent ()
+;;;###autoload (autoload 'emoji-recent "emoji" nil t)
+(transient-define-prefix emoji-recent ()
"Choose and insert one of the recently-used emoji glyphs."
+ :variable-pitch t
+ [:class transient-columns
+ :setup-children emoji--setup-suffixes
+ :description emoji--group-description]
(interactive "*")
(emoji--init)
- (unless (fboundp 'emoji--command-Emoji)
- (emoji--define-transient))
- (funcall (emoji--define-transient
- (cons "Recent" (multisession-value emoji--recent)) t)))
+ (emoji--setup-prefix 'emoji-recent "Recent" t
+ (multisession-value emoji--recent)))
-;;;###autoload
-(defun emoji-search ()
+;;;###autoload (autoload 'emoji-search "emoji" nil t)
+(transient-define-prefix emoji-search ()
"Choose and insert an emoji glyph by typing its Unicode name.
This command prompts for an emoji name, with completion, and
inserts it. It recognizes the Unicode Standard names of emoji,
and also consults the `emoji-alternate-names' alist."
+ :variable-pitch t
+ [:class transient-columns
+ :setup-children emoji--setup-suffixes
+ :description emoji--group-description]
(interactive "*")
(emoji--init)
- (emoji--choose-emoji))
+ (pcase-let ((`(,glyph . ,derived) (emoji--read-emoji)))
+ (if derived
+ (emoji--setup-prefix 'emoji-search "Choose Emoji"
+ (list glyph)
+ (cons glyph derived))
+ (emoji--add-recent glyph)
+ (insert glyph))))
+
+(defclass emoji--narrow (transient-suffix)
+ ((title :initarg :title)
+ (done-derived :initarg :done-derived)
+ (children :initarg :children)))
+
+(defun emoji--setup-prefix (command title done-derived spec)
+ (transient-setup
+ command nil nil
+ :scope (if (eq transient-current-command command)
+ (cons (oref (transient-suffix-object) title)
+ (oref (transient-suffix-object) done-derived))
+ (cons title done-derived))
+ :value (if (eq transient-current-command command)
+ (oref (transient-suffix-object) children)
+ spec)))
+
+(defun emoji--setup-suffixes (_)
+ (transient-parse-suffixes
+ (oref transient--prefix command)
+ (pcase-let ((`(,title . ,done-derived) (oref transient--prefix scope)))
+ (emoji--layout (oref transient--prefix command) title
+ (oref transient--prefix value) done-derived))))
+
+(defun emoji--group-description ()
+ (car (oref transient--prefix scope)))
+
+(transient-define-suffix emoji-insert-glyph ()
+ "Insert the emoji you selected."
+ (interactive nil not-a-mode)
+ (let ((glyph (oref (transient-suffix-object) description)))
+ (emoji--add-recent glyph)
+ (insert glyph)))
;;;###autoload
(defun emoji-list ()
@@ -179,11 +227,10 @@ the name is not known."
'help-echo (emoji--name glyph))))
(insert "\n\n"))))
-(defun emoji--fontify-glyph (glyph &optional inhibit-derived)
+(defun emoji--fontify-glyph (glyph &optional done-derived)
(propertize glyph 'face
- (if (and (not inhibit-derived)
- (or (null emoji--done-derived)
- (not (gethash glyph emoji--done-derived)))
+ (if (and (not (or (eq done-derived t)
+ (member glyph done-derived)))
(gethash glyph emoji--derived))
;; If this emoji has derivations, use a special face
;; to tell the user.
@@ -206,33 +253,30 @@ the name is not known."
:interactive nil
(setq-local truncate-lines t))
-(defun emoji-list-select (event)
+;;;###autoload (autoload 'emoji-list-select "emoji" nil t)
+(transient-define-prefix emoji-list-select (event)
"Select the emoji under point."
+ :variable-pitch t
+ [:class transient-columns
+ :setup-children emoji--setup-suffixes
+ :description emoji--group-description]
(interactive (list last-nonmenu-event) emoji-list-mode)
(mouse-set-point event)
(let ((glyph (get-text-property (point) 'emoji-glyph)))
(unless glyph
(error "No emoji under point"))
- (let ((derived (gethash glyph emoji--derived))
- (end-func
- (lambda ()
- (let ((buf emoji--insert-buffer))
- (quit-window)
- (if (buffer-live-p buf)
- (switch-to-buffer buf)
- (error "Buffer disappeared"))))))
- (if (not derived)
- ;; Glyph without derivations.
- (progn
- (emoji--add-recent glyph)
- (funcall end-func)
- (insert glyph))
- ;; Pop up a transient to choose between derivations.
- (let ((emoji--done-derived (make-hash-table :test #'equal)))
- (setf (gethash glyph emoji--done-derived) t)
- (funcall
- (emoji--define-transient (cons "Choose Emoji" (cons glyph derived))
- nil end-func)))))))
+ (let ((buf emoji--insert-buffer))
+ (quit-window)
+ (if (buffer-live-p buf)
+ (switch-to-buffer buf)
+ (error "Buffer disappeared")))
+ (let ((derived (gethash glyph emoji--derived)))
+ (if derived
+ (emoji--setup-prefix 'emoji-list-select "Choose Emoji"
+ (list glyph)
+ (cons glyph derived))
+ (emoji--add-recent glyph)
+ (insert glyph)))))
(defun emoji-list-help ()
"Display the name of the emoji at point."
@@ -245,6 +289,7 @@ the name is not known."
(error "Emoji name is unknown")
(message "%s" name)))))
+;;;###autoload
(defun emoji--init (&optional force inhibit-adjust)
(when (or (not emoji--labels)
force)
@@ -475,97 +520,51 @@ the name is not known."
(setq parent elem))
(nconc elem (list glyph)))))
-(defun emoji--define-transient (&optional alist inhibit-derived
- end-function)
- (unless alist
- (setq alist (cons "Emoji" emoji--labels)))
- (let* ((mname (pop alist))
- (name (intern (format "emoji--command-%s" mname)))
- (emoji--done-derived (or emoji--done-derived
- (make-hash-table :test #'equal)))
- (has-subs (consp (cadr alist)))
- (layout
- (if has-subs
- ;; Define sub-maps.
- (cl-loop for entry in
- (emoji--compute-prefix
- (if (equal mname "Emoji")
- (cons (list "Recent") alist)
- alist))
- collect (list
- (car entry)
- (emoji--compute-name (cdr entry))
- (if (equal (cadr entry) "Recent")
- (emoji--recent-transient end-function)
- (emoji--define-transient
- (cons (concat mname " > " (cadr entry))
- (cddr entry))))))
- ;; Insert an emoji.
- (cl-loop for glyph in alist
- for i in (append (number-sequence ?a ?z)
- (number-sequence ?A ?Z)
- (number-sequence ?0 ?9)
- (number-sequence ?! ?/))
- collect (let ((this-glyph glyph))
- (list
- (string i)
- (emoji--fontify-glyph
- glyph inhibit-derived)
- (let ((derived
- (and (not inhibit-derived)
- (not (gethash glyph
- emoji--done-derived))
- (gethash glyph emoji--derived))))
- (if derived
- ;; We have a derived glyph, so add
- ;; another level.
- (progn
- (setf (gethash glyph
- emoji--done-derived)
- t)
- (emoji--define-transient
- (cons (concat mname " " glyph)
- (cons glyph derived))
- t end-function))
- ;; Insert the emoji.
- (lambda ()
- (interactive nil not-a-mode)
- ;; Allow switching to the correct
- ;; buffer.
- (when end-function
- (funcall end-function))
- (emoji--add-recent this-glyph)
- (insert this-glyph)))))))))
- (args (apply #'vector mname
- (emoji--columnize layout
- (if has-subs 2 8)))))
- ;; There's probably a better way to do this...
- (setf (symbol-function name)
- (lambda ()
- (interactive nil not-a-mode)
- (transient-setup name)))
- (pcase-let ((`(,class ,slots ,suffixes ,docstr ,_body)
- (transient--expand-define-args (list args))))
- (put name 'interactive-only t)
- (put name 'function-documentation docstr)
- (put name 'transient--prefix
- (apply (or class 'transient-prefix) :command name
- (cons :variable-pitch (cons t slots))))
- (put name 'transient--layout
- (transient-parse-suffixes name suffixes)))
- name))
-
-(defun emoji--recent-transient (end-function)
- "Create a function to display a dynamically generated menu."
- (lambda ()
- (interactive)
- (funcall (emoji--define-transient
- (cons "Recent" (multisession-value emoji--recent))
- t end-function))))
+(defun emoji--layout (command title spec done-derived)
+ (let ((has-subs (consp (cadr spec))))
+ (emoji--columnize
+ (if has-subs
+ (cl-loop for (key desc . glyphs) in (emoji--compute-prefix spec)
+ collect
+ (list key
+ (emoji--compute-name (cons desc glyphs))
+ command
+ :class 'emoji--narrow
+ :title (concat title " > " desc)
+ :done-derived (or (string-suffix-p "Recent" desc)
+ done-derived)
+ :children glyphs))
+ (cl-loop for glyph in spec
+ for char in (emoji--char-sequence)
+ for key = (string char)
+ for derived = (and (not (or (eq done-derived t)
+ (member glyph done-derived)))
+ (gethash glyph emoji--derived))
+ collect
+ (if derived
+ (list key
+ (emoji--fontify-glyph glyph done-derived)
+ command
+ :class 'emoji--narrow
+ :title (concat title " " glyph)
+ :done-derived (or (eq done-derived t)
+ (cons glyph done-derived))
+ :children (cons glyph derived))
+ (list key
+ (emoji--fontify-glyph glyph done-derived)
+ 'emoji-insert-glyph))))
+ (if has-subs 2 8))))
+
+(defun emoji--char-sequence ()
+ (append (number-sequence ?a ?z)
+ (number-sequence ?A ?Z)
+ (number-sequence ?0 ?9)
+ (number-sequence ?! ?/)))
(defun emoji--add-recent (glyph)
"Add GLYPH to the set of recently used emojis."
(let ((recent (multisession-value emoji--recent)))
+ (set-text-properties 0 (length glyph) nil glyph)
(setq recent (delete glyph recent))
(push glyph recent)
;; Shorten the list.
@@ -638,7 +637,7 @@ We prefer the earliest unique letter."
collect (cons (concat (string prefix) "-group")
(seq-take bit 77))))))))
-(defun emoji--choose-emoji ()
+(defun emoji--read-emoji ()
;; Use the list of names.
(let* ((table
(if (not emoji-alternate-names)
@@ -678,21 +677,10 @@ We prefer the earliest unique letter."
(complete-with-action action table string pred)))
nil t)))
(when (cl-plusp (length name))
- (let* ((glyph (if emoji-alternate-names
- (cadr (split-string name "\t"))
- (gethash name emoji--all-bases)))
- (derived (gethash glyph emoji--derived)))
- (if (not derived)
- ;; Simple glyph with no derivations.
- (progn
- (emoji--add-recent glyph)
- (insert glyph))
- ;; Choose a derived version.
- (let ((emoji--done-derived (make-hash-table :test #'equal)))
- (setf (gethash glyph emoji--done-derived) t)
- (funcall
- (emoji--define-transient
- (cons "Choose Emoji" (cons glyph derived))))))))))
+ (let ((glyph (if emoji-alternate-names
+ (cadr (split-string name "\t"))
+ (gethash name emoji--all-bases))))
+ (cons glyph (gethash glyph emoji--derived))))))
(defvar-keymap emoji-zoom-map
"+" #'emoji-zoom-increase
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 979e685e32a..a27aaf9e522 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1734,6 +1734,20 @@ included; callers should bind `case-fold-search' to t."
:version "27.1"
:group 'processes)
+;; (describe-char-fold-equivalences ?:)
+;; The last entry is taken from history.
+(defcustom password-colon-equivalents
+ '(?\u003a ; ?\N{COLON}
+ ?\uff1a ; ?\N{FULLWIDTH COLON}
+ ?\ufe55 ; ?\N{SMALL COLON}
+ ?\ufe13 ; ?\N{PRESENTATION FORM FOR VERTICAL COLON}
+ ?\u17d6 ; ?\N{KHMER SIGN CAMNUC PII KUUH}
+ )
+ "List of characters equivalent to trailing colon in \"password\" prompts."
+ :type '(repeat character)
+ :version "30.1"
+ :group 'processes)
+
;; The old code-pages library is obsoleted by coding systems based on
;; the charsets defined in this file but might be required by user
;; code.
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 52019697ad7..25b90b49c8f 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -2544,6 +2544,7 @@ This function is intended to be added to
`auto-coding-functions'."
;; coding-system-equal, since it isn't a
;; coding-system. So test that up front.
(not (equal sym-type 'charset))
+ (not (equal bfcs-type 'charset))
(coding-system-equal 'utf-8 sym-type)
(coding-system-equal 'utf-8 bfcs-type))
buffer-file-coding-system
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 22e27764127..094e02d605e 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2774,25 +2774,22 @@ With argument, add COUNT copies of the character."
(mapconcat
'isearch-text-char-description
string ""))))))))
-(defvar emoji--derived)
+(autoload 'emoji--read-emoji "emoji")
(defun isearch-emoji-by-name (&optional count)
"Read an Emoji name and add it to the search string COUNT times.
COUNT (interactively, the prefix argument) defaults to 1.
The command accepts Unicode names like \"smiling face\" or
\"heart with arrow\", and completion is available."
(interactive "p")
+ (emoji--init)
(with-isearch-suspended
- (let ((emoji (with-temp-buffer
- ;; Derived emoji not supported yet (bug#60740).
- ;; So first load `emoji--labels', then `emoji--init'
- ;; will not fill `emoji--derived' that is set
- ;; to an empty hash table below.
- (ignore-errors (require 'emoji-labels))
- (let ((emoji--derived (make-hash-table :test #'equal)))
- (emoji-search))
- (if (and (integerp count) (> count 1))
- (apply 'concat (make-list count (buffer-string)))
- (buffer-string)))))
+ (pcase-let* ((`(,glyph . ,derived) (emoji--read-emoji))
+ (emoji (if derived
+ (completing-read "Select derivation: "
+ (cons glyph derived) nil t)
+ glyph)))
+ (when (and (integerp count) (> count 1))
+ (setq emoji (apply 'concat (make-list count emoji))))
(when emoji
(setq isearch-new-string (concat isearch-string emoji)
isearch-new-message (concat isearch-message
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 201a49cef8c..4f02639ffe2 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -65,7 +65,7 @@ DEFINITION is anything that can be a key's definition:
(setq definition (key-parse definition)))
(define-key keymap (key-parse key) definition))
-(defun keymap-global-set (key command)
+(defun keymap-global-set (key command &optional interactive)
"Give KEY a global binding as COMMAND.
COMMAND is the command definition to use; usually it is
a symbol naming an interactively-callable function.
@@ -75,13 +75,14 @@ KEY is a string that satisfies `key-valid-p'.
Note that if KEY has a local binding in the current buffer,
that local binding will continue to shadow any global binding
that you make with this function."
- (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
- (interactive "KSet key globally:\nCSet key %s globally to command: ")
- (unless (stringp key)
+ (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))
+ (advertised-calling-convention (key command) "29.1"))
+ (interactive "KSet key globally: \nCSet key %s globally to command: \np")
+ (when interactive
(setq key (key-description key)))
(keymap-set (current-global-map) key command))
-(defun keymap-local-set (key command)
+(defun keymap-local-set (key command &optional interactive)
"Give KEY a local binding as COMMAND.
COMMAND is the command definition to use; usually it is
a symbol naming an interactively-callable function.
@@ -90,12 +91,13 @@ KEY is a string that satisfies `key-valid-p'.
The binding goes in the current buffer's local map, which in most
cases is shared with all other buffers in the same major mode."
- (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
- (interactive "KSet key locally:\nCSet key %s locally to command: ")
+ (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))
+ (advertised-calling-convention (key command) "29.1"))
+ (interactive "KSet key locally: \nCSet key %s locally to command: \np")
(let ((map (current-local-map)))
(unless map
(use-local-map (setq map (make-sparse-keymap))))
- (unless (stringp key)
+ (when interactive
(setq key (key-description key)))
(keymap-set map key command)))
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 94d8794bd23..64aa7a27bde 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -376,11 +376,23 @@ and `kmacro-counter-format'.")
(defvar kmacro-view-last-item nil)
(defvar kmacro-view-item-no 0)
+(defun kmacro--to-vector (object)
+ "Normalize an old-style key sequence to the vector form."
+ (if (not (stringp object))
+ object
+ (let ((vec (string-to-vector object)))
+ (unless (multibyte-string-p object)
+ (dotimes (i (length vec))
+ (let ((k (aref vec i)))
+ (when (> k 127)
+ (setf (aref vec i) (+ k ?\M-\C-@ -128))))))
+ vec)))
(defun kmacro-ring-head ()
"Return pseudo head element in macro ring."
(and last-kbd-macro
- (kmacro last-kbd-macro kmacro-counter kmacro-counter-format-start)))
+ (kmacro (kmacro--to-vector last-kbd-macro)
+ kmacro-counter kmacro-counter-format-start)))
(defun kmacro-push-ring (&optional elt)
@@ -839,12 +851,8 @@ KEYS should be a vector or a string that obeys
`key-valid-p'."
(setq format (nth 2 mac))
(setq counter (nth 1 mac))
(setq mac (nth 0 mac)))
- (when (stringp mac)
- ;; `kmacro' interprets a string according to `key-parse'.
- (require 'macros)
- (declare-function macro--string-to-vector "macros")
- (setq mac (macro--string-to-vector mac)))
- (kmacro mac counter format)))
+ ;; `kmacro' interprets a string according to `key-parse'.
+ (kmacro (kmacro--to-vector mac) counter format)))
(defun kmacro-extract-lambda (mac)
"Extract kmacro from a kmacro lambda form."
@@ -860,8 +868,6 @@ KEYS should be a vector or a string that obeys
`key-valid-p'."
(cl-defmethod cl-print-object ((object kmacro) stream)
(princ "#f(kmacro " stream)
- (require 'macros)
- (declare-function macros--insert-vector-macro "macros" (definition))
(let ((vecdef (kmacro--keys object))
(counter (kmacro--counter object))
(format (kmacro--format object)))
@@ -943,20 +949,15 @@ Such a \"function\" cannot be called from Lisp, but it is
a valid editor command
(put symbol 'kmacro t))
-(cl-defstruct (kmacro-register
- (:constructor nil)
- (:constructor kmacro-make-register (macro)))
- macro)
+(cl-defmethod register-val-jump-to ((km kmacro) arg)
+ (funcall km arg)) ;FIXME: η-reduce?
-(cl-defmethod register-val-jump-to ((data kmacro-register) _arg)
- (kmacro-call-macro current-prefix-arg nil nil (kmacro-register-macro data)))
+(cl-defmethod register-val-describe ((km kmacro) _verbose)
+ (princ (format "a keyboard macro:\n %s"
+ (key-description (kmacro--keys km)))))
-(cl-defmethod register-val-describe ((data kmacro-register) _verbose)
- (princ (format "a keyboard macro:\n %s"
- (key-description (kmacro-register-macro data)))))
-
-(cl-defmethod register-val-insert ((data kmacro-register))
- (insert (format-kbd-macro (kmacro-register-macro data))))
+(cl-defmethod register-val-insert ((km kmacro))
+ (insert (key-description (kmacro--keys km))))
(defun kmacro-to-register (r)
"Store the last keyboard macro in register R.
@@ -966,7 +967,7 @@ Interactively, reads the register using
`register-read-with-preview'."
(progn
(or last-kbd-macro (error "No keyboard macro defined"))
(list (register-read-with-preview "Save to register: "))))
- (set-register r (kmacro-make-register last-kbd-macro)))
+ (set-register r (kmacro-ring-head)))
(defun kmacro-view-macro (&optional _arg)
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 73d47804e5d..65b990682c1 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -2780,7 +2780,7 @@ it is disabled.
;;; Generated autoloads from emacs-lisp/byte-opt.el
-(register-definition-prefixes "byte-opt" '("byte-" "disassemble-offset"))
+(register-definition-prefixes "byte-opt" '("byte" "disassemble-offset"))
;;; Generated autoloads from emacs-lisp/bytecomp.el
@@ -2921,7 +2921,7 @@ and corresponding effects.
;;; Generated autoloads from progmodes/c-ts-common.el
-(register-definition-prefixes "c-ts-common" '("c-ts-"))
+(register-definition-prefixes "c-ts-common" '("c-ts-common-"))
;;; Generated autoloads from progmodes/c-ts-mode.el
@@ -7765,6 +7765,9 @@ customize `display-fill-column-indicator-column'. You
can change the
character for the indicator setting `display-fill-column-indicator-character'.
The globalized version is `global-display-fill-column-indicator-mode',
which see.
+This minor mode assumes the buffer uses a fixed-pitch font; if you
+use variable-pitch fonts, the indicators on different lines might
+not appear aligned.
See Info node `Displaying Boundaries' for details.
This is a minor mode. If called interactively, toggle the
@@ -7881,36 +7884,53 @@ Display-Line-Numbers mode.
(fn &optional ARG)" t)
(defvar header-line-indent "" "\
-String to indent at the start if the header line.
-This is used in `header-line-indent-mode', and buffers that have
-this switched on should have a `header-line-format' that look like:
+String of spaces to indent the beginning of header-line due to line numbers.
+This is intended to be used in `header-line-format', and requires
+the `header-line-indent-mode' to be turned on, in order for the width
+of this string to be kept updated when the line-number width changes
+on display. An example of a `header-line-format' that uses this
+variable might look like this:
(\"\" header-line-indent THE-REST...)
+where THE-REST is the format string which produces the actual text
+of the header-line.
Also see `header-line-indent-width'.")
(defvar header-line-indent-width 0 "\
-The width of the current line numbers displayed.
-This is updated when `header-line-indent-mode' is switched on.
-
+The width of the current line number display in the window.
+This is measured in units of the frame's canonical columns.
+This is updated when `header-line-indent-mode' is switched on,
+and is intended for use in `:align-to' display specifications
+that are part of `header-line-format', when portions of header-line
+text should be aligned to respective parts of buffer text.
Also see `header-line-indent'.")
(autoload 'header-line-indent-mode "display-line-numbers" "\
-Mode to indent the header line in `display-line-numbers-mode' buffers.
+Minor mode to help with alignment of header line when line numbers are shown.
-This means that the header line will be kept indented so that it
-has blank space that's as wide as the displayed line numbers in
-the buffer.
+This minor mode should be turned on in buffers which display header-line
+that needs to be aligned with buffer text when `display-line-numbers-mode'
+is turned on in the buffer.
-Buffers that have this switched on should have a
-`header-line-format' that look like:
+Buffers that have this switched on should have a `header-line-format'
+that uses the `header-line-indent' or the `header-line-indent-width'
+variables, which this mode will keep up-to-date with the current
+display of line numbers. For example, a `header-line-format' that
+looks like this:
(\"\" header-line-indent THE-REST...)
-The `header-line-indent-width' variable is also kept updated, and
-has the width of `header-line-format'. This can be used, for
-instance, in `:align-to' specs, like:
+will make sure the text produced by THE-REST (which should be
+a header-line format string) is always indented to be aligned on
+display with the first column of buffer text.
+
+The `header-line-indent-width' variable is also kept updated,
+and can be used, for instance, in `:align-to' specs as part
+of `header-line-format', like this:
(space :align-to (+ header-line-indent-width 10))
+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
@@ -9553,6 +9573,16 @@ displayed." t)
;;; Generated autoloads from eshell/em-extpipe.el
+(defgroup eshell-extpipe nil "\
+Native shell pipelines.
+
+This module lets you construct pipelines that use your operating
+system's shell instead of Eshell's own pipelining support. This
+is especially relevant when executing commands on a remote
+machine using Eshell's Tramp integration: using the remote
+shell's pipelining avoids copying the data which will flow
+through the pipeline to local Emacs buffers and then right back
+again." :tag "External pipelines" :group 'eshell-module)
(register-definition-prefixes "em-extpipe" '("eshell-"))
@@ -9563,12 +9593,12 @@ displayed." t)
;;; Generated autoloads from eshell/em-hist.el
-(register-definition-prefixes "em-hist" '("eshell"))
+(register-definition-prefixes "em-hist" '("em-hist-unload-function" "eshell"))
;;; Generated autoloads from eshell/em-ls.el
-(register-definition-prefixes "em-ls" '("eshell"))
+(register-definition-prefixes "em-ls" '("em-ls-unload-function" "eshell"))
;;; Generated autoloads from eshell/em-pred.el
@@ -9593,7 +9623,7 @@ displayed." t)
;;; Generated autoloads from eshell/em-smart.el
-(register-definition-prefixes "em-smart" '("eshell-"))
+(register-definition-prefixes "em-smart" '("em-smart-unload-hook" "eshell-"))
;;; Generated autoloads from eshell/em-term.el
@@ -9741,15 +9771,9 @@ Emerge two RCS revisions of a file, with another
revision as ancestor.
;;; Generated autoloads from international/emoji.el
-(autoload 'emoji-insert "emoji" "\
-Choose and insert an emoji glyph." t)
-(autoload 'emoji-recent "emoji" "\
-Choose and insert one of the recently-used emoji glyphs." t)
-(autoload 'emoji-search "emoji" "\
-Choose and insert an emoji glyph by typing its Unicode name.
-This command prompts for an emoji name, with completion, and
-inserts it. It recognizes the Unicode Standard names of emoji,
-and also consults the `emoji-alternate-names' alist." t)
+ (autoload 'emoji-insert "emoji" nil t)
+ (autoload 'emoji-recent "emoji" nil t)
+ (autoload 'emoji-search "emoji" nil t)
(autoload 'emoji-list "emoji" "\
List emojis and insert the one that's selected.
Select the emoji by typing \\<emoji-list-mode-map>\\[emoji-list-select] on its
picture.
@@ -9765,6 +9789,11 @@ If called from Lisp, return the name as a string; return
nil if
the name is not known.
(fn GLYPH &optional INTERACTIVE)" t)
+ (autoload 'emoji-list-select "emoji" nil t)
+(autoload 'emoji--init "emoji" "\
+
+
+(fn &optional FORCE INHIBIT-ADJUST)")
(autoload 'emoji-zoom-increase "emoji" "\
Increase the size of the character under point.
FACTOR is the multiplication factor for the size.
@@ -10221,7 +10250,7 @@ Example usage:
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 USER
+See Info node `(erc) Network Identifier' for details. Like USER
and CLIENT-CERTIFICATE, this parameter cannot be specified
interactively.
@@ -15821,7 +15850,7 @@ it is disabled.
;;; Generated autoloads from progmodes/hideshow.el
-(defvar hs-special-modes-alist (mapcar #'purecopy '((c-mode "{" "}" "/[*/]"
nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)"
1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil)
(mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\
+(defvar hs-special-modes-alist (mapcar #'purecopy '((c-mode "{" "}" "/[*/]"
nil nil) (c-ts-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil)
(c++-ts-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
(java-mode "{" "}" "/[*/]" nil nil) (java-ts-mode "{" "}" "/[*/]" nil nil)
(js-mode "{" "}" "/[*/]" nil) (js-ts-mode "{" "}" "/[*/]" nil) (mhtml-mode
"{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\
Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC
@@ -17321,12 +17350,12 @@ Return non-nil if there is an image at point.")
;;; Generated autoloads from image/image-converter.el
(autoload 'image-converter-add-handler "image-converter" "\
-Make Emacs use CONVERTER to parse image files that end with SUFFIX.
-CONVERTER is a function with two parameters, where the first is
-the file name or a string with the image data, and the second is
-non-nil if the first parameter is image data. The converter
-should output the image in the current buffer, converted to
-`image-convert-to-format'.
+Make Emacs use CONVERTER to parse image files whose names end with SUFFIX.
+CONVERTER is a function with two arguments, the file name or a string
+with the image data, and a non-nil value if the first argument is image data.
+The converter should produce the image in the current buffer, converted to
+the format given by `image-convert-to-format'.
+SUFFIX should not include the leading dot.
(fn SUFFIX CONVERTER)")
(register-definition-prefixes "image-converter" '("image-convert"))
@@ -17370,9 +17399,9 @@ Open directory DIR and create a default window
configuration.
Convenience command that:
- - Opens Dired in folder DIR
- - Splits windows in most useful (?) way
- - Sets `truncate-lines' to t
+ - opens Dired in folder DIR;
+ - splits windows in most useful (?) way; and
+ - sets `truncate-lines' to t
After the command has finished, you would typically mark some
image files in Dired and type
@@ -17430,11 +17459,12 @@ Default bookmark handler for Image-Dired buffers.
;;; Generated autoloads from image/image-dired-dired.el
(autoload 'image-dired-dired-toggle-marked-thumbs "image-dired-dired" "\
-Toggle thumbnails in front of file names in the Dired buffer.
-If no marked file could be found, insert or hide thumbnails on the
-current line. ARG, if non-nil, specifies the files to use instead
-of the marked files. If ARG is an integer, use the next ARG (or
-previous -ARG, if ARG<0) files.
+Toggle thumbnails in front of marked file names in the Dired buffer.
+If no file is marked, toggle display of thumbnail on the current file's line.
+ARG, if non-nil (interactively, the prefix argument), specifies the files
+whose thumbnail display to toggle instead of the marked files: if ARG is an
+integer, use the next ARG (or previous -ARG, if ARG<0) files; any other
+value of ARG means toggle thumbnail display of the current line's file.
(fn &optional ARG)" '(dired-mode))
(autoload 'image-dired-jump-thumbnail-buffer "image-dired-dired" "\
@@ -17486,7 +17516,8 @@ Append thumbnails to `image-dired-thumbnail-buffer'."
'(dired-mode))
(autoload 'image-dired-display-thumb "image-dired-dired" "\
Shorthand for `image-dired-display-thumbs' with prefix argument."
'(dired-mode))
(autoload 'image-dired-dired-display-external "image-dired-dired" "\
-Display file at point using an external viewer." '(dired-mode))
+Display file at point using an external viewer.
+The viewer is specified by the value of `image-dired-external-viewer'."
'(dired-mode))
(autoload 'image-dired-dired-display-image "image-dired-dired" "\
Display current image file.
See documentation for `image-dired-display-image' for more information.
@@ -17494,11 +17525,11 @@ See documentation for `image-dired-display-image' for
more information.
(fn &optional _)" '(dired-mode))
(set-advertised-calling-convention 'image-dired-dired-display-image 'nil
'"29.1")
(autoload 'image-dired-mark-tagged-files "image-dired-dired" "\
-Use REGEXP to mark files with matching tag.
+Mark files whose tag matches REGEXP.
A `tag' is a keyword, a piece of meta data, associated with an
image file and stored in image-dired's database file. This command
-lets you input a regexp and this will be matched against all tags
-on all image files in the database file. The files that have a
+prompts for a regexp, and then matches it against all the tags
+of all the image files in the database file. The files that have a
matching tag will be marked in the Dired buffer.
(fn REGEXP)" '(dired-mode))
@@ -17513,7 +17544,8 @@ matching tag will be marked in the Dired buffer.
;;; Generated autoloads from image/image-dired-tags.el
(autoload 'image-dired-tag-files "image-dired-tags" "\
-Tag marked file(s) in Dired. With prefix ARG, tag file at point.
+Tag file(s) which are marked in a Dired buffer.
+With prefix ARG, tag the file at point.
(fn ARG)" '(dired-mode))
(autoload 'image-dired-delete-tag "image-dired-tags" "\
@@ -18326,7 +18358,9 @@ Add submenus to the File menu, to convert to and from
various formats." t)
(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t
exclusive))))
(defvar ispell-personal-dictionary nil "\
File name of your personal spelling dictionary, or nil.
-If nil, the default personal dictionary for your spelling checker is used.")
+If nil, the default personal dictionary for your spelling checker is used.
+Due to a misfeature of Hunspell, if the value is an absolute file name, the
+file by that name must already exist for Hunspell to be able to use it.")
(custom-autoload 'ispell-personal-dictionary "ispell" t)
(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p)
(defconst ispell-menu-map (let ((map (make-sparse-keymap "Spell")))
(define-key map [ispell-change-dictionary] `(menu-item ,(purecopy "Change
Dictionary...") ispell-change-dictionary :help ,(purecopy "Supply explicit
dictionary file name"))) (define-key map [ispell-kill-ispell] `(menu-item
,(purecopy "Kill Process") (lambda nil (interactive) (ispell-kill-ispell nil
'clear)) :enable (and (boundp 'ispell-process) ispell-process (eq
(ispell-process-status) 'run)) :help ,(purecopy "Terminate [...]
@@ -19418,7 +19452,7 @@ If called with an optional prefix argument ARG, prompts
for month and year.
This function is suitable for execution in an init file.
(fn &optional ARG)" t)
-(register-definition-prefixes "lunar" '("calendar-lunar-phases"
"diary-lunar-phases" "eclipse-check" "lunar-"))
+(register-definition-prefixes "lunar" '("calendar-lunar-phases"
"diary-lunar-phases" "lunar-"))
;;; Generated autoloads from progmodes/m4-mode.el
@@ -19511,7 +19545,7 @@ and then select the region of un-tablified names and use
(fn TOP BOTTOM &optional MACRO)" t)
(define-key ctl-x-map "q" 'kbd-macro-query)
-(register-definition-prefixes "macros" '("macro"))
+(register-definition-prefixes "macros" '("macros--insert-vector-macro"))
;;; Generated autoloads from mail/mail-extr.el
@@ -25165,7 +25199,7 @@ Open profile FILENAME.
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 9 6)) package--builtin-versions)
+(push (purecopy '(project 0 9 8)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -26465,6 +26499,8 @@ usually more efficient than that of a simplified
version:
(cdr parens))))
(fn STRINGS &optional PAREN)")
+(function-put 'regexp-opt 'pure 't)
+(function-put 'regexp-opt 'side-effect-free 't)
(autoload 'regexp-opt-depth "regexp-opt" "\
Return the depth of REGEXP.
This means the number of non-shy regexp grouping constructs
@@ -26561,8 +26597,12 @@ or call the function `repeat-mode'.")
(autoload 'repeat-mode "repeat" "\
Toggle Repeat mode.
-When Repeat mode is enabled, and the command symbol has the property named
-`repeat-map', this map is activated temporarily for the next command.
+When Repeat mode is enabled, certain commands bound to multi-key
+sequences can be repeated by typing a single key, after typing the
+full key sequence once.
+The commands which can be repeated like that are those whose symbol
+ has the property `repeat-map' which specifies a keymap of single
+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
@@ -30272,7 +30312,7 @@ Studlify-case the current buffer." t)
(defsubst string-join (strings &optional separator) "\
Join all STRINGS using SEPARATOR.
Optional argument SEPARATOR must be a string, a vector, or a list of
-characters; nil stands for the empty string." (mapconcat #'identity strings
separator))
+characters; nil stands for the empty string." (declare (pure t)
(side-effect-free t)) (mapconcat #'identity strings separator))
(autoload 'string-truncate-left "subr-x" "\
If STRING is longer than LENGTH, return a truncated version.
When truncating, \"...\" is always prepended to the string, so
@@ -30280,10 +30320,12 @@ the resulting string may be longer than the original
if LENGTH is
3 or smaller.
(fn STRING LENGTH)")
+(function-put 'string-truncate-left 'pure 't)
+(function-put 'string-truncate-left 'side-effect-free 't)
(defsubst string-blank-p (string) "\
Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and
-carriage return." (string-match-p "\\`[ \11\n\15]*\\'" string))
+carriage return." (declare (pure t) (side-effect-free t)) (string-match-p
"\\`[ \11\n\15]*\\'" string))
(autoload 'string-clean-whitespace "subr-x" "\
Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
@@ -34195,6 +34237,10 @@ When using this command to register a new file (or
files), it
will automatically deduce which VC repository to register it
with, using the most specific one.
+If VERBOSE is non-nil (interactively, the prefix argument),
+you can specify a VC backend or (for centralized VCS only)
+the revision ID or branch ID.
+
(fn VERBOSE)" t)
(autoload 'vc-register "vc" "\
Register into a version control system.
@@ -34355,24 +34401,31 @@ Uses `vc-retrieve-tag' with the non-nil arg `branchp'.
(fn DIR NAME)" t)
(autoload 'vc-print-log "vc" "\
-List the change log of the current fileset in a window.
-If WORKING-REVISION is non-nil, leave point at that revision.
+Show in another window the VC change history of the current fileset.
+If WORKING-REVISION is non-nil, it should be a revision ID; position
+point in the change history buffer at that revision.
If LIMIT is non-nil, it should be a number specifying the maximum
number of revisions to show; the default is `vc-log-show-limit'.
When called interactively with a prefix argument, prompt for
WORKING-REVISION and LIMIT.
+This shows a short log (one line for each commit) if the current
+fileset includes directories and the VC backend supports that;
+otherwise it shows the detailed log of each commit, which includes
+the full log message and the author. Additional control of the
+shown log style is available via `vc-log-short-style'.
+
(fn &optional WORKING-REVISION LIMIT)" t)
(autoload 'vc-print-root-log "vc" "\
-List the revision history for the current VC controlled tree in a window.
+Show in another window VC change history of the current VC controlled tree.
If LIMIT is non-nil, it should be a number specifying the maximum
number of revisions to show; the default is `vc-log-show-limit'.
-When called interactively with a prefix argument, prompt for LIMIT.
-When the prefix argument is a number, use it as LIMIT.
+When called interactively with a prefix argument, prompt for LIMIT, but
+if the prefix argument is a number, use it as LIMIT.
A special case is when the prefix argument is 1: in this case
-the command asks for the ID of a revision, and shows that revision
-with its diffs (if the underlying VCS supports that).
+the command prompts for the ID of a revision, and shows that revision
+with its diffs (if the underlying VCS backend supports that).
(fn &optional LIMIT REVISION)" t)
(autoload 'vc-print-branch-log "vc" "\
@@ -34392,20 +34445,22 @@ In some version control systems REMOTE-LOCATION can
be a remote branch name.
(fn &optional REMOTE-LOCATION)" t)
(autoload 'vc-log-search "vc" "\
-Search the log of changes for PATTERN.
+Search the VC log of changes for PATTERN and show log of matching changes.
PATTERN is usually interpreted as a regular expression. However, its
exact semantics is up to the backend's log search command; some can
only match fixed strings.
-Display all entries that match log messages in long format.
-With a prefix argument, ask for a command to run that will output
-log entries.
+This command displays in long format all the changes whose log messages
+match PATTERN.
+
+With a prefix argument, the command asks for a shell command to run that
+will output log entries, and displays those log entries instead.
(fn PATTERN)" t)
(autoload 'vc-log-mergebase "vc" "\
-Show a log of changes between the merge base of REV1 and REV2 revisions.
-The merge base is a common ancestor between REV1 and REV2 revisions.
+Show a log of changes between the merge base of revisions REV1 and REV2.
+The merge base is a common ancestor of revisions REV1 and REV2.
(fn FILES REV1 REV2)" t)
(autoload 'vc-region-history "vc" "\
@@ -36887,7 +36942,7 @@ If LIMIT is non-nil, then do not consider characters
beyond LIMIT.
;;; Generated autoloads from progmodes/xref.el
-(push (purecopy '(xref 1 6 1)) package--builtin-versions)
+(push (purecopy '(xref 1 6 2)) package--builtin-versions)
(autoload 'xref-find-backend "xref")
(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1")
(autoload 'xref-go-back "xref" "\
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 5c576861579..46b26750cd5 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -550,7 +550,7 @@ lost after dumping")))
(equal dump-mode "pdump"))
;; Don't enable this before bootstrap is completed, as the
;; compiler infrastructure may not be usable yet.
- (setq comp-enable-subr-trampolines t))
+ (setq native-comp-enable-subr-trampolines t))
(message "Dumping under the name %s" output)
(condition-case ()
(delete-file output)
diff --git a/lisp/macros.el b/lisp/macros.el
index 59c7796551f..98ee3dc52f9 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -46,16 +46,6 @@
" ")
?\]))
-(defun macro--string-to-vector (str)
- "Convert an old-style string key sequence to the vector form."
- (let ((vec (string-to-vector str)))
- (unless (multibyte-string-p str)
- (dotimes (i (length vec))
- (let ((k (aref vec i)))
- (when (> k 127)
- (setf (aref vec i) (+ k ?\M-\C-@ -128))))))
- vec))
-
;;;###autoload
(defun insert-kbd-macro (macroname &optional keys)
"Insert in buffer the definition of kbd macro MACRONAME, as Lisp code.
@@ -88,10 +78,8 @@ use this command, and then save the file."
(insert "(defalias '"))
(prin1 macroname (current-buffer))
(insert "\n ")
- (when (stringp definition)
- (setq definition (macro--string-to-vector definition)))
- (if (vectorp definition)
- (setq definition (kmacro definition)))
+ (when (or (stringp definition) (vectorp definition))
+ (setq definition (kmacro (kmacro--to-vector definition))))
(if (kmacro-p definition)
(let ((vecdef (kmacro--keys definition))
(counter (kmacro--counter definition))
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index 72d532d6f62..ecc03bfb537 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -25,16 +25,16 @@
;; The hashcash binary is at http://www.hashcash.org/.
;;
-;; Call mail-add-payment to add a hashcash payment to a mail message
+;; Call `mail-add-payment' to add a hashcash payment to a mail message
;; in the current buffer.
;;
-;; Call mail-add-payment-async after writing the addresses but before
-;; writing the mail to start calculating the hashcash payment
+;; Call `mail-add-payment-async' after writing the addresses but
+;; before writing the mail to start calculating the hashcash payment
;; asynchronously.
;;
-;; The easiest way to do this automatically for all outgoing mail
-;; is to set `message-generate-hashcash' to t. If you want more
-;; control, try the following hooks.
+;; The easiest way to do this automatically for all outgoing mail is
+;; to set `message-generate-hashcash' to `opportunistic' or t. If you
+;; want more control, try the following hooks.
;;
;; To automatically add payments to all outgoing mail when sending:
;; (add-hook 'message-send-hook 'mail-add-payment)
@@ -44,6 +44,8 @@
;;
;; To check whether calculations are done before sending:
;; (add-hook 'message-send-hook 'hashcash-wait-or-cancel)
+;;
+;; For more information, see Info node `(gnus) Hashcash'.
;;; Code:
@@ -87,7 +89,9 @@ is used instead."
(define-obsolete-variable-alias 'hashcash-path 'hashcash-program "24.4")
(defcustom hashcash-program "hashcash"
"The name of the hashcash executable.
-If this is not in your PATH, specify an absolute file name."
+If this is not in your PATH, specify an absolute file name.
+
+See also `message-generate-hashcash'."
:type '(choice (const nil) file))
(defcustom hashcash-extra-generate-parameters '("-Z2")
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index ba580907658..21dec2bbeb7 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -1931,7 +1931,7 @@ even if the header display is currently pruned."
(progn (require 'rmailout)
(list (rmail-output-read-file-name)
(prefix-numeric-value current-prefix-arg))))
- (let ((i 0) prev-msg)
+ (let ((i 0) prev-msg curmsg)
(while
(and (< i n)
(progn (rmail-summary-goto-msg)
@@ -1942,7 +1942,11 @@ even if the header display is currently pruned."
(setq i (1+ i))
(with-current-buffer rmail-buffer
(let ((rmail-delete-after-output nil))
+ (setq curmsg rmail-current-message)
(rmail-output file-name 1)))
+ ;; rmail-output sometimes moves to the next message; undo that.
+ (or (= curmsg (rmail-summary-msg-number))
+ (rmail-summary-goto-msg curmsg))
(if rmail-delete-after-output
(rmail-summary-delete-forward nil)
(if (< i n)
diff --git a/lisp/man.el b/lisp/man.el
index 286edf9314e..479bf9f9a3c 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -97,6 +97,14 @@
:group 'external
:group 'help)
+(defcustom Man-prefer-synchronous-call nil
+ "Whether to call the Un*x \"man\" program synchronously.
+When this is non-nil, call the \"man\" program synchronously
+(rather than asynchronously, which is the default behavior)."
+ :type 'boolean
+ :group 'man
+ :version "30.1")
+
(defcustom Man-filter-list nil
"Manpage cleaning filter command phrases.
This variable contains a list of the following form:
@@ -1118,7 +1126,8 @@ Return the buffer in which the manpage will appear."
"[cleaning...]")
'face 'mode-line-emphasis)))
(Man-start-calling
- (if (fboundp 'make-process)
+ (if (and (fboundp 'make-process)
+ (not Man-prefer-synchronous-call))
(let ((proc (start-process
manual-program buffer
(if (memq system-type '(cygwin windows-nt))
@@ -1262,21 +1271,21 @@ Same for the ANSI bold and normal escape sequences."
(progn
(goto-char (point-min))
(while (and (search-forward "__\b\b" nil t) (not (eobp)))
- (backward-delete-char 4)
+ (delete-char -4)
(put-text-property (point) (1+ (point))
'font-lock-face 'Man-underline))
(goto-char (point-min))
(while (search-forward "\b\b__" nil t)
- (backward-delete-char 4)
+ (delete-char -4)
(put-text-property (1- (point)) (point)
'font-lock-face 'Man-underline))))
(goto-char (point-min))
(while (and (search-forward "_\b" nil t) (not (eobp)))
- (backward-delete-char 2)
+ (delete-char -2)
(put-text-property (point) (1+ (point)) 'font-lock-face 'Man-underline))
(goto-char (point-min))
(while (search-forward "\b_" nil t)
- (backward-delete-char 2)
+ (delete-char -2)
(put-text-property (1- (point)) (point) 'font-lock-face 'Man-underline))
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
@@ -1294,7 +1303,7 @@ Same for the ANSI bold and normal escape sequences."
;; condense it to a shorter line interspersed with ^H. Remove ^H with
;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min))
- (while (re-search-forward ".\b" nil t) (backward-delete-char 2))
+ (while (re-search-forward ".\b" nil t) (delete-char -2))
(goto-char (point-min))
;; Try to recognize common forms of cross references.
(Man-highlight-references)
@@ -1375,9 +1384,9 @@ script would have done them."
(if (or interactive (not Man-sed-script))
(progn
(goto-char (point-min))
- (while (search-forward "_\b" nil t) (backward-delete-char 2))
+ (while (search-forward "_\b" nil t) (delete-char -2))
(goto-char (point-min))
- (while (search-forward "\b_" nil t) (backward-delete-char 2))
+ (while (search-forward "\b_" nil t) (delete-char -2))
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
(replace-match "\\1"))
@@ -1392,7 +1401,7 @@ script would have done them."
;; condense it to a shorter line interspersed with ^H. Remove ^H with
;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min))
- (while (re-search-forward ".\b" nil t) (backward-delete-char 2))
+ (while (re-search-forward ".\b" nil t) (delete-char -2))
(Man-softhyphen-to-minus))
(defun Man-bgproc-filter (process string)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 21d4607e7cf..01894689623 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1087,11 +1087,7 @@ and DOC describes the way this style of completion
works.")
The available styles are listed in `completion-styles-alist'.
Note that `completion-category-overrides' may override these
-styles for specific categories, such as files, buffers, etc.
-
-Note that Tramp host name completion (e.g., \"/ssh:ho<TAB>\")
-currently doesn't work if this list doesn't contain at least one
-of `basic', `emacs22' or `emacs21'."
+styles for specific categories, such as files, buffers, etc."
:type completion--styles-type
:version "23.1")
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 722e98be2fc..10c5a7744c1 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -510,7 +510,7 @@ If SOURCE, mark the entry with this as the source."
(skip-chars-forward "^;\n")
;; skip \;
(while (eq (char-before) ?\\)
- (backward-delete-char 1)
+ (delete-char -1)
(forward-char)
(skip-chars-forward "^;\n"))
(if (eq (or (char-after save-pos) 0) ?')
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 38fd8a4e258..f8c38859477 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -487,16 +487,9 @@ Emacs dired can't find files."
(defun tramp-adb-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
- ;; `file-exists-p' is used as predicate in file name completion.
- ;; We don't want to run it when `non-essential' is t, or there is
- ;; no connection process yet.
- (when (tramp-connectable-p filename)
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-exists-p"
- (if (tramp-file-property-p v localname "file-attributes")
- (not (null (tramp-get-file-property v localname "file-attributes")))
- (tramp-adb-send-command-and-check
- v (format "test -e %s" (tramp-shell-quote-argument localname))))))))
+ (tramp-skeleton-file-exists-p filename
+ (tramp-adb-send-command-and-check
+ v (format "test -e %s" (tramp-shell-quote-argument localname)))))
(defun tramp-adb-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 01f1c38988c..420d6cadb9c 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -275,6 +275,19 @@ Add the extension of F, if existing."
(autoload 'netrc-parse "netrc")
(netrc-parse file))))
+;; User option `password-colon-equivalents' is new in Emacs 30.1.
+(if (boundp 'password-colon-equivalents)
+ (defvaralias
+ 'tramp-compat-password-colon-equivalents
+ 'password-colon-equivalents)
+ (defvar tramp-compat-password-colon-equivalents
+ '(?\N{COLON}
+ ?\N{FULLWIDTH COLON}
+ ?\N{SMALL COLON}
+ ?\N{PRESENTATION FORM FOR VERTICAL COLON}
+ ?\N{KHMER SIGN CAMNUC PII KUUH})
+ "List of characters equivalent to trailing colon in \"password\"
prompts."))
+
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 02ceb2979f7..b9639c1e7f7 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -2467,16 +2467,17 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
(delete-dups
(mapcar
(lambda (x)
- (let* ((list (split-string x ";"))
- (host (nth 6 list))
- (text (split-string (nth 9 list) "\" \"" 'omit "\""))
- user)
- ;; A user is marked in a TXT field like "u=guest".
- (while text
- (when (string-match (rx "u=" (group (+ nonl)) eol) (car text))
- (setq user (match-string 1 (car text))))
- (setq text (cdr text)))
- (list user host)))
+ (ignore-errors
+ (let* ((list (split-string x ";"))
+ (host (nth 6 list))
+ (text (split-string (nth 9 list) "\" \"" 'omit "\""))
+ user)
+ ;; A user is marked in a TXT field like "u=guest".
+ (while text
+ (when (string-match (rx "u=" (group (+ nonl)) eol) (car text))
+ (setq user (match-string 1 (car text))))
+ (setq text (cdr text)))
+ (list user host))))
result))))
(when tramp-gvfs-enabled
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index c7877c9824d..3ef4b55acd3 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -133,7 +133,7 @@ been set up by `rfn-eshadow-setup-minibuffer'."
;; Use `path-separator' as it does eshell.
(setq eshell-path-env
(if (file-remote-p default-directory)
- (mapconcat #'identity (butlast (exec-path)) path-separator)
+ (string-join (butlast (exec-path)) path-separator)
(getenv "PATH"))))
(with-eval-after-load 'esh-util
@@ -345,8 +345,7 @@ NAME must be equal to `tramp-current-connection'."
(defconst tramp-bsd-process-attributes-ps-args
`("-acxww"
"-o"
- ,(mapconcat
- #'identity
+ ,(string-join
'("pid"
"euid"
"user"
@@ -355,8 +354,7 @@ NAME must be equal to `tramp-current-connection'."
"comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
",")
"-o"
- ,(mapconcat
- #'identity
+ ,(string-join
'("state"
"ppid"
"pgid"
@@ -419,8 +417,7 @@ See `tramp-process-attributes-ps-format'.")
;; Tested with BusyBox v1.24.1.
(defconst tramp-busybox-process-attributes-ps-args
`("-o"
- ,(mapconcat
- #'identity
+ ,(string-join
'("pid"
"user"
"group"
@@ -428,8 +425,7 @@ See `tramp-process-attributes-ps-format'.")
",")
"-o" "stat=abcde"
"-o"
- ,(mapconcat
- #'identity
+ ,(string-join
'("ppid"
"pgid"
"tty"
@@ -472,8 +468,7 @@ See `tramp-process-attributes-ps-format'.")
(defconst tramp-darwin-process-attributes-ps-args
`("-acxww"
"-o"
- ,(mapconcat
- #'identity
+ ,(string-join
'("pid"
"uid"
"user"
@@ -482,8 +477,7 @@ See `tramp-process-attributes-ps-format'.")
",")
"-o" "state=abcde"
"-o"
- ,(mapconcat
- #'identity
+ ,(string-join
'("ppid"
"pgid"
"sess"
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index d1f723e9807..3ae5208154a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -108,11 +108,18 @@ detected as prompt when being sent on echoing hosts,
therefore.")
(defcustom tramp-use-ssh-controlmaster-options (not (eq system-type
'windows-nt))
"Whether to use `tramp-ssh-controlmaster-options'.
+Set it to t, if you want Tramp to apply these options.
Set it to nil, if you use Control* or Proxy* options in your ssh
-configuration."
+configuration.
+Set it to `suppress' if you want to disable settings in your
+\"~/.ssh/config¸\"."
:group 'tramp
- :version "28.1"
- :type 'boolean)
+ :version "29.2"
+ :type '(choice (const :tag "Set ControlMaster" t)
+ (const :tag "Don't set ControlMaster" nil)
+ (const :tag "Suppress ControlMaster" suppress))
+ ;; Check with (safe-local-variable-p 'tramp-use-ssh-controlmaster-options
'suppress)
+ :safe (lambda (val) (and (memq val '(t nil suppress)) t)))
(defvar tramp-ssh-controlmaster-options nil
"Which ssh Control* arguments to use.
@@ -123,8 +130,8 @@ If it is a string, it should have the form
spec must be doubled, because the string is used as format string.
Otherwise, it will be auto-detected by Tramp, if
-`tramp-use-ssh-controlmaster-options' is non-nil. The value
-depends on the installed local ssh version.
+`tramp-use-ssh-controlmaster-options' is t. The value depends on
+the installed local ssh version.
The string is used in `tramp-methods'.")
@@ -631,7 +638,6 @@ foreach $f (@files) {
print \"$f\\n\";
}
}
-print \"ok\\n\"
' \"$1\" %n"
"Perl script to produce output suitable for use with
`file-name-all-completions' on the remote file system.
@@ -1186,20 +1192,13 @@ Operations not mentioned here will be handled by the
normal Emacs functions.")
(defun tramp-sh-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
- ;; `file-exists-p' is used as predicate in file name completion.
- ;; We don't want to run it when `non-essential' is t, or there is
- ;; no connection process yet.
- (when (tramp-connectable-p filename)
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-exists-p"
- (if (tramp-file-property-p v localname "file-attributes")
- (not (null (tramp-get-file-property v localname "file-attributes")))
- (tramp-send-command-and-check
- v
- (format
- "%s %s"
- (tramp-get-file-exists-command v)
- (tramp-shell-quote-argument localname))))))))
+ (tramp-skeleton-file-exists-p filename
+ (tramp-send-command-and-check
+ v
+ (format
+ "%s %s"
+ (tramp-get-file-exists-command v)
+ (tramp-shell-quote-argument localname)))))
(defun tramp-sh-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -1775,57 +1774,34 @@ ID-FORMAT valid values are `string' and `integer'."
;; Get a list of directories and files, including reliably
;; tagging the directories with a trailing "/". Because I
;; rock. --daniel@danann.net
- (tramp-send-command
- v
- (if (tramp-get-remote-perl v)
- (progn
- (tramp-maybe-send-script
- v tramp-perl-file-name-all-completions
- "tramp_perl_file_name_all_completions")
- (format "tramp_perl_file_name_all_completions %s"
- (tramp-shell-quote-argument localname)))
-
- (format (concat
- "(cd %s 2>&1 && %s -a 2>%s"
- " | while IFS= read f; do"
- " if %s -d \"$f\" 2>%s;"
- " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
- " && \\echo ok) || \\echo fail")
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command v)
- (tramp-get-remote-null-device v)
- (tramp-get-test-command v)
- (tramp-get-remote-null-device v))))
-
- ;; Now grab the output.
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-max))
-
- ;; Check result code, found in last line of output.
- (forward-line -1)
- (if (looking-at-p (rx bol "fail" eol))
- (progn
- ;; Grab error message from line before last line
- ;; (it was put there by `cd 2>&1').
- (forward-line -1)
- (tramp-error
- v 'file-error
- "tramp-sh-handle-file-name-all-completions: %s"
- (buffer-substring (point) (line-end-position))))
- ;; For peace of mind, if buffer doesn't end in `fail'
- ;; then it should end in `ok'. If neither are in the
- ;; buffer something went seriously wrong on the remote
- ;; side.
- (unless (looking-at-p (rx bol "ok" eol))
- (tramp-error
- v 'file-error
- (concat "tramp-sh-handle-file-name-all-completions: "
- "internal error accessing `%s': `%s'")
- (tramp-shell-quote-argument localname) (buffer-string))))
-
- (while (zerop (forward-line -1))
- (push (buffer-substring (point) (line-end-position)) result)))
- result))))))
+ (when (tramp-send-command-and-check
+ v
+ (if (tramp-get-remote-perl v)
+ (progn
+ (tramp-maybe-send-script
+ v tramp-perl-file-name-all-completions
+ "tramp_perl_file_name_all_completions")
+ (format "tramp_perl_file_name_all_completions %s"
+ (tramp-shell-quote-argument localname)))
+
+ (format (concat
+ "cd %s 2>&1 && %s -a 2>%s"
+ " | while IFS= read f; do"
+ " if %s -d \"$f\" 2>%s;"
+ " then \\echo \"$f/\"; else \\echo \"$f\"; fi;"
+ " done")
+ (tramp-shell-quote-argument localname)
+ (tramp-get-ls-command v)
+ (tramp-get-remote-null-device v)
+ (tramp-get-test-command v)
+ (tramp-get-remote-null-device v))))
+
+ ;; Now grab the output.
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-max))
+ (while (zerop (forward-line -1))
+ (push (buffer-substring (point) (line-end-position)) result)))
+ result)))))))
;; cp, mv and ln
@@ -2392,8 +2368,7 @@ The method used must be an out-of-band method."
v 'file-error
"Cannot find remote listener: %s" remote-copy-program))
(setq remote-copy-program
- (mapconcat
- #'identity
+ (string-join
(append
(list remote-copy-program) remote-copy-args
(list (if v1 (concat "<" source) (concat ">" target)) "&"))
@@ -2658,8 +2633,8 @@ The method used must be an out-of-band method."
;; End is followed by \n or by " -> ".
(put-text-property start end 'dired-filename t))))))
;; Remove trailing lines.
- (beginning-of-line)
- (while (looking-at "//")
+ (goto-char (point-max))
+ (while (re-search-backward (rx bol "//") nil 'noerror)
(forward-line 1)
(delete-region (match-beginning 0) (point))))
;; Reset multibyte if needed.
@@ -3010,8 +2985,7 @@ implementation will be used."
;; We must also disable buffering,
;; otherwise strings larger than 4096
;; bytes, sent by the process, could
- ;; block, see termios(3) and
- ;;
<https://github.com/emacs-lsp/lsp-mode/issues/2375#issuecomment-1407272718>.
+ ;; block, see termios(3) and Bug#61341.
;; FIXME: Shall we rather use "stty raw"?
(if (tramp-check-remote-uname v "Darwin")
(tramp-send-command
@@ -3118,8 +3092,7 @@ implementation will be used."
(format
"%s %s %s"
(tramp-get-method-parameter vec 'tramp-remote-shell)
- (mapconcat
- #'identity
+ (string-join
(tramp-get-method-parameter vec
'tramp-remote-shell-args)
" ")
(tramp-shell-quote-argument (format "kill -%d $$" i))))
@@ -4845,6 +4818,15 @@ Goes through the list `tramp-inline-compress-commands'."
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
+(defun tramp-ssh-option-exists-p (vec option)
+ "Check, whether local ssh OPTION is applicable."
+ ;; We don't want to cache it persistently.
+ (with-tramp-connection-property nil option
+ ;; We use a non-existing IP address for check, in order to avoid
+ ;; useless connections, and DNS timeouts.
+ (zerop
+ (tramp-call-process vec "ssh" nil nil nil "-G" "-o" option "0.0.0.1"))))
+
(defun tramp-ssh-controlmaster-options (vec)
"Return the Control* arguments of the local ssh."
(cond
@@ -4854,40 +4836,30 @@ Goes through the list `tramp-inline-compress-commands'."
"")
;; There is already a value to be used.
- ((stringp tramp-ssh-controlmaster-options) tramp-ssh-controlmaster-options)
+ ((and (eq tramp-use-ssh-controlmaster-options t)
+ (stringp tramp-ssh-controlmaster-options))
+ tramp-ssh-controlmaster-options)
;; Determine the options.
- (t (setq tramp-ssh-controlmaster-options "")
- (let ((case-fold-search t))
- (ignore-errors
- (with-tramp-progress-reporter
- vec 4 "Computing ControlMaster options"
- ;; We use a non-existing IP address, in order to avoid
- ;; useless connections, and DNS timeouts.
- (when (zerop
- (tramp-call-process
- vec "ssh" nil nil nil
- "-G" "-o" "ControlMaster=auto" "0.0.0.1"))
- (setq tramp-ssh-controlmaster-options
- "-o ControlMaster=auto")
- (if (zerop
- (tramp-call-process
- vec "ssh" nil nil nil
- "-G" "-o" "ControlPath=tramp.%C" "0.0.0.1"))
- (setq tramp-ssh-controlmaster-options
- (concat tramp-ssh-controlmaster-options
- " -o ControlPath=tramp.%%C"))
- (setq tramp-ssh-controlmaster-options
- (concat tramp-ssh-controlmaster-options
- " -o ControlPath=tramp.%%r@%%h:%%p")))
- (when (zerop
- (tramp-call-process
- vec "ssh" nil nil nil
- "-G" "-o" "ControlPersist=no" "0.0.0.1"))
- (setq tramp-ssh-controlmaster-options
- (concat tramp-ssh-controlmaster-options
- " -o ControlPersist=no")))))))
- tramp-ssh-controlmaster-options)))
+ (t (ignore-errors
+ ;; ControlMaster and ControlPath options are introduced in OpenSSH 3.9.
+ (when (tramp-ssh-option-exists-p vec "ControlMaster=auto")
+ (concat
+ "-o ControlMaster="
+ (if (eq tramp-use-ssh-controlmaster-options 'suppress)
+ "no" "auto")
+
+ " -o ControlPath="
+ (if (eq tramp-use-ssh-controlmaster-options 'suppress)
+ "none"
+ ;; Hashed tokens are introduced in OpenSSH 6.7.
+ (if (tramp-ssh-option-exists-p vec "ControlPath=tramp.%C")
+ "tramp.%%C" "tramp.%%r@%%h:%%p"))
+
+ ;; ControlPersist option is introduced in OpenSSH 5.6.
+ (when (and (not (eq tramp-use-ssh-controlmaster-options 'suppress))
+ (tramp-ssh-option-exists-p vec "ControlPersist=no"))
+ " -o ControlPersist=no")))))))
(defun tramp-scp-strict-file-name-checking (vec)
"Return the strict file name checking argument of the local scp."
@@ -4972,7 +4944,7 @@ Goes through the list `tramp-inline-compress-commands'."
(tramp-call-process
vec1 tramp-encoding-shell nil t nil
tramp-encoding-command-switch
- (mapconcat #'identity command " "))
+ (string-join command " "))
(goto-char (point-min))
(not (search-forward "remotecommand" nil 'noerror)))))
@@ -4991,11 +4963,11 @@ Goes through the list `tramp-inline-compress-commands'."
found string)
(with-temp-buffer
;; Check hostkey of VEC2, seen from VEC1.
- (tramp-send-command vec1 (mapconcat #'identity command " "))
+ (tramp-send-command vec1 (string-join command " "))
;; Check hostkey of VEC2, seen locally.
(tramp-call-process
vec1 tramp-encoding-shell nil t nil tramp-encoding-command-switch
- (mapconcat #'identity command " "))
+ (string-join command " "))
(goto-char (point-min))
(while (and (not found) (not (eobp)))
(setq string
@@ -5219,8 +5191,7 @@ connection if a previous connection has died for some
reason."
;; Replace `login-args' place holders.
(setq
command
- (mapconcat
- #'identity
+ (string-join
(append
;; We do not want to see the trailing local
;; prompt in `start-file-process'.
@@ -5521,12 +5492,10 @@ Nonexistent directories are removed from spec."
(format
"%s %s %s 'echo %s \\\"$PATH\\\"'"
(tramp-get-method-parameter vec 'tramp-remote-shell)
- (mapconcat
- #'identity
+ (string-join
(tramp-get-method-parameter vec 'tramp-remote-shell-login)
" ")
- (mapconcat
- #'identity
+ (string-join
(tramp-get-method-parameter vec 'tramp-remote-shell-args)
" ")
(tramp-shell-quote-argument tramp-end-of-heredoc))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index b2272f804e0..2a69465224f 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -757,7 +757,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
"Read ACL data from connection buffer."
(unless (process-live-p proc)
;; Accept pending output.
- (while (tramp-accept-process-output proc))
+ (while (tramp-accept-process-output proc 0))
(with-current-buffer (tramp-get-connection-buffer vec)
;; There might be a hidden password prompt.
(widen)
@@ -1361,7 +1361,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
"Set ACL data."
(unless (process-live-p proc)
;; Accept pending output.
- (while (tramp-accept-process-output proc))
+ (while (tramp-accept-process-output proc 0))
(tramp-message
vec 10 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(throw 'tramp-action 'ok)))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 1f646253579..fa1689d6851 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -454,16 +454,9 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
- ;; `file-exists-p' is used as predicate in file name completion.
- ;; We don't want to run it when `non-essential' is t, or there is
- ;; no connection process yet.
- (when (tramp-connectable-p filename)
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-exists-p"
- (if (tramp-file-property-p v localname "file-attributes")
- (not (null (tramp-get-file-property v localname "file-attributes")))
- (tramp-sudoedit-send-command
- v "test" "-e" (file-name-unquote localname)))))))
+ (tramp-skeleton-file-exists-p filename
+ (tramp-sudoedit-send-command
+ v "test" "-e" (file-name-unquote localname))))
(defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 21dbd40b1d2..47173b95bea 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -441,6 +441,8 @@ See `tramp-methods' for a list of possibilities for METHOD."
(defconst tramp-default-method-marker "-"
"Marker for default method in remote file names.")
+(add-to-list 'tramp-methods `(,tramp-default-method-marker))
+
(defcustom tramp-default-user nil
"Default user to use for transferring files.
It is nil by default; otherwise settings in configuration files like
@@ -639,10 +641,11 @@ This regexp must match both `tramp-initial-end-of-output'
and
:type 'regexp)
(defcustom tramp-password-prompt-regexp
- (rx
- bol (* nonl)
- (group (regexp (regexp-opt password-word-equivalents)))
- (* nonl) (any ":：៖") (? "\^@") (* blank))
+ (rx-to-string
+ `(: bol (* nonl)
+ (group (| . ,password-word-equivalents))
+ (* nonl) (any . ,tramp-compat-password-colon-equivalents)
+ (? "\^@") (* blank)))
"Regexp matching password-like prompts.
The regexp should match at end of buffer.
@@ -1209,9 +1212,12 @@ The `ftp' syntax does not support methods.")
(? (regexp tramp-completion-method-regexp)
;; Method separator, user name and host name.
(? (regexp tramp-postfix-method-regexp)
- ;; This is a little bit lax, but it serves.
- (? (regexp tramp-host-regexp))))
-
+ (? (regexp tramp-user-regexp)
+ (regexp tramp-postfix-user-regexp))
+ (? (| (regexp tramp-host-regexp) ;; This includes a user.
+ (: (regexp tramp-prefix-ipv6-regexp)
+ (? (regexp tramp-ipv6-regexp)
+ (? (regexp tramp-postfix-ipv6-regexp))))))))
eos)))
(defvar tramp-completion-file-name-regexp
@@ -1364,7 +1370,9 @@ special value `tramp-default-remote-path'.
`Private Directories' are the settings of the $PATH environment,
as given in your `~/.profile'. This entry is represented in
-the list by the special value `tramp-own-remote-path'."
+the list by the special value `tramp-own-remote-path'.
+
+For a full discussion, see Info node `(tramp) Remote programs'."
:group 'tramp
:type '(repeat (choice
(const :tag "Default Directories" tramp-default-remote-path)
@@ -1414,9 +1422,13 @@ This shouldn't be set explicitly. It is let-bound, for
example
during direct remote copying with scp.")
(defconst tramp-completion-file-name-handler-alist
- '((file-name-all-completions
+ '((expand-file-name . tramp-completion-handle-expand-file-name)
+ (file-exists-p . tramp-completion-handle-file-exists-p)
+ (file-name-all-completions
. tramp-completion-handle-file-name-all-completions)
- (file-name-completion . tramp-completion-handle-file-name-completion))
+ (file-name-completion . tramp-completion-handle-file-name-completion)
+ (file-name-directory . tramp-completion-handle-file-name-directory)
+ (file-name-nondirectory . tramp-completion-handle-file-name-nondirectory))
"Alist of completion handler functions.
Used for file names matching `tramp-completion-file-name-regexp'.
Operations not mentioned here will be handled by Tramp's file
@@ -1707,7 +1719,6 @@ default values are used."
:port port :localname localname :hop hop))
;; The method must be known.
(unless (or nodefault non-essential
- (string-equal method tramp-default-method-marker)
(assoc method tramp-methods))
(tramp-user-error
v "Method `%s' is not known." method))
@@ -2768,7 +2779,7 @@ Fall back to normal file name handler if no Tramp file
name handler exists."
"Invoke Tramp file name completion handler for OPERATION and ARGS.
Falls back to normal file name handler if no Tramp file name handler exists."
(if-let
- ((fn (and tramp-mode
+ ((fn (and tramp-mode minibuffer-completing-file-name
(assoc operation tramp-completion-file-name-handler-alist))))
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args)))
@@ -2938,9 +2949,76 @@ not in completion mode."
(or ;; We check this for the process related to
;; `tramp-buffer-name'; otherwise `start-file-process'
;; wouldn't run ever when `non-essential' is non-nil.
- (and vec (process-live-p (get-process (tramp-buffer-name vec))))
+ (process-live-p (tramp-get-process vec))
(not non-essential))))
+(defun tramp-completion-handle-expand-file-name (filename &optional directory)
+ "Like `expand-file-name' for partial Tramp files."
+ ;; We need special handling only when a method is needed. Then we
+ ;; check, whether DIRECTORY is "/method:" or "/[method/".
+ (let ((dir (or directory default-directory "/")))
+ (cond
+ ((file-name-absolute-p filename) filename)
+ ((and (eq tramp-syntax 'simplified)
+ (string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir))
+ (concat dir filename))
+ ((string-match-p
+ (rx bos (regexp tramp-prefix-regexp)
+ (* (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))
+ (? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp)
+ (? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp)))
+ eos)
+ dir)
+ (concat dir filename))
+ (t (tramp-run-real-handler #'expand-file-name (list filename
directory))))))
+
+(defun tramp-completion-handle-file-exists-p (filename)
+ "Like `file-exists-p' for partial Tramp files."
+ ;; We need special handling only when a method is needed. Then we
+ ;; regard all files "/method:" or "/[method/" as existent, if
+ ;; "method" is a valid Tramp method. And we regard all files
+ ;; "/method:user@", "/user@" or "/[method/user@" as existent, if
+ ;; "user@" is a valid file name completion. Host completion is
+ ;; performed in the respective backen operation.
+ (or (and (cond
+ ;; Completion styles like `flex' and `substring' check for
+ ;; the file name "/". This does exist.
+ ((string-equal filename "/"))
+ ;; Is it a valid method?
+ ((and (not (string-empty-p tramp-postfix-method-format))
+ (string-match
+ (rx
+ (regexp tramp-prefix-regexp)
+ (* (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))
+ (group-n 9 (regexp tramp-method-regexp))
+ (? (regexp tramp-postfix-method-regexp))
+ eos)
+ filename))
+ (assoc (match-string 9 filename) tramp-methods))
+ ;; Is it a valid user?
+ ((string-match
+ (rx
+ (regexp tramp-prefix-regexp)
+ (* (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))
+ (group-n 10
+ (regexp tramp-method-regexp)
+ (regexp tramp-postfix-method-regexp))
+ (group-n 11
+ (regexp tramp-user-regexp)
+ (regexp tramp-postfix-user-regexp))
+ eos)
+ filename)
+ (member
+ (match-string 11 filename)
+ (file-name-all-completions
+ "" (concat tramp-prefix-format (match-string 10 filename))))))
+ t)
+
+ (tramp-run-real-handler #'file-exists-p (list filename))))
+
;; Method, host name and user name completion.
;; `tramp-completion-dissect-file-name' returns a list of
;; `tramp-file-name' structures. For all of them we return possible
@@ -3014,11 +3092,12 @@ not in completion mode."
result1)))
;; Complete local parts.
- (append
- result1
- (ignore-errors
- (tramp-run-real-handler
- #'file-name-all-completions (list filename directory))))))
+ (delete-dups
+ (append
+ result1
+ (ignore-errors
+ (tramp-run-real-handler
+ #'file-name-all-completions (list filename directory)))))))
;; Method, host name and user name completion for a file.
(defun tramp-completion-handle-file-name-completion
@@ -3176,6 +3255,45 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match
HOST."
(unless (zerop (+ (length user) (length host)))
(tramp-completion-make-tramp-file-name method user host nil)))
+(defun tramp-completion-handle-file-name-directory (filename)
+ "Like `file-name-directory' for partial Tramp files."
+ ;; We need special handling only when a method is needed. Then we
+ ;; return "/method:" or "/[method/", if "method" is a valid Tramp
+ ;; method. In the `separate' file name syntax, we return "/[" when
+ ;; `filename' is "/[string" w/o a trailing method separator "/".
+ (cond
+ ((string-match
+ (rx (group (regexp tramp-prefix-regexp)
+ (* (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp)))
+ (? (regexp tramp-completion-method-regexp)) eos)
+ filename)
+ (match-string 1 filename))
+ ((and (string-match
+ (rx (group
+ (regexp tramp-prefix-regexp)
+ (* (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (? (regexp tramp-user-regexp)
+ (regexp tramp-postfix-user-regexp)))
+ (? (| (regexp tramp-host-regexp)
+ (: (regexp tramp-prefix-ipv6-regexp)
+ (? (regexp tramp-ipv6-regexp)
+ (? (regexp tramp-postfix-ipv6-regexp))))))
+ eos)
+ filename)
+ ;; Is it a valid method?
+ (or (tramp-string-empty-or-nil-p (match-string 2 filename))
+ (assoc (match-string 2 filename) tramp-methods)))
+ (match-string 1 filename))
+ (t (tramp-run-real-handler #'file-name-directory (list filename)))))
+
+(defun tramp-completion-handle-file-name-nondirectory (filename)
+ "Like `file-name-nondirectory' for partial Tramp files."
+ (tramp-compat-string-replace (file-name-directory filename) "" filename))
+
(defun tramp-parse-default-user-host (method)
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
@@ -3517,6 +3635,25 @@ BODY is the backend specific code."
(tramp-dissect-file-name ,directory) 'file-missing ,directory)
nil)))
+(defmacro tramp-skeleton-file-exists-p (filename &rest body)
+ "Skeleton for `tramp-*-handle-file-exists-p'.
+BODY is the backend specific code."
+ (declare (indent 1) (debug t))
+ ;; `file-exists-p' is used as predicate in file name completion.
+ `(or (and minibuffer-completing-file-name
+ (file-name-absolute-p ,filename)
+ (tramp-string-empty-or-nil-p
+ (tramp-file-name-localname (tramp-dissect-file-name ,filename))))
+ ;; We don't want to run it when `non-essential' is t, or there
+ ;; is no connection process yet.
+ (when (tramp-connectable-p ,filename)
+ (with-parsed-tramp-file-name (expand-file-name ,filename) nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (if (tramp-file-property-p v localname "file-attributes")
+ (not
+ (null (tramp-get-file-property v localname
"file-attributes")))
+ ,@body))))))
+
(defmacro tramp-skeleton-file-local-copy (filename &rest body)
"Skeleton for `tramp-*-handle-file-local-copy'.
BODY is the backend specific code."
@@ -3954,13 +4091,8 @@ Let-bind it when necessary.")
(defun tramp-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
- ;; `file-exists-p' is used as predicate in file name completion.
- ;; We don't want to run it when `non-essential' is t, or there is
- ;; no connection process yet.
- (when (tramp-connectable-p filename)
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-exists-p"
- (not (null (file-attributes filename)))))))
+ (tramp-skeleton-file-exists-p filename
+ (not (null (file-attributes filename)))))
(defun tramp-handle-file-in-directory-p (filename directory)
"Like `file-in-directory-p' for Tramp files."
@@ -4415,8 +4547,7 @@ Return it as number of seconds. Used in
`tramp-process-attributes-ps-format'."
(defconst tramp-process-attributes-ps-args
`("-eww"
"-o"
- ,(mapconcat
- #'identity
+ ,(string-join
'("pid"
"euid"
"euser"
@@ -4649,11 +4780,20 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(defun tramp-handle-unlock-file (file)
"Like `unlock-file' for Tramp files."
- (when-let ((lockname (tramp-compat-make-lock-file-name file)))
- (condition-case err
- (delete-file lockname)
- ;; `userlock--handle-unlock-error' exists since Emacs 28.1.
- (error (tramp-compat-funcall 'userlock--handle-unlock-error err)))))
+ (condition-case err
+ ;; When there is no connection, we don't do it. Otherwise,
+ ;; functions like `kill-buffer' would try to reestablish the
+ ;; connection. See Bug#61663.
+ (if-let ((v (tramp-dissect-file-name file))
+ ((process-live-p (tramp-get-process v)))
+ (lockname (tramp-compat-make-lock-file-name file)))
+ (delete-file lockname)
+ ;; Trigger the unlock error.
+ (signal 'file-error `("Cannot remove lock file for" ,file)))
+ ;; `userlock--handle-unlock-error' exists since Emacs 28.1.
+ (error
+ (when create-lockfiles
+ (tramp-compat-funcall 'userlock--handle-unlock-error err)))))
(defun tramp-handle-load (file &optional noerror nomessage nosuffix
must-suffix)
"Like `load' for Tramp files."
@@ -4890,7 +5030,7 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(if (consp (tramp-get-method-parameter v 'tramp-direct-async))
(append
(tramp-get-method-parameter v 'tramp-direct-async)
- `(,(mapconcat #'identity command " ")))
+ `(,(string-join command " ")))
command)))
;; Check for `tramp-sh-file-name-handler', because something
@@ -5786,8 +5926,7 @@ the remote host use line-endings as defined in the
variable
(let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
;; Replace "\n" by `tramp-rsh-end-of-line'.
(setq string
- (mapconcat
- #'identity (split-string string "\n") tramp-rsh-end-of-line))
+ (string-join (split-string string "\n") tramp-rsh-end-of-line))
(unless (or (string-empty-p string)
(string-equal (substring string -1) tramp-rsh-end-of-line))
(setq string (concat string tramp-rsh-end-of-line)))
@@ -6485,7 +6624,7 @@ verbosity of 6."
(apply #'process-lines program args)
(error
(tramp-error vec (car err) (cdr err)))))
- (tramp-message vec 6 "\n%s" (mapconcat #'identity result "\n"))
+ (tramp-message vec 6 "\n%s" (string-join result "\n"))
result))
(defun tramp-process-running-p (process-name)
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 9b271a7cfbd..ad7bf94cdcd 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -102,7 +102,7 @@
("2.3.3" . "26.1") ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2")
("2.3.5.26.3" . "26.3")
("2.4.3.27.1" . "27.1") ("2.4.5.27.2" . "27.2")
- ("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2")
+ ("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2") ("2.5.4" . "28.3")
("2.6.0.29.1" . "29.1")))
(add-hook 'tramp-unload-hook
diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el
index 6f6edb949cc..07e53077253 100644
--- a/lisp/org/ob-eval.el
+++ b/lisp/org/ob-eval.el
@@ -59,7 +59,7 @@ Writes QUERY into a temp-buffer that is processed with
(let ((error-buffer (get-buffer-create " *Org-Babel Error*")) exit-code)
(with-current-buffer error-buffer (erase-buffer))
(with-temp-buffer
- (insert query)
+ (insert query "\n")
(setq exit-code
(org-babel--shell-command-on-region
command error-buffer))
diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el
index 9bf16b9849c..1de263a52d0 100644
--- a/lisp/org/ob-octave.el
+++ b/lisp/org/ob-octave.el
@@ -243,8 +243,8 @@ value of the last statement in BODY, as elisp."
(`output
(setq results
(if matlabp
- (cdr (reverse (delq "" (mapcar #'org-strip-quotes
- (mapcar #'org-trim raw)))))
+ (cdr (reverse (delete "" (mapcar #'org-strip-quotes
+ (mapcar #'org-trim raw)))))
(cdr (member org-babel-octave-eoe-output
(reverse (mapcar #'org-strip-quotes
(mapcar #'org-trim raw)))))))
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el
index 39a4573a54e..f73e7003f6d 100644
--- a/lisp/org/ob-sql.el
+++ b/lisp/org/ob-sql.el
@@ -234,7 +234,7 @@ database connections."
(:database . sql-database)))
(mapped-name (cdr (assq name name-mapping))))
(cadr (assq mapped-name
- (cdr (assoc dbconnection sql-connection-alist))))))))
+ (cdr (assoc-string dbconnection sql-connection-alist
t))))))))
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 63107e8e6a4..a33d84f1cd4 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -7330,7 +7330,7 @@ Any match of REMOVE-RE will be removed from TXT."
(let ((s (org-format-outline-path
(org-get-outline-path)
(1-
(frame-width))
nil
org-agenda-breadcrumbs-separator)))
- (if (eq "" s) "" (concat s
org-agenda-breadcrumbs-separator))))))
+ (if (equal "" s) "" (concat s
org-agenda-breadcrumbs-separator))))))
(setq time (cond (s2 (concat
(org-agenda-time-of-day-to-ampm-maybe s1)
"-" (org-agenda-time-of-day-to-ampm-maybe s2)
@@ -8211,7 +8211,7 @@ filter."
(if (and org-agenda-filtered-by-category
org-agenda-category-filter)
(org-agenda-filter-show-all-cat)
- (let ((cat (org-no-properties (org-get-at-eol 'org-category 1))))
+ (let ((cat (org-no-properties (org-agenda-get-category))))
(cond
((and cat strip)
(org-agenda-filter-apply
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 55372e5649b..f9daf3f14d8 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -726,9 +726,9 @@ If not, show simply the clocked time like 01:50."
'org-mode-line-clock-overrun
'org-mode-line-clock)))
(effort-str (org-duration-from-minutes effort-in-minutes)))
- (format (propertize " [%s/%s] (%s)" 'face 'org-mode-line-clock)
+ (format (propertize "[%s/%s] (%s) " 'face 'org-mode-line-clock)
work-done-str effort-str org-clock-heading))
- (format (propertize " [%s] (%s)" 'face 'org-mode-line-clock)
+ (format (propertize "[%s] (%s) " 'face 'org-mode-line-clock)
(org-duration-from-minutes clocked-time)
org-clock-heading))))
@@ -1798,7 +1798,11 @@ Optional argument N tells to change by that many units."
(begts (if updatets1 begts1 begts2)))
(setq tdiff
(time-subtract
- (org-time-string-to-time org-last-changed-timestamp)
+ (org-time-string-to-time
+ (save-excursion
+ (goto-char (if updatets1 begts2 begts1))
+ (looking-at org-ts-regexp3)
+ (match-string 0)))
(org-time-string-to-time ts)))
;; `save-excursion' won't work because
;; `org-timestamp-change' deletes and re-inserts the
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index 6c50852553c..d5bf2191ae7 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -196,11 +196,13 @@ removed."
;;; Emacs < 27.1 compatibility
-(unless (fboundp 'combine-change-calls)
- ;; A stub when `combine-change-calls' was not yet there.
- (defmacro combine-change-calls (_beg _end &rest body)
- (declare (debug (form form def-body)) (indent 2))
- `(progn ,@body)))
+(if (version< emacs-version "29")
+ ;; A stub when `combine-change-calls' was not yet there or had
+ ;; critical bugs (see Emacs bug#60467).
+ (defmacro org-combine-change-calls (_beg _end &rest body)
+ (declare (debug (form form def-body)) (indent 2))
+ `(progn ,@body))
+ (defalias 'org-combine-change-calls 'combine-change-calls))
(if (version< emacs-version "27.1")
(defsubst org-replace-buffer-contents (source &optional _max-secs
_max-costs)
diff --git a/lisp/org/org-cycle.el b/lisp/org/org-cycle.el
index 828c84cd0ac..90fc95f41f7 100644
--- a/lisp/org/org-cycle.el
+++ b/lisp/org/org-cycle.el
@@ -648,6 +648,9 @@ With a numeric prefix, show all headlines up to that level."
(org-fold-show-hidden-entry)
(org-fold-show-children))
("content"
+ ;; Newline before heading will be outside the
+ ;; narrowing. Make sure that it is revealed.
+ (org-fold-heading nil)
(save-excursion
(save-restriction
(org-narrow-to-subtree)
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 389acf82500..8524dd29d83 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -7406,14 +7406,16 @@ the cache."
(org-element-at-point to-pos)
(cl-macrolet ((cache-root
;; Use the most optimal version of cache available.
- () `(if (memq granularity '(headline
headline+inlinetask))
- (org-element--headline-cache-root)
- (org-element--cache-root)))
+ () `(org-with-base-buffer nil
+ (if (memq granularity '(headline
headline+inlinetask))
+ (org-element--headline-cache-root)
+ (org-element--cache-root))))
(cache-size
;; Use the most optimal version of cache available.
- () `(if (memq granularity '(headline
headline+inlinetask))
- org-element--headline-cache-size
- org-element--cache-size))
+ () `(org-with-base-buffer nil
+ (if (memq granularity '(headline
headline+inlinetask))
+ org-element--headline-cache-size
+ org-element--cache-size)))
(cache-walk-restart
;; Restart tree traversal after AVL tree re-balance.
() `(when node
@@ -7443,8 +7445,9 @@ the cache."
;; Avoid extra staff like timer cancels et al
;; and only call
`org-element--cache-sync-requests' when
;; there are pending requests.
- (when org-element--cache-sync-requests
- (org-element--cache-sync (current-buffer)))
+ (org-with-base-buffer nil
+ (when org-element--cache-sync-requests
+ (org-element--cache-sync (current-buffer))))
;; Call `org-element--parse-to' directly
avoiding any
;; kind of `org-element-at-point' overheads.
(if restrict-elements
@@ -7515,8 +7518,9 @@ the cache."
tmpnext-start))
;; Check if cache does not have gaps.
(cache-gapless-p
- () `(eq org-element--cache-change-tic
- (alist-get granularity
org-element--cache-gapless))))
+ () `(org-with-base-buffer nil
+ (eq org-element--cache-change-tic
+ (alist-get granularity
org-element--cache-gapless)))))
;; The core algorithm is simple walk along binary tree. However,
;; instead of checking all the tree elements from first to last
;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping
@@ -7558,15 +7562,15 @@ the cache."
;; beginning.
(next-element-re (pcase granularity
((or `headline
- (guard (eq '(headline)
- restrict-elements)))
+ (guard (equal '(headline)
+ restrict-elements)))
(cons
(org-with-limited-levels
org-element-headline-re)
'match-beg))
(`headline+inlinetask
(cons
- (if (eq '(inlinetask) restrict-elements)
+ (if (equal '(inlinetask)
restrict-elements)
(org-inlinetask-outline-regexp)
org-element-headline-re)
'match-beg))
@@ -7644,7 +7648,9 @@ the cache."
;; In the process, we may alter the buffer,
;; so also keep track of the cache state.
(progn
- (setq modified-tic org-element--cache-change-tic)
+ (setq modified-tic
+ (org-with-base-buffer nil
+ org-element--cache-change-tic))
(setq cache-size (cache-size))
;; When NEXT-RE/FAIL-RE is provided, skip to
;; next regexp match after :begin of the current
@@ -7678,7 +7684,7 @@ the cache."
;;
;; Call FUNC. FUNC may move point.
(setq org-element-cache-map-continue-from nil)
- (if org-element--cache-map-statistics
+ (if (org-with-base-buffer nil
org-element--cache-map-statistics)
(progn
(setq before-time (float-time))
(push (funcall func data) result)
@@ -7697,7 +7703,15 @@ the cache."
(when org-element-cache-map-continue-from
(goto-char
org-element-cache-map-continue-from))
(when (> (point) start)
- (move-start-to-next-match nil))
+ (move-start-to-next-match nil)
+ ;; (point) inside matching element.
+ ;; Go further.
+ (when (> (point) start)
+ (setq data (element-match-at-point))
+ (if (not data)
+ (cache-walk-abort)
+ (goto-char (next-element-start))
+ (move-start-to-next-match
next-element-re))))
;; Drop nil.
(unless (car result) (pop result)))
;; If FUNC did not move the point and we
@@ -7710,8 +7724,9 @@ the cache."
start))
(setq start nil))
;; Check if the buffer has been modified.
- (unless (and (eq modified-tic
org-element--cache-change-tic)
- (eq cache-size (cache-size)))
+ (unless (org-with-base-buffer nil
+ (and (eq modified-tic
org-element--cache-change-tic)
+ (eq cache-size (cache-size))))
;; START may no longer be valid, update
;; it to beginning of real element.
;; Upon modification, START may lay
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index c83026d1d8f..6bdd0b32fed 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -853,7 +853,7 @@ to `org-footnote-section'. Inline definitions are ignored."
;; Insert un-referenced footnote definitions at the end.
;; Combine all insertions into one to create a single cache
;; update call.
- (combine-change-calls (point) (point)
+ (org-combine-change-calls (point) (point)
(pcase-dolist (`(,label . ,definition) definitions)
(unless (member label inserted)
(insert "\n" definition "\n"))))))))))
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 8372a0be4a5..a8a13152dc8 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made."
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
- (let ((org-git-version "release_9.6.1-23-gc45a05"))
+ (let ((org-git-version "release_9.6.1-40-g3d817c"))
org-git-version))
(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 1b829d837c7..2fbb825015f 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -297,47 +297,49 @@ default, only Emacs Lisp is loaded, since it has no
specific
requirement."
:group 'org-babel
:set 'org-babel-do-load-languages
- :version "24.1"
+ :package-version '(Org . "9.6")
:type '(alist :tag "Babel Languages"
:key-type
(choice
(const :tag "Awk" awk)
- (const :tag "C" C)
+ (const :tag "C, D, C++, and cpp" C)
(const :tag "R" R)
(const :tag "Calc" calc)
- (const :tag "Clojure" clojure)
+ (const :tag "Clojure and ClojureScript" clojure)
(const :tag "CSS" css)
(const :tag "Ditaa" ditaa)
(const :tag "Dot" dot)
(const :tag "Emacs Lisp" emacs-lisp)
+ (const :tag "Eshell" eshell)
(const :tag "Forth" forth)
(const :tag "Fortran" fortran)
- (const :tag "Gnuplot" gnuplot)
+ (const :tag "GnuPlot" gnuplot)
+ (const :tag "Groovy" groovy)
(const :tag "Haskell" haskell)
(const :tag "Java" java)
- (const :tag "Javascript" js)
- (const :tag "LaTeX" latex)
- (const :tag "Lilypond" lilypond)
+ (const :tag "JavaScript" js)
+ (const :tag "Julia" julia)
+ (const :tag "LaTeX" latex)
+ (const :tag "LilyPond" lilypond)
(const :tag "Lisp" lisp)
+ (const :tag "Lua" lua)
(const :tag "Makefile" makefile)
(const :tag "Maxima" maxima)
- (const :tag "Matlab" matlab)
- (const :tag "Ocaml" ocaml)
- (const :tag "Octave" octave)
+ (const :tag "OCaml" ocaml)
+ (const :tag "Octave and MatLab" octave)
(const :tag "Org" org)
(const :tag "Perl" perl)
- (const :tag "Pico Lisp" picolisp)
+ (const :tag "Processing" processing)
(const :tag "PlantUML" plantuml)
(const :tag "Python" python)
(const :tag "Ruby" ruby)
(const :tag "Sass" sass)
- (const :tag "Scala" scala)
(const :tag "Scheme" scheme)
(const :tag "Screen" screen)
+ (const :tag "Sed" sed)
(const :tag "Shell Script" shell)
(const :tag "Sql" sql)
- (const :tag "Sqlite" sqlite)
- (const :tag "Stan" stan))
+ (const :tag "Sqlite" sqlite))
:value-type (boolean :tag "Activate" :value t)))
;;;; Customization variables
@@ -723,6 +725,10 @@ defined in org-duration.el.")
(set-default-toplevel-value var value)
(when (featurep 'org)
(org-load-modules-maybe 'force)
+ ;; FIXME: We can't have all the requires at top-level due to
+ ;; circular dependencies. Yet, this function might sometimes be
+ ;; called when 'org-element is not loaded.
+ (require 'org-element)
(org-element-cache-reset 'all)))
(defcustom org-modules '(ol-doi ol-w3m ol-bbdb ol-bibtex ol-docview ol-gnus
ol-info ol-irc ol-mhe ol-rmail ol-eww)
@@ -4555,21 +4561,25 @@ is available. This option applies only if FILE is a
URL."
(cache)
(is-url
(if (org--should-fetch-remote-resource-p file)
- (with-current-buffer (url-retrieve-synchronously file)
- (goto-char (point-min))
- ;; Move point to after the url-retrieve header.
- (search-forward "\n\n" nil :move)
- ;; Search for the success code only in the url-retrieve header.
- (if (save-excursion
- (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror))
- ;; Update the cache `org--file-cache' and return contents.
- (puthash file
- (buffer-substring-no-properties (point) (point-max))
- org--file-cache)
- (funcall (if noerror #'message #'user-error)
- "Unable to fetch file from %S"
- file)
- nil))
+ (condition-case error
+ (with-current-buffer (url-retrieve-synchronously file)
+ (goto-char (point-min))
+ ;; Move point to after the url-retrieve header.
+ (search-forward "\n\n" nil :move)
+ ;; Search for the success code only in the url-retrieve header.
+ (if (save-excursion
+ (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror))
+ ;; Update the cache `org--file-cache' and return contents.
+ (puthash file
+ (buffer-substring-no-properties (point)
(point-max))
+ org--file-cache)
+ (funcall (if noerror #'message #'user-error)
+ "Unable to fetch file from %S"
+ file)
+ nil))
+ (error (if noerror
+ (message "Org could't download \"%s\": %s %S" file (car
error) (cdr error))
+ (signal (car error) (cdr error)))))
(funcall (if noerror #'message #'user-error)
"The remote resource %S is considered unsafe, and will not be
downloaded."
file)))
@@ -6556,7 +6566,7 @@ See also `org-promote'."
(interactive)
(save-excursion
(org-back-to-heading t)
- (combine-change-calls (point) (save-excursion (org-end-of-subtree t))
+ (org-combine-change-calls (point) (save-excursion (org-end-of-subtree t))
(org-with-limited-levels (org-map-tree 'org-promote))))
(org-fix-position-after-promote))
@@ -6566,7 +6576,7 @@ See `org-demote' and `org-promote'."
(interactive)
(save-excursion
(org-back-to-heading t)
- (combine-change-calls (point) (save-excursion (org-end-of-subtree t))
+ (org-combine-change-calls (point) (save-excursion (org-end-of-subtree t))
(org-with-limited-levels (org-map-tree 'org-demote))))
(org-fix-position-after-promote))
@@ -7135,7 +7145,7 @@ When REMOVE is non-nil, remove the subtree from the
clipboard."
(setq beg (point))
;; Avoid re-parsing cache elements when i.e. level 1 heading
;; is inserted and then promoted.
- (combine-change-calls beg beg
+ (org-combine-change-calls beg beg
(when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
(insert txt)
(unless (string-suffix-p "\n" txt) (insert "\n"))
@@ -18844,7 +18854,7 @@ Alignment is done according to `org-property-format',
which see."
(when (save-excursion
(beginning-of-line)
(looking-at org-property-re))
- (combine-change-calls (match-beginning 0) (match-end 0)
+ (org-combine-change-calls (match-beginning 0) (match-end 0)
(let ((newtext (concat (match-string 4)
(org-trim
(format org-property-format (match-string 1)
(match-string 3))))))
diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el
index 8e3a0456299..4ff482cc3f5 100644
--- a/lisp/org/ox-texinfo.el
+++ b/lisp/org/ox-texinfo.el
@@ -32,6 +32,8 @@
(require 'cl-lib)
(require 'ox)
+(eval-when-compile (require 'subr-x))
+
(defvar orgtbl-exp-regexp)
(defvar org-texinfo-supports-math--cache)
@@ -2025,12 +2027,14 @@ Once computed, the results remain cached."
(unless (boundp 'org-texinfo-supports-math--cache)
(setq org-texinfo-supports-math--cache
(let ((math-example "1 + 1 = 2"))
- (let* ((input-file
- (make-temp-file "test" nil ".info"))
- (input-content
- (concat (format "@setfilename %s" input-file) "\n"
- "@node Top" "\n"
- (format "@displaymath{%s}" math-example) "\n")))
+ (let* ((input-file (make-temp-file "test" nil ".info"))
+ (input-content (string-join
+ (list (format "@setfilename %s" input-file)
+ "@node Top"
+ "@displaymath"
+ math-example
+ "@end displaymath")
+ "\n")))
(with-temp-file input-file
(insert input-content))
(let* ((output-file (org-texinfo-compile input-file))
diff --git a/lisp/paren.el b/lisp/paren.el
index b2a79624c0f..4c91fd29490 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -122,7 +122,8 @@ On non-graphical frames, the context is shown in the echo
area."
"Whether to use `show-paren-mode' in a buffer.
The default is to enable the mode in all buffers that don't
derive from `special-mode', which means that it's on (by default)
-in all editing buffers."
+in all editing buffers.
+The predicate is passed as argument to `buffer-match-p', which see."
:type 'buffer-predicate
:safe #'booleanp
:version "29.1")
@@ -160,13 +161,14 @@ use `show-paren-local-mode'."
;;;###autoload
(define-minor-mode show-paren-local-mode
"Toggle `show-paren-mode' only in this buffer."
- :variable ( show-paren-mode .
- (lambda (val) (setq-local show-paren-mode val)))
+ :variable ((show-paren--enabled-p)
+ .
+ (lambda (val) (setq-local show-paren-mode val)))
(cond
((eq show-paren-mode (default-value 'show-paren-mode))
(unless show-paren-mode
- (show-paren--delete-overlays))
- (kill-local-variable 'show-paren-mode))
+ (show-paren--delete-overlays)
+ (kill-local-variable 'show-paren-mode)))
((not (default-value 'show-paren-mode))
;; Locally enabled, but globally disabled.
(show-paren-mode 1) ; Setup the timer.
@@ -427,14 +429,17 @@ It is the default value of `show-paren-data-function'."
;; `show-paren-delay'.
(defvar-local show-paren--last-pos nil)
+(defun show-paren--enabled-p ()
+ (and show-paren-mode
+ ;; If we're using `show-paren-local-mode', then
+ ;; always heed the value.
+ (or (local-variable-p 'show-paren-mode)
+ ;; If not, check that the predicate matches.
+ (buffer-match-p show-paren-predicate (current-buffer)))))
+
(defun show-paren-function ()
"Highlight the parentheses until the next input arrives."
- (let ((data (and show-paren-mode
- ;; If we're using `show-paren-local-mode', then
- ;; always heed the value.
- (or (local-variable-p 'show-paren-mode)
- ;; If not, check that the predicate matches.
- (buffer-match-p show-paren-predicate (current-buffer)))
+ (let ((data (and (show-paren--enabled-p)
(funcall show-paren-data-function))))
(if (not data)
(progn
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 1ca7a213361..36f68f1af57 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -362,6 +362,32 @@ modified to be an empty string, or the desired separation
string."
;;; User Functions:
+(defun pcomplete-default-exit-function (_s status)
+ "The default exit function to use in `pcomplete-completions-at-point'.
+This just adds `pcomplete-termination-string' after the
+completion if STATUS is `finished'."
+ (unless (zerop (length pcomplete-termination-string))
+ (when (eq status 'finished)
+ (if (looking-at
+ (regexp-quote pcomplete-termination-string))
+ (goto-char (match-end 0))
+ (insert pcomplete-termination-string)))))
+
+(defvar pcomplete-exit-function #'pcomplete-default-exit-function
+ "The exit function to call in `pcomplete-completions-at-point'.
+
+This variable is let-bound in `pcomplete-completions-at-point',
+so you can modify or advise it in order to adjust the behavior
+for a specific completion. For example, you might do the
+following in a `pcomplete-try-first-hook' function to insert a
+trailing slash after a completion:
+
+ (add-function
+ :before (var pcomplete-exit-function)
+ (lambda (_ status)
+ (when (eq status \\='finished)
+ (insert \"/\"))))")
+
;;; Alternative front-end using the standard completion facilities.
;; The way pcomplete-parse-arguments and pcomplete-stub work only
@@ -406,6 +432,7 @@ Same as `pcomplete' but using the standard completion UI."
(if pcomplete-allow-modifications buffer-read-only t))
pcomplete-seen pcomplete-norm-func
pcomplete-args pcomplete-last pcomplete-index
+ (pcomplete-exit-function pcomplete-exit-function)
(pcomplete-autolist pcomplete-autolist)
(pcomplete-suffix-list pcomplete-suffix-list)
;; Apparently the vars above are global vars modified by
@@ -494,16 +521,7 @@ Same as `pcomplete' but using the standard completion UI."
(get-text-property 0 'pcomplete-help cand)))
:predicate pred
:exit-function
- ;; If completion is finished, add a terminating space.
- ;; We used to also do this if STATUS is `sole', but
- ;; that does not work right when completion cycling.
- (unless (zerop (length pcomplete-termination-string))
- (lambda (_s status)
- (when (eq status 'finished)
- (if (looking-at
- (regexp-quote pcomplete-termination-string))
- (goto-char (match-end 0))
- (insert pcomplete-termination-string)))))))))))
+ pcomplete-exit-function))))))
;; I don't think such commands are usable before first setting up buffer-local
;; variables to parse args, so there's no point autoloading it.
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 7574ef86a6e..a54df19425a 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -2147,7 +2147,7 @@ command `antlr-show-makefile-rules' for detail."
(antlr-makefile-insert-variable i " $(" ")"))
(insert "\n" (car antlr-makefile-specification))))
(if (string-equal (car antlr-makefile-specification) "\n")
- (backward-delete-char 1))
+ (delete-char -1))
(when with-error
(goto-char (point-min))
(insert antlr-help-unknown-file-text))
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index d7dd3ed1c9a..bc280284588 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -174,7 +174,7 @@ subexpression 10."
(re-search-forward bug-reference-bug-regexp end-line 'move))
(when (or (not bug-reference-prog-mode)
;; This tests for both comment and string syntax.
- (nth 8 (syntax-ppss)))
+ (nth 8 (save-match-data (syntax-ppss))))
(let* ((bounds (bug-reference--overlay-bounds))
(overlay (or
(let ((ov (pop overlays)))
@@ -599,12 +599,7 @@ and set it if applicable."
(erc-format-target)
(erc-network-name))))
-(defvar bug-reference-auto-setup-functions
- (list #'bug-reference-try-setup-from-vc
- #'bug-reference-try-setup-from-gnus
- #'bug-reference-try-setup-from-rmail
- #'bug-reference-try-setup-from-rcirc
- #'bug-reference-try-setup-from-erc)
+(defvar bug-reference-auto-setup-functions nil
"Functions trying to auto-setup `bug-reference-mode'.
These functions are run after `bug-reference-mode' has been
activated in a buffer and try to guess suitable values for
@@ -616,7 +611,36 @@ guesswork is based on these variables:
- `bug-reference-setup-from-mail-alist' for guessing based on
mail group names or mail header values.
- `bug-reference-setup-from-irc-alist' for guessing based on IRC
- channel or network names.")
+ channel or network names.
+
+Note: This variable's purpose is to allow packages to provide
+bug-reference auto-setup support in buffers managed by this
+package. Therefore, such auto-setup function should check if the
+current buffer is \"their\" buffer and only act if that's the
+case, e.g., in terms of `derived-mode-p'.
+
+The variable is not intended for users. Those are advised to set
+`bug-reference-bug-regexp' and `bug-reference-url-format' using
+other means such as file-local variable sections, a
+`.dir-locals.el' file, or compute and set their values in
+`bug-reference-mode-hook' or `bug-reference-prog-mode-hook'. If
+the bug regexp and URL format are already set after those hooks
+have been run, the auto-setup is inhibited.")
+
+;; Add the default auto-setup functions. We don't have them as
+;; init value of bug-reference-auto-setup-functions because then
+;; they wouldn't be added if some package uses
+;;
+;; (add-hook 'bug-reference-auto-setup-functions
+;; #'my-pkg--bug-reference-try-setup-from-my-pkg)
+;;
+;; before bug-reference.el is loaded.
+(dolist (fn (list #'bug-reference-try-setup-from-vc
+ #'bug-reference-try-setup-from-gnus
+ #'bug-reference-try-setup-from-rmail
+ #'bug-reference-try-setup-from-rcirc
+ #'bug-reference-try-setup-from-erc))
+ (add-hook 'bug-reference-auto-setup-functions fn))
(defun bug-reference--run-auto-setup ()
(when (or bug-reference-mode
diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el
index 8729cae4ba7..85db39aaeae 100644
--- a/lisp/progmodes/c-ts-common.el
+++ b/lisp/progmodes/c-ts-common.el
@@ -51,6 +51,7 @@
(declare-function treesit-node-end "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-parent "treesit.c")
+(declare-function treesit-node-prev-sibling "treesit.c")
;;; Comment indentation and filling
@@ -266,26 +267,59 @@ This should be the symbol of the indent offset variable
for the
particular major mode. This cannot be nil for `c-ts-common'
statement indent functions to work.")
-(defvar c-ts-common-indent-block-type-regexp nil
- "Regexp matching types of block nodes (i.e., {} blocks).
+(defvar c-ts-common-indent-type-regexp-alist nil
+ "An alist of node type regexps.
-This cannot be nil for `c-ts-common' statement indent functions
-to work.")
+Each key in the alist is one of `if', `else', `do', `while',
+`for', `block', `close-bracket'. Each value in the alist
+is the regexp matching the type of that kind of node. Most of
+these types are self-explanatory, e.g., `if' corresponds to
+\"if_statement\" in C. `block' corresponds to the {} block.
-(defvar c-ts-common-indent-bracketless-type-regexp nil
- "A regexp matching types of bracketless constructs.
+Some types, specifically `else', is usually not identified by a
+standalone node, but a child under the \"if_statement\", under a
+field name like \"alternative\", etc. In that case, use a
+cons (TYPE . FIELD-NAME) as the value, where TYPE is the node's
+parent's type, and FIELD-NAME is the field name of the node.
-These constructs include if, while, do-while, for statements. In
-these statements, the body can omit the bracket, which requires
-special handling from our bracket-counting indent algorithm.
+If the language doesn't have a particular type, it is fine to
+omit it.")
-This can be nil, meaning such special handling is not needed.")
+(defun c-ts-common--node-is (node &rest types)
+ "Return non-nil if NODE is any one of the TYPES.
-(defun c-ts-common-statement-offset (node parent bol &rest _)
- "This anchor is used for children of a statement inside a block.
+TYPES can be any of `if', `else', `while', `do', `for', and
+`block'.
+
+If NODE is nil, return nil."
+ (declare (indent 2))
+ (catch 'ret
+ (when (null node)
+ (throw 'ret nil))
+ (dolist (type types)
+ (let ((regexp (alist-get
+ type c-ts-common-indent-type-regexp-alist))
+ (parent (treesit-node-parent node)))
+ (when (and regexp
+ (if (consp regexp)
+ (and parent
+ (string-match-p (car regexp)
+ (treesit-node-type parent))
+ (treesit-node-field-name node)
+ (string-match-p (cdr regexp)
+ (treesit-node-field-name
+ node)))
+ (string-match-p regexp (treesit-node-type node))))
+ (throw 'ret t))))
+ nil))
+
+(defun c-ts-common-statement-offset (node parent &rest _)
+ "Return an indent offset for a statement inside a block.
+
+Assumes the anchor is (point-min), i.e., the 0th column.
This function basically counts the number of block nodes (i.e.,
-brackets) (defined by `c-ts-mode--indent-block-type-regexp')
+brackets) (defined by `c-ts-common-indent-block-type-regexp')
between NODE and the root node (not counting NODE itself), and
multiply that by `c-ts-common-indent-offset'.
@@ -293,16 +327,16 @@ To support GNU style, on each block level, this function
also
checks whether the opening bracket { is on its own line, if so,
it adds an extra level, except for the top-level.
+It also has special handling for bracketless statements and
+else-if statements, which see.
+
PARENT is NODE's parent, BOL is the beginning of non-whitespace
characters on the current line."
(let ((level 0))
;; If NODE is a opening/closing bracket on its own line, take off
;; one level because the code below assumes NODE is a statement
;; _inside_ a {} block.
- (when (and node
- (or (string-match-p c-ts-common-indent-block-type-regexp
- (treesit-node-type node))
- (save-excursion (goto-char bol) (looking-at-p "}"))))
+ (when (c-ts-common--node-is node 'block 'close-bracket)
(cl-decf level))
;; If point is on an empty line, NODE would be nil, but we pretend
;; there is a statement node.
@@ -312,48 +346,41 @@ characters on the current line."
(while (if (eq node t)
(setq node parent)
node)
- (when (string-match-p c-ts-common-indent-block-type-regexp
- (treesit-node-type node))
- (cl-incf level)
- (save-excursion
- (goto-char (treesit-node-start node))
- ;; Add an extra level if the opening bracket is on its own
- ;; line, except (1) it's at top-level, or (2) it's immediate
- ;; parent is another block.
- (cond ((bolp) nil) ; Case (1).
- ((let ((parent-type (treesit-node-type
- (treesit-node-parent node))))
- ;; Case (2).
- (and parent-type
- (string-match-p
- c-ts-common-indent-block-type-regexp
- parent-type)))
- nil)
- ;; Add a level.
- ((looking-back (rx bol (* whitespace))
- (line-beginning-position))
- (cl-incf level)))))
- (setq level (c-ts-mode--fix-bracketless-indent level node))
+ (let ((parent (treesit-node-parent node)))
+ ;; Increment level for every bracket (with exception).
+ (when (c-ts-common--node-is node 'block)
+ (cl-incf level)
+ (save-excursion
+ (goto-char (treesit-node-start node))
+ ;; Add an extra level if the opening bracket is on its own
+ ;; line, except (1) it's at top-level, or (2) it's immediate
+ ;; parent is another block.
+ (cond ((bolp) nil) ; Case (1).
+ ((c-ts-common--node-is parent 'block) ; Case (2).
+ nil)
+ ;; Add a level.
+ ((looking-back (rx bol (* whitespace))
+ (line-beginning-position))
+ (cl-incf level)))))
+ ;; Fix bracketless statements.
+ (when (and (c-ts-common--node-is parent
+ 'if 'do 'while 'for)
+ (not (c-ts-common--node-is node 'block)))
+ (cl-incf level))
+ ;; Flatten "else if" statements.
+ (when (and (c-ts-common--node-is node 'else)
+ (c-ts-common--node-is node 'if)
+ ;; But if the "if" is on it's own line, still
+ ;; indent a level.
+ (not (save-excursion
+ (goto-char (treesit-node-start node))
+ (looking-back (rx bol (* whitespace))
+ (line-beginning-position)))))
+ (cl-decf level)))
;; Go up the tree.
(setq node (treesit-node-parent node)))
(* level (symbol-value c-ts-common-indent-offset))))
-(defun c-ts-mode--fix-bracketless-indent (level node)
- "Takes LEVEL and NODE and return adjusted LEVEL.
-This fixes indentation for cases shown in bug#61026. Basically
-in C-like syntax, statements like if, for, while sometimes omit
-the bracket in the body."
- (let ((block-re c-ts-common-indent-block-type-regexp)
- (statement-re
- c-ts-common-indent-bracketless-type-regexp)
- (node-type (treesit-node-type node))
- (parent-type (treesit-node-type (treesit-node-parent node))))
- (if (and block-re statement-re node-type parent-type
- (not (string-match-p block-re node-type))
- (string-match-p statement-re parent-type))
- (1+ level)
- level)))
-
(provide 'c-ts-common)
;;; c-ts-common.el ends here
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index 586849e9a3d..8c44647ec3e 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -77,6 +77,8 @@
(declare-function treesit-node-child "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(declare-function treesit-node-type "treesit.c")
+(declare-function treesit-node-prev-sibling "treesit.c")
+(declare-function treesit-node-first-child-for-pos "treesit.c")
;;; Custom variables
@@ -87,20 +89,45 @@
:safe 'integerp
:group 'c)
+(defun c-ts-mode-toggle-comment-style (&optional arg)
+ "Toggle the comment style between block and line comments.
+Optional numeric ARG, if supplied, switches to block comment
+style when positive, to line comment style when negative, and
+just toggles it when zero or left out."
+ (interactive "P")
+ (let ((prevstate-line (string= comment-start "// ")))
+ (when (or (not arg)
+ (zerop (setq arg (prefix-numeric-value arg)))
+ (xor (> 0 arg) prevstate-line))
+ (pcase-let ((`(,starter . ,ender)
+ (if prevstate-line
+ (cons "/* " " */")
+ (cons "// " ""))))
+ (setq-local comment-start starter
+ comment-end ender))
+ (c-ts-mode-set-modeline))))
+
+(defun c-ts-mode-set-modeline ()
+ (setq mode-name
+ (concat (if (eq major-mode 'c-ts-mode) "C" "C++")
+ (string-trim-right comment-start)))
+ (force-mode-line-update))
+
(defun c-ts-mode--indent-style-setter (sym val)
"Custom setter for `c-ts-mode-set-style'.
+
Apart from setting the default value of SYM to VAL, also change
-the value of SYM in `c-ts-mode' and `c++-ts-mode' buffers to VAL."
+the value of SYM in `c-ts-mode' and `c++-ts-mode' buffers to VAL.
+
+SYM should be `c-ts-mode-indent-style', and VAL should be a style
+symbol."
(set-default sym val)
(named-let loop ((res nil)
(buffers (buffer-list)))
(if (null buffers)
(mapc (lambda (b)
(with-current-buffer b
- (setq-local treesit-simple-indent-rules
- (treesit--indent-rules-optimize
- (c-ts-mode--get-indent-style
- (if (derived-mode-p 'c-ts-mode) 'c 'cpp))))))
+ (c-ts-mode-set-style val)))
res)
(let ((buffer (car buffers)))
(with-current-buffer buffer
@@ -112,8 +139,8 @@ the value of SYM in `c-ts-mode' and `c++-ts-mode' buffers
to VAL."
"Style used for indentation.
The selected style could be one of GNU, K&R, LINUX or BSD. If
-one of the supplied styles doesn't suffice a function could be
-set instead. This function is expected return a list that
+one of the supplied styles doesn't suffice, a function could be
+set instead. This function is expected to return a list that
follows the form of `treesit-simple-indent-rules'."
:version "29.1"
:type '(choice (symbol :tag "Gnu" gnu)
@@ -134,7 +161,7 @@ MODE is either `c' or `cpp'."
`((,mode ,@style))))
(defun c-ts-mode--prompt-for-style ()
- "Prompt for a indent style and return the symbol for it."
+ "Prompt for an indent style and return the symbol for it."
(let ((mode (if (derived-mode-p 'c-ts-mode) 'c 'c++)))
(intern
(completing-read
@@ -142,16 +169,20 @@ MODE is either `c' or `cpp'."
(mapcar #'car (c-ts-mode--indent-styles mode))
nil t nil nil "gnu"))))
-(defun c-ts-mode-set-style (style)
+(defun c-ts-mode-set-global-style (style)
"Set the indent style of C/C++ modes globally to STYLE.
This changes the current indent style of every C/C++ buffer and
-the default C/C++ indent style in this Emacs session."
+the default C/C++ indent style for `c-ts-mode' and `c++-ts-mode'
+in this Emacs session."
(interactive (list (c-ts-mode--prompt-for-style)))
(c-ts-mode--indent-style-setter 'c-ts-mode-indent-style style))
-(defun c-ts-mode-set-local-style (style)
- "Set the C/C++ indent style of the current buffer to STYLE."
+(defun c-ts-mode-set-style (style)
+ "Set the C/C++ indent style of the current buffer to STYLE.
+
+To set the default indent style globally, use
+`c-ts-mode-set-global-style'."
(interactive (list (c-ts-mode--prompt-for-style)))
(if (not (derived-mode-p 'c-ts-mode 'c++-ts-mode))
(user-error "The current buffer is not in `c-ts-mode' nor `c++-ts-mode'")
@@ -209,11 +240,107 @@ delimiters < and >'s."
;;; Indent
+(defun c-ts-mode--preproc-offset (_n _p &rest _)
+ "This anchor is used for preprocessor directives.
+
+Because node is nil at the moment of indentation, we use
+`treesit-node-on' to capture the anonymous node covering the
+newline. If the grand-parent of that node is the
+translation_unit itself, we don't indent. Otherwise, just indent
+one step according to the great-grand-parent indent level. The
+reason there is a difference between grand-parent and
+great-grand-parent here is that the node containing the newline
+is actually the parent of point at the moment of indentation."
+ (when-let ((node (treesit-node-on (point) (point))))
+ (if (string-equal "translation_unit"
+ (treesit-node-type
+ (treesit-node-parent
+ (treesit-node-parent node))))
+ 0
+ c-ts-mode-indent-offset)))
+
+(defun c-ts-mode--anchor-prev-sibling (node parent bol &rest _)
+ "Return the start of the previous named sibling of NODE.
+
+This anchor handles the special case where the previous sibling
+is a labeled_statement, in that case, return the child of the
+labeled statement instead. (Actually, recursively go down until
+the node isn't a labeled_statement.) Eg,
+
+label:
+ int x = 1;
+ int y = 2;
+
+The anchor of \"int y = 2;\" should be \"int x = 1;\" rather than
+the labeled_statement.
+
+Return nil if a) there is no prev-sibling, or 2) prev-sibling
+doesn't have a child.
+
+PARENT and BOL are like other anchor functions."
+ (when-let ((prev-sibling
+ (or (treesit-node-prev-sibling node t)
+ (treesit-node-prev-sibling
+ (treesit-node-first-child-for-pos parent bol) t)
+ (treesit-node-child parent -1 t)))
+ (continue t))
+ (save-excursion
+ (while (and prev-sibling continue)
+ (pcase (treesit-node-type prev-sibling)
+ ;; Get the statement in the label.
+ ("labeled_statement"
+ (setq prev-sibling (treesit-node-child prev-sibling 2)))
+ ;; Get the last statement in the preproc. Tested by
+ ;; "Prev-Sibling When Prev-Sibling is Preproc" test.
+ ((or "preproc_if" "preproc_ifdef")
+ (setq prev-sibling (treesit-node-child prev-sibling -2)))
+ ((or "preproc_elif" "preproc_else")
+ (setq prev-sibling (treesit-node-child prev-sibling -1)))
+ ((or "#elif" "#else")
+ (setq prev-sibling (treesit-node-prev-sibling
+ (treesit-node-parent prev-sibling) t)))
+ ;; If the start of the previous sibling isn't at the
+ ;; beginning of a line, something's probably not quite
+ ;; right, go a step further.
+ (_ (goto-char (treesit-node-start prev-sibling))
+ (if (looking-back (rx bol (* whitespace))
+ (line-beginning-position))
+ (setq continue nil)
+ (setq prev-sibling
+ (treesit-node-prev-sibling prev-sibling)))))))
+ ;; This could be nil if a) there is no prev-sibling or b)
+ ;; prev-sibling doesn't have a child.
+ (treesit-node-start prev-sibling)))
+
+(defun c-ts-mode--standalone-parent-skip-preproc (_n parent &rest _)
+ "Like the standalone-parent anchor but skips preproc nodes.
+PARENT is the same as other anchor functions."
+ (save-excursion
+ (treesit-node-start
+ (treesit-parent-until
+ ;; Use PARENT rather than NODE, to handle the case where NODE is
+ ;; nil.
+ parent (lambda (node)
+ (and node
+ (not (string-match "preproc" (treesit-node-type node)))
+ (progn
+ (goto-char (treesit-node-start node))
+ (looking-back (rx bol (* whitespace))
+ (line-beginning-position)))))
+ t))))
+
+(defun c-ts-mode--standalone-grandparent (_node parent bol &rest args)
+ "Like the standalone-parent anchor but pass it the grandparent.
+PARENT, BOL, ARGS are the same as other anchor functions."
+ (apply (alist-get 'standalone-parent treesit-simple-indent-presets)
+ parent (treesit-node-parent parent) bol args))
+
(defun c-ts-mode--indent-styles (mode)
"Indent rules supported by `c-ts-mode'.
MODE is either `c' or `cpp'."
(let ((common
- `(((parent-is "translation_unit") point-min 0)
+ `(((parent-is "translation_unit") column-0 0)
+ ((query "(ERROR (ERROR)) @indent") column-0 0)
((node-is ")") parent 1)
((node-is "]") parent-bol 0)
((node-is "else") parent-bol 0)
@@ -229,16 +356,32 @@ MODE is either `c' or `cpp'."
((parent-is "comment") prev-adaptive-prefix 0)
;; Labels.
- ((node-is "labeled_statement") parent-bol 0)
+ ((node-is "labeled_statement") standalone-parent 0)
((parent-is "labeled_statement")
- point-min c-ts-common-statement-offset)
-
- ((match "preproc_ifdef" "compound_statement") point-min 0)
- ((match "#endif" "preproc_ifdef") point-min 0)
- ((match "preproc_if" "compound_statement") point-min 0)
- ((match "#endif" "preproc_if") point-min 0)
- ((match "preproc_function_def" "compound_statement") point-min 0)
- ((match "preproc_call" "compound_statement") point-min 0)
+ c-ts-mode--standalone-grandparent c-ts-mode-indent-offset)
+
+ ;; Preproc directives
+ ((node-is "preproc") column-0 0)
+ ((node-is "#endif") column-0 0)
+ ((match "preproc_call" "compound_statement") column-0 0)
+
+ ;; Top-level things under a preproc directive. Note that
+ ;; "preproc" matches more than one type: it matches
+ ;; preproc_if, preproc_elif, etc.
+ ((n-p-gp nil "preproc" "translation_unit") column-0 0)
+ ;; Indent rule for an empty line after a preproc directive.
+ ((and no-node (parent-is ,(rx (or "\n" "preproc"))))
+ c-ts-mode--standalone-parent-skip-preproc
c-ts-mode--preproc-offset)
+ ;; Statement under a preproc directive, the first statement
+ ;; indents against parent, the rest statements indent to
+ ;; their prev-sibling.
+ ((match nil ,(rx "preproc_" (or "if" "elif")) nil 3 3)
+ c-ts-mode--standalone-parent-skip-preproc c-ts-mode-indent-offset)
+ ((match nil "preproc_ifdef" nil 2 2)
+ c-ts-mode--standalone-parent-skip-preproc c-ts-mode-indent-offset)
+ ((match nil "preproc_else" nil 1 1)
+ c-ts-mode--standalone-parent-skip-preproc c-ts-mode-indent-offset)
+ ((parent-is "preproc") c-ts-mode--anchor-prev-sibling 0)
((parent-is "function_definition") parent-bol 0)
((parent-is "conditional_expression") first-sibling 0)
@@ -255,38 +398,55 @@ MODE is either `c' or `cpp'."
((query "(for_statement update: (_) @indent)") parent-bol 5)
((query "(call_expression arguments: (_) @indent)") parent
c-ts-mode-indent-offset)
((parent-is "call_expression") parent 0)
+ ;; Closing bracket. This should be before initializer_list
+ ;; (and probably others) rule because that rule (and other
+ ;; similar rules) will match the closing bracket. (Bug#61398)
+ ((node-is "}") standalone-parent 0)
,@(when (eq mode 'cpp)
'(((node-is "access_specifier") parent-bol 0)
;; Indent the body of namespace definitions.
((parent-is "declaration_list") parent-bol
c-ts-mode-indent-offset)))
+
;; int[5] a = { 0, 0, 0, 0 };
- ((parent-is "initializer_list") parent-bol c-ts-mode-indent-offset)
+ ((match nil "initializer_list" nil 1 1) parent-bol
c-ts-mode-indent-offset)
+ ((parent-is "initializer_list") c-ts-mode--anchor-prev-sibling 0)
;; Statement in enum.
- ((parent-is "enumerator_list") point-min
c-ts-common-statement-offset)
+ ((match nil "enumerator_list" nil 1 1) standalone-parent
c-ts-mode-indent-offset)
+ ((parent-is "enumerator_list") c-ts-mode--anchor-prev-sibling 0)
;; Statement in struct and union.
- ((parent-is "field_declaration_list") point-min
c-ts-common-statement-offset)
+ ((match nil "field_declaration_list" nil 1 1) standalone-parent
c-ts-mode-indent-offset)
+ ((parent-is "field_declaration_list")
c-ts-mode--anchor-prev-sibling 0)
;; Statement in {} blocks.
- ((parent-is "compound_statement") point-min
c-ts-common-statement-offset)
- ;; Closing bracket.
- ((node-is "}") point-min c-ts-common-statement-offset)
+ ((or (match nil "compound_statement" nil 1 1)
+ (match null "compound_statement"))
+ standalone-parent c-ts-mode-indent-offset)
+ ((parent-is "compound_statement") c-ts-mode--anchor-prev-sibling 0)
;; Opening bracket.
- ((node-is "compound_statement") point-min
c-ts-common-statement-offset)
+ ((node-is "compound_statement") standalone-parent
c-ts-mode-indent-offset)
+ ;; Bug#61291.
+ ((match "expression_statement" nil "body") standalone-parent
c-ts-mode-indent-offset)
+ ;; These rules are for cases where the body is bracketless.
+ ;; Tested by the "Bracketless Simple Statement" test.
+ ((parent-is "if_statement") standalone-parent
c-ts-mode-indent-offset)
+ ((parent-is "for_statement") standalone-parent
c-ts-mode-indent-offset)
+ ((parent-is "while_statement") standalone-parent
c-ts-mode-indent-offset)
+ ((parent-is "do_statement") standalone-parent
c-ts-mode-indent-offset)
,@(when (eq mode 'cpp)
`(((node-is "field_initializer_list") parent-bol ,(*
c-ts-mode-indent-offset 2)))))))
`((gnu
;; Prepend rules to set highest priority
((match "while" "do_statement") parent 0)
- (c-ts-mode--top-level-label-matcher point-min 1)
+ (c-ts-mode--top-level-label-matcher column-0 1)
,@common)
(k&r ,@common)
(linux
;; Reference:
;; https://www.kernel.org/doc/html/latest/process/coding-style.html,
;; and script/Lindent in Linux kernel repository.
- ((node-is "labeled_statement") point-min 0)
+ ((node-is "labeled_statement") column-0 0)
,@common)
(bsd
((node-is "}") parent-bol 0)
@@ -301,16 +461,13 @@ MODE is either `c' or `cpp'."
((parent-is "do_statement") parent-bol 0)
,@common))))
-(defun c-ts-mode--top-level-label-matcher (node &rest _)
+(defun c-ts-mode--top-level-label-matcher (node parent &rest _)
"A matcher that matches a top-level label.
-NODE should be a labeled_statement."
- (let ((func (treesit-parent-until
- node (lambda (n)
- (equal (treesit-node-type n)
- "compound_statement")))))
- (and (equal (treesit-node-type node)
- "labeled_statement")
- (not (treesit-node-top-level func "compound_statement")))))
+NODE should be a labeled_statement. PARENT is its parent."
+ (and (equal (treesit-node-type node)
+ "labeled_statement")
+ (equal "function_definition"
+ (treesit-node-type (treesit-node-parent parent)))))
;;; Font-lock
@@ -440,11 +597,13 @@ MODE is either `c' or `cpp'."
declarator: (_) @c-ts-mode--fontify-declarator)
(function_definition
- declarator: (_) @c-ts-mode--fontify-declarator))
+ declarator: (_) @c-ts-mode--fontify-declarator)
+
+ (parameter_declaration
+ declarator: (_) @c-ts-mode--fontify-declarator)
- ;; Should we highlight identifiers in the parameter list?
- ;; (parameter_declaration
- ;; declarator: (_) @c-ts-mode--fontify-declarator))
+ (enumerator
+ name: (identifier) @font-lock-property-name-face))
:language mode
:feature 'assignment
@@ -454,7 +613,7 @@ MODE is either `c' or `cpp'."
'((assignment_expression
left: (identifier) @font-lock-variable-name-face)
(assignment_expression
- left: (field_expression field: (_) @font-lock-property-face))
+ left: (field_expression field: (_) @font-lock-property-use-face))
(assignment_expression
left: (pointer_expression
(identifier) @font-lock-variable-name-face))
@@ -466,7 +625,9 @@ MODE is either `c' or `cpp'."
:language mode
:feature 'function
'((call_expression
- function: (identifier) @font-lock-function-name-face))
+ function:
+ [(identifier) @font-lock-function-call-face
+ (field_expression field: (field_identifier)
@font-lock-function-call-face)]))
:language mode
:feature 'variable
@@ -488,9 +649,7 @@ MODE is either `c' or `cpp'."
:language mode
:feature 'property
- '((field_identifier) @font-lock-property-face
- (enumerator
- name: (identifier) @font-lock-property-face))
+ '((field_identifier) @font-lock-property-use-face)
:language mode
:feature 'bracket
@@ -550,11 +709,13 @@ For NODE, OVERRIDE, START, END, and ARGS, see
(face (pcase (treesit-node-type (treesit-node-parent
(or qualified-root
identifier)))
+ ("field_declaration" 'font-lock-property-name-face)
("function_declarator" 'font-lock-function-name-face)
(_ 'font-lock-variable-name-face))))
- (treesit-fontify-with-override
- (treesit-node-start identifier) (treesit-node-end identifier)
- face override start end)))
+ (when identifier
+ (treesit-fontify-with-override
+ (treesit-node-start identifier) (treesit-node-end identifier)
+ face override start end))))
(defun c-ts-mode--fontify-variable (node override start end &rest _)
"Fontify an identifier node if it is a variable.
@@ -565,7 +726,7 @@ OVERRIDE, START, END, and ARGS, see
`treesit-font-lock-rules'."
"call_expression"))
(treesit-fontify-with-override
(treesit-node-start node) (treesit-node-end node)
- 'font-lock-variable-name-face override start end)))
+ 'font-lock-variable-use-face override start end)))
(defun c-ts-mode--fontify-defun (node override start end &rest _)
"Correctly fontify the DEFUN macro.
@@ -713,7 +874,9 @@ the semicolon. This function skips the semicolon."
:doc "Keymap for C and C-like languages with tree-sitter"
:parent prog-mode-map
"C-c C-q" #'c-ts-mode-indent-defun
- "C-c ." #'c-ts-mode-set-style)
+ "C-c ." #'c-ts-mode-set-style
+ "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"
@@ -774,20 +937,26 @@ the semicolon. This function skips the semicolon."
(when (eq c-ts-mode-indent-style 'linux)
(setq-local indent-tabs-mode t))
(setq-local c-ts-common-indent-offset 'c-ts-mode-indent-offset)
- (setq-local c-ts-common-indent-block-type-regexp
- (rx (or "compound_statement"
- "field_declaration_list"
- "enumerator_list")))
- (setq-local c-ts-common-indent-bracketless-type-regexp
- (rx (or "if_statement" "do_statement"
- "for_statement" "while_statement")))
-
+ ;; This setup is not needed anymore, but we might find uses for it
+ ;; later, so I'm keeping it.
+ (setq-local c-ts-common-indent-type-regexp-alist
+ `((block . ,(rx (or "compound_statement"
+ "field_declaration_list"
+ "enumerator_list"
+ "initializer_list"
+ "declaration_list")))
+ (if . "if_statement")
+ (else . ("if_statement" . "alternative"))
+ (do . "do_statement")
+ (while . "while_statement")
+ (for . "for_statement")
+ (close-bracket . "}")))
;; Comment
(c-ts-common-comment-setup)
;; Electric
(setq-local electric-indent-chars
- (append "{}():;," electric-indent-chars))
+ (append "{}():;,#" electric-indent-chars))
;; Imenu.
(setq-local treesit-simple-imenu-settings
@@ -805,8 +974,8 @@ the semicolon. This function skips the semicolon."
(setq-local treesit-font-lock-feature-list
'(( comment definition)
( keyword preprocessor string type)
- ( assignment constant escape-sequence label literal property )
- ( bracket delimiter error function operator variable))))
+ ( assignment constant escape-sequence label literal)
+ ( bracket delimiter error function operator property
variable))))
;;;###autoload
(define-derived-mode c-ts-mode c-ts-base-mode "C"
@@ -825,6 +994,7 @@ To use tree-sitter C/C++ modes by default, evaluate
in your configuration."
:group 'c
+ :after-hook (c-ts-mode-set-modeline)
(when (treesit-ready-p 'c)
(treesit-parser-create 'c)
@@ -857,6 +1027,7 @@ To use tree-sitter C/C++ modes by default, evaluate
in your configuration."
:group 'c++
+ :after-hook (c-ts-mode-set-modeline)
(when (treesit-ready-p 'cpp)
(setq-local treesit-text-type-regexp
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 1899b522ab0..81446c3c00b 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1651,7 +1651,7 @@ This function does not do any hidden buffer changes."
;; comment, but XEmacs doesn't. We depend on the Emacs
;; behavior (which also is symmetric).
(if (and (eolp) (elt (parse-partial-sexp start (point)) 7))
- (condition-case nil (forward-char 1)))
+ (forward-char 1))
t))))
@@ -14911,7 +14911,49 @@ comment at the start of cc-engine.el for more info."
(c-add-syntax 'topmost-intro-cont (c-point 'boi)))
))
- ;; (CASE 6 has been removed.)
+ ;; ((Old) CASE 6 has been removed.)
+ ;; CASE 6: line is within a C11 _Generic expression.
+ ((and c-generic-key
+ (eq (char-after containing-sexp) ?\()
+ (progn (setq tmp-pos (c-safe-scan-lists
+ containing-sexp 1 0
+ (min (+ (point) 2000) (point-max))))
+ t)
+ (save-excursion
+ (and
+ (progn (goto-char containing-sexp)
+ (zerop (c-backward-token-2)))
+ (looking-at c-generic-key)
+ (progn (goto-char (1+ containing-sexp))
+ (c-syntactic-re-search-forward
+ "," indent-point 'bound t t))
+ (setq placeholder (point)))))
+ (let ((res (c-syntactic-re-search-forward
+ "[,:)]"
+ (or tmp-pos (min (+ (point) 2000) (point-max)))
+ 'bound t t)))
+ (cond
+ ((and res
+ (eq (char-before) ?\))
+ (save-excursion
+ (backward-char)
+ (c-backward-syntactic-ws indent-point)
+ (eq (point) indent-point)))
+ (c-add-stmt-syntax
+ 'arglist-close (list containing-sexp) t
+ (c-most-enclosing-brace paren-state indent-point) paren-state))
+ ((or (not res)
+ (eq (char-before) ?\)))
+ (backward-char)
+ (c-syntactic-skip-backward "^,:" containing-sexp t)
+ (c-add-syntax (if (eq (char-before) ?:)
+ 'statement-case-intro
+ 'case-label)
+ (1+ containing-sexp)))
+ (t (c-add-syntax (if (eq (char-before) ?:)
+ 'case-label
+ 'statement-case-intro)
+ (1+ containing-sexp))))))
;; CASE 7: line is an expression, not a statement. Most
;; likely we are either in a function prototype or a function
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index c220d8d8789..f726fef467e 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -259,14 +259,14 @@
(defmacro c-fontify-types-and-refs (varlist &rest body)
(declare (indent 1) (debug let*))
- ;; Like `let', but additionally activates `c-record-type-identifiers'
+ ;; Like `let*', but additionally activates `c-record-type-identifiers'
;; and `c-record-ref-identifiers', and fontifies the recorded ranges
;; accordingly on exit.
;;
;; This function does hidden buffer changes.
- `(let ((c-record-type-identifiers t)
- c-record-ref-identifiers
- ,@varlist)
+ `(let* ((c-record-type-identifiers t)
+ c-record-ref-identifiers
+ ,@varlist)
(prog1 (progn ,@body)
(c-fontify-recorded-types-and-refs))))
@@ -1219,6 +1219,7 @@ casts and declarations are fontified. Used on level 2
and higher."
;; inside a function declaration arglist).
;; '<> In an angle bracket arglist.
;; 'arglist Some other type of arglist.
+ ;; 'generic In a C11 _Generic construct.
;; 'top Some other context and point is at the top-level (either
;; outside any braces or directly inside a class or namespace,
;; etc.)
@@ -1345,6 +1346,15 @@ casts and declarations are fontified. Used on level 2
and higher."
(c-back-over-member-initializers)))
(c-put-char-property (1- match-pos) 'c-type 'c-not-decl)
(cons 'not-decl nil))
+ ;; In a C11 _Generic construct.
+ ((and c-generic-key
+ (eq (char-before match-pos) ?,)
+ (save-excursion
+ (and (c-go-up-list-backward match-pos
+ (max (- (point) 2000) (point-min)))
+ (zerop (c-backward-token-2))
+ (looking-at c-generic-key))))
+ (cons 'generic nil))
;; At start of a declaration inside a declaration paren.
((save-excursion
(goto-char match-pos)
@@ -1616,13 +1626,16 @@ casts and declarations are fontified. Used on level 2
and higher."
(c-forward-syntactic-ws))
;; Now analyze the construct.
- (if (eq context 'not-decl)
- (progn
- (setq decl-or-cast nil)
- (if (c-syntactic-re-search-forward
- "," (min limit (point-max)) 'at-limit t)
- (c-put-char-property (1- (point)) 'c-type
'c-not-decl))
- nil)
+ (cond
+ ((eq context 'not-decl)
+ (setq decl-or-cast nil)
+ (if (c-syntactic-re-search-forward
+ "," (min limit (point-max)) 'at-limit t)
+ (c-put-char-property (1- (point)) 'c-type 'c-not-decl))
+ nil)
+ ((eq context 'generic)
+ (c-font-lock-c11-generic-clause))
+ (t
(setq decl-or-cast
(c-forward-decl-or-cast-1
match-pos context last-cast-end inside-macro))
@@ -1683,7 +1696,7 @@ casts and declarations are fontified. Used on level 2
and higher."
context
(or toplev (nth 4 decl-or-cast))))
- (t t))))
+ (t t)))))
;; It was a false alarm. Check if we're in a label (or other
;; construct with `:' except bitfield) instead.
@@ -1713,6 +1726,28 @@ casts and declarations are fontified. Used on level 2
and higher."
nil))))
+(defun c-font-lock-c11-generic-clause ()
+ ;; Fontify a type inside the C11 _Generic clause. Point will be at the
+ ;; type and will be left at the next comma of the clause (if any) or the
+ ;; closing parenthesis, if any, or at the end of the type, otherwise.
+ ;; The return value is always nil.
+ (c-fontify-types-and-refs
+ ((here (point))
+ (type-type (c-forward-type t))
+ (c-promote-possible-types (if (eq type-type 'maybe) 'just-one t))
+ (pos (point)) pos1)
+ (when (and type-type (eq (char-after) ?:))
+ (goto-char here)
+ (c-forward-type t)) ; Fontify the type.
+ (cond
+ ((c-syntactic-re-search-forward "," nil t t t)
+ (backward-char))
+ ((and (setq pos1 (c-up-list-forward))
+ (eq (char-before pos1) ?\)))
+ (goto-char (1- pos1)))
+ (t (goto-char pos))))
+ nil)
+
(defun c-font-lock-enum-body (limit)
;; Fontify the identifiers of each enum we find by searching forward.
;;
@@ -2070,7 +2105,7 @@ casts and declarations are fontified. Used on level 2
and higher."
;; prevent a repeat invocation. See elisp/lispref page "Search-based
;; Fontification".
(while (and (< (point) limit)
- (re-search-forward
+ (re-search-forward
"\\<\\(module\\|export\\|import\\)\\>\\(?:[^_$]\\|$\\)"
limit t))
(goto-char (match-end 1))
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index daa23bd14fa..28403385115 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -3085,6 +3085,17 @@ Keywords here should also be in `c-block-stmt-1-kwds'."
t (c-make-keywords-re t (c-lang-const c-block-stmt-2-kwds)))
(c-lang-defvar c-block-stmt-2-key (c-lang-const c-block-stmt-2-key))
+(c-lang-defconst c-generic-kwds
+ "The keyword \"_Generic\" which introduces a C11 generic statement."
+ t nil
+ c '("_Generic"))
+
+(c-lang-defconst c-generic-key
+ ;; Regexp matching the keyword(s) in `c-generic-kwds'.
+ t (if (c-lang-const c-generic-kwds)
+ (c-make-keywords-re t (c-lang-const c-generic-kwds))))
+(c-lang-defvar c-generic-key (c-lang-const c-generic-key))
+
(c-lang-defconst c-block-stmt-kwds
;; Union of `c-block-stmt-1-kwds' and `c-block-stmt-2-kwds'.
t (c--delete-duplicates (append (c-lang-const c-block-stmt-1-kwds)
@@ -3964,7 +3975,7 @@ is in effect when this is matched (see
`c-identifier-syntax-table')."
;; "throw" in `c-type-modifier-kwds' is followed
;; by a parenthesis list, but no extra measures
;; are necessary to handle that.
- (regexp-opt
+ (regexp-opt
(append (c-lang-const c-fun-name-substitute-kwds)
(c-lang-const c-type-modifier-kwds))
t)
diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el
index c241a2868e5..d83a956af21 100644
--- a/lisp/progmodes/cmake-ts-mode.el
+++ b/lisp/progmodes/cmake-ts-mode.el
@@ -125,7 +125,7 @@
:language 'cmake
:feature 'function
- '((normal_command (identifier) @font-lock-function-name-face))
+ '((normal_command (identifier) @font-lock-function-call-face))
:language 'cmake
:feature 'keyword
@@ -154,7 +154,7 @@
:language 'cmake
:feature 'variable
:override t
- '((variable) @font-lock-variable-name-face)
+ '((variable) @font-lock-variable-use-face)
:language 'cmake
:feature 'error
@@ -220,6 +220,9 @@ the subtrees."
(setq-local treesit-font-lock-feature-list
'((comment)
(keyword string)
+ ;; 'function' and 'variable' here play slightly
+ ;; different roles than in other ts modes, so we
+ ;; kept them at level 3.
(builtin constant escape-sequence function number variable)
(bracket error misc-punctuation)))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 5758eadf996..6d151db8a83 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -649,6 +649,36 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column =
\\([0-9]+\\)\\)?"
;; we do not know what lines will follow.
(guile-file "^In \\(.+\\..+\\):\n" 1 nil nil 0)
(guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2)
+
+ ;; Typescript compilation prior to tsc version 2.7, "plain" format:
+ ;; greeter.ts(30,12): error TS2339: Property 'foo' does not exist.
+ (typescript-tsc-plain
+ ,(rx bol
+ (group (not (in " \t\n()")) ; 1: file
+ (* (not (in "\n()"))))
+ "("
+ (group (+ (in "0-9"))) ; 2: line
+ ","
+ (group (+ (in "0-9"))) ; 3: column
+ "): error "
+ (+ (in "0-9A-Z")) ; error code
+ ": ")
+ 1 2 3 2)
+
+ ;; Typescript compilation after tsc version 2.7, "pretty" format:
+ ;; src/resources/document.ts:140:22 - error TS2362: something.
+ (typescript-tsc-pretty
+ ,(rx bol
+ (group (not (in " \t\n()")) ; 1: file
+ (* (not (in "\n()"))))
+ ":"
+ (group (+ (in "0-9"))) ; 2: line
+ ":"
+ (group (+ (in "0-9"))) ; 3: column
+ " - error "
+ (+ (in "0-9A-Z")) ; error code
+ ": ")
+ 1 2 3 2)
))
"Alist of values for `compilation-error-regexp-alist'.")
@@ -1676,7 +1706,7 @@ to `compilation-error-regexp-alist' if RULES is nil."
(set-marker (make-marker)
(save-excursion
(goto-char (point-min))
- (text-property-search-forward
'compilation-header-end)
+ (text-property-search-forward
'compilation-annotation)
;; If we have no end marker, this will be
;; `point-min' still.
(point)))))
@@ -1824,6 +1854,14 @@ If nil, don't hide anything."
;; buffers when it changes from nil to non-nil or vice-versa.
(unless compilation-in-progress (force-mode-line-update t)))
+(defun compilation-insert-annotation (&rest args)
+ "Insert ARGS at point, adding the `compilation-annotation' text property.
+This property is used to distinguish output of the compilation
+process from additional information inserted by Emacs."
+ (let ((start (point)))
+ (apply #'insert args)
+ (put-text-property start (point) 'compilation-annotation t)))
+
;;;###autoload
(defun compilation-start (command &optional mode name-function highlight-regexp
continue)
@@ -1945,17 +1983,16 @@ Returns the compilation buffer created."
(setq-local compilation-auto-jump-to-next t))
(when (zerop (buffer-size))
;; Output a mode setter, for saving and later reloading this buffer.
- (insert "-*- mode: " name-of-mode
- "; default-directory: "
- (prin1-to-string (abbreviate-file-name default-directory))
- " -*-\n"))
- (insert (format "%s started at %s\n\n"
- mode-name
- (substring (current-time-string) 0 19))
- command "\n")
- ;; Mark the end of the header so that we don't interpret
- ;; anything in it as an error.
- (put-text-property (1- (point)) (point) 'compilation-header-end t)
+ (compilation-insert-annotation
+ "-*- mode: " name-of-mode
+ "; default-directory: "
+ (prin1-to-string (abbreviate-file-name default-directory))
+ " -*-\n"))
+ (compilation-insert-annotation
+ (format "%s started at %s\n\n"
+ mode-name
+ (substring (current-time-string) 0 19))
+ command "\n")
(setq thisdir default-directory))
(set-buffer-modified-p nil))
;; Pop up the compilation buffer.
@@ -2437,13 +2474,13 @@ commands of Compilation major mode are available. See
(cur-buffer (current-buffer)))
;; Record where we put the message, so we can ignore it later on.
(goto-char omax)
- (insert ?\n mode-name " " (car status))
+ (compilation-insert-annotation ?\n mode-name " " (car status))
(if (and (numberp compilation-window-height)
(zerop compilation-window-height))
(message "%s" (cdr status)))
(if (bolp)
(forward-char -1))
- (insert " at " (substring (current-time-string) 0 19))
+ (compilation-insert-annotation " at " (substring (current-time-string) 0
19))
(goto-char (point-max))
;; Prevent that message from being recognized as a compilation error.
(add-text-properties omax (point)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 412283f3488..b6f0e9bca41 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -2918,8 +2918,9 @@ and closing parentheses and brackets."
;;
((eq 'REx-part2 (elt i 0)) ;; [self start] start of /REP in s//REP/x
(goto-char (elt i 1))
- (condition-case nil ; Use indentation of the 1st part
- (forward-sexp -1))
+ (condition-case nil
+ (forward-sexp -1) ; Use indentation of the 1st part
+ (error nil))
(current-column))
((eq 'indentable (elt i 0)) ; Indenter for REGEXP qw() etc
(cond ;;; [indentable terminator start-pos is-block]
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index 063cfffe1da..ea4977254ce 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -474,28 +474,37 @@ compilation and evaluation time conflicts."
(and (eq (char-before) ?\])
(not (eq (char-after) ?\;))))))
`((annotation-top-cont ,(c-point 'iopl))))
-
((and
;; Heuristics to find object initializers
(save-excursion
;; Next non-whitespace character should be '{'
(goto-char (c-point 'boi))
- (eq (char-after) ?{))
- (save-excursion
- ;; 'new' should be part of the line
- (goto-char (c-point 'iopl))
- (looking-at ".*new.*"))
+ (unless (eq (char-after) ?{)
+ (backward-up-list 1 t t))
+ (save-excursion
+ ;; 'new' should be part of the line
+ (goto-char (c-point 'iopl))
+ (looking-at ".*new.*")))
;; Line should not already be terminated
(save-excursion
(goto-char (c-point 'eopl))
(or (not (eq (char-before) ?\;))
(not (eq (char-before) ?\{)))))
- (if (save-excursion
- ;; if we have a hanging brace on line before
- (goto-char (c-point 'eopl))
- (eq (char-before) ?\{))
- `((brace-list-intro ,(c-point 'iopl)))
- `((block-open) (statement ,(c-point 'iopl)))))
+ (cond
+ ((save-excursion
+ ;; if we have a hanging brace on line before
+ (goto-char (c-point 'eopl))
+ (eq (char-before) ?\{))
+ `((brace-list-intro ,(c-point 'iopl))))
+ ((save-excursion
+ ;; if we have a hanging brace on line before
+ (goto-char (c-point 'boi))
+ (and (eq (char-after) ?\})
+ `((brace-list-close ,(save-excursion
+ (backward-up-list 1 t t)
+ (point)))))))
+ (t
+ `((block-open) (statement ,(c-point 'iopl))))))
(t
(apply orig-fun args))))
@@ -699,9 +708,9 @@ compilation and evaluation time conflicts."
(treesit-font-lock-rules
:language 'c-sharp
:feature 'expression
- '((conditional_expression (identifier) @font-lock-variable-name-face)
- (postfix_unary_expression (identifier)* @font-lock-variable-name-face)
- (initializer_expression (assignment_expression left: (identifier)
@font-lock-variable-name-face)))
+ '((conditional_expression (identifier) @font-lock-variable-use-face)
+ (postfix_unary_expression (identifier)* @font-lock-variable-use-face)
+ (initializer_expression (assignment_expression left: (identifier)
@font-lock-variable-use-face)))
:language 'c-sharp
:feature 'bracket
@@ -730,8 +739,8 @@ compilation and evaluation time conflicts."
:language 'c-sharp
:override t
:feature 'property
- `((attribute (identifier) @font-lock-property-face
(attribute_argument_list))
- (attribute (identifier) @font-lock-property-face))
+ `((attribute (identifier) @font-lock-property-use-face
(attribute_argument_list))
+ (attribute (identifier) @font-lock-property-use-face))
:language 'c-sharp
:override t
@@ -850,19 +859,42 @@ compilation and evaluation time conflicts."
:feature 'function
'((invocation_expression
function: (member_access_expression
- name: (identifier) @font-lock-function-name-face))
+ name: (identifier) @font-lock-function-call-face))
(invocation_expression
- function: (identifier) @font-lock-function-name-face)
+ function: (identifier) @font-lock-function-call-face)
(invocation_expression
function: (member_access_expression
- name: (generic_name (identifier)
@font-lock-function-name-face)))
+ name: (generic_name (identifier)
@font-lock-function-call-face)))
(invocation_expression
- function: (generic_name (identifier) @font-lock-function-name-face)))
+ function: (generic_name (identifier) @font-lock-function-call-face)))
:language 'c-sharp
:feature 'escape-sequence
:override t
- '((escape_sequence) @font-lock-escape-face)))
+ '((escape_sequence) @font-lock-escape-face)
+
+ :language 'c-sharp
+ :feature 'directives
+ :override t
+ '((if_directive
+ "if" @font-lock-preprocessor-face
+ (identifier) @font-lock-variable-use-face)
+ (elif_directive
+ "elif" @font-lock-preprocessor-face
+ (identifier) @font-lock-variable-use-face)
+ (else_directive) @font-lock-preprocessor-face
+ (endif_directive) @font-lock-preprocessor-face
+ (define_directive
+ "define" @font-lock-preprocessor-face
+ (identifier) @font-lock-variable-use-face)
+ (nullable_directive) @font-lock-preprocessor-face
+ (pragma_directive) @font-lock-preprocessor-face
+ (region_directive) @font-lock-preprocessor-face
+ (endregion_directive) @font-lock-preprocessor-face
+ (region_directive
+ (preproc_message) @font-lock-variable-use-face)
+ (endregion_directive
+ (preproc_message) @font-lock-variable-use-face))))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode))
@@ -930,7 +962,7 @@ Key bindings:
(setq-local treesit-font-lock-settings csharp-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list
'(( comment definition)
- ( keyword string type)
+ ( keyword string type directives)
( constant escape-sequence expression literal property)
( function bracket delimiter error)))
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 4fa886bc788..2f8d2002cd3 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -47,9 +47,10 @@
;; definition-chasing, Flymake for diagnostics, Eldoc for at-point
;; documentation, etc. Eglot's job is generally *not* to provide
;; such a UI itself, though a small number of simple
-;; counter-examples do exist, for example in the `eglot-rename'
-;; command. When a new UI is evidently needed, consider adding a
-;; new package to Emacs, or extending an existing one.
+;; counter-examples do exist, e.g. in the `eglot-rename' command or
+;; the `eglot-inlay-hints-mode' minor mode. When a new UI is
+;; evidently needed, consider adding a new package to Emacs, or
+;; extending an existing one.
;;
;; * Eglot was designed to function with just the UI facilities found
;; in the latest Emacs core, as long as those facilities are also
@@ -129,7 +130,8 @@
(defvar markdown-fontify-code-blocks-natively)
(defvar company-backends)
(defvar company-tooltip-align-annotations)
-
+(defvar tramp-ssh-controlmaster-options)
+(defvar tramp-use-ssh-controlmaster-options)
;;; User tweakable stuff
@@ -221,7 +223,8 @@ chosen (interactively or automatically)."
"--client-id"
"emacs.eglot-dart"))
(elixir-mode . ("language_server.sh"))
(ada-mode . ("ada_language_server"))
- (scala-mode . ("metals-emacs"))
+ (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")))
@@ -482,7 +485,10 @@ This can be useful when using docker to run a language
server.")
(VersionedTextDocumentIdentifier (:uri :version) ())
(WorkDoneProgress (:kind) (:title :message :percentage :cancellable))
(WorkspaceEdit () (:changes :documentChanges))
- (WorkspaceSymbol (:name :kind) (:containerName :location :data)))
+ (WorkspaceSymbol (:name :kind) (:containerName :location :data))
+ (InlayHint (:position :label) (:kind :textEdits :tooltip :paddingLeft
+ :paddingRight :data))
+ (InlayHintLabelPart (:value) (:tooltip :location :command)))
"Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
INTERFACE-NAME is a symbol designated by the spec as
@@ -637,7 +643,7 @@ Honor `eglot-strict-mode'."
Honor `eglot-strict-mode'."
(declare (indent 1) (debug (sexp &rest form)))
(let ((e (cl-gensym "jsonrpc-lambda-elem")))
- `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body))))
+ `(lambda (,e) (cl-block nil (eglot--dbind ,cl-lambda-list ,e ,@body)))))
(cl-defmacro eglot--dcase (obj &rest clauses)
"Like `pcase', but for the LSP object OBJ.
@@ -802,6 +808,7 @@ treated as in `eglot--dbind'."
:formatting `(:dynamicRegistration :json-false)
:rangeFormatting `(:dynamicRegistration :json-false)
:rename `(:dynamicRegistration :json-false)
+ :inlayHint `(:dynamicRegistration :json-false)
:publishDiagnostics (list :relatedInformation :json-false
;; TODO: We can support
:codeDescription after
;; adding an appropriate UI to
@@ -811,6 +818,7 @@ treated as in `eglot--dbind'."
`(:valueSet
[,@(mapcar
#'car eglot--tag-faces)])))
+ :general (list :positionEncodings ["utf-32" "utf-8" "utf-16"])
:experimental eglot--{})))
(cl-defgeneric eglot-workspace-folders (server)
@@ -954,7 +962,7 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
"Lookup `eglot-server-programs' for MODE.
Return (MANAGED-MODES LANGUAGE-ID CONTACT-PROXY).
-MANAGED-MODES is a list with MODE as its first elements.
+MANAGED-MODES is a list with MODE as its first element.
Subsequent elements are other major modes also potentially
managed by the server that is to manage MODE.
@@ -1071,7 +1079,8 @@ variable (which see) can query the value
`eglot-lsp-context' to
decide whether a given directory is a project containing a
suitable root directory for a given LSP server's purposes."
(let ((eglot-lsp-context t))
- (or (project-current) `(transient . ,default-directory))))
+ (or (project-current)
+ `(transient . ,(expand-file-name default-directory)))))
;;;###autoload
(defun eglot (managed-major-mode project class contact language-id
@@ -1198,7 +1207,7 @@ Each function is passed the server as an argument")
;;
;; Not only does this seem like there should be a better way,
;; but it almost certainly doesn’t work on non-unix systems.
- (list "sh" "-c"
+ (list shell-file-name "-c"
(string-join (cons "stty raw > /dev/null;"
(mapcar #'shell-quote-argument contact))
" "))
@@ -1242,7 +1251,15 @@ This docstring appeases checkdoc, that's all."
(contact (cl-subseq contact 0 probe)))
`(:process
,(lambda ()
- (let ((default-directory default-directory))
+ (let ((default-directory default-directory)
+ ;; bug#61350: Tramp turns on a feature
+ ;; by default that can't (yet) handle
+ ;; very much data so we turn it off
+ ;; unconditionally -- just for our
+ ;; process.
+ (tramp-use-ssh-controlmaster-options t)
+ (tramp-ssh-controlmaster-options
+ "-o ControlMaster=no -o ControlPath=none"))
(make-process
:name readable-name
:command (setq server-info (eglot--cmd contact))
@@ -1328,10 +1345,7 @@ This docstring appeases checkdoc, that's all."
(lambda ()
(setf (eglot--inhibit-autoreconnect
server)
(null eglot-autoreconnect)))))))
- (let ((default-directory (project-root project))
- (major-mode (car managed-modes)))
- (hack-dir-local-variables-non-file-buffer)
- (run-hook-with-args 'eglot-connect-hook server))
+ (run-hook-with-args 'eglot-connect-hook server)
(eglot--message
"Connected! Server `%s' now managing `%s' buffers \
in project `%s'."
@@ -1434,71 +1448,111 @@ CONNECT-ARGS are passed as additional arguments to
(let ((warning-minimum-level :error))
(display-warning 'eglot (apply #'format format args) :warning)))
-(defun eglot-current-column () (- (point) (line-beginning-position)))
-
-(defvar eglot-current-column-function #'eglot-lsp-abiding-column
- "Function to calculate the current column.
+(defalias 'eglot--bol
+ (if (fboundp 'pos-bol) #'pos-bol
+ (lambda (&optional n) (let ((inhibit-field-text-motion t))
+ (line-beginning-position n))))
+ "Return position of first character in current line.")
-This is the inverse operation of
-`eglot-move-to-column-function' (which see). It is a function of
-no arguments returning a column number. For buffers managed by
-fully LSP-compliant servers, this should be set to
-`eglot-lsp-abiding-column' (the default), and
-`eglot-current-column' for all others.")
-
-(defun eglot-lsp-abiding-column (&optional lbp)
- "Calculate current COLUMN as defined by the LSP spec.
-LBP defaults to `line-beginning-position'."
- (/ (- (length (encode-coding-region (or lbp (line-beginning-position))
+
+;;; Encoding fever
+;;;
+(define-obsolete-function-alias
+ 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "29.1")
+(define-obsolete-function-alias
+ 'eglot-current-column 'eglot-utf-32-linepos "29.1")
+(define-obsolete-variable-alias
+ 'eglot-current-column-function 'eglot-current-linepos-function "29.1")
+
+(defvar eglot-current-linepos-function #'eglot-utf-16-linepos
+ "Function calculating position relative to line beginning.
+
+It is a function of no arguments considering the text from line
+beginning up to current point. The return value is the number of
+UTF code units needed to encode that text from the LSP server's
+perspective. This may be a number of octets, 16-bit words or
+Unicode code points, depending on whether the LSP server's
+`positionEncoding' capability is UTF-8, UTF-16 or UTF-32,
+respectively. Position of point should remain unaltered if that
+return value is fed through the corresponding inverse function
+`eglot-move-to-linepos-function' (which see).")
+
+(defun eglot-utf-8-linepos ()
+ "Calculate number of UTF-8 bytes from line beginning."
+ (length (encode-coding-region (eglot--bol) (point) 'utf-8-unix t)))
+
+(defun eglot-utf-16-linepos (&optional lbp)
+ "Calculate number of UTF-16 code units from position given by LBP.
+LBP defaults to `eglot--bol'."
+ (/ (- (length (encode-coding-region (or lbp (eglot--bol))
;; Fix github#860
(min (point) (point-max)) 'utf-16 t))
2)
2))
+(defun eglot-utf-32-linepos ()
+ "Calculate number of Unicode codepoints from line beginning."
+ (- (point) (eglot--bol)))
+
(defun eglot--pos-to-lsp-position (&optional pos)
"Convert point POS to LSP position."
(eglot--widening
;; LSP line is zero-origin; emacs is one-origin.
(list :line (1- (line-number-at-pos pos t))
:character (progn (when pos (goto-char pos))
- (funcall eglot-current-column-function)))))
-
-(defvar eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column
- "Function to move to a column reported by the LSP server.
-
-According to the standard, LSP column/character offsets are based
-on a count of UTF-16 code units, not actual visual columns. So
-when LSP says position 3 of a line containing just \"aXbc\",
-where X is a multi-byte character, it actually means `b', not
-`c'. However, many servers don't follow the spec this closely.
-
-For buffers managed by fully LSP-compliant servers, this should
-be set to `eglot-move-to-lsp-abiding-column' (the default), and
-`eglot-move-to-column' for all others.")
-
-(defun eglot-move-to-column (column)
- "Move to COLUMN without closely following the LSP spec."
+ (funcall eglot-current-linepos-function)))))
+
+(define-obsolete-function-alias
+ 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "29.1")
+(define-obsolete-function-alias
+ 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "29.1")
+(define-obsolete-variable-alias
+'eglot-move-to-column-function 'eglot-move-to-linepos-function "29.1")
+
+(defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos
+ "Function to move to a position within a line reported by the LSP server.
+
+Per the LSP spec, character offsets in LSP Position objects count
+UTF-16 code units, not actual code points. So when LSP says
+position 3 of a line containing just \"aXbc\", where X is a funny
+looking character in the UTF-16 \"supplementary plane\", it
+actually means `b', not `c'. The default value
+`eglot-move-to-utf-16-linepos' accounts for this.
+
+This variable can also be set to `eglot-move-to-utf-8-linepos' or
+`eglot-move-to-utf-32-linepos' for servers not closely following
+the spec. Also, since LSP 3.17 server and client may agree on an
+encoding and Eglot will set this variable automatically.")
+
+(defun eglot-move-to-utf-8-linepos (n)
+ "Move to line's Nth byte as computed by LSP's UTF-8 criterion."
+ (let* ((bol (eglot--bol))
+ (goal-byte (+ (position-bytes bol) n))
+ (eol (line-end-position)))
+ (goto-char bol)
+ (while (and (< (position-bytes (point)) goal-byte) (< (point) eol))
+ ;; raw bytes take 2 bytes in the buffer
+ (when (>= (char-after) #x3fff80) (setq goal-byte (1+ goal-byte)))
+ (forward-char 1))))
+
+(defun eglot-move-to-utf-16-linepos (n)
+ "Move to line's Nth code unit as computed by LSP's UTF-16 criterion."
+ (let* ((bol (eglot--bol))
+ (goal-char (+ bol n))
+ (eol (line-end-position)))
+ (goto-char bol)
+ (while (and (< (point) goal-char) (< (point) eol))
+ ;; code points in the "supplementary place" use two code units
+ (when (<= #x010000 (char-after) #x10ffff) (setq goal-char (1-
goal-char)))
+ (forward-char 1))))
+
+(defun eglot-move-to-utf-32-linepos (n)
+ "Move to line's Nth codepoint as computed by LSP's UTF-32 criterion."
;; We cannot use `move-to-column' here, because it moves to *visual*
- ;; columns, which can be different from LSP columns in case of
+ ;; columns, which can be different from LSP characters in case of
;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296,
;; github#297)
- (goto-char (min (+ (line-beginning-position) column)
- (line-end-position))))
-
-(defun eglot-move-to-lsp-abiding-column (column)
- "Move to COLUMN abiding by the LSP spec."
- (save-restriction
- (cl-loop
- with lbp = (line-beginning-position)
- initially
- (narrow-to-region lbp (line-end-position))
- (move-to-column column)
- for diff = (- column
- (eglot-lsp-abiding-column lbp))
- until (zerop diff)
- do (condition-case eob-err
- (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2))
- (end-of-buffer (cl-return eob-err))))))
+ (goto-char (min (+ (eglot--bol) n) (line-end-position))))
(defun eglot--lsp-position-to-point (pos-plist &optional marker)
"Convert LSP position POS-PLIST to Emacs point.
@@ -1510,16 +1564,17 @@ If optional MARKER, return a marker instead"
(forward-line (min most-positive-fixnum
(plist-get pos-plist :line)))
(unless (eobp) ;; if line was excessive leave point at eob
- (let ((tab-width 1)
- (col (plist-get pos-plist :character)))
+ (let ((col (plist-get pos-plist :character)))
(unless (wholenump col)
(eglot--warn
"Caution: LSP server sent invalid character position %s. Using 0
instead."
col)
(setq col 0))
- (funcall eglot-move-to-column-function col)))
+ (funcall eglot-move-to-linepos-function col)))
(if marker (copy-marker (point-marker)) (point)))))
+
+;;; More helpers
(defconst eglot--uri-path-allowed-chars
(let ((vec (copy-sequence url-path-allowed-chars)))
(aset vec ?: nil) ;; see github#639
@@ -1624,7 +1679,8 @@ under cursor."
(const :tag "Highlight links in document" :documentLinkProvider)
(const :tag "Decorate color references" :colorProvider)
(const :tag "Fold regions of buffer" :foldingRangeProvider)
- (const :tag "Execute custom commands" :executeCommandProvider)))
+ (const :tag "Execute custom commands" :executeCommandProvider)
+ (const :tag "Inlay hints" :inlayHintProvider)))
(defun eglot--server-capable (&rest feats)
"Determine if current server is capable of FEATS."
@@ -1640,6 +1696,14 @@ under cursor."
if (not (listp (cadr probe))) do (cl-return (if more nil (cadr
probe)))
finally (cl-return (or (cadr probe) t)))))
+(defun eglot--server-capable-or-lose (&rest feats)
+ "Like `eglot--server-capable', but maybe error out."
+ (let ((retval (apply #'eglot--server-capable feats)))
+ (unless retval
+ (eglot--error "Unsupported or ignored LSP capability `%s'"
+ (mapconcat #'symbol-name feats " ")))
+ retval))
+
(defun eglot--range-region (range &optional markers)
"Return region (BEG . END) that represents LSP RANGE.
If optional MARKERS, make markers."
@@ -1744,6 +1808,14 @@ Use `eglot-managed-p' to determine if current buffer is
managed.")
:init-value nil :lighter nil :keymap eglot-mode-map
(cond
(eglot--managed-mode
+ (pcase (plist-get (eglot--capabilities (eglot-current-server))
+ :positionEncoding)
+ ("utf-32"
+ (eglot--setq-saving eglot-current-linepos-function
#'eglot-utf-32-linepos)
+ (eglot--setq-saving eglot-move-to-linepos-function
#'eglot-move-to-utf-32-linepos))
+ ("utf-8"
+ (eglot--setq-saving eglot-current-linepos-function
#'eglot-utf-8-linepos)
+ (eglot--setq-saving eglot-move-to-linepos-function
#'eglot-move-to-utf-8-linepos)))
(add-hook 'after-change-functions 'eglot--after-change nil t)
(add-hook 'before-change-functions 'eglot--before-change nil t)
(add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
@@ -1759,20 +1831,22 @@ Use `eglot-managed-p' to determine if current buffer is
managed.")
(add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t)
(add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t)
(add-hook 'pre-command-hook 'eglot--pre-command-hook nil t)
- (eglot--setq-saving eldoc-documentation-functions
- '(eglot-signature-eldoc-function
- eglot-hover-eldoc-function))
- (eglot--setq-saving eldoc-documentation-strategy
- #'eldoc-documentation-enthusiast)
(eglot--setq-saving xref-prompt-for-identifier nil)
(eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend))
(eglot--setq-saving company-backends '(company-capf))
(eglot--setq-saving company-tooltip-align-annotations t)
+ (eglot--setq-saving eldoc-documentation-strategy
+ #'eldoc-documentation-compose)
(unless (eglot--stay-out-of-p 'imenu)
(add-function :before-until (local 'imenu-create-index-function)
#'eglot-imenu))
(unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1))
- (unless (eglot--stay-out-of-p 'eldoc) (eldoc-mode 1))
+ (unless (eglot--stay-out-of-p 'eldoc)
+ (add-hook 'eldoc-documentation-functions #'eglot-hover-eldoc-function
+ nil t)
+ (add-hook 'eldoc-documentation-functions #'eglot-signature-eldoc-function
+ nil t)
+ (eldoc-mode 1))
(cl-pushnew (current-buffer) (eglot--managed-buffers
(eglot-current-server))))
(t
(remove-hook 'after-change-functions 'eglot--after-change t)
@@ -1788,6 +1862,8 @@ Use `eglot-managed-p' to determine if current buffer is
managed.")
(remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t)
(remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t)
(remove-hook 'pre-command-hook 'eglot--pre-command-hook t)
+ (remove-hook 'eldoc-documentation-functions #'eglot-hover-eldoc-function t)
+ (remove-hook 'eldoc-documentation-functions
#'eglot-signature-eldoc-function t)
(cl-loop for (var . saved-binding) in eglot--saved-bindings
do (set (make-local-variable var) saved-binding))
(remove-function (local 'imenu-create-index-function) #'eglot-imenu)
@@ -1801,12 +1877,11 @@ Use `eglot-managed-p' to determine if current buffer is
managed.")
(delq (current-buffer) (eglot--managed-buffers server)))
(when (and eglot-autoshutdown
(null (eglot--managed-buffers server)))
- (eglot-shutdown server))))))
- ;; Note: the public hook runs before the internal eglot--managed-mode-hook.
- (run-hooks 'eglot-managed-mode-hook))
+ (eglot-shutdown server)))))))
(defun eglot--managed-mode-off ()
"Turn off `eglot--managed-mode' unconditionally."
+ (remove-overlays nil nil 'eglot--overlay t)
(eglot--managed-mode -1))
(defun eglot-current-server ()
@@ -1845,9 +1920,12 @@ If it is activated, also signal textDocument/didOpen."
(when (and buffer-file-name (eglot-current-server))
(setq eglot--diagnostics nil)
(eglot--managed-mode)
- (eglot--signal-textDocument/didOpen))))
+ (eglot--signal-textDocument/didOpen)
+ ;; Run user hook after 'textDocument/didOpen' so server knows
+ ;; about the buffer.
+ (eglot-inlay-hints-mode 1)
+ (run-hooks 'eglot-managed-mode-hook))))
-(add-hook 'find-file-hook 'eglot--maybe-activate-editing-mode)
(add-hook 'after-change-major-mode-hook 'eglot--maybe-activate-editing-mode)
(defun eglot-clear-status (server)
@@ -2124,7 +2202,7 @@ COMMAND is a symbol naming the command."
(eglot--widening
(goto-char (point-min))
(setq beg
- (line-beginning-position
+ (eglot--bol
(1+ (plist-get (plist-get range :start)
:line))))
(setq end
(line-end-position
@@ -2271,6 +2349,7 @@ THINGS are either registrations or unregisterations
(sic)."
(defun eglot--before-change (beg end)
"Hook onto `before-change-functions' with BEG and END."
+ (remove-overlays beg end 'eglot--overlay t)
(when (listp eglot--recent-changes)
;; Records BEG and END, crucially convert them into LSP
;; (line/char) positions before that information is lost (because
@@ -2283,6 +2362,9 @@ THINGS are either registrations or unregisterations
(sic)."
(,end . ,(copy-marker end t)))
eglot--recent-changes)))
+(defvar eglot--document-changed-hook '(eglot--signal-textDocument/didChange)
+ "Internal hook for doing things when the document changes.")
+
(defun eglot--after-change (beg end pre-change-length)
"Hook onto `after-change-functions'.
Records BEG, END and PRE-CHANGE-LENGTH locally."
@@ -2323,7 +2405,7 @@ Records BEG, END and PRE-CHANGE-LENGTH locally."
eglot-send-changes-idle-time
nil (lambda () (eglot--when-live-buffer buf
(when eglot--managed-mode
- (eglot--signal-textDocument/didChange)
+ (run-hooks 'eglot--document-changed-hook)
(setq eglot--change-idle-timer nil))))))))
;; HACK! Launching a deferred sync request with outstanding changes is a
@@ -2369,9 +2451,7 @@ format described above.")
(defun eglot-show-workspace-configuration (&optional server)
"Dump `eglot-workspace-configuration' as JSON for debugging."
- (interactive (list (and (eglot-current-server)
- (eglot--read-server "Server configuration"
- (eglot-current-server)))))
+ (interactive (list (eglot--read-server "Show workspace configuration for"
t)))
(let ((conf (eglot--workspace-configuration-plist server)))
(with-current-buffer (get-buffer-create "*EGLOT workspace configuration*")
(erase-buffer)
@@ -2382,14 +2462,23 @@ format described above.")
(json-pretty-print-buffer))
(pop-to-buffer (current-buffer)))))
-(defun eglot--workspace-configuration (server)
- (if (functionp eglot-workspace-configuration)
- (funcall eglot-workspace-configuration server)
- eglot-workspace-configuration))
-
-(defun eglot--workspace-configuration-plist (server)
- "Returns `eglot-workspace-configuration' suitable for serialization."
- (let ((val (eglot--workspace-configuration server)))
+(defun eglot--workspace-configuration-plist (server &optional path)
+ "Returns SERVER's workspace configuration as a plist.
+If PATH consider that file's `file-name-directory' to get the
+local value of the `eglot-workspace-configuration' variable, else
+use the root of SERVER's `eglot--project'."
+ (let ((val (with-temp-buffer
+ (setq default-directory
+ (if path
+ (file-name-directory path)
+ (project-root (eglot--project server))))
+ ;; Set the major mode to be the first of the managed
+ ;; modes. This is the one the user started eglot in.
+ (setq major-mode (car (eglot--major-modes server)))
+ (hack-dir-local-variables-non-file-buffer)()
+ (if (functionp eglot-workspace-configuration)
+ (funcall eglot-workspace-configuration server)
+ eglot-workspace-configuration))))
(or (and (consp (car val))
(cl-loop for (section . v) in val
collect (if (keywordp section) section
@@ -2414,25 +2503,17 @@ When called interactively, use the currently active
server"
(apply #'vector
(mapcar
(eglot--lambda ((ConfigurationItem) scopeUri section)
- (with-temp-buffer
- (let* ((uri-path (eglot--uri-to-path scopeUri))
- (default-directory
- (if (and uri-path
- (not (string-empty-p uri-path))
- (file-directory-p uri-path))
- (file-name-as-directory uri-path)
- (project-root (eglot--project server)))))
- (setq-local major-mode (car (eglot--major-modes server)))
- (hack-dir-local-variables-non-file-buffer)
- (cl-loop for (wsection o)
- on (eglot--workspace-configuration-plist server)
- by #'cddr
- when (string=
- (if (keywordp wsection)
- (substring (symbol-name wsection) 1)
- wsection)
- section)
- return o))))
+ (cl-loop
+ with scope-uri-path = (and scopeUri (eglot--uri-to-path scopeUri))
+ for (wsection o)
+ on (eglot--workspace-configuration-plist server scope-uri-path)
+ by #'cddr
+ when (string=
+ (if (keywordp wsection)
+ (substring (symbol-name wsection) 1)
+ wsection)
+ section)
+ return o))
items)))
(defun eglot--signal-textDocument/didChange ()
@@ -2481,7 +2562,7 @@ When called interactively, use the currently active
server"
:textDocument/didClose `(:textDocument
,(eglot--TextDocumentIdentifier)))))
(defun eglot--signal-textDocument/willSave ()
- "Send textDocument/willSave to server."
+ "Maybe send textDocument/willSave to server."
(let ((server (eglot--current-server-or-lose))
(params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
(when (eglot--server-capable :textDocumentSync :willSave)
@@ -2493,15 +2574,16 @@ When called interactively, use the currently active
server"
:timeout 0.5))))))
(defun eglot--signal-textDocument/didSave ()
- "Send textDocument/didSave to server."
+ "Maybe send textDocument/didSave to server."
(eglot--signal-textDocument/didChange)
- (jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didSave
- (list
- ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
- :text (buffer-substring-no-properties (point-min) (point-max))
- :textDocument (eglot--TextDocumentIdentifier))))
+ (when (eglot--server-capable :textDocumentSync :save)
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didSave
+ (list
+ ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
+ :text (buffer-substring-no-properties (point-min) (point-max))
+ :textDocument (eglot--TextDocumentIdentifier)))))
(defun eglot-flymake-backend (report-fn &rest _more)
"A Flymake backend for Eglot.
@@ -2559,14 +2641,14 @@ Try to visit the target file for a richer summary line."
(collect (lambda ()
(eglot--widening
(pcase-let* ((`(,beg . ,end) (eglot--range-region range))
- (bol (progn (goto-char beg)
(line-beginning-position)))
+ (bol (progn (goto-char beg) (eglot--bol)))
(substring (buffer-substring bol
(line-end-position)))
(hi-beg (- beg bol))
(hi-end (- (min (line-end-position) end) bol)))
(add-face-text-property hi-beg hi-end 'xref-match
t substring)
(list substring (line-number-at-pos (point) t)
- (eglot-current-column) (- end beg))))))
+ (eglot-utf-32-linepos) (- end beg))))))
(`(,summary ,line ,column ,length)
(cond
(visiting (with-current-buffer visiting (funcall collect)))
@@ -2589,8 +2671,7 @@ Try to visit the target file for a richer summary line."
"Ask for :workspace/symbol on PAT, return list of formatted strings.
If BUFFER, switch to it before."
(with-current-buffer (or buffer (current-buffer))
- (unless (eglot--server-capable :workspaceSymbolProvider)
- (eglot--error "This LSP server isn't a :workspaceSymbolProvider"))
+ (eglot--server-capable-or-lose :workspaceSymbolProvider)
(mapcar
(lambda (wss)
(eglot--dbind ((WorkspaceSymbol) name containerName kind) wss
@@ -2652,13 +2733,12 @@ If BUFFER, switch to it before."
(cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability)
"Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY."
- (unless (eglot--server-capable
- (or capability
- (intern
- (format ":%sProvider"
- (cadr (split-string (symbol-name method)
- "/"))))))
- (eglot--error "Sorry, this server doesn't do %s" method))
+ (eglot--server-capable-or-lose
+ (or capability
+ (intern
+ (format ":%sProvider"
+ (cadr (split-string (symbol-name method)
+ "/"))))))
(let ((response
(jsonrpc-request
(eglot--current-server-or-lose)
@@ -2755,8 +2835,7 @@ for which LSP on-type-formatting should be requested."
:end (eglot--pos-to-lsp-position end)))))
(t
'(:textDocument/formatting :documentFormattingProvider
nil)))))
- (unless (eglot--server-capable cap)
- (eglot--error "Server can't format!"))
+ (eglot--server-capable-or-lose cap)
(eglot--apply-text-edits
(jsonrpc-request
(eglot--current-server-or-lose)
@@ -2780,10 +2859,9 @@ for which LSP on-type-formatting should be requested."
(cl-sort completions
#'string-lessp
:key (lambda (c)
- (or (plist-get
- (get-text-property 0 'eglot--lsp-item c)
- :sortText)
- "")))))
+ (plist-get
+ (get-text-property 0 'eglot--lsp-item c)
+ :sortText)))))
(metadata `(metadata (category . eglot)
(display-sort-function . ,sort-completions)))
resp items (cached-proxies :none)
@@ -2803,16 +2881,20 @@ for which LSP on-type-formatting should be requested."
(mapcar
(jsonrpc-lambda
(&rest item &key label insertText insertTextFormat
- &allow-other-keys)
+ textEdit &allow-other-keys)
(let ((proxy
- (cond ((and (eql insertTextFormat 2)
- (eglot--snippet-expansion-fn))
+ ;; Snippet or textEdit, it's safe to
+ ;; display/insert the label since
+ ;; it'll be adjusted. If no usable
+ ;; insertText at all, label is best,
+ ;; too.
+ (cond ((or (and (eql insertTextFormat 2)
+ (eglot--snippet-expansion-fn))
+ textEdit
+ (null insertText)
+ (string-empty-p insertText))
(string-trim-left label))
- ((and insertText
- (not (string-empty-p insertText)))
- insertText)
- (t
- (string-trim-left label)))))
+ (t insertText))))
(unless (zerop (length proxy))
(put-text-property 0 1 'eglot--lsp-item item
proxy))
proxy))
@@ -2873,7 +2955,10 @@ for which LSP on-type-formatting should be requested."
(when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))
(kind (alist-get (plist-get lsp-item :kind)
eglot--kind-names)))
- (intern (downcase kind))))
+ (pcase kind
+ ("EnumMember" 'enum-member)
+ ("TypeParameter" 'type-parameter)
+ (_ (intern (downcase kind))))))
:company-deprecated
(lambda (proxy)
(when-let ((lsp-item (get-text-property 0 'eglot--lsp-item proxy)))
@@ -2907,7 +2992,7 @@ for which LSP on-type-formatting should be requested."
(looking-back
(regexp-opt
(cl-coerce (cl-getf completion-capability :triggerCharacters)
'list))
- (line-beginning-position))))
+ (eglot--bol))))
:exit-function
(lambda (proxy status)
(when (memq status '(finished exact))
@@ -3197,8 +3282,7 @@ Returns a list as described in docstring of
`imenu--index-alist'."
"unknown symbol"))
nil nil nil nil
(symbol-name (symbol-at-point)))))
- (unless (eglot--server-capable :renameProvider)
- (eglot--error "Server can't rename!"))
+ (eglot--server-capable-or-lose :renameProvider)
(eglot--apply-workspace-edit
(jsonrpc-request (eglot--current-server-or-lose)
:textDocument/rename
`(,@(eglot--TextDocumentPositionParams)
@@ -3225,9 +3309,7 @@ at point. With prefix argument, prompt for ACTION-KIND."
'("quickfix" "refactor.extract" "refactor.inline"
"refactor.rewrite" "source.organizeImports")))
t))
- (unless (or (not interactive)
- (eglot--server-capable :codeActionProvider))
- (eglot--error "Server can't execute code actions!"))
+ (eglot--server-capable-or-lose :codeActionProvider)
(let* ((server (eglot--current-server-or-lose))
(actions
(jsonrpc-request
@@ -3454,6 +3536,123 @@ If NOERROR, return predicate, else erroring function."
(pop-to-buffer (current-buffer)))))
+;;; Inlay hints
+(defface eglot-inlay-hint-face '((t (:height 0.8 :inherit shadow)))
+ "Face used for inlay hint overlays.")
+
+(defface eglot-type-hint-face '((t (:inherit eglot-inlay-hint-face)))
+ "Face used for type inlay hint overlays.")
+
+(defface eglot-parameter-hint-face '((t (:inherit eglot-inlay-hint-face)))
+ "Face used for parameter inlay hint overlays.")
+
+(defvar-local eglot--outstanding-inlay-hints-region (cons nil nil)
+ "Jit-lock-calculated (FROM . TO) region with potentially outdated hints")
+
+(defvar-local eglot--outstanding-inlay-hints-last-region nil)
+
+(defvar-local eglot--outstanding-inlay-regions-timer nil
+ "Helper timer for `eglot--update-hints'")
+
+(defun eglot--update-hints (from to)
+ "Jit-lock function for Eglot inlay hints."
+ (cl-symbol-macrolet ((region eglot--outstanding-inlay-hints-region)
+ (last-region eglot--outstanding-inlay-hints-last-region)
+ (timer eglot--outstanding-inlay-regions-timer))
+ (setcar region (min (or (car region) (point-max)) from))
+ (setcdr region (max (or (cdr region) (point-min)) to))
+ ;; HACK: We're relying on knowledge of jit-lock internals here. The
+ ;; condition comparing `jit-lock-context-unfontify-pos' to
+ ;; `point-max' is a heuristic for telling whether this call to
+ ;; `jit-lock-functions' happens after `jit-lock-context-timer' has
+ ;; just run. Only after this delay should we start the smoothing
+ ;; timer that will eventually call `eglot--update-hints-1' with the
+ ;; coalesced region. I wish we didn't need the timer, but sometimes
+ ;; a lot of "non-contextual" calls come in all at once and do verify
+ ;; the condition. Notice it is a 0 second timer though, so we're
+ ;; not introducing any more delay over jit-lock's timers.
+ (when (= jit-lock-context-unfontify-pos (point-max))
+ (if timer (cancel-timer timer))
+ (let ((buf (current-buffer)))
+ (setq timer (run-at-time
+ 0 nil
+ (lambda ()
+ (eglot--when-live-buffer buf
+ ;; HACK: In some pathological situations
+ ;; (Emacs's own coding.c, for example),
+ ;; jit-lock is calling `eglot--update-hints'
+ ;; repeatedly with same sequence of
+ ;; arguments, which leads to
+ ;; `eglot--update-hints-1' being called with
+ ;; the same region repeatedly. This happens
+ ;; even if the hint-painting code does
+ ;; nothing else other than widen, narrow,
+ ;; move point then restore these things.
+ ;; Possible Emacs bug, but this fixes it.
+ (unless (equal last-region region)
+ (eglot--update-hints-1 (max (car region)
(point-min))
+ (min (cdr region)
(point-max)))
+ (setq last-region region))
+ (setq region (cons nil nil)
+ timer nil)))))))))
+
+(defun eglot--update-hints-1 (from to)
+ "Do most work for `eglot--update-hints', including LSP request."
+ (let* ((buf (current-buffer))
+ (paint-hint
+ (eglot--lambda ((InlayHint) position kind label paddingLeft
paddingRight)
+ (goto-char (eglot--lsp-position-to-point position))
+ (when (or (> (point) to) (< (point) from)) (cl-return))
+ (let ((left-pad (and paddingLeft
+ (not (eq paddingLeft :json-false))
+ (not (memq (char-before) '(32 9))) " "))
+ (right-pad (and paddingRight
+ (not (eq paddingRight :json-false))
+ (not (memq (char-after) '(32 9))) " ")))
+ (cl-flet
+ ((do-it (text lpad rpad)
+ (let ((ov (make-overlay (point) (point))))
+ (overlay-put ov 'before-string
+ (propertize
+ (concat lpad text rpad)
+ 'face (pcase kind
+ (1 'eglot-type-hint-face)
+ (2 'eglot-parameter-hint-face)
+ (_ 'eglot-inlay-hint-face))))
+ (overlay-put ov 'eglot--inlay-hint t)
+ (overlay-put ov 'eglot--overlay t))))
+ (if (stringp label) (do-it label left-pad right-pad)
+ (cl-loop
+ for i from 0 for ldetail across label
+ do (eglot--dbind ((InlayHintLabelPart) value) ldetail
+ (do-it value
+ (and (zerop i) left-pad)
+ (and (= i (1- (length label)))
right-pad))))))))))
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/inlayHint
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :range (list :start (eglot--pos-to-lsp-position from)
+ :end (eglot--pos-to-lsp-position to)))
+ :success-fn (lambda (hints)
+ (eglot--when-live-buffer buf
+ (eglot--widening
+ (remove-overlays from to 'eglot--inlay-hint t)
+ (mapc paint-hint hints))))
+ :deferred 'eglot--update-hints-1)))
+
+(define-minor-mode eglot-inlay-hints-mode
+ "Minor mode for annotating buffers with LSP server's inlay hints."
+ :global nil
+ (cond (eglot-inlay-hints-mode
+ (if (eglot--server-capable :inlayHintProvider)
+ (jit-lock-register #'eglot--update-hints 'contextual)
+ (eglot-inlay-hints-mode -1)))
+ (t
+ (jit-lock-unregister #'eglot--update-hints)
+ (remove-overlays nil nil 'eglot--inlay-hint t))))
+
+
;;; Hacks
;;;
;; FIXME: Although desktop.el compatibility is Emacs bug#56407, the
@@ -3465,6 +3664,15 @@ If NOERROR, return predicate, else erroring function."
(add-to-list 'desktop-minor-mode-handlers '(eglot--managed-mode . ignore)))
+;;; Misc
+;;;
+(defun eglot--debbugs-or-github-bug-uri ()
+ (format (if (string= (match-string 2) "github")
+ "https://github.com/joaotavora/eglot/issues/%s";
+ "https://debbugs.gnu.org/%s";)
+ (match-string 3)))
+(put 'eglot--debbugs-or-github-bug-uri 'bug-reference-url-format t)
+
;;; Obsolete
;;;
@@ -3474,8 +3682,8 @@ If NOERROR, return predicate, else erroring function."
;; Local Variables:
-;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)"
-;; bug-reference-url-format: "https://github.com/joaotavora/eglot/issues/%s";
+;; bug-reference-bug-regexp: "\\(\\(github\\|bug\\)#\\([0-9]+\\)\\)"
+;; bug-reference-url-format: eglot--debbugs-or-github-bug-uri
;; checkdoc-force-docstrings-flag: nil
;; End:
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index be969b0c3e3..45e3848362e 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -191,7 +191,7 @@ All commands in `lisp-mode-shared-map' are inherited by
this map."
menu)
(defun emacs-lisp-byte-compile ()
- "Byte compile the file containing the current buffer."
+ "Byte-compile the current buffer's file."
(interactive nil emacs-lisp-mode)
(if buffer-file-name
(byte-compile-file buffer-file-name)
@@ -220,11 +220,12 @@ All commands in `lisp-mode-shared-map' are inherited by
this map."
Load the compiled code when finished.
Use `emacs-lisp-byte-compile-and-load' in combination with
-`inhibit-automatic-native-compilation' set to nil to achieve
-asynchronous native compilation."
+`native-comp-jit-compilation' set to t to achieve asynchronous
+native compilation."
(interactive nil emacs-lisp-mode)
(emacs-lisp--before-compile-buffer)
- (load (native-compile buffer-file-name)))
+ (when-let ((out (native-compile buffer-file-name)))
+ (load out)))
(defun emacs-lisp-macroexpand ()
"Macroexpand the form after point.
@@ -943,6 +944,10 @@ namespace but with lower confidence."
cl-defmethod cl-defgeneric)))
;; (defun FUNC (... IDENT
'variable)
+ ((and (eql j 2)
+ (eq j-head 'defclass))
+ ;; (defclass CLASS (... IDENT
+ 'function)
((eq j-head 'cond)
;; (cond ... (... IDENT
'variable)
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 2edaf9e2593..060957eac29 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -255,6 +255,9 @@ This variable is updated in `gdb-done-or-error' and
returned by
It is initialized to `gdb-non-stop-setting' at the beginning of
every GDB session.")
+(defvar gdb-debuginfod-enable nil
+ "Whether the current GDB session can query debuginfod servers.")
+
(defvar-local gdb-buffer-type nil
"One of the symbols bound in `gdb-buffer-rules'.")
@@ -467,6 +470,30 @@ GDB session needs to be restarted for this setting to take
effect."
:group 'gdb-non-stop
:version "26.1")
+(defcustom gdb-debuginfod-enable-setting
+ ;; debuginfod servers are only for ELF executables, and elfutils, of
+ ;; which libdebuginfod is a part, is not usually available on
+ ;; MS-Windows.
+ (if (not (eq system-type 'windows-nt)) 'ask)
+ "Whether to enable downloading missing debug info from debuginfod servers.
+The debuginfod servers are HTTP servers for distributing source
+files and debug info files of programs. If GDB was built with
+debuginfod support, it can query these servers when you debug a
+program for which some of these files are not available locally,
+and download the files if the servers have them.
+
+The value nil means never to download from debuginfod servers.
+The value t means always download from debuginfod servers when
+some source or debug info files are missing.
+The value `ask', the default, means ask at the beginning of each
+debugging session whether to download from debuginfod servers
+during that session."
+ :type '(choice (const :tag "Never download from debuginfod servers" nil)
+ (const :tag "Download from debuginfod servers when necessary"
t)
+ (const :tag "Ask whether to download for each session" ask))
+ :group 'gdb
+ :version "29.1")
+
;; TODO Some commands can't be called with --all (give a notice about
;; it in setting doc)
(defcustom gdb-gud-control-all-threads t
@@ -1021,6 +1048,11 @@ detailed description of this mode.
(run-hooks 'gdb-mode-hook))
+(defconst gdb--string-regexp (rx "\""
+ (* (or (seq "\\" nonl)
+ (not (any "\"\\"))))
+ "\""))
+
(defun gdb-init-1 ()
;; (Re-)initialize.
(setq gdb-selected-frame nil
@@ -1044,7 +1076,8 @@ detailed description of this mode.
gdb-threads-list '()
gdb-breakpoints-list '()
gdb-register-names '()
- gdb-non-stop gdb-non-stop-setting)
+ gdb-non-stop gdb-non-stop-setting
+ gdb-debuginfod-enable gdb-debuginfod-enable-setting)
;;
(gdbmi-bnf-init)
;;
@@ -1053,6 +1086,15 @@ detailed description of this mode.
(gdb-force-mode-line-update
(propertize "initializing..." 'face font-lock-variable-name-face))
+ ;; This needs to be done before we ask GDB for anything that might
+ ;; trigger questions about debuginfod queries.
+ (if (eq gdb-debuginfod-enable 'ask)
+ (setq gdb-debuginfod-enable
+ (y-or-n-p "Enable querying debuginfod servers for this session?")))
+ (gdb-input (format "-gdb-set debuginfod enabled %s"
+ (if gdb-debuginfod-enable "on" "off"))
+ 'gdb-debuginfod-message)
+
(gdb-get-buffer-create 'gdb-inferior-io)
(gdb-clear-inferior-io)
(gdb-inferior-io--init-proc (get-process "gdb-inferior"))
@@ -1080,6 +1122,18 @@ detailed description of this mode.
(gdb-input "-file-list-exec-source-file" 'gdb-get-source-file)
(gdb-input "-gdb-show prompt" 'gdb-get-prompt))
+(defun gdb-debuginfod-message ()
+ "Show in the echo area GDB error response for a debuginfod command, if any."
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward "msg=\\(\".+\"\\)$" nil t)
+ ;; Supports debuginfod, but cannot perform command.
+ (message "%s" (buffer-substring (1+ (match-beginning 1))
+ (1- (line-end-position)))))
+ ((re-search-forward "No symbol" nil t)
+ (message "This version of GDB doesn't support debuginfod commands."))
+ (t (message nil))))
+
(defun gdb-non-stop-handler ()
(goto-char (point-min))
(if (re-search-forward "No symbol" nil t)
@@ -1148,11 +1202,6 @@ no input, and GDB is waiting for input."
(declare-function tooltip-show "tooltip" (text &optional use-echo-area
text-face default-face))
-(defconst gdb--string-regexp (rx "\""
- (* (or (seq "\\" nonl)
- (not (any "\"\\"))))
- "\""))
-
(defun gdb-tooltip-print (expr)
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(goto-char (point-min))
diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el
index 7dafe9b2e3d..e6e8abd6445 100644
--- a/lisp/progmodes/go-ts-mode.el
+++ b/lisp/progmodes/go-ts-mode.el
@@ -67,12 +67,15 @@
(defvar go-ts-mode--indent-rules
`((go
+ ((parent-is "source_file") column-0 0)
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((node-is "}") parent-bol 0)
- ((node-is "labeled_statement") no-indent)
+ ((node-is "labeled_statement") no-indent 0)
+ ((parent-is "raw_string_literal") no-indent 0)
((parent-is "argument_list") parent-bol go-ts-mode-indent-offset)
((parent-is "block") parent-bol go-ts-mode-indent-offset)
+ ((parent-is "communication_case") parent-bol go-ts-mode-indent-offset)
((parent-is "const_declaration") parent-bol go-ts-mode-indent-offset)
((parent-is "default_case") parent-bol go-ts-mode-indent-offset)
((parent-is "expression_case") parent-bol go-ts-mode-indent-offset)
@@ -83,7 +86,10 @@
((parent-is "labeled_statement") parent-bol go-ts-mode-indent-offset)
((parent-is "literal_value") parent-bol go-ts-mode-indent-offset)
((parent-is "parameter_list") parent-bol go-ts-mode-indent-offset)
+ ((parent-is "select_statement") parent-bol 0)
+ ((parent-is "type_case") parent-bol go-ts-mode-indent-offset)
((parent-is "type_spec") parent-bol go-ts-mode-indent-offset)
+ ((parent-is "type_switch_statement") parent-bol 0)
((parent-is "var_declaration") parent-bol go-ts-mode-indent-offset)
(no-node parent-bol 0)))
"Tree-sitter indent rules for `go-ts-mode'.")
@@ -120,17 +126,32 @@
:feature 'delimiter
'((["," "." ";" ":"]) @font-lock-delimiter-face)
+ :language 'go
+ :feature 'definition
+ '((function_declaration
+ name: (identifier) @font-lock-function-name-face)
+ (method_declaration
+ name: (field_identifier) @font-lock-function-name-face)
+ (method_spec
+ name: (field_identifier) @font-lock-function-name-face)
+ (field_declaration
+ name: (field_identifier) @font-lock-property-name-face)
+ (parameter_declaration
+ name: (identifier) @font-lock-variable-name-face)
+ (short_var_declaration
+ left: (expression_list
+ (identifier) @font-lock-variable-name-face
+ ("," (identifier) @font-lock-variable-name-face)*))
+ (var_spec name: (identifier) @font-lock-variable-name-face
+ ("," name: (identifier) @font-lock-variable-name-face)*))
+
:language 'go
:feature 'function
'((call_expression
- function: (identifier) @font-lock-function-name-face)
+ function: (identifier) @font-lock-function-call-face)
(call_expression
function: (selector_expression
- field: (field_identifier) @font-lock-function-name-face))
- (function_declaration
- name: (identifier) @font-lock-function-name-face)
- (method_declaration
- name: (field_identifier) @font-lock-function-name-face))
+ field: (field_identifier) @font-lock-function-call-face)))
:language 'go
:feature 'keyword
@@ -156,21 +177,20 @@
:feature 'type
'([(package_identifier) (type_identifier)] @font-lock-type-face)
+ :language 'go
+ :feature 'property
+ '((selector_expression field: (field_identifier)
@font-lock-property-use-face)
+ (keyed_element (_ (identifier) @font-lock-property-use-face)))
+
:language 'go
:feature 'variable
- '((identifier) @font-lock-variable-name-face)
+ '((identifier) @font-lock-variable-use-face)
:language 'go
:feature 'escape-sequence
:override t
'((escape_sequence) @font-lock-escape-face)
- :language 'go
- :feature 'property
- :override t
- '((field_identifier) @font-lock-property-face
- (keyed_element (_ (identifier) @font-lock-property-face)))
-
:language 'go
:feature 'error
:override t
@@ -225,11 +245,10 @@
;; Font-lock.
(setq-local treesit-font-lock-settings go-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list
- '(( comment)
+ '(( comment definition)
( keyword string type)
- ( constant escape-sequence function label number
- property variable)
- ( bracket delimiter error operator)))
+ ( constant escape-sequence label number)
+ ( bracket delimiter error function operator property
variable)))
(treesit-major-mode-setup)))
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 0da16b44dda..82e9c5d8edf 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -457,6 +457,33 @@ buffer `default-directory'."
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
+(defcustom grep-use-headings nil
+ "If non-nil, subdivide grep output into sections, one per file."
+ :type 'boolean
+ :version "30.1")
+
+(defface grep-heading `((t :inherit ,grep-hit-face))
+ "Face of headings when `grep-use-headings' is non-nil."
+ :version "30.1")
+
+(defvar grep-heading-regexp
+ (rx bol
+ (or
+ (group-n 2
+ (group-n 1 (+ (not (any 0 ?\n))))
+ 0)
+ (group-n 2
+ (group-n 1 (+? nonl))
+ (any ?: ?- ?=)))
+ (+ digit)
+ (any ?: ?- ?=))
+ "Regexp used to create headings from grep output lines.
+It should be anchored at beginning of line. The first capture
+group, if present, should match the heading associated to the
+line. The buffer range of the second capture, if present, is
+made invisible (presumably because displaying it would be
+redundant).")
+
(defvar grep-find-abbreviate-properties
(let ((ellipsis (if (char-displayable-p ?…) "[…]" "[...]"))
(map (make-sparse-keymap)))
@@ -612,6 +639,40 @@ This function is called from `compilation-filter-hook'."
(while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
(replace-match "" t t))))))
+(defvar grep--heading-format
+ (eval-when-compile
+ (let ((title (propertize "%s"
+ 'font-lock-face 'grep-heading
+ 'outline-level 1)))
+ (propertize (concat title "\n") 'compilation-annotation t)))
+ "Format string of grep headings.
+This is passed to `format' with one argument, the text of the
+first capture group of `grep-heading-regexp'.")
+
+(defvar-local grep--heading-state nil
+ "Variable to keep track of the `grep--heading-filter' state.")
+
+(defun grep--heading-filter ()
+ "Filter function to add headings to output of a grep process."
+ (unless grep--heading-state
+ (setq grep--heading-state (cons (point-min-marker) nil)))
+ (save-excursion
+ (let ((limit (car grep--heading-state)))
+ ;; Move point to the old limit and update limit marker.
+ (move-marker limit (prog1 (pos-bol) (goto-char limit)))
+ (while (re-search-forward grep-heading-regexp limit t)
+ (unless (get-text-property (point) 'compilation-annotation)
+ (let ((heading (match-string-no-properties 1))
+ (start (match-beginning 2))
+ (end (match-end 2)))
+ (when start
+ (put-text-property start end 'invisible t))
+ (when (and heading (not (equal heading (cdr grep--heading-state))))
+ (save-excursion
+ (goto-char (pos-bol))
+ (insert-before-markers (format grep--heading-format heading)))
+ (setf (cdr grep--heading-state) heading))))))))
+
(defun grep-probe (command args &optional func result)
(let (process-file-side-effects)
(equal (condition-case nil
@@ -906,6 +967,11 @@ The value depends on `grep-command', `grep-template',
(add-function :filter-return (local 'kill-transform-function)
(lambda (string)
(string-replace "\0" ":" string)))
+ (when grep-use-headings
+ (add-hook 'compilation-filter-hook #'grep--heading-filter 80 t)
+ (setq-local outline-search-function #'outline-search-level
+ outline-level (lambda () (get-text-property
+ (point) 'outline-level))))
(add-hook 'compilation-filter-hook #'grep-filter nil t))
(defun grep--save-buffers ()
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el
index e4153725efd..1115eadde7f 100644
--- a/lisp/progmodes/java-ts-mode.el
+++ b/lisp/progmodes/java-ts-mode.el
@@ -69,22 +69,26 @@
(defvar java-ts-mode--indent-rules
`((java
- ((parent-is "program") point-min 0)
- ((node-is "}") (and parent parent-bol) 0)
+ ((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 ")") parent-bol 0)
+ ((node-is "else") parent-bol 0)
((node-is "]") parent-bol 0)
((and (parent-is "comment") c-ts-common-looking-at-star)
c-ts-common-comment-start-after-first-star -1)
((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "text_block") no-indent)
- ((parent-is "class_body") parent-bol java-ts-mode-indent-offset)
- ((parent-is "annotation_type_body") parent-bol java-ts-mode-indent-offset)
- ((parent-is "interface_body") parent-bol java-ts-mode-indent-offset)
- ((parent-is "constructor_body") parent-bol java-ts-mode-indent-offset)
+ ((parent-is "class_body") column-0 c-ts-common-statement-offset)
+ ((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 "enum_body_declarations") parent-bol 0)
- ((parent-is "enum_body") parent-bol java-ts-mode-indent-offset)
- ((parent-is "switch_block") parent-bol java-ts-mode-indent-offset)
- ((parent-is "record_declaration_body") parent-bol
java-ts-mode-indent-offset)
+ ((parent-is "enum_body") column-0 c-ts-common-statement-offset)
+ ((parent-is "switch_block") column-0 c-ts-common-statement-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)
((parent-is "local_variable_declaration") parent-bol
java-ts-mode-indent-offset)
@@ -117,7 +121,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") (and parent parent-bol) java-ts-mode-indent-offset)))
+ ((parent-is "block") column-0 c-ts-common-statement-offset)))
"Tree-sitter indent rules.")
(defvar java-ts-mode--keywords
@@ -158,7 +162,8 @@
:override t
:feature 'keyword
`([,@java-ts-mode--keywords
- (this)] @font-lock-keyword-face
+ (this)
+ (super)] @font-lock-keyword-face
(labeled_statement
(identifier) @font-lock-keyword-face))
:language 'java
@@ -215,7 +220,7 @@
(method_reference (identifier) @font-lock-type-face)
- (scoped_identifier (identifier) @font-lock-variable-name-face)
+ (scoped_identifier (identifier) @font-lock-constant-face)
((scoped_identifier name: (identifier) @font-lock-type-face)
(:match "^[A-Z]" @font-lock-type-face))
@@ -239,7 +244,7 @@
name: (identifier) @font-lock-variable-name-face)
(element_value_pair
- key: (identifier) @font-lock-property-face)
+ key: (identifier) @font-lock-property-use-face)
(formal_parameter
name: (identifier) @font-lock-variable-name-face)
@@ -250,14 +255,14 @@
:override t
:feature 'expression
'((method_invocation
- object: (identifier) @font-lock-variable-name-face)
+ object: (identifier) @font-lock-variable-use-face)
(method_invocation
- name: (identifier) @font-lock-function-name-face)
+ name: (identifier) @font-lock-function-call-face)
(argument_list (identifier) @font-lock-variable-name-face)
- (expression_statement (identifier) @font-lock-variable-name-face))
+ (expression_statement (identifier) @font-lock-variable-use-face))
:language 'java
:feature 'bracket
@@ -304,6 +309,24 @@ Return nil if there is no name or if NODE is not a defun
node."
"text_block")))
;; Indent.
+ (setq-local c-ts-common-indent-type-regexp-alist
+ `((block . ,(rx (or "class_body"
+ "array_initializer"
+ "constructor_body"
+ "annotation_type_body"
+ "interface_body"
+ "lambda_expression"
+ "enum_body"
+ "switch_block"
+ "record_declaration_body"
+ "block")))
+ (close-bracket . "}")
+ (if . "if_statement")
+ (else . ("if_statement" . "alternative"))
+ (for . "for_statement")
+ (while . "while_statement")
+ (do . "do_statement")))
+ (setq-local c-ts-common-indent-offset 'java-ts-mode-indent-offset)
(setq-local treesit-simple-indent-rules java-ts-mode--indent-rules)
;; Electric
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 6ae325c0657..f68ecb6fa6c 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -3442,6 +3442,7 @@ This function is intended for use in
`after-change-functions'."
((parent-is "arguments") parent-bol js-indent-level)
((parent-is "array") parent-bol js-indent-level)
((parent-is "formal_parameters") parent-bol js-indent-level)
+ ((parent-is "template_string") no-indent) ; Don't indent the string
contents.
((parent-is "template_substitution") parent-bol js-indent-level)
((parent-is "object_pattern") parent-bol js-indent-level)
((parent-is "object") parent-bol js-indent-level)
@@ -3457,12 +3458,14 @@ This function is intended for use in
`after-change-functions'."
((match "<" "jsx_fragment") parent 0)
((parent-is "jsx_fragment") parent js-indent-level)
((node-is "jsx_closing_element") parent 0)
- ((node-is "jsx_element") parent js-indent-level)
+ ((match "jsx_element" "statement") parent js-indent-level)
((parent-is "jsx_element") parent js-indent-level)
+ ((parent-is "jsx_text") parent-bol js-indent-level)
((parent-is "jsx_opening_element") parent js-indent-level)
((parent-is "jsx_expression") parent-bol js-indent-level)
((match "/" "jsx_self_closing_element") parent 0)
((parent-is "jsx_self_closing_element") parent js-indent-level)
+ ;; FIXME(Theo): This no-node catch-all should be removed. When is it
needed?
(no-node parent-bol 0)))))
(defvar js--treesit-keywords
@@ -3541,11 +3544,10 @@ This function is intended for use in
`after-change-functions'."
value: [(function) (arrow_function)])
(variable_declarator
- name: (array_pattern
- (identifier)
- (identifier)
- @font-lock-function-name-face)
- value: (array (number) (function)))
+ name: [(array_pattern (identifier) @font-lock-variable-name-face)
+ (object_pattern
+ (shorthand_property_identifier_pattern)
@font-lock-variable-name-face)])
+
;; full module imports
(import_clause (identifier) @font-lock-variable-name-face)
;; named imports with aliasing
@@ -3561,15 +3563,13 @@ This function is intended for use in
`after-change-functions'."
:language 'javascript
:feature 'property
- '(((property_identifier) @font-lock-property-face
+ '(((property_identifier) @font-lock-property-use-face
(:pred js--treesit-property-not-function-p
- @font-lock-property-face))
-
- (pair value: (identifier) @font-lock-variable-name-face)
+ @font-lock-property-use-face))
- ((shorthand_property_identifier) @font-lock-property-face)
+ (pair value: (identifier) @font-lock-variable-use-face)
- ((shorthand_property_identifier_pattern) @font-lock-property-face))
+ ((shorthand_property_identifier) @font-lock-property-use-face))
:language 'javascript
:feature 'assignment
@@ -3579,14 +3579,14 @@ This function is intended for use in
`after-change-functions'."
:language 'javascript
:feature 'function
'((call_expression
- function: [(identifier) @font-lock-function-name-face
+ function: [(identifier) @font-lock-function-call-face
(member_expression
property:
- (property_identifier) @font-lock-function-name-face)])
+ (property_identifier) @font-lock-function-call-face)])
(method_definition
name: (property_identifier) @font-lock-function-name-face)
(function_declaration
- name: (identifier) @font-lock-function-name-face)
+ name: (identifier) @font-lock-function-call-face)
(function
name: (identifier) @font-lock-function-name-face))
@@ -3594,15 +3594,15 @@ This function is intended for use in
`after-change-functions'."
:feature 'jsx
'((jsx_opening_element
[(nested_identifier (identifier)) (identifier)]
- @font-lock-function-name-face)
+ @font-lock-function-call-face)
(jsx_closing_element
[(nested_identifier (identifier)) (identifier)]
- @font-lock-function-name-face)
+ @font-lock-function-call-face)
(jsx_self_closing_element
[(nested_identifier (identifier)) (identifier)]
- @font-lock-function-name-face)
+ @font-lock-function-call-face)
(jsx_attribute
(property_identifier)
@@ -3681,8 +3681,8 @@ For OVERRIDE, START, END, see `treesit-font-lock-rules'."
(treesit-fontify-with-override
(treesit-node-start node) (treesit-node-end node)
(pcase (treesit-node-type node)
- ("identifier" 'font-lock-variable-name-face)
- ("property_identifier" 'font-lock-property-face))
+ ("identifier" 'font-lock-variable-use-face)
+ ("property_identifier" 'font-lock-property-use-face))
override start end)))
(defun js--treesit-defun-name (node)
@@ -3872,7 +3872,7 @@ See `treesit-sexp-type-regexp' for more information.")
;; Electric-indent.
(setq-local electric-indent-chars
- (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds
"[]*".
+ (append "{}():;,<>/" electric-indent-chars)) ;FIXME: js2-mode
adds "[]*".
(setq-local electric-layout-rules
'((?\; . after) (?\{ . after) (?\} . before)))
diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el
index 6bd9d30328e..f56d118c0fe 100644
--- a/lisp/progmodes/json-ts-mode.el
+++ b/lisp/progmodes/json-ts-mode.el
@@ -101,7 +101,7 @@
:language 'json
:feature 'pair
:override t ; Needed for overriding string face on keys.
- '((pair key: (_) @font-lock-variable-name-face))
+ '((pair key: (_) @font-lock-property-use-face))
:language 'json
:feature 'error
:override t
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 2343adf4698..11228226592 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2023 Free Software Foundation, Inc.
-;; Version: 0.9.6
+;; Version: 0.9.8
;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -494,24 +494,33 @@ files related to the current buffer.
The directory names should be absolute. Used in the VC-aware
project backend implementation of `project-external-roots'.")
+(defvar project-vc-backend-markers-alist
+ `((Git . ".git")
+ (Hg . ".hg")
+ (Bzr . ".bzr")
+ ;; See the comment above `vc-svn-admin-directory' for why we're
+ ;; duplicating the definition.
+ (SVN . ,(if (and (memq system-type '(cygwin windows-nt ms-dos))
+ (getenv "SVN_ASP_DOT_NET_HACK"))
+ "_svn"
+ ".svn"))
+ (DARCS . "_darcs")
+ (Fossil . ".fslckout")
+ (Got . ".got"))
+ "Associative list assigning root markers to VC backend symbols.
+
+See `project-vc-extra-root-markers' for the marker value format.")
+
(defun project-try-vc (dir)
- (defvar vc-svn-admin-directory)
- (require 'vc-svn)
;; FIXME: Learn to invalidate when the value of
;; `project-vc-merge-submodules' or `project-vc-extra-root-markers'
;; changes.
(or (vc-file-getprop dir 'project-vc)
- (let* ((backend-markers-alist `((Git . ".git")
- (Hg . ".hg")
- (Bzr . ".bzr")
- (SVN . ,vc-svn-admin-directory)
- (DARCS . "_darcs")
- (Fossil . ".fslckout")))
- (backend-markers
+ (let* ((backend-markers
(delete
nil
(mapcar
- (lambda (b) (assoc-default b backend-markers-alist))
+ (lambda (b) (assoc-default b project-vc-backend-markers-alist))
vc-handled-backends)))
(marker-re
(concat
@@ -537,7 +546,7 @@ project backend implementation of
`project-external-roots'.")
(backend
(cl-find-if
(lambda (b)
- (member (assoc-default b backend-markers-alist)
+ (member (assoc-default b project-vc-backend-markers-alist)
last-matches))
vc-handled-backends))
project)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index df0d1c96965..1f970633bfc 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1070,7 +1070,7 @@ fontified."
;; Don't highlight string prefixes like f/r/b.
(save-excursion
(goto-char string-beg)
- (when (search-forward "\"" string-end t)
+ (when (re-search-forward "[\"']" string-end t)
(setq string-beg (match-beginning 0))))
(treesit-fontify-with-override
string-beg string-end face override start end)))
@@ -1106,24 +1106,25 @@ fontified."
:language 'python
'((interpolation) @python--treesit-fontify-string-interpolation)
+ :feature 'keyword
+ :language 'python
+ `([,@python--treesit-keywords] @font-lock-keyword-face
+ ((identifier) @font-lock-keyword-face
+ (:match "^self$" @font-lock-keyword-face)))
+
:feature 'definition
:language 'python
'((function_definition
name: (identifier) @font-lock-function-name-face)
(class_definition
- name: (identifier) @font-lock-type-face))
+ name: (identifier) @font-lock-type-face)
+ (parameters (identifier) @font-lock-variable-name-face))
:feature 'function
:language 'python
- '((call function: (identifier) @font-lock-function-name-face)
+ '((call function: (identifier) @font-lock-function-call-face)
(call function: (attribute
- attribute: (identifier) @font-lock-function-name-face)))
-
- :feature 'keyword
- :language 'python
- `([,@python--treesit-keywords] @font-lock-keyword-face
- ((identifier) @font-lock-keyword-face
- (:match "^self$" @font-lock-keyword-face)))
+ attribute: (identifier) @font-lock-function-call-face)))
:feature 'builtin
:language 'python
@@ -1146,7 +1147,7 @@ fontified."
@font-lock-variable-name-face)
(assignment left: (attribute
attribute: (identifier)
- @font-lock-property-face))
+ @font-lock-property-use-face))
(pattern_list (identifier)
@font-lock-variable-name-face)
(tuple_pattern (identifier)
@@ -1183,12 +1184,12 @@ fontified."
:feature 'property
:language 'python
'((attribute
- attribute: (identifier) @font-lock-property-face)
+ attribute: (identifier) @font-lock-property-use-face)
(class_definition
body: (block
(expression_statement
(assignment left:
- (identifier) @font-lock-property-face)))))
+ (identifier) @font-lock-property-use-face)))))
:feature 'operator
:language 'python
@@ -1211,10 +1212,10 @@ fontified."
"Check whether NODE is a variable.
NODE's type should be \"identifier\"."
;; An identifier can be a function/class name, a property, or a
- ;; variables. This function filters out function/class names and
- ;; properties.
+ ;; variables. This function filters out function/class names,
+ ;; properties and method parameters.
(pcase (treesit-node-type (treesit-node-parent node))
- ((or "function_definition" "class_definition") nil)
+ ((or "function_definition" "class_definition" "parameters") nil)
("attribute"
(pcase (treesit-node-field-name node)
("object" t)
@@ -3759,14 +3760,15 @@ the python shell:
whitespaces will be removed. Otherwise, wraps indented
regions under an \"if True:\" block so the interpreter
evaluates them correctly."
- (let* ((single-p (save-restriction
- (narrow-to-region start end)
- (= (progn
- (goto-char start)
- (python-nav-beginning-of-statement))
- (progn
- (goto-char end)
- (python-nav-beginning-of-statement)))))
+ (let* ((single-p (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (= (progn
+ (goto-char start)
+ (python-nav-beginning-of-statement))
+ (progn
+ (goto-char end)
+ (python-nav-beginning-of-statement))))))
(start (save-excursion
;; If we're at the start of the expression, and if
;; the region consists of a single statement, then
@@ -3785,10 +3787,11 @@ the python shell:
(line-beginning-position)
start))))
(substring (buffer-substring-no-properties start end))
- (starts-at-first-line-p (save-restriction
- (widen)
- (goto-char start)
- (= (line-number-at-pos) 1)))
+ (starts-at-first-line-p (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char start)
+ (= (line-number-at-pos) 1))))
(encoding (python-info-encoding))
(toplevel-p (zerop (save-excursion
(goto-char start)
@@ -6374,7 +6377,7 @@ for key in sorted(result):
"List files containing Python imports that may be useful in the current
buffer."
(if-let (((featurep 'project)) ;For compatibility with Emacs < 26
(proj (project-current)))
- (seq-filter (lambda (s) (string-match-p "\\.py[ciw]?\\'" s))
+ (seq-filter (lambda (s) (string-match-p "\\.py[iwx]?\\'" s))
(project-files proj))
(list default-directory)))
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index dba9ff0a846..d2c4da794ac 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -909,16 +909,21 @@ This only affects the output of the command
`ruby-toggle-block'."
"<<=" ">>=" "&&=" "||=" "and" "or"))
(cond
((not ruby-after-operator-indent)
- (ruby-smie--indent-to-stmt ruby-indent-level))
+ (ruby-smie--indent-to-stmt (if (smie-indent--hanging-p)
+ ruby-indent-level
+ 0)))
((and (smie-rule-parent-p ";" nil)
(smie-indent--hanging-p))
ruby-indent-level)))
(`(:before . "=")
- (save-excursion
- (and (smie-rule-parent-p " @ ")
- (goto-char (nth 1 (smie-indent--parent)))
- (smie-rule-prev-p "def=")
- (cons 'column (+ (current-column) ruby-indent-level -3)))))
+ (or
+ (save-excursion
+ (and (smie-rule-parent-p " @ ")
+ (goto-char (nth 1 (smie-indent--parent)))
+ (smie-rule-prev-p "def=")
+ (cons 'column (+ (current-column) ruby-indent-level -3))))
+ (and (smie-rule-parent-p ",")
+ (smie-rule-parent))))
(`(:after . ,(or "?" ":"))
(if ruby-after-operator-indent
ruby-indent-level
@@ -1845,93 +1850,92 @@ For example:
File.open
See `add-log-current-defun-function'."
- (condition-case nil
- (save-excursion
- (let* ((indent (ruby--add-log-current-indent))
- mname mlist
- (start (point))
- (make-definition-re
- (lambda (re &optional method-name?)
- (concat "^[ \t]*" re "[ \t]+"
- "\\("
- ;; \\. and :: for class methods
- "\\([A-Za-z_]" ruby-symbol-re "*[?!]?"
- "\\|"
- (if method-name? ruby-operator-re "\\.")
- "\\|::" "\\)"
- "+\\)")))
- (definition-re (funcall make-definition-re ruby-defun-beg-re t))
- (module-re (funcall make-definition-re "\\(class\\|module\\)")))
- ;; Get the current method definition (or class/module).
- (when (catch 'found
- (while (and (re-search-backward definition-re nil t)
- (if (if (string-equal "def" (match-string 1))
- ;; We're inside a method.
- (if (ruby-block-contains-point (1-
start))
- t
- ;; Try to match a method only once.
- (setq definition-re module-re)
- nil)
- ;; Class/module. For performance,
- ;; comparing indentation.
- (or (not (numberp indent))
- (> indent (current-indentation))))
- (throw 'found t)
- t))))
- (goto-char (match-beginning 1))
- (if (not (string-equal "def" (match-string 1)))
- (setq mlist (list (match-string 2)))
- (setq mname (match-string 2)))
- (setq indent (current-column))
- (beginning-of-line))
- ;; Walk up the class/module nesting.
- (while (and indent
- (> indent 0)
- (re-search-backward module-re nil t))
- (goto-char (match-beginning 1))
- (when (< (current-column) indent)
- (setq mlist (cons (match-string 2) mlist))
- (setq indent (current-column))
- (beginning-of-line)))
- ;; Process the method name.
- (when mname
- (let ((mn (split-string mname "\\.\\|::")))
- (if (cdr mn)
- (progn
- (unless (string-equal "self" (car mn)) ; def self.foo
- ;; def C.foo
- (let ((ml (nreverse mlist)))
- ;; If the method name references one of the
- ;; containing modules, drop the more nested ones.
- (while ml
- (if (string-equal (car ml) (car mn))
- (setq mlist (nreverse (cdr ml)) ml nil))
- (or (setq ml (cdr ml)) (nreverse mlist))))
- (if mlist
- (setcdr (last mlist) (butlast mn))
- (setq mlist (butlast mn))))
- (setq mname (concat "." (car (last mn)))))
- ;; See if the method is in singleton class context.
- (let ((in-singleton-class
- (when (re-search-forward ruby-singleton-class-re start
t)
- (goto-char (match-beginning 0))
- ;; FIXME: Optimize it out, too?
- ;; This can be slow in a large file, but
- ;; unlike class/module declaration
- ;; indentations, method definitions can be
- ;; intermixed with these, and may or may not
- ;; be additionally indented after visibility
- ;; keywords.
- (ruby-block-contains-point start))))
- (setq mname (concat
- (if in-singleton-class "." "#")
- mname))))))
- ;; Generate the string.
- (if (consp mlist)
- (setq mlist (mapconcat (function identity) mlist "::")))
- (if mname
- (if mlist (concat mlist mname) mname)
- mlist)))))
+ (save-excursion
+ (let* ((indent (ruby--add-log-current-indent))
+ mname mlist
+ (start (point))
+ (make-definition-re
+ (lambda (re &optional method-name?)
+ (concat "^[ \t]*" re "[ \t]+"
+ "\\("
+ ;; \\. and :: for class methods
+ "\\([A-Za-z_]" ruby-symbol-re "*[?!]?"
+ "\\|"
+ (if method-name? ruby-operator-re "\\.")
+ "\\|::" "\\)"
+ "+\\)")))
+ (definition-re (funcall make-definition-re ruby-defun-beg-re t))
+ (module-re (funcall make-definition-re "\\(class\\|module\\)")))
+ ;; Get the current method definition (or class/module).
+ (when (catch 'found
+ (while (and (re-search-backward definition-re nil t)
+ (if (if (string-equal "def" (match-string 1))
+ ;; We're inside a method.
+ (if (ruby-block-contains-point (1- start))
+ t
+ ;; Try to match a method only once.
+ (setq definition-re module-re)
+ nil)
+ ;; Class/module. For performance,
+ ;; comparing indentation.
+ (or (not (numberp indent))
+ (> indent (current-indentation))))
+ (throw 'found t)
+ t))))
+ (goto-char (match-beginning 1))
+ (if (not (string-equal "def" (match-string 1)))
+ (setq mlist (list (match-string 2)))
+ (setq mname (match-string 2)))
+ (setq indent (current-column))
+ (beginning-of-line))
+ ;; Walk up the class/module nesting.
+ (while (and indent
+ (> indent 0)
+ (re-search-backward module-re nil t))
+ (goto-char (match-beginning 1))
+ (when (< (current-column) indent)
+ (setq mlist (cons (match-string 2) mlist))
+ (setq indent (current-column))
+ (beginning-of-line)))
+ ;; Process the method name.
+ (when mname
+ (let ((mn (split-string mname "\\.\\|::")))
+ (if (cdr mn)
+ (progn
+ (unless (string-equal "self" (car mn)) ; def self.foo
+ ;; def C.foo
+ (let ((ml (nreverse mlist)))
+ ;; If the method name references one of the
+ ;; containing modules, drop the more nested ones.
+ (while ml
+ (if (string-equal (car ml) (car mn))
+ (setq mlist (nreverse (cdr ml)) ml nil))
+ (or (setq ml (cdr ml)) (nreverse mlist))))
+ (if mlist
+ (setcdr (last mlist) (butlast mn))
+ (setq mlist (butlast mn))))
+ (setq mname (concat "." (car (last mn)))))
+ ;; See if the method is in singleton class context.
+ (let ((in-singleton-class
+ (when (re-search-forward ruby-singleton-class-re start t)
+ (goto-char (match-beginning 0))
+ ;; FIXME: Optimize it out, too?
+ ;; This can be slow in a large file, but
+ ;; unlike class/module declaration
+ ;; indentations, method definitions can be
+ ;; intermixed with these, and may or may not
+ ;; be additionally indented after visibility
+ ;; keywords.
+ (ruby-block-contains-point start))))
+ (setq mname (concat
+ (if in-singleton-class "." "#")
+ mname))))))
+ ;; Generate the string.
+ (if (consp mlist)
+ (setq mlist (mapconcat (function identity) mlist "::")))
+ (if mname
+ (if mlist (concat mlist mname) mname)
+ mlist))))
(defun ruby-block-contains-point (pt)
(save-excursion
diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el
index beaab2e76e6..b2842c33d29 100644
--- a/lisp/progmodes/ruby-ts-mode.el
+++ b/lisp/progmodes/ruby-ts-mode.el
@@ -95,6 +95,11 @@
(declare-function treesit-node-end "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-string "treesit.c")
+(declare-function treesit-query-compile "treesit.c")
+(declare-function treesit-query-capture "treesit.c")
+(declare-function treesit-parser-add-notifier "treesit.c")
+(declare-function treesit-parser-buffer "treesit.c")
+(declare-function treesit-parser-list "treesit.c")
(defgroup ruby-ts nil
"Major mode for editing Ruby code."
@@ -287,11 +292,11 @@ values of OVERRIDE"
:language language
:feature 'global
- '((global_variable) @font-lock-variable-name-face)
+ '((global_variable) @font-lock-variable-use-face)
:language language
:feature 'instance
- '((instance_variable) @font-lock-variable-name-face)
+ '((instance_variable) @font-lock-variable-use-face)
:language language
:feature 'method-definition
@@ -345,7 +350,7 @@ values of OVERRIDE"
:language language
:feature 'function
'((call
- method: (identifier) @font-lock-function-name-face))
+ method: (identifier) @font-lock-function-call-face))
:language language
:feature 'assignment
@@ -552,7 +557,7 @@ a statement container is a node that matches
(let ((common
`(
;; Slam all top level nodes to the left margin
- ((parent-is "program") point-min 0)
+ ((parent-is "program") column-0 0)
;; Do not indent here docs or the end. Not sure why it
;; takes the grand-parent but ok fine.
@@ -566,7 +571,7 @@ a statement container is a node that matches
;; Incomplete buffer state, better not reindent (bug#61017).
((and (parent-is "ERROR")
(or (node-is ,ruby-ts--class-or-module-regex)
- (node-is "\\`def\\'")))
+ (node-is "\\`\\(?:def\\|identifier\\)\\'")))
no-indent 0)
;; if then else elseif notes:
@@ -656,6 +661,13 @@ a statement container is a node that matches
((n-p-gp nil "body_statement" ,ruby-ts--method-regex) ;other
statements
(ruby-ts--align-keywords ruby-ts--grand-parent-node)
ruby-indent-level)
+ ;; Quirk of the ruby parser: these "alignable" nodes don't
+ ;; have the "container" child node when there are no
+ ;; statements inside. Thus we have to have a separate rule
+ ;; for the "empty if/unless/case/def" situation.
+ ((match "\\`\\'" "\\`\\(?:if\\|unless\\|case\\|method\\)\\'")
+ (ruby-ts--align-keywords ruby-ts--parent-node) ruby-indent-level)
+
;; Chained calls:
;; if `ruby-align-chained-calls' is true, the first query
;; matches and the node is aligned under the first dot (.);
@@ -1002,6 +1014,78 @@ leading double colon is not added."
(concat result sep method-name)
result)))
+(defvar ruby-ts--s-p-query
+ (when (treesit-available-p)
+ (treesit-query-compile 'ruby
+ '(((heredoc_body) @heredoc)
+ ;; $' $" $`.
+ ((global_variable) @global_var
+ (:match "\\`\\$[#\"'`:?]" @global_var))
+ ;; ?' ?" ?` are character literals.
+ ((character) @char
+ (:match "\\`?[#\"'`:?]" @char))
+ ;; Symbols like :+, :<=> or :foo=.
+ ((simple_symbol) @symbol
+ (:match "[[:punct:]]" @symbol))
+ ;; Method calls with name ending with ? or !.
+ ((call method: (identifier) @ident)
+ (:match "[?!]\\'" @ident))
+ ;; Backtick method redefinition.
+ ((operator "`" @backtick))
+ ;; TODO: Stop at interpolations.
+ ((regex "/" @regex_slash))
+ ;; =begin...=end
+ ((comment) @comm
+ (:match "\\`=" @comm))
+ ;; Percent literals: %w[], %q{}, ...
+ ((string) @percent
+ (:match "\\`%" @percent))))))
+
+(defun ruby-ts--syntax-propertize (beg end)
+ (let ((captures (treesit-query-capture 'ruby ruby-ts--s-p-query beg end)))
+ (pcase-dolist (`(,name . ,node) captures)
+ (pcase-exhaustive name
+ ('regex_slash
+ ;; N.B.: A regexp literal with modifiers actually includes them in
+ ;; the trailing "/" node.
+ (put-text-property (treesit-node-start node) (1+ (treesit-node-start
node))
+ 'syntax-table
+ ;; Differentiate the %r{...} literals.
+ (if (eq ?/ (char-after (treesit-node-start node)))
+ (string-to-syntax "\"/")
+ (string-to-syntax "|"))))
+ ('ident
+ (put-text-property (1- (treesit-node-end node)) (treesit-node-end
node)
+ 'syntax-table (string-to-syntax "_")))
+ ('symbol
+ (put-text-property (1+ (treesit-node-start node)) (treesit-node-end
node)
+ 'syntax-table (string-to-syntax "_")))
+ ('heredoc
+ (put-text-property (treesit-node-start node) (1+ (treesit-node-start
node))
+ 'syntax-table (string-to-syntax "\""))
+ (put-text-property (treesit-node-end node) (1+ (treesit-node-end
node))
+ 'syntax-table (string-to-syntax "\"")))
+ ('percent
+ ;; FIXME: Put the first one on the first paren in both %Q{} and %().
+ ;; That would stop electric-pair-mode from pairing, though. Hmm.
+ (put-text-property (treesit-node-start node) (1+ (treesit-node-start
node))
+ 'syntax-table (string-to-syntax "|"))
+ (put-text-property (1- (treesit-node-end node)) (treesit-node-end
node)
+ 'syntax-table (string-to-syntax "|")))
+ ((or 'global_var 'char)
+ (put-text-property (treesit-node-start node) (1+ (treesit-node-start
node))
+ 'syntax-table (string-to-syntax "'"))
+ (put-text-property (1+ (treesit-node-start node)) (treesit-node-end
node)
+ 'syntax-table (string-to-syntax "_")))
+ ('backtick
+ (put-text-property (treesit-node-start node) (treesit-node-end node)
+ 'syntax-table (string-to-syntax "_")))
+ ('comm
+ (dolist (pos (list (treesit-node-start node)
+ (1- (treesit-node-end node))))
+ (put-text-property pos (1+ pos) 'syntax-table
+ (string-to-syntax "!"))))))))
+
(defvar-keymap ruby-ts-mode-map
:doc "Keymap used in Ruby mode"
:parent prog-mode-map
@@ -1066,7 +1150,21 @@ leading double colon is not added."
interpolation literal symbol assignment)
( bracket error function operator punctuation)))
- (treesit-major-mode-setup))
+ (treesit-major-mode-setup)
+
+ (treesit-parser-add-notifier (car (treesit-parser-list))
+ #'ruby-ts--parser-after-change)
+
+ (setq-local syntax-propertize-function #'ruby-ts--syntax-propertize))
+
+(defun ruby-ts--parser-after-change (ranges parser)
+ ;; Make sure we re-syntax-propertize the full node that is being
+ ;; edited. This is most pertinent to multi-line complex nodes such
+ ;; as heredocs.
+ (when ranges
+ (with-current-buffer (treesit-parser-buffer parser)
+ (syntax-ppss-flush-cache (cl-loop for r in ranges
+ minimize (car r))))))
(if (treesit-ready-p 'ruby)
;; Copied from ruby-mode.el.
diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el
index e317793d211..696c2633231 100644
--- a/lisp/progmodes/rust-ts-mode.el
+++ b/lisp/progmodes/rust-ts-mode.el
@@ -36,8 +36,10 @@
(declare-function treesit-node-child "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-end "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-parent "treesit.c")
+(declare-function treesit-query-compile "treesit.c")
(defcustom rust-ts-mode-indent-offset 4
"Number of spaces for each indentation step in `rust-ts-mode'."
@@ -69,6 +71,7 @@
(defvar rust-ts-mode--indent-rules
`((rust
+ ((parent-is "source_file") column-0 0)
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((node-is "}") (and parent parent-bol) 0)
@@ -122,8 +125,8 @@
(treesit-font-lock-rules
:language 'rust
:feature 'attribute
- '((attribute_item) @font-lock-constant-face
- (inner_attribute_item) @font-lock-constant-face)
+ '((attribute_item) @font-lock-preprocessor-face
+ (inner_attribute_item) @font-lock-preprocessor-face)
:language 'rust
:feature 'bracket
@@ -145,34 +148,43 @@
:feature 'comment
'(([(block_comment) (line_comment)]) @font-lock-comment-face)
- :language 'rust
- :feature 'constant
- `((boolean_literal) @font-lock-constant-face
- ((identifier) @font-lock-constant-face
- (:match "^[A-Z][A-Z\\d_]*$" @font-lock-constant-face)))
-
:language 'rust
:feature 'delimiter
'((["," "." ";" ":" "::"]) @font-lock-delimiter-face)
+ :language 'rust
+ :feature 'definition
+ '((function_item name: (identifier) @font-lock-function-name-face)
+ (macro_definition "macro_rules!" @font-lock-constant-face)
+ (macro_definition (identifier) @font-lock-preprocessor-face)
+ (field_declaration name: (field_identifier) @font-lock-property-name-face)
+ (parameter pattern: (_) @rust-ts-mode--fontify-pattern)
+ (closure_parameters (_) @rust-ts-mode--fontify-pattern)
+ (let_declaration pattern: (_) @rust-ts-mode--fontify-pattern)
+ (for_expression pattern: (_) @rust-ts-mode--fontify-pattern)
+ (let_condition pattern: (_) @rust-ts-mode--fontify-pattern)
+ (match_arm pattern: (_) @rust-ts-mode--fontify-pattern))
+
+ :language 'rust
+ :feature 'assignment
+ '((assignment_expression left: (_) @rust-ts-mode--fontify-pattern)
+ (compound_assignment_expr left: (_) @rust-ts-mode--fontify-pattern))
+
:language 'rust
:feature 'function
'((call_expression
function:
- [(identifier) @font-lock-function-name-face
+ [(identifier) @font-lock-function-call-face
(field_expression
- field: (field_identifier) @font-lock-function-name-face)
+ field: (field_identifier) @font-lock-function-call-face)
(scoped_identifier
- name: (identifier) @font-lock-function-name-face)])
- (function_item (identifier) @font-lock-function-name-face)
+ name: (identifier) @font-lock-function-call-face)])
(generic_function
- function: [(identifier) @font-lock-function-name-face
+ function: [(identifier) @font-lock-function-call-face
(field_expression
- field: (field_identifier) @font-lock-function-name-face)
+ field: (field_identifier) @font-lock-function-call-face)
(scoped_identifier
- name: (identifier) @font-lock-function-name-face)])
- (macro_definition "macro_rules!" @font-lock-constant-face)
- (macro_definition (identifier) @font-lock-preprocessor-face)
+ name: (identifier) @font-lock-function-call-face)])
(macro_invocation macro: (identifier) @font-lock-preprocessor-face))
:language 'rust
@@ -195,9 +207,18 @@
:language 'rust
:feature 'type
- `((call_expression
- function: (scoped_identifier
- path: (identifier) @font-lock-type-face))
+ `((scoped_use_list path: (identifier) @font-lock-constant-face)
+ (scoped_use_list path: (scoped_identifier
+ name: (identifier) @font-lock-constant-face))
+ ((use_as_clause alias: (identifier) @font-lock-type-face)
+ (:match "^[A-Z]" @font-lock-type-face))
+ ((use_as_clause path: (identifier) @font-lock-type-face)
+ (:match "^[A-Z]" @font-lock-type-face))
+ ((use_list (identifier) @font-lock-type-face)
+ (:match "^[A-Z]" @font-lock-type-face))
+ (use_wildcard [(identifier) @rust-ts-mode--fontify-scope
+ (scoped_identifier
+ name: (identifier) @rust-ts-mode--fontify-scope)])
(enum_variant name: (identifier) @font-lock-type-face)
(match_arm
pattern: (match_pattern (_ type: (identifier) @font-lock-type-face)))
@@ -208,47 +229,97 @@
(mod_item name: (identifier) @font-lock-constant-face)
(primitive_type) @font-lock-type-face
(type_identifier) @font-lock-type-face
- (scoped_identifier name: (identifier) @font-lock-type-face)
- (scoped_identifier path: (identifier) @font-lock-constant-face)
- (scoped_identifier
- (scoped_identifier
- path: (identifier) @font-lock-constant-face))
- ((scoped_identifier
- path: [(identifier) @font-lock-type-face
- (scoped_identifier
- name: (identifier) @font-lock-type-face)])
- (:match "^[A-Z]" @font-lock-type-face))
- (scoped_type_identifier path: (identifier) @font-lock-constant-face)
- (scoped_use_list
- path: [(identifier) @font-lock-constant-face
- (scoped_identifier (identifier) @font-lock-constant-face)])
- (type_identifier) @font-lock-type-face
- (use_as_clause alias: (identifier) @font-lock-type-face)
- (use_list (identifier) @font-lock-type-face))
+ ((scoped_identifier name: (identifier) @rust-ts-mode--fontify-tail))
+ ((scoped_identifier path: (identifier) @font-lock-type-face)
+ (:match
+
"^\\(u8\\|u16\\|u32\\|u64\\|u128\\|usize\\|i8\\|i16\\|i32\\|i64\\|i128\\|isize\\|char\\|str\\)$"
+ @font-lock-type-face))
+ ((scoped_identifier path: (identifier) @rust-ts-mode--fontify-scope))
+ (type_identifier) @font-lock-type-face)
+
+ :language 'rust
+ :feature 'property
+ '((field_identifier) @font-lock-property-use-face
+ (shorthand_field_initializer (identifier) @font-lock-property-use-face))
+
+ ;; Must be under type, otherwise some imports can be highlighted as
constants.
+ :language 'rust
+ :feature 'constant
+ `((boolean_literal) @font-lock-constant-face
+ ((identifier) @font-lock-constant-face
+ (:match "^[A-Z][A-Z\\d_]*$" @font-lock-constant-face)))
:language 'rust
:feature 'variable
- '((identifier) @font-lock-variable-name-face
- ;; Everything in a token_tree is an identifier.
- (token_tree (identifier) @default))
+ '((arguments (identifier) @font-lock-variable-use-face)
+ (array_expression (identifier) @font-lock-variable-use-face)
+ (assignment_expression right: (identifier) @font-lock-variable-use-face)
+ (binary_expression left: (identifier) @font-lock-variable-use-face)
+ (binary_expression right: (identifier) @font-lock-variable-use-face)
+ (block (identifier) @font-lock-variable-use-face)
+ (compound_assignment_expr right: (identifier)
@font-lock-variable-use-face)
+ (field_expression value: (identifier) @font-lock-variable-use-face)
+ (field_initializer value: (identifier) @font-lock-variable-use-face)
+ (if_expression condition: (identifier) @font-lock-variable-use-face)
+ (let_condition value: (identifier) @font-lock-variable-use-face)
+ (let_declaration value: (identifier) @font-lock-variable-use-face)
+ (match_arm value: (identifier) @font-lock-variable-use-face)
+ (match_expression value: (identifier) @font-lock-variable-use-face)
+ (reference_expression value: (identifier) @font-lock-variable-use-face)
+ (return_expression (identifier) @font-lock-variable-use-face)
+ (tuple_expression (identifier) @font-lock-variable-use-face)
+ (unary_expression (identifier) @font-lock-variable-use-face)
+ (while_expression condition: (identifier) @font-lock-variable-use-face))
:language 'rust
:feature 'escape-sequence
:override t
'((escape_sequence) @font-lock-escape-face)
- :language 'rust
- :feature 'property
- :override t
- '((field_identifier) @font-lock-property-face
- (shorthand_field_initializer (identifier) @font-lock-property-face))
-
:language 'rust
:feature 'error
:override t
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `rust-ts-mode'.")
+(defun rust-ts-mode--fontify-scope (node override start end &optional tail-p)
+ (let* ((case-fold-search nil)
+ (face
+ (cond
+ ((string-match-p "^[A-Z]" (treesit-node-text node))
+ 'font-lock-type-face)
+ ((and
+ tail-p
+ (string-match-p
+
"\\`\\(?:use_list\\|call_expression\\|use_as_clause\\|use_declaration\\)\\'"
+ (treesit-node-type (treesit-node-parent (treesit-node-parent
node)))))
+ nil)
+ (t 'font-lock-constant-face))))
+ (when face
+ (treesit-fontify-with-override
+ (treesit-node-start node) (treesit-node-end node)
+ face
+ override start end))))
+
+(defun rust-ts-mode--fontify-tail (node override start end)
+ (rust-ts-mode--fontify-scope node override start end t))
+
+(defalias 'rust-ts-mode--fontify-pattern
+ (and
+ (treesit-available-p)
+ `(lambda (node override start end &rest _)
+ (let ((captures (treesit-query-capture
+ node
+ ,(treesit-query-compile 'rust '((identifier) @id
+
(shorthand_field_identifier) @id)))))
+ (pcase-dolist (`(_name . ,id) captures)
+ (unless (string-match-p "\\`scoped_\\(?:type_\\)?identifier\\'"
+ (treesit-node-type
+ (treesit-node-parent id)))
+ (treesit-fontify-with-override
+ (treesit-node-start id) (treesit-node-end id)
+ 'font-lock-variable-name-face override start end)))))))
+
(defun rust-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."
@@ -317,11 +388,11 @@ delimiters < and >'s."
;; Font-lock.
(setq-local treesit-font-lock-settings rust-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list
- '(( comment)
+ '(( comment definition)
( keyword string)
- ( attribute builtin constant escape-sequence
- function number property type variable)
- ( bracket delimiter error operator)))
+ ( assignment attribute builtin constant escape-sequence
+ number type)
+ ( bracket delimiter error function operator property
variable)))
;; Imenu.
(setq-local treesit-simple-imenu-settings
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 17c22ff4751..a5428a9a714 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1042,7 +1042,9 @@ subshells can nest."
;; Maybe we've bumped into an escaped newline.
(sh-is-quoted-p (point)))
(backward-char 1))
- (when (eq (char-before) ?|)
+ (when (and
+ (eq (char-before) ?|)
+ (not (eq (char-before (1- (point))) ?\;)))
(backward-char 1) t)))
(and (> (point) (1+ (point-min)))
(progn (backward-char 2)
@@ -1053,7 +1055,7 @@ subshells can nest."
;; a normal command rather than the real `in' keyword.
;; I.e. we should look back to try and find the
;; corresponding `case'.
- (and (looking-at ";[;&]\\|\\_<in")
+ (and (looking-at ";\\(?:;&?\\|[&|]\\)\\|\\_<in")
;; ";; esac )" is a case that looks
;; like a case-pattern but it's really just a close
;; paren after a case statement. I.e. if we skipped
@@ -1619,7 +1621,8 @@ not written in Bash or sh."
(setq-local treesit-font-lock-feature-list
'(( comment function)
( command declaration-command keyword string)
- ( builtin-variable constant heredoc number variable)
+ ( builtin-variable constant heredoc number
+ string-interpolation variable)
( bracket delimiter misc-punctuation operator)))
(setq-local treesit-font-lock-settings
sh-mode--treesit-settings)
@@ -1784,8 +1787,9 @@ before the newline and in that case point should be just
before the token."
(pattern (rpattern) ("case-(" rpattern))
(branches (branches ";;" branches)
(branches ";&" branches) (branches ";;&" branches) ;bash.
+ (branches ";|" branches) ;zsh.
(pattern "case-)" cmd)))
- '((assoc ";;" ";&" ";;&"))
+ '((assoc ";;" ";&" ";;&" ";|"))
'((assoc ";" "&") (assoc "&&" "||") (assoc "|" "|&")))))
(defconst sh-smie--sh-operators
@@ -2010,7 +2014,7 @@ May return nil if the line should not be treated as
continued."
(forward-line -1)
(if (sh-smie--looking-back-at-continuation-p)
(current-indentation)
- (+ (current-indentation) sh-basic-offset))))
+ (+ (current-indentation) (sh-var-value 'sh-indent-for-continuation)))))
(t
;; Just make sure a line-continuation is indented deeper.
(save-excursion
@@ -2031,7 +2035,10 @@ May return nil if the line should not be treated as
continued."
;; check the line before that one.
(> ci indent))
(t ;Previous line is the beginning of the continued line.
- (setq indent (min (+ ci sh-basic-offset) max))
+ (setq
+ indent
+ (min
+ (+ ci (sh-var-value 'sh-indent-for-continuation))
max))
nil)))))
indent))))))
@@ -2055,11 +2062,11 @@ May return nil if the line should not be treated as
continued."
`(column . ,(smie-indent-virtual))))))
;; FIXME: Maybe this handling of ;; should be made into
;; a smie-rule-terminator function that takes the substitute ";" as arg.
- (`(:before . ,(or ";;" ";&" ";;&"))
- (if (and (smie-rule-bolp) (looking-at ";;?&?[ \t]*\\(#\\|$\\)"))
+ (`(:before . ,(or ";;" ";&" ";;&" ";|"))
+ (if (and (smie-rule-bolp) (looking-at ";\\(?:;&?\\|[&|]\\)?[
\t]*\\(#\\|$\\)"))
(cons 'column (smie-indent-keyword ";"))
(smie-rule-separator kind)))
- (`(:after . ,(or ";;" ";&" ";;&"))
+ (`(:after . ,(or ";;" ";&" ";;&" ";|"))
(with-demoted-errors "SMIE rule error: %S"
(smie-backward-sexp token)
(cons 'column
@@ -2148,8 +2155,9 @@ May return nil if the line should not be treated as
continued."
(pattern (pattern "|" pattern))
(branches (branches ";;" branches)
(branches ";&" branches) (branches ";;&" branches) ;bash.
+ (branches ";|" branches) ;zsh.
(pattern "case-)" cmd)))
- '((assoc ";;" ";&" ";;&"))
+ '((assoc ";;" ";&" ";;&" ";|"))
'((assoc "case") (assoc ";" "&") (assoc "&&" "||") (assoc "|" "|&")))))
(defun sh-smie--rc-after-special-arg-p ()
@@ -3293,6 +3301,12 @@ See `sh-mode--treesit-other-keywords' and
:language 'bash
'([(string) (raw_string)] @font-lock-string-face)
+ :feature 'string-interpolation
+ :language 'bash
+ :override t
+ '((command_substitution) @sh-quoted-exec
+ (string (expansion (variable_name) @font-lock-variable-use-face)))
+
:feature 'heredoc
:language 'bash
'([(heredoc_start) (heredoc_body)] @sh-heredoc)
diff --git a/lisp/progmodes/typescript-ts-mode.el
b/lisp/progmodes/typescript-ts-mode.el
index 3437ea43505..b21b1fd2cef 100644
--- a/lisp/progmodes/typescript-ts-mode.el
+++ b/lisp/progmodes/typescript-ts-mode.el
@@ -69,7 +69,7 @@
"Rules used for indentation.
Argument LANGUAGE is either `typescript' or `tsx'."
`((,language
- ((parent-is "program") point-min 0)
+ ((parent-is "program") column-0 0)
((node-is "}") parent-bol 0)
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
@@ -81,11 +81,14 @@ Argument LANGUAGE is either `typescript' or `tsx'."
((parent-is "member_expression") parent-bol
typescript-ts-mode-indent-offset)
((parent-is "named_imports") parent-bol typescript-ts-mode-indent-offset)
((parent-is "statement_block") parent-bol
typescript-ts-mode-indent-offset)
+ ((parent-is "switch_case") parent-bol typescript-ts-mode-indent-offset)
+ ((parent-is "switch_default") parent-bol typescript-ts-mode-indent-offset)
((parent-is "type_arguments") parent-bol typescript-ts-mode-indent-offset)
((parent-is "variable_declarator") parent-bol
typescript-ts-mode-indent-offset)
((parent-is "arguments") parent-bol typescript-ts-mode-indent-offset)
((parent-is "array") parent-bol typescript-ts-mode-indent-offset)
((parent-is "formal_parameters") parent-bol
typescript-ts-mode-indent-offset)
+ ((parent-is "template_string") no-indent) ; Don't indent the string
contents.
((parent-is "template_substitution") parent-bol
typescript-ts-mode-indent-offset)
((parent-is "object_pattern") parent-bol typescript-ts-mode-indent-offset)
((parent-is "object") parent-bol typescript-ts-mode-indent-offset)
@@ -100,12 +103,14 @@ Argument LANGUAGE is either `typescript' or `tsx'."
`(((match "<" "jsx_fragment") parent 0)
((parent-is "jsx_fragment") parent typescript-ts-mode-indent-offset)
((node-is "jsx_closing_element") parent 0)
- ((node-is "jsx_element") parent typescript-ts-mode-indent-offset)
+ ((match "jsx_element" "statement") parent
typescript-ts-mode-indent-offset)
((parent-is "jsx_element") parent typescript-ts-mode-indent-offset)
+ ((parent-is "jsx_text") parent-bol typescript-ts-mode-indent-offset)
((parent-is "jsx_opening_element") parent
typescript-ts-mode-indent-offset)
((parent-is "jsx_expression") parent-bol
typescript-ts-mode-indent-offset)
((match "/" "jsx_self_closing_element") parent 0)
((parent-is "jsx_self_closing_element") parent
typescript-ts-mode-indent-offset)))
+ ;; FIXME(Theo): This no-node catch-all should be removed. When is it
needed?
(no-node parent-bol 0))))
(defvar typescript-ts-mode--keywords
@@ -240,16 +245,13 @@ Argument LANGUAGE is either `typescript' or `tsx'."
:language language
:feature 'property
`((property_signature
- name: (property_identifier) @font-lock-property-face)
+ name: (property_identifier) @font-lock-property-name-face)
(public_field_definition
- name: (property_identifier) @font-lock-property-face)
+ name: (property_identifier) @font-lock-property-name-face)
- (pair key: (property_identifier) @font-lock-variable-name-face)
+ (pair key: (property_identifier) @font-lock-property-use-face)
- ((shorthand_property_identifier) @font-lock-property-face)
-
- ((shorthand_property_identifier_pattern)
- @font-lock-property-face))
+ ((shorthand_property_identifier) @font-lock-property-use-face))
:language language
:feature 'expression
@@ -263,30 +265,34 @@ Argument LANGUAGE is either `typescript' or `tsx'."
:feature 'function
'((call_expression
function:
- [(identifier) @font-lock-function-name-face
+ [(identifier) @font-lock-function-call-face
(member_expression
- property: (property_identifier) @font-lock-function-name-face)]))
+ property: (property_identifier) @font-lock-function-call-face)]))
:language language
:feature 'pattern
`((pair_pattern
- key: (property_identifier) @font-lock-property-face)
+ 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)
- (array_pattern (identifier) @font-lock-variable-name-face))
+ ((shorthand_property_identifier_pattern) @font-lock-variable-name-face))
:language language
:feature 'jsx
`((jsx_opening_element
[(nested_identifier (identifier)) (identifier)]
- @font-lock-function-name-face)
+ @font-lock-function-call-face)
(jsx_closing_element
[(nested_identifier (identifier)) (identifier)]
- @font-lock-function-name-face)
+ @font-lock-function-call-face)
(jsx_self_closing_element
[(nested_identifier (identifier)) (identifier)]
- @font-lock-function-name-face)
+ @font-lock-function-call-face)
(jsx_attribute (property_identifier) @font-lock-constant-face))
@@ -376,8 +382,9 @@ See `treesit-sexp-type-regexp' for more information.")
;; Electric
(setq-local electric-indent-chars
- (append "{}():;," electric-indent-chars))
-
+ (append "{}():;,<>/" electric-indent-chars))
+ (setq-local electric-layout-rules
+ '((?\; . after) (?\{ . after) (?\} . before)))
;; Navigation.
(setq-local treesit-defun-type-regexp
(regexp-opt '("class_declaration"
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 2989d7ddb61..ac6fd382a46 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -370,7 +370,8 @@ wherever possible, since it is slow."
(unless (fboundp 'ignore-errors)
(defmacro ignore-errors (&rest body)
(declare (debug t) (indent 0))
- `(condition-case nil (progn ,@body) (error nil)))))
+ `(condition-case nil (progn ,@body) (error nil))))
+ (error nil))
;; Added in Emacs 24.1
(condition-case nil
(unless (fboundp 'prog-mode)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 4db0df6c3b8..38c424402a0 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,7 +1,7 @@
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2023 Free Software Foundation, Inc.
-;; Version: 1.6.1
+;; Version: 1.6.2
;; Package-Requires: ((emacs "26.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -1126,7 +1126,9 @@ GROUP is a string for decoration purposes and XREF is an
maximize (xref-location-line
(xref-item-location xref)))
for line-format = (and max-line
- (format "%%%dd: " (1+ (floor (log max-line
10)))))
+ (format
+ #("%%%dd:" 0 4 (face xref-line-number) 5 6
(face shadow))
+ (1+ (floor (log max-line 10)))))
with item-text-props = (list 'mouse-face 'highlight
'keymap xref--button-map
'help-echo
@@ -1146,8 +1148,7 @@ GROUP is a string for decoration purposes and XREF is an
((and (equal line prev-line)
(equal prev-group group))
"")
- (t (propertize (format line-format line)
- 'face 'xref-line-number)))))
+ (t (format line-format line)))))
;; Render multiple matches on the same line, together.
(when (and (equal prev-group group)
(or (null line)
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 37d4aaec985..2fcac4d2ce3 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -359,8 +359,8 @@ This property can override the value of this variable."
:group 'repeat
:version "28.1")
-(defvar repeat-exit-function nil
- "Function that exits the repeating sequence.")
+(defvar repeat--transient-exitfun nil
+ "Function returned by `set-transient-map'.")
(defvar repeat-exit-timer nil
"Timer activated after the last key typed in the repeating key sequence.")
@@ -517,9 +517,9 @@ See `describe-repeat-maps' for a list of all repeatable
commands."
'ignore))
(setq repeat-in-progress t)
- (repeat--exit)
+ (repeat--clear-prev)
(let ((exitfun (set-transient-map map)))
- (setq repeat-exit-function exitfun)
+ (setq repeat--transient-exitfun exitfun)
(let* ((prop (repeat--command-property 'repeat-exit-timeout))
(timeout (unless (eq prop 'no) (or prop
repeat-exit-timeout))))
@@ -538,17 +538,17 @@ See `describe-repeat-maps' for a list of all repeatable
commands."
This function can be used to force exit of repetition while it's active."
(interactive)
(setq repeat-in-progress nil)
- (repeat--exit)
+ (repeat--clear-prev)
(funcall repeat-echo-function nil))
-(defun repeat--exit ()
+(defun repeat--clear-prev ()
"Internal function to clean up previously set exit function and timer."
(when repeat-exit-timer
(cancel-timer repeat-exit-timer)
(setq repeat-exit-timer nil))
- (when repeat-exit-function
- (funcall repeat-exit-function)
- (setq repeat-exit-function nil)))
+ (when repeat--transient-exitfun
+ (funcall repeat--transient-exitfun)
+ (setq repeat--transient-exitfun nil)))
(defun repeat-echo-message-string (keymap)
"Return a string with the list of repeating keys in KEYMAP."
diff --git a/lisp/simple.el b/lisp/simple.el
index bed6dfb8292..80c75d4d7c3 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -937,7 +937,7 @@ column specified by the function `current-left-margin'."
(defcustom read-quoted-char-radix 8
"Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
-Legitimate radix values are 8, 10 and 16."
+Supported radix values are 8, 10 and 16."
:type '(choice (const 8) (const 10) (const 16))
:group 'editing-basics)
@@ -1012,21 +1012,25 @@ any other non-digit terminates the character code and
is then used as input."))
This is useful for inserting control characters.
With argument, insert ARG copies of the character.
-If the first character you type after this command is an octal digit,
-you should type a sequence of octal digits that specify a character code.
-Any nondigit terminates the sequence. If the terminator is a RET,
-it is discarded; any other terminator is used itself as input.
+If the first character you type is an octal digit, the sequence of
+one or more octal digits you type is interpreted to specify a
+character code. Any character that is not an octal digit terminates
+the sequence. If the terminator is a RET, it is discarded; any
+other terminator is used itself as input and is inserted.
+
The variable `read-quoted-char-radix' specifies the radix for this feature;
-set it to 10 or 16 to use decimal or hex instead of octal.
+set it to 10 or 16 to use decimal or hex instead of octal. If you change
+the radix, the characters interpreted as specifying a character code
+change accordingly: 0 to 9 for decimal, 0 to F for hex.
In overwrite mode, this function inserts the character anyway, and
-does not handle octal digits specially. This means that if you use
-overwrite as your normal editing mode, you can use this function to
-insert characters when necessary.
+does not handle octal (or decimal or hex) digits specially. This means
+that if you use overwrite mode as your normal editing mode, you can use
+this function to insert characters when necessary.
In binary overwrite mode, this function does overwrite, and octal
-digits are interpreted as a character code. This is intended to be
-useful for editing binary files."
+(or decimal or hex) digits are interpreted as a character code. This
+is intended to be useful for editing binary files."
(interactive "*p")
(let* ((char
;; Avoid "obsolete" warnings for translation-table-for-input.
@@ -1088,7 +1092,8 @@ Leave one space or none, according to the context."
(defun delete-horizontal-space (&optional backward-only)
"Delete all spaces and tabs around point.
-If BACKWARD-ONLY is non-nil, delete them only before point."
+If BACKWARD-ONLY is non-nil (interactively, the prefix argument), delete
+them only before point."
(interactive "*P")
(delete-space--internal " \t" backward-only))
@@ -1114,6 +1119,7 @@ If BACKWARD-ONLY is non-nil, delete them only before
point."
(defun just-one-space (&optional n)
"Delete all spaces and tabs around point, leaving one space (or N spaces).
+Interactively, N is the prefix numeric argument.
If N is negative, delete newlines as well, leaving -N spaces.
See also `cycle-spacing'."
(interactive "*p")
@@ -1755,6 +1761,7 @@ not at the start of a line.
When IGNORE-INVISIBLE-LINES is non-nil, invisible lines are not
included in the count."
+ (declare (side-effect-free t))
(save-excursion
(save-restriction
(narrow-to-region start end)
@@ -6830,6 +6837,7 @@ is active, and returns an integer or nil in the usual way.
If you are using this in an editing command, you are most likely making
a mistake; see the documentation of `set-mark'."
+ (declare (side-effect-free t))
(if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
(marker-position (mark-marker))
(signal 'mark-inactive nil)))
@@ -9914,7 +9922,12 @@ minibuffer, but don't quit the completions window."
(with-current-buffer buffer
(choose-completion-string
choice buffer
- (or (and completion-use-base-affixes base-affixes)
+ ;; Don't allow affixes to replace the whole buffer when not
+ ;; in the minibuffer. Thus check for `completion-in-region-mode'
+ ;; to ignore non-nil value of `completion-use-base-affixes' set by
+ ;; `minibuffer-choose-completion'.
+ (or (and (not completion-in-region-mode)
+ completion-use-base-affixes base-affixes)
base-position
;; If all else fails, just guess.
(list (choose-completion-guess-base-position choice)))
@@ -10830,7 +10843,8 @@ If the buffer doesn't exist, create it first."
'((?y "yes" "kill buffer without saving")
(?n "no" "exit without doing anything")
(?s "save and then kill" "save the buffer and then kill it"))
- nil nil (not use-short-answers)))))
+ nil nil (and (not use-short-answers)
+ (not (use-dialog-box-p)))))))
(if (equal response "no")
nil
(unless (equal response "yes")
@@ -10840,6 +10854,7 @@ If the buffer doesn't exist, create it first."
(defsubst string-empty-p (string)
"Check whether STRING is empty."
+ (declare (pure t) (side-effect-free t))
(string= string ""))
(defun read-signal-name ()
@@ -10857,7 +10872,7 @@ If the buffer doesn't exist, create it first."
(defun lax-plist-get (plist prop)
"Extract a value from a property list, comparing with `equal'."
- (declare (obsolete plist-get "29.1"))
+ (declare (pure t) (side-effect-free t) (obsolete plist-get "29.1"))
(plist-get plist prop #'equal))
(defun lax-plist-put (plist prop val)
diff --git a/lisp/startup.el b/lisp/startup.el
index 06783a77c1e..9ae53f4e50b 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -542,8 +542,8 @@ DIRS are relative."
(setq comp--compilable t))
(defvar native-comp-eln-load-path)
-(defvar inhibit-automatic-native-compilation)
-(defvar comp-enable-subr-trampolines)
+(defvar native-comp-jit-compilation)
+(defvar native-comp-enable-subr-trampolines)
(defvar startup--original-eln-load-path nil
"Original value of `native-comp-eln-load-path'.")
@@ -579,10 +579,6 @@ the updated value."
It sets `command-line-processed', processes the command-line,
reads the initialization files, etc.
It is the default value of the variable `top-level'."
- ;; Allow disabling automatic .elc->.eln processing.
- (setq inhibit-automatic-native-compilation
- (getenv "EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION"))
-
(if command-line-processed
(message internal--top-level-message)
(setq command-line-processed t)
@@ -601,8 +597,8 @@ It is the default value of the variable `top-level'."
;; in this session. This is necessary if libgccjit is not
;; available on MS-Windows, but Emacs was built with
;; native-compilation support.
- (setq inhibit-automatic-native-compilation t
- comp-enable-subr-trampolines nil))
+ (setq native-comp-jit-compilation nil
+ native-comp-enable-subr-trampolines nil))
;; Form `native-comp-eln-load-path'.
(let ((path-env (getenv "EMACSNATIVELOADPATH")))
@@ -1596,7 +1592,8 @@ please check its value")
;; or EMACSLOADPATH, so we basically always have to check.
(let (warned)
(dolist (dir load-path)
- (and (not warned)
+ (and (not noninteractive)
+ (not warned)
(stringp dir)
(string-equal (file-name-as-directory (expand-file-name dir))
(expand-file-name user-emacs-directory))
diff --git a/lisp/subr.el b/lisp/subr.el
index f909b63aabe..e29c8ddd6c4 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -422,7 +422,9 @@ PREFIX is a string, and defaults to \"g\"."
"Do nothing and return nil.
This function accepts any number of ARGUMENTS, but ignores them.
Also see `always'."
- (declare (completion ignore))
+ ;; Not declared `side-effect-free' because we don't want calls to it
+ ;; elided; see `byte-compile-ignore'.
+ (declare (pure t) (completion ignore))
(interactive)
nil)
@@ -430,6 +432,7 @@ Also see `always'."
"Do nothing and return t.
This function accepts any number of ARGUMENTS, but ignores them.
Also see `ignore'."
+ (declare (pure t) (side-effect-free error-free))
t)
;; Signal a compile-error if the first arg is missing.
@@ -509,16 +512,19 @@ was called."
"Return t if NUMBER is zero."
;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because
;; = has a byte-code.
- (declare (compiler-macro (lambda (_) `(= 0 ,number))))
+ (declare (pure t) (side-effect-free t)
+ (compiler-macro (lambda (_) `(= 0 ,number))))
(= 0 number))
(defun fixnump (object)
"Return t if OBJECT is a fixnum."
+ (declare (side-effect-free error-free))
(and (integerp object)
(<= most-negative-fixnum object most-positive-fixnum)))
(defun bignump (object)
"Return t if OBJECT is a bignum."
+ (declare (side-effect-free error-free))
(and (integerp object) (not (fixnump object))))
(defun lsh (value count)
@@ -533,7 +539,8 @@ instead."
(lambda (form)
(macroexp-warn-and-return
(format-message "avoid `lsh'; use `ash' instead")
- form '(suspicious lsh) t form))))
+ form '(suspicious lsh) t form)))
+ (side-effect-free t))
(when (and (< value 0) (< count 0))
(when (< value most-negative-fixnum)
(signal 'args-out-of-range (list value count)))
@@ -706,7 +713,7 @@ instead."
If LIST is nil, return nil.
If N is non-nil, return the Nth-to-last link of LIST.
If N is bigger than the length of LIST, return LIST."
- (declare (side-effect-free t))
+ (declare (pure t) (side-effect-free t)) ; pure up to mutation
(if n
(and (>= n 0)
(let ((m (safe-length list)))
@@ -761,7 +768,9 @@ one is kept. See `seq-uniq' for non-destructive operation."
(defun delete-consecutive-dups (list &optional circular)
"Destructively remove `equal' consecutive duplicates from LIST.
First and last elements are considered consecutive if CIRCULAR is
-non-nil."
+non-nil.
+Of several consecutive `equal' occurrences, the one earliest in
+the list is kept."
(let ((tail list) last)
(while (cdr tail)
(if (equal (car tail) (cadr tail))
@@ -797,6 +806,7 @@ TO as (+ FROM (* N INC)) or use a variable whose value was
computed with this exact expression. Alternatively, you can,
of course, also replace TO with a slightly larger value
\(or a slightly more negative value if INC is negative)."
+ (declare (side-effect-free t))
(if (or (not to) (= from to))
(list from)
(or inc (setq inc 1))
@@ -818,6 +828,7 @@ of course, also replace TO with a slightly larger value
If TREE is a cons cell, this recursively copies both its car and its cdr.
Contrast to `copy-sequence', which copies only along the cdrs. With second
argument VECP, this copies vectors as well as conses."
+ (declare (side-effect-free t))
(if (consp tree)
(let (result)
(while (consp tree)
@@ -834,6 +845,62 @@ argument VECP, this copies vectors as well as conses."
(aset tree i (copy-tree (aref tree i) vecp)))
tree)
tree)))
+
+(defvar safe-copy-tree--seen nil
+ "A hash table for conses/vectors/records already seen by safe-copy-tree-1.
+Its key is a cons or vector/record seen by the algorithm, and its
+value is the corresponding cons/vector/record in the copy.")
+
+(defun safe-copy-tree--1 (tree &optional vecp)
+ "Make a copy of TREE, taking circular structure into account.
+If TREE is a cons cell, this recursively copies both its car and its cdr.
+Contrast to `copy-sequence', which copies only along the cdrs. With second
+argument VECP, this copies vectors and records as well as conses."
+ (cond
+ ((gethash tree safe-copy-tree--seen))
+ ((consp tree)
+ (let* ((result (cons (car tree) (cdr tree)))
+ (newcons result)
+ hash)
+ (while (and (not hash) (consp tree))
+ (if (setq hash (gethash tree safe-copy-tree--seen))
+ (setq newcons hash)
+ (puthash tree newcons safe-copy-tree--seen))
+ (setq tree newcons)
+ (unless hash
+ (if (or (consp (car tree))
+ (and vecp (or (vectorp (car tree)) (recordp (car tree)))))
+ (let ((newcar (safe-copy-tree--1 (car tree) vecp)))
+ (setcar tree newcar)))
+ (setq newcons (if (consp (cdr tree))
+ (cons (cadr tree) (cddr tree))
+ (cdr tree)))
+ (setcdr tree newcons)
+ (setq tree (cdr tree))))
+ (nconc result
+ (if (and vecp (or (vectorp tree) (recordp tree)))
+ (safe-copy-tree--1 tree vecp) tree))))
+ ((and vecp (or (vectorp tree) (recordp tree)))
+ (let* ((newvec (copy-sequence tree))
+ (i (length newvec)))
+ (puthash tree newvec safe-copy-tree--seen)
+ (setq tree newvec)
+ (while (>= (setq i (1- i)) 0)
+ (aset tree i (safe-copy-tree--1 (aref tree i) vecp)))
+ tree))
+ (t tree)))
+
+(defun safe-copy-tree (tree &optional vecp)
+ "Make a copy of TREE, taking circular structure into account.
+If TREE is a cons cell, this recursively copies both its car and its cdr.
+Contrast to `copy-sequence', which copies only along the cdrs. With second
+argument VECP, this copies vectors and records as well as conses."
+ (setq safe-copy-tree--seen (make-hash-table :test #'eq))
+ (unwind-protect
+ (safe-copy-tree--1 tree vecp)
+ (clrhash safe-copy-tree--seen)
+ (setq safe-copy-tree--seen nil)))
+
;;;; Various list-search functions.
@@ -1525,6 +1592,7 @@ See also `current-global-map'.")
(defun eventp (object)
"Return non-nil if OBJECT is an input event or event object."
+ (declare (pure t) (side-effect-free error-free))
(or (integerp object)
(and (if (consp object)
(setq object (car object))
@@ -1587,6 +1655,7 @@ in the current Emacs session, then this function may
return nil."
(defsubst mouse-movement-p (object)
"Return non-nil if OBJECT is a mouse movement event."
+ (declare (side-effect-free error-free))
(eq (car-safe object) 'mouse-movement))
(defun mouse-event-p (object)
@@ -1859,7 +1928,7 @@ be a list of the form returned by `event-start' and
`event-end'."
(defun log10 (x)
"Return (log X 10), the log base 10 of X."
- (declare (obsolete log "24.4"))
+ (declare (side-effect-free t) (obsolete log "24.4"))
(log x 10))
(set-advertised-calling-convention
@@ -1916,8 +1985,13 @@ activations. To prevent runaway recursion, use
`max-lisp-eval-depth'
instead; it will indirectly limit the specpdl stack size as well.")
(make-obsolete-variable 'max-specpdl-size nil "29.1")
+(make-obsolete-variable 'comp-enable-subr-trampolines
+ 'native-comp-enable-subr-trampolines
+ "29.1")
+
(make-obsolete-variable 'native-comp-deferred-compilation
- 'inhibit-automatic-native-compilation "29.1")
+ 'native-comp-jit-compilation
+ "29.1")
;;;; Alternate names for functions - these are not being phased out.
@@ -2423,8 +2497,9 @@ If the variable `delay-mode-hooks' is non-nil, does not
do anything,
just adds the HOOKS to the list `delayed-mode-hooks'.
Otherwise, runs hooks in the sequence: `change-major-mode-after-body-hook',
`delayed-mode-hooks' (in reverse order), HOOKS, then runs
-`hack-local-variables', runs the hook `after-change-major-mode-hook', and
-finally evaluates the functions in `delayed-after-hook-functions' (see
+`hack-local-variables' (if the buffer is visiting a file),
+runs the hook `after-change-major-mode-hook', and finally
+evaluates the functions in `delayed-after-hook-functions' (see
`define-derived-mode').
Major mode functions should use this instead of `run-hooks' when
@@ -2983,6 +3058,7 @@ It can be retrieved with `(process-get PROCESS
PROPNAME)'."
(defun memory-limit ()
"Return an estimate of Emacs virtual memory usage, divided by 1024."
+ (declare (side-effect-free error-free))
(let ((default-directory temporary-file-directory))
(or (cdr (assq 'vsize (process-attributes (emacs-pid)))) 0)))
@@ -3595,12 +3671,14 @@ like) while `y-or-n-p' is running)."
(if (or (zerop l) (eq ?\s (aref prompt (1- l))))
"" " ")
(if dialog ""
- (substitute-command-keys
- (if help-form
- (format "(\\`y', \\`n' or \\`%s') "
- (key-description
- (vector help-char)))
- "(\\`y' or \\`n') ")))))))
+ ;; Don't clobber caller's match data.
+ (save-match-data
+ (substitute-command-keys
+ (if help-form
+ (format "(\\`y', \\`n' or \\`%s') "
+ (key-description
+ (vector help-char)))
+ "(\\`y' or \\`n') "))))))))
;; Preserve the actual command that eventually called
;; `y-or-n-p' (otherwise `repeat' will be repeating
;; `exit-minibuffer').
@@ -3961,30 +4039,51 @@ See also `locate-user-emacs-file'.")
"Return non-nil if the current buffer is narrowed."
(/= (- (point-max) (point-min)) (buffer-size)))
-(defmacro with-narrowing (start end &rest rest)
+(defmacro with-restriction (start end &rest rest)
"Execute BODY with restrictions set to START and END.
The current restrictions, if any, are restored upon return.
-With the optional :locked TAG argument, inside BODY,
-`narrow-to-region' and `widen' can be used only within the START
-and END limits, unless the restrictions are unlocked by calling
-`narrowing-unlock' with TAG. See `narrowing-lock' for a more
-detailed description.
+When the optional :label LABEL argument is present, in which
+LABEL is a symbol, inside BODY, `narrow-to-region' and `widen'
+can be used only within the START and END limits. To gain access
+to other portions of the buffer, use `without-restriction' with the
+same LABEL argument.
-\(fn START END [:locked TAG] BODY)"
- (if (eq (car rest) :locked)
- `(internal--with-narrowing ,start ,end (lambda () ,@(cddr rest))
+\(fn START END [:label LABEL] BODY)"
+ (if (eq (car rest) :label)
+ `(internal--with-restriction ,start ,end (lambda () ,@(cddr rest))
,(cadr rest))
- `(internal--with-narrowing ,start ,end (lambda () ,@rest))))
+ `(internal--with-restriction ,start ,end (lambda () ,@rest))))
-(defun internal--with-narrowing (start end body &optional tag)
- "Helper function for `with-narrowing', which see."
+(defun internal--with-restriction (start end body &optional label)
+ "Helper function for `with-restriction', which see."
(save-restriction
- (progn
- (narrow-to-region start end)
- (if tag (narrowing-lock tag))
- (funcall body))))
+ (narrow-to-region start end)
+ (if label (internal--lock-narrowing label))
+ (funcall body)))
+
+(defmacro without-restriction (&rest rest)
+ "Execute BODY without restrictions.
+
+The current restrictions, if any, are restored upon return.
+
+When the optional :label LABEL argument is present, the
+restrictions set by `with-restriction' with the same LABEL argument
+are lifted.
+
+\(fn [:label LABEL] BODY)"
+ (if (eq (car rest) :label)
+ `(internal--without-restriction (lambda () ,@(cddr rest))
+ ,(cadr rest))
+ `(internal--without-restriction (lambda () ,@rest))))
+
+(defun internal--without-restriction (body &optional label)
+ "Helper function for `without-restriction', which see."
+ (save-restriction
+ (if label (internal--unlock-narrowing label))
+ (widen)
+ (funcall body)))
(defun find-tag-default-bounds ()
"Determine the boundaries of the default tag, based on text at point.
@@ -4122,15 +4221,18 @@ system's shell."
(defsubst string-to-list (string)
"Return a list of characters in STRING."
+ (declare (side-effect-free t))
(append string nil))
(defsubst string-to-vector (string)
"Return a vector of characters in STRING."
+ (declare (side-effect-free t))
(vconcat string))
(defun string-or-null-p (object)
"Return t if OBJECT is a string or nil.
Otherwise, return nil."
+ (declare (pure t) (side-effect-free error-free))
(or (stringp object) (null object)))
(defun list-of-strings-p (object)
@@ -4143,21 +4245,25 @@ Otherwise, return nil."
(defun booleanp (object)
"Return t if OBJECT is one of the two canonical boolean values: t or nil.
Otherwise, return nil."
+ (declare (pure t) (side-effect-free error-free))
(and (memq object '(nil t)) t))
(defun special-form-p (object)
"Non-nil if and only if OBJECT is a special form."
+ (declare (side-effect-free error-free))
(if (and (symbolp object) (fboundp object))
(setq object (indirect-function object)))
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
(defun plistp (object)
"Non-nil if and only if OBJECT is a valid plist."
+ (declare (pure t) (side-effect-free error-free))
(let ((len (proper-list-p object)))
(and len (zerop (% len 2)))))
(defun macrop (object)
"Non-nil if and only if OBJECT is a macro."
+ (declare (side-effect-free t))
(let ((def (indirect-function object)))
(when (consp def)
(or (eq 'macro (car def))
@@ -4167,6 +4273,7 @@ Otherwise, return nil."
"Return non-nil if OBJECT is a function that has been compiled.
Does not distinguish between functions implemented in machine code
or byte-code."
+ (declare (side-effect-free error-free))
(or (subrp object) (byte-code-function-p object)))
(defun field-at-pos (pos)
@@ -4180,8 +4287,8 @@ or byte-code."
"Return the SHA-1 (Secure Hash Algorithm) of an OBJECT.
OBJECT is either a string or a buffer. Optional arguments START and
END are character positions specifying which portion of OBJECT for
-computing the hash. If BINARY is non-nil, return a string in binary
-form.
+computing the hash. If BINARY is non-nil, return a 40-byte unibyte
+string; otherwise returna 40-character string.
Note that SHA-1 is not collision resistant and should not be used
for anything security-related. See `secure-hash' for
@@ -5193,11 +5300,13 @@ wherever possible, since it is slow."
(defsubst looking-at-p (regexp)
"\
Same as `looking-at' except this function does not change the match data."
+ (declare (side-effect-free t))
(looking-at regexp t))
(defsubst string-match-p (regexp string &optional start)
"\
Same as `string-match' except this function does not change the match data."
+ (declare (side-effect-free t))
(string-match regexp string start t))
(defun subregexp-context-p (regexp pos &optional start)
@@ -5468,7 +5577,7 @@ Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison.
See also `string-equal'."
- (declare (pure t) (side-effect-free t))
+ (declare (side-effect-free t))
(eq t (compare-strings string1 0 nil string2 0 nil t)))
(defun string-prefix-p (prefix string &optional ignore-case)
@@ -5513,6 +5622,7 @@ consisting of STR followed by an invisible left-to-right
mark
"Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
Case is significant.
Symbols are also allowed; their print names are used instead."
+ (declare (pure t) (side-effect-free t))
(string-lessp string2 string1))
@@ -5794,6 +5904,7 @@ integer that encodes the corresponding syntax class. See
Info
node `(elisp)Syntax Table Internals' for a list of codes.
If SYNTAX is nil, return nil."
+ (declare (pure t) (side-effect-free t))
(and syntax (logand (car syntax) 65535)))
;; Utility motion commands
@@ -6156,7 +6267,8 @@ To test whether a function can be called interactively,
use
`commandp'."
;; Kept around for now. See discussion at:
;; https://lists.gnu.org/r/emacs-devel/2020-08/msg00564.html
- (declare (obsolete called-interactively-p "23.2"))
+ (declare (obsolete called-interactively-p "23.2")
+ (side-effect-free error-free))
(called-interactively-p 'interactive))
(defun internal-push-keymap (keymap symbol)
@@ -6643,6 +6755,7 @@ Note that a version specified by the list (1) is equal to
(1 0),
\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
Also, a version given by the list (1) is higher than (1 -1), which in
turn is higher than (1 -2), which is higher than (1 -3)."
+ (declare (pure t) (side-effect-free t))
(while (and l1 l2 (= (car l1) (car l2)))
(setq l1 (cdr l1)
l2 (cdr l2)))
@@ -6664,6 +6777,7 @@ Note that a version specified by the list (1) is equal to
(1 0),
\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
Also, a version given by the list (1) is higher than (1 -1), which in
turn is higher than (1 -2), which is higher than (1 -3)."
+ (declare (pure t) (side-effect-free t))
(while (and l1 l2 (= (car l1) (car l2)))
(setq l1 (cdr l1)
l2 (cdr l2)))
@@ -6685,6 +6799,7 @@ Note that integer list (1) is equal to (1 0), (1 0 0), (1
0 0 0),
etc. That is, the trailing zeroes are insignificant. Also, integer
list (1) is greater than (1 -1) which is greater than (1 -2)
which is greater than (1 -3)."
+ (declare (pure t) (side-effect-free t))
(while (and l1 l2 (= (car l1) (car l2)))
(setq l1 (cdr l1)
l2 (cdr l2)))
@@ -6702,6 +6817,7 @@ which is greater than (1 -3)."
"Return the first non-zero element of LST, which is a list of integers.
If all LST elements are zeros or LST is nil, return zero."
+ (declare (pure t) (side-effect-free t))
(while (and lst (zerop (car lst)))
(setq lst (cdr lst)))
(if lst
@@ -6841,6 +6957,7 @@ returned list are in the same order as in TREE.
\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7))
=> (1 2 3 4 5 6 7)"
+ (declare (side-effect-free error-free))
(let (elems)
(while (consp tree)
(let ((elem (pop tree)))
@@ -6867,6 +6984,7 @@ REGEXP defaults to \"[ \\t\\n\\r]+\"."
"Trim STRING of trailing string matching REGEXP.
REGEXP defaults to \"[ \\t\\n\\r]+\"."
+ (declare (side-effect-free t))
(let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
string)))
(if i (substring string 0 i) string)))
@@ -6938,6 +7056,7 @@ sentence (see Info node `(elisp) Documentation Tips')."
"Return OBJECT as a list.
If OBJECT is already a list, return OBJECT itself. If it's
not a list, return a one-element list containing OBJECT."
+ (declare (side-effect-free error-free))
(if (listp object)
object
(list object)))
@@ -6953,27 +7072,17 @@ string will be displayed only if BODY takes longer than
TIMEOUT seconds.
(lambda ()
,@body)))
-(defun function-alias-p (func &optional noerror)
+(defun function-alias-p (func &optional _noerror)
"Return nil if FUNC is not a function alias.
-If FUNC is a function alias, return the function alias chain.
-
-If the function alias chain contains loops, an error will be
-signaled. If NOERROR, the non-loop parts of the chain is returned."
- (declare (side-effect-free t))
- (let ((chain nil)
- (orig-func func))
- (nreverse
- (catch 'loop
- (while (and (symbolp func)
- (setq func (symbol-function func))
- (symbolp func))
- (when (or (memq func chain)
- (eq func orig-func))
- (if noerror
- (throw 'loop chain)
- (signal 'cyclic-function-indirection (list orig-func))))
- (push func chain))
- chain))))
+If FUNC is a function alias, return the function alias chain."
+ (declare (advertised-calling-convention (func) "30.1")
+ (side-effect-free error-free))
+ (let ((chain nil))
+ (while (and (symbolp func)
+ (setq func (symbol-function func))
+ (symbolp func))
+ (push func chain))
+ (nreverse chain)))
(defun readablep (object)
"Say whether OBJECT has a readable syntax.
@@ -7023,6 +7132,7 @@ is inserted before adjusting the number of empty lines."
If OMIT-NULLS, empty lines will be removed from the results.
If KEEP-NEWLINES, don't strip trailing newlines from the result
lines."
+ (declare (side-effect-free t))
(if (equal string "")
(if omit-nulls
nil
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index a1d7d4bbbec..f51edfb4c80 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1399,9 +1399,8 @@ for determining whether point is within a selector."
:feature 'query
:language 'css
- '((keyword_query) @font-lock-property-face
- (feature_name) @font-lock-property-face)
-
+ '((keyword_query) @font-lock-property-use-face
+ (feature_name) @font-lock-property-use-face)
:feature 'bracket
:language 'css
diff --git a/lisp/textmodes/emacs-news-mode.el
b/lisp/textmodes/emacs-news-mode.el
index b844955e1be..773b07764aa 100644
--- a/lisp/textmodes/emacs-news-mode.el
+++ b/lisp/textmodes/emacs-news-mode.el
@@ -53,13 +53,28 @@
:parent emacs-news-common-map
"C-c C-s" #'emacs-news-next-untagged-entry
"C-c C-r" #'emacs-news-previous-untagged-entry
- "C-c C-t" #'emacs-news-toggle-tag
+ "C-c C-t" #'emacs-news-cycle-tag
+ "C-c C-d" #'emacs-news-delete-temporary-markers
"C-c C-g" #'emacs-news-goto-section
"C-c C-j" #'emacs-news-find-heading
"C-c C-e" #'emacs-news-count-untagged-entries
"C-x C-q" #'emacs-news-view-mode
"<remap> <open-line>" #'emacs-news-open-line)
+(easy-menu-define emacs-news-mode-menu emacs-news-mode-map
+ "Menu for `emacs-news-mode'."
+ '("News"
+ ["Next Untagged" emacs-news-next-untagged-entry :help "Go to next untagged
entry"]
+ ["Previous Untagged" emacs-news-previous-untagged-entry :help "Go to
previous untagged entry"]
+ ["Count Untagged" emacs-news-count-untagged-entries :help "Count the
number of untagged entries"]
+ ["Cycle Tag" emacs-news-cycle-tag :help "Cycle documentation tag of
current entry"]
+ ["Delete Tags" emacs-news-delete-temporary-markers :help "Delete all
documentation tags in buffer"]
+ "--"
+ ["Goto Section" emacs-news-goto-section :help "Prompt for section and go
to it"]
+ ["Goto Heading" emacs-news-find-heading :help "Prompt for heading and go
to it"]
+ "--"
+ ["Enter View Mode" emacs-news-view-mode :help "Enter view-only mode"]))
+
(defvar emacs-news-view-mode-map
;; This is defined this way instead of inheriting because we're
;; deriving the mode from `special-mode' and want the keys from there.
@@ -173,14 +188,16 @@ untagged NEWS entry."
(interactive nil emacs-news-mode)
(emacs-news-next-untagged-entry t))
-(defun emacs-news-toggle-tag ()
- "Toggle documentation tag of current headline in the Emacs NEWS file."
+(defun emacs-news-cycle-tag ()
+ "Cycle documentation tag of current headline in the Emacs NEWS file."
(interactive nil emacs-news-mode)
(save-excursion
(goto-char (line-beginning-position))
(cond ((or (looking-at (rx bol (or "---" "+++") eol)))
(forward-line 2))
- ((or (looking-at (rx bol "*** ")))
+ ((or (looking-at (rx bol "**"
+ (zero-or-more "*")
+ " ")))
(forward-line 1)))
(outline-previous-visible-heading 1)
(forward-line -1)
@@ -191,7 +208,7 @@ untagged NEWS entry."
(insert "+++"))
((looking-at (rx bol "+++" eol))
(delete-char 4))
- (t (user-error "Invalid headline tag; can't toggle")))))
+ (t (user-error "Invalid headline tag; can't cycle")))))
(defun emacs-news-count-untagged-entries ()
"Say how many untagged entries there are in the current NEWS buffer."
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 3da6effbcfe..bb2bcfd8052 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -318,7 +318,9 @@ window system by evaluating the following on startup to set
this variable:
;;;###autoload
(defcustom ispell-personal-dictionary nil
"File name of your personal spelling dictionary, or nil.
-If nil, the default personal dictionary for your spelling checker is used."
+If nil, the default personal dictionary for your spelling checker is used.
+Due to a misfeature of Hunspell, if the value is an absolute file name, the
+file by that name must already exist for Hunspell to be able to use it."
:type '(choice file
(const :tag "default" nil)))
@@ -1730,7 +1732,10 @@ If you specify a personal dictionary for the current
buffer which is
different from the current personal dictionary, the effect is similar
to calling \\[ispell-change-dictionary]. This variable is automatically
set when defined in the file with either `ispell-pdict-keyword' or the
-local variable syntax.")
+local variable syntax.
+
+Due to a misfeature of Hunspell, if the value is an absolute file name, the
+file by that name must already exist for Hunspell to be able to use it.")
;;;###autoload(put 'ispell-local-pdict 'safe-local-variable 'stringp)
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index bf249fdcdfb..6c33380b6bd 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -476,8 +476,7 @@ sentences. Also, every paragraph boundary terminates
sentences as well."
(skip-chars-backward " \t\n")
(goto-char par-end)))
(setq arg (1- arg)))
- (let ((npoint (constrain-to-field nil opoint t)))
- (not (= npoint opoint)))))
+ (constrain-to-field nil opoint t)))
(defvar forward-sentence-function #'forward-sentence-default-function
"Function to be used to calculate sentence movements.
@@ -499,8 +498,13 @@ sentence. Delegates its work to
`forward-sentence-function'."
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
- (while (ignore-errors (forward-sentence))
- (setq sentences (1+ sentences)))
+ (let* ((prev (point))
+ (next (forward-sentence)))
+ (while (and (not (null next))
+ (not (= prev next)))
+ (setq prev next
+ next (ignore-errors (forward-sentence))
+ sentences (1+ sentences))))
;; Remove last possibly empty sentence
(when (/= (skip-chars-backward " \t\n") 0)
(setq sentences (1- sentences)))
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index 7315c1e1e74..da0779c8e8d 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -495,7 +495,7 @@ When called with 2 \\[universal-argument] prefix args,
disable magic word recogn
sep1 (cdr (assoc sep reftex-multiref-punctuation))
labels (cdr labels))
(when cut
- (backward-delete-char cut)
+ (delete-char (- cut))
(setq cut nil))
;; remove ~ if we do already have a space
diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el
index 416542084f1..2c491034372 100644
--- a/lisp/textmodes/toml-ts-mode.el
+++ b/lisp/textmodes/toml-ts-mode.el
@@ -92,8 +92,8 @@
:language 'toml
:feature 'pair
:override t ; Needed for overriding string face on keys.
- '((bare_key) @font-lock-property-face
- (quoted_key) @font-lock-property-face
+ '((bare_key) @font-lock-property-use-face
+ (quoted_key) @font-lock-property-use-face
(table ("[" @font-lock-bracket-face
(_) @font-lock-type-face
"]" @font-lock-bracket-face))
diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el
index a25230e6e61..dfa8d22fb34 100644
--- a/lisp/textmodes/yaml-ts-mode.el
+++ b/lisp/textmodes/yaml-ts-mode.el
@@ -94,22 +94,22 @@
:feature 'property
:override t
'((block_mapping_pair
- key: (flow_node (plain_scalar (string_scalar) @font-lock-property-face)))
+ key: (flow_node (plain_scalar (string_scalar)
@font-lock-property-use-face)))
(block_mapping_pair
key: (flow_node
- [(double_quote_scalar) (single_quote_scalar)]
@font-lock-property-face))
+ [(double_quote_scalar) (single_quote_scalar)]
@font-lock-property-use-face))
(flow_mapping
- (_ key: (flow_node (plain_scalar (string_scalar)
@font-lock-property-face))))
+ (_ key: (flow_node (plain_scalar (string_scalar)
@font-lock-property-use-face))))
(flow_mapping
(_ key:
(flow_node
- [(double_quote_scalar) (single_quote_scalar)]
@font-lock-property-face)))
+ [(double_quote_scalar) (single_quote_scalar)]
@font-lock-property-use-face)))
(flow_sequence
- (_ key: (flow_node (plain_scalar (string_scalar)
@font-lock-property-face))))
+ (_ key: (flow_node (plain_scalar (string_scalar)
@font-lock-property-use-face))))
(flow_sequence
(_ key:
(flow_node
- [(double_quote_scalar) (single_quote_scalar)]
@font-lock-property-face))))
+ [(double_quote_scalar) (single_quote_scalar)]
@font-lock-property-use-face))))
:language 'yaml
:feature 'error
diff --git a/lisp/time.el b/lisp/time.el
index f04a22dfd28..522bec46ac6 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -139,6 +139,11 @@ make the mail indicator stand out on a color display."
:version "22.1"
:type '(choice (const :tag "None" nil) face))
+(defface display-time-date-and-time nil
+ "Face for `display-time-format'."
+ :group 'mode-line-faces
+ :version "30.1")
+
(defvar display-time-mail-icon
(find-image '((:type xpm :file "letter.xpm" :ascent center)
(:type pbm :file "letter.pbm" :ascent center)))
@@ -179,6 +184,7 @@ depend on `display-time-day-and-date' and
`display-time-24hr-format'."
(format-time-string (or display-time-format
(if display-time-24hr-format "%H:%M" "%-I:%M%p"))
now)
+ 'face 'display-time-date-and-time
'help-echo (format-time-string "%a %b %e, %Y" now))
load
(if mail
diff --git a/lisp/transient.el b/lisp/transient.el
index 0b41bc44adb..96e711e950c 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -632,7 +632,8 @@ If `transient-save-history' is nil, then do nothing."
(transient-non-suffix :initarg :transient-non-suffix :initform nil)
(incompatible :initarg :incompatible :initform nil)
(suffix-description :initarg :suffix-description)
- (variable-pitch :initarg :variable-pitch :initform nil))
+ (variable-pitch :initarg :variable-pitch :initform nil)
+ (unwind-suffix :documentation "Internal use." :initform nil))
"Transient prefix command.
Each transient prefix command consists of a command, which is
@@ -876,18 +877,6 @@ to the setup function:
(list ,@(cl-mapcan (lambda (s) (transient--parse-child name s))
suffixes))))))
-(defmacro transient-define-groups (name &rest groups)
- "Define one or more GROUPS and store them in symbol NAME.
-GROUPS, defined using this macro, can be used inside the
-definition of transient prefix commands, by using the symbol
-NAME where a group vector is expected. GROUPS has the same
-form as for `transient-define-prefix'."
- (declare (debug (&define name [&rest vectorp]))
- (indent defun))
- `(put ',name 'transient--layout
- (list ,@(cl-mapcan (lambda (group) (transient--parse-child name group))
- groups))))
-
(defmacro transient-define-suffix (name arglist &rest args)
"Define NAME as a transient suffix command.
@@ -976,7 +965,7 @@ keyword.
Only use this alias to define an infix command that actually
sets an infix argument. To define a infix command that, for
-example, sets a variable use `transient-define-infix' instead.
+example, sets a variable, use `transient-define-infix' instead.
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)")
@@ -1059,26 +1048,30 @@ example, sets a variable use `transient-define-infix'
instead.
(setq args (plist-put args :key pop)))
(cond
((or (stringp car)
- (eq (car-safe car) 'lambda))
+ (and (eq (car-safe car) 'lambda)
+ (not (commandp car))))
(setq args (plist-put args :description pop)))
((and (symbolp car)
+ (not (keywordp car))
(not (commandp car))
(commandp (cadr spec)))
(setq args (plist-put args :description (macroexp-quote pop)))))
(cond
((keywordp car)
- (error "Need command, got %S" car))
+ (error "Need command, got `%s'" car))
((symbolp car)
(setq args (plist-put args :command (macroexp-quote pop))))
((and (commandp car)
(not (stringp car)))
(let ((cmd pop)
- (sym (intern (format "transient:%s:%s"
- prefix
- (or (plist-get args :description)
- (plist-get args :key))))))
- (defalias sym cmd)
- (setq args (plist-put args :command (macroexp-quote sym)))))
+ (sym (intern
+ (format "transient:%s:%s"
+ prefix
+ (let ((desc (plist-get args :description)))
+ (if (and desc (or (stringp desc) (symbolp desc)))
+ desc
+ (plist-get args :key)))))))
+ (setq args (plist-put args :command `(defalias ',sym ,cmd)))))
((or (stringp car)
(and car (listp car)))
(let ((arg pop))
@@ -1411,17 +1404,6 @@ Usually it remains current while the transient is
active.")
(defvar transient--history nil)
-(defvar transient--abort-commands
- '(abort-minibuffers ; (minibuffer-quit-recursive-edit)
- abort-recursive-edit ; (throw 'exit t)
- exit-recursive-edit ; (throw 'exit nil)
- keyboard-escape-quit ; dwim
- keyboard-quit ; (signal 'quit nil)
- minibuffer-keyboard-quit ; (abort-minibuffers)
- minibuffer-quit-recursive-edit ; (throw 'exit (lambda ()
- ; (signal 'minibuffer-quit nil)))
- top-level)) ; (throw 'top-level nil)
-
(defvar transient--scroll-commands
'(transient-scroll-up
transient-scroll-down
@@ -1476,10 +1458,11 @@ probably use this instead:
(lambda (obj)
(eq (transient--suffix-command obj)
(or command
- ;; When `this-command' is `transient-set-level',
- ;; its reader needs to know what command is being
- ;; configured.
- this-original-command)))
+ (if (eq this-command 'transient-set-level)
+ ;; This is how it can look up for which
+ ;; command it is setting the level.
+ this-original-command
+ this-command))))
(or transient--suffixes
transient-current-suffixes))))
(or (and (cdr suffixes)
@@ -1530,18 +1513,8 @@ then just return it. Otherwise return the symbol whose
;;; Keymaps
-(defvar transient-base-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "ESC ESC ESC") #'transient-quit-all)
- (define-key map (kbd "C-g") #'transient-quit-one)
- (define-key map (kbd "C-q") #'transient-quit-all)
- (define-key map (kbd "C-z") #'transient-suspend)
- (define-key map (kbd "C-v") #'transient-scroll-up)
- (define-key map (kbd "C-M-v") #'transient-scroll-down)
- (define-key map [next] #'transient-scroll-up)
- (define-key map [prior] #'transient-scroll-down)
- map)
- "Parent of other keymaps used by Transient.
+(defvar-keymap transient-base-map
+ :doc "Parent of other keymaps used by Transient.
This is the parent keymap of all the keymaps that are used in
all transients: `transient-map' (which in turn is the parent
@@ -1554,40 +1527,42 @@ the latter isn't a proper transient prefix command, it
can be
edited using the same functions as used for transients.
If you add a new command here, then you must also add a binding
-to `transient-predicate-map'.")
-
-(defvar transient-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map transient-base-map)
- (define-key map (kbd "C-u") #'universal-argument)
- (define-key map (kbd "C--") #'negative-argument)
- (define-key map (kbd "C-t") #'transient-show)
- (define-key map (kbd "?") #'transient-help)
- (define-key map (kbd "C-h") #'transient-help)
- ;; Also bound to "C-x p" and "C-x n" in transient-common-commands.
- (define-key map (kbd "C-M-p") #'transient-history-prev)
- (define-key map (kbd "C-M-n") #'transient-history-next)
- map)
- "Top-level keymap used by all transients.
+to `transient-predicate-map'."
+ "ESC ESC ESC" #'transient-quit-all
+ "C-g" #'transient-quit-one
+ "C-q" #'transient-quit-all
+ "C-z" #'transient-suspend
+ "C-v" #'transient-scroll-up
+ "C-M-v" #'transient-scroll-down
+ "<next>" #'transient-scroll-up
+ "<prior>" #'transient-scroll-down)
+
+(defvar-keymap transient-map
+ :doc "Top-level keymap used by all transients.
If you add a new command here, then you must also add a binding
-to `transient-predicate-map'. Also see `transient-base-map'.")
-
-(defvar transient-edit-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map transient-base-map)
- (define-key map (kbd "?") #'transient-help)
- (define-key map (kbd "C-h") #'transient-help)
- (define-key map (kbd "C-x l") #'transient-set-level)
- map)
- "Keymap that is active while a transient in is in \"edit mode\".")
-
-(defvar transient-sticky-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map transient-base-map)
- (define-key map (kbd "C-g") #'transient-quit-seq)
- map)
- "Keymap that is active while an incomplete key sequence is active.")
+to `transient-predicate-map'. Also see `transient-base-map'."
+ :parent transient-base-map
+ "C-u" #'universal-argument
+ "C--" #'negative-argument
+ "C-t" #'transient-show
+ "?" #'transient-help
+ "C-h" #'transient-help
+ ;; Also bound to "C-x p" and "C-x n" in transient-common-commands.
+ "C-M-p" #'transient-history-prev
+ "C-M-n" #'transient-history-next)
+
+(defvar-keymap transient-edit-map
+ :doc "Keymap that is active while a transient in is in \"edit mode\"."
+ :parent transient-base-map
+ "?" #'transient-help
+ "C-h" #'transient-help
+ "C-x l" #'transient-set-level)
+
+(defvar-keymap transient-sticky-map
+ :doc "Keymap that is active while an incomplete key sequence is active."
+ :parent transient-base-map
+ "C-g" #'transient-quit-seq)
(defvar transient--common-command-prefixes '(?\C-x))
@@ -1627,69 +1602,28 @@ to `transient-predicate-map'. Also see
`transient-base-map'.")
"Show common permanently")))
(list "C-x l" "Show/hide suffixes" #'transient-set-level))))))))
-(defvar transient-popup-navigation-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "<down-mouse-1>") #'transient-noop)
- (define-key map (kbd "<up>") #'transient-backward-button)
- (define-key map (kbd "<down>") #'transient-forward-button)
- (define-key map (kbd "C-r") #'transient-isearch-backward)
- (define-key map (kbd "C-s") #'transient-isearch-forward)
- (define-key map (kbd "M-RET") #'transient-push-button)
- map)
- "One of the keymaps used when popup navigation is enabled.
-See `transient-enable-popup-navigation'.")
-
-(defvar transient-button-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "<mouse-1>") #'transient-push-button)
- (define-key map (kbd "<mouse-2>") #'transient-push-button)
- map)
- "One of the keymaps used when popup navigation is enabled.
-See `transient-enable-popup-navigation'.")
-
-(defvar transient-predicate-map
- (let ((map (make-sparse-keymap)))
- (define-key map [transient-suspend] #'transient--do-suspend)
- (define-key map [transient-help] #'transient--do-stay)
- (define-key map [transient-set-level] #'transient--do-stay)
- (define-key map [transient-history-prev] #'transient--do-stay)
- (define-key map [transient-history-next] #'transient--do-stay)
- (define-key map [universal-argument] #'transient--do-stay)
- (define-key map [negative-argument] #'transient--do-minus)
- (define-key map [digit-argument] #'transient--do-stay)
- (define-key map [transient-quit-all] #'transient--do-quit-all)
- (define-key map [transient-quit-one] #'transient--do-quit-one)
- (define-key map [transient-quit-seq] #'transient--do-stay)
- (define-key map [transient-show] #'transient--do-stay)
- (define-key map [transient-update] #'transient--do-stay)
- (define-key map [transient-toggle-common] #'transient--do-stay)
- (define-key map [transient-set] #'transient--do-call)
- (define-key map [transient-save] #'transient--do-call)
- (define-key map [transient-reset] #'transient--do-call)
- (define-key map [describe-key-briefly] #'transient--do-stay)
- (define-key map [describe-key] #'transient--do-stay)
- (define-key map [transient-scroll-up] #'transient--do-stay)
- (define-key map [transient-scroll-down] #'transient--do-stay)
- (define-key map [mwheel-scroll] #'transient--do-stay)
- (define-key map [scroll-bar-toolkit-scroll] #'transient--do-stay)
- (define-key map [transient-noop] #'transient--do-noop)
- (define-key map [transient-mouse-push-button] #'transient--do-move)
- (define-key map [transient-push-button] #'transient--do-push-button)
- (define-key map [transient-backward-button] #'transient--do-move)
- (define-key map [transient-forward-button] #'transient--do-move)
- (define-key map [transient-isearch-backward] #'transient--do-move)
- (define-key map [transient-isearch-forward] #'transient--do-move)
- ;; If a valid but incomplete prefix sequence is followed by
- ;; an unbound key, then Emacs calls the `undefined' command
- ;; but does not set `this-command', `this-original-command'
- ;; or `real-this-command' accordingly. Instead they are nil.
- (define-key map [nil] #'transient--do-warn)
- map)
- "Base keymap used to map common commands to their transient behavior.
+(defvar-keymap transient-popup-navigation-map
+ :doc "One of the keymaps used when popup navigation is enabled.
+See `transient-enable-popup-navigation'."
+ "<down-mouse-1>" #'transient-noop
+ "<up>" #'transient-backward-button
+ "<down>" #'transient-forward-button
+ "C-r" #'transient-isearch-backward
+ "C-s" #'transient-isearch-forward
+ "M-RET" #'transient-push-button)
+
+(defvar-keymap transient-button-map
+ :doc "One of the keymaps used when popup navigation is enabled.
+See `transient-enable-popup-navigation'."
+ "<mouse-1>" #'transient-push-button
+ "<mouse-2>" #'transient-push-button)
+
+(defvar-keymap transient-predicate-map
+ :doc "Base keymap used to map common commands to their transient behavior.
The \"transient behavior\" of a command controls, among other
things, whether invoking the command causes the transient to be
-exited or not and whether infix arguments are exported before
+exited or not, and whether infix arguments are exported before
doing so.
Each \"key\" is a command that is common to all transients and
@@ -1701,7 +1635,43 @@ transient behavior of the respective command.
For transient commands that are bound in individual transients,
the transient behavior is specified using the `:transient' slot
-of the corresponding object.")
+of the corresponding object."
+ "<transient-suspend>" #'transient--do-suspend
+ "<transient-help>" #'transient--do-stay
+ "<transient-set-level>" #'transient--do-stay
+ "<transient-history-prev>" #'transient--do-stay
+ "<transient-history-next>" #'transient--do-stay
+ "<universal-argument>" #'transient--do-stay
+ "<negative-argument>" #'transient--do-minus
+ "<digit-argument>" #'transient--do-stay
+ "<top-level>" #'transient--do-quit-all
+ "<transient-quit-all>" #'transient--do-quit-all
+ "<transient-quit-one>" #'transient--do-quit-one
+ "<transient-quit-seq>" #'transient--do-stay
+ "<transient-show>" #'transient--do-stay
+ "<transient-update>" #'transient--do-stay
+ "<transient-toggle-common>" #'transient--do-stay
+ "<transient-set>" #'transient--do-call
+ "<transient-save>" #'transient--do-call
+ "<transient-reset>" #'transient--do-call
+ "<describe-key-briefly>" #'transient--do-stay
+ "<describe-key>" #'transient--do-stay
+ "<transient-scroll-up>" #'transient--do-stay
+ "<transient-scroll-down>" #'transient--do-stay
+ "<mwheel-scroll>" #'transient--do-stay
+ "<scroll-bar-toolkit-scroll>" #'transient--do-stay
+ "<transient-noop>" #'transient--do-noop
+ "<transient-mouse-push-button>" #'transient--do-move
+ "<transient-push-button>" #'transient--do-push-button
+ "<transient-backward-button>" #'transient--do-move
+ "<transient-forward-button>" #'transient--do-move
+ "<transient-isearch-backward>" #'transient--do-move
+ "<transient-isearch-forward>" #'transient--do-move
+ ;; If a valid but incomplete prefix sequence is followed by
+ ;; an unbound key, then Emacs calls the `undefined' command
+ ;; but does not set `this-command', `this-original-command'
+ ;; or `real-this-command' accordingly. Instead they are nil.
+ "<nil>" #'transient--do-warn)
(defvar transient--transient-map nil)
(defvar transient--predicate-map nil)
@@ -1717,8 +1687,8 @@ of the corresponding object.")
(defun transient--pop-keymap (var)
(let ((map (symbol-value var)))
- (transient--debug " pop %s%s" var (if map "" " VOID"))
(when map
+ (transient--debug " pop %s" var)
(with-demoted-errors "transient--pop-keymap: %S"
(internal-pop-keymap map 'overriding-terminal-local-map)))))
@@ -1745,9 +1715,9 @@ of the corresponding object.")
(string-trim key)
cmd conflict)))
(define-key map kbd cmd))))
- (when-let ((b (lookup-key map "-"))) (define-key map [kp-subtract] b))
- (when-let ((b (lookup-key map "="))) (define-key map [kp-equal] b))
- (when-let ((b (lookup-key map "+"))) (define-key map [kp-add] b))
+ (when-let ((b (keymap-lookup map "-"))) (keymap-set map "<kp-subtract>" b))
+ (when-let ((b (keymap-lookup map "="))) (keymap-set map "<kp-equal>" b))
+ (when-let ((b (keymap-lookup map "+"))) (keymap-set map "<kp-add>" b))
(when transient-enable-popup-navigation
;; `transient--make-redisplay-map' maps only over bindings that are
;; directly in the base keymap, so that cannot be a composed keymap.
@@ -1762,7 +1732,7 @@ of the corresponding object.")
(set-keymap-parent map transient-predicate-map)
(when (memq (oref transient--prefix transient-non-suffix)
'(nil transient--do-warn transient--do-noop))
- (define-key map [handle-switch-frame] #'transient--do-suspend))
+ (keymap-set map "<handle-switch-frame>" #'transient--do-suspend))
(dolist (obj transient--suffixes)
(let* ((cmd (oref obj command))
(sub-prefix (and (symbolp cmd) (get cmd 'transient--prefix) t))
@@ -1830,8 +1800,8 @@ of the corresponding object.")
This function is called by transient prefix commands to setup the
transient. In that case NAME is mandatory, LAYOUT and EDIT must
-be nil and PARAMS may be (but usually is not) used to set e.g. the
-\"scope\" of the transient (see `transient-define-prefix').
+be nil and PARAMS may be (but usually is not) used to set, e.g.,
+the \"scope\" of the transient (see `transient-define-prefix').
This function is also called internally in which case LAYOUT and
EDIT may be non-nil."
@@ -2042,6 +2012,7 @@ value. Otherwise return CHILDREN as is."
(transient--push-keymap 'transient--redisplay-map)
(add-hook 'pre-command-hook #'transient--pre-command)
(add-hook 'post-command-hook #'transient--post-command)
+ (advice-add 'recursive-edit :around #'transient--recursive-edit)
(when transient--exitp
;; This prefix command was invoked as the suffix of another.
;; Prevent `transient--post-command' from removing the hooks
@@ -2077,11 +2048,14 @@ value. Otherwise return CHILDREN as is."
(not (memq this-command '(transient-quit-one
transient-quit-all
transient-help))))
- (setq this-command 'transient-set-level))
+ (setq this-command 'transient-set-level)
+ (transient--wrap-command))
(t
(setq transient--exitp nil)
- (when (eq (transient--do-pre-command) transient--exit)
- (transient--pre-exit))))))
+ (let ((exitp (eq (transient--do-pre-command) transient--exit)))
+ (transient--wrap-command)
+ (when exitp
+ (transient--pre-exit)))))))
(defun transient--do-pre-command ()
(if-let ((fn (transient--get-predicate-for this-command)))
@@ -2163,7 +2137,7 @@ value. Otherwise return CHILDREN as is."
(remove-hook 'pre-command-hook #'transient--pre-command)
(remove-hook 'post-command-hook #'transient--post-command))
-(defun transient--resume-override ()
+(defun transient--resume-override (&optional _ignore)
(transient--debug 'resume-override)
(when (and transient--showp transient-hide-during-minibuffer-read)
(transient--show))
@@ -2172,6 +2146,19 @@ value. Otherwise return CHILDREN as is."
(add-hook 'pre-command-hook #'transient--pre-command)
(add-hook 'post-command-hook #'transient--post-command))
+(defun transient--recursive-edit (fn)
+ (transient--debug 'recursive-edit)
+ (if (not transient--prefix)
+ (funcall fn)
+ (transient--suspend-override (bound-and-true-p edebug-active))
+ (funcall fn) ; Already unwind protected.
+ (cond ((memq this-command '(top-level abort-recursive-edit))
+ (setq transient--exitp t)
+ (transient--post-exit)
+ (transient--delete-window))
+ (transient--prefix
+ (transient--resume-override)))))
+
(defmacro transient--with-suspended-override (&rest body)
(let ((depth (make-symbol "depth"))
(setup (make-symbol "setup"))
@@ -2199,76 +2186,69 @@ value. Otherwise return CHILDREN as is."
(remove-hook 'minibuffer-exit-hook ,exit)))
,@body)))
-(defun transient--post-command-hook ()
- (run-hooks 'transient--post-command-hook))
-
-(add-hook 'post-command-hook #'transient--post-command-hook)
-
-(defun transient--delay-post-command (&optional abort-only)
- (transient--debug 'delay-post-command)
- (let ((depth (minibuffer-depth))
- (command this-command)
- (delayed (if transient--exitp
- (apply-partially #'transient--post-exit this-command)
- #'transient--resume-override))
- outside-interactive post-command abort-minibuffer)
- (unless abort-only
- (setq post-command
- (lambda () "@transient--delay-post-command"
- (let ((act (and (not (equal (this-command-keys-vector) []))
- (or (eq this-command command)
- ;; `execute-extended-command' was
- ;; used to call another command
- ;; that also uses the minibuffer.
- (equal
- (ignore-errors
- (string-to-multibyte (this-command-keys)))
- (format "\M-x%s\r" this-command))
- ;; Minibuffer used outside `interactive'.
- (and outside-interactive 'post-cmd)))))
- (transient--debug 'post-command-hook "act: %s" act)
- (when act
- (remove-hook 'transient--post-command-hook post-command)
- (remove-hook 'minibuffer-exit-hook abort-minibuffer)
- (funcall delayed)))))
- (add-hook 'transient--post-command-hook post-command))
- (setq abort-minibuffer
- (lambda () "@transient--delay-post-command"
- (let ((act (and (= (minibuffer-depth) depth)
- (or (memq this-command transient--abort-commands)
- (equal (this-command-keys) "")
- (prog1 nil
- (setq outside-interactive t))))))
- (transient--debug
- 'abort-minibuffer
- "mini: %s|%s, act: %s" (minibuffer-depth) depth
- (or act (and outside-interactive '->post-cmd)))
- (when act
- (remove-hook 'transient--post-command-hook post-command)
- (remove-hook 'minibuffer-exit-hook abort-minibuffer)
- (funcall delayed)))))
- (add-hook 'minibuffer-exit-hook abort-minibuffer)))
+(defun transient--wrap-command ()
+ (let* ((prefix transient--prefix)
+ (suffix this-command)
+ (advice nil)
+ (advice-interactive
+ (lambda (spec)
+ (let ((abort t))
+ (unwind-protect
+ (prog1 (advice-eval-interactive-spec spec)
+ (setq abort nil))
+ (when abort
+ (when-let ((unwind (oref prefix unwind-suffix)))
+ (transient--debug 'unwind-interactive)
+ (funcall unwind suffix))
+ (if (symbolp suffix)
+ (advice-remove suffix advice)
+ (remove-function suffix advice))
+ (oset prefix unwind-suffix nil))))))
+ (advice-body
+ (lambda (fn &rest args)
+ (unwind-protect
+ (apply fn args)
+ (when-let ((unwind (oref prefix unwind-suffix)))
+ (transient--debug 'unwind-command)
+ (funcall unwind suffix))
+ (if (symbolp suffix)
+ (advice-remove suffix advice)
+ (remove-function suffix advice))
+ (oset prefix unwind-suffix nil)))))
+ (setq advice `(lambda (fn &rest args)
+ (interactive ,advice-interactive)
+ (apply ',advice-body fn args)))
+ (if (symbolp suffix)
+ (advice-add suffix :around advice '((depth . -99)))
+ (add-function :around (var suffix) advice '((depth . -99))))))
+
+(defun transient--premature-post-command ()
+ (and (equal (this-command-keys-vector) [])
+ (= (minibuffer-depth)
+ (1+ transient--minibuffer-depth))
+ (progn
+ (transient--debug 'premature-post-command)
+ (transient--suspend-override)
+ (oset (or transient--prefix transient-current-prefix)
+ unwind-suffix
+ (if transient--exitp
+ #'transient--post-exit
+ #'transient--resume-override))
+ t)))
(defun transient--post-command ()
- (transient--debug 'post-command)
- (transient--with-emergency-exit
- (cond
- ((and (equal (this-command-keys-vector) [])
- (= (minibuffer-depth)
- (1+ transient--minibuffer-depth)))
- (transient--suspend-override)
- (transient--delay-post-command (eq transient--exitp 'replace)))
- (transient--exitp
- (transient--post-exit))
- ((eq this-command (oref transient--prefix command)))
- (t
- (let ((old transient--redisplay-map)
- (new (transient--make-redisplay-map)))
- (unless (equal old new)
- (transient--pop-keymap 'transient--redisplay-map)
- (setq transient--redisplay-map new)
- (transient--push-keymap 'transient--redisplay-map)))
- (transient--redisplay)))))
+ (unless (transient--premature-post-command)
+ (transient--debug 'post-command)
+ (transient--with-emergency-exit
+ (cond (transient--exitp (transient--post-exit))
+ ((eq this-command (oref transient--prefix command)))
+ ((let ((old transient--redisplay-map)
+ (new (transient--make-redisplay-map)))
+ (unless (equal old new)
+ (transient--pop-keymap 'transient--redisplay-map)
+ (setq transient--redisplay-map new)
+ (transient--push-keymap 'transient--redisplay-map))
+ (transient--redisplay)))))))
(defun transient--post-exit (&optional command)
(transient--debug 'post-exit)
@@ -2289,7 +2269,8 @@ value. Otherwise return CHILDREN as is."
(setq transient--exitp nil)
(transient--stack-zap)))))
(remove-hook 'pre-command-hook #'transient--pre-command)
- (remove-hook 'post-command-hook #'transient--post-command))
+ (remove-hook 'post-command-hook #'transient--post-command)
+ (advice-remove 'recursive-edit #'transient--recursive-edit))
(setq transient-current-prefix nil)
(setq transient-current-command nil)
(setq transient-current-suffixes nil)
@@ -2358,7 +2339,7 @@ value. Otherwise return CHILDREN as is."
(when transient--debug
(let ((inhibit-message (not (eq transient--debug 'message))))
(if (symbolp arg)
- (message "-- %-18s (cmd: %s, event: %S, exit: %s%s)"
+ (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
arg
(or (ignore-errors (transient--suffix-symbol this-command))
(if (byte-code-function-p this-command)
@@ -2596,10 +2577,10 @@ transient is active."
(defvar transient-resume-mode)
-(defun transient-help ()
- "Show help for the active transient or one of its suffixes."
- (interactive)
- (if (called-interactively-p 'any)
+(defun transient-help (&optional interactive)
+ "Show help for the active transient or one of its suffixes.\n\n(fn)"
+ (interactive (list t))
+ (if interactive
(setq transient--helpp t)
(with-demoted-errors "transient-help: %S"
(when (lookup-key transient--transient-map
@@ -3840,17 +3821,15 @@ Suffixes on levels %s and %s are unavailable.\n"
(propertize (format ">=%s" (1+ level))
'face 'transient-disabled-suffix))))))
-(defvar transient-resume-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap Man-quit] #'transient-resume)
- (define-key map [remap Info-exit] #'transient-resume)
- (define-key map [remap quit-window] #'transient-resume)
- map)
- "Keymap for `transient-resume-mode'.
+(defvar-keymap transient-resume-mode-map
+ :doc "Keymap for `transient-resume-mode'.
This keymap remaps every command that would usually just quit the
documentation buffer to `transient-resume', which additionally
-resumes the suspended transient.")
+resumes the suspended transient."
+ "<remap> <Man-quit>" #'transient-resume
+ "<remap> <Info-exit>" #'transient-resume
+ "<remap> <quit-window>" #'transient-resume)
(define-minor-mode transient-resume-mode
"Auxiliary minor-mode used to resume a transient after viewing help.")
@@ -3910,13 +3889,11 @@ See `forward-button' for information about N."
;;; Compatibility
;;;; Popup Isearch
-(defvar transient--isearch-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map isearch-mode-map)
- (define-key map [remap isearch-exit] #'transient-isearch-exit)
- (define-key map [remap isearch-cancel] #'transient-isearch-cancel)
- (define-key map [remap isearch-abort] #'transient-isearch-abort)
- map))
+(defvar-keymap transient--isearch-mode-map
+ :parent isearch-mode-map
+ "<remap> <isearch-exit>" #'transient-isearch-exit
+ "<remap> <isearch-cancel>" #'transient-isearch-cancel
+ "<remap> <isearch-abort>" #'transient-isearch-abort)
(defun transient-isearch-backward (&optional regexp-p)
"Do incremental search backward.
@@ -3994,23 +3971,6 @@ search instead."
;;;; Edebug
-(defun transient--edebug--recursive-edit (fn arg-mode)
- (transient--debug 'edebug--recursive-edit)
- (if (not transient--prefix)
- (funcall fn arg-mode)
- (transient--suspend-override t)
- (funcall fn arg-mode)
- (transient--resume-override)))
-
-(advice-add 'edebug--recursive-edit :around
#'transient--edebug--recursive-edit)
-
-(defun transient--abort-edebug ()
- (when (bound-and-true-p edebug-active)
- (transient--emergency-exit)))
-
-(advice-add 'abort-recursive-edit :before #'transient--abort-edebug)
-(advice-add 'top-level :before #'transient--abort-edebug)
-
(defun transient--edebug-command-p ()
(and (bound-and-true-p edebug-active)
(or (memq this-command '(top-level abort-recursive-edit))
@@ -4060,8 +4020,8 @@ that does that. Of course \"Q\" may already be bound to
something
else, so that function binds \"M-q\" to that command instead.
Of course \"M-q\" may already be bound to something else, but
we stop there."
- (define-key transient-base-map "q" #'transient-quit-one)
- (define-key transient-sticky-map "q" #'transient-quit-seq)
+ (keymap-set transient-base-map "q" #'transient-quit-one)
+ (keymap-set transient-sticky-map "q" #'transient-quit-seq)
(setq transient-substitute-key-function
#'transient-rebind-quit-commands))
@@ -4105,7 +4065,8 @@ we stop there."
(regexp-opt (list "transient-define-prefix"
"transient-define-infix"
"transient-define-argument"
- "transient-define-suffix")
+ "transient-define-suffix"
+ "transient-define-groups")
t)
"\\_>[ \t'(]*"
"\\(\\(?:\\sw\\|\\s_\\)+\\)?")
diff --git a/lisp/treesit.el b/lisp/treesit.el
index d11e57fef8a..9bb58ec4ab1 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -166,10 +166,13 @@ parser in `treesit-parser-list', or nil if there is no
parser."
A leaf node is a node that doesn't have any child nodes.
The returned node's span covers POS: the node's beginning is before
-or at POS, and the node's end is at or after POS.
+or at POS, and the node's end is after POS.
-If no leaf node's span covers POS (e.g., POS is on whitespace
-between two leaf nodes), return the first leaf node after POS.
+If no such node exists, but there's a leaf node which ends at POS,
+return that node.
+
+Otherwise (e.g., when POS is on whitespace between two leaf
+nodes), return the first leaf node after POS.
If there is no leaf node after POS, return the first leaf node
before POS.
@@ -555,8 +558,35 @@ omitted, default END to BEG."
"Generic tree-sitter font-lock error"
'treesit-error)
+(defvar-local treesit-font-lock-settings nil
+ "A list of SETTINGs for treesit-based fontification.
+
+The exact format of each SETTING is considered internal. Use
+`treesit-font-lock-rules' to set this variable.
+
+Each SETTING has the form:
+
+ (QUERY ENABLE FEATURE OVERRIDE)
+
+QUERY must be a compiled query. See Info node `(elisp)Pattern
+Matching' for how to write a query and compile it.
+
+For SETTING to be activated for font-lock, ENABLE must be t. To
+disable this SETTING, set ENABLE to nil.
+
+FEATURE is the \"feature name\" of the query. Users can control
+which features are enabled with `treesit-font-lock-level' and
+`treesit-font-lock-feature-list'.
+
+OVERRIDE is the override flag for this query. Its value can be
+t, nil, append, prepend, keep. See more in
+`treesit-font-lock-rules'.")
+
(defun treesit--font-lock-level-setter (sym val)
- "Custom setter for `treesit-font-lock-level'."
+ "Custom setter for `treesit-font-lock-level'.
+Set the default value of SYM to VAL, recompute fontification
+features and refontify for every buffer where tree-sitter-based
+fontification is enabled."
(set-default sym val)
(and (treesit-available-p)
(named-let loop ((res nil)
@@ -571,7 +601,7 @@ omitted, default END to BEG."
res)
(let ((buffer (car buffers)))
(with-current-buffer buffer
- (if (treesit-parser-list)
+ (if treesit-font-lock-settings
(loop (append res (list buffer)) (cdr buffers))
(loop res (cdr buffers)))))))))
@@ -585,9 +615,10 @@ fontifications.
Level 1 usually contains only comments and definitions.
Level 2 usually adds keywords, strings, data types, etc.
Level 3 usually represents full-blown fontifications, including
-assignments, constants, numbers and literals, properties, etc.
+assignments, constants, numbers and literals, etc.
Level 4 adds everything else that can be fontified: delimiters,
-operators, brackets, punctuation, all functions and variables, etc.
+operators, brackets, punctuation, all functions, properties,
+variables, etc.
In addition to the decoration level, individual features can be
turned on/off by calling `treesit-font-lock-recompute-features'.
@@ -634,30 +665,6 @@ See the manual for more explanations on some of the
features.
For changes to this variable to take effect, run
`treesit-font-lock-recompute-features'.")
-(defvar-local treesit-font-lock-settings nil
- "A list of SETTINGs for treesit-based fontification.
-
-The exact format of each SETTING is considered internal. Use
-`treesit-font-lock-rules' to set this variable.
-
-Each SETTING has the form:
-
- (QUERY ENABLE FEATURE OVERRIDE)
-
-QUERY must be a compiled query. See Info node `(elisp)Pattern
-Matching' for how to write a query and compile it.
-
-For SETTING to be activated for font-lock, ENABLE must be t. To
-disable this SETTING, set ENABLE to nil.
-
-FEATURE is the \"feature name\" of the query. Users can control
-which features are enabled with `treesit-font-lock-level' and
-`treesit-font-lock-feature-list'.
-
-OVERRIDE is the override flag for this query. Its value can be
-t, nil, append, prepend, keep. See more in
-`treesit-font-lock-rules'.")
-
(defun treesit-font-lock-rules (&rest query-specs)
"Return a value suitable for `treesit-font-lock-settings'.
@@ -1100,9 +1107,11 @@ See `treesit-simple-indent-presets'.")
(&optional node-type parent-type node-field
node-index-min node-index-max)
(lambda (node parent &rest _)
- (and (or (null node-type)
- (string-match-p
- node-type (or (treesit-node-type node) "")))
+ (and (pcase node-type
+ ('nil t)
+ ('null (null node))
+ (_ (string-match-p
+ node-type (or (treesit-node-type node) ""))))
(or (null parent-type)
(string-match-p
parent-type (treesit-node-type parent)))
@@ -1179,12 +1188,18 @@ See `treesit-simple-indent-presets'.")
(skip-syntax-backward "-")
(point))))
(cons 'prev-adaptive-prefix
- (lambda (_n parent &rest _)
- (let ((comment-start-bol
- (save-excursion
- (goto-char (treesit-node-start parent))
- (line-beginning-position))))
+ (lambda (_n parent bol &rest _)
+ (let (comment-start-bol
+ this-line-has-prefix)
(save-excursion
+ (goto-char (treesit-node-start parent))
+ (setq comment-start-bol (line-beginning-position))
+
+ (goto-char bol)
+ (setq this-line-has-prefix
+ (and (looking-at adaptive-fill-regexp)
+ (match-string 1)))
+
(forward-line -1)
(and (>= (point) comment-start-bol)
adaptive-fill-regexp
@@ -1192,26 +1207,60 @@ See `treesit-simple-indent-presets'.")
;; If previous line is an empty line, don't
;; indent.
(not (looking-at (rx (* whitespace) eol)))
- (match-end 0))))))
+ ;; Return the anchor. If the indenting line
+ ;; has a prefix and the previous line also
+ ;; has a prefix, indent to the beginning of
+ ;; prev line's prefix rather than the end of
+ ;; prev line's prefix. (Bug#61314).
+ (or (and this-line-has-prefix
+ (match-beginning 1))
+ (match-end 0)))))))
;; TODO: Document.
(cons 'grand-parent
(lambda (_n parent &rest _)
(treesit-node-start (treesit-node-parent parent))))
+ (cons 'great-grand-parent
+ (lambda (_n parent &rest _)
+ (treesit-node-start
+ (treesit-node-parent
+ (treesit-node-parent parent)))))
(cons 'parent-bol (lambda (_n parent &rest _)
(save-excursion
(goto-char (treesit-node-start parent))
(back-to-indentation)
(point))))
- (cons 'prev-sibling (lambda (node &rest _)
+ (cons 'standalone-parent
+ (lambda (_n parent &rest _)
+ (save-excursion
+ (catch 'term
+ (while parent
+ (goto-char (treesit-node-start parent))
+ (when (looking-back (rx bol (* whitespace))
+ (line-beginning-position))
+ (throw 'term (point)))
+ (setq parent (treesit-node-parent parent)))))))
+ (cons 'prev-sibling (lambda (node parent bol &rest _)
(treesit-node-start
- (treesit-node-prev-sibling node))))
+ (or (treesit-node-prev-sibling node t)
+ ;; If node is nil (indenting empty
+ ;; line), we still try to guess the
+ ;; previous sibling.
+ (treesit-node-prev-sibling
+ (treesit-node-first-child-for-pos
+ parent bol)
+ t)
+ (treesit-node-child parent -1 t)))))
(cons 'no-indent (lambda (_n _p bol &rest _) bol))
(cons 'prev-line (lambda (_n _p bol &rest _)
(save-excursion
(goto-char bol)
(forward-line -1)
- (skip-chars-forward " \t"))))
- (cons 'point-min (lambda (&rest _) (point-min)))
+ (skip-chars-forward " \t")
+ (point))))
+ (cons 'column-0 (lambda (_n _p bol &rest _)
+ (save-excursion
+ (goto-char bol)
+ (line-beginning-position))))
;; TODO: Document.
(cons 'and (lambda (&rest fns)
(lambda (node parent bol &rest _)
@@ -1255,6 +1304,7 @@ MATCHER:
(match nil \"argument_list\" nil nil 0 0).
NODE-TYPE, PARENT-TYPE, and NODE-FIELD are regexps.
+ NODE-TYPE can also be `null', which matches when NODE is nil.
no-node
@@ -1298,6 +1348,11 @@ parent-bol
Returns the beginning of non-space characters on the line where
PARENT is on.
+standalone-parent
+
+ Finds the first ancestor node (parent, grandparent, etc) that
+ starts on its own line, and return the start of that node.
+
prev-sibling
Returns the start of NODE's previous sibling.
@@ -1310,9 +1365,9 @@ prev-line
Returns the first non-whitespace character on the previous line.
-point-min
+column-0
- Returns the beginning of buffer, which is always at column 0.
+ Returns the beginning of the current line, which is at column 0.
comment-start
@@ -1324,8 +1379,11 @@ prev-adaptive-prefix
Goes to the beginning of previous non-empty line, and tries
to match `adaptive-fill-regexp'. If it matches, return the
- end of the match, otherwise return nil. This is useful for a
- `indent-relative'-like indent behavior for block comments.")
+ end of the match, otherwise return nil. However, if the
+ current line begins with a prefix, return the beginning of
+ the prefix of the previous line instead, so that the two
+ prefixes aligns. This is useful for a `indent-relative'-like
+ indent behavior for block comments.")
(defun treesit--simple-indent-eval (exp)
"Evaluate EXP.
@@ -1489,14 +1547,24 @@ Similar to `treesit-indent', but indent a region
instead."
(aref meta-vec (+ 1 (* idx meta-len))) nil)
(pcase-let* ((`(,anchor . ,offset) (treesit--indent-1))
(marker (aref meta-vec (* idx meta-len))))
- ;; Set ANCHOR.
- (when anchor
+ (if (not (and anchor offset))
+ ;; No indent for this line, either...
+ (if (markerp marker)
+ (progn
+ ;; ... Set marker and offset to do a dummy
+ ;; indent, or...
+ (back-to-indentation)
+ (move-marker marker (point))
+ (setf (aref meta-vec (+ 1 (* idx meta-len))) 0))
+ ;; ...Set anchor to nil so no indent is performed.
+ (setf (aref meta-vec (* idx meta-len)) nil))
+ ;; Set ANCHOR.
(if (markerp marker)
(move-marker marker anchor)
(setf (aref meta-vec (* idx meta-len))
- (copy-marker anchor t))))
- ;; SET OFFSET.
- (setf (aref meta-vec (+ 1 (* idx meta-len))) offset)))
+ (copy-marker anchor t)))
+ ;; SET OFFSET.
+ (setf (aref meta-vec (+ 1 (* idx meta-len))) offset))))
(cl-incf idx)
(setq lines-left-to-move (forward-line 1)))
;; Now IDX = last valid IDX + 1.
@@ -1505,7 +1573,7 @@ Similar to `treesit-indent', but indent a region instead."
(dotimes (jdx idx)
(let ((anchor (aref meta-vec (* jdx meta-len)))
(offset (aref meta-vec (+ 1 (* jdx meta-len)))))
- (when offset
+ (when (and anchor offset)
(let ((col (save-excursion
(goto-char anchor)
(+ offset (current-column)))))
@@ -1826,10 +1894,23 @@ This is a tree-sitter equivalent of
`beginning-of-defun'.
Behavior of this function depends on `treesit-defun-type-regexp'
and `treesit-defun-skipper'."
(interactive "^p")
- (when (treesit-beginning-of-thing treesit-defun-type-regexp arg)
- (when treesit-defun-skipper
- (funcall treesit-defun-skipper))
- t))
+ (let ((orig-point (point))
+ (success nil))
+ (catch 'done
+ (dotimes (_ 2)
+
+ (when (treesit-beginning-of-thing treesit-defun-type-regexp arg)
+ (when treesit-defun-skipper
+ (funcall treesit-defun-skipper)
+ (setq success t)))
+
+ ;; If we end up at the same point, it means we went to the
+ ;; next beg-of-defun, but defun skipper moved point back to
+ ;; where we started, in this case we just move one step
+ ;; further.
+ (if (or (eq arg 0) (not (eq orig-point (point))))
+ (throw 'done success)
+ (setq arg (if (> arg 0) (1+ arg) (1- arg))))))))
(defun treesit-end-of-defun (&optional arg _)
"Move forward to next end of defun.
@@ -1841,9 +1922,21 @@ This is a tree-sitter equivalent of `end-of-defun'.
Behavior of
this function depends on `treesit-defun-type-regexp' and
`treesit-defun-skipper'."
(interactive "^p\nd")
- (when (treesit-end-of-thing treesit-defun-type-regexp arg)
- (when treesit-defun-skipper
- (funcall treesit-defun-skipper))))
+ (let ((orig-point (point)))
+ (catch 'done
+ (dotimes (_ 2) ; Not making progress is better than infloop.
+
+ (when (treesit-end-of-thing treesit-defun-type-regexp arg)
+ (when treesit-defun-skipper
+ (funcall treesit-defun-skipper)))
+
+ ;; If we end up at the same point, it means we went to the
+ ;; prev end-of-defun, but defun skipper moved point back to
+ ;; where we started, in this case we just move one step
+ ;; further.
+ (if (or (eq arg 0) (not (eq orig-point (point))))
+ (throw 'done nil)
+ (setq arg (if (> arg 0) (1+ arg) (1- arg))))))))
(defvar-local treesit-text-type-regexp "\\`comment\\'"
"A regexp that matches the node type of textual nodes.
@@ -1999,9 +2092,9 @@ REGEXP and PRED are the same as in
`treesit-thing-at-point'."
;;
;; prev-end (tricky):
;; 1. prev-sibling exists
-;; -> If you think about it, we are already at prev-sibling's end!
-;; So we need to go one step further, either to
-;; prev-prev-sibling's end, or parent's prev-sibling's end, etc.
+;; -> If we are already at prev-sibling's end, we need to go one
+;; step further, either to prev-prev-sibling's end, or parent's
+;; prev-sibling's end, etc.
;; 2. prev-sibling is nil but parent exists
;; -> Obviously we don't want to go to parent's end, instead, we
;; want to go to parent's prev-sibling's end. Again, we recurse
@@ -2051,18 +2144,24 @@ function is called recursively."
;; ...forward.
(if (and (eq side 'beg)
;; Should we skip the defun (recurse)?
- (cond (next (not recursing)) ; [1] (see below)
- (parent t) ; [2]
- (t nil)))
- ;; Special case: go to next beg-of-defun. Set POS
- ;; to the end of next-sib/parent defun, and run one
- ;; more step. If there is a next-sib defun, we only
- ;; need to recurse once, so we don't need to recurse
- ;; if we are already recursing [1]. If there is no
+ (cond (next (and (not recursing) ; [1] (see below)
+ (eq pos (funcall advance next))))
+ (parent t))) ; [2]
+ ;; Special case: go to next beg-of-defun, but point
+ ;; is already on beg-of-defun. Set POS to the end
+ ;; of next-sib/parent defun, and run one more step.
+ ;; If there is a next-sib defun, we only need to
+ ;; recurse once, so we don't need to recurse if we
+ ;; are already recursing [1]. If there is no
;; next-sib but a parent, keep stepping out
;; (recursing) until we got out of the parents until
;; (1) there is a next sibling defun, or (2) no more
;; parents [2].
+ ;;
+ ;; If point on beg-of-defun but we are already
+ ;; recurring, that doesn't count as special case,
+ ;; because we have already made progress (by moving
+ ;; the end of next before recurring.)
(setq pos (or (treesit--navigate-thing
(treesit-node-end (or next parent))
1 'beg regexp pred t)
@@ -2071,9 +2170,9 @@ function is called recursively."
(setq pos (funcall advance (or next parent))))
;; ...backward.
(if (and (eq side 'end)
- (cond (prev (not recursing))
- (parent t)
- (t nil)))
+ (cond (prev (and (not recursing)
+ (eq pos (funcall advance prev))))
+ (parent t)))
;; Special case: go to prev end-of-defun.
(setq pos (or (treesit--navigate-thing
(treesit-node-start (or prev parent))
@@ -2455,7 +2554,8 @@ to the offending pattern and highlight the pattern."
(with-current-buffer buf
(let* ((data (cdr err))
(message (nth 0 data))
- (start (nth 1 data)))
+ (start (nth 1 data))
+ (inhibit-read-only t))
(erase-buffer)
(insert (treesit-query-expand query))
(goto-char start)
@@ -2963,7 +3063,17 @@ function signals an error."
;; Copy out.
(unless (file-exists-p out-dir)
(make-directory out-dir t))
- (copy-file lib-name (file-name-as-directory out-dir) t t)
+ (let* ((library-fname (expand-file-name lib-name out-dir))
+ (old-fname (concat library-fname ".old")))
+ ;; Rename the existing shared library, if any, then
+ ;; install the new one, and try deleting the old one.
+ ;; This is for Windows systems, where we cannot simply
+ ;; overwrite a DLL that is being used.
+ (if (file-exists-p library-fname)
+ (rename-file library-fname old-fname t))
+ (copy-file lib-name (file-name-as-directory out-dir) t t)
+ ;; Ignore errors, in case the old version is still used.
+ (ignore-errors (delete-file old-fname)))
(message "Library installed to %s/%s" out-dir lib-name))
(when (file-exists-p workdir)
(delete-directory workdir t)))))
@@ -3031,7 +3141,7 @@ function signals an error."
"Parsers"
(treesit-parser-create
- :no-eval (treesit-parser-create)
+ :no-eval (treesit-parser-create 'c)
:eg-result-string "#<treesit-parser for c>")
(treesit-parser-delete
:no-value (treesit-parser-delete parser))
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index e9ee72029f3..6848c0c73a7 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -100,7 +100,10 @@ instead of the filename inheritance method."
(setq retval
(base64-encode-string
(format "%s:%s" user
- (encode-coding-string pass 'utf-8))
+ (if pass
+ (encode-coding-string pass
+ 'utf-8)
+ ""))
t))))
(symbol-value url-basic-auth-storage))))
(byserv
diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el
index 74d46f1c037..671885e418f 100644
--- a/lisp/url/url-domsuf.el
+++ b/lisp/url/url-domsuf.el
@@ -30,14 +30,26 @@
(defvar url-domsuf-domains nil)
+(defun url-domsuf--public-suffix-file ()
+ "Look for and return a file name for a recent \"public_suffix_list.dat\".
+Emacs ships with a copy of this file, but some systems might have
+a newer version available. Look for it in some standard
+locations, and if a newer file was found, then return that."
+ (car (sort
+ (seq-filter
+ #'file-readable-p
+ (list (expand-file-name "publicsuffix.txt.gz" data-directory)
+ (expand-file-name "publicsuffix.txt" data-directory)
+ ;; Debian and Fedora
+ "/usr/share/publicsuffix/public_suffix_list.dat"
+ ;; FreeBSD port
+ "/usr/local/share/public_suffix_list/public_suffix_list.dat"))
+ #'file-newer-than-file-p)))
+
(defun url-domsuf-parse-file ()
(with-temp-buffer
(with-auto-compression-mode
- (insert-file-contents
- (let* ((suffixfile (expand-file-name "publicsuffix.txt" data-directory))
- (compressed-file (concat suffixfile ".gz")))
- (or (and (file-readable-p compressed-file) compressed-file)
- suffixfile))))
+ (insert-file-contents (url-domsuf--public-suffix-file)))
(let ((domains nil)
domain exception)
(while (not (eobp))
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index b20e5073f74..f16be980945 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -239,35 +239,34 @@ overriding the value of `url-gateway-method'."
(if url-gateway-broken-resolution
(setq host (url-gateway-nslookup-host host)))
- (condition-case nil
- ;; This is a clean way to ensure the new process inherits the
- ;; right coding systems in both Emacs and XEmacs.
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (setq conn (pcase gw-method
- ((or 'tls 'ssl 'native)
- (if (eq gw-method 'native)
- (setq gw-method 'plain))
- (open-network-stream
- name buffer host service
- :type gw-method
- ;; Use non-blocking socket if we can.
- :nowait (and (featurep 'make-network-process)
- (url-asynchronous url-current-object)
- '(:nowait t))))
- ('socks
- (socks-open-network-stream name buffer host service))
- ('telnet
- (url-open-telnet name buffer host service))
- ('rlogin
- (unless url-gw-rlogin-obsolete-warned-once
- (lwarn 'url :error "Setting `url-gateway-method'
to `rlogin' is obsolete")
- (setq url-gw-rlogin-obsolete-warned-once t))
- (with-suppressed-warnings ((obsolete
url-open-rlogin))
- (url-open-rlogin name buffer host service)))
- (_
- (error "Bad setting of url-gateway-method: %s"
- url-gateway-method))))))
+ ;; This is a clean way to ensure the new process inherits the
+ ;; right coding systems in both Emacs and XEmacs.
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (setq conn (pcase gw-method
+ ((or 'tls 'ssl 'native)
+ (if (eq gw-method 'native)
+ (setq gw-method 'plain))
+ (open-network-stream
+ name buffer host service
+ :type gw-method
+ ;; Use non-blocking socket if we can.
+ :nowait (and (featurep 'make-network-process)
+ (url-asynchronous url-current-object)
+ '(:nowait t))))
+ ('socks
+ (socks-open-network-stream name buffer host service))
+ ('telnet
+ (url-open-telnet name buffer host service))
+ ('rlogin
+ (unless url-gw-rlogin-obsolete-warned-once
+ (lwarn 'url :error "Setting `url-gateway-method' to
`rlogin' is obsolete")
+ (setq url-gw-rlogin-obsolete-warned-once t))
+ (with-suppressed-warnings ((obsolete url-open-rlogin))
+ (url-open-rlogin name buffer host service)))
+ (_
+ (error "Bad setting of url-gateway-method: %s"
+ url-gateway-method)))))
conn)))
(provide 'url-gw)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index eb01dede56e..d776375d681 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -153,6 +153,17 @@ and hunk-based syntax highlighting otherwise as a
fallback."
:type (get 'whitespace-style 'custom-type)
:version "29.1")
+(defcustom diff-ignore-whitespace-switches "-b"
+ "Switch or list of diff switches to use when ignoring whitespace.
+The default \"-b\" means to ignore whitespace-only changes,
+\"-w\" means ignore all whitespace changes."
+ :type '(choice
+ (string :tag "Ignore whitespace-only changes" :value "-b")
+ (string :tag "Ignore all whitespace changes" :value "-w")
+ (string :tag "Single switch")
+ (repeat :tag "Multiple switches" (string :tag "Switch")))
+ :version "30.1")
+
(defvar diff-vc-backend nil
"The VC backend that created the current Diff buffer, if any.")
@@ -2103,10 +2114,13 @@ For use in `add-log-current-defun-function'."
(goto-char (+ (car pos) (cdr src)))
(add-log-current-defun)))))))
-(defun diff-ignore-whitespace-hunk ()
- "Re-diff the current hunk, ignoring whitespace differences."
- (interactive)
- (diff-refresh-hunk t))
+(defun diff-ignore-whitespace-hunk (&optional whole-buffer)
+ "Re-diff the current hunk, ignoring whitespace differences.
+With non-nil prefix arg, re-diff all the hunks."
+ (interactive "P")
+ (if whole-buffer
+ (diff--ignore-whitespace-all-hunks)
+ (diff-refresh-hunk t)))
(defun diff-refresh-hunk (&optional ignore-whitespace)
"Re-diff the current hunk."
@@ -2127,7 +2141,7 @@ For use in `add-log-current-defun-function'."
(coding-system-for-read buffer-file-coding-system)
opts old new)
(when ignore-whitespace
- (setq opts '("-b")))
+ (setq opts (ensure-list diff-ignore-whitespace-switches)))
(when opt-type
(setq opts (cons opt-type opts)))
@@ -2299,6 +2313,16 @@ Call FUN with two args (BEG and END) for each hunk."
(or (ignore-errors (diff-hunk-next) (point))
max)))))))))
+;; This doesn't use `diff--iterate-hunks', since that assumes that
+;; hunks don't change size.
+(defun diff--ignore-whitespace-all-hunks ()
+ "Re-diff all the hunks, ignoring whitespace-differences."
+ (save-excursion
+ (goto-char (point-min))
+ (diff-hunk-next)
+ (while (looking-at diff-hunk-header-re)
+ (diff-refresh-hunk t))))
+
(defun diff--font-lock-refined (max)
"Apply hunk refinement from font-lock."
(when (eq diff-refine 'font-lock)
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index d78f9ad9f36..28630792211 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -1527,7 +1527,10 @@ This default should work without changes."
(define-obsolete-function-alias 'ediff-convert-standard-filename
#'convert-standard-filename "28.1")
(define-obsolete-function-alias 'ediff-hide-face #'ignore "28.1")
(define-obsolete-function-alias 'ediff-file-remote-p #'file-remote-p "29.1")
-(define-obsolete-function-alias 'ediff-window-display-p #'display-graphic-p
"29.1")
+(define-obsolete-function-alias 'ediff-window-display-p #'display-graphic-p
"29.1"
+ "To prevent Ediff from creating frames, see `ediff-window-setup-function'.
+Set it to `ediff-setup-windows-plain' to do everything in a single frame,
+even on GUI terminal.")
(define-obsolete-function-alias 'ediff-mouse-event-p #'mouse-event-p "29.1")
(provide 'ediff-init)
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index de09be80e7c..e95742b304a 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -1299,7 +1299,7 @@ Otherwise, the A or B file present is copied to the
output file."
(setq ancestor-dir-files (cdr ancestor-dir-files))))
(if output-dir
(insert "output=" output-dir f "\t"))
- (backward-delete-char 1)
+ (delete-char -1)
(insert "\n")))))
;;; Common setup routines
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 72160c35f57..90905edb887 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1239,7 +1239,11 @@ For old-style locking-based version control systems,
like RCS:
When using this command to register a new file (or files), it
will automatically deduce which VC repository to register it
-with, using the most specific one."
+with, using the most specific one.
+
+If VERBOSE is non-nil (interactively, the prefix argument),
+you can specify a VC backend or (for centralized VCS only)
+the revision ID or branch ID."
(interactive "P")
(let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
(backend (car vc-fileset))
@@ -2342,8 +2346,8 @@ Unlike `vc-find-revision-save', doesn't save the buffer
to the file."
(ignore-errors (delay-mode-hooks (set-auto-mode))))
(normal-mode))
(set-buffer-modified-p nil)
- (setq buffer-read-only t))
- (setq failed nil)
+ (setq buffer-read-only t)
+ (setq failed nil))
(when (and failed (unless buffer (get-file-buffer filename)))
(with-current-buffer (get-file-buffer filename)
(set-buffer-modified-p nil))
@@ -2696,7 +2700,16 @@ earlier revisions. Show up to LIMIT entries (non-nil
means unlimited)."
is-start-revision limit type)))))
(defvar vc-log-view-type nil
- "Set this to differentiate the different types of logs.")
+ "Set this to record the type of VC log shown in the current buffer.
+Supported values are:
+
+ `short' -- short log form, one line for each commit
+ `long' -- long log form, including full log message and author
+ `with-diff' -- log including diffs
+ `log-outgoing' -- log of changes to be pushed to upstream
+ `log-incoming' -- log of changes to be brought by pulling from upstream
+ `log-search' -- log entries matching a pattern; shown in long format
+ `mergebase' -- log created by `vc-log-mergebase'.")
(put 'vc-log-view-type 'permanent-local t)
(defvar vc-sentinel-movepoint)
@@ -2753,13 +2766,20 @@ Each function runs in the log output buffer without
args.")
;;;###autoload
(defun vc-print-log (&optional working-revision limit)
- "List the change log of the current fileset in a window.
-If WORKING-REVISION is non-nil, leave point at that revision.
+ "Show in another window the VC change history of the current fileset.
+If WORKING-REVISION is non-nil, it should be a revision ID; position
+point in the change history buffer at that revision.
If LIMIT is non-nil, it should be a number specifying the maximum
number of revisions to show; the default is `vc-log-show-limit'.
When called interactively with a prefix argument, prompt for
-WORKING-REVISION and LIMIT."
+WORKING-REVISION and LIMIT.
+
+This shows a short log (one line for each commit) if the current
+fileset includes directories and the VC backend supports that;
+otherwise it shows the detailed log of each commit, which includes
+the full log message and the author. Additional control of the
+shown log style is available via `vc-log-short-style'."
(interactive
(cond
(current-prefix-arg
@@ -2784,14 +2804,14 @@ WORKING-REVISION and LIMIT."
;;;###autoload
(defun vc-print-root-log (&optional limit revision)
- "List the revision history for the current VC controlled tree in a window.
+ "Show in another window VC change history of the current VC controlled tree.
If LIMIT is non-nil, it should be a number specifying the maximum
number of revisions to show; the default is `vc-log-show-limit'.
-When called interactively with a prefix argument, prompt for LIMIT.
-When the prefix argument is a number, use it as LIMIT.
+When called interactively with a prefix argument, prompt for LIMIT, but
+if the prefix argument is a number, use it as LIMIT.
A special case is when the prefix argument is 1: in this case
-the command asks for the ID of a revision, and shows that revision
-with its diffs (if the underlying VCS supports that)."
+the command prompts for the ID of a revision, and shows that revision
+with its diffs (if the underlying VCS backend supports that)."
(interactive
(cond
((eq current-prefix-arg 1)
@@ -2875,15 +2895,17 @@ In some version control systems REMOTE-LOCATION can be
a remote branch name."
;;;###autoload
(defun vc-log-search (pattern)
- "Search the log of changes for PATTERN.
+ "Search the VC log of changes for PATTERN and show log of matching changes.
PATTERN is usually interpreted as a regular expression. However, its
exact semantics is up to the backend's log search command; some can
only match fixed strings.
-Display all entries that match log messages in long format.
-With a prefix argument, ask for a command to run that will output
-log entries."
+This command displays in long format all the changes whose log messages
+match PATTERN.
+
+With a prefix argument, the command asks for a shell command to run that
+will output log entries, and displays those log entries instead."
(interactive (list (unless current-prefix-arg
(read-regexp "Search log with pattern: "))))
(let ((backend (vc-deduce-backend)))
@@ -2894,8 +2916,8 @@ log entries."
;;;###autoload
(defun vc-log-mergebase (_files rev1 rev2)
- "Show a log of changes between the merge base of REV1 and REV2 revisions.
-The merge base is a common ancestor between REV1 and REV2 revisions."
+ "Show a log of changes between the merge base of revisions REV1 and REV2.
+The merge base is a common ancestor of revisions REV1 and REV2."
(interactive
(vc-diff-build-argument-list-internal
(or (ignore-errors (vc-deduce-fileset t))
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 771458508e6..5572dcb32f3 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -455,6 +455,7 @@ non-nil means return old filename."
(setq major-mode 'dired-mode)
(setq mode-name "Dired")
(dired-advertise)
+ (dired-hide-details-update-invisibility-spec)
(remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
(remove-hook 'before-change-functions #'wdired--before-change-fn t)
(remove-hook 'after-change-functions #'wdired--restore-properties t)
diff --git a/lisp/window.el b/lisp/window.el
index 2d9f746d8fb..08ce8498655 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -2484,14 +2484,6 @@ and no others."
(defalias 'some-window 'get-window-with-predicate)
-(defcustom display-buffer-avoid-small-windows nil
- "If non-nil, windows that have fewer lines than this are avoided.
-This is used by `get-lru-window'. The value is interpreted in units
-of the frame's canonical line height, like `window-total-height' does."
- :type '(choice (const nil) number)
- :version "29.1"
- :group 'windows)
-
(defun get-lru-window (&optional all-frames dedicated not-selected no-other)
"Return the least recently used window on frames specified by ALL-FRAMES.
Return a full-width window if possible. A minibuffer window is
@@ -2517,11 +2509,8 @@ have special meanings:
- A frame means consider all windows on that frame only.
Any other value of ALL-FRAMES means consider all windows on the
-selected frame and no others.
-
-`display-buffer-avoid-small-windows', if non-nil, is also taken into
-consideration. Windows whose height is smaller that the value of that
-variable will be avoided if larger windows are available."
+selected frame and no others."
+ (declare (side-effect-free error-free))
(let ((windows (window-list-1 nil 'nomini all-frames))
best-window best-time second-best-window second-best-time time)
(dolist (window windows)
@@ -2531,9 +2520,6 @@ variable will be avoided if larger windows are available."
(not (window-parameter window 'no-other-window))))
(setq time (window-use-time window))
(if (or (eq window (selected-window))
- (and display-buffer-avoid-small-windows
- (< (window-height window)
- display-buffer-avoid-small-windows))
(not (window-full-width-p window)))
(when (or (not second-best-time) (< time second-best-time))
(setq second-best-time time)
@@ -2603,6 +2589,7 @@ have special meanings:
Any other value of ALL-FRAMES means consider all windows on the
selected frame and no others."
+ (declare (side-effect-free error-free))
(let ((best-size 0)
best-window size)
(dolist (window (window-list-1 nil 'nomini all-frames))
@@ -3801,6 +3788,7 @@ frame, rounded if necessary. PIXELWISE non-nil means to
return
the coordinates in pixels where the values for RIGHT and BOTTOM
are one more than the actual value of these edges. Note that if
ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too."
+ (declare (side-effect-free t))
(let* ((window (window-normalize-window window body))
(frame (window-frame window))
(border-width (frame-internal-border-width frame))
@@ -3856,6 +3844,7 @@ ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too."
"Return a list of the edge coordinates of WINDOW's body.
The return value is that of `window-edges' called with argument
BODY non-nil."
+ (declare (side-effect-free t))
(window-edges window t))
(defalias 'window-inside-edges 'window-body-edges)
@@ -3863,12 +3852,14 @@ BODY non-nil."
"Return a list of the edge pixel coordinates of WINDOW.
The return value is that of `window-edges' called with argument
PIXELWISE non-nil."
+ (declare (side-effect-free t))
(window-edges window nil nil t))
(defun window-body-pixel-edges (&optional window)
"Return a list of the edge pixel coordinates of WINDOW's body.
The return value is that of `window-edges' called with arguments
BODY and PIXELWISE non-nil."
+ (declare (side-effect-free t))
(window-edges window t nil t))
(defalias 'window-inside-pixel-edges 'window-body-pixel-edges)
@@ -3876,12 +3867,14 @@ BODY and PIXELWISE non-nil."
"Return a list of the edge pixel coordinates of WINDOW.
The return value is that of `window-edges' called with argument
ABSOLUTE non-nil."
+ (declare (side-effect-free t))
(window-edges window nil t t))
(defun window-absolute-body-pixel-edges (&optional window)
"Return a list of the edge pixel coordinates of WINDOW's text area.
The return value is that of `window-edges' called with arguments
BODY and ABSOLUTE non-nil."
+ (declare (side-effect-free t))
(window-edges window t t t))
(defalias 'window-inside-absolute-pixel-edges
'window-absolute-body-pixel-edges)
@@ -4091,6 +4084,7 @@ with a special meaning are:
Anything else means consider all windows on the selected frame
and no others."
+ (declare (side-effect-free error-free))
(let ((base-window (selected-window)))
(if (and nomini (eq base-window (minibuffer-window)))
(setq base-window (next-window base-window)))
@@ -4149,6 +4143,10 @@ X and Y are FRAME-relative pixel coordinates. A
coordinate on an
edge shared by two windows is attributed to the window on the
right (or below). Return nil if no such window can be found.
+Tool-bar and tab-bar pseudo-windows are ignored by this function:
+if the specified coordinates are in any of these two windows, this
+function returns nil.
+
Optional argument FRAME must specify a live frame and defaults to
the selected one. Optional argument NO-OTHER non-nil means to
return nil if the window located at the specified coordinates has
@@ -7274,6 +7272,11 @@ entry. Otherwise, if WINDOW is new and the value of
dedicated flag to that value. In any other case, reset WINDOW's
dedicated flag to nil.
+If ALIST contains a non-nil `bump-use-time' entry, bump use time
+of WINDOW so further calls of `display-buffer-use-some-window'
+and `display-buffer-use-least-recent-window' will try to avoid
+it.
+
Return WINDOW if BUFFER and WINDOW are live."
(when (and (buffer-live-p buffer) (window-live-p window))
(display-buffer-record-window type window buffer)
@@ -7281,6 +7284,10 @@ Return WINDOW if BUFFER and WINDOW are live."
;; Unless WINDOW already shows BUFFER reset its dedicated flag.
(set-window-dedicated-p window nil)
(set-window-buffer window buffer))
+ (when (cdr (assq 'bump-use-time alist))
+ ;; Bump WINDOW's use time so 'display-buffer--lru-window' will try
+ ;; to avoid it.
+ (window-bump-use-time window))
(let ((alist-dedicated (assq 'dedicated alist)))
;; Maybe dedicate WINDOW to BUFFER if asked for.
(cond
@@ -8502,15 +8509,64 @@ indirectly called by the latter."
(when (setq window (or best-window second-best-window))
(window--display-buffer buffer window 'reuse alist))))
-(defun display-buffer-use-least-recent-window (buffer alist)
- "Display BUFFER in an existing window, but that hasn't been used lately.
-This `display-buffer' action function is like
-`display-buffer-use-some-window', but will cycle through windows
-when displaying buffers repeatedly, and if there's only a single
-window, it will split the window."
- (when-let ((window (display-buffer-use-some-window
- buffer (cons (cons 'inhibit-same-window t) alist))))
- (window-bump-use-time window)))
+(defun display-buffer--lru-window (alist)
+ "Return the least recently used window according to ALIST.
+Do not return a minibuffer window or a window dedicated to its
+buffer. ALIST is a buffer display action alist as compiled by
+`display-buffer'. The following ALIST entries are honored:
+
+- `lru-frames' specifies the frames to investigate and has the
+ same meaning as the ALL-FRAMES argument of `get-lru-window'.
+
+- `lru-time' specifies a use time. Do not return a window whose
+ use time is higher than this.
+
+- `window-min-width' specifies a preferred minimum width in
+ canonical frame columns. If it is the constant `full-width',
+ prefer a full-width window.
+
+- `window-min-height' specifies a preferred minimum height in
+ canonical frame lines. If it is the constant `full-height',
+ prefer a full-height window.
+
+If ALIST contains a non-nil `inhibit-same--window' entry, do not
+return the selected window."
+ (let ((windows
+ (window-list-1 nil 'nomini (cdr (assq 'lru-frames alist))))
+ (lru-time (cdr (assq 'lru-time alist)))
+ (min-width (cdr (assq 'window-min-width alist)))
+ (min-height (cdr (assq 'window-min-height alist)))
+ (not-this-window (cdr (assq 'inhibit-same-window alist)))
+ best-window best-time second-best-window second-best-time time)
+ (dolist (window windows)
+ (when (and (not (window-dedicated-p window))
+ (or (not not-this-window)
+ (not (eq window (selected-window)))))
+ (setq time (window-use-time window))
+ (unless (and (numberp lru-time) (> time lru-time))
+ (if (or (eq window (selected-window))
+ (and min-width
+ (or (and (numberp min-width)
+ (< (window-width window) min-width))
+ (and (eq min-width 'full-width)
+ (not (window-full-width-p window)))))
+ (and min-height
+ (or (and (numberp min-height)
+ (< (window-height window) min-height))
+ (and (eq min-height 'full-height)
+ (not (window-full-height-p window))))))
+ ;; This window is either selected or does not meet the size
+ ;; restrictions - so it's only a second best choice. Try to
+ ;; find a more recently used one that fits.
+ (when (or (not second-best-time) (< time second-best-time))
+ (setq second-best-time time)
+ (setq second-best-window window))
+ ;; This window is not selected and does meet the size
+ ;; restrictions. It's the best choice so far.
+ (when (or (not best-time) (< time best-time))
+ (setq best-time time)
+ (setq best-window window))))))
+ (or best-window second-best-window)))
(defun display-buffer-use-some-window (buffer alist)
"Display BUFFER in an existing window.
@@ -8534,7 +8590,11 @@ indirectly called by the latter."
(window--frame-usable-p (last-nonminibuffer-frame))))
(window
;; Reuse an existing window.
- (or (get-lru-window frame nil not-this-window)
+ (or (display-buffer--lru-window
+ ;; If ALIST specifies 'lru-frames' or 'window-min-width'
+ ;; let them prevail.
+ (append alist `((lru-frames . ,frame)
+ (window-min-width . full-width))))
(let ((window (get-buffer-window buffer 'visible)))
(unless (and not-this-window
(eq window (selected-window)))
@@ -8564,6 +8624,76 @@ indirectly called by the latter."
(unless (cdr (assq 'inhibit-switch-frame alist))
(window--maybe-raise-frame (window-frame window)))))))
+(defun display-buffer-use-least-recent-window (buffer alist)
+ "Display BUFFER trying to avoid windows used recently.
+This is similar to `display-buffer-use-some-window' but tries
+hard to avoid using a window recently used by `display-buffer'.
+
+Distinctive features are:
+
+- Do not use the selected window.
+
+- Try first to reuse a window that shows BUFFER already on a
+ frame specified by a `reusable-frames' ALIST entry, using the
+ selected frame if no such entry has been specified.
+
+- Next try to show BUFFER in the least recently used window. The
+ frames to search for such a window can be specified via a
+ `lru-frames' ALIST entry; if no such entry exists, search the
+ selected frame only. In addition, try to satisfy constraints
+ specified by the following ALIST entries, if present:
+
+ `lru-time' specifies a use time. Do not return a window whose
+ use time is higher than this. When calling this action
+ function repeatedly (presumably to display several buffers in
+ a row), an application should first save the use time of the
+ selected window and pass that same value via such an entry in
+ each call of `display-buffer'. This reduces the probability
+ that `display-buffer' uses the same window as a previous
+ call.
+
+ `window-min-width' specifies a preferred minimum width in
+ canonical frame columns. If it is the constant `full-width',
+ prefer a full-width window.
+
+ `window-min-height' specifies a preferred minimum height in
+ canonical frame lines. If it is the constant `full-height',
+ prefer a full-height window.
+
+- If the preceding steps fail, try to pop up a new window on the
+ selected frame.
+
+If a window is found, bump the use time of that window to the
+highest use time after the selected window. This makes it less
+probable that a future invocation of this function uses that
+window for another buffer."
+ (let* ((alist (cons (cons 'inhibit-same-window t) alist))
+ (window
+ (or (display-buffer-reuse-window buffer alist)
+ (let ((window (display-buffer--lru-window alist)))
+ (when (window-live-p window)
+ (let* ((quit-restore (window-parameter window 'quit-restore))
+ (quad (nth 1 quit-restore)))
+ ;; If the window was used by `display-buffer' before, try
to
+ ;; resize it to its old height but don't signal an error.
+ (when (and (listp quad)
+ (integerp (nth 3 quad))
+ (> (nth 3 quad) (window-total-height window)))
+ (condition-case nil
+ (window-resize
+ window (- (nth 3 quad) (window-total-height
window)))
+ (error nil)))
+ (prog1
+ (window--display-buffer buffer window 'reuse alist)
+ (window--even-window-sizes window)
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame (window-frame window)))))))
+ (display-buffer-pop-up-window buffer alist))))
+ ;; Don't bump use time twice.
+ (when (and window (not (cdr (assq 'bump-use-time alist))))
+ (window-bump-use-time window))
+ window))
+
(defun display-buffer-no-window (_buffer alist)
"Display BUFFER in no window.
ALIST is an association list of action symbols and values. See
diff --git a/lisp/woman.el b/lisp/woman.el
index 92cd425d32f..24f23c8e8f0 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1690,11 +1690,11 @@ Do not call directly!"
(progn
(goto-char (point-min))
(while (search-forward "__\b\b" nil t)
- (backward-delete-char 4)
+ (delete-char -4)
(woman-set-face (point) (1+ (point)) 'woman-italic))
(goto-char (point-min))
(while (search-forward "\b\b__" nil t)
- (backward-delete-char 4)
+ (delete-char -4)
(woman-set-face (1- (point)) (point) 'woman-italic))))
;; Interpret overprinting to indicate bold face:
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index abbda29081e..7daca81f9f7 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -925,7 +925,8 @@ Return the buffer."
"Display the current xwidget webkit URL and place it on the `kill-ring'."
(interactive nil xwidget-webkit-mode)
(let ((url (xwidget-webkit-uri (xwidget-webkit-current-session))))
- (message "URL: %s" (kill-new (or url "")))))
+ (when url (kill-new url))
+ (message "URL: %s" url)))
(defun xwidget-webkit-browse-history ()
"Display a buffer containing the history of page loads."
diff --git a/m4/assert_h.m4 b/m4/assert_h.m4
index 3801452ef0d..d255855d313 100644
--- a/m4/assert_h.m4
+++ b/m4/assert_h.m4
@@ -46,10 +46,13 @@ AC_DEFUN([gl_ASSERT_H],
gl_NEXT_HEADERS([assert.h])])
dnl The "zz" puts this toward config.h's end, to avoid potential
- dnl collisions with other definitions. #undef assert so that
- dnl programs are not tempted to use it without specifically
- dnl including assert.h. Break the #undef apart with a comment
- dnl so that 'configure' does not comment it out.
+ dnl collisions with other definitions.
+ dnl #undef assert so that programs are not tempted to use it without
+ dnl specifically including assert.h.
+ dnl #undef __ASSERT_H__ so that on IRIX, when programs later include
+ dnl <assert.h>, this include actually defines assert.
+ dnl Break the #undef_s apart with a comment so that 'configure' does
+ dnl not comment them out.
AH_VERBATIM([zzstatic_assert],
[#if (!defined HAVE_C_STATIC_ASSERT && !defined assert \
&& (!defined __cplusplus \
@@ -57,6 +60,9 @@ AC_DEFUN([gl_ASSERT_H],
&& __GNUG__ < 6 && __clang_major__ < 6)))
#include <assert.h>
#undef/**/assert
+ #ifdef __sgi
+ #undef/**/__ASSERT_H__
+ #endif
/* Solaris 11.4 <assert.h> defines static_assert as a macro with 2 arguments.
We need it also to be invocable with a single argument. */
#if defined __sun && (__STDC_VERSION__ - 0 >= 201112L) && !defined __cplusplus
diff --git a/m4/fdopendir.m4 b/m4/fdopendir.m4
index 2c975397118..dfcc46c03e2 100644
--- a/m4/fdopendir.m4
+++ b/m4/fdopendir.m4
@@ -1,4 +1,4 @@
-# serial 14
+# serial 15
# See if we need to provide fdopendir.
dnl Copyright (C) 2009-2023 Free Software Foundation, Inc.
@@ -49,12 +49,12 @@ DIR *fdopendir (int);
[gl_cv_func_fdopendir_works=yes],
[gl_cv_func_fdopendir_works=no],
[case "$host_os" in
- # Guess yes on glibc systems.
- *-gnu*) gl_cv_func_fdopendir_works="guessing yes" ;;
- # Guess yes on musl systems.
- *-musl*) gl_cv_func_fdopendir_works="guessing yes" ;;
- # If we don't know, obey --enable-cross-guesses.
- *) gl_cv_func_fdopendir_works="$gl_cross_guess_normal" ;;
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_fdopendir_works="guessing yes" ;;
+ # Guess yes on musl systems.
+ *-musl* | midipix*) gl_cv_func_fdopendir_works="guessing yes" ;;
+ # If we don't know, obey
--enable-cross-guesses.
+ *)
gl_cv_func_fdopendir_works="$gl_cross_guess_normal" ;;
esac
])])
case "$gl_cv_func_fdopendir_works" in
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index c0181abdc50..c84a2afd9c5 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 80
+# gnulib-common.m4 serial 82
dnl Copyright (C) 2007-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -356,7 +356,7 @@ AC_DEFUN([gl_COMMON_BODY], [
[[__maybe_unused__]] nevertheless produces a warning. */
#ifndef _GL_ATTRIBUTE_MAYBE_UNUSED
# if defined __clang__ && defined __cplusplus
-# if __clang_major__ >= 10
+# if !defined __apple_build_version__ && __clang_major__ >= 10
# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]]
# endif
# elif defined __has_c_attribute
@@ -1095,6 +1095,113 @@ AC_DEFUN([gl_CONDITIONAL_HEADER],
m4_popdef([gl_header_name])
])
+dnl Preparations for gl_CHECK_FUNCS_MACOS.
+AC_DEFUN([gl_PREPARE_CHECK_FUNCS_MACOS],
+[
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ AC_REQUIRE([gl_COMPILER_CLANG])
+ AC_CACHE_CHECK([for compiler option needed when checking for future
declarations],
+ [gl_cv_compiler_check_future_option],
+ [case "$host_os" in
+ dnl This is only needed on macOS.
+ darwin*)
+ if test $gl_cv_compiler_clang = yes; then
+ dnl Test whether the compiler supports the option
+ dnl '-Werror=unguarded-availability-new'.
+ save_ac_compile="$ac_compile"
+ ac_compile="$ac_compile -Werror=unguarded-availability-new"
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]],[[]])],
+
[gl_cv_compiler_check_future_option='-Werror=unguarded-availability-new'],
+ [gl_cv_compiler_check_future_option=none])
+ ac_compile="$save_ac_compile"
+ else
+ gl_cv_compiler_check_future_option=none
+ fi
+ ;;
+ *) gl_cv_compiler_check_future_option=none ;;
+ esac
+ ])
+])
+
+dnl Pieces of the expansion of
+dnl gl_CHECK_FUNCS_ANDROID
+dnl gl_CHECK_FUNCS_MACOS
+dnl gl_CHECK_FUNCS_ANDROID_MACOS
+
+AC_DEFUN([gl_CHECK_FUNCS_DEFAULT_CASE],
+[
+ *)
+ AC_CHECK_FUNC([$1])
+ [gl_cv_onwards_func_][$1]=$[ac_cv_func_][$1]
+ ;;
+])
+
+AC_DEFUN([gl_CHECK_FUNCS_CASE_FOR_ANDROID],
+[
+ linux*-android*)
+ AC_CHECK_DECL([$1], , , [$2])
+ if test $[ac_cv_have_decl_][$1] = yes; then
+ AC_CHECK_FUNC([[$1]])
+ if test $[ac_cv_func_][$1] = yes; then
+ [gl_cv_onwards_func_][$1]=yes
+ else
+ dnl The function is declared but does not exist. This should not
+ dnl happen normally. But anyway, we know that a future version
+ dnl of Android will have the function.
+ [gl_cv_onwards_func_][$1]='future OS version'
+ fi
+ else
+ [gl_cv_onwards_func_][$1]='future OS version'
+ fi
+ ;;
+])
+
+AC_DEFUN([gl_CHECK_FUNCS_CASE_FOR_MACOS],
+[
+ darwin*)
+ if test "x$gl_cv_compiler_check_future_option" != "xnone"; then
+ dnl Use a compile test, not a link test.
+ save_ac_compile="$ac_compile"
+ ac_compile="$ac_compile $gl_cv_compiler_check_future_option"
+ save_ac_compile_for_check_decl="$ac_compile_for_check_decl"
+ ac_compile_for_check_decl="$ac_compile_for_check_decl
$gl_cv_compiler_check_future_option"
+ unset [ac_cv_have_decl_][$1]
+ AC_CHECK_DECL([$1], , , [$2])
+ ac_compile="$save_ac_compile"
+ ac_compile_for_check_decl="$save_ac_compile_for_check_decl"
+ [ac_cv_func_][$1]="$[ac_cv_have_decl_][$1]"
+ if test $[ac_cv_func_][$1] = yes; then
+ [gl_cv_onwards_func_][$1]=yes
+ else
+ unset [ac_cv_have_decl_][$1]
+ AC_CHECK_DECL([$1], , , [$2])
+ if test $[ac_cv_have_decl_][$1] = yes; then
+ [gl_cv_onwards_func_][$1]='future OS version'
+ else
+ [gl_cv_onwards_func_][$1]=no
+ fi
+ fi
+ else
+ AC_CHECK_FUNC([$1])
+ [gl_cv_onwards_func_][$1]=$[ac_cv_func_][$1]
+ fi
+ ;;
+])
+
+AC_DEFUN([gl_CHECK_FUNCS_SET_RESULTS],
+[
+ case "$[gl_cv_onwards_func_][$1]" in
+ future*) [ac_cv_func_][$1]=no ;;
+ *) [ac_cv_func_][$1]=$[gl_cv_onwards_func_][$1] ;;
+ esac
+ if test $[ac_cv_func_][$1] = yes; then
+ AC_DEFINE([HAVE_]m4_translit([[$1]],
+ [abcdefghijklmnopqrstuvwxyz],
+ [ABCDEFGHIJKLMNOPQRSTUVWXYZ]),
+ [1], [Define to 1 if you have the `$1' function.])
+ fi
+])
+
dnl gl_CHECK_FUNCS_ANDROID([func], [[#include <foo.h>]])
dnl is like AC_CHECK_FUNCS([func]), taking into account a portability problem
dnl on Android.
@@ -1137,39 +1244,87 @@ AC_DEFUN([gl_CHECK_FUNCS_ANDROID],
[[gl_cv_onwards_func_][$1]],
[gl_SILENT([
case "$host_os" in
- linux*-android*)
- AC_CHECK_DECL([$1], , , [$2])
- if test $[ac_cv_have_decl_][$1] = yes; then
- AC_CHECK_FUNC([[$1]])
- if test $[ac_cv_func_][$1] = yes; then
- [gl_cv_onwards_func_][$1]=yes
- else
- dnl The function is declared but does not exist. This should not
- dnl happen normally. But anyway, we know that a future version
- dnl of Android will have the function.
- [gl_cv_onwards_func_][$1]='future OS version'
- fi
- else
- [gl_cv_onwards_func_][$1]='future OS version'
- fi
- ;;
- *)
- AC_CHECK_FUNC([$1])
- [gl_cv_onwards_func_][$1]=$[ac_cv_func_][$1]
- ;;
+ gl_CHECK_FUNCS_CASE_FOR_ANDROID([$1], [$2])
+ gl_CHECK_FUNCS_DEFAULT_CASE([$1])
esac
])
])
- case "$[gl_cv_onwards_func_][$1]" in
- future*) [ac_cv_func_][$1]=no ;;
- *) [ac_cv_func_][$1]=$[gl_cv_onwards_func_][$1] ;;
- esac
- if test $[ac_cv_func_][$1] = yes; then
- AC_DEFINE([HAVE_]m4_translit([[$1]],
- [abcdefghijklmnopqrstuvwxyz],
- [ABCDEFGHIJKLMNOPQRSTUVWXYZ]),
- [1], [Define to 1 if you have the `$1' function.])
- fi
+ gl_CHECK_FUNCS_SET_RESULTS([$1])
+])
+
+dnl gl_CHECK_FUNCS_MACOS([func], [[#include <foo.h>]])
+dnl is like AC_CHECK_FUNCS([func]), taking into account a portability problem
+dnl on macOS.
+dnl
+dnl When code is compiled on macOS, it is in the context of a certain minimum
+dnl macOS version, that can be set through the option '-mmacosx-version-min='.
+dnl In other words, you don't compile for a specific version of macOS. You
+dnl compile for all versions of macOS, onwards from the given version.
+dnl Thus, the question "does the OS have the function func" has three possible
+dnl answers:
+dnl - yes, in all versions starting from the given version,
+dnl - no, in no version,
+dnl - not in the given version, but in a later version of macOS.
+dnl
+dnl In detail, this works as follows:
+dnl If func was added to, say, macOS version 13, then the libc has the
+dnl symbol func always, whereas the header file <foo.h> declares func
+dnl conditionally with a special availability attribute:
+dnl ... func (...) __attribute__((availability(macos,introduced=13.0)));
+dnl Thus, when compiling with "clang mmacosx-version-min=13", there is no
+dnl warning about the use of func, and the resulting binary
+dnl - runs fine on macOS 13,
+dnl - aborts with a dyld "Symbol not found" message on macOS 12.
+dnl Whereas, when compiling with "clang mmacosx-version-min=12", there is a
+dnl warning: 'func' is only available on macOS 13.0 or newer
+dnl [-Wunguarded-availability-new],
+dnl and the resulting binary
+dnl - runs fine on macOS 13,
+dnl - crashes with a SIGSEGV (signal 11) on macOS 12.
+dnl
+dnl This macro sets two variables:
+dnl - gl_cv_onwards_func_<func> to yes / no / "future OS version"
+dnl - ac_cv_func_<func> to yes / no / no
+dnl The first variable allows to distinguish all three cases.
+dnl The second variable is set, so that an invocation
+dnl gl_CHECK_FUNCS_MACOS([func], [[#include <foo.h>]])
+dnl can be used as a drop-in replacement for
+dnl AC_CHECK_FUNCS([func]).
+AC_DEFUN([gl_CHECK_FUNCS_MACOS],
+[
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ AC_REQUIRE([gl_PREPARE_CHECK_FUNCS_MACOS])
+ AC_CACHE_CHECK([for [$1]],
+ [[gl_cv_onwards_func_][$1]],
+ [gl_SILENT([
+ case "$host_os" in
+ gl_CHECK_FUNCS_CASE_FOR_MACOS([$1], [$2])
+ gl_CHECK_FUNCS_DEFAULT_CASE([$1])
+ esac
+ ])
+ ])
+ gl_CHECK_FUNCS_SET_RESULTS([$1])
+])
+
+dnl gl_CHECK_FUNCS_ANDROID_MACOS([func], [[#include <foo.h>]])
+dnl is like AC_CHECK_FUNCS([func]), taking into account a portability problem
+dnl on Android and on macOS.
+dnl It is the combination of gl_CHECK_FUNCS_ANDROID and gl_CHECK_FUNCS_MACOS.
+AC_DEFUN([gl_CHECK_FUNCS_ANDROID_MACOS],
+[
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ AC_REQUIRE([gl_PREPARE_CHECK_FUNCS_MACOS])
+ AC_CACHE_CHECK([for [$1]],
+ [[gl_cv_onwards_func_][$1]],
+ [gl_SILENT([
+ case "$host_os" in
+ gl_CHECK_FUNCS_CASE_FOR_ANDROID([$1], [$2])
+ gl_CHECK_FUNCS_CASE_FOR_MACOS([$1], [$2])
+ gl_CHECK_FUNCS_DEFAULT_CASE([$1])
+ esac
+ ])
+ ])
+ gl_CHECK_FUNCS_SET_RESULTS([$1])
])
dnl Expands to some code for use in .c programs that, on native Windows,
defines
diff --git a/m4/limits-h.m4 b/m4/limits-h.m4
index 5088fa16fd3..4f8ce41098a 100644
--- a/m4/limits-h.m4
+++ b/m4/limits-h.m4
@@ -23,6 +23,7 @@ AC_DEFUN_ONCE([gl_LIMITS_H],
int wb = WORD_BIT;
int ullw = ULLONG_WIDTH;
int bw = BOOL_WIDTH;
+ int bm = BOOL_MAX;
]])],
[gl_cv_header_limits_width=yes],
[gl_cv_header_limits_width=no])])
diff --git a/m4/lstat.m4 b/m4/lstat.m4
index 7e667fb187a..2bc46697934 100644
--- a/m4/lstat.m4
+++ b/m4/lstat.m4
@@ -1,4 +1,4 @@
-# serial 33
+# serial 34
# Copyright (C) 1997-2001, 2003-2023 Free Software Foundation, Inc.
#
@@ -56,6 +56,9 @@ AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK],
linux-* | linux)
# Guess yes on Linux systems.
gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;;
+ midipix*)
+ # Guess yes on systems that emulate the Linux system calls.
+ gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;;
*-gnu* | gnu*)
# Guess yes on glibc systems.
gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;;
diff --git a/m4/malloc.m4 b/m4/malloc.m4
index 554029243d1..bc580176f5f 100644
--- a/m4/malloc.m4
+++ b/m4/malloc.m4
@@ -1,4 +1,4 @@
-# malloc.m4 serial 28
+# malloc.m4 serial 29
dnl Copyright (C) 2007, 2009-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -25,7 +25,7 @@ AC_DEFUN([_AC_FUNC_MALLOC_IF],
[case "$host_os" in
# Guess yes on platforms where we know the result.
*-gnu* | freebsd* | netbsd* | openbsd* | bitrig* \
- | gnu* | *-musl* | midnightbsd* \
+ | gnu* | *-musl* | midipix* | midnightbsd* \
| hpux* | solaris* | cygwin* | mingw* | msys* )
ac_cv_func_malloc_0_nonnull="guessing yes" ;;
# If we don't know, obey --enable-cross-guesses.
diff --git a/m4/pselect.m4 b/m4/pselect.m4
index 9f2b282cee0..6c3d1b8f97f 100644
--- a/m4/pselect.m4
+++ b/m4/pselect.m4
@@ -1,4 +1,4 @@
-# pselect.m4 serial 10
+# pselect.m4 serial 11
dnl Copyright (C) 2011-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -54,6 +54,8 @@ AC_DEFUN([gl_FUNC_PSELECT],
case "$host_os" in
# Guess yes on Linux systems.
linux-* | linux) gl_cv_func_pselect_detects_ebadf="guessing yes" ;;
+ # Guess yes on systems that emulate the Linux
system calls.
+ midipix*) gl_cv_func_pselect_detects_ebadf="guessing yes" ;;
# Guess yes on glibc systems.
*-gnu* | gnu*) gl_cv_func_pselect_detects_ebadf="guessing yes" ;;
# If we don't know, obey --enable-cross-guesses.
diff --git a/m4/readlink.m4 b/m4/readlink.m4
index 078b93aa9dc..f1d41d2b113 100644
--- a/m4/readlink.m4
+++ b/m4/readlink.m4
@@ -1,4 +1,4 @@
-# readlink.m4 serial 16
+# readlink.m4 serial 17
dnl Copyright (C) 2003, 2007, 2009-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -38,6 +38,9 @@ AC_DEFUN([gl_FUNC_READLINK],
# Guess yes on Linux or glibc systems.
linux-* | linux | *-gnu* | gnu*)
gl_cv_func_readlink_trailing_slash="guessing yes" ;;
+ # Guess yes on systems that emulate the Linux system calls.
+ midipix*)
+ gl_cv_func_readlink_trailing_slash="guessing yes" ;;
# Guess no on AIX or HP-UX.
aix* | hpux*)
gl_cv_func_readlink_trailing_slash="guessing no" ;;
@@ -75,6 +78,9 @@ AC_DEFUN([gl_FUNC_READLINK],
# Guess yes on Linux or glibc systems.
linux-* | linux | *-gnu* | gnu*)
gl_cv_func_readlink_truncate="guessing yes" ;;
+ # Guess yes on systems that emulate the Linux system calls.
+ midipix*)
+ gl_cv_func_readlink_truncate="guessing yes" ;;
# Guess no on AIX or HP-UX.
aix* | hpux*)
gl_cv_func_readlink_truncate="guessing no" ;;
diff --git a/m4/realloc.m4 b/m4/realloc.m4
index d22138fc7ac..26053914cbe 100644
--- a/m4/realloc.m4
+++ b/m4/realloc.m4
@@ -1,4 +1,4 @@
-# realloc.m4 serial 26
+# realloc.m4 serial 27
dnl Copyright (C) 2007, 2009-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -25,7 +25,7 @@ AC_DEFUN([_AC_FUNC_REALLOC_IF],
[case "$host_os" in
# Guess yes on platforms where we know the result.
*-gnu* | freebsd* | netbsd* | openbsd* | bitrig* \
- | gnu* | *-musl* | midnightbsd* \
+ | gnu* | *-musl* | midipix* | midnightbsd* \
| hpux* | solaris* | cygwin* | mingw* | msys* )
ac_cv_func_realloc_0_nonnull="guessing yes" ;;
# If we don't know, obey --enable-cross-guesses.
diff --git a/m4/symlink.m4 b/m4/symlink.m4
index 7796ec8bbc0..52d6c115ca5 100644
--- a/m4/symlink.m4
+++ b/m4/symlink.m4
@@ -1,4 +1,4 @@
-# serial 9
+# serial 10
# See if we need to provide symlink replacement.
dnl Copyright (C) 2009-2023 Free Software Foundation, Inc.
@@ -38,6 +38,8 @@ AC_DEFUN([gl_FUNC_SYMLINK],
[case "$host_os" in
# Guess yes on Linux systems.
linux-* | linux) gl_cv_func_symlink_works="guessing yes" ;;
+ # Guess yes on systems that emulate the Linux
system calls.
+ midipix*) gl_cv_func_symlink_works="guessing yes" ;;
# Guess yes on glibc systems.
*-gnu* | gnu*) gl_cv_func_symlink_works="guessing yes" ;;
# If we don't know, obey --enable-cross-guesses.
diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp
index 634bf999e50..c3f410bd74d 100644
--- a/msdos/sedlibmk.inp
+++ b/msdos/sedlibmk.inp
@@ -428,6 +428,8 @@ s/= @GL_GENERATE_STDINT_H_CONDITION@/= 1/
s/= @GL_GENERATE_LIMITS_H_CONDITION@/= 1/
s/= @GL_GENERATE_ERRNO_H_CONDITION@/= /
s/= @GL_GENERATE_LIMITS_H_CONDITION@/= /
+s/= @GL_GENERATE_GETOPT_CDEFS_H_CONDITION@/= 1/
+s/= @GL_GENERATE_GETOPT_H_CONDITION@/= 1/
s/= @GL_GENERATE_GMP_H_CONDITION@/= 1/
s/= @GL_GENERATE_GMP_GMP_H_CONDITION@/= /
s/= @GL_GENERATE_MINI_GMP_H_CONDITION@/= 1/
diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site
index 7ca19cbad06..425eaace30d 100644
--- a/nt/mingw-cfg.site
+++ b/nt/mingw-cfg.site
@@ -170,3 +170,6 @@ gl_cv_func_free_preserves_errno=yes
# Don't build the Gnulib nanosleep module: it requires W2K or later,
# and MinGW does have nanosleep.
gl_cv_func_nanosleep=yes
+# Suppress configure-time diagnostic from unnecessary libxattr check,
+# as xattr will not be supported here.
+enable_xattr=no
diff --git a/src/.gdbinit b/src/.gdbinit
index 55f6c58e7b4..84bd6501a1a 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -940,7 +940,7 @@ Print the contents of $ as an Emacs Lisp cons.
end
define nextcons
- p $.u.cdr
+ p $.u.s.u.cdr
xcons
end
document nextcons
diff --git a/src/alloc.c b/src/alloc.c
index 3f0fc73cde6..9969ace5fef 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1085,7 +1085,11 @@ lisp_free (void *block)
BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
/* Byte alignment of storage blocks. */
-#define BLOCK_ALIGN (1 << 10)
+#ifdef HAVE_UNEXEC
+# define BLOCK_ALIGN (1 << 10)
+#else /* !HAVE_UNEXEC */
+# define BLOCK_ALIGN (1 << 15)
+#endif
verify (POWER_OF_2 (BLOCK_ALIGN));
#ifdef HAVE_NATIVE_COMP
@@ -3748,7 +3752,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH
&optional DOCSTRING INT
&& FIXNATP (args[COMPILED_STACK_DEPTH])))
error ("Invalid byte-code object");
- pin_string (args[COMPILED_BYTECODE]); // Bytecode must be immovable.
+ /* Bytecode must be immovable. */
+ pin_string (args[COMPILED_BYTECODE]);
/* We used to purecopy everything here, if purify-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
@@ -6020,7 +6025,7 @@ purecopy (Lisp_Object obj)
memcpy (vec, objp, nbytes);
for (i = 0; i < size; i++)
vec->contents[i] = purecopy (vec->contents[i]);
- // Byte code strings must be pinned.
+ /* Byte code strings must be pinned. */
if (COMPILEDP (obj) && size >= 2 && STRINGP (vec->contents[1])
&& !STRING_MULTIBYTE (vec->contents[1]))
pin_string (vec->contents[1]);
diff --git a/src/bidi.c b/src/bidi.c
index e01251263be..3c26ae19322 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -1126,6 +1126,7 @@ bidi_set_paragraph_end (struct bidi_it *bidi_it)
bidi_it->invalid_levels = 0;
bidi_it->invalid_isolates = 0;
bidi_it->stack_idx = 0;
+ bidi_it->isolate_level = 0;
bidi_it->resolved_level = bidi_it->level_stack[0].level;
}
@@ -3300,12 +3301,15 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
it belongs to a sequence of WS characters preceding a newline
or a TAB or a paragraph separator. */
if ((bidi_it->orig_type == NEUTRAL_WS
- || bidi_it->orig_type == WEAK_BN
+ || (bidi_it->orig_type == WEAK_BN
+ /* If this BN character is already at base level, we don't
+ need to consider resetting it, since I1 and I2 below
+ will not change the level, so avoid the potentially
+ costly loop below. */
+ && level != bidi_it->level_stack[0].level)
|| bidi_isolate_fmt_char (bidi_it->orig_type))
- && bidi_it->next_for_ws.charpos < bidi_it->charpos
- /* If this character is already at base level, we don't need to
- reset it, so avoid the potentially costly loop below. */
- && level != bidi_it->level_stack[0].level)
+ /* This means the informaition about WS resolution is not valid. */
+ && bidi_it->next_for_ws.charpos < bidi_it->charpos)
{
int ch;
ptrdiff_t clen = bidi_it->ch_len;
@@ -3340,7 +3344,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
|| bidi_it->orig_type == NEUTRAL_S
|| bidi_it->ch == '\n' || bidi_it->ch == BIDI_EOB
|| ((bidi_it->orig_type == NEUTRAL_WS
- || bidi_it->orig_type == WEAK_BN
+ || bidi_it->orig_type == WEAK_BN /* L1/Retaining */
|| bidi_isolate_fmt_char (bidi_it->orig_type)
|| bidi_explicit_dir_char (bidi_it->ch))
&& (bidi_it->next_for_ws.type == NEUTRAL_B
diff --git a/src/buffer.c b/src/buffer.c
index 88ca69b0dd8..df1f5206668 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -5081,8 +5081,8 @@ the mode line appears at the bottom. */);
The header line appears, optionally, at the top of a window; the mode
line appears at the bottom.
-Also see `header-line-indent-mode' if `display-line-number-mode' is
-used. */);
+Also see `header-line-indent-mode' if `display-line-numbers-mode' is
+turned on and header-line text should be aligned with buffer text. */);
DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer,
mode_line_format),
Qnil,
@@ -5916,40 +5916,41 @@ If nil, these display shortcuts will always remain
disabled.
There is no reason to change that value except for debugging purposes. */);
XSETFASTINT (Vlong_line_threshold, 50000);
- DEFVAR_INT ("long-line-locked-narrowing-region-size",
- long_line_locked_narrowing_region_size,
- doc: /* Region size for locked narrowing in buffers with long
lines.
+ DEFVAR_INT ("long-line-optimizations-region-size",
+ long_line_optimizations_region_size,
+ doc: /* Region size for narrowing in buffers with long lines.
-This variable has effect only in buffers which contain one or more
-lines whose length is above `long-line-threshold', which see. For
-performance reasons, in such buffers, low-level hooks such as
-`fontification-functions' or `post-command-hook' are executed on a
-narrowed buffer, with a narrowing locked with `narrowing-lock'. This
-variable specifies the size of the narrowed region around point.
+This variable has effect only in buffers in which
+`long-line-optimizations-p' is non-nil. For performance reasons, in
+such buffers, the `fontification-functions', `pre-command-hook' and
+`post-command-hook' hooks are executed on a narrowed buffer around
+point, as if they were called in a `with-restriction' form with a label.
+This variable specifies the size of the narrowed region around point.
To disable that narrowing, set this variable to 0.
-See also `long-line-locked-narrowing-bol-search-limit'.
+See also `long-line-optimizations-bol-search-limit'.
There is no reason to change that value except for debugging purposes. */);
- long_line_locked_narrowing_region_size = 500000;
+ long_line_optimizations_region_size = 500000;
- DEFVAR_INT ("long-line-locked-narrowing-bol-search-limit",
- long_line_locked_narrowing_bol_search_limit,
+ DEFVAR_INT ("long-line-optimizations-bol-search-limit",
+ long_line_optimizations_bol_search_limit,
doc: /* Limit for beginning of line search in buffers with long
lines.
-This variable has effect only in buffers which contain one or more
-lines whose length is above `long-line-threshold', which see. For
-performance reasons, in such buffers, low-level hooks such as
-`fontification-functions' or `post-command-hook' are executed on a
-narrowed buffer, with a narrowing locked with `narrowing-lock'. The
-variable `long-line-locked-narrowing-region-size' specifies the size
-of the narrowed region around point. This variable, which should be a
-small integer, specifies the number of characters by which that region
-can be extended backwards to make it start at the beginning of a line.
+This variable has effect only in buffers in which
+`long-line-optimizations-p' is non-nil. For performance reasons, in
+such buffers, the `fontification-functions', `pre-command-hook' and
+`post-command-hook' hooks are executed on a narrowed buffer around
+point, as if they were called in a `with-restriction' form with a label.
+The variable `long-line-optimizations-region-size' specifies the
+size of the narrowed region around point. This variable, which should
+be a small integer, specifies the number of characters by which that
+region can be extended backwards to make it start at the beginning of
+a line.
There is no reason to change that value except for debugging purposes. */);
- long_line_locked_narrowing_bol_search_limit = 128;
+ long_line_optimizations_bol_search_limit = 128;
DEFVAR_INT ("large-hscroll-threshold", large_hscroll_threshold,
doc: /* Horizontal scroll of truncated lines above which to use redisplay
shortcuts.
diff --git a/src/buffer.h b/src/buffer.h
index eb32d602ad6..e700297a264 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -690,7 +690,7 @@ struct buffer
display optimizations must be used. */
bool_bf long_line_optimizations_p : 1;
- /* The inveral tree containing this buffer's overlays. */
+ /* The interval tree containing this buffer's overlays. */
struct itree_tree *overlays;
/* Changes in the buffer are recorded here for undo, and t means
diff --git a/src/bytecode.c b/src/bytecode.c
index 124348e5b35..74a94859aba 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -789,10 +789,10 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
Lisp_Object template;
Lisp_Object bytecode;
if (COMPILEDP (call_fun)
- // Lexical binding only.
+ /* Lexical binding only. */
&& (template = AREF (call_fun, COMPILED_ARGLIST),
FIXNUMP (template))
- // No autoloads.
+ /* No autoloads. */
&& (bytecode = AREF (call_fun, COMPILED_BYTECODE),
!CONSP (bytecode)))
{
diff --git a/src/comp.c b/src/comp.c
index 245aa5b0a1b..54ebcdcfcdb 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -597,6 +597,10 @@ load_gccjit_if_necessary (bool mandatory)
#define CALL2I(fun, arg1, arg2) \
CALLN (Ffuncall, intern_c_string (STR (fun)), arg1, arg2)
+/* Like call4 but stringify and intern. */
+#define CALL4I(fun, arg1, arg2, arg3, arg4) \
+ CALLN (Ffuncall, intern_c_string (STR (fun)), arg1, arg2, arg3, arg4)
+
#define DECL_BLOCK(name, func) \
gcc_jit_block *(name) = \
gcc_jit_function_new_block ((func), STR (name))
@@ -7630,7 +7634,8 @@ DEFUN ("comp--compile-ctxt-to-file",
Fcomp__compile_ctxt_to_file,
format_string ("%s_libgccjit_repro.c", SSDATA (ebase_name)));
Lisp_Object tmp_file =
- Fmake_temp_file_internal (base_name, Qnil, build_string (".eln.tmp"),
Qnil);
+ CALL4I (make-temp-file, base_name, Qnil, build_string (".eln.tmp"), Qnil);
+
Lisp_Object encoded_tmp_file = ENCODE_FILE (tmp_file);
#ifdef WINDOWSNT
encoded_tmp_file = ansi_encode_filename (encoded_tmp_file);
@@ -7825,8 +7830,7 @@ maybe_defer_native_compilation (Lisp_Object function_name,
if (!load_gccjit_if_necessary (false))
return;
- if (!native_comp_deferred_compilation
- || !NILP (Vinhibit_automatic_native_compilation)
+ if (!native_comp_jit_compilation
|| noninteractive
|| !NILP (Vpurify_flag)
|| !COMPILEDP (definition)
@@ -8411,28 +8415,18 @@ syms_of_comp (void)
{
#ifdef HAVE_NATIVE_COMP
DEFVAR_LISP ("comp--delayed-sources", Vcomp__delayed_sources,
- doc: /* List of sources to be native-compiled when startup is
finished.
+ doc: /* List of sources to be native-compiled when startup is finished.
For internal use. */);
- DEFVAR_BOOL ("comp--compilable",
- comp__compilable,
- doc: /* Non-nil when comp.el can be native compiled.
+ DEFVAR_BOOL ("comp--compilable", comp__compilable,
+ doc: /* Non-nil when comp.el can be native compiled.
For internal use. */);
/* Compiler control customizes. */
- DEFVAR_LISP ("inhibit-automatic-native-compilation",
- Vinhibit_automatic_native_compilation,
- doc: /* If non-nil, inhibit automatic native compilation of
loaded .elc files.
-
-After compilation, each function definition is updated to the native
-compiled one. */);
- Vinhibit_automatic_native_compilation = Qnil;
+ DEFVAR_BOOL ("native-comp-jit-compilation", native_comp_jit_compilation,
+ doc: /* If non-nil, compile loaded .elc files asynchronously.
- DEFVAR_BOOL ("native-comp-deferred-compilation",
- native_comp_deferred_compilation,
- doc: /* If non-nil compile loaded .elc files asynchronously.
-
-After compilation, each function definition is updated to the native
-compiled one. */);
- native_comp_deferred_compilation = true;
+After compilation, each function definition is updated to use the
+natively-compiled one. */);
+ native_comp_jit_compilation = true;
DEFSYM (Qnative_comp_speed, "native-comp-speed");
DEFSYM (Qnative_comp_debug, "native-comp-debug");
@@ -8605,74 +8599,83 @@ compiled one. */);
/* FIXME should be initialized but not here... Plus this don't have
to be necessarily exposed to lisp but can easy debug for now. */
DEFVAR_LISP ("comp-subr-list", Vcomp_subr_list,
- doc: /* List of all defined subrs. */);
+ doc: /* List of all defined subrs. */);
DEFVAR_LISP ("comp-abi-hash", Vcomp_abi_hash,
- doc: /* String signing the .eln files ABI. */);
+ doc: /* String signing the .eln files ABI. */);
Vcomp_abi_hash = Qnil;
DEFVAR_LISP ("comp-native-version-dir", Vcomp_native_version_dir,
- doc: /* Directory in use to disambiguate eln compatibility. */);
+ doc: /* Directory in use to disambiguate eln compatibility. */);
Vcomp_native_version_dir = Qnil;
DEFVAR_LISP ("comp-deferred-pending-h", Vcomp_deferred_pending_h,
- doc: /* Hash table symbol-name -> function-value.
+ doc: /* Hash table symbol-name -> function-value.
For internal use. */);
Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq);
DEFVAR_LISP ("comp-eln-to-el-h", Vcomp_eln_to_el_h,
- doc: /* Hash table eln-filename -> el-filename. */);
+ doc: /* Hash table eln-filename -> el-filename. */);
Vcomp_eln_to_el_h = CALLN (Fmake_hash_table, QCtest, Qequal);
DEFVAR_LISP ("native-comp-eln-load-path", Vnative_comp_eln_load_path,
- doc: /* List of eln cache directories.
+ doc: /* List of directories to look for natively-compiled *.eln files.
-If a directory is non absolute it is assumed to be relative to
-`invocation-directory'.
-`comp-native-version-dir' value is used as a sub-folder name inside
-each eln cache directory.
-The last directory of this list is assumed to be the system one. */);
+The *.eln files are actually looked for in a version-specific
+subdirectory of each directory in this list. That subdirectory
+is determined by the value of `comp-native-version-dir'.
+If the name of a directory in this list is not absolute, it is
+assumed to be relative to `invocation-directory'.
+The last directory of this list is assumed to be the one holding
+the system *.eln files, which are the files produced when building
+Emacs. */);
/* Temporary value in use for bootstrap. We can't do better as
`invocation-directory' is still unset, will be fixed up during
dump reload. */
Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil);
- DEFVAR_BOOL ("comp-enable-subr-trampolines", comp_enable_subr_trampolines,
- doc: /* If non-nil, enable primitive trampoline synthesis.
-This makes Emacs respect redefinition or advises of primitive functions
-when they are called from Lisp code natively-compiled at `native-comp-speed'
-of 2.
+ DEFVAR_LISP ("native-comp-enable-subr-trampolines",
+ Vnative_comp_enable_subr_trampolines,
+ doc: /* If non-nil, enable generation of trampolines for calling
primitives.
+Trampolines are needed so that Emacs respects redefinition or advice of
+primitive functions when they are called from Lisp code natively-compiled
+at `native-comp-speed' of 2.
-By default, this is enabled, and when Emacs sees a redefined or advised
+By default, the value is t, and when Emacs sees a redefined or advised
primitive called from natively-compiled Lisp, it generates a trampoline
for it on-the-fly.
-Disabling this, when a trampoline for a redefined or advised primitive is
-not available from previous compilations, means that such redefinition
-or advise will not have effect on calls from natively-compiled Lisp code.
-That is, calls to primitives without existing trampolines from
-natively-compiled Lisp will behave as if the primitive was called
-directly from C. */);
+If the value is a file name (a string), it specifies the directory in
+which to deposit the generated trampolines, overriding the directories
+in `native-comp-eln-load-path'.
+
+When this variable is nil, generation of trampolines is disabled.
+
+Disabling the generation of trampolines, when a trampoline for a redefined
+or advised primitive is not already available from previous compilations,
+means that such redefinition or advice will not have effect when calling
+primitives from natively-compiled Lisp code. That is, calls to primitives
+without existing trampolines from natively-compiled Lisp will behave as if
+the primitive was called directly from C, and will ignore its redefinition
+and advice. */);
DEFVAR_LISP ("comp-installed-trampolines-h", Vcomp_installed_trampolines_h,
- doc: /* Hash table subr-name -> installed trampoline.
-This is used to prevent double trampoline instantiation but also to
+ doc: /* Hash table subr-name -> installed trampoline.
+This is used to prevent double trampoline instantiation, and also to
protect the trampolines against GC. */);
Vcomp_installed_trampolines_h = CALLN (Fmake_hash_table);
DEFVAR_LISP ("comp-no-native-file-h", V_comp_no_native_file_h,
- doc: /* Files for which no deferred compilation has to be
performed.
+ doc: /* Files for which no deferred compilation should be performed.
These files' compilation should not be deferred because the bytecode
version was explicitly requested by the user during load.
For internal use. */);
V_comp_no_native_file_h = CALLN (Fmake_hash_table, QCtest, Qequal);
DEFVAR_BOOL ("comp-file-preloaded-p", comp_file_preloaded_p,
- doc: /* When non-nil assume the file being compiled to
-be preloaded. */);
+ doc: /* When non-nil, assume the file being compiled to be preloaded. */);
DEFVAR_LISP ("comp-loaded-comp-units-h", Vcomp_loaded_comp_units_h,
- doc: /* Hash table recording all loaded compilation units.
-file -> CU. */);
+ doc: /* Hash table recording all loaded compilation units, file -> CU.
*/);
Vcomp_loaded_comp_units_h =
CALLN (Fmake_hash_table, QCweakness, Qvalue, QCtest, Qequal);
diff --git a/src/data.c b/src/data.c
index 04ac2b09ac3..d2f4d40d7bc 100644
--- a/src/data.c
+++ b/src/data.c
@@ -840,7 +840,9 @@ the position will be taken. */)
}
DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
- doc: /* Set SYMBOL's function definition to DEFINITION, and return
DEFINITION. */)
+ doc: /* Set SYMBOL's function definition to DEFINITION, and return
DEFINITION.
+If the resulting chain of function definitions would contain a loop,
+signal a `cyclic-function-indirection' error. */)
(register Lisp_Object symbol, Lisp_Object definition)
{
CHECK_SYMBOL (symbol);
@@ -852,10 +854,16 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
eassert (valid_lisp_object_p (definition));
+ /* Ensure non-circularity. */
+ for (Lisp_Object s = definition; SYMBOLP (s) && !NILP (s);
+ s = XSYMBOL (s)->u.s.function)
+ if (EQ (s, symbol))
+ xsignal1 (Qcyclic_function_indirection, symbol);
+
#ifdef HAVE_NATIVE_COMP
register Lisp_Object function = XSYMBOL (symbol)->u.s.function;
- if (comp_enable_subr_trampolines
+ if (!NILP (Vnative_comp_enable_subr_trampolines)
&& SUBRP (function)
&& !SUBR_NATIVE_COMPILEDP (function))
CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol);
@@ -1078,7 +1086,7 @@ If CMD is not a command, the return value is nil.
Value, if non-nil, is a list (interactive SPEC). */)
(Lisp_Object cmd)
{
- Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
+ Lisp_Object fun = indirect_function (cmd);
bool genfun = false;
if (NILP (fun))
@@ -1168,7 +1176,7 @@ If COMMAND is not a command, the return value is nil.
The value, if non-nil, is a list of mode name symbols. */)
(Lisp_Object command)
{
- Lisp_Object fun = indirect_function (command); /* Check cycles. */
+ Lisp_Object fun = indirect_function (command);
if (NILP (fun))
return Qnil;
@@ -2482,55 +2490,22 @@ If the current binding is global (the default), the
value is nil. */)
/* If OBJECT is a symbol, find the end of its function chain and
return the value found there. If OBJECT is not a symbol, just
- return it. If there is a cycle in the function chain, signal a
- cyclic-function-indirection error.
-
- This is like Findirect_function, except that it doesn't signal an
- error if the chain ends up unbound. */
+ return it. */
Lisp_Object
-indirect_function (register Lisp_Object object)
+indirect_function (Lisp_Object object)
{
- Lisp_Object tortoise, hare;
-
- hare = tortoise = object;
-
- for (;;)
- {
- if (!SYMBOLP (hare) || NILP (hare))
- break;
- hare = XSYMBOL (hare)->u.s.function;
- if (!SYMBOLP (hare) || NILP (hare))
- break;
- hare = XSYMBOL (hare)->u.s.function;
-
- tortoise = XSYMBOL (tortoise)->u.s.function;
-
- if (EQ (hare, tortoise))
- xsignal1 (Qcyclic_function_indirection, object);
- }
-
- return hare;
+ while (SYMBOLP (object) && !NILP (object))
+ object = XSYMBOL (object)->u.s.function;
+ return object;
}
DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
doc: /* Return the function at the end of OBJECT's function chain.
If OBJECT is not a symbol, just return it. Otherwise, follow all
-function indirections to find the final function binding and return it.
-Signal a cyclic-function-indirection error if there is a loop in the
-function chain of symbols. */)
- (register Lisp_Object object, Lisp_Object noerror)
+function indirections to find the final function binding and return it. */)
+ (Lisp_Object object, Lisp_Object noerror)
{
- Lisp_Object result;
-
- /* Optimize for no indirection. */
- result = object;
- if (SYMBOLP (result) && !NILP (result)
- && (result = XSYMBOL (result)->u.s.function, SYMBOLP (result)))
- result = indirect_function (result);
- if (!NILP (result))
- return result;
-
- return Qnil;
+ return indirect_function (object);
}
/* Extract and set vector and string elements. */
diff --git a/src/editfns.c b/src/editfns.c
index 78d2c73ecbf..f83c5c7259b 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2659,7 +2659,11 @@ DEFUN ("delete-and-extract-region",
Fdelete_and_extract_region,
the (uninterned) Qoutermost_narrowing tag and records the narrowing
bounds that were set by the user and that are visible on display.
This alist is used internally by narrow-to-region, widen,
- narrowing-lock, narrowing-unlock and save-restriction. */
+ internal--lock-narrowing, internal--unlock-narrowing and
+ save-restriction. For efficiency reasons, an alist is used instead
+ of a buffer-local variable: otherwise reset_outermost_narrowings,
+ which is called during each redisplay cycle, would have to loop
+ through all live buffers. */
static Lisp_Object narrowing_locks;
/* Add BUF with its LOCKS in the narrowing_locks alist. */
@@ -2763,7 +2767,10 @@ unwind_reset_outermost_narrowing (Lisp_Object buf)
In particular, this function is called when redisplay starts, so
that if a Lisp function executed during redisplay calls (redisplay)
while a locked narrowing is in effect, the locked narrowing will
- not be visible on display. */
+ not be visible on display.
+ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#140 and
+ https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#254 for example
+ recipes that demonstrate why this is necessary. */
void
reset_outermost_narrowings (void)
{
@@ -2792,27 +2799,25 @@ narrowing_locks_save (void)
{
Lisp_Object buf = Fcurrent_buffer ();
Lisp_Object locks = assq_no_quit (buf, narrowing_locks);
- if (NILP (locks))
- return Qnil;
- locks = XCAR (XCDR (locks));
+ if (!NILP (locks))
+ locks = XCAR (XCDR (locks));
return Fcons (buf, Fcopy_sequence (locks));
}
static void
narrowing_locks_restore (Lisp_Object buf_and_saved_locks)
{
- if (NILP (buf_and_saved_locks))
- return;
Lisp_Object buf = XCAR (buf_and_saved_locks);
Lisp_Object saved_locks = XCDR (buf_and_saved_locks);
narrowing_locks_remove (buf);
- narrowing_locks_add (buf, saved_locks);
+ if (!NILP (saved_locks))
+ narrowing_locks_add (buf, saved_locks);
}
static void
unwind_narrow_to_region_locked (Lisp_Object tag)
{
- Fnarrowing_unlock (tag);
+ Finternal__unlock_narrowing (tag);
Fwiden ();
}
@@ -2821,7 +2826,7 @@ void
narrow_to_region_locked (Lisp_Object begv, Lisp_Object zv, Lisp_Object tag)
{
Fnarrow_to_region (begv, zv);
- Fnarrowing_lock (tag);
+ Finternal__lock_narrowing (tag);
record_unwind_protect (restore_point_unwind, Fpoint_marker ());
record_unwind_protect (unwind_narrow_to_region_locked, tag);
}
@@ -2829,10 +2834,12 @@ narrow_to_region_locked (Lisp_Object begv, Lisp_Object
zv, Lisp_Object tag)
DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
doc: /* Remove restrictions (narrowing) from current buffer.
-This allows the buffer's full text to be seen and edited, unless
-restrictions have been locked with `narrowing-lock', which see, in
-which case the narrowing that was current when `narrowing-lock' was
-called is restored. */)
+This allows the buffer's full text to be seen and edited.
+
+However, when restrictions have been set by `with-restriction' with a
+label, `widen' restores the narrowing limits set by `with-restriction'.
+To gain access to other portions of the buffer, use
+`without-restriction' with the same label. */)
(void)
{
Fset (Qoutermost_narrowing, Qnil);
@@ -2879,11 +2886,12 @@ When calling from Lisp, pass two arguments START and
END:
positions (integers or markers) bounding the text that should
remain visible.
-When restrictions have been locked with `narrowing-lock', which see,
-`narrow-to-region' can be used only within the limits of the
-restrictions that were current when `narrowing-lock' was called. If
-the START or END arguments are outside these limits, the corresponding
-limit of the locked restriction is used instead of the argument. */)
+However, when restrictions have been set by `with-restriction' with a
+label, `narrow-to-region' can be used only within the limits of these
+restrictions. If the START or END arguments are outside these limits,
+the corresponding limit set by `with-restriction' is used instead of the
+argument. To gain access to other portions of the buffer, use
+`without-restriction' with the same label. */)
(Lisp_Object start, Lisp_Object end)
{
EMACS_INT s = fix_position (start), e = fix_position (end);
@@ -2912,7 +2920,7 @@ limit of the locked restriction is used instead of the
argument. */)
/* Record the accessible range of the buffer when narrow-to-region
is called, that is, before applying the narrowing. It is used
- only by narrowing-lock. */
+ only by internal--lock-narrowing. */
Fset (Qoutermost_narrowing, list3 (Qoutermost_narrowing,
Fpoint_min_marker (),
Fpoint_max_marker ()));
@@ -2932,31 +2940,18 @@ limit of the locked restriction is used instead of the
argument. */)
return Qnil;
}
-DEFUN ("narrowing-lock", Fnarrowing_lock, Snarrowing_lock, 1, 1, 0,
- doc: /* Lock the current narrowing with TAG.
+DEFUN ("internal--lock-narrowing", Finternal__lock_narrowing,
+ Sinternal__lock_narrowing, 1, 1, 0,
+ doc: /* Lock the current narrowing with LABEL.
-When restrictions are locked, `narrow-to-region' and `widen' can be
-used only within the limits of the restrictions that were current when
-`narrowing-lock' was called, unless the lock is removed by calling
-`narrowing-unlock' with TAG.
-
-Locking restrictions should be used sparingly, after carefully
-considering the potential adverse effects on the code that will be
-executed within locked restrictions. It is typically meant to be used
-around portions of code that would become too slow, and make Emacs
-unresponsive, if they were executed in a large buffer. For example,
-restrictions are locked by Emacs around low-level hooks such as
-`fontification-functions' or `post-command-hook'.
-
-Locked restrictions are never visible on display, and can therefore
-not be used as a stronger variant of normal restrictions. */)
+This is an internal function used by `with-restriction'. */)
(Lisp_Object tag)
{
Lisp_Object buf = Fcurrent_buffer ();
Lisp_Object outermost_narrowing
= buffer_local_value (Qoutermost_narrowing, buf);
- /* If narrowing-lock is called without being preceded by
- narrow-to-region, do nothing. */
+ /* If internal--lock-narrowing is ever called without being preceded
+ by narrow-to-region, do nothing. */
if (NILP (outermost_narrowing))
return Qnil;
if (NILP (narrowing_lock_peek_tag (buf)))
@@ -2967,16 +2962,11 @@ not be used as a stronger variant of normal
restrictions. */)
return Qnil;
}
-DEFUN ("narrowing-unlock", Fnarrowing_unlock, Snarrowing_unlock, 1, 1, 0,
- doc: /* Unlock a narrowing locked with (narrowing-lock TAG).
+DEFUN ("internal--unlock-narrowing", Finternal__unlock_narrowing,
+ Sinternal__unlock_narrowing, 1, 1, 0,
+ doc: /* Unlock a narrowing locked with LABEL.
-Unlocking restrictions locked with `narrowing-lock' should be used
-sparingly, after carefully considering the reasons why restrictions
-were locked. Restrictions are typically locked around portions of
-code that would become too slow, and make Emacs unresponsive, if they
-were executed in a large buffer. For example, restrictions are locked
-by Emacs around low-level hooks such as `fontification-functions' or
-`post-command-hook'. */)
+This is an internal function used by `without-restriction'. */)
(Lisp_Object tag)
{
Lisp_Object buf = Fcurrent_buffer ();
@@ -2985,8 +2975,8 @@ by Emacs around low-level hooks such as
`fontification-functions' or
return Qnil;
}
-Lisp_Object
-save_restriction_save (void)
+static Lisp_Object
+save_restriction_save_1 (void)
{
if (BEGV == BEG && ZV == Z)
/* The common case that the buffer isn't narrowed.
@@ -3009,8 +2999,8 @@ save_restriction_save (void)
}
}
-void
-save_restriction_restore (Lisp_Object data)
+static void
+save_restriction_restore_1 (Lisp_Object data)
{
struct buffer *cur = NULL;
struct buffer *buf = (CONSP (data)
@@ -3078,13 +3068,28 @@ save_restriction_restore (Lisp_Object data)
set_buffer_internal (cur);
}
+Lisp_Object
+save_restriction_save (void)
+{
+ Lisp_Object restr = save_restriction_save_1 ();
+ Lisp_Object locks = narrowing_locks_save ();
+ return Fcons (restr, locks);
+}
+
+void
+save_restriction_restore (Lisp_Object data)
+{
+ narrowing_locks_restore (XCDR (data));
+ save_restriction_restore_1 (XCAR (data));
+}
+
DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED,
0,
doc: /* Execute BODY, saving and restoring current buffer's
restrictions.
The buffer's restrictions make parts of the beginning and end invisible.
\(They are set up with `narrow-to-region' and eliminated with `widen'.)
This special form, `save-restriction', saves the current buffer's
-restrictions, as well as their locks if they have been locked with
-`narrowing-lock', when it is entered, and restores them when it is exited.
+restrictions, including those that were set by `with-restriction' with a
+label argument, when it is entered, and restores them when it is exited.
So any `narrow-to-region' within BODY lasts only until the end of the form.
The old restrictions settings are restored even in case of abnormal exit
\(throw or error).
@@ -3102,7 +3107,6 @@ usage: (save-restriction &rest BODY) */)
specpdl_ref count = SPECPDL_INDEX ();
record_unwind_protect (save_restriction_restore, save_restriction_save ());
- record_unwind_protect (narrowing_locks_restore, narrowing_locks_save ());
val = Fprogn (body);
return unbind_to (count, val);
}
@@ -4903,8 +4907,8 @@ it to be non-nil. */);
defsubr (&Sdelete_and_extract_region);
defsubr (&Swiden);
defsubr (&Snarrow_to_region);
- defsubr (&Snarrowing_lock);
- defsubr (&Snarrowing_unlock);
+ defsubr (&Sinternal__lock_narrowing);
+ defsubr (&Sinternal__unlock_narrowing);
defsubr (&Ssave_restriction);
defsubr (&Stranspose_regions);
}
diff --git a/src/emacs.c b/src/emacs.c
index 214e2e2a296..282e2f48100 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2447,7 +2447,8 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
#ifdef HAVE_DBUS
init_dbusbind ();
#endif
-#if defined(USE_GTK) && !defined(HAVE_PGTK)
+
+#ifdef HAVE_X_WINDOWS
init_xterm ();
#endif
diff --git a/src/eval.c b/src/eval.c
index d42f7ffe894..eb40c953f96 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2116,7 +2116,7 @@ then strings and vectors are not accepted. */)
fun = function;
- fun = indirect_function (fun); /* Check cycles. */
+ fun = indirect_function (fun);
if (NILP (fun))
return Qnil;
@@ -2348,6 +2348,8 @@ it defines a macro. */)
}
+static Lisp_Object list_of_t; /* Never-modified constant containing (t). */
+
DEFUN ("eval", Feval, Seval, 1, 2, 0,
doc: /* Evaluate FORM and return its value.
If LEXICAL is t, evaluate using lexical scoping.
@@ -2357,7 +2359,7 @@ alist mapping symbols to their value. */)
{
specpdl_ref count = SPECPDL_INDEX ();
specbind (Qinternal_interpreter_environment,
- CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt));
+ CONSP (lexical) || NILP (lexical) ? lexical : list_of_t);
return unbind_to (count, eval_sub (form));
}
@@ -4392,6 +4394,9 @@ alist of active lexical bindings. */);
Qcatch_all_memory_full
= Fmake_symbol (build_pure_c_string ("catch-all-memory-full"));
+ staticpro (&list_of_t);
+ list_of_t = list1 (Qt);
+
defsubr (&Sor);
defsubr (&Sand);
defsubr (&Sif);
diff --git a/src/fileio.c b/src/fileio.c
index c672e0f7baf..b80f8d61de4 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -3907,8 +3907,6 @@ by calling `format-decode', which see. */)
struct timespec mtime;
int fd;
ptrdiff_t inserted = 0;
- ptrdiff_t how_much;
- off_t beg_offset, end_offset;
int unprocessed;
specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object handler, val, insval, orig_filename, old_undo;
@@ -3921,7 +3919,8 @@ by calling `format-decode', which see. */)
bool replace_handled = false;
bool set_coding_system = false;
Lisp_Object coding_system;
- bool read_quit = false;
+ /* Negative if read error, 0 if OK so far, positive if quit. */
+ ptrdiff_t read_quit = 0;
/* If the undo log only contains the insertion, there's no point
keeping it. It's typically when we first fill a file-buffer. */
bool empty_undo_list_p
@@ -3970,6 +3969,17 @@ by calling `format-decode', which see. */)
goto handled;
}
+ if (!NILP (visit))
+ {
+ if (!NILP (beg) || !NILP (end))
+ error ("Attempt to visit less than an entire file");
+ if (BEG < Z && NILP (replace))
+ error ("Cannot do file visiting in a non-empty buffer");
+ }
+
+ off_t beg_offset = !NILP (beg) ? file_offset (beg) : 0;
+ off_t end_offset = !NILP (end) ? file_offset (end) : -1;
+
orig_filename = filename;
filename = ENCODE_FILE (filename);
@@ -4012,7 +4022,6 @@ by calling `format-decode', which see. */)
if (!S_ISREG (st.st_mode))
{
regular = false;
- seekable = lseek (fd, 0, SEEK_CUR) < 0;
if (! NILP (visit))
{
@@ -4020,32 +4029,18 @@ by calling `format-decode', which see. */)
goto notfound;
}
- if (!NILP (beg) && !seekable)
- xsignal2 (Qfile_error,
- build_string ("cannot use a start position in a non-seekable
file/device"),
- orig_filename);
-
if (!NILP (replace))
xsignal2 (Qfile_error,
build_string ("not a regular file"), orig_filename);
- }
- if (!NILP (visit))
- {
- if (!NILP (beg) || !NILP (end))
- error ("Attempt to visit less than an entire file");
- if (BEG < Z && NILP (replace))
- error ("Cannot do file visiting in a non-empty buffer");
+ seekable = lseek (fd, 0, SEEK_CUR) < 0;
+ if (!NILP (beg) && !seekable)
+ xsignal2 (Qfile_error,
+ build_string ("cannot use a start position in a non-seekable
file/device"),
+ orig_filename);
}
- if (!NILP (beg))
- beg_offset = file_offset (beg);
- else
- beg_offset = 0;
-
- if (!NILP (end))
- end_offset = file_offset (end);
- else
+ if (end_offset < 0)
{
if (!regular)
end_offset = TYPE_MAXIMUM (off_t);
@@ -4106,7 +4101,7 @@ by calling `format-decode', which see. */)
else
{
/* Don't try looking inside a file for a coding system
- specification if it is not seekable. */
+ specification if it is not a regular file. */
if (regular && !NILP (Vset_auto_coding_function))
{
/* Find a coding system specified in the heading two
@@ -4124,7 +4119,7 @@ by calling `format-decode', which see. */)
if (nread == 1024)
{
int ntail;
- if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
+ if (lseek (fd, st.st_size - 1024 * 3, SEEK_CUR) < 0)
report_file_error ("Setting file position",
orig_filename);
ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3);
@@ -4409,7 +4404,7 @@ by calling `format-decode', which see. */)
ptrdiff_t bufpos;
unsigned char *decoded;
ptrdiff_t temp;
- ptrdiff_t this = 0;
+ ptrdiff_t this;
specpdl_ref this_count = SPECPDL_INDEX ();
bool multibyte
= ! NILP (BVAR (current_buffer, enable_multibyte_characters));
@@ -4585,8 +4580,12 @@ by calling `format-decode', which see. */)
}
move_gap_both (PT, PT_BYTE);
- if (GAP_SIZE < total)
- make_gap (total - GAP_SIZE);
+
+ /* Ensure the gap is at least one byte larger than needed for the
+ estimated file size, so that in the usual case we read to EOF
+ without reallocating. */
+ if (GAP_SIZE <= total)
+ make_gap (total - GAP_SIZE + 1);
if (beg_offset != 0 || !NILP (replace))
{
@@ -4594,12 +4593,6 @@ by calling `format-decode', which see. */)
report_file_error ("Setting file position", orig_filename);
}
- /* In the following loop, HOW_MUCH contains the total bytes read so
- far for a regular file, and not changed for a special file. But,
- before exiting the loop, it is set to a negative value if I/O
- error occurs. */
- how_much = 0;
-
/* Total bytes inserted. */
inserted = 0;
@@ -4608,23 +4601,26 @@ by calling `format-decode', which see. */)
{
ptrdiff_t gap_size = GAP_SIZE;
- while (how_much < total)
+ while (NILP (end) || inserted < total)
{
- /* `try' is reserved in some compilers (Microsoft C). */
- ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
ptrdiff_t this;
+ if (gap_size == 0)
+ {
+ /* The size estimate was wrong. Make the gap 50% larger. */
+ make_gap (GAP_SIZE >> 1);
+ gap_size = GAP_SIZE - inserted;
+ }
+
+ /* 'try' is reserved in some compilers (Microsoft C). */
+ ptrdiff_t trytry = min (gap_size, READ_BUF_SIZE);
+ if (!NILP (end))
+ trytry = min (trytry, total - inserted);
+
if (!seekable && NILP (end))
{
Lisp_Object nbytes;
- /* Maybe make more room. */
- if (gap_size < trytry)
- {
- make_gap (trytry - gap_size);
- gap_size = GAP_SIZE - inserted;
- }
-
/* Read from the file, capturing `quit'. When an
error occurs, end the loop, and arrange for a quit
to be signaled after decoding the text we read. */
@@ -4635,7 +4631,7 @@ by calling `format-decode', which see. */)
if (NILP (nbytes))
{
- read_quit = true;
+ read_quit = 1;
break;
}
@@ -4654,19 +4650,11 @@ by calling `format-decode', which see. */)
if (this <= 0)
{
- how_much = this;
+ read_quit = this;
break;
}
gap_size -= this;
-
- /* For a regular file, where TOTAL is the real size,
- count HOW_MUCH to compare with it.
- For a special file, where TOTAL is just a buffer size,
- so don't bother counting in HOW_MUCH.
- (INSERTED is where we count the number of characters inserted.) */
- if (seekable || !NILP (end))
- how_much += this;
inserted += this;
}
}
@@ -4687,7 +4675,7 @@ by calling `format-decode', which see. */)
emacs_close (fd);
clear_unwind_protect (fd_index);
- if (how_much < 0)
+ if (read_quit < 0)
report_file_error ("Read error", orig_filename);
notfound:
diff --git a/src/fns.c b/src/fns.c
index 59d5b5c0850..0af9b725c7a 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5809,8 +5809,9 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object,
Lisp_Object start,
DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
doc: /* Return MD5 message digest of OBJECT, a buffer or string.
-A message digest is a cryptographic checksum of a document, and the
-algorithm to calculate it is defined in RFC 1321.
+A message digest is the string representation of the cryptographic checksum
+of a document, and the algorithm to calculate it is defined in RFC 1321.
+The MD5 digest is 32-character long.
The two optional arguments START and END are character positions
specifying for which part of OBJECT the message digest should be
@@ -5844,12 +5845,12 @@ anything security-related. See `secure-hash' for
alternatives. */)
DEFUN ("secure-hash", Fsecure_hash, Ssecure_hash, 2, 5, 0,
doc: /* Return the secure hash of OBJECT, a buffer or string.
ALGORITHM is a symbol specifying the hash to use:
-- md5 corresponds to MD5
-- sha1 corresponds to SHA-1
-- sha224 corresponds to SHA-2 (SHA-224)
-- sha256 corresponds to SHA-2 (SHA-256)
-- sha384 corresponds to SHA-2 (SHA-384)
-- sha512 corresponds to SHA-2 (SHA-512)
+- md5 corresponds to MD5, produces a 32-character signature
+- sha1 corresponds to SHA-1, produces a 40-character signature
+- sha224 corresponds to SHA-2 (SHA-224), produces a 56-character signature
+- sha256 corresponds to SHA-2 (SHA-256), produces a 64-character signature
+- sha384 corresponds to SHA-2 (SHA-384), produces a 96-character signature
+- sha512 corresponds to SHA-2 (SHA-512), produces a 128-character signature
The two optional arguments START and END are positions specifying for
which part of OBJECT to compute the hash. If nil or omitted, uses the
diff --git a/src/frame.c b/src/frame.c
index 983424b0bee..2cea96d4a32 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1526,7 +1526,7 @@ do_switch_frame (Lisp_Object frame, int for_deletion,
Lisp_Object norecord)
if (f->select_mini_window_flag
&& !NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt)))
- f->selected_window = f->minibuffer_window;
+ fset_selected_window (f, f->minibuffer_window);
f->select_mini_window_flag = false;
if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
diff --git a/src/haikufont.c b/src/haikufont.c
index a025dec58bb..b4c2e547247 100644
--- a/src/haikufont.c
+++ b/src/haikufont.c
@@ -760,7 +760,7 @@ haikufont_open (struct frame *f, Lisp_Object font_entity,
int pixel_size)
struct haiku_font_pattern ptn;
struct font *font;
void *be_font;
- Lisp_Object font_object, tem, extra, indices, antialias;
+ Lisp_Object font_object, extra, indices, antialias;
int px_size, min_width, max_width;
int avg_width, height, space_width, ascent;
int descent, underline_pos, underline_thickness;
diff --git a/src/indent.c b/src/indent.c
index 4cd3206a9c1..6a84472fd2f 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -2401,7 +2401,7 @@ whether or not it is currently displayed in some window.
*/)
last line that it occupies. */
if (it_start < ZV)
{
- if ((it.bidi_it.scan_dir > 0)
+ if ((it.bidi_it.scan_dir >= 0 || it.vpos == vpos_init)
? IT_CHARPOS (it) < it_start
: IT_CHARPOS (it) > it_start)
{
diff --git a/src/insdel.c b/src/insdel.c
index e459d0cfa17..b65a3fbd805 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1715,6 +1715,44 @@ del_range (ptrdiff_t from, ptrdiff_t to)
del_range_1 (from, to, 1, 0);
}
+struct safe_del_range_context
+{
+ /* From and to positions. */
+ ptrdiff_t from, to;
+};
+
+static Lisp_Object
+safe_del_range_1 (void *ptr)
+{
+ struct safe_del_range_context *context;
+
+ context = ptr;
+ del_range (context->from, context->to);
+ return Qnil;
+}
+
+static Lisp_Object
+safe_del_range_2 (enum nonlocal_exit type, Lisp_Object value)
+{
+ return Qt;
+}
+
+/* Like del_range; however, catch all non-local exits. Value is 0 if
+ the buffer contents were really deleted. Otherwise, it is 1. */
+
+int
+safe_del_range (ptrdiff_t from, ptrdiff_t to)
+{
+ struct safe_del_range_context context;
+
+ context.from = from;
+ context.to = to;
+
+ return !NILP (internal_catch_all (safe_del_range_1,
+ &context,
+ safe_del_range_2));
+}
+
/* Like del_range; PREPARE says whether to call prepare_to_modify_buffer.
RET_STRING says to return the deleted text. */
diff --git a/src/intervals.c b/src/intervals.c
index 75e37a8c90c..ee976fb1035 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -2333,6 +2333,9 @@ set_intervals_multibyte_1 (INTERVAL i, bool multi_flag,
if (TOTAL_LENGTH (i) == 0)
{
+ /* Delete the whole subtree. */
+ i->left = NULL;
+ i->right = NULL;
delete_interval (i);
return;
}
diff --git a/src/keyboard.c b/src/keyboard.c
index 6f0f075e54e..b2816f8270b 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1910,12 +1910,13 @@ safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct
window *w)
specbind (Qinhibit_quit, Qt);
if (current_buffer->long_line_optimizations_p
- && long_line_locked_narrowing_region_size > 0)
+ && long_line_optimizations_region_size > 0)
{
ptrdiff_t begv = get_locked_narrowing_begv (PT);
ptrdiff_t zv = get_locked_narrowing_zv (PT);
if (begv != BEG || zv != Z)
- narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), hook);
+ narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv),
+ Qlong_line_optimizations_in_command_hooks);
}
run_hook_with_args (2, ((Lisp_Object []) {hook, hook}),
@@ -12168,6 +12169,8 @@ syms_of_keyboard (void)
/* Hooks to run before and after each command. */
DEFSYM (Qpre_command_hook, "pre-command-hook");
DEFSYM (Qpost_command_hook, "post-command-hook");
+ DEFSYM (Qlong_line_optimizations_in_command_hooks,
+ "long-line-optimizations-in-command-hooks");
/* Hook run after the region is selected. */
DEFSYM (Qpost_select_region_hook, "post-select-region-hook");
@@ -12728,13 +12731,11 @@ If an unhandled error happens in running this hook,
the function in
which the error occurred is unconditionally removed, since otherwise
the error might happen repeatedly and make Emacs nonfunctional.
-Note that, when the current buffer contains one or more lines whose
-length is above `long-line-threshold', these hook functions are called
-with the buffer narrowed to a small portion around point (whose size
-is specified by `long-line-locked-narrowing-region-size'), and the
-narrowing is locked (see `narrowing-lock'), so that these hook
-functions cannot use `widen' to gain access to other portions of
-buffer text.
+Note that, when `long-line-optimizations-p' is non-nil in the buffer,
+these functions are called as if they were in a `with-restriction' form,
+with a `long-line-optimizations-in-command-hooks' label and with the
+buffer narrowed to a portion around point whose size is specified by
+`long-line-optimizations-region-size'.
See also `post-command-hook'. */);
Vpre_command_hook = Qnil;
@@ -12750,13 +12751,11 @@ It is a bad idea to use this hook for expensive
processing. If
unavoidable, wrap your code in `(while-no-input (redisplay) CODE)' to
avoid making Emacs unresponsive while the user types.
-Note that, when the current buffer contains one or more lines whose
-length is above `long-line-threshold', these hook functions are called
-with the buffer narrowed to a small portion around point (whose size
-is specified by `long-line-locked-narrowing-region-size'), and the
-narrowing is locked (see `narrowing-lock'), so that these hook
-functions cannot use `widen' to gain access to other portions of
-buffer text.
+Note that, when `long-line-optimizations-p' is non-nil in the buffer,
+these functions are called as if they were in a `with-restriction' form,
+with a `long-line-optimizations-in-command-hooks' label and with the
+buffer narrowed to a portion around point whose size is specified by
+`long-line-optimizations-region-size'.
See also `pre-command-hook'. */);
Vpost_command_hook = Qnil;
diff --git a/src/lisp.h b/src/lisp.h
index 23d3f8fe496..bea2d29f3e9 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4169,6 +4169,7 @@ extern void del_range_byte (ptrdiff_t, ptrdiff_t);
extern void del_range_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t, bool);
+extern int safe_del_range (ptrdiff_t, ptrdiff_t);
extern void modify_text (ptrdiff_t, ptrdiff_t);
extern void prepare_to_modify_buffer (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
extern void prepare_to_modify_buffer_1 (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
@@ -5286,6 +5287,11 @@ extern void syms_of_profiler (void);
extern char *emacs_root_dir (void);
#endif /* DOS_NT */
+#ifdef HAVE_TEXT_CONVERSION
+/* Defined in textconv.c. */
+extern void report_selected_window_change (struct frame *);
+#endif
+
#ifdef HAVE_NATIVE_COMP
INLINE bool
SUBR_NATIVE_COMPILEDP (Lisp_Object a)
diff --git a/src/macros.c b/src/macros.c
index 0db0af89a71..d1541d2817f 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -128,9 +128,9 @@ end_kbd_macro (void)
update_mode_lines = 20;
kset_last_kbd_macro
(current_kboard,
- make_event_array ((current_kboard->kbd_macro_end
- - current_kboard->kbd_macro_buffer),
- current_kboard->kbd_macro_buffer));
+ Fvector ((current_kboard->kbd_macro_end
+ - current_kboard->kbd_macro_buffer),
+ current_kboard->kbd_macro_buffer));
}
DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 2, "p",
diff --git a/src/nsxwidget.h b/src/nsxwidget.h
index 8d55fac5326..2b5596f905e 100644
--- a/src/nsxwidget.h
+++ b/src/nsxwidget.h
@@ -36,6 +36,8 @@ Lisp_Object nsxwidget_webkit_uri (struct xwidget *xw);
Lisp_Object nsxwidget_webkit_title (struct xwidget *xw);
void nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri);
void nsxwidget_webkit_goto_history (struct xwidget *xw, int rel_pos);
+double nsxwidget_webkit_estimated_load_progress(struct xwidget *xw);
+void nsxwidget_webkit_stop_loading (struct xwidget *xw);
void nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change);
void nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script,
Lisp_Object fun);
diff --git a/src/nsxwidget.m b/src/nsxwidget.m
index e1fbd749b62..0e00589bb7f 100644
--- a/src/nsxwidget.m
+++ b/src/nsxwidget.m
@@ -57,12 +57,13 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
@end
@implementation XwWebView : WKWebView
-- (id)initWithFrame:(CGRect)frame
+- (id) initWithFrame:(CGRect)frame
configuration:(WKWebViewConfiguration *)configuration
xwidget:(struct xwidget *)xw
{
/* Script controller to add script message handler and user script. */
- WKUserContentController *scriptor = [[WKUserContentController alloc] init];
+ WKUserContentController *scriptor = [[[WKUserContentController alloc] init]
+ autorelease];
configuration.userContentController = scriptor;
/* Enable inspect element context menu item for debugging. */
@@ -81,7 +82,8 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
if (self)
{
self.xw = xw;
- self.urlScriptBlocked = [[NSMutableDictionary alloc] init];
+ self.urlScriptBlocked = [[[NSMutableDictionary alloc] init]
+ autorelease];
self.navigationDelegate = self;
self.UIDelegate = self;
self.customUserAgent =
@@ -89,23 +91,48 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
@" AppleWebKit/603.3.8 (KHTML, like Gecko)"
@" Version/11.0.1 Safari/603.3.8";
[scriptor addScriptMessageHandler:self name:@"keyDown"];
- [scriptor addUserScript:[[WKUserScript alloc]
- initWithSource:xwScript
- injectionTime:
- WKUserScriptInjectionTimeAtDocumentStart
- forMainFrameOnly:NO]];
+ WKUserScript *userScript = [[[WKUserScript alloc]
+ initWithSource:xwScript
+ injectionTime:
+ WKUserScriptInjectionTimeAtDocumentStart
+ forMainFrameOnly:NO] autorelease];
+ [scriptor addUserScript:userScript];
}
return self;
}
-- (void)webView:(WKWebView *)webView
+/* These 4 functions emulate the behavior of webkit_view_load_changed_cb
+ in the GTK implementation*/
+- (void) webView:(WKWebView *)webView
didFinishNavigation:(WKNavigation *)navigation
{
if (EQ (Fbuffer_live_p (self.xw->buffer), Qt))
- store_xwidget_event_string (self.xw, "load-changed", "");
+ store_xwidget_event_string (self.xw, "load-changed", "load-finished");
}
-- (void)webView:(WKWebView *)webView
+- (void) webView:(WKWebView *)webView
+didStartProvisionalNavigation:(WKNavigation *)navigation
+{
+ if (EQ (Fbuffer_live_p (self.xw->buffer), Qt))
+ store_xwidget_event_string (self.xw, "load-changed", "load-started");
+}
+
+- (void) webView:(WKWebView *)webView
+didReceiveServerRedirectForProvisionalNavigation:(WKNavigation *)navigation
+{
+ if (EQ (Fbuffer_live_p (self.xw->buffer), Qt))
+ store_xwidget_event_string (self.xw, "load-changed", "load-redirected");
+}
+
+/* Start loading WKWebView */
+- (void) webView:(WKWebView *)webView
+didCommitNavigation:(WKNavigation *)navigation
+{
+ if (EQ (Fbuffer_live_p (self.xw->buffer), Qt))
+ store_xwidget_event_string (self.xw, "load-changed", "load-committed");
+}
+
+- (void) webView:(WKWebView *)webView
decidePolicyForNavigationAction:(WKNavigationAction *)navigationAction
decisionHandler:(void (^)(WKNavigationActionPolicy))decisionHandler
{
@@ -114,13 +141,13 @@ decisionHandler:(void
(^)(WKNavigationActionPolicy))decisionHandler
decisionHandler (WKNavigationActionPolicyAllow);
break;
default:
- // decisionHandler (WKNavigationActionPolicyCancel);
+ /* decisionHandler (WKNavigationActionPolicyCancel); */
decisionHandler (WKNavigationActionPolicyAllow);
break;
}
}
-- (void)webView:(WKWebView *)webView
+- (void) webView:(WKWebView *)webView
decidePolicyForNavigationResponse:(WKNavigationResponse *)navigationResponse
decisionHandler:(void (^)(WKNavigationResponsePolicy))decisionHandler
{
@@ -166,7 +193,7 @@ decisionHandler:(void
(^)(WKNavigationResponsePolicy))decisionHandler
/* No additional new webview or emacs window will be created
for <a ... target="_blank">. */
-- (WKWebView *)webView:(WKWebView *)webView
+- (WKWebView *) webView:(WKWebView *)webView
createWebViewWithConfiguration:(WKWebViewConfiguration *)configuration
forNavigationAction:(WKNavigationAction *)navigationAction
windowFeatures:(WKWindowFeatures *)windowFeatures
@@ -177,7 +204,7 @@ createWebViewWithConfiguration:(WKWebViewConfiguration
*)configuration
}
/* Open panel for file upload. */
-- (void)webView:(WKWebView *)webView
+- (void) webView:(WKWebView *)webView
runOpenPanelWithParameters:(WKOpenPanelParameters *)parameters
initiatedByFrame:(WKFrameInfo *)frame
completionHandler:(void (^)(NSArray<NSURL *> *URLs))completionHandler
@@ -197,13 +224,13 @@ completionHandler:(void (^)(NSArray<NSURL *>
*URLs))completionHandler
- Correct mouse hand/arrow/I-beam is displayed (TODO: not perfect yet).
*/
-- (void)mouseDown:(NSEvent *)event
+- (void) mouseDown:(NSEvent *)event
{
[self.xw->xv->emacswindow mouseDown:event];
[super mouseDown:event];
}
-- (void)mouseUp:(NSEvent *)event
+- (void) mouseUp:(NSEvent *)event
{
[self.xw->xv->emacswindow mouseUp:event];
[super mouseUp:event];
@@ -214,7 +241,7 @@ completionHandler:(void (^)(NSArray<NSURL *>
*URLs))completionHandler
emacs as first responder to avoid focus held in an input element
with matching text. */
-- (void)keyDown:(NSEvent *)event
+- (void) keyDown:(NSEvent *)event
{
Lisp_Object var = Fintern (build_string ("isearch-mode"), Qnil);
Lisp_Object val = buffer_local_value (var, Fcurrent_buffer ());
@@ -250,7 +277,7 @@ completionHandler:(void (^)(NSArray<NSURL *>
*URLs))completionHandler
}];
}
-- (void)interpretKeyEvents:(NSArray<NSEvent *> *)eventArray
+- (void) interpretKeyEvents:(NSArray<NSEvent *> *)eventArray
{
/* We should do nothing and do not forward (default implementation
if we not override here) to let emacs collect key events and ask
@@ -258,7 +285,7 @@ completionHandler:(void (^)(NSArray<NSURL *>
*URLs))completionHandler
}
static NSString *xwScript;
-+ (void)initialize
++ (void) initialize
{
/* Find out if an input element has focus.
Message to script message handler when 'C-g' key down. */
@@ -284,7 +311,7 @@ static NSString *xwScript;
/* Confirming to WKScriptMessageHandler, listens concerning keyDown in
webkit. Currently 'C-g'. */
-- (void)userContentController:(WKUserContentController *)userContentController
+- (void) userContentController:(WKUserContentController *)userContentController
didReceiveScriptMessage:(WKScriptMessage *)message
{
if ([message.body isEqualToString:@"C-g"])
@@ -343,6 +370,20 @@ nsxwidget_webkit_goto_history (struct xwidget *xw, int
rel_pos)
}
}
+double
+nsxwidget_webkit_estimated_load_progress (struct xwidget *xw)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ return xwWebView.estimatedProgress;
+}
+
+void
+nsxwidget_webkit_stop_loading (struct xwidget *xw)
+{
+ XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
+ [xwWebView stopLoading];
+}
+
void
nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change)
{
@@ -430,7 +471,7 @@ nsxwidget_webkit_execute_script (struct xwidget *xw, const
char *script,
}
else if (result && FUNCTIONP (fun))
{
- // NSLog (@"result=%@, type=%@", result, [result class]);
+ /* NSLog (@"result=%@, type=%@", result, [result class]); */
Lisp_Object lisp_value = js_to_lisp (result);
store_xwidget_js_callback_event (xw, fun, lisp_value);
}
@@ -440,19 +481,20 @@ nsxwidget_webkit_execute_script (struct xwidget *xw,
const char *script,
/* Window containing an xwidget. */
@implementation XwWindow
-- (BOOL)isFlipped { return YES; }
+- (BOOL) isFlipped { return YES; }
@end
/* Xwidget model, macOS Cocoa part. */
void
-nsxwidget_init(struct xwidget *xw)
+nsxwidget_init (struct xwidget *xw)
{
block_input ();
NSRect rect = NSMakeRect (0, 0, xw->width, xw->height);
xw->xwWidget = [[XwWebView alloc]
initWithFrame:rect
- configuration:[[WKWebViewConfiguration alloc] init]
+ configuration:[[[WKWebViewConfiguration alloc] init]
+ autorelease]
xwidget:xw];
xw->xwWindow = [[XwWindow alloc]
initWithFrame:rect];
@@ -470,16 +512,18 @@ nsxwidget_kill (struct xwidget *xw)
((XwWebView *) xw->xwWidget).configuration.userContentController;
[scriptor removeAllUserScripts];
[scriptor removeScriptMessageHandlerForName:@"keyDown"];
- [scriptor release];
+
if (xw->xv)
xw->xv->model = Qnil; /* Make sure related view stale. */
/* This stops playing audio when a xwidget-webkit buffer is
- killed. I could not find other solution. */
+ killed. I could not find other solution.
+ TODO: improve this */
nsxwidget_webkit_goto_uri (xw, "about:blank");
[((XwWebView *) xw->xwWidget).urlScriptBlocked release];
[xw->xwWidget removeFromSuperviewWithoutNeedingDisplay];
+
[xw->xwWidget release];
[xw->xwWindow removeFromSuperviewWithoutNeedingDisplay];
[xw->xwWindow release];
@@ -507,7 +551,7 @@ nsxwidget_get_size (struct xwidget *xw)
/* Xwidget view, macOS Cocoa part. */
@implementation XvWindow : NSView
-- (BOOL)isFlipped { return YES; }
+- (BOOL) isFlipped { return YES; }
@end
void
diff --git a/src/pdumper.c b/src/pdumper.c
index dd16e905a03..c79e32b971b 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2748,7 +2748,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_DB34E5D09F
+#if CHECK_STRUCTS && !defined HASH_buffer_85D317CE74
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
diff --git a/src/profiler.c b/src/profiler.c
index 81b5e7b0cf0..8247b2e90c6 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -505,6 +505,9 @@ Before returning, a new log is allocated for future
samples. */)
void
malloc_probe (size_t size)
{
+ if (EQ (backtrace_top_function (), QAutomatic_GC)) /* bug#60237 */
+ /* FIXME: We should do something like what we did with `cpu_gc_count`. */
+ return;
eassert (HASH_TABLE_P (memory_log));
record_backtrace (XHASH_TABLE (memory_log), min (size,
MOST_POSITIVE_FIXNUM));
}
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 2dca0d16ad9..2571812cb39 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -3653,6 +3653,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp,
re_char *p1,
re_opcode_t op2;
bool multibyte = RE_MULTIBYTE_P (bufp);
unsigned char *pend = bufp->buffer + bufp->used;
+ re_char *p2_orig = p2;
eassert (p1 >= bufp->buffer && p1 < pend
&& p2 >= bufp->buffer && p2 <= pend);
@@ -3822,6 +3823,23 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp,
re_char *p1,
case notcategoryspec:
return ((re_opcode_t) *p1 == categoryspec && p1[1] == p2[1]);
+ case on_failure_jump_nastyloop:
+ case on_failure_jump_smart:
+ case on_failure_jump_loop:
+ case on_failure_keep_string_jump:
+ case on_failure_jump:
+ {
+ int mcnt;
+ p2++;
+ EXTRACT_NUMBER_AND_INCR (mcnt, p2);
+ /* Don't just test `mcnt > 0` because non-greedy loops have
+ their test at the end with an unconditional jump at the start. */
+ if (p2 + mcnt > p2_orig) /* Ensure forward progress. */
+ return (mutually_exclusive_p (bufp, p1, p2)
+ && mutually_exclusive_p (bufp, p1, p2 + mcnt));
+ break;
+ }
+
default:
;
}
diff --git a/src/textconv.c b/src/textconv.c
new file mode 100644
index 00000000000..d5db6d11717
--- /dev/null
+++ b/src/textconv.c
@@ -0,0 +1,313 @@
+/* String conversion support for graphics terminals.
+
+Copyright (C) 2023 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/>. */
+
+/* String conversion support.
+
+ Many input methods require access to text surrounding the cursor.
+ They may then request that the text editor remove or substitute
+ that text for something else, for example when providing the
+ ability to ``undo'' or ``edit'' previously composed text. This is
+ most commonly seen in input methods for CJK laguages for X Windows,
+ and is extensively used throughout Android by input methods for all
+ kinds of scripts. */
+
+#include <config.h>
+
+#include "textconv.h"
+#include "buffer.h"
+#include "syntax.h"
+
+
+
+/* The window system's text conversion interface.
+ NULL when the window system has not set up text conversion.
+
+ This interface will later be heavily extended on the
+ feature/android branch to deal with Android's much less
+ straightforward text conversion protocols. */
+
+static struct textconv_interface *text_interface;
+
+
+
+/* Copy the portion of the current buffer described by BEG, BEG_BYTE,
+ END, END_BYTE to the buffer BUFFER, which is END_BYTE - BEG_BYTEs
+ long. */
+
+static void
+copy_buffer (ptrdiff_t beg, ptrdiff_t beg_byte,
+ ptrdiff_t end, ptrdiff_t end_byte,
+ char *buffer)
+{
+ ptrdiff_t beg0, end0, beg1, end1, size;
+
+ if (beg_byte < GPT_BYTE && GPT_BYTE < end_byte)
+ {
+ /* Two regions, before and after the gap. */
+ beg0 = beg_byte;
+ end0 = GPT_BYTE;
+ beg1 = GPT_BYTE + GAP_SIZE - BEG_BYTE;
+ end1 = end_byte + GAP_SIZE - BEG_BYTE;
+ }
+ else
+ {
+ /* The only region. */
+ beg0 = beg_byte;
+ end0 = end_byte;
+ beg1 = -1;
+ end1 = -1;
+ }
+
+ size = end0 - beg0;
+ memcpy (buffer, BYTE_POS_ADDR (beg0), size);
+ if (beg1 != -1)
+ memcpy (buffer, BEG_ADDR + beg1, end1 - beg1);
+}
+
+
+
+/* Conversion query. */
+
+/* Perform the text conversion operation specified in QUERY and return
+ the results.
+
+ Find the text between QUERY->position from point on F's selected
+ window and QUERY->factor times QUERY->direction from that
+ position. Return it in QUERY->text.
+
+ Then, either delete that text from the buffer if QUERY->operation
+ is TEXTCONV_SUBSTITUTION, or return 0.
+
+ Value is 0 if QUERY->operation was not TEXTCONV_SUBSTITUTION
+ or if deleting the text was successful, and 1 otherwise. */
+
+int
+textconv_query (struct frame *f, struct textconv_callback_struct *query)
+{
+ specpdl_ref count;
+ ptrdiff_t pos, pos_byte, end, end_byte;
+ ptrdiff_t temp, temp1;
+ char *buffer;
+
+ /* Save the excursion, as there will be extensive changes to the
+ selected window. */
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_excursion ();
+
+ /* Inhibit quitting. */
+ specbind (Qinhibit_quit, Qt);
+
+ /* Temporarily switch to F's selected window. */
+ Fselect_window (f->selected_window, Qt);
+
+ /* Now find the appropriate text bounds for QUERY. First, move
+ point QUERY->position steps forward or backwards. */
+
+ pos = PT;
+
+ /* If pos is outside the accessible part of the buffer or if it
+ overflows, move back to point or to the extremes of the
+ accessible region. */
+
+ if (INT_ADD_WRAPV (pos, query->position, &pos))
+ pos = PT;
+
+ if (pos < BEGV)
+ pos = BEGV;
+
+ if (pos > ZV)
+ pos = ZV;
+
+ /* Move to pos. */
+ set_point (pos);
+ pos = PT;
+ pos_byte = PT_BYTE;
+
+ /* Now scan forward or backwards according to what is in QUERY. */
+
+ switch (query->direction)
+ {
+ case TEXTCONV_FORWARD_CHAR:
+ /* Move forward by query->factor characters. */
+ if (INT_ADD_WRAPV (pos, query->factor, &end) || end > ZV)
+ end = ZV;
+
+ end_byte = CHAR_TO_BYTE (end);
+ break;
+
+ case TEXTCONV_BACKWARD_CHAR:
+ /* Move backward by query->factor characters. */
+ if (INT_SUBTRACT_WRAPV (pos, query->factor, &end) || end < BEGV)
+ end = BEGV;
+
+ end_byte = CHAR_TO_BYTE (end);
+ break;
+
+ case TEXTCONV_FORWARD_WORD:
+ /* Move forward by query->factor word. */
+ end = scan_words (pos, (EMACS_INT) query->factor);
+
+ if (!end)
+ {
+ end = ZV;
+ end_byte = ZV_BYTE;
+ }
+ else
+ end_byte = CHAR_TO_BYTE (end);
+
+ break;
+
+ case TEXTCONV_BACKWARD_WORD:
+ /* Move backwards by query->factor word. */
+ end = scan_words (pos, 0 - (EMACS_INT) query->factor);
+
+ if (!end)
+ {
+ end = BEGV;
+ end_byte = BEGV_BYTE;
+ }
+ else
+ end_byte = CHAR_TO_BYTE (end);
+
+ break;
+
+ case TEXTCONV_CARET_UP:
+ /* Move upwards one visual line, keeping the column intact. */
+ Fvertical_motion (Fcons (Fcurrent_column (), make_fixnum (-1)),
+ Qnil, Qnil);
+ end = PT;
+ end_byte = PT_BYTE;
+ break;
+
+ case TEXTCONV_CARET_DOWN:
+ /* Move downwards one visual line, keeping the column
+ intact. */
+ Fvertical_motion (Fcons (Fcurrent_column (), make_fixnum (1)),
+ Qnil, Qnil);
+ end = PT;
+ end_byte = PT_BYTE;
+ break;
+
+ case TEXTCONV_NEXT_LINE:
+ /* Move one line forward. */
+ scan_newline (pos, pos_byte, ZV, ZV_BYTE,
+ query->factor, false);
+ end = PT;
+ end_byte = PT_BYTE;
+ break;
+
+ case TEXTCONV_PREVIOUS_LINE:
+ /* Move one line backwards. */
+ scan_newline (pos, pos_byte, BEGV, BEGV_BYTE,
+ 0 - (EMACS_INT) query->factor, false);
+ end = PT;
+ end_byte = PT_BYTE;
+ break;
+
+ case TEXTCONV_LINE_START:
+ /* Move to the beginning of the line. */
+ Fbeginning_of_line (Qnil);
+ end = PT;
+ end_byte = PT_BYTE;
+ break;
+
+ case TEXTCONV_LINE_END:
+ /* Move to the end of the line. */
+ Fend_of_line (Qnil);
+ end = PT;
+ end_byte = PT_BYTE;
+ break;
+
+ case TEXTCONV_ABSOLUTE_POSITION:
+ /* How to implement this is unclear. */
+ SET_PT (query->factor);
+ end = PT;
+ end_byte = PT_BYTE;
+ break;
+
+ default:
+ unbind_to (count, Qnil);
+ return 1;
+ }
+
+ /* Sort end and pos. */
+
+ if (end < pos)
+ {
+ eassert (end_byte < pos_byte);
+ temp = pos_byte;
+ temp1 = pos;
+ pos_byte = end_byte;
+ pos = end;
+ end = temp1;
+ end_byte = temp;
+ }
+
+ /* Return the string first. */
+ buffer = xmalloc (end_byte - pos_byte);
+ copy_buffer (pos, pos_byte, end, end_byte, buffer);
+ query->text.text = buffer;
+ query->text.length = end - pos;
+ query->text.bytes = end_byte - pos_byte;
+
+ /* Next, perform any operation specified. */
+
+ switch (query->operation)
+ {
+ case TEXTCONV_SUBSTITUTION:
+ if (safe_del_range (pos, end))
+ {
+ /* Undo any changes to the excursion. */
+ unbind_to (count, Qnil);
+ return 1;
+ }
+
+ default:
+ break;
+ }
+
+ /* Undo any changes to the excursion. */
+ unbind_to (count, Qnil);
+ return 0;
+}
+
+
+
+/* Window system interface. These are called from the rest of
+ Emacs. */
+
+/* Notice that F's selected window has been set from redisplay.
+ Reset F's input method state. */
+
+void
+report_selected_window_change (struct frame *f)
+{
+ if (!text_interface)
+ return;
+
+ text_interface->reset (f);
+}
+
+/* Register INTERFACE as the text conversion interface. */
+
+void
+register_texconv_interface (struct textconv_interface *interface)
+{
+ text_interface = interface;
+}
diff --git a/src/textconv.h b/src/textconv.h
new file mode 100644
index 00000000000..f6e7eb7925f
--- /dev/null
+++ b/src/textconv.h
@@ -0,0 +1,109 @@
+/* String conversion support for graphics terminals.
+
+Copyright (C) 2023 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/>. */
+
+#ifndef _TEXTCONV_H_
+
+#include "lisp.h"
+#include "frame.h"
+
+/* The function pointers in this structure should be filled out by
+ each GUI backend interested in supporting text conversion.
+
+ Finally, register_texconv_interface must be called at some point
+ during terminal initialization. */
+
+struct textconv_interface
+{
+ /* Notice that the text conversion context has changed (which can
+ happen if the window is deleted or switches buffers, or an
+ unexpected buffer change occurs.) */
+ void (*reset) (struct frame *);
+};
+
+
+
+enum textconv_caret_direction
+ {
+ TEXTCONV_FORWARD_CHAR,
+ TEXTCONV_BACKWARD_CHAR,
+ TEXTCONV_FORWARD_WORD,
+ TEXTCONV_BACKWARD_WORD,
+ TEXTCONV_CARET_UP,
+ TEXTCONV_CARET_DOWN,
+ TEXTCONV_NEXT_LINE,
+ TEXTCONV_PREVIOUS_LINE,
+ TEXTCONV_LINE_START,
+ TEXTCONV_LINE_END,
+ TEXTCONV_ABSOLUTE_POSITION,
+ };
+
+enum textconv_operation
+ {
+ TEXTCONV_SUBSTITUTION,
+ TEXTCONV_RETRIEVAL,
+ };
+
+/* Structure describing text in a buffer corresponding to a ``struct
+ textconv_callback_struct''. */
+
+struct textconv_conversion_text
+{
+ /* Length of the text in characters and bytes. */
+ size_t length, bytes;
+
+ /* Pointer to the text data. This must be deallocated by the
+ caller. */
+ char *text;
+};
+
+/* Structure describing a single query submitted by the input
+ method. */
+
+struct textconv_callback_struct
+{
+ /* Character position, relative to the current spot location, from
+ where on text should be returned. */
+ EMACS_INT position;
+
+ /* The type of scanning to perform to determine either the start or
+ the end of the conversion. */
+ enum textconv_caret_direction direction;
+
+ /* The the number of times for which to repeat the scanning in order
+ to determine the starting position of the text to return. */
+ unsigned short factor;
+
+ /* The operation to perform upon the current buffer contents.
+
+ If this is TEXTCONV_SUBSTITUTION, then the text that is returned
+ will be deleted from the buffer itself.
+
+ Otherwise, the text is simply returned without modifying the
+ buffer contents. */
+ enum textconv_operation operation;
+
+ /* Structure that will be filled with a description of the resulting
+ text. */
+ struct textconv_conversion_text text;
+};
+
+extern int textconv_query (struct frame *, struct textconv_callback_struct *);
+extern void register_texconv_interface (struct textconv_interface *);
+
+#endif /* _TEXTCONV_H_ */
diff --git a/src/treesit.c b/src/treesit.c
index 8e772523cc7..5a4fe3e8803 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -617,10 +617,14 @@ treesit_load_language (Lisp_Object language_symbol,
eassume (handle != NULL);
dynlib_error ();
TSLanguage *(*langfn) (void);
- char *c_name = xstrdup (SSDATA (base_name));
- treesit_symbol_to_c_name (c_name);
+ char *c_name;
if (found_override)
- c_name = SSDATA (override_c_name);
+ c_name = xstrdup (SSDATA (override_c_name));
+ else
+ {
+ c_name = xstrdup (SSDATA (base_name));
+ treesit_symbol_to_c_name (c_name);
+ }
langfn = dynlib_sym (handle, c_name);
xfree (c_name);
error = dynlib_error ();
@@ -716,6 +720,7 @@ Return nil if a grammar library for LANGUAGE is not
available. */)
}
}
+
/*** Parsing functions */
static void
@@ -766,7 +771,8 @@ treesit_record_change (ptrdiff_t start_byte, ptrdiff_t
old_end_byte,
treesit_check_parser (lisp_parser);
TSTree *tree = XTS_PARSER (lisp_parser)->tree;
/* See comment (ref:visible-beg-null) if you wonder why we don't
- update visible_beg/end when tree is NULL. */
+ update visible_beg/end when tree is NULL. */
+
if (tree != NULL)
{
eassert (start_byte <= old_end_byte);
@@ -790,8 +796,12 @@ treesit_record_change (ptrdiff_t start_byte, ptrdiff_t
old_end_byte,
ptrdiff_t old_end_offset = (min (visible_end,
max (visible_beg, old_end_byte))
- visible_beg);
- ptrdiff_t new_end_offset = (min (visible_end,
- max (visible_beg, new_end_byte))
+ /* We don't clip new_end_offset under visible_end, because
+ otherwise we would miss updating the clipped part. Plus,
+ when inserting in narrowed region, the narrowed region
+ will grow to accommodate the new text, so this is the
+ correct behavior. (Bug#61369). */
+ ptrdiff_t new_end_offset = (max (visible_beg, new_end_byte)
- visible_beg);
eassert (start_offset <= old_end_offset);
eassert (start_offset <= new_end_offset);
@@ -813,11 +823,13 @@ treesit_record_change (ptrdiff_t start_byte, ptrdiff_t
old_end_byte,
/* Move forward. */
visi_beg_delta = (old_end_byte < visible_beg
? new_end_byte - old_end_byte : 0);
+
XTS_PARSER (lisp_parser)->visible_beg = visible_beg + visi_beg_delta;
XTS_PARSER (lisp_parser)->visible_end = (visible_end
+ visi_beg_delta
+ (new_end_offset
- old_end_offset));
+
eassert (XTS_PARSER (lisp_parser)->visible_beg >= 0);
eassert (XTS_PARSER (lisp_parser)->visible_beg
<= XTS_PARSER (lisp_parser)->visible_end);
@@ -1100,6 +1112,7 @@ treesit_read_buffer (void *parser, uint32_t byte_index,
return beg;
}
+
/*** Functions for parser and node object */
/* Wrap the parser in a Lisp_Object to be used in the Lisp
@@ -1262,6 +1275,9 @@ treesit_ensure_query_compiled (Lisp_Object query,
Lisp_Object *signal_symbol,
return treesit_query;
}
+
+/* Lisp definitions. */
+
DEFUN ("treesit-parser-p",
Ftreesit_parser_p, Streesit_parser_p, 1, 1, 0,
doc: /* Return t if OBJECT is a tree-sitter parser. */)
@@ -1471,6 +1487,16 @@ This symbol is the one used to create the parser. */)
return XTS_PARSER (parser)->language_symbol;
}
+/* Return true if PARSER is not deleted and its buffer is live. */
+static bool
+treesit_parser_live_p (Lisp_Object parser)
+{
+ CHECK_TS_PARSER (parser);
+ return ((!XTS_PARSER (parser)->deleted) &&
+ (!NILP (Fbuffer_live_p (XTS_PARSER (parser)->buffer))));
+}
+
+
/*** Parser API */
DEFUN ("treesit-parser-root-node",
@@ -1717,6 +1743,7 @@ positions. PARSER is the parser issuing the
notification. */)
return Qnil;
}
+
/*** Node API */
/* Check that OBJ is a positive integer and signal an error if
@@ -1904,7 +1931,8 @@ DEFUN ("treesit-node-check",
Ftreesit_node_check, Streesit_node_check, 2, 2, 0,
doc: /* Return non-nil if NODE has PROPERTY, nil otherwise.
-PROPERTY could be `named', `missing', `extra', `outdated', or `has-error'.
+PROPERTY could be `named', `missing', `extra', `outdated',
+`has-error', or `live'.
Named nodes correspond to named rules in the language definition,
whereas "anonymous" nodes correspond to string literals in the
@@ -1920,7 +1948,10 @@ A node is "outdated" if the parser has reparsed at least
once after
the node was created.
A node "has error" if itself is a syntax error or contains any syntax
-errors. */)
+errors.
+
+A node is "live" if its parser is not deleted and its buffer is
+live. */)
(Lisp_Object node, Lisp_Object property)
{
if (NILP (node)) return Qnil;
@@ -1943,9 +1974,11 @@ errors. */)
result = ts_node_is_extra (treesit_node);
else if (EQ (property, Qhas_error))
result = ts_node_has_error (treesit_node);
+ else if (EQ (property, Qlive))
+ result = treesit_parser_live_p (XTS_NODE (node)->parser);
else
signal_error ("Expecting `named', `missing', `extra', "
- "`outdated', or `has-error', but got",
+ "`outdated', `has-error', or `live', but got",
property);
return result ? Qt : Qnil;
}
@@ -2233,6 +2266,7 @@ produced by tree-sitter. */)
return same_node ? Qt : Qnil;
}
+
/*** Query functions */
DEFUN ("treesit-pattern-expand",
@@ -2450,7 +2484,7 @@ treesit_predicate_match (Lisp_Object args, struct
capture_range captures)
{
if (XFIXNUM (Flength (args)) != 2)
xsignal2 (Qtreesit_query_error,
- build_string ("Predicate `equal' requires two "
+ build_string ("Predicate `match' requires two "
"arguments but only given"),
Flength (args));
@@ -2807,6 +2841,7 @@ the query. */)
return Fnreverse (result);
}
+
/*** Navigation */
static inline void
@@ -3131,13 +3166,13 @@ the way. PREDICATE is a regexp string that matches
against each
node's type, or a function that takes a node and returns nil/non-nil.
By default, only traverse named nodes, but if ALL is non-nil, traverse
-all nodes. If BACKWARD is non-nil, traverse backwards. If LIMIT is
+all nodes. If BACKWARD is non-nil, traverse backwards. If DEPTH is
non-nil, only traverse nodes up to that number of levels down in the
-tree. If LIMIT is nil, default to 1000.
+tree. If DEPTH is nil, default to 1000.
Return the first matched node, or nil if none matches. */)
(Lisp_Object node, Lisp_Object predicate, Lisp_Object backward,
- Lisp_Object all, Lisp_Object limit)
+ Lisp_Object all, Lisp_Object depth)
{
CHECK_TS_NODE (node);
CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate),
@@ -3148,10 +3183,10 @@ Return the first matched node, or nil if none matches.
*/)
/* We use a default limit of 1000. See bug#59426 for the
discussion. */
ptrdiff_t the_limit = treesit_recursion_limit;
- if (!NILP (limit))
+ if (!NILP (depth))
{
- CHECK_FIXNUM (limit);
- the_limit = XFIXNUM (limit);
+ CHECK_FIXNUM (depth);
+ the_limit = XFIXNUM (depth);
}
treesit_initialize ();
@@ -3303,8 +3338,8 @@ If PROCESS-FN is non-nil, it should be a function of one
argument. In
that case, instead of returning the matched nodes, pass each node to
PROCESS-FN, and use its return value instead.
-If non-nil, LIMIT is the number of levels to go down the tree from
-ROOT. If LIMIT is nil or omitted, it defaults to 1000.
+If non-nil, DEPTH is the number of levels to go down the tree from
+ROOT. If DEPTH is nil or omitted, it defaults to 1000.
Each node in the returned tree looks like (NODE . (CHILD ...)). The
root of this tree might be nil, if ROOT doesn't match PREDICATE.
@@ -3315,7 +3350,7 @@ PREDICATE can also be a function that takes a node and
returns
nil/non-nil, but it is slower and more memory consuming than using
a regexp. */)
(Lisp_Object root, Lisp_Object predicate, Lisp_Object process_fn,
- Lisp_Object limit)
+ Lisp_Object depth)
{
CHECK_TS_NODE (root);
CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate),
@@ -3327,10 +3362,10 @@ a regexp. */)
/* We use a default limit of 1000. See bug#59426 for the
discussion. */
ptrdiff_t the_limit = treesit_recursion_limit;
- if (!NILP (limit))
+ if (!NILP (depth))
{
- CHECK_FIXNUM (limit);
- the_limit = XFIXNUM (limit);
+ CHECK_FIXNUM (depth);
+ the_limit = XFIXNUM (depth);
}
treesit_initialize ();
@@ -3427,7 +3462,7 @@ DEFUN ("treesit-available-p", Ftreesit_available_p,
#endif
}
-
+
/*** Initialization */
/* Initialize the tree-sitter routines. */
@@ -3444,6 +3479,7 @@ syms_of_treesit (void)
DEFSYM (Qextra, "extra");
DEFSYM (Qoutdated, "outdated");
DEFSYM (Qhas_error, "has-error");
+ DEFSYM (Qlive, "live");
DEFSYM (QCanchor, ":anchor");
DEFSYM (QCequal, ":equal");
diff --git a/src/window.c b/src/window.c
index d3cefe4a959..2f4718ef583 100644
--- a/src/window.c
+++ b/src/window.c
@@ -762,10 +762,15 @@ future use. */)
DEFUN ("window-use-time", Fwindow_use_time, Swindow_use_time, 0, 1, 0,
doc: /* Return the use time of window WINDOW.
-WINDOW must be a live window and defaults to the selected one.
-The window with the highest use time is the most recently selected
-one. The window with the lowest use time is the least recently
-selected one. */)
+WINDOW must specify a live window and defaults to the selected one.
+
+The window with the highest use time is usually the one most recently
+selected by calling `select-window' with NORECORD nil. The window with
+the lowest use time is usually the least recently selected one chosen in
+such a way.
+
+Note that the use time of a window can be also changed by calling
+`window-bump-use-time' for that window. */)
(Lisp_Object window)
{
return make_fixnum (decode_live_window (window)->use_time);
@@ -773,15 +778,27 @@ selected one. */)
DEFUN ("window-bump-use-time", Fwindow_bump_use_time,
Swindow_bump_use_time, 0, 1, 0,
- doc: /* Mark WINDOW as having been most recently used.
-WINDOW must be a live window and defaults to the selected one. */)
+ doc: /* Mark WINDOW as second most recently used.
+WINDOW must specify a live window.
+
+If WINDOW is not selected and the selected window has the highest use
+time of all windows, set the use time of WINDOW to that of the selected
+window, increase the use time of the selected window by one and return
+the new use time of WINDOW. Otherwise, do nothing and return nil. */)
(Lisp_Object window)
{
struct window *w = decode_live_window (window);
+ struct window *sw = XWINDOW (selected_window);
- w->use_time = ++window_select_count;
+ if (w != sw && sw->use_time == window_select_count)
+ {
+ w->use_time = window_select_count;
+ sw->use_time = ++window_select_count;
- return Qnil;
+ return make_fixnum (w->use_time);
+ }
+ else
+ return Qnil;
}
DEFUN ("window-pixel-width", Fwindow_pixel_width, Swindow_pixel_width, 0, 1, 0,
@@ -1712,8 +1729,11 @@ window_from_coordinates (struct frame *f, int x, int y,
DEFUN ("window-at", Fwindow_at, Swindow_at, 2, 3, 0,
doc: /* Return window containing coordinates X and Y on FRAME.
FRAME must be a live frame and defaults to the selected one.
-The top left corner of the frame is considered to be row 0,
-column 0. */)
+X and Y are measured in units of canonical columns and rows.
+The top left corner of the frame is considered to be column 0, row 0.
+Tool-bar and tab-bar pseudo-windows are ignored by this function: if
+the specified coordinates are in any of these two windows, this
+function returns nil. */)
(Lisp_Object x, Lisp_Object y, Lisp_Object frame)
{
struct frame *f = decode_live_frame (frame);
@@ -3856,6 +3876,9 @@ run_window_change_functions_1 (Lisp_Object symbol,
Lisp_Object buffer,
*
* This function does not save and restore match data. Any functions
* it calls are responsible for doing that themselves.
+ *
+ * Additionally, report changes to each frame's selected window to the
+ * input method in textconv.c.
*/
void
run_window_change_functions (void)
@@ -4015,6 +4038,18 @@ run_window_change_functions (void)
run_window_change_functions_1
(Qwindow_selection_change_functions, Qnil, frame);
+#if defined HAVE_TEXT_CONVERSION
+
+ /* If the buffer or selected window has changed, also reset the
+ input method composition state. */
+
+ if ((frame_selected_window_change || frame_buffer_change)
+ && FRAME_LIVE_P (f)
+ && FRAME_WINDOW_P (f))
+ report_selected_window_change (f);
+
+#endif
+
/* A frame has changed state when a size or buffer change
occurred, its selected window has changed, when it was
(de-)selected or its window state change flag was set. */
diff --git a/src/xdisp.c b/src/xdisp.c
index ed870004b43..0ebbe81f7d3 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -3498,18 +3498,18 @@ init_iterator (struct it *it, struct window *w,
static int
get_narrowed_width (struct window *w)
{
- int fact;
/* In a character-only terminal, only one font size is used, so we
can use a smaller factor. */
- fact = EQ (Fterminal_live_p (Qnil), Qt) ? 2 : 3;
- return fact * window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS);
+ int fact = EQ (Fterminal_live_p (Qnil), Qt) ? 2 : 3;
+ int width = window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS);
+ return fact * max (1, width);
}
static int
get_narrowed_len (struct window *w)
{
- return get_narrowed_width (w) *
- window_body_height (w, WINDOW_BODY_IN_CANONICAL_CHARS);
+ int height = window_body_height (w, WINDOW_BODY_IN_CANONICAL_CHARS);
+ return get_narrowed_width (w) * max (1, height);
}
ptrdiff_t
@@ -3536,11 +3536,11 @@ get_closer_narrowed_begv (struct window *w, ptrdiff_t
pos)
ptrdiff_t
get_locked_narrowing_begv (ptrdiff_t pos)
{
- if (long_line_locked_narrowing_region_size <= 0)
+ if (long_line_optimizations_region_size <= 0)
return BEGV;
- int len = long_line_locked_narrowing_region_size / 2;
+ int len = long_line_optimizations_region_size / 2;
int begv = max (pos - len, BEGV);
- int limit = long_line_locked_narrowing_bol_search_limit;
+ int limit = long_line_optimizations_bol_search_limit;
while (limit > 0)
{
if (begv == BEGV || FETCH_BYTE (CHAR_TO_BYTE (begv) - 1) == '\n')
@@ -3554,9 +3554,9 @@ get_locked_narrowing_begv (ptrdiff_t pos)
ptrdiff_t
get_locked_narrowing_zv (ptrdiff_t pos)
{
- if (long_line_locked_narrowing_region_size <= 0)
+ if (long_line_optimizations_region_size <= 0)
return ZV;
- int len = long_line_locked_narrowing_region_size / 2;
+ int len = long_line_optimizations_region_size / 2;
return min (pos + len, ZV);
}
@@ -4394,7 +4394,7 @@ handle_fontified_prop (struct it *it)
eassert (it->end_charpos == ZV);
if (current_buffer->long_line_optimizations_p
- && long_line_locked_narrowing_region_size > 0)
+ && long_line_optimizations_region_size > 0)
{
ptrdiff_t begv = it->locked_narrowing_begv;
ptrdiff_t zv = it->locked_narrowing_zv;
@@ -4406,7 +4406,7 @@ handle_fontified_prop (struct it *it)
}
if (begv != BEG || zv != Z)
narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv),
- Qfontification_functions);
+
Qlong_line_optimizations_in_fontification_functions);
}
/* Don't allow Lisp that runs from 'fontification-functions'
@@ -4583,7 +4583,7 @@ face_at_pos (const struct it *it, enum
lface_attribute_index attr_filter)
&next_stop,
base_face_id, false,
attr_filter);
- } // !STRINGP (it->string))
+ } /* !STRINGP (it->string) */
}
@@ -9609,8 +9609,8 @@ move_it_in_display_line_to (struct it *it,
else
line_number_pending = true;
}
- /* If there's a line-/wrap-prefix, handle it. */
- if (it->method == GET_FROM_BUFFER)
+ /* If there's a line-/wrap-prefix, handle it, if we didn't already. */
+ if (it->area == TEXT_AREA && !it->string_from_prefix_prop_p)
handle_line_prefix (it);
}
@@ -13424,7 +13424,8 @@ gui_consider_frame_title (Lisp_Object frame)
Fselect_window (f->selected_window, Qt);
set_buffer_internal_1 (XBUFFER (XWINDOW (f->selected_window)->contents));
- fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format;
+ fmt = (FRAME_ICONIFIED_P (f) && !EQ (Vicon_title_format, Qt)
+ ? Vicon_title_format : Vframe_title_format);
mode_line_target = MODE_LINE_TITLE;
title_start = MODE_LINE_NOPROP_LEN (0);
@@ -29364,6 +29365,7 @@ fill_gstring_glyph_string (struct glyph_string *s, int
face_id,
int start, int end, int overlaps)
{
struct glyph *glyph, *last;
+ int voffset;
Lisp_Object lgstring;
int i;
bool glyph_not_available_p;
@@ -29371,6 +29373,7 @@ fill_gstring_glyph_string (struct glyph_string *s, int
face_id,
s->for_overlaps = overlaps;
glyph = s->row->glyphs[s->area] + start;
last = s->row->glyphs[s->area] + end;
+ voffset = glyph->voffset;
glyph_not_available_p = glyph->glyph_not_available_p;
s->cmp_id = glyph->u.cmp.id;
s->cmp_from = glyph->slice.cmp.from;
@@ -29421,6 +29424,9 @@ fill_gstring_glyph_string (struct glyph_string *s, int
face_id,
if (glyph_not_available_p)
s->font_not_found_p = true;
+ /* Adjust base line for subscript/superscript text. */
+ s->ybase += voffset;
+
return glyph - s->row->glyphs[s->area];
}
@@ -36308,6 +36314,8 @@ be let-bound around code that needs to disable messages
temporarily. */);
DEFSYM (QCfile, ":file");
DEFSYM (Qfontified, "fontified");
DEFSYM (Qfontification_functions, "fontification-functions");
+ DEFSYM (Qlong_line_optimizations_in_fontification_functions,
+ "long-line-optimizations-in-fontification-functions");
/* Name of the symbol which disables Lisp evaluation in 'display'
properties. This is used by enriched.el. */
@@ -36648,9 +36656,11 @@ which no explicit name has been set (see
`modify-frame-parameters'). */);
DEFVAR_LISP ("icon-title-format", Vicon_title_format,
doc: /* Template for displaying the title bar of an iconified frame.
\(Assuming the window manager supports this feature.)
-This variable has the same structure as `mode-line-format' (which see),
-and is used only on frames for which no explicit name has been set
-\(see `modify-frame-parameters'). */);
+If the value is a string, it should have the same structure
+as `mode-line-format' (which see), and is used only on frames
+for which no explicit name has been set \(see `modify-frame-parameters').
+If the value is t, that means use `frame-title-format' for
+iconified frames. */);
/* Do not nest calls to pure_list. This works around a bug in
Oracle Developer Studio 12.6. */
Lisp_Object icon_title_name_format
@@ -36817,12 +36827,11 @@ Each function is called with one argument POS.
Functions must
fontify a region starting at POS in the current buffer, and give
fontified regions the property `fontified' with a non-nil value.
-Note that, when the buffer contains one or more lines whose length is
-above `long-line-threshold', these functions are called with the
-buffer narrowed to a small portion around POS (whose size is specified
-by `long-line-locked-narrowing-region-size'), and the narrowing is
-locked (see `narrowing-lock'), so that these functions cannot use
-`widen' to gain access to other portions of buffer text. */);
+Note that, when `long-line-optimizations-p' is non-nil in the buffer,
+these functions are called as if they were in a `with-restriction' form,
+with a `long-line-optimizations-in-fontification-functions' label and
+with the buffer narrowed to a portion around POS whose size is
+specified by `long-line-optimizations-region-size'. */);
Vfontification_functions = Qnil;
Fmake_variable_buffer_local (Qfontification_functions);
diff --git a/src/xfaces.c b/src/xfaces.c
index 62d7823f308..37b703984be 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -4186,7 +4186,9 @@ Default face attributes override any local face
attributes. */)
if (EQ (face, Qdefault))
{
struct face_cache *c = FRAME_FACE_CACHE (f);
- struct face *newface, *oldface = FACE_FROM_ID_OR_NULL (f,
DEFAULT_FACE_ID);
+ struct face *newface;
+ struct face *oldface =
+ c ? FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID) : NULL;
Lisp_Object attrs[LFACE_VECTOR_SIZE];
/* This can be NULL (e.g., in batch mode). */
diff --git a/src/xfns.c b/src/xfns.c
index 3a129211463..9e004f6a678 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -37,6 +37,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "termhooks.h"
#include "font.h"
+#ifdef HAVE_X_I18N
+#include "textconv.h"
+#endif
+
#include <sys/types.h>
#include <sys/stat.h>
@@ -2671,24 +2675,50 @@ append_wm_protocols (struct x_display_info *dpyinfo,
#ifdef HAVE_X_I18N
-static void xic_preedit_draw_callback (XIC, XPointer,
XIMPreeditDrawCallbackStruct *);
-static void xic_preedit_caret_callback (XIC, XPointer,
XIMPreeditCaretCallbackStruct *);
+static void xic_preedit_draw_callback (XIC, XPointer,
+ XIMPreeditDrawCallbackStruct *);
+static void xic_preedit_caret_callback (XIC, XPointer,
+ XIMPreeditCaretCallbackStruct *);
static void xic_preedit_done_callback (XIC, XPointer, XPointer);
static int xic_preedit_start_callback (XIC, XPointer, XPointer);
+static void xic_string_conversion_callback (XIC, XPointer,
+ XIMStringConversionCallbackStruct
*);
#ifndef HAVE_XICCALLBACK_CALLBACK
#define XICCallback XIMCallback
#define XICProc XIMProc
#endif
-static XIMCallback Xxic_preedit_draw_callback = { NULL,
- (XIMProc)
xic_preedit_draw_callback };
-static XIMCallback Xxic_preedit_caret_callback = { NULL,
- (XIMProc)
xic_preedit_caret_callback };
-static XIMCallback Xxic_preedit_done_callback = { NULL,
- (XIMProc)
xic_preedit_done_callback };
-static XICCallback Xxic_preedit_start_callback = { NULL,
- (XICProc)
xic_preedit_start_callback };
+static XIMCallback Xxic_preedit_draw_callback =
+ {
+ NULL,
+ (XIMProc) xic_preedit_draw_callback,
+ };
+
+static XIMCallback Xxic_preedit_caret_callback =
+ {
+ NULL,
+ (XIMProc) xic_preedit_caret_callback,
+ };
+
+static XIMCallback Xxic_preedit_done_callback =
+ {
+ NULL,
+ (XIMProc) xic_preedit_done_callback,
+ };
+
+static XICCallback Xxic_preedit_start_callback =
+ {
+ NULL,
+ (XICProc) xic_preedit_start_callback,
+ };
+
+static XIMCallback Xxic_string_conversion_callback =
+ {
+ /* This is actually an XICCallback! */
+ NULL,
+ (XIMProc) xic_string_conversion_callback,
+ };
#if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
/* Create an X fontset on frame F with base font name BASE_FONTNAME. */
@@ -3094,6 +3124,8 @@ create_frame_xic (struct frame *f)
XNFocusWindow, FRAME_X_WINDOW (f),
XNStatusAttributes, status_attr,
XNPreeditAttributes, preedit_attr,
+ XNStringConversionCallback,
+ &Xxic_string_conversion_callback,
NULL);
else if (preedit_attr)
xic = XCreateIC (xim,
@@ -3101,6 +3133,8 @@ create_frame_xic (struct frame *f)
XNClientWindow, FRAME_X_WINDOW (f),
XNFocusWindow, FRAME_X_WINDOW (f),
XNPreeditAttributes, preedit_attr,
+ XNStringConversionCallback,
+ &Xxic_string_conversion_callback,
NULL);
else if (status_attr)
xic = XCreateIC (xim,
@@ -3108,12 +3142,16 @@ create_frame_xic (struct frame *f)
XNClientWindow, FRAME_X_WINDOW (f),
XNFocusWindow, FRAME_X_WINDOW (f),
XNStatusAttributes, status_attr,
+ XNStringConversionCallback,
+ &Xxic_string_conversion_callback,
NULL);
else
xic = XCreateIC (xim,
XNInputStyle, xic_style,
XNClientWindow, FRAME_X_WINDOW (f),
XNFocusWindow, FRAME_X_WINDOW (f),
+ XNStringConversionCallback,
+ &Xxic_string_conversion_callback,
NULL);
if (!xic)
@@ -3377,6 +3415,7 @@ struct x_xim_text_conversion_data
struct coding_system *coding;
char *source;
struct x_display_info *dpyinfo;
+ size_t size;
};
static Lisp_Object
@@ -3411,6 +3450,38 @@ x_xim_text_to_utf8_unix_1 (ptrdiff_t nargs, Lisp_Object
*args)
return Qnil;
}
+static Lisp_Object
+x_encode_xim_text_1 (ptrdiff_t nargs, Lisp_Object *args)
+{
+ struct x_xim_text_conversion_data *data;
+ ptrdiff_t nbytes;
+ Lisp_Object coding_system;
+
+ data = xmint_pointer (args[0]);
+
+ if (SYMBOLP (Vx_input_coding_system))
+ coding_system = Vx_input_coding_system;
+ else if (!NILP (data->dpyinfo->xim_coding))
+ coding_system = data->dpyinfo->xim_coding;
+ else
+ coding_system = Vlocale_coding_system;
+
+ nbytes = data->size;
+
+ data->coding->destination = NULL;
+
+ setup_coding_system (coding_system, data->coding);
+ data->coding->mode |= (CODING_MODE_LAST_BLOCK
+ | CODING_MODE_SAFE_ENCODING);
+ data->coding->source = (const unsigned char *) data->source;
+ data->coding->dst_bytes = 2048;
+ data->coding->destination = xmalloc (2048);
+ encode_coding_object (data->coding, Qnil, 0, 0,
+ nbytes, nbytes, Qnil);
+
+ return Qnil;
+}
+
static Lisp_Object
x_xim_text_to_utf8_unix_2 (Lisp_Object val, ptrdiff_t nargs,
Lisp_Object *args)
@@ -3468,6 +3539,46 @@ x_xim_text_to_utf8_unix (struct x_display_info *dpyinfo,
return (char *) coding.destination;
}
+/* Convert SIZE bytes of the specified text from Emacs's internal
+ coding system to the input method coding system. Return the
+ result, its byte length in *LENGTH, and its character length in
+ *CHARS, or NULL.
+
+ The string returned is not NULL terminated. */
+
+static char *
+x_encode_xim_text (struct x_display_info *dpyinfo, char *text,
+ size_t size, ptrdiff_t *length,
+ ptrdiff_t *chars)
+{
+ struct coding_system coding;
+ struct x_xim_text_conversion_data data;
+ Lisp_Object arg;
+ bool was_waiting_for_input_p;
+
+ data.coding = &coding;
+ data.source = text;
+ data.dpyinfo = dpyinfo;
+ data.size = size;
+
+ was_waiting_for_input_p = waiting_for_input;
+ /* Otherwise Fsignal will crash. */
+ waiting_for_input = false;
+
+ arg = make_mint_ptr (&data);
+ internal_condition_case_n (x_encode_xim_text_1, 1, &arg,
+ Qt, x_xim_text_to_utf8_unix_2);
+ waiting_for_input = was_waiting_for_input_p;
+
+ if (length)
+ *length = coding.produced;
+
+ if (chars)
+ *chars = coding.produced_char;
+
+ return (char *) coding.destination;
+}
+
static void
xic_preedit_draw_callback (XIC xic, XPointer client_data,
XIMPreeditDrawCallbackStruct *call_data)
@@ -3664,6 +3775,128 @@ xic_set_xfontset (struct frame *f, const char
*base_fontname)
FRAME_XIC_FONTSET (f) = xfs;
}
+
+
+/* String conversion support. See textconv.c for more details. */
+
+static void
+xic_string_conversion_callback (XIC ic, XPointer client_data,
+ XIMStringConversionCallbackStruct *call_data)
+{
+ struct textconv_callback_struct request;
+ ptrdiff_t length;
+ struct frame *f;
+ int rc;
+
+ /* Find the frame associated with this IC. */
+ f = x_xic_to_frame (ic);
+
+ if (!f)
+ goto failure;
+
+ /* Fill in CALL_DATA as early as possible. */
+ call_data->text->feedback = NULL;
+ call_data->text->encoding_is_wchar = False;
+
+ /* Now translate the conversion request to the format understood by
+ textconv.c. */
+ request.position = call_data->position;
+
+ switch (call_data->direction)
+ {
+ case XIMForwardChar:
+ request.direction = TEXTCONV_FORWARD_CHAR;
+ break;
+
+ case XIMBackwardChar:
+ request.direction = TEXTCONV_BACKWARD_CHAR;
+ break;
+
+ case XIMForwardWord:
+ request.direction = TEXTCONV_FORWARD_WORD;
+ break;
+
+ case XIMBackwardWord:
+ request.direction = TEXTCONV_BACKWARD_WORD;
+ break;
+
+ case XIMCaretUp:
+ request.direction = TEXTCONV_CARET_UP;
+ break;
+
+ case XIMCaretDown:
+ request.direction = TEXTCONV_CARET_DOWN;
+ break;
+
+ case XIMNextLine:
+ request.direction = TEXTCONV_NEXT_LINE;
+ break;
+
+ case XIMPreviousLine:
+ request.direction = TEXTCONV_PREVIOUS_LINE;
+ break;
+
+ case XIMLineStart:
+ request.direction = TEXTCONV_LINE_START;
+ break;
+
+ case XIMLineEnd:
+ request.direction = TEXTCONV_LINE_END;
+ break;
+
+ case XIMAbsolutePosition:
+ request.direction = TEXTCONV_ABSOLUTE_POSITION;
+ break;
+
+ default:
+ goto failure;
+ }
+
+ /* factor is signed in call_data but is actually a CARD16. */
+ request.factor = call_data->factor;
+
+ if (call_data->operation == XIMStringConversionSubstitution)
+ request.operation = TEXTCONV_SUBSTITUTION;
+ else
+ request.operation = TEXTCONV_RETRIEVAL;
+
+ /* Now perform the string conversion. */
+ rc = textconv_query (f, &request);
+
+ if (rc)
+ {
+ xfree (request.text.text);
+ goto failure;
+ }
+
+ /* Encode the text in the locale coding system and give it back to
+ the input method. */
+ request.text.text = NULL;
+ call_data->text->string.mbs
+ = x_encode_xim_text (FRAME_DISPLAY_INFO (f),
+ request.text.text,
+ request.text.bytes, NULL,
+ &length);
+ call_data->text->length = length;
+
+ /* Free the encoded text. This is always set to something
+ valid. */
+ xfree (request.text.text);
+
+ /* Detect failure. */
+ if (!call_data->text->string.mbs)
+ goto failure;
+
+ return;
+
+ failure:
+ /* Return a string of length 0 using the C library malloc. This
+ assumes XFree is able to free data allocated with our malloc
+ wrapper. */
+ call_data->text->length = 0;
+ call_data->text->string.mbs = malloc (0);
+}
+
#endif /* HAVE_X_I18N */
@@ -9771,6 +10004,53 @@ This should be called from a variable watcher for
`x-gtk-use-native-input'. */)
return Qnil;
}
+
+#if 0
+
+DEFUN ("x-test-string-conversion", Fx_test_string_conversion,
+ Sx_test_string_conversion, 5, 5, 0,
+ doc: /* Perform tests on the XIM string conversion support. */)
+ (Lisp_Object frame, Lisp_Object position,
+ Lisp_Object direction, Lisp_Object operation, Lisp_Object factor)
+{
+ struct frame *f;
+ XIMStringConversionCallbackStruct call_data;
+ XIMStringConversionText text;
+
+ f = decode_window_system_frame (frame);
+
+ if (!FRAME_XIC (f))
+ error ("No XIC on FRAME!");
+
+ CHECK_FIXNUM (position);
+ CHECK_FIXNUM (direction);
+ CHECK_FIXNUM (operation);
+ CHECK_FIXNUM (factor);
+
+ /* xic_string_conversion_callback (XIC ic, XPointer client_data,
+ XIMStringConversionCallbackStruct *call_data) */
+
+ call_data.position = XFIXNUM (position);
+ call_data.direction = XFIXNUM (direction);
+ call_data.operation = XFIXNUM (operation);
+ call_data.factor = XFIXNUM (factor);
+ call_data.text = &text;
+
+ block_input ();
+ xic_string_conversion_callback (FRAME_XIC (f), NULL,
+ &call_data);
+ unblock_input ();
+
+ /* Place a breakpoint here to inspect TEXT! */
+
+ while (1)
+ maybe_quit ();
+
+ return Qnil;
+}
+
+#endif
+
/***********************************************************************
Initialization
@@ -10217,6 +10497,9 @@ eliminated in future versions of Emacs. */);
defsubr (&Sx_display_set_last_user_time);
defsubr (&Sx_translate_coordinates);
defsubr (&Sx_get_modifier_masks);
+#if 0
+ defsubr (&Sx_test_string_conversion);
+#endif
tip_timer = Qnil;
staticpro (&tip_timer);
diff --git a/src/xterm.c b/src/xterm.c
index 1325d923be9..70bcb67d80d 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -636,6 +636,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "xterm.h"
#include <X11/cursorfont.h>
+#ifdef HAVE_X_I18N
+#include "textconv.h"
+#endif
+
#ifdef USE_XCB
#include <xcb/xproto.h>
#include <xcb/xcb.h>
@@ -5946,8 +5950,10 @@ void
x_end_cr_clip (struct frame *f)
{
cairo_restore (FRAME_CR_CONTEXT (f));
+#ifdef HAVE_XDBE
if (FRAME_X_DOUBLE_BUFFERED_P (f))
x_mark_frame_dirty (f);
+#endif
}
void
@@ -7482,8 +7488,10 @@ x_update_end (struct frame *f)
MOUSE_HL_INFO (f)->mouse_face_defer = false;
#ifdef USE_CAIRO
+# ifdef HAVE_XDBE
if (!FRAME_X_DOUBLE_BUFFERED_P (f) && FRAME_CR_CONTEXT (f))
cairo_surface_flush (cairo_get_target (FRAME_CR_CONTEXT (f)));
+# endif
#endif
/* If double buffering is disabled, finish the update here.
@@ -21137,8 +21145,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_flush (WINDOW_XFRAME (XWINDOW (bar->window)));
}
+#ifdef HAVE_XDBE
if (f && FRAME_X_DOUBLE_BUFFERED_P (f))
x_drop_xrender_surfaces (f);
+#endif
goto OTHER;
}
@@ -31506,7 +31516,37 @@ x_initialize (void)
XSetIOErrorHandler (x_io_error_quitter);
}
-#ifdef USE_GTK
+#ifdef HAVE_X_I18N
+
+/* Notice that a change has occured on F that requires its input
+ method state to be reset. */
+
+static void
+x_reset_conversion (struct frame *f)
+{
+ char *string;
+
+ if (FRAME_XIC (f))
+ {
+ string = XmbResetIC (FRAME_XIC (f));
+
+ /* string is actually any string that was being composed at the
+ time of the reset. */
+
+ if (string)
+ XFree (string);
+ }
+}
+
+/* Interface used to control input method ``text conversion''. */
+
+static struct textconv_interface text_conversion_interface =
+ {
+ x_reset_conversion,
+ };
+
+#endif
+
void
init_xterm (void)
{
@@ -31520,8 +31560,11 @@ init_xterm (void)
gdk_disable_multidevice ();
#endif
#endif
-}
+
+#ifdef HAVE_X_I18N
+ register_texconv_interface (&text_conversion_interface);
#endif
+}
void
mark_xterm (void)
diff --git a/src/xwidget.c b/src/xwidget.c
index efe27055629..7f30e48c954 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -3063,6 +3063,36 @@ DEFUN ("xwidget-webkit-title",
#endif
}
+DEFUN ("xwidget-webkit-estimated-load-progress",
+ Fxwidget_webkit_estimated_load_progress,
Sxwidget_webkit_estimated_load_progress,
+ 1, 1, 0, doc: /* Get the estimated load progress of XWIDGET, a WebKit
widget.
+Return a value ranging from 0.0 to 1.0, based on how close XWIDGET
+is to completely loading its page. */)
+ (Lisp_Object xwidget)
+{
+ struct xwidget *xw;
+#ifdef USE_GTK
+ WebKitWebView *webview;
+#endif
+ double value;
+
+ CHECK_LIVE_XWIDGET (xwidget);
+ xw = XXWIDGET (xwidget);
+ CHECK_WEBKIT_WIDGET (xw);
+
+ block_input ();
+#ifdef USE_GTK
+ webview = WEBKIT_WEB_VIEW (xw->widget_osr);
+ value = webkit_web_view_get_estimated_load_progress (webview);
+#elif defined NS_IMPL_COCOA
+ value = nsxwidget_webkit_estimated_load_progress (xw);
+#endif
+
+ unblock_input ();
+
+ return make_float (value);
+}
+
DEFUN ("xwidget-webkit-goto-uri",
Fxwidget_webkit_goto_uri, Sxwidget_webkit_goto_uri,
2, 2, 0,
@@ -3810,28 +3840,6 @@ LIMIT is not specified or nil, it is treated as `50'.
*/)
return list3 (back, here, forward);
}
-DEFUN ("xwidget-webkit-estimated-load-progress",
- Fxwidget_webkit_estimated_load_progress,
Sxwidget_webkit_estimated_load_progress,
- 1, 1, 0, doc: /* Get the estimated load progress of XWIDGET, a WebKit
widget.
-Return a value ranging from 0.0 to 1.0, based on how close XWIDGET
-is to completely loading its page. */)
- (Lisp_Object xwidget)
-{
- struct xwidget *xw;
- WebKitWebView *webview;
- double value;
-
- CHECK_LIVE_XWIDGET (xwidget);
- xw = XXWIDGET (xwidget);
- CHECK_WEBKIT_WIDGET (xw);
-
- block_input ();
- webview = WEBKIT_WEB_VIEW (xw->widget_osr);
- value = webkit_web_view_get_estimated_load_progress (webview);
- unblock_input ();
-
- return make_float (value);
-}
#endif
DEFUN ("xwidget-webkit-set-cookie-storage-file",
@@ -3874,19 +3882,23 @@ This will stop any data transfer that may still be in
progress inside
XWIDGET as part of loading a page. */)
(Lisp_Object xwidget)
{
-#ifdef USE_GTK
struct xwidget *xw;
+#ifdef USE_GTK
WebKitWebView *webview;
+#endif
CHECK_LIVE_XWIDGET (xwidget);
xw = XXWIDGET (xwidget);
CHECK_WEBKIT_WIDGET (xw);
block_input ();
+#ifdef USE_GTK
webview = WEBKIT_WEB_VIEW (xw->widget_osr);
webkit_web_view_stop_loading (webview);
- unblock_input ();
+#elif defined NS_IMPL_COCOA
+ nsxwidget_webkit_stop_loading (xw);
#endif
+ unblock_input ();
return Qnil;
}
@@ -3936,8 +3948,9 @@ syms_of_xwidget (void)
#ifdef USE_GTK
defsubr (&Sxwidget_webkit_load_html);
defsubr (&Sxwidget_webkit_back_forward_list);
- defsubr (&Sxwidget_webkit_estimated_load_progress);
#endif
+
+ defsubr (&Sxwidget_webkit_estimated_load_progress);
defsubr (&Skill_xwidget);
DEFSYM (QCxwidget, ":xwidget");
diff --git a/test/lisp/calendar/lunar-tests.el
b/test/lisp/calendar/lunar-tests.el
index 0d66403e3b6..e19965d1034 100644
--- a/test/lisp/calendar/lunar-tests.el
+++ b/test/lisp/calendar/lunar-tests.el
@@ -41,23 +41,26 @@
(should (equal (lunar-phase 1)
'((1 8 1900) "05:40" 1 "")))))
-(ert-deftest lunar-test-eclipse-check ()
+(ert-deftest lunar-test-check-for-eclipse ()
(with-lunar-test
- (should (equal (eclipse-check 1 1) "** Eclipse **"))))
+ (should (equal (lunar-check-for-eclipse 10.0 1) ""))
+ (should (equal (lunar-check-for-eclipse 10.0 2) "** Lunar Eclipse **"))))
(ert-deftest lunar-test-phase-list ()
(with-lunar-test
- (should (equal (lunar-phase-list 3 1871)
- '(((3 21 1871) "04:03" 0 "")
- ((3 29 1871) "06:46" 1 "** Eclipse **")
- ((4 5 1871) "14:20" 2 "")
- ((4 12 1871) "05:57" 3 "** Eclipse possible **")
- ((4 19 1871) "19:06" 0 "")
- ((4 27 1871) "23:49" 1 "")
- ((5 4 1871) "22:57" 2 "")
- ((5 11 1871) "14:29" 3 "")
- ((5 19 1871) "10:46" 0 "")
- ((5 27 1871) "13:02" 1 ""))))))
+ (should (equal (lunar-phase-list 9 2023)
+ '(((9 6 2023) "22:27" 3 "")
+ ((9 15 2023) "01:40" 0 "")
+ ((9 22 2023) "19:33" 1 "")
+ ((9 29 2023) "09:54" 2 "** Lunar Eclipse possible **")
+ ((10 6 2023) "13:53" 3 "")
+ ((10 14 2023) "17:55" 0 "** Solar Eclipse **")
+ ((10 22 2023) "03:30" 1 "")
+ ((10 28 2023) "20:20" 2 "** Lunar Eclipse **")
+ ((11 5 2023) "08:42" 3 "")
+ ((11 13 2023) "09:27" 0 "")
+ ((11 20 2023) "10:51" 1 "")
+ ((11 27 2023) "09:13" 2 ""))))))
(ert-deftest lunar-test-new-moon-time ()
(with-lunar-test
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 2fdf7389fc1..10b009a261c 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -757,6 +757,15 @@ inner loops respectively."
(bytecomp-test-identity 3)
(error 'bad)
(:success)) ; empty handler
+
+ ;; `cond' miscompilation bug
+ (let ((fn (lambda (x)
+ (let ((y nil))
+ (cond ((progn (setq x (1+ x)) (> x 10)) (setq y 'a))
+ ((eq x 1) (setq y 'b))
+ ((eq x 2) (setq y 'c)))
+ (list x y)))))
+ (mapcar fn (bytecomp-test-identity '(0 1 2 3 10 11))))
)
"List of expressions for cross-testing interpreted and compiled code.")
@@ -886,19 +895,28 @@ byte-compiled. Run with dynamic binding."
;; Should not warn that mt--test2 is not known to be defined.
(should-not (re-search-forward "my--test2" nil t))))
-(defmacro bytecomp--with-warning-test (re-warning form)
+(defun bytecomp--with-warning-test (re-warning form)
(declare (indent 1))
- `(with-current-buffer (get-buffer-create "*Compile-Log*")
+ (with-current-buffer (get-buffer-create "*Compile-Log*")
(let ((inhibit-read-only t)) (erase-buffer))
(let ((text-quoting-style 'grave)
- (macroexp--warned
- (make-hash-table :test #'equal :weakness 'key)) ; oh dear
- (form ,form))
+ (macroexp--warned ; oh dear
+ (make-hash-table :test #'equal :weakness 'key)))
(ert-info ((prin1-to-string form) :prefix "form: ")
(byte-compile form)
(ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ")
(should (re-search-forward
- (string-replace " " "[ \n]+" ,re-warning))))))))
+ (string-replace " " "[ \n]+" re-warning))))))))
+
+(ert-deftest bytecomp-warn--ignore ()
+ (bytecomp--with-warning-test "unused"
+ '(lambda (y) 6))
+ (bytecomp--with-warning-test "\\`\\'" ;No warning!
+ '(lambda (y) (ignore y) 6))
+ (bytecomp--with-warning-test "assq"
+ '(lambda (x y) (progn (assq x y) 5)))
+ (bytecomp--with-warning-test "\\`\\'" ;No warning!
+ '(lambda (x y) (progn (ignore (assq x y)) 5))))
(ert-deftest bytecomp-warn-wrong-args ()
(bytecomp--with-warning-test "remq.*3.*2"
@@ -1213,7 +1231,8 @@ byte-compiled. Run with dynamic binding."
literals (Bug#20852)."
(should (boundp 'lread--unescaped-character-literals))
(let ((byte-compile-error-on-warn t)
- (byte-compile-debug t))
+ (byte-compile-debug t)
+ (text-quoting-style 'grave))
(bytecomp-tests--with-temp-file source
(write-region "(list ?) ?( ?; ?\" ?[ ?])" nil source)
(bytecomp-tests--with-temp-file destination
@@ -1332,6 +1351,7 @@ literals (Bug#20852)."
(defun test-suppression (form suppress match)
(let ((lexical-binding t)
+ (text-quoting-style 'grave)
(byte-compile-log-buffer (generate-new-buffer " *Compile-Log*")))
;; Check that we get a warning without suppression.
(with-current-buffer byte-compile-log-buffer
@@ -1435,6 +1455,12 @@ literals (Bug#20852)."
'((suspicious set-buffer))
"Warning: Use .with-current-buffer. rather than")
+ (test-suppression
+ '(defun zot (x)
+ (condition-case nil (list x)))
+ '((suspicious condition-case))
+ "Warning: `condition-case' without handlers")
+
(test-suppression
'(defun zot ()
(let ((_ 1))
diff --git a/test/lisp/emacs-lisp/cconv-tests.el
b/test/lisp/emacs-lisp/cconv-tests.el
index 83013cf46a9..6facd3452ea 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -364,5 +364,30 @@
(call-interactively f))
'((t 51696) (nil 51695) (t 51697)))))))
+(ert-deftest cconv-safe-for-space ()
+ (let* ((magic-string "This-is-a-magic-string")
+ (safe-p (lambda (x) (not (string-match magic-string (format "%S"
x))))))
+ (should (funcall safe-p (lambda (x) (+ x 1))))
+ (should (funcall safe-p (eval '(lambda (x) (+ x 1))
+ `((y . ,magic-string)))))
+ (should (funcall safe-p (eval '(lambda (x) :closure-dont-trim-context)
+ `((y . ,magic-string)))))
+ (should-not (funcall safe-p
+ (eval '(lambda (x) :closure-dont-trim-context (+ x 1))
+ `((y . ,magic-string)))))))
+
+(ert-deftest cconv-tests-interactive-form-modify-bug60974 ()
+ (let* ((f '(function (lambda (&optional arg)
+ (interactive
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle)))
+ (ignore arg))))
+ (if (cadr (nth 2 (cadr f))))
+ (if2))
+ (cconv-closure-convert f)
+ (setq if2 (cadr (nth 2 (cadr f))))
+ (should (eq if if2))))
+
(provide 'cconv-tests)
;;; cconv-tests.el ends here
diff --git a/test/lisp/emacs-lisp/nadvice-tests.el
b/test/lisp/emacs-lisp/nadvice-tests.el
index 987483f00b1..716ab694e2c 100644
--- a/test/lisp/emacs-lisp/nadvice-tests.el
+++ b/test/lisp/emacs-lisp/nadvice-tests.el
@@ -29,6 +29,7 @@
(advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 2)))
(advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
(defun sm-test1 (x) (+ x 4))
+ (declare-function sm-test1 nil)
(should (equal (sm-test1 6) 20))
(advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 2)))
(should (equal (sm-test1 6) 10))
@@ -62,6 +63,7 @@
(ert-deftest advice-tests-advice ()
"Test advice code."
(defun sm-test2 (x) (+ x 4))
+ (declare-function sm-test2 nil)
(should (equal (sm-test2 6) 10))
(defadvice sm-test2 (around sm-test activate)
ad-do-it (setq ad-return-value (* ad-return-value 5)))
@@ -94,6 +96,7 @@
(ert-deftest advice-tests-combination ()
"Combining old style and new style advices."
(defun sm-test5 (x) (+ x 4))
+ (declare-function sm-test5 nil)
(should (equal (sm-test5 6) 10))
(advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5)))
(should (equal (sm-test5 6) 50))
@@ -112,6 +115,7 @@
(ert-deftest advice-test-called-interactively-p ()
"Check interaction between advice and called-interactively-p."
(defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4))
+ (declare-function sm-test7 nil)
(advice-add 'sm-test7 :around
(lambda (f &rest args)
(list (cons 1 (called-interactively-p)) (apply f args))))
@@ -119,7 +123,7 @@
(should (equal (call-interactively 'sm-test7) '((1 . t) 11)))
(let ((smi 7))
(advice-add 'sm-test7 :before
- (lambda (&rest args)
+ (lambda (&rest _args)
(setq smi (called-interactively-p))))
(should (equal (list (sm-test7) smi)
'(((1 . nil) 11) nil)))
@@ -137,6 +141,7 @@ This tests the currently broken case of the innermost
advice to a
function being an around advice."
:expected-result :failed
(defun sm-test7.2 () (interactive) (cons 1 (called-interactively-p)))
+ (declare-function sm-test7.2 nil)
(advice-add 'sm-test7.2 :around
(lambda (f &rest args)
(list (cons 1 (called-interactively-p)) (apply f args))))
@@ -147,6 +152,7 @@ function being an around advice."
"Check interaction between filter-args advice and called-interactively-p."
:expected-result :failed
(defun sm-test7.3 () (interactive) (cons 1 (called-interactively-p)))
+ (declare-function sm-test7.3 nil)
(advice-add 'sm-test7.3 :filter-args #'list)
(should (equal (sm-test7.3) '(1 . nil)))
(should (equal (call-interactively 'sm-test7.3) '(1 . t))))
diff --git a/test/lisp/erc/erc-scenarios-base-reuse-buffers.el
b/test/lisp/erc/erc-scenarios-base-reuse-buffers.el
index d23a0b35904..71027a0c138 100644
--- a/test/lisp/erc/erc-scenarios-base-reuse-buffers.el
+++ b/test/lisp/erc/erc-scenarios-base-reuse-buffers.el
@@ -63,42 +63,6 @@ collisions involving bouncers in ERC. Run EXTRA."
(should (cdr (erc-scenarios-common-buflist "127.0.0.1"))))
(when more (funcall more port))))
-;; XXX maybe remove: already covered many times over by other scenarios
-(ert-deftest erc-scenarios-base-reuse-buffers-server-buffers--enabled ()
- :tags '(:expensive-test)
- (with-suppressed-warnings ((obsolete erc-reuse-buffers))
- (should erc-reuse-buffers))
- (let ((erc-scenarios-common-dialog "base/reuse-buffers/server"))
- (erc-scenarios-common-with-cleanup
- ((dumb-server (erc-d-run "localhost" t 'foonet 'barnet))
- (port (process-contact dumb-server :service))
- erc-autojoin-channels-alist)
-
- (ert-info ("Connect to foonet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "foonet:changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (erc-d-t-search-for 12 "marked as being away")))
-
- (ert-info ("Connect to barnet")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :password "barnet:changeme"
- :full-name "tester")
- (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
- (erc-d-t-search-for 45 "marked as being away")))
-
- (erc-d-t-wait-for 2 (get-buffer "foonet"))
- (erc-d-t-wait-for 2 (get-buffer "barnet"))
-
- (ert-info ("Server buffers are unique, no IP-based names")
- (should-not (eq (get-buffer "foonet") (get-buffer "barnet")))
- (should-not (erc-scenarios-common-buflist "127.0.0.1"))))))
-
;; FIXME no sense in running this twice (JOIN variant includes this)
(ert-deftest erc-scenarios-base-reuse-buffers-server-buffers--disabled ()
:tags '(:expensive-test)
diff --git a/test/lisp/erc/erc-scenarios-internal.el
b/test/lisp/erc/erc-scenarios-internal.el
index 8d38c2dde49..18eb94e24b0 100644
--- a/test/lisp/erc/erc-scenarios-internal.el
+++ b/test/lisp/erc/erc-scenarios-internal.el
@@ -21,6 +21,9 @@
(require 'ert-x)
(eval-and-compile
+ (when (and (getenv "EMACS_TEST_DIRECTORY")
+ (getenv "EMACS_TEST_JUNIT_REPORT"))
+ (setq ert-load-file-name (or (macroexp-file-name) buffer-file-name)))
(let ((load-path (cons (expand-file-name "erc-d" (ert-resource-directory))
load-path)))
(load "erc-d-tests" nil 'silent)))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..d6c63934163 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -147,7 +147,7 @@
(should (looking-at-p (regexp-quote erc-prompt)))
(setq erc-server-process (buffer-local-value 'erc-server-process
(get-buffer "ServNet"))
- erc-default-recipients '("#chan")))
+ erc--target (erc--target-from-string "#chan")))
(with-current-buffer (get-buffer-create "bob")
(erc-tests--send-prep)
@@ -155,7 +155,7 @@
(should (looking-at-p (regexp-quote erc-prompt)))
(setq erc-server-process (buffer-local-value 'erc-server-process
(get-buffer "ServNet"))
- erc-default-recipients '("bob")))
+ erc--target (erc--target-from-string "bob")))
(ert-info ("Value: t (default)")
(should (eq erc-hide-prompt t))
diff --git a/test/lisp/eshell/em-cmpl-tests.el
b/test/lisp/eshell/em-cmpl-tests.el
index 12a156fbb38..be2199c0464 100644
--- a/test/lisp/eshell/em-cmpl-tests.el
+++ b/test/lisp/eshell/em-cmpl-tests.el
@@ -183,6 +183,31 @@ See <lisp/eshell/esh-var.el>."
(should (equal (eshell-insert-and-complete "echo $system-nam")
"echo $system-name "))))
+(ert-deftest em-cmpl-test/quoted-variable-ref-completion ()
+ "Test completion of variable references like \"$'var'\".
+See <lisp/eshell/esh-var.el>."
+ (with-temp-eshell
+ (should (equal (eshell-insert-and-complete "echo $'system-nam")
+ "echo $'system-name' ")))
+ (with-temp-eshell
+ (should (equal (eshell-insert-and-complete "echo $\"system-nam")
+ "echo $\"system-name\" "))))
+
+(ert-deftest em-cmpl-test/variable-ref-completion/directory ()
+ "Test completion of variable references that expand to directories.
+See <lisp/eshell/esh-var.el>."
+ (with-temp-eshell
+ (should (equal (eshell-insert-and-complete "echo $PW")
+ "echo $PWD/")))
+ (with-temp-eshell
+ (let ((minibuffer-message-timeout 0)
+ (inhibit-message t))
+ (should (equal (eshell-insert-and-complete "echo $PWD")
+ "echo $PWD/"))))
+ (with-temp-eshell
+ (should (equal (eshell-insert-and-complete "echo $'PW")
+ "echo $'PWD'/"))))
+
(ert-deftest em-cmpl-test/variable-assign-completion ()
"Test completion of variable assignments like \"var=value\".
See <lisp/eshell/esh-var.el>."
@@ -192,16 +217,29 @@ See <lisp/eshell/esh-var.el>."
(should (equal (eshell-insert-and-complete "VAR=f")
"VAR=file.txt ")))))
+(ert-deftest em-cmpl-test/variable-assign-completion/non-assignment ()
+ "Test completion of things that look like variable assignment, but aren't.
+For example, the second argument in \"tar --directory=dir\" looks
+like it could be a variable assignment, but it's not. We should
+let `pcomplete-tar' handle it instead.
+
+See <lisp/eshell/esh-var.el>."
+ (with-temp-eshell
+ (ert-with-temp-directory default-directory
+ (write-region nil nil (expand-file-name "file.txt"))
+ (make-directory "dir")
+ (should (equal (eshell-insert-and-complete "tar --directory=")
+ "tar --directory=dir/")))))
+
(ert-deftest em-cmpl-test/user-ref-completion ()
- "Test completeion of user references like \"~user\".
+ "Test completion of user references like \"~user\".
See <lisp/eshell/em-dirs.el>."
(unwind-protect
(with-temp-eshell
(cl-letf (((symbol-function 'eshell-read-user-names)
(lambda () (setq eshell-user-names '((1234 . "user"))))))
- ;; FIXME: Should this really add a space at the end?
(should (equal (eshell-insert-and-complete "echo ~us")
- "echo ~user/ "))))
+ "echo ~user/"))))
;; Clear the cached user names we set above.
(setq eshell-user-names nil)))
diff --git a/test/lisp/eshell/em-prompt-tests.el
b/test/lisp/eshell/em-prompt-tests.el
index db45e2ae3a7..257549e40fb 100644
--- a/test/lisp/eshell/em-prompt-tests.el
+++ b/test/lisp/eshell/em-prompt-tests.el
@@ -54,8 +54,8 @@
(should (equal last-input "echo hello\n"))
(should (equal-including-properties
last-output
- (propertize "hello\n" 'rear-nonsticky '(field)
- 'field 'command-output))))))
+ (apply #'propertize "hello\n"
+ eshell-command-output-properties))))))
(ert-deftest em-prompt-test/field-properties/no-highlight ()
"Check that field properties are properly set on Eshell output/prompts.
@@ -77,8 +77,8 @@ This tests the case when `eshell-highlight-prompt' is nil."
(should (equal last-input "echo hello\n"))
(should (equal-including-properties
last-output
- (propertize "hello\n" 'rear-nonsticky '(field)
- 'field 'command-output)))))))
+ (apply #'propertize "hello\n"
+ eshell-command-output-properties)))))))
(ert-deftest em-prompt-test/next-previous-prompt ()
"Check that navigating forward/backward through old prompts works correctly."
diff --git a/test/lisp/eshell/esh-cmd-tests.el
b/test/lisp/eshell/esh-cmd-tests.el
index bcecc9a531f..94763954622 100644
--- a/test/lisp/eshell/esh-cmd-tests.el
+++ b/test/lisp/eshell/esh-cmd-tests.el
@@ -73,6 +73,23 @@ Test that trailing arguments outside the subcommand are
ignored.
e.g. \"{(+ 1 2)} 3\" => 3"
(eshell-command-result-equal "{(+ 1 2)} 3" 3))
+(ert-deftest esh-cmd-test/let-rebinds-after-defer ()
+ "Test that let-bound values are properly updated after `eshell-defer'.
+When inside a `let' block in an Eshell command form, we need to
+ensure that deferred commands update any let-bound variables so
+they have the correct values when resuming evaluation. See
+bug#59469."
+ (skip-unless (executable-find "echo"))
+ (with-temp-eshell
+ (eshell-match-command-output
+ (concat "{"
+ " export LOCAL=value; "
+ " echo \"$LOCAL\"; "
+ " *echo external; " ; This will throw `eshell-defer'.
+ " echo \"$LOCAL\"; "
+ "}")
+ "value\nexternal\nvalue\n")))
+
;; Lisp forms
diff --git a/test/lisp/eshell/eshell-tests-unload.el
b/test/lisp/eshell/eshell-tests-unload.el
new file mode 100644
index 00000000000..cdd58efef18
--- /dev/null
+++ b/test/lisp/eshell/eshell-tests-unload.el
@@ -0,0 +1,99 @@
+;;; eshell-tests-unload.el --- test unloading Eshell -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 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:
+
+;; Tests for unloading Eshell.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+
+;; In order to test unloading Eshell, don't require any of its files
+;; at the top level. This means we need to explicitly declare some of
+;; the variables and functions we'll use.
+(defvar eshell-directory-name)
+(defvar eshell-history-file-name)
+(defvar eshell-last-dir-ring-file-name)
+(defvar eshell-modules-list)
+
+(declare-function eshell-module--feature-name "esh-module"
+ (module &optional kind))
+(declare-function eshell-subgroups "esh-util" (groupsym))
+
+(defvar max-unload-time 5
+ "The maximum amount of time to wait to unload Eshell modules, in seconds.
+See `unload-eshell'.")
+
+(defun load-eshell ()
+ "Load Eshell by calling the `eshell' function and immediately closing it."
+ (save-current-buffer
+ (ert-with-temp-directory eshell-directory-name
+ (let* (;; We want no history file, so prevent Eshell from falling
+ ;; back on $HISTFILE.
+ (process-environment (cons "HISTFILE" process-environment))
+ (eshell-history-file-name nil)
+ (eshell-last-dir-ring-file-name nil)
+ (eshell-buffer (eshell t)))
+ (let (kill-buffer-query-functions)
+ (kill-buffer eshell-buffer))))))
+
+(defun unload-eshell ()
+ "Unload Eshell, waiting until the core modules are unloaded as well."
+ (let ((debug-on-error t)
+ (inhibit-message t))
+ (unload-feature 'eshell)
+ ;; We unload core modules are unloaded from a timer, since they
+ ;; need to wait until after `eshell' itself is unloaded. Wait for
+ ;; this to finish.
+ (let ((start (current-time)))
+ (while (featurep 'esh-arg)
+ (when (> (float-time (time-since start))
+ max-unload-time)
+ (error "timed out waiting to unload Eshell modules"))
+ (sit-for 0.1)))))
+
+;;; Tests:
+
+(ert-deftest eshell-test-unload/default ()
+ "Test unloading Eshell with the default list of extension modules."
+ (load-eshell)
+ (unload-eshell))
+
+(ert-deftest eshell-test-unload/no-modules ()
+ "Test unloading Eshell with no extension modules."
+ (require 'esh-module)
+ (let (eshell-modules-list)
+ (load-eshell))
+ (dolist (module (eshell-subgroups 'eshell-module))
+ (should-not (featurep (intern (eshell-module--feature-name module)))))
+ (unload-eshell))
+
+(ert-deftest eshell-test-unload/all-modules ()
+ "Test unloading Eshell with every extension module."
+ (require 'esh-module)
+ (let ((eshell-modules-list (eshell-subgroups 'eshell-module)))
+ (load-eshell))
+ (dolist (module (eshell-subgroups 'eshell-module))
+ (should (featurep (intern (eshell-module--feature-name module)))))
+ (unload-eshell))
+
+(provide 'eshell-tests-unload)
+;;; eshell-tests-unload.el ends here
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index 776cfb9b92f..743cc28b9b5 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -34,6 +34,8 @@
(file-name-directory (or load-file-name
default-directory))))
+(defvar eshell-test-value nil)
+
;;; Tests:
(ert-deftest eshell-test/pipe-headproc ()
@@ -160,6 +162,32 @@ insert the queued one at the next prompt, and finally run
it."
(beginning-of-line))
(should (string= (eshell-get-old-input) "echo alpha"))))
+(ert-deftest eshell-test/get-old-input/rerun-command ()
+ "Test that we can rerun an old command when point is on it."
+ (with-temp-eshell
+ (let ((eshell-test-value "first"))
+ (eshell-match-command-output "echo $eshell-test-value" "first"))
+ ;; Go to the previous prompt.
+ (forward-line -2)
+ (let ((inhibit-field-text-motion t))
+ (end-of-line))
+ ;; Rerun the command, but with a different variable value.
+ (let ((eshell-test-value "second"))
+ (eshell-send-input))
+ (eshell-match-output "second")))
+
+(ert-deftest eshell-test/get-old-input/run-output ()
+ "Test that we can run a line of output as a command when point is on it."
+ (with-temp-eshell
+ (eshell-match-command-output "echo \"echo there\"" "echo there")
+ ;; Go to the output, and insert "hello" after "echo".
+ (forward-line -1)
+ (forward-word)
+ (insert " hello")
+ ;; Run the line as a command.
+ (eshell-send-input)
+ (eshell-match-output "(\"hello\" \"there\")")))
+
(provide 'eshell-tests)
;;; eshell-tests.el ends here
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 4d715cde1d5..243a45ae6d2 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -180,10 +180,6 @@ Return first line of the output of (describe-function-1
FUNC)."
(ert-deftest help-fns--analyze-function-recursive ()
(defalias 'help-fns--a 'help-fns--b)
- (should (equal (help-fns--analyze-function 'help-fns--a)
- '(help-fns--a help-fns--b t help-fns--b)))
- ;; Make a loop and see that it doesn't infloop.
- (defalias 'help-fns--b 'help-fns--a)
(should (equal (help-fns--analyze-function 'help-fns--a)
'(help-fns--a help-fns--b t help-fns--b))))
diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el
index aeb08ecbb29..794a3b1d0c2 100644
--- a/test/lisp/hi-lock-tests.el
+++ b/test/lisp/hi-lock-tests.el
@@ -86,13 +86,18 @@
(unhighlight-regexp "a a")
(should (= (length (overlays-in (point-min) (point-max))) 0))
- (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp
"a a"))
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (highlight-regexp "a a"))
(should (= (length (overlays-in (point-min) (point-max))) 1))
- (cl-letf (((symbol-function 'completing-read)
- (lambda (_prompt _coll
- &optional _x _y _z _hist defaults _inherit)
- (car defaults))))
- (call-interactively 'unhighlight-regexp))
+ ;; We bind use-dialog-box to nil to prevent unhighlight-regexp
+ ;; from using popup menus, since the replacement for
+ ;; completing-read below is not ready for that calamity
+ (let ((use-dialog-box nil))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll
+ &optional _x _y _z _hist defaults _inherit)
+ (car defaults))))
+ (call-interactively 'unhighlight-regexp)))
(should (= (length (overlays-in (point-min) (point-max))) 0))
(emacs-lisp-mode)
@@ -142,12 +147,16 @@
(let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp
"a a"))
(font-lock-ensure)
(should (memq 'hi-yellow (get-text-property 1 'face)))
- (cl-letf (((symbol-function 'completing-read)
- (lambda (_prompt _coll
- &optional _x _y _z _hist defaults _inherit)
- (car defaults)))
- (font-lock-fontified t))
- (call-interactively 'unhighlight-regexp))
+ ;; We bind use-dialog-box to nil to prevent unhighlight-regexp
+ ;; from using popup menus, since the replacement for
+ ;; completing-read below is not ready for that calamity
+ (let ((use-dialog-box nil))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll
+ &optional _x _y _z _hist defaults _inherit)
+ (car defaults)))
+ (font-lock-fontified t))
+ (call-interactively 'unhighlight-regexp)))
(should (null (get-text-property 1 'face))))))
(ert-deftest hi-lock-unhighlight ()
@@ -156,58 +165,64 @@
(with-temp-buffer
(insert "aAbB\n")
- (cl-letf (((symbol-function 'completing-read)
- (lambda (_prompt _coll
- &optional _x _y _z _hist defaults _inherit)
- (car defaults))))
-
- (highlight-regexp "a")
- (highlight-regexp "b")
- (should (= (length (overlays-in (point-min) (point-max))) 4))
- ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
- ;; not the last regexp "b"
- (goto-char 1)
- (call-interactively 'unhighlight-regexp)
- (should (= (length (overlays-in 1 3)) 0))
- (should (= (length (overlays-in 3 5)) 2))
- ;; Next call should unhighlight remaining regepxs
- (call-interactively 'unhighlight-regexp)
- (should (= (length (overlays-in 3 5)) 0))
-
- ;; Test unhighlight all
- (highlight-regexp "a")
- (highlight-regexp "b")
- (should (= (length (overlays-in (point-min) (point-max))) 4))
- (unhighlight-regexp t)
- (should (= (length (overlays-in (point-min) (point-max))) 0))
-
- (emacs-lisp-mode)
- (setq font-lock-mode t)
-
- (highlight-regexp "a")
- (highlight-regexp "b")
- (font-lock-ensure)
- (should (memq 'hi-yellow (get-text-property 1 'face)))
- (should (memq 'hi-yellow (get-text-property 3 'face)))
- ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
- ;; not the last regexp "b"
- (goto-char 1)
- (let ((font-lock-fontified t)) (call-interactively
'unhighlight-regexp))
- (should (null (get-text-property 1 'face)))
- (should (memq 'hi-yellow (get-text-property 3 'face)))
- ;; Next call should unhighlight remaining regepxs
- (let ((font-lock-fontified t)) (call-interactively
'unhighlight-regexp))
- (should (null (get-text-property 3 'face)))
-
- ;; Test unhighlight all
- (highlight-regexp "a")
- (highlight-regexp "b")
- (font-lock-ensure)
- (should (memq 'hi-yellow (get-text-property 1 'face)))
- (should (memq 'hi-yellow (get-text-property 3 'face)))
- (let ((font-lock-fontified t)) (unhighlight-regexp t))
- (should (null (get-text-property 1 'face)))
- (should (null (get-text-property 3 'face)))))))
+ ;; We bind use-dialog-box to nil to prevent unhighlight-regexp
+ ;; from using popup menus, since the replacement for
+ ;; completing-read below is not ready for that calamity
+ (let ((use-dialog-box nil))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll
+ &optional _x _y _z _hist defaults _inherit)
+ (car defaults))))
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (should (= (length (overlays-in (point-min) (point-max))) 4))
+ ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
+ ;; not the last regexp "b"
+ (goto-char 1)
+ (call-interactively 'unhighlight-regexp)
+ (should (= (length (overlays-in 1 3)) 0))
+ (should (= (length (overlays-in 3 5)) 2))
+ ;; Next call should unhighlight remaining regepxs
+ (call-interactively 'unhighlight-regexp)
+ (should (= (length (overlays-in 3 5)) 0))
+
+ ;; Test unhighlight all
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (should (= (length (overlays-in (point-min) (point-max))) 4))
+ (unhighlight-regexp t)
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (emacs-lisp-mode)
+ (setq font-lock-mode t)
+
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
+ ;; not the last regexp "b"
+ (goto-char 1)
+ (let ((font-lock-fontified t))
+ (call-interactively 'unhighlight-regexp))
+ (should (null (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ ;; Next call should unhighlight remaining regepxs
+ (let ((font-lock-fontified t))
+ (call-interactively 'unhighlight-regexp))
+ (should (null (get-text-property 3 'face)))
+
+ ;; Test unhighlight all
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t))
+ (unhighlight-regexp t))
+ (should (null (get-text-property 1 'face)))
+ (should (null (get-text-property 3 'face))))))))
(provide 'hi-lock-tests)
;;; hi-lock-tests.el ends here
diff --git a/test/lisp/international/mule-tests.el
b/test/lisp/international/mule-tests.el
index 6e23d8c5421..3e0c5bf9f4b 100644
--- a/test/lisp/international/mule-tests.el
+++ b/test/lisp/international/mule-tests.el
@@ -99,7 +99,7 @@ provide HTML fragments. Some tests override those variables."
(ert-deftest sgml-html-meta-utf-8 ()
"Baseline: UTF-8."
- (should (eq 'utf-8 (sgml-html-meta-run "utf-8"))))
+ (should (eq 'utf-8 (coding-system-base (sgml-html-meta-run "utf-8")))))
(ert-deftest sgml-html-meta-windows-hebrew ()
"A non-Unicode charset."
@@ -119,9 +119,10 @@ provide HTML fragments. Some tests override those
variables."
(ert-deftest sgml-html-meta-no-post-less-than-10lines ()
"No '</head>', detect charset in the first 10 lines."
(let ((sgml-html-meta-post ""))
- (should (eq 'utf-8 (sgml-html-meta-run
- (concat "\n\n\n\n\n\n\n\n\n"
- "<meta charset='utf-8'>"))))))
+ (should (eq 'utf-8 (coding-system-base
+ (sgml-html-meta-run
+ (concat "\n\n\n\n\n\n\n\n\n"
+ "<meta charset='utf-8'>")))))))
(ert-deftest sgml-html-meta-no-post-10lines ()
"No '</head>', do not detect charset after the first 10 lines."
diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el
index 551fd8b60fc..a325220e8d9 100644
--- a/test/lisp/kmacro-tests.el
+++ b/test/lisp/kmacro-tests.el
@@ -614,6 +614,20 @@ This is a regression test for: Bug#3412, Bug#11817."
(kmacro-tests-should-insert "bb"
(kmacro-tests-simulate-command '(kmacro-tests-symbol-for-test))))
+;; Bug#61700 inserting named macro when the definition contains things
+;; that `key-parse' thinks are named keys
+(kmacro-tests-deftest kmacro-tests-name-last-macro-key-parse-syntax ()
+ "Name last macro can rebind a symbol it binds."
+ ;; Make sure our symbol is unbound.
+ (when (fboundp 'kmacro-tests-symbol-for-test)
+ (fmakunbound 'kmacro-tests-symbol-for-test))
+ (setplist 'kmacro-tests-symbol-for-test nil)
+ (kmacro-tests-define-macro "<b> hello </>")
+ (kmacro-name-last-macro 'kmacro-tests-symbol-for-test)
+ ;; Now run the function bound to the symbol.
+ (kmacro-tests-should-insert "<b> hello </>"
+ (kmacro-tests-simulate-command '(kmacro-tests-symbol-for-test))))
+
(kmacro-tests-deftest kmacro-tests-store-in-register ()
"Macro can be stored in and retrieved from a register."
(use-local-map kmacro-tests-keymap)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index cc93970be28..b6ad2e2f219 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2530,7 +2530,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(rx bos))
tramp--test-messages))))))
- ;; We do not test lockname here. See
+ ;; We do not test the lock file here. See
;; `tramp-test39-make-lock-file-name'.
;; Do not overwrite if excluded.
@@ -4524,29 +4524,28 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(let ((tramp-fuse-remove-hidden-files t)
(method (file-remote-p ert-remote-temporary-file-directory 'method))
(host (file-remote-p ert-remote-temporary-file-directory 'host))
- (orig-syntax tramp-syntax))
+ (orig-syntax tramp-syntax)
+ (minibuffer-completing-file-name t))
(when (and (stringp host) (string-match tramp-host-with-port-regexp
host))
(setq host (match-string 1 host)))
(unwind-protect
- (dolist
- (syntax
- (if (tramp--test-expensive-test-p)
- (tramp-syntax-values) `(,orig-syntax)))
+ (dolist (syntax (if (tramp--test-expensive-test-p)
+ (tramp-syntax-values) `(,orig-syntax)))
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
;; for completion. We must refill the cache.
(tramp-set-connection-property tramp-test-vec "property" nil)
- (let ;; This is needed for the `separate' syntax.
- ((prefix-format (substring tramp-prefix-format 1))
- ;; This is needed for the IPv6 host name syntax.
- (ipv6-prefix
- (and (string-match-p tramp-ipv6-regexp host)
- tramp-prefix-ipv6-format))
- (ipv6-postfix
- (and (string-match-p tramp-ipv6-regexp host)
- tramp-postfix-ipv6-format)))
+ (let (;; This is needed for the `separate' syntax.
+ (prefix-format (substring tramp-prefix-format 1))
+ ;; This is needed for the IPv6 host name syntax.
+ (ipv6-prefix
+ (and (string-match-p tramp-ipv6-regexp host)
+ tramp-prefix-ipv6-format))
+ (ipv6-postfix
+ (and (string-match-p tramp-ipv6-regexp host)
+ tramp-postfix-ipv6-format)))
;; Complete method name.
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp))
@@ -4558,8 +4557,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; Complete host name.
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp)
- (tramp-string-empty-or-nil-p host)
- (tramp--test-gvfs-p method))
+ (tramp-string-empty-or-nil-p host))
(should
(member
(concat
@@ -4592,6 +4590,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(should (equal (file-name-completion "foo" tmp-name) t))
(should (equal (file-name-completion "b" tmp-name) "bo"))
(should-not (file-name-completion "a" tmp-name))
+ ;; `file-name-completion' should not err out if
+ ;; directory does not exist. (Bug#61890)
+ (should-not
+ (file-name-completion
+ "a" (tramp-compat-file-name-concat tmp-name "fuzz")))
;; Ange-FTP does not support predicates.
(unless (tramp--test-ange-ftp-p)
(should
@@ -4637,6 +4640,190 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-directory tmp-name 'recursive)))))))
+(tramp--test-deftest-with-perl tramp-test26-file-name-completion)
+
+(tramp--test-deftest-with-ls tramp-test26-file-name-completion)
+
+;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042
+;; and Bug#60505.
+(ert-deftest tramp-test26-interactive-file-name-completion ()
+ "Check interactive completion with different `completion-styles'."
+ ;; Method, user and host name in completion mode. This kind of
+ ;; completion does not work on MS Windows.
+ (skip-unless (not (memq system-type '(cygwin windows-nt))))
+ (tramp-cleanup-connection tramp-test-vec nil 'keep-password)
+
+ (let ((method (file-remote-p ert-remote-temporary-file-directory 'method))
+ (user (file-remote-p ert-remote-temporary-file-directory 'user))
+ (host (file-remote-p ert-remote-temporary-file-directory 'host))
+ (hop (file-remote-p ert-remote-temporary-file-directory 'hop))
+ (orig-syntax tramp-syntax)
+ (non-essential t)
+ (inhibit-message t))
+ (when (and (stringp host) (string-match tramp-host-with-port-regexp host))
+ (setq host (match-string 1 host)))
+
+ ;; (trace-function #'tramp-completion-file-name-handler)
+ ;; (trace-function #'completion-file-name-table)
+ (unwind-protect
+ (dolist (syntax (if (tramp--test-expensive-test-p)
+ (tramp-syntax-values) `(,orig-syntax)))
+ (tramp-change-syntax syntax)
+ ;; This has cleaned up all connection data, which are used
+ ;; for completion. We must refill the cache.
+ (tramp-set-connection-property tramp-test-vec "property" nil)
+
+ (dolist
+ (style
+ (if (tramp--test-expensive-test-p)
+ ;; It doesn't work for `initials' and `shorthand'
+ ;; completion styles. Should it?
+ '(emacs21 emacs22 basic partial-completion substring flex)
+ '(basic)))
+
+ (when (assoc style completion-styles-alist)
+ (let* (;; Force the real minibuffer in batch mode.
+ (executing-kbd-macro noninteractive)
+ (completion-styles `(,style))
+ completion-category-defaults
+ completion-category-overrides
+ ;; This is needed for the `simplified' syntax,
+ (tramp-default-method method)
+ (method-string
+ (unless (string-empty-p tramp-method-regexp)
+ (concat method tramp-postfix-method-format)))
+ (user-string
+ (unless (tramp-string-empty-or-nil-p user)
+ (concat user tramp-postfix-user-format)))
+ ;; This is needed for the IPv6 host name syntax.
+ (ipv6-prefix
+ (and (string-match-p tramp-ipv6-regexp host)
+ tramp-prefix-ipv6-format))
+ (ipv6-postfix
+ (and (string-match-p tramp-ipv6-regexp host)
+ tramp-postfix-ipv6-format))
+ (host-string
+ (unless (tramp-string-empty-or-nil-p host)
+ (concat
+ ipv6-prefix host
+ ipv6-postfix tramp-postfix-host-format)))
+ ;; The hop string fits only the initial syntax.
+ (hop (and (eq tramp-syntax orig-syntax) hop))
+ test result completions)
+
+ (dolist
+ (test-and-result
+ ;; These are triples of strings (TEST-STRING
+ ;; RESULT-CHECK COMPLETION-CHECK). RESULT-CHECK
+ ;; could be not unique, in this case it is a list
+ ;; (RESULT1 RESULT2 ...).
+ (append
+ ;; Complete method name.
+ (unless (string-empty-p tramp-method-regexp)
+ `((,(concat
+ tramp-prefix-format hop
+ (substring-no-properties
+ method 0 (min 2 (length method))))
+ ,(concat tramp-prefix-format method-string)
+ ,method-string)))
+ ;; Complete user name.
+ (unless (tramp-string-empty-or-nil-p user)
+ `((,(concat
+ tramp-prefix-format hop method-string
+ (substring-no-properties
+ user 0 (min 2 (length user))))
+ ,(concat
+ tramp-prefix-format method-string user-string)
+ ,user-string)))
+ ;; Complete host name.
+ (unless (tramp-string-empty-or-nil-p host)
+ `((,(concat
+ tramp-prefix-format hop method-string
+ ipv6-prefix
+ (substring-no-properties
+ host 0 (min 2 (length host))))
+ (,(concat
+ tramp-prefix-format method-string host-string)
+ ,(concat
+ tramp-prefix-format method-string
+ user-string host-string))
+ ,host-string)))
+ ;; Complete user and host name.
+ (unless (or (tramp-string-empty-or-nil-p user)
+ (tramp-string-empty-or-nil-p host))
+ `((,(concat
+ tramp-prefix-format hop method-string user-string
+ ipv6-prefix
+ (substring-no-properties
+ host 0 (min 2 (length host))))
+ ,(concat
+ tramp-prefix-format method-string
+ user-string host-string)
+ ,host-string)))))
+
+ (ignore-errors (kill-buffer "*Completions*"))
+ ;; (and (bufferp trace-buffer) (kill-buffer trace-buffer))
+ (discard-input)
+ (setq test (car test-and-result)
+ unread-command-events
+ (mapcar #'identity (concat test "\t\t\n"))
+ completions nil
+ result (read-file-name "Prompt: "))
+
+ (if (or (not (get-buffer "*Completions*"))
+ (string-match-p
+ (if (string-empty-p tramp-method-regexp)
+ (rx
+ (| (regexp tramp-postfix-user-regexp)
+ (regexp tramp-postfix-host-regexp))
+ eos)
+ (rx
+ (| (regexp tramp-postfix-method-regexp)
+ (regexp tramp-postfix-user-regexp)
+ (regexp tramp-postfix-host-regexp))
+ eos))
+ result))
+ (progn
+ ;; (tramp--test-message
+ ;; "syntax: %s style: %s test: %s result: %s"
+ ;; syntax style test result)
+ (if (stringp (cadr test-and-result))
+ (should
+ (string-prefix-p (cadr test-and-result) result))
+ (should
+ (let (res)
+ (dolist (elem (cadr test-and-result) res)
+ (setq
+ res (or res (string-prefix-p elem result))))))))
+
+ (with-current-buffer "*Completions*"
+ ;; We must remove leading `default-directory'.
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (while (re-search-forward "//" nil 'noerror)
+ (delete-region (line-beginning-position) (point))))
+ (goto-char (point-min))
+ (re-search-forward
+ (rx bol (0+ nonl)
+ (any "Pp") "ossible completions"
+ (0+ nonl) eol))
+ (forward-line 1)
+ (setq completions
+ (split-string
+ (buffer-substring-no-properties (point)
(point-max))
+ (rx (any "\r\n\t ")) 'omit)))
+
+ ;; (tramp--test-message
+ ;; "syntax: %s style: %s test: %s result: %s completions:
%S"
+ ;; syntax style test result completions)
+ (should (member (caddr test-and-result) completions))))))))
+
+ ;; Cleanup.
+ ;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer))
+ ;; (untrace-function #'tramp-completion-file-name-handler)
+ ;; (untrace-function #'completion-file-name-table)
+ (tramp-change-syntax orig-syntax))))
+
(ert-deftest tramp-test27-load ()
"Check `load'."
(skip-unless (tramp--test-enabled))
@@ -4928,18 +5115,16 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(sit-for 0.1 'nodisp))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
- ;; Read output.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (< (- (point-max) (point-min))
- (length "66\n6F\n6F\n0D\n0A\n"))
- (while (accept-process-output proc 0 nil t))))
- (should
- (string-match-p
- ;; On macOS, there is always newline conversion.
- ;; "telnet" converts \r to <CR><NUL> if `crlf'
- ;; flag is FALSE. See telnet(1) man page.
- (rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n")
- (buffer-string))))
+ ;; Read output. On macOS, there is always newline
+ ;; conversion. "telnet" converts \r to <CR><NUL> if
+ ;; `crlf' flag is FALSE. See telnet(1) man page.
+ (let ((expected
+ (rx "66\n" "6F\n" "6F\n"
+ (| "0D\n" "0A\n") (? "00\n") "0A\n")))
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (not (string-match-p expected (buffer-string)))
+ (while (accept-process-output proc 0 nil t))))
+ (should (string-match-p expected (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc)))))
@@ -5219,18 +5404,16 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(sit-for 0.1 'nodisp))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
- ;; Read output.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (< (- (point-max) (point-min))
- (length "66\n6F\n6F\n0D\n0A\n"))
- (while (accept-process-output proc 0 nil t))))
- (should
- (string-match-p
- ;; On macOS, there is always newline conversion.
- ;; "telnet" converts \r to <CR><NUL> if `crlf'
- ;; flag is FALSE. See telnet(1) man page.
- (rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n")
"0A\n")
- (buffer-string))))
+ ;; Read output. On macOS, there is always newline
+ ;; conversion. "telnet" converts \r to <CR><NUL> if
+ ;; `crlf' flag is FALSE. See telnet(1) man page.
+ (let ((expected
+ (rx "66\n" "6F\n" "6F\n"
+ (| "0D\n" "0A\n") (? "00\n") "0A\n")))
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (not (string-match-p expected (buffer-string)))
+ (while (accept-process-output proc 0 nil t))))
+ (should (string-match-p expected (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc)))))))))
@@ -5386,7 +5569,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; (tramp--test-message "%s" attributes)
(should (equal (cdr (assq 'comm attributes)) (car command)))
(should (equal (cdr (assq 'args attributes))
- (mapconcat #'identity command " ")))))
+ (string-join command " ")))))
;; Cleanup.
(ignore-errors (delete-process proc)))))
@@ -5947,8 +6130,7 @@ INPUT, if non-nil, is a string sent to the process."
;; We make a super long `tramp-remote-path'.
(make-directory tmp-name)
(should (file-directory-p tmp-name))
- (while (tramp-compat-length<
- (mapconcat #'identity orig-exec-path ":") 5000)
+ (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
@@ -5970,8 +6152,7 @@ INPUT, if non-nil, is a string sent to the process."
tramp-test-vec "pipe-buf" 4096))
;; The last element of `exec-path' is `exec-directory'.
(should
- (string-equal
- path (mapconcat #'identity (butlast orig-exec-path) ":"))))
+ (string-equal path (string-join (butlast orig-exec-path) ":"))))
;; The shell "sh" shall always exist.
(should (executable-find "sh" 'remote)))
@@ -6363,11 +6544,33 @@ INPUT, if non-nil, is a string sent to the process."
(save-buffer)
(should-not (buffer-modified-p)))
(should-not (with-no-warnings (file-locked-p tmp-name1)))
+
+ ;; `kill-buffer' removes the lock.
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+ (with-temp-buffer
+ (set-visited-file-name tmp-name1)
+ (insert "foo")
+ (should (buffer-modified-p))
+ (cl-letf (((symbol-function #'read-from-minibuffer)
+ (lambda (&rest _args) "yes")))
+ (kill-buffer)))
+ (should-not (with-no-warnings (file-locked-p tmp-name1)))
+ ;; `kill-buffer' should not remove the lock when the
+ ;; connection is broken. See Bug#61663.
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+ (with-temp-buffer
+ (set-visited-file-name tmp-name1)
+ (insert "foo")
+ (should (buffer-modified-p))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug
'keep-password)
+ (cl-letf (((symbol-function #'read-from-minibuffer)
+ (lambda (&rest _args) "yes")))
+ (kill-buffer)))
;; A new connection changes process id, and also the
- ;; lockname contents.
+ ;; lock file contents. But it still exists.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (stringp (with-no-warnings (file-locked-p tmp-name1))))
@@ -7026,7 +7229,7 @@ This requires restrictions of file name syntax."
;; Simplify test in order to speed up.
(apply #'tramp--test-check-files
(if (tramp--test-expensive-test-p)
- files (list (mapconcat #'identity files ""))))))
+ files (list (string-join files ""))))))
(tramp--test-deftest-with-stat tramp-test41-special-characters)
diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts
b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts
index ba4f854baf8..74e34fe821b 100644
--- a/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts
+++ b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts
@@ -3,7 +3,7 @@ Code:
(c-ts-mode)
(setq-local indent-tabs-mode nil)
(setq-local c-ts-mode-indent-offset 2)
- (c-ts-mode-set-local-style 'bsd)
+ (c-ts-mode-set-style 'bsd)
(indent-region (point-min) (point-max)))
Point-Char: |
diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent-preproc.erts
b/test/lisp/progmodes/c-ts-mode-resources/indent-preproc.erts
new file mode 100644
index 00000000000..ce753b5b3ea
--- /dev/null
+++ b/test/lisp/progmodes/c-ts-mode-resources/indent-preproc.erts
@@ -0,0 +1,99 @@
+Code:
+ (lambda ()
+ (c-ts-mode)
+ (setq-local indent-tabs-mode nil)
+ (newline)
+ (indent-for-tab-command))
+
+Point-Char: |
+
+Name: Indents inside #if preproc
+
+=-=
+static void
+free_glyph_pool (struct glyph_pool *pool)
+{
+ if (pool)
+ {
+#if defined GLYPH_DEBUG|
+#endif
+ }
+}
+=-=
+static void
+free_glyph_pool (struct glyph_pool *pool)
+{
+ if (pool)
+ {
+#if defined GLYPH_DEBUG
+ |
+#endif
+ }
+}
+=-=-=
+
+Name: Indents to 0 if #if preproc at root
+
+=-=
+#if 0|
+/* */
+static void
+=-=
+#if 0
+|
+/* */
+static void
+=-=-=
+
+Code:
+ (lambda ()
+ (c-ts-mode)
+ (setq-local indent-tabs-mode nil)
+ (setq-local c-ts-mode-indent-offset 2)
+ (c-ts-mode-set-style 'gnu)
+ (indent-region (point-min) (point-max)))
+
+Name: Prev-Sibling When Prev-Sibling is Preproc
+
+=-=
+static void
+free_glyph_pool (struct glyph_pool *pool)
+{
+ if (pool)
+ {
+#if defined GLYPH_DEBUG
+ int c = 1;
+#endif
+ int check_this = 3;
+
+#ifdef stuff
+ int c = 1;
+#elif defined stuff
+ int e = 5;
+#else
+ int d = 11;
+ int f = 11;
+#endif
+ int check_this = 3;
+ }
+}
+=-=-=
+
+Name: Prev-Sibling Plus Preproc
+
+=-=-=
+int main() {
+#ifdef MSDOS
+ f->output_data.tty = &the_only_tty_output;
+ f->output_data.tty->display_info = &the_only_display_info;
+#else
+ if (f->output_method == output_termcap)
+ create_tty_output (f);
+#elif defined (HAVE_X_WINDOWS) /* X without toolkit. */
+ if (FRAME_WINDOW_P (f))
+ {}
+#endif
+ t->display_info.tty->top_frame = selected_frame;
+ change_frame_size ();
+}
+=-=-=
diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts
b/test/lisp/progmodes/c-ts-mode-resources/indent.erts
index 058c6e9099c..9e28ef203fd 100644
--- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts
@@ -3,7 +3,7 @@ Code:
(c-ts-mode)
(setq-local indent-tabs-mode nil)
(setq-local c-ts-mode-indent-offset 2)
- (c-ts-mode-set-local-style 'gnu)
+ (c-ts-mode-set-style 'gnu)
(indent-region (point-min) (point-max)))
Point-Char: |
@@ -84,14 +84,6 @@ int main()
}
=-=-=
-Name: Empty Line
-=-=
-int main()
-{
- |
-}
-=-=-=
-
Name: Concecutive blocks (GNU Style) (bug#60873)
=-=
@@ -144,6 +136,58 @@ int f2(int x,
};
=-=-=
+Name: Semi-colon in While Loop (bug#61291)
+
+=-=
+while (true)
+ ;
+for (int i = 0;
+ i < 5;
+ i++)
+ ;
+=-=-=
+
+Name: Bracketless Simple Statement
+
+=-=
+for (int i = 0; i < 5; i++)
+ continue;
+
+while (true)
+ return 1;
+
+do
+ i++;
+while (true)
+=-=-=
+
+Name: Nested If-Else
+
+=-=
+if (true)
+ return 0;
+else if (false)
+ return 1;
+else if (true)
+ return 2;
+else if (false)
+ return 3;
+=-=-=
+
+Name: Initializer List (Bug#61398)
+
+=-=
+int main()
+{
+ const char *emoticons[][2] =
+ {
+ {":-)", "SLIGHTLY SMILING FACE"},
+ {";-)", "WINKING FACE"},
+ {":-(", "SLIGHTLY FROWNING FACE"},
+ };
+}
+=-=-=
+
Name: Multiline Block Comments 1 (bug#60270)
=-=
@@ -190,13 +234,28 @@ line 2
*/
=-=-=
+Name: Block Comment prefixes (Bug#61314)
+
+=-=-=
+/*
+- item1
+- item2
+- item3
+*/
+=-=-=
+/*
+ - item1
+ - item2
+ - item3
+ */
+=-=-=
Code:
(lambda ()
(c-ts-mode)
(setq-local indent-tabs-mode nil)
(setq-local c-ts-mode-indent-offset 8)
- (c-ts-mode-set-local-style 'linux)
+ (c-ts-mode-set-style 'linux)
(indent-region (point-min) (point-max)))
Name: Labels (Linux Style)
@@ -244,3 +303,134 @@ int main() {
}
}
=-=-=
+
+Name: Complicated mixed bracket matching indentation (bug#61142)
+
+=-=
+void foo(
+ int foo) {
+ for (;;)
+ return 5;
+
+ if (a == 0
+ && b == 1
+ && foo)
+ {
+ return 0;
+ }
+ else if (a == 1)
+ {
+ return 1;
+ }
+ else if (true)
+ return 5;
+ else
+ {
+ if (a == 0
+ && b == 1
+ && foo)
+ for (
+ int i = 0;
+ i < 5;
+ i++)
+ if (true)
+ do
+ i = 5;
+ while (true);
+ else if (false)
+ {
+ return 6;
+ }
+ else
+ if (true
+ && false)
+ return 6;
+ }
+}
+=-=-=
+
+Name: Initializer List (Linux Style) (Bug#61398)
+
+=-=
+int main()
+{
+ const char *emoticons[][2] = {
+ {":-)", "SLIGHTLY SMILING FACE"},
+ {";-)", "WINKING FACE"},
+ {":-(", "SLIGHTLY FROWNING FACE"},
+ };
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (c++-ts-mode)
+ (setq-local indent-tabs-mode nil)
+ (setq-local c-ts-mode-indent-offset 2)
+ (indent-region (point-min) (point-max)))
+
+Name: Declaration List (Namespace) (Bug#61635)
+
+=-=
+namespace test {
+ class Name {
+ };
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (c-ts-mode)
+ (setq-local indent-tabs-mode nil)
+ (setq-local c-ts-mode-indent-offset 2)
+ (c-ts-mode-set-style 'gnu)
+ (indent-for-tab-command))
+
+Name: Empty Line
+=-=
+int main()
+{
+ |
+}
+=-=-=
+
+Name: Empty Line Previous Sibling
+=-=
+int main()
+{
+ int a = 1;
+ |
+}
+=-=-=
+
+Name: Prev-Sibling But Not Trailing Comment
+
+=-=
+static int
+required_matrix_height (struct window *w)
+{
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f))
+ {
+ return 0;
+ }
+#endif /* Don't align to this comment. */
+ |
+}
+=-=-=
+
+Name: Empty Line
+
+=-=
+int
+main (void)
+{
+|
+}
+=-=
+int
+main (void)
+{
+ |
+}
+=-=-=
diff --git a/test/lisp/progmodes/c-ts-mode-tests.el
b/test/lisp/progmodes/c-ts-mode-tests.el
index ddf64b40736..ea5fab4cbef 100644
--- a/test/lisp/progmodes/c-ts-mode-tests.el
+++ b/test/lisp/progmodes/c-ts-mode-tests.el
@@ -27,6 +27,10 @@
(skip-unless (treesit-ready-p 'c))
(ert-test-erts-file (ert-resource-file "indent.erts")))
+(ert-deftest c-ts-mode-test-indentation-preproc ()
+ (skip-unless (treesit-ready-p 'c))
+ (ert-test-erts-file (ert-resource-file "indent-preproc.erts")))
+
(ert-deftest c-ts-mode-test-indentation-bsd ()
(skip-unless (treesit-ready-p 'c))
(ert-test-erts-file (ert-resource-file "indent-bsd.erts")))
diff --git a/test/lisp/progmodes/compile-tests.el
b/test/lisp/progmodes/compile-tests.el
index 53dc7f2a133..078eef36774 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -382,6 +382,10 @@
;; sun-ada
(sun-ada "/home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error:
\",\" inserted"
1 6 361 "/home3/xdhar/rcds_rc/main.a")
+ (typescript-tsc-plain "/home/foo/greeter.ts(30,12): error TS2339: Property
'foo' does not exist."
+ 1 12 30 "/home/foo/greeter.ts")
+ (typescript-tsc-pretty "src/resources/document.ts:140:22 - error TS2362:
something."
+ 1 22 140 "src/resources/document.ts")
;; 4bsd
(edg-1 "/usr/src/foo/foo.c(8): warning: w may be used before set"
1 nil 8 "/usr/src/foo/foo.c")
@@ -495,7 +499,7 @@ The test data is in `compile-tests--test-regexps-data'."
(compilation-num-warnings-found 0)
(compilation-num-infos-found 0))
(mapc #'compile--test-error-line compile-tests--test-regexps-data)
- (should (eq compilation-num-errors-found 98))
+ (should (eq compilation-num-errors-found 100))
(should (eq compilation-num-warnings-found 35))
(should (eq compilation-num-infos-found 28)))))
diff --git a/test/lisp/progmodes/eglot-tests.el
b/test/lisp/progmodes/eglot-tests.el
index 4b6528351b2..7a90d68d213 100644
--- a/test/lisp/progmodes/eglot-tests.el
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -103,22 +103,21 @@ then restored."
(set (car spec) (cadr spec)))
((stringp (car spec)) (push spec file-specs))))
(unwind-protect
- (let* ((home (getenv "HOME"))
- (process-environment
+ (let* ((process-environment
(append
`(;; Set XDF_CONFIG_HOME to /dev/null to prevent
;; user-configuration to have an influence on
;; language servers. (See github#441)
"XDG_CONFIG_HOME=/dev/null"
;; ... on the flip-side, a similar technique by
- ;; Emacs's test makefiles means that HOME is set to
- ;; /nonexistent. This breaks some common
- ;; installations for LSP servers like pylsp, making
- ;; these tests mostly useless, so we hack around it
- ;; here with a great big hack.
+ ;; Emacs's test makefiles means that HOME is
+ ;; spoofed to /nonexistent, or sometimes /tmp.
+ ;; This breaks some common installations for LSP
+ ;; servers like pylsp, rust-analyzer making these
+ ;; tests mostly useless, so we hack around it here
+ ;; with a great big hack.
,(format "HOME=%s"
- (if (file-exists-p home) home
- (format "/home/%s" (getenv "USER")))))
+ (expand-file-name (format "~%s"
(user-login-name)))))
process-environment))
;; Prevent "Can't guess python-indent-offset ..." messages.
(python-indent-guess-indent-offset-verbose . nil)
@@ -856,8 +855,8 @@ pylsp prefers autopep over yafp, despite its README stating
the contrary."
'((c-mode . ("clangd")))))
(with-current-buffer
(eglot--find-file-noselect "project/foo.c")
- (setq-local eglot-move-to-column-function
#'eglot-move-to-lsp-abiding-column)
- (setq-local eglot-current-column-function #'eglot-lsp-abiding-column)
+ (setq-local eglot-move-to-linepos-function
#'eglot-move-to-utf-16-linepos)
+ (setq-local eglot-current-linepos-function #'eglot-utf-16-linepos)
(eglot--sniffing (:client-notifications c-notifs)
(eglot--tests-connect)
(end-of-line)
@@ -866,12 +865,12 @@ pylsp prefers autopep over yafp, despite its README
stating the contrary."
(eglot--wait-for (c-notifs 2) (&key params &allow-other-keys)
(should (equal 71 (cadddr (cadadr (aref (cadddr params) 0))))))
(beginning-of-line)
- (should (eq eglot-move-to-column-function
#'eglot-move-to-lsp-abiding-column))
- (funcall eglot-move-to-column-function 71)
+ (should (eq eglot-move-to-linepos-function
#'eglot-move-to-utf-16-linepos))
+ (funcall eglot-move-to-linepos-function 71)
(should (looking-at "p")))))))
(ert-deftest eglot-test-lsp-abiding-column ()
- "Test basic `eglot-lsp-abiding-column' and
`eglot-move-to-lsp-abiding-column'."
+ "Test basic LSP character counting logic."
(skip-unless (executable-find "clangd"))
(eglot-tests--lsp-abiding-column-1))
diff --git a/test/lisp/progmodes/elisp-mode-tests.el
b/test/lisp/progmodes/elisp-mode-tests.el
index 57b39a49801..5b6ef88dceb 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -1003,6 +1003,11 @@ evaluation of BODY."
(should (equal (elisp--xref-infer-namespace p5) 'variable))
(should (equal (elisp--xref-infer-namespace p6) 'function)))
+ (elisp-mode-test--with-buffer
+ (concat "(defclass child-class ({p1}parent-1 {p2}parent-2))\n")
+ (should (equal (elisp--xref-infer-namespace p1) 'function))
+ (should (equal (elisp--xref-infer-namespace p2) 'function)))
+
(elisp-mode-test--with-buffer
(concat "(require '{p1}alpha)\n"
"(fboundp '{p2}beta)\n"
diff --git a/test/lisp/progmodes/go-ts-mode-resources/indent.erts
b/test/lisp/progmodes/go-ts-mode-resources/indent.erts
new file mode 100644
index 00000000000..a89d69b307c
--- /dev/null
+++ b/test/lisp/progmodes/go-ts-mode-resources/indent.erts
@@ -0,0 +1,47 @@
+Code:
+ (lambda ()
+ (go-ts-mode)
+ (indent-region (point-min) (point-max)))
+
+Point-Char: |
+
+Name: Basic
+
+=-=
+package main
+
+func main() {
+}
+=-=-=
+
+Name: Switch and Select
+
+=-=
+package main
+
+func main() {
+ var x any
+ switch x {
+ case 1:
+ println("one")
+ default:
+ println("default case")
+ }
+
+ switch x.(type) {
+ case int:
+ println("integer")
+ default:
+ println("don't know the type")
+ }
+
+ var c chan int
+ select {
+ case x := <-c:
+ println(x)
+ default:
+ println("no communication")
+ }
+}
+
+=-=-=
diff --git a/test/lisp/erc/erc-scenarios-internal.el
b/test/lisp/progmodes/go-ts-mode-tests.el
similarity index 64%
copy from test/lisp/erc/erc-scenarios-internal.el
copy to test/lisp/progmodes/go-ts-mode-tests.el
index 8d38c2dde49..548465208f9 100644
--- a/test/lisp/erc/erc-scenarios-internal.el
+++ b/test/lisp/progmodes/go-ts-mode-tests.el
@@ -1,6 +1,6 @@
-;;; erc-scenarios-internal.el --- Proxy file for erc-d tests -*-
lexical-binding: t -*-
+;;; go-ts-mode-tests.el --- Tests for Tree-sitter-based Go mode -*-
lexical-binding: t; -*-
-;; Copyright (C) 2022-2023 Free Software Foundation, Inc.
+;; Copyright (C) 2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -19,10 +19,13 @@
;;; Code:
+(require 'ert)
(require 'ert-x)
-(eval-and-compile
- (let ((load-path (cons (expand-file-name "erc-d" (ert-resource-directory))
- load-path)))
- (load "erc-d-tests" nil 'silent)))
+(require 'treesit)
-;;; erc-scenarios-internal.el ends here
+(ert-deftest go-ts-mode-test-indentation ()
+ (skip-unless (treesit-ready-p 'go))
+ (ert-test-erts-file (ert-resource-file "indent.erts")))
+
+(provide 'go-ts-mode-tests)
+;;; go-ts-mode-tests.el ends here
diff --git a/test/lisp/progmodes/grep-tests.el
b/test/lisp/progmodes/grep-tests.el
index 39307999d6d..9b7f83086bf 100644
--- a/test/lisp/progmodes/grep-tests.el
+++ b/test/lisp/progmodes/grep-tests.el
@@ -66,4 +66,18 @@
(cl-letf (((symbol-function 'w32-shell-dos-semantics) #'ignore))
(grep-tests--check-rgrep-abbreviation))))
+(ert-deftest grep-tests--grep-heading-regexp-without-null ()
+ (dolist (sep '(?: ?- ?=))
+ (let ((string (format "filename%c123%ctext" sep sep)))
+ (should (string-match grep-heading-regexp string))
+ (should (equal (match-string 1 string) "filename"))
+ (should (equal (match-string 2 string) (format "filename%c" sep))))))
+
+(ert-deftest grep-tests--grep-heading-regexp-with-null ()
+ (dolist (sep '(?: ?- ?=))
+ (let ((string (format "funny:0:filename%c123%ctext" 0 sep)))
+ (should (string-match grep-heading-regexp string))
+ (should (equal (match-string 1 string) "funny:0:filename"))
+ (should (equal (match-string 2 string) "funny:0:filename\0")))))
+
;;; grep-tests.el ends here
diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts
b/test/lisp/progmodes/java-ts-mode-resources/indent.erts
index c8e0ac71708..4fca74dd2e1 100644
--- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts
@@ -1,7 +1,7 @@
Code:
(lambda ()
(setq indent-tabs-mode nil)
- (setq java-ts-mode-indent-offset 2)
+ (setq java-ts-mode-indent-offset 4)
(java-ts-mode)
(indent-region (point-min) (point-max)))
@@ -11,9 +11,9 @@ Name: Basic
=-=
public class Basic {
- public void basic() {
- return;
- }
+ public void basic() {
+ return;
+ }
}
=-=-=
@@ -21,9 +21,9 @@ Name: Empty Line
=-=
public class EmptyLine {
- public void emptyLine() {
- |
- }
+ public void emptyLine() {
+ |
+ }
}
=-=-=
@@ -31,15 +31,15 @@ Name: Statements
=-=
if (x) {
- for (var foo : foos) {
- |
- }
+ for (var foo : foos) {
+ |
+ }
} else if (y) {
- for (int i = 0; x < foos.size(); i++) {
- return;
- }
+ for (int i = 0; x < foos.size(); i++) {
+ return;
+ }
} else {
- return;
+ return;
}
=-=-=
@@ -47,7 +47,66 @@ Name: Field declaration without access modifier (bug#61115)
=-=
public class T {
- @Autowired
- String a;
+ @Autowired
+ String a;
+}
+=-=-=
+
+Name: Array initializer
+
+=-=
+public class Java {
+ void foo() {
+ return new String[]{
+ "foo", // These
+ "bar"
+ }
+ }
+}
+=-=-=
+
+Name: Advanced bracket matching indentation (bug#61142)
+
+=-=
+public class Java {
+
+ public Java(
+ String foo) {
+ this.foo = foo;
+ }
+
+ void foo(
+ String foo) {
+
+ for (var f : rs)
+ return new String[]{
+ "foo",
+ "bar"
+ };
+ if (a == 0
+ && b == 1
+ && foo) {
+ return 0;
+ } else if (a == 1) {
+ return 1;
+ } else if (true)
+ return 5;
+ else {
+ if (a == 0
+ && b == 1
+ && foo)
+ while (true)
+ for (
+ ;;)
+ if (true)
+ return 5;
+ else if (false) {
+ return 6;
+ } else
+ if (true
+ && false)
+ return 6;
+ }
+ }
}
=-=-=
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index df71990278e..4f24c042c6a 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -189,6 +189,14 @@ default to `point-min' and `point-max' respectively."
(overlay-end overlay))))
(buffer-substring-no-properties (point-min) (point-max)))))
+(defun python-tests-should-not-move (func &rest args)
+ "Assert that point does not move while calling FUNC with ARGS.
+Returns the value returned by FUNC."
+ (let ((pos (point))
+ (ret (apply func args)))
+ (should (= pos (point)))
+ ret))
+
(defun python-virt-bin (&optional virt-root)
"Return the virtualenv bin dir, starting from VIRT-ROOT.
If nil, VIRT-ROOT defaults to `python-shell-virtualenv-root'.
@@ -4213,7 +4221,8 @@ class Bar(models.Model):
pass
"
(should (string= (buffer-string)
- (python-shell-buffer-substring (point-min) (point-max))))))
+ (python-tests-should-not-move
+ #'python-shell-buffer-substring (point-min)
(point-max))))))
(ert-deftest python-shell-buffer-substring-2 ()
"Main block should be removed if NOMAIN is non-nil."
@@ -4229,7 +4238,8 @@ if __name__ == \"__main__\":
foo = Foo()
print (foo)
"
- (should (string= (python-shell-buffer-substring (point-min) (point-max) t)
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring (point-min) (point-max) t)
"
class Foo(models.Model):
pass
@@ -4256,7 +4266,8 @@ if __name__ == \"__main__\":
class Bar(models.Model):
pass
"
- (should (string= (python-shell-buffer-substring (point-min) (point-max) t)
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring (point-min) (point-max) t)
"
class Foo(models.Model):
pass
@@ -4284,7 +4295,8 @@ if __name__ == \"__main__\":
class Bar(models.Model):
pass
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "class Foo(models.Model):")
(progn (python-nav-forward-sexp) (point)))
"# -*- coding: latin-1 -*-
@@ -4307,7 +4319,8 @@ if __name__ == \"__main__\":
class Bar(models.Model):
pass
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "class Bar(models.Model):")
(progn (python-nav-forward-sexp) (point)))
"# -*- coding: latin-1 -*-
@@ -4338,7 +4351,8 @@ if __name__ == \"__main__\":
class Bar(models.Model):
pass
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "# coding: latin-1")
(python-tests-look-at "if __name__ == \"__main__\":"))
"# -*- coding: latin-1 -*-
@@ -4365,7 +4379,8 @@ if __name__ == \"__main__\":
class Bar(models.Model):
pass
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "# coding: latin-1")
(python-tests-look-at "if __name__ == \"__main__\":"))
"# -*- coding: utf-8 -*-
@@ -4385,7 +4400,8 @@ class Foo(models.Model):
class Foo(models.Model):
pass
"
- (should (string= (python-shell-buffer-substring (point-min) (point-max))
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring (point-min) (point-max))
"# coding: utf-8
@@ -4404,7 +4420,8 @@ class Foo(models.Model):
class Bar(models.Model):
pass
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(point-min)
(python-tests-look-at "class Bar(models.Model):"))
"# coding: utf-8
@@ -4421,7 +4438,8 @@ class Foo(models.Model):
def foo():
print ('a')
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "print ('a')")
(point-max))
"# -*- coding: utf-8 -*-\nif True:\n print
('a')\n\n"))))
@@ -4433,7 +4451,8 @@ def foo():
def foo():
print ('a')
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(progn
(python-tests-look-at "print ('a')")
(backward-char 1)
@@ -4451,7 +4470,8 @@ def foo():
print ('a')
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "# Whitespace")
(point-max))
"# -*- coding: utf-8 -*-\n\nif True:\n #
Whitespace\n\n print ('a')\n\n"))))
@@ -4463,7 +4483,8 @@ def foo():
def foo():
a = 1
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "a = 1")
(pos-eol))
"# -*- coding: utf-8 -*-\n\na = 1"))))
@@ -4476,7 +4497,8 @@ def foo():
a = \"\"\"Some
string\"\"\"
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "a = \"\"\"Some")
(pos-eol 2))
"# -*- coding: utf-8 -*-\n\na = \"\"\"Some\n
string\"\"\""))))
@@ -4488,7 +4510,8 @@ def foo():
def foo():
a = 1
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at " a = 1")
(python-tests-look-at " = 1"))
"# -*- coding: utf-8 -*-\n\na"))))
@@ -4500,7 +4523,8 @@ def foo():
def foo():
a = 1
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "1")
(1+ (point)))
"# -*- coding: utf-8 -*-\n\n1"))))
@@ -4515,7 +4539,8 @@ def foo():
b = 2
\"\"\"
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "a = 1")
(python-tests-look-at "\"\"\""))
"# -*- coding: utf-8 -*-\n\nif True:\n a = 1\n b =
2\n\n"))))
@@ -4525,7 +4550,8 @@ def foo():
(python-tests-with-temp-buffer
"s = 'test'
"
- (should (string= (python-shell-buffer-substring
+ (should (string= (python-tests-should-not-move
+ #'python-shell-buffer-substring
(python-tests-look-at "'test'")
(pos-eol))
"'test'"))))
diff --git
a/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb
index 25cd8736f97..e339d229d3e 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb
@@ -10,6 +10,10 @@ qux = 4 + 5 *
foo = obj.bar { |m| tee(m) } +
obj.qux { |m| hum(m) }
+some_variable = abc + some_method(
+ some_argument
+)
+
foo.
bar
.baz
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
index 3f0dfdf68ba..81d0dfd75c9 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -163,6 +163,11 @@ if something == :==
)
end
+# Bug#61871
+foo, bar = baz.(
+ some_arg
+)
+
# Bug#17097
if x == :!=
something
diff --git a/test/lisp/progmodes/ruby-ts-mode-tests.el
b/test/lisp/progmodes/ruby-ts-mode-tests.el
index 18e3e60a04a..c99e1a43063 100644
--- a/test/lisp/progmodes/ruby-ts-mode-tests.el
+++ b/test/lisp/progmodes/ruby-ts-mode-tests.el
@@ -122,6 +122,22 @@ The whitespace before and including \"|\" on each line is
removed."
(funcall indent-line-function)
(should (= (current-indentation) ruby-indent-level))))
+(ert-deftest ruby-ts-indent-empty-if-else ()
+ (skip-unless (treesit-ready-p 'ruby t))
+ (let* ((str "c = if foo
+ zz
+ else
+ zz
+ end
+"))
+ (ruby-ts-with-temp-buffer str
+ (goto-char (point-min))
+ (dotimes (_ 2)
+ (re-search-forward "^ *zz")
+ (replace-match "")
+ (funcall indent-line-function)
+ (should (= (current-indentation) 6))))))
+
(ert-deftest ruby-ts-add-log-current-method-examples ()
(skip-unless (treesit-ready-p 'ruby t))
(let ((pairs '(("foo" . "#foo")
diff --git a/test/lisp/progmodes/sh-script-tests.el
b/test/lisp/progmodes/sh-script-tests.el
index c850a5d8af7..52c1303c414 100644
--- a/test/lisp/progmodes/sh-script-tests.el
+++ b/test/lisp/progmodes/sh-script-tests.el
@@ -52,6 +52,24 @@
(ert-deftest test-indentation ()
(ert-test-erts-file (ert-resource-file "sh-indents.erts")))
+(ert-deftest test-indent-after-continuation ()
+ (with-temp-buffer
+ (insert "for f \\\nin a; do \\\ntoto; \\\ndone\n")
+ (shell-script-mode)
+ (let ((sh-indent-for-continuation '++))
+ (let ((sh-indent-after-continuation t))
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string)
+ "for f \\\n\tin a; do \\\n toto; \\\n done\n")))
+ (let ((sh-indent-after-continuation 'always))
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string)
+ "for f \\\n\tin a; do \\\n\ttoto; \\\n\tdone\n")))
+ (let ((sh-indent-after-continuation nil))
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string)
+ "for f \\\nin a; do \\\n toto; \\\ndone\n"))))))
+
(defun test-sh-back (string &optional pos)
(with-temp-buffer
(shell-script-mode)
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 1abd3be4ea1..37fe09c1716 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1058,10 +1058,12 @@ final or penultimate step during initialization."))
'(subr-tests--b subr-tests--c)))
(defalias 'subr-tests--d 'subr-tests--e)
- (defalias 'subr-tests--e 'subr-tests--d)
- (should-error (function-alias-p 'subr-tests--d))
- (should (equal (function-alias-p 'subr-tests--d t)
- '(subr-tests--e))))
+ (should (equal (function-alias-p 'subr-tests--d)
+ '(subr-tests--e)))
+
+ (fset 'subr-tests--f 'subr-tests--a)
+ (should (equal (function-alias-p 'subr-tests--f)
+ '(subr-tests--a subr-tests--b subr-tests--c))))
(ert-deftest test-readablep ()
(should (readablep "foo"))
@@ -1169,5 +1171,65 @@ final or penultimate step during initialization."))
(should-not (list-of-strings-p '("a" nil "b")))
(should-not (list-of-strings-p '("a" "b" . "c"))))
+(ert-deftest subr--delete-dups ()
+ (should (equal (delete-dups nil) nil))
+ (let* ((a (list "a" "b" "c"))
+ (a-dedup (delete-dups a)))
+ (should (equal a-dedup '("a" "b" "c")))
+ (should (eq a a-dedup)))
+ (let* ((a (list "a" "a" "b" "b" "a" "c" "b" "c" "a"))
+ (a-b (cddr a)) ; link of first "b"
+ (a-dedup (delete-dups a)))
+ (should (equal a-dedup '("a" "b" "c")))
+ (should (eq a a-dedup))
+ (should (eq (cdr a-dedup) a-b))))
+
+(ert-deftest subr--delete-consecutive-dups ()
+ (should (equal (delete-consecutive-dups nil) nil))
+ (let* ((a (list "a" "b" "c"))
+ (a-dedup (delete-consecutive-dups a)))
+ (should (equal a-dedup '("a" "b" "c")))
+ (should (eq a a-dedup)))
+ (let* ((a (list "a" "a" "b" "a" "a" "b" "b" "b" "c" "c" "a" "a"))
+ (a-b (nthcdr 3 a)) ; link of third "a"
+ (a-dedup (delete-consecutive-dups a)))
+ (should (equal a-dedup '("a" "b" "a" "b" "c" "a")))
+ (should (eq a a-dedup))
+ (should (equal (nthcdr 2 a-dedup) a-b)))
+ (let* ((a (list "a" "b" "a"))
+ (a-dedup (delete-consecutive-dups a t)))
+ (should (equal a-dedup '("a" "b")))
+ (should (eq a a-dedup)))
+ (let* ((a (list "a" "a" "b" "a" "a" "b" "b" "b" "c" "c" "a" "a"))
+ (a-dedup (delete-consecutive-dups a t)))
+ (should (equal a-dedup '("a" "b" "a" "b" "c")))
+ (should (eq a a-dedup))))
+
+(ert-deftest subr--safe-copy-tree ()
+ (should (null (safe-copy-tree nil)))
+ (let* ((foo '(1 2 (3 4))) (bar (safe-copy-tree foo)))
+ (should (equal bar foo))
+ (should-not (eq bar foo))
+ (should-not (eq (caddr bar) (caddr foo))))
+ (let* ((foo '#1=(a #1#)) (bar (safe-copy-tree foo)))
+ (should (eq (car bar) (car foo)))
+; (should-not (proper-list-p bar))
+ (should (eq (caadr bar) (caadr foo)))
+ (should (eq (caadr bar) 'a)))
+ (let* ((foo [1 2 3 4]) (bar (safe-copy-tree foo)))
+ (should (eq bar foo)))
+ (let* ((foo [1 (2 3) 4]) (bar (safe-copy-tree foo t)))
+ (should-not (eq bar foo))
+ (should (equal bar foo))
+ (should-not (eq (aref bar 1) (aref foo 1))))
+ (let* ((foo [1 [2 3] 4]) (bar (safe-copy-tree foo t)))
+ (should (equal bar foo))
+ (should-not (eq bar foo))
+ (should-not (eq (aref bar 1) (aref foo 1))))
+ (let* ((foo (record 'foo 1 "two" 3)) (bar (safe-copy-tree foo t)))
+ (should (equal bar foo))
+ (should-not (eq bar foo))
+ (should (eq (aref bar 2) (aref foo 2)))))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/textmodes/emacs-news-mode-resources/toggle-tag.erts
b/test/lisp/textmodes/emacs-news-mode-resources/cycle-tag.erts
similarity index 59%
rename from test/lisp/textmodes/emacs-news-mode-resources/toggle-tag.erts
rename to test/lisp/textmodes/emacs-news-mode-resources/cycle-tag.erts
index 63c3b1b7d8a..c3d32f6f05c 100644
--- a/test/lisp/textmodes/emacs-news-mode-resources/toggle-tag.erts
+++ b/test/lisp/textmodes/emacs-news-mode-resources/cycle-tag.erts
@@ -129,3 +129,92 @@ The corresponding key "% Y" is now bound by default in
Dired.
Before, that binding was only available if the 'dired-x' package was
loaded.
=-=-=
+
+Name: tag7-2level
+Point-Char: |
+
+=-=
++++
+** 'dired-do-relsymlink-regexp' moved from dired-x to dired.
+The corresponding key "% Y" is now bound by default in Dired.
+
+|+++
+** 'M-G' is now bound to 'dired-goto-subdir'.
+Before, that binding was only available if the 'dired-x' package was
+loaded.
+=-=
++++
+** 'dired-do-relsymlink-regexp' moved from dired-x to dired.
+The corresponding key "% Y" is now bound by default in Dired.
+
+|** 'M-G' is now bound to 'dired-goto-subdir'.
+Before, that binding was only available if the 'dired-x' package was
+loaded.
+=-=-=
+
+Name: tag8-2level
+Point-Char: |
+
+=-=
++++
+** 'dired-do-relsymlink-regexp' moved from dired-x to dired.
+The corresponding key "% Y" is now bound by default in Dired.
+
++++
+|** 'M-G' is now bound to 'dired-goto-subdir'.
+Before, that binding was only available if the 'dired-x' package was
+loaded.
+=-=
++++
+** 'dired-do-relsymlink-regexp' moved from dired-x to dired.
+The corresponding key "% Y" is now bound by default in Dired.
+
+|** 'M-G' is now bound to 'dired-goto-subdir'.
+Before, that binding was only available if the 'dired-x' package was
+loaded.
+=-=-=
+
+Name: tag9-2level-notag
+Point-Char: |
+
+=-=
++++
+** 'dired-do-relsymlink-regexp' moved from dired-x to dired.
+The corresponding key "% Y" is now bound by default in Dired.
+
+|** 'M-G' is now bound to 'dired-goto-subdir'.
+Before, that binding was only available if the 'dired-x' package was
+loaded.
+=-=
++++
+** 'dired-do-relsymlink-regexp' moved from dired-x to dired.
+The corresponding key "% Y" is now bound by default in Dired.
+
+---
+|** 'M-G' is now bound to 'dired-goto-subdir'.
+Before, that binding was only available if the 'dired-x' package was
+loaded.
+=-=-=
+
+
+Name: tag10-4level
+Point-Char: |
+
+=-=
++++
+**** 'dired-do-relsymlink-regexp' moved from dired-x to dired.
+The corresponding key "% Y" is now bound by default in Dired.
+
+|**** 'M-G' is now bound to 'dired-goto-subdir'.
+Before, that binding was only available if the 'dired-x' package was
+loaded.
+=-=
++++
+**** 'dired-do-relsymlink-regexp' moved from dired-x to dired.
+The corresponding key "% Y" is now bound by default in Dired.
+
+---
+|**** 'M-G' is now bound to 'dired-goto-subdir'.
+Before, that binding was only available if the 'dired-x' package was
+loaded.
+=-=-=
diff --git a/test/lisp/textmodes/emacs-news-mode-tests.el
b/test/lisp/textmodes/emacs-news-mode-tests.el
index e1152265a45..676a3270da6 100644
--- a/test/lisp/textmodes/emacs-news-mode-tests.el
+++ b/test/lisp/textmodes/emacs-news-mode-tests.el
@@ -23,10 +23,10 @@
(require 'ert-x)
(require 'emacs-news-mode)
-(ert-deftest emacs-news-toggle-tag ()
- (ert-test-erts-file (ert-resource-file "toggle-tag.erts")
+(ert-deftest emacs-news-cycle-tag ()
+ (ert-test-erts-file (ert-resource-file "cycle-tag.erts")
(lambda ()
(emacs-news-mode)
- (emacs-news-toggle-tag))))
+ (emacs-news-cycle-tag))))
;;; emacs-news-mode-tests.el ends here
diff --git a/test/lisp/url/url-domsuf-tests.el
b/test/lisp/url/url-domsuf-tests.el
index 09fd6240065..8dbf65dae44 100644
--- a/test/lisp/url/url-domsuf-tests.el
+++ b/test/lisp/url/url-domsuf-tests.el
@@ -24,6 +24,10 @@
(require 'url-domsuf)
(require 'ert)
+(ert-deftest url-domsuf--public-suffix-file ()
+ ;; We should always have a file, since it ships with Emacs.
+ (should (file-readable-p (url-domsuf--public-suffix-file))))
+
(defun url-domsuf-tests--run ()
(should-not (url-domsuf-cookie-allowed-p "com"))
(should (url-domsuf-cookie-allowed-p "foo.bar.bd"))
diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index 74c2449076f..20caaff17c7 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-tests.el
@@ -31,6 +31,10 @@
"Test using non-nil wdired-use-interactive-rename.
Partially modifying a file name should succeed."
(ert-with-temp-directory test-dir
+ ;; The call to file-truename is for MS-Windows, where numeric
+ ;; tails or some other feature (like SUBST) could cause file names
+ ;; to fail to compare 'equal'.
+ (setq test-dir (file-truename test-dir))
(let* ((test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
(new-file (string-replace "foo" replace test-file))
@@ -56,6 +60,7 @@ Partially modifying a file name should succeed."
"Test using non-nil wdired-use-interactive-rename.
Aborting an edit should leaving original file name unchanged."
(ert-with-temp-directory test-dir
+ (setq test-dir (file-truename test-dir))
(let* ((test-file (concat (file-name-as-directory test-dir) "foo.c"))
(wdired-use-interactive-rename t))
(write-region "" nil test-file nil 'silent)
@@ -106,6 +111,7 @@ only the name before the link arrow."
Finding the new name should be possible while still in
wdired-mode."
(ert-with-temp-directory test-dir
+ (setq test-dir (file-truename test-dir))
(let* ((test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
(new-file (string-replace "foo" replace test-file)))
@@ -143,7 +149,11 @@ wdired-get-filename before and after editing."
(with-current-buffer buf
(dired-create-empty-file "foo")
(set-file-modes "foo" (file-modes-symbolic-to-number "+x"))
- (make-symbolic-link "foo" "bar")
+ (skip-unless
+ ;; This check is for wdired, not symbolic links, so skip
+ ;; it when make-symbolic-link fails for any reason (like
+ ;; insufficient privileges).
+ (ignore-errors (make-symbolic-link "foo" "bar") t))
(make-directory "foodir")
(dired-smart-shell-command "mkfifo foopipe")
(when (featurep 'make-network-process '(:family local))
@@ -176,6 +186,7 @@ wdired-get-filename before and after editing."
(ert-deftest wdired-test-bug39280 ()
"Test for https://debbugs.gnu.org/39280.";
(ert-with-temp-directory test-dir
+ (setq test-dir (file-truename test-dir))
(let* ((fname "foo")
(full-fname (expand-file-name fname test-dir)))
(make-empty-file full-fname)
@@ -189,5 +200,32 @@ wdired-get-filename before and after editing."
(wdired-finish-edit))
(if buf (kill-buffer buf)))))))
+(ert-deftest wdired-test-bug61510 ()
+ "Test visibility of symlink target on leaving wdired-mode.
+When dired-hide-details-mode is enabled and
+dired-hide-details-hide-symlink-targets is non-nil (the default),
+the link target becomes invisible. When wdired-mode is enabled
+the target becomes visible, but on returning to dired-mode, it
+should be invisible again."
+ (ert-with-temp-directory test-dir
+ (let ((buf (find-file-noselect test-dir))
+ ;; Default value is t, but set it anyway, to be sure.
+ (dired-hide-details-hide-symlink-targets t))
+ (unwind-protect
+ (with-current-buffer buf
+ (skip-unless
+ ;; This check is for wdired, not symbolic links, so skip
+ ;; it when make-symbolic-link fails for any reason (like
+ ;; insufficient privileges).
+ (ignore-errors (make-symbolic-link "bar" "foo") t))
+ (dired-hide-details-mode)
+ (should (memq 'dired-hide-details-link buffer-invisibility-spec))
+ (dired-toggle-read-only)
+ (should-not (memq 'dired-hide-details-link
+ buffer-invisibility-spec))
+ (wdired-finish-edit)
+ (should (memq 'dired-hide-details-link buffer-invisibility-spec)))
+ (if buf (kill-buffer buf))))))
+
(provide 'wdired-tests)
;;; wdired-tests.el ends here
diff --git a/test/manual/indent/shell.sh b/test/manual/indent/shell.sh
index bd4a74f7054..5b3fb0e66fb 100755
--- a/test/manual/indent/shell.sh
+++ b/test/manual/indent/shell.sh
@@ -140,6 +140,7 @@ foo () {
5) hello ;;
4) hello ;&
4) hello ;;&
+ 4) hello ;|
5) hello ;;
5) hello ;;
esac
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 9d4bbf3e040..45914b2b6b0 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -8539,4 +8539,110 @@ Finally, kill the buffer and its temporary file."
(if f2 (delete-file f2))
)))
+(ert-deftest test-labeled-narrowing ()
+ "Test `with-restriction' and `without-restriction'."
+ (with-current-buffer (generate-new-buffer " foo" t)
+ (insert (make-string 5000 ?a))
+ (should (= (point-min) 1))
+ (should (= (point-max) 5001))
+ (with-restriction
+ 100 500 :label 'foo
+ (should (= (point-min) 100))
+ (should (= (point-max) 500))
+ (widen)
+ (should (= (point-min) 100))
+ (should (= (point-max) 500))
+ (narrow-to-region 1 5000)
+ (should (= (point-min) 100))
+ (should (= (point-max) 500))
+ (narrow-to-region 50 150)
+ (should (= (point-min) 100))
+ (should (= (point-max) 150))
+ (widen)
+ (should (= (point-min) 100))
+ (should (= (point-max) 500))
+ (narrow-to-region 400 1000)
+ (should (= (point-min) 400))
+ (should (= (point-max) 500))
+ (without-restriction
+ :label 'bar
+ (should (= (point-min) 100))
+ (should (= (point-max) 500)))
+ (without-restriction
+ :label 'foo
+ (should (= (point-min) 1))
+ (should (= (point-max) 5001)))
+ (should (= (point-min) 400))
+ (should (= (point-max) 500))
+ (widen)
+ (should (= (point-min) 100))
+ (should (= (point-max) 500))
+ (with-restriction
+ 50 250 :label 'bar
+ (should (= (point-min) 100))
+ (should (= (point-max) 250))
+ (widen)
+ (should (= (point-min) 100))
+ (should (= (point-max) 250))
+ (without-restriction
+ :label 'bar
+ (should (= (point-min) 100))
+ (should (= (point-max) 500))
+ (without-restriction
+ :label 'foo
+ (should (= (point-min) 1))
+ (should (= (point-max) 5001)))
+ (should (= (point-min) 100))
+ (should (= (point-max) 500)))
+ (should (= (point-min) 100))
+ (should (= (point-max) 250)))
+ (should (= (point-min) 100))
+ (should (= (point-max) 500))
+ (with-restriction
+ 50 250 :label 'bar
+ (should (= (point-min) 100))
+ (should (= (point-max) 250))
+ (with-restriction
+ 150 500 :label 'baz
+ (should (= (point-min) 150))
+ (should (= (point-max) 250))
+ (without-restriction
+ :label 'bar
+ (should (= (point-min) 150))
+ (should (= (point-max) 250)))
+ (without-restriction
+ :label 'foo
+ (should (= (point-min) 150))
+ (should (= (point-max) 250)))
+ (without-restriction
+ :label 'baz
+ (should (= (point-min) 100))
+ (should (= (point-max) 250))
+ (without-restriction
+ :label 'foo
+ (should (= (point-min) 100))
+ (should (= (point-max) 250)))
+ (without-restriction
+ :label 'bar
+ (should (= (point-min) 100))
+ (should (= (point-max) 500))
+ (without-restriction
+ :label 'foobar
+ (should (= (point-min) 100))
+ (should (= (point-max) 500)))
+ (without-restriction
+ :label 'foo
+ (should (= (point-min) 1))
+ (should (= (point-max) 5001)))
+ (should (= (point-min) 100))
+ (should (= (point-max) 500)))
+ (should (= (point-min) 100))
+ (should (= (point-max) 250)))
+ (should (= (point-min) 150))
+ (should (= (point-max) 250)))
+ (should (= (point-min) 100))
+ (should (= (point-max) 250))))
+ (should (= (point-min) 1))
+ (should (= (point-max) 5001))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 28cee9d2c5b..680fdd57d71 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -772,4 +772,40 @@ comparing the subr with a much slower Lisp implementation."
"Can't set variable marked with 'make_symbol_constant'."
(should-error (setq most-positive-fixnum 1) :type 'setting-constant))
+(ert-deftest data-tests-fset ()
+ (fset 'data-tests--fs-fun (lambda () 'moo))
+ (declare-function data-tests--fs-fun nil)
+ (should (equal (data-tests--fs-fun) 'moo))
+
+ (fset 'data-tests--fs-fun1 'data-tests--fs-fun)
+ (declare-function data-tests--fs-fun1 nil)
+ (should (equal (data-tests--fs-fun1) 'moo))
+
+ (fset 'data-tests--fs-a 'data-tests--fs-b)
+ (fset 'data-tests--fs-b 'data-tests--fs-c)
+
+ (should-error (fset 'data-tests--fs-c 'data-tests--fs-c)
+ :type 'cyclic-function-indirection)
+ (fset 'data-tests--fs-d 'data-tests--fs-a)
+ (should-error (fset 'data-tests--fs-c 'data-tests--fs-d)
+ :type 'cyclic-function-indirection))
+
+(ert-deftest data-tests-defalias ()
+ (defalias 'data-tests--da-fun (lambda () 'baa))
+ (declare-function data-tests--da-fun nil)
+ (should (equal (data-tests--da-fun) 'baa))
+
+ (defalias 'data-tests--da-fun1 'data-tests--da-fun)
+ (declare-function data-tests--da-fun1 nil)
+ (should (equal (data-tests--da-fun1) 'baa))
+
+ (defalias 'data-tests--da-a 'data-tests--da-b)
+ (defalias 'data-tests--da-b 'data-tests--da-c)
+
+ (should-error (defalias 'data-tests--da-c 'data-tests--da-c)
+ :type 'cyclic-function-indirection)
+ (defalias 'data-tests--da-d 'data-tests--da-a)
+ (should-error (defalias 'data-tests--da-c 'data-tests--da-d)
+ :type 'cyclic-function-indirection))
+
;;; data-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index e0d6c96b360..0321b92d0bc 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -622,7 +622,7 @@
(insert "foo")
(goto-char 2)
(insert " ")
- (backward-delete-char 1)
+ (delete-char -1)
(buffer-hash))
(sha1 "foo"))))
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 459a06a39b6..c0ea37d2c55 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -137,11 +137,13 @@ literals (Bug#20852)."
(write-region "?) ?( ?; ?\" ?[ ?]" nil file-name)
(should (equal (load file-name nil :nomessage :nosuffix) t))
(should (equal (lread-tests--last-message)
- (concat (format-message "Loading `%s': " file-name)
- "unescaped character literals "
- "`?\"', `?(', `?)', `?;', `?[', `?]' detected, "
- "`?\\\"', `?\\(', `?\\)', `?\\;', `?\\[', `?\\]' "
- "expected!")))))
+ (format-message
+ (concat "Loading `%s': "
+ "unescaped character literals "
+ "`?\"', `?(', `?)', `?;', `?[', `?]' detected, "
+ "`?\\\"', `?\\(', `?\\)', `?\\;', `?\\[', `?\\]' "
+ "expected!")
+ file-name)))))
(ert-deftest lread-test-bug26837 ()
"Test for https://debbugs.gnu.org/26837 ."
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index 34fa35e32ff..52d43775b8e 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -872,4 +872,15 @@ This evaluates the TESTS test cases from glibc."
(should (equal (string-match "\\`\\(?:ab\\)*\\'" "a") nil))
(should (equal (string-match "\\`a\\{2\\}*\\'" "a") nil)))
+(ert-deftest regexp-tests-backtrack-optimization () ;bug#61514
+ ;; Make sure we don't use up the regexp stack needlessly.
+ (with-current-buffer (get-buffer-create "*bug*")
+ (erase-buffer)
+ (insert (make-string 1000000 ?x) "=")
+ (goto-char (point-min))
+ (should (looking-at "x*=*"))
+ (should (looking-at "x*\\(=\\|:\\)"))
+ (should (looking-at "x*\\(=\\|:\\)*"))
+ (should (looking-at "x*=*?"))))
+
;;; regex-emacs-tests.el ends here
diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el
index a2ab3be7cd8..468cd221ef9 100644
--- a/test/src/treesit-tests.el
+++ b/test/src/treesit-tests.el
@@ -100,6 +100,7 @@
(should (eq nil (treesit-node-check root-node 'missing)))
(should (eq nil (treesit-node-check root-node 'extra)))
(should (eq nil (treesit-node-check root-node 'has-error)))
+ (should (eq t (treesit-node-check root-node 'live)))
;; `treesit-node-child'.
(setq doc-node (treesit-node-child root-node 0))
(should (equal "array" (treesit-node-type doc-node)))
@@ -160,7 +161,18 @@
:type 'args-out-of-range)
;; `treesit-node-eq'.
(should (treesit-node-eq root-node root-node))
- (should (not (treesit-node-eq root-node doc-node))))))
+ (should (not (treesit-node-eq root-node doc-node)))
+
+ ;; Further test for `treesit-node-check'.
+ (treesit-parser-delete parser)
+ (should (equal nil (treesit-node-check root-node 'live)))
+ ;; Recreate parser.
+ (setq parser (treesit-parser-create 'json))
+ (setq root-node (treesit-parser-root-node
+ parser))
+ (should (equal t (treesit-node-check root-node 'live)))
+ (kill-buffer)
+ (should (equal nil (treesit-node-check root-node 'live))))))
;;; Indirect buffer
@@ -965,22 +977,22 @@ and \"]\"."
(defvar treesit--ert-defun-navigation-nested-master
;; START PREV-BEG NEXT-END PREV-END NEXT-BEG
- '((0 103 105 102 106) ; Between Beg of parent & 1st sibling.
+ '((0 103 105 102 104) ; Between Beg of parent & 1st sibling.
(1 103 105 102 106) ; Beg of 1st sibling.
(2 104 105 102 106) ; Inside 1st sibling.
- (3 104 107 102 109) ; End of 1st sibling.
- (4 104 107 102 109) ; Between 1st sibling & 2nd sibling.
- (5 104 107 102 109) ; Beg of 2nd sibling.
+ (3 104 107 102 106) ; End of 1st sibling.
+ (4 104 107 105 106) ; Between 1st sibling & 2nd sibling.
+ (5 104 107 105 109) ; Beg of 2nd sibling.
(6 106 107 105 109) ; Inside 2nd sibling.
(7 106 108 105 109) ; End of 2nd sibling.
- (8 106 108 105 109) ; Between 2nd sibling & end of parent.
- (9 103 110 102 nil) ; End of parent.
+ (8 106 108 107 109) ; Between 2nd sibling & end of parent.
+ (9 103 110 102 109) ; End of parent.
- (100 nil 102 nil 103) ; Before 1st parent.
+ (100 nil 102 nil 101) ; Before 1st parent.
(101 nil 102 nil 103) ; Beg of 1st parent.
- (102 101 108 nil 109) ; Between 1st & 2nd parent.
- (103 101 108 nil 109) ; Beg of 2nd parent.
- (110 109 nil 108 nil) ; After 3rd parent.
+ (102 101 108 102 103) ; Between 1st & 2nd parent.
+ (103 101 108 102 109) ; Beg of 2nd parent.
+ (110 109 nil 110 nil) ; After 3rd parent.
)
"Master of nested navigation test.
@@ -988,7 +1000,7 @@ This basically says, e.g., \"start with point on marker 0,
go to
the prev-beg, now point should be at marker 103\", etc.")
(defvar treesit--ert-defun-navigation-top-level-master
- ;; START PREV-BEG NEXT-END NEXT-BEG PREV-END
+ ;; START PREV-BEG NEXT-END PREV-END NEXT-BEG
'((0 103 108 102 109) ; Between Beg of parent & 1st sibling.
(1 103 108 102 109) ; Beg of 1st sibling.
(2 103 108 102 109) ; Inside 1st sibling.
@@ -998,14 +1010,14 @@ the prev-beg, now point should be at marker 103\", etc.")
(6 103 108 102 109) ; Inside 2nd sibling.
(7 103 108 102 109) ; End of 2nd sibling.
(8 103 108 102 109) ; Between 2nd sibling & end of parent.
- (9 103 110 102 nil) ; End of parent.
+ (9 103 110 102 109) ; End of parent.
;; Top-level defuns should be identical to the nested test.
- (100 nil 102 nil 103) ; Before 1st parent.
+ (100 nil 102 nil 101) ; Before 1st parent.
(101 nil 102 nil 103) ; Beg of 1st parent.
- (102 101 108 nil 109) ; Between 1st & 2nd parent.
- (103 101 108 nil 109) ; Beg of 2nd parent.
- (110 109 nil 108 nil) ; After 3rd parent.
+ (102 101 108 102 103) ; Between 1st & 2nd parent.
+ (103 101 108 102 109) ; Beg of 2nd parent.
+ (110 109 nil 110 nil) ; After 3rd parent.
)
"Master of top-level navigation test.")