diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2023-03-21 14:54:22 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2023-03-21 14:54:22 -0700 |
| commit | 4b50e19f1a6bd81688d68994d2aea051685f2ebd (patch) | |
| tree | f50f702e6195670f63fca9f86eaa3c933a1fe587 | |
| parent | 343a3fa966f28350911fc85346df2023b6a610d5 (diff) | |
| parent | 42fba8f36b19536964d6deb6a34f3fd1c02b43dd (diff) | |
| download | emacs-4b50e19f1a6bd81688d68994d2aea051685f2ebd.tar.gz | |
Merge upstream Git snapshot into athena/unstable
680 files changed, 41250 insertions, 30110 deletions
diff --git a/CONTRIBUTE b/CONTRIBUTE index 674b4e5b18c..dcf34f48fe5 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -18,7 +18,7 @@ To configure Git for Emacs development, you can run the following: The following shell commands then build and run Emacs from scratch: - git clone git://git.sv.gnu.org/emacs.git + git clone https://git.savannah.gnu.org/git/emacs.git cd emacs ./autogen.sh ./configure 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/INSTALL.REPO b/INSTALL.REPO index dcbbbcb9594..ea88842cfa9 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -4,7 +4,7 @@ The Emacs repository is hosted on Savannah. The following Git command will clone the repository to the 'emacs' subdirectory of the current directory on your local machine: - git clone git://git.sv.gnu.org/emacs.git + git clone https://git.savannah.gnu.org/git/emacs.git To build the repository code, simply run 'make' in the 'emacs' directory. This should work if your files are freshly checked out diff --git a/Makefile.in b/Makefile.in index 2fb7754d683..4f2f2f15c97 100644 --- a/Makefile.in +++ b/Makefile.in @@ -841,7 +841,7 @@ install-etc: rm -f $${tmp} tmp=etc/emacsclient.tmpdesktop; rm -f $${tmp}; \ client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \ - sed -e "/^Exec=emacsclient/ s|emacsclient|${bindir}/$${client_name}|" \ + sed -e "/^Exec=/ s|emacsclient|${bindir}/$${client_name}|" \ -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \ $(USE_STARTUP_NOTIFICATION_SED_CMD) \ ${srcdir}/etc/emacsclient.desktop > $${tmp}; \ @@ -855,7 +855,7 @@ install-etc: rm -f $${tmp} tmp=etc/emacsclient-mail.tmpdesktop; rm -f $${tmp}; \ client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \ - sed -e "/^Exec=emacsclient/ s|emacsclient|${bindir}/$${client_name}|" \ + sed -e "/^Exec=/ s|emacsclient|${bindir}/$${client_name}|" \ -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \ ${srcdir}/etc/emacsclient-mail.desktop > $${tmp}; \ ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/$${client_name}-mail.desktop"; \ @@ -2,7 +2,7 @@ Copyright (C) 2001-2023 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 29.0.60 of GNU Emacs, the extensible, +This directory tree holds version 30.0.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 6e080d1f5bb..1273e9a976b 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -294,7 +294,7 @@ Po Lu Tramp Maintainer: Michael Albinus - Repository: git://git.savannah.gnu.org/tramp.git + Repository: https://git.savannah.gnu.org/git/tramp.git Mailing List: tramp-devel@gnu.org Bug Reports: M-x tramp-bug Notes: For backward compatibility requirements, see @@ -316,7 +316,7 @@ Modus themes Org Mode Home Page: https://orgmode.org/ Maintainer: Org Mode developers - Repository: git://git.sv.gnu.org/emacs/org-mode.git + Repository: https://git.savannah.gnu.org/git/emacs/org-mode.git Mailing list: emacs-orgmode@gnu.org Bug Reports: M-x org-submit-bug-report Notes: Org Mode is maintained as a separate project that is diff --git a/admin/admin.el b/admin/admin.el index 735d426b09b..90f810b79c6 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -110,7 +110,7 @@ Root must be the root of an Emacs source tree." (submatch (1+ (in "0-9.")))))) (set-version-in-file root "configure.ac" version (rx (and "AC_INIT" (1+ (not (in ?,))) - ?, (0+ space) ?\[ + ?, (0+ space) (submatch (1+ (in "0-9.")))))) (set-version-in-file root "nt/README.W32" version (rx (and "version" (1+ space) @@ -843,8 +843,11 @@ $Date: %s $ (package-install pkg) (require pkg nil t)))) +(declare-function org-html-export-as-html "ox-html.el") (defvar org-html-postamble) (defvar org-html-mathjax-template) +(defvar htmlize-output-type) + (defun make-news-html-file (root version) "Convert the NEWS file into an HTML file." (interactive (let ((root diff --git a/admin/find-gc.el b/admin/find-gc.el index cce4a8402a7..7cb319d867a 100644 --- a/admin/find-gc.el +++ b/admin/find-gc.el @@ -100,7 +100,7 @@ Also store it in `find-gc-unsafe-list'." -(defun trace-call-tree (&optional ignored) +(defun trace-call-tree (&optional _ignored) (message "Setting up directories...") (setq find-gc-subrs-called nil) (let ((case-fold-search nil) diff --git a/admin/git-bisect-start b/admin/git-bisect-start index a439ee7fe15..511111c7f65 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 Feb 28 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,49 @@ $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 +# SKIP-SINGLE 8d8464bd5a98598e7a6fe63370545c7f07574926 +# SKIP-SINGLE 11c4177430230ef41cb700c48afecf475cf39893 +# SKIP-SINGLE cf3c89423fabc2c5a7891a5b5465fa995e461218 +# SKIP-SINGLE 8d5d7509b0a2c248084fa349b0b188d4de4af804 +# SKIP-SINGLE b6e2799aa1c3887c2995e115e6ff2f69d59f0e44 +# SKIP-SINGLE 1795839babcf8572a79aaee3c76ca5b357937a59 +# SKIP-SINGLE abfd00e5c02ec0aed8bbac1eca0d0db1874f020a +# SKIP-SINGLE 8aef401b4f66a64ddfa9390590fb2cae1f96d522 +# SKIP-SINGLE d5bf26f488b7968feed9f43e612a90da2aab15a8 +# SKIP-SINGLE 5d0912f1445e33f1ccf23a84f0dc6d08c4ee2b60 +# SKIP-SINGLE 95692f6754c3a8f55a90df2d6f7ce62be55cdcfc +# SKIP-SINGLE a3edacd3f547195740304139cb68aaa94d7b18ee +# SKIP-SINGLE ae4ff4f25fbf704446f8f38d8e818f223b79042b diff --git a/admin/gitmerge.el b/admin/gitmerge.el index a172fa2bc9b..396d2fe2ac5 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -293,7 +293,7 @@ should not be skipped." "Try to resolve conflicts in FILE with smerge. Returns non-nil if conflicts remain." (unless (file-exists-p file) (error "Gitmerge-resolve: Can't find %s" file)) - (with-demoted-errors + (with-demoted-errors "Error: %S" (let ((exists (find-buffer-visiting file))) (with-current-buffer (let ((enable-local-variables :safe) (enable-local-eval nil)) 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/merge-gnulib b/admin/merge-gnulib index 6aa52bc7539..917ddda1fd5 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -23,29 +23,30 @@ # written by Paul Eggert -GNULIB_URL=git://git.savannah.gnu.org/gnulib.git +GNULIB_URL=https://git.savannah.gnu.org/git/gnulib.git GNULIB_MODULES=' - alloca-opt binary-io byteswap c-ctype c-strcase + alignasof alloca-opt binary-io byteswap c-ctype c-strcase canonicalize-lgpl careadlinkat close-stream copy-file-range count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer d-type diffseq double-slash-root dtoastr dtotimespec dup2 - environ execinfo explicit_bzero faccessat + environ execinfo faccessat fchmodat fcntl fcntl-h fdopendir file-has-acl filemode filename filevercmp flexmember fpieee free-posix fstatat fsusage fsync futimens getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog ieee754-h ignore-value intprops largefile libgmp lstat - manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime + manywarnings memmem-simple mempcpy memrchr memset_explicit + minmax mkostemp mktime nanosleep nproc nstrftime pathmax pipe2 pselect pthread_sigmask qcopy-acl readlink readlinkat regex - sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stdbool stddef stdio + sig2str sigdescr_np socklen stat-time std-gnu11 stdbool stddef stdio stpcpy strnlen strtoimax symlink sys_stat sys_time - tempname time time_r time_rz timegm timer-time timespec-add timespec-sub + tempname time-h time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright unlocked-io utimensat vla warnings ' diff --git a/admin/notes/elpa b/admin/notes/elpa index 1e9e7a9f52b..afcda71d1dd 100644 --- a/admin/notes/elpa +++ b/admin/notes/elpa @@ -3,7 +3,7 @@ NOTES ON THE EMACS PACKAGE ARCHIVE The GNU Emacs package archive, at elpa.gnu.org, is managed using a Git repository named "elpa", hosted on Savannah. To check it out: - git clone git://git.sv.gnu.org/emacs/elpa + git clone https://git.savannah.gnu.org/git/emacs/elpa cd elpa make setup diff --git a/admin/notes/git-workflow b/admin/notes/git-workflow index 717fc550776..d33f49a1aca 100644 --- a/admin/notes/git-workflow +++ b/admin/notes/git-workflow @@ -16,14 +16,14 @@ Initial setup Then we want to clone the repository. We normally want to have both the current master and (if there is one) the active release branch -(eg emacs-28). +(eg emacs-29). mkdir ~/emacs cd ~/emacs git clone <membername>@git.sv.gnu.org:/srv/git/emacs.git master cd master git config push.default current -git worktree add ../emacs-28 emacs-28 +git worktree add ../emacs-29 emacs-29 You now have both branches conveniently accessible, and you can do "git pull" in them once in a while to keep updated. @@ -67,10 +67,10 @@ which will look like commit 958b768a6534ae6e77a8547a56fc31b46b63710b -cd ~/emacs/emacs-28 +cd ~/emacs/emacs-29 git cherry-pick -xe 958b768a6534ae6e77a8547a56fc31b46b63710b -and optionally add "Backport:" to the commit string. Then +and add "Backport:" to the commit string. Then git push @@ -109,7 +109,7 @@ up-to-date by doing a pull. Then start Emacs with emacs -l admin/gitmerge.el -f gitmerge You'll be asked for the branch to merge, which will default to -(eg) 'origin/emacs-28', which you should accept. Merging a local tracking +(eg) 'origin/emacs-29', which you should accept. Merging a local tracking branch is discouraged, since it might not be up-to-date, or worse, contain commits from you which are not yet pushed upstream. diff --git a/admin/notes/tree-sitter/build-module/README b/admin/notes/tree-sitter/build-module/README deleted file mode 100644 index 2fcb9778dae..00000000000 --- a/admin/notes/tree-sitter/build-module/README +++ /dev/null @@ -1,17 +0,0 @@ -To build the language definition for a particular language, run - - ./build.sh <language> - -eg, - - ./build.sh html - -The dynamic module will be in /dist directory - -To build all modules at once, run - - ./batch.sh - -This gives you C, JSON, Go, HTML, Javascript, CSS, Python, Typescript -(tsx), C# (csharp), C++ (cpp), Rust. More can be added to batch.sh -unless it's directory structure is not standard.
\ No newline at end of file diff --git a/admin/notes/tree-sitter/build-module/batch.sh b/admin/notes/tree-sitter/build-module/batch.sh index 58272c74549..1d4076564dc 100755 --- a/admin/notes/tree-sitter/build-module/batch.sh +++ b/admin/notes/tree-sitter/build-module/batch.sh @@ -8,8 +8,10 @@ languages=( 'css' 'c-sharp' 'dockerfile' + 'elixir' 'go' 'go-mod' + 'heex' 'html' 'javascript' 'json' diff --git a/admin/notes/tree-sitter/build-module/build.sh b/admin/notes/tree-sitter/build-module/build.sh index f0962940287..0832875168b 100755 --- a/admin/notes/tree-sitter/build-module/build.sh +++ b/admin/notes/tree-sitter/build-module/build.sh @@ -3,12 +3,17 @@ lang=$1 topdir="$PWD" -if [ $(uname) == "Darwin" ] -then - soext="dylib" -else - soext="so" -fi +case $(uname) in + "Darwin") + soext="dylib" + ;; + *"MINGW"*) + soext="dll" + ;; + *) + soext="so" + ;; +esac echo "Building ${lang}" @@ -26,11 +31,17 @@ case "${lang}" in "cmake") org="uyha" ;; + "elixir") + org="elixir-lang" + ;; "go-mod") # The parser is called "gomod". lang="gomod" org="camdencheek" ;; + "heex") + org="phoenixframework" + ;; "typescript") sourcedir="tree-sitter-typescript/typescript/src" grammardir="tree-sitter-typescript/typescript" diff --git a/admin/notes/tree-sitter/html-manual/Accessing-Node.html b/admin/notes/tree-sitter/html-manual/Accessing-Node.html deleted file mode 100644 index afbbdaa11b5..00000000000 --- a/admin/notes/tree-sitter/html-manual/Accessing-Node.html +++ /dev/null @@ -1,205 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Accessing Node (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Accessing Node (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Accessing Node (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> -<link href="Pattern-Matching.html" rel="next" title="Pattern Matching"> -<link href="Retrieving-Node.html" rel="prev" title="Retrieving Node"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="section" id="Accessing-Node"> -<div class="header"> -<p> -Next: <a href="Pattern-Matching.html" accesskey="n" rel="next">Pattern Matching Tree-sitter Nodes</a>, Previous: <a href="Retrieving-Node.html" accesskey="p" rel="prev">Retrieving Node</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Accessing-Node-Information"></span><h3 class="section">37.4 Accessing Node Information</h3> - -<p>Before going further, make sure you have read the basic conventions -about tree-sitter nodes in the previous node. -</p> -<span id="Basic-information"></span><h3 class="heading">Basic information</h3> - -<p>Every node is associated with a parser, and that parser is associated -with a buffer. The following functions let you retrieve them. -</p> -<dl class="def"> -<dt id="index-treesit_002dnode_002dparser"><span class="category">Function: </span><span><strong>treesit-node-parser</strong> <em>node</em><a href='#index-treesit_002dnode_002dparser' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns <var>node</var>’s associated parser. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dbuffer"><span class="category">Function: </span><span><strong>treesit-node-buffer</strong> <em>node</em><a href='#index-treesit_002dnode_002dbuffer' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns <var>node</var>’s parser’s associated buffer. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dlanguage"><span class="category">Function: </span><span><strong>treesit-node-language</strong> <em>node</em><a href='#index-treesit_002dnode_002dlanguage' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns <var>node</var>’s parser’s associated language. -</p></dd></dl> - -<p>Each node represents a piece of text in the buffer. Functions below -finds relevant information about that text. -</p> -<dl class="def"> -<dt id="index-treesit_002dnode_002dstart"><span class="category">Function: </span><span><strong>treesit-node-start</strong> <em>node</em><a href='#index-treesit_002dnode_002dstart' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Return the start position of <var>node</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dend"><span class="category">Function: </span><span><strong>treesit-node-end</strong> <em>node</em><a href='#index-treesit_002dnode_002dend' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Return the end position of <var>node</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dtext"><span class="category">Function: </span><span><strong>treesit-node-text</strong> <em>node &optional object</em><a href='#index-treesit_002dnode_002dtext' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Returns the buffer text that <var>node</var> represents. (If <var>node</var> is -retrieved from parsing a string, it will be text from that string.) -</p></dd></dl> - -<p>Here are some basic checks on tree-sitter nodes. -</p> -<dl class="def"> -<dt id="index-treesit_002dnode_002dp"><span class="category">Function: </span><span><strong>treesit-node-p</strong> <em>object</em><a href='#index-treesit_002dnode_002dp' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Checks if <var>object</var> is a tree-sitter syntax node. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002deq"><span class="category">Function: </span><span><strong>treesit-node-eq</strong> <em>node1 node2</em><a href='#index-treesit_002dnode_002deq' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Checks if <var>node1</var> and <var>node2</var> are the same node in a syntax -tree. -</p></dd></dl> - -<span id="Property-information"></span><h3 class="heading">Property information</h3> - -<p>In general, nodes in a concrete syntax tree fall into two categories: -<em>named nodes</em> and <em>anonymous nodes</em>. Whether a node is named -or anonymous is determined by the language definition -(see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). -</p> -<span id="index-tree_002dsitter-missing-node"></span> -<p>Apart from being named/anonymous, a node can have other properties. A -node can be “missing”: missing nodes are inserted by the parser in -order to recover from certain kinds of syntax errors, i.e., something -should probably be there according to the grammar, but not there. -</p> -<span id="index-tree_002dsitter-extra-node"></span> -<p>A node can be “extra”: extra nodes represent things like comments, -which can appear anywhere in the text. -</p> -<span id="index-tree_002dsitter-node-that-has-changes"></span> -<p>A node “has changes” if the buffer changed since when the node is -retrieved, i.e., outdated. -</p> -<span id="index-tree_002dsitter-node-that-has-error"></span> -<p>A node “has error” if the text it spans contains a syntax error. It -can be the node itself has an error, or one of its -children/grandchildren... has an error. -</p> -<dl class="def"> -<dt id="index-treesit_002dnode_002dcheck"><span class="category">Function: </span><span><strong>treesit-node-check</strong> <em>node property</em><a href='#index-treesit_002dnode_002dcheck' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function checks if <var>node</var> has <var>property</var>. <var>property</var> -can be <code>'named</code>, <code>'missing</code>, <code>'extra</code>, -<code>'has-changes</code>, or <code>'has-error</code>. -</p></dd></dl> - - -<dl class="def"> -<dt id="index-treesit_002dnode_002dtype"><span class="category">Function: </span><span><strong>treesit-node-type</strong> <em>node</em><a href='#index-treesit_002dnode_002dtype' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Named nodes have “types” (see <a href="Language-Definitions.html#tree_002dsitter-node-type">node type</a>). -For example, a named node can be a <code>string_literal</code> node, where -<code>string_literal</code> is its type. -</p> -<p>This function returns <var>node</var>’s type as a string. -</p></dd></dl> - -<span id="Information-as-a-child-or-parent"></span><h3 class="heading">Information as a child or parent</h3> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dindex"><span class="category">Function: </span><span><strong>treesit-node-index</strong> <em>node &optional named</em><a href='#index-treesit_002dnode_002dindex' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the index of <var>node</var> as a child node of its -parent. If <var>named</var> is non-nil, it only count named nodes -(see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dfield_002dname"><span class="category">Function: </span><span><strong>treesit-node-field-name</strong> <em>node</em><a href='#index-treesit_002dnode_002dfield_002dname' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>A child of a parent node could have a field name (see <a href="Language-Definitions.html#tree_002dsitter-node-field-name">field name</a>). This function returns the field name -of <var>node</var> as a child of its parent. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dfield_002dname_002dfor_002dchild"><span class="category">Function: </span><span><strong>treesit-node-field-name-for-child</strong> <em>node n</em><a href='#index-treesit_002dnode_002dfield_002dname_002dfor_002dchild' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the field name of the <var>n</var>’th child of -<var>node</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dchild_002dcount"><span class="category">Function: </span><span><strong>treesit-node-child-count</strong> <em>node &optional named</em><a href='#index-treesit_002dchild_002dcount' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function finds the number of children of <var>node</var>. If -<var>named</var> is non-nil, it only counts named child (see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). -</p></dd></dl> - -</div> -<hr> -<div class="header"> -<p> -Next: <a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>, Previous: <a href="Retrieving-Node.html">Retrieving Node</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/Language-Definitions.html b/admin/notes/tree-sitter/html-manual/Language-Definitions.html deleted file mode 100644 index 9b1e0021272..00000000000 --- a/admin/notes/tree-sitter/html-manual/Language-Definitions.html +++ /dev/null @@ -1,401 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Language Definitions (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Language Definitions (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Language Definitions (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> -<link href="Using-Parser.html" rel="next" title="Using Parser"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="section" id="Language-Definitions"> -<div class="header"> -<p> -Next: <a href="Using-Parser.html" accesskey="n" rel="next">Using Tree-sitter Parser</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Tree_002dsitter-Language-Definitions"></span><h3 class="section">37.1 Tree-sitter Language Definitions</h3> -<span id="index-language-definitions_002c-for-tree_002dsitter"></span> - -<span id="Loading-a-language-definition"></span><h3 class="heading">Loading a language definition</h3> -<span id="index-loading-language-definition-for-tree_002dsitter"></span> - -<span id="index-language-argument_002c-for-tree_002dsitter"></span> -<p>Tree-sitter relies on language definitions to parse text in that -language. In Emacs, a language definition is represented by a symbol. -For example, the C language definition is represented as the symbol -<code>c</code>, and <code>c</code> can be passed to tree-sitter functions as the -<var>language</var> argument. -</p> -<span id="index-treesit_002dextra_002dload_002dpath"></span> -<span id="index-treesit_002dload_002dlanguage_002derror"></span> -<span id="index-treesit_002dload_002dsuffixes"></span> -<p>Tree-sitter language definitions are distributed as dynamic libraries. -In order to use a language definition in Emacs, you need to make sure -that the dynamic library is installed on the system. Emacs looks for -language definitions in several places, in the following order: -</p> -<ul> -<li> first, in the list of directories specified by the variable -<code>treesit-extra-load-path</code>; -</li><li> then, in the <samp>tree-sitter</samp> subdirectory of the directory -specified by <code>user-emacs-directory</code> (see <a href="Init-File.html">The Init File</a>); -</li><li> and finally, in the system’s default locations for dynamic libraries. -</li></ul> - -<p>In each of these directories, Emacs looks for a file with file-name -extensions specified by the variable <code>dynamic-library-suffixes</code>. -</p> -<p>If Emacs cannot find the library or has problems loading it, Emacs -signals the <code>treesit-load-language-error</code> error. The data of -that signal could be one of the following: -</p> -<dl compact="compact"> -<dt><span><code>(not-found <var>error-msg</var> …)</code></span></dt> -<dd><p>This means that Emacs could not find the language definition library. -</p></dd> -<dt><span><code>(symbol-error <var>error-msg</var>)</code></span></dt> -<dd><p>This means that Emacs could not find in the library the expected function -that every language definition library should export. -</p></dd> -<dt><span><code>(version-mismatch <var>error-msg</var>)</code></span></dt> -<dd><p>This means that the version of language definition library is incompatible -with that of the tree-sitter library. -</p></dd> -</dl> - -<p>In all of these cases, <var>error-msg</var> might provide additional -details about the failure. -</p> -<dl class="def"> -<dt id="index-treesit_002dlanguage_002davailable_002dp"><span class="category">Function: </span><span><strong>treesit-language-available-p</strong> <em>language &optional detail</em><a href='#index-treesit_002dlanguage_002davailable_002dp' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns non-<code>nil</code> if the language definitions for -<var>language</var> exist and can be loaded. -</p> -<p>If <var>detail</var> is non-<code>nil</code>, return <code>(t . nil)</code> when -<var>language</var> is available, and <code>(nil . <var>data</var>)</code> when it’s -unavailable. <var>data</var> is the signal data of -<code>treesit-load-language-error</code>. -</p></dd></dl> - -<span id="index-treesit_002dload_002dname_002doverride_002dlist"></span> -<p>By convention, the file name of the dynamic library for <var>language</var> is -<samp>libtree-sitter-<var>language</var>.<var>ext</var></samp>, where <var>ext</var> is the -system-specific extension for dynamic libraries. Also by convention, -the function provided by that library is named -<code>tree_sitter_<var>language</var></code>. If a language definition library -doesn’t follow this convention, you should add an entry -</p> -<div class="example"> -<pre class="example">(<var>language</var> <var>library-base-name</var> <var>function-name</var>) -</pre></div> - -<p>to the list in the variable <code>treesit-load-name-override-list</code>, where -<var>library-base-name</var> is the basename of the dynamic library’s file name, -(usually, <samp>libtree-sitter-<var>language</var></samp>), and -<var>function-name</var> is the function provided by the library -(usually, <code>tree_sitter_<var>language</var></code>). For example, -</p> -<div class="example"> -<pre class="example">(cool-lang "libtree-sitter-coool" "tree_sitter_cooool") -</pre></div> - -<p>for a language that considers itself too “cool” to abide by -conventions. -</p> -<span id="index-language_002ddefinition-version_002c-compatibility"></span> -<dl class="def"> -<dt id="index-treesit_002dlanguage_002dversion"><span class="category">Function: </span><span><strong>treesit-language-version</strong> <em>&optional min-compatible</em><a href='#index-treesit_002dlanguage_002dversion' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the version of the language-definition -Application Binary Interface (<acronym>ABI</acronym>) supported by the -tree-sitter library. By default, it returns the latest ABI version -supported by the library, but if <var>min-compatible</var> is -non-<code>nil</code>, it returns the oldest ABI version which the library -still can support. Language definition libraries must be built for -ABI versions between the oldest and the latest versions supported by -the tree-sitter library, otherwise the library will be unable to load -them. -</p></dd></dl> - -<span id="Concrete-syntax-tree"></span><h3 class="heading">Concrete syntax tree</h3> -<span id="index-syntax-tree_002c-concrete"></span> - -<p>A syntax tree is what a parser generates. In a syntax tree, each node -represents a piece of text, and is connected to each other by a -parent-child relationship. For example, if the source text is -</p> -<div class="example"> -<pre class="example">1 + 2 -</pre></div> - -<p>its syntax tree could be -</p> -<div class="example"> -<pre class="example"> +--------------+ - | root "1 + 2" | - +--------------+ - | - +--------------------------------+ - | expression "1 + 2" | - +--------------------------------+ - | | | -+------------+ +--------------+ +------------+ -| number "1" | | operator "+" | | number "2" | -+------------+ +--------------+ +------------+ -</pre></div> - -<p>We can also represent it as an s-expression: -</p> -<div class="example"> -<pre class="example">(root (expression (number) (operator) (number))) -</pre></div> - -<span id="Node-types"></span><h4 class="subheading">Node types</h4> -<span id="index-node-types_002c-in-a-syntax-tree"></span> - -<span id="index-type-of-node_002c-tree_002dsitter"></span> -<span id="tree_002dsitter-node-type"></span><span id="index-named-node_002c-tree_002dsitter"></span> -<span id="tree_002dsitter-named-node"></span><span id="index-anonymous-node_002c-tree_002dsitter"></span> -<p>Names like <code>root</code>, <code>expression</code>, <code>number</code>, and -<code>operator</code> specify the <em>type</em> of the nodes. However, not all -nodes in a syntax tree have a type. Nodes that don’t have a type are -known as <em>anonymous nodes</em>, and nodes with a type are <em>named -nodes</em>. Anonymous nodes are tokens with fixed spellings, including -punctuation characters like bracket ‘<samp>]</samp>’, and keywords like -<code>return</code>. -</p> -<span id="Field-names"></span><h4 class="subheading">Field names</h4> - -<span id="index-field-name_002c-tree_002dsitter"></span> -<span id="index-tree_002dsitter-node-field-name"></span> -<span id="tree_002dsitter-node-field-name"></span><p>To make the syntax tree easier to analyze, many language definitions -assign <em>field names</em> to child nodes. For example, a -<code>function_definition</code> node could have a <code>declarator</code> and a -<code>body</code>: -</p> -<div class="example"> -<pre class="example">(function_definition - declarator: (declaration) - body: (compound_statement)) -</pre></div> - -<span id="Exploring-the-syntax-tree"></span><h3 class="heading">Exploring the syntax tree</h3> -<span id="index-explore-tree_002dsitter-syntax-tree"></span> -<span id="index-inspection-of-tree_002dsitter-parse-tree-nodes"></span> - -<p>To aid in understanding the syntax of a language and in debugging of -Lisp program that use the syntax tree, Emacs provides an “explore” -mode, which displays the syntax tree of the source in the current -buffer in real time. Emacs also comes with an “inspect mode”, which -displays information of the nodes at point in the mode-line. -</p> -<dl class="def"> -<dt id="index-treesit_002dexplore_002dmode"><span class="category">Command: </span><span><strong>treesit-explore-mode</strong><a href='#index-treesit_002dexplore_002dmode' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This mode pops up a window displaying the syntax tree of the source in -the current buffer. Selecting text in the source buffer highlights -the corresponding nodes in the syntax tree display. Clicking -on nodes in the syntax tree highlights the corresponding text in the -source buffer. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dinspect_002dmode"><span class="category">Command: </span><span><strong>treesit-inspect-mode</strong><a href='#index-treesit_002dinspect_002dmode' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This minor mode displays on the mode-line the node that <em>starts</em> -at point. For example, the mode-line can display -</p> -<div class="example"> -<pre class="example"><var>parent</var> <var>field</var>: (<var>node</var> (<var>child</var> (…))) -</pre></div> - -<p>where <var>node</var>, <var>child</var>, etc., are nodes which begin at point. -<var>parent</var> is the parent of <var>node</var>. <var>node</var> is displayed in -a bold typeface. <var>field-name</var>s are field names of <var>node</var> and -of <var>child</var>, etc. -</p> -<p>If no node starts at point, i.e., point is in the middle of a node, -then the mode line displays the earliest node that spans point, and -its immediate parent. -</p> -<p>This minor mode doesn’t create parsers on its own. It uses the first -parser in <code>(treesit-parser-list)</code> (see <a href="Using-Parser.html">Using Tree-sitter Parser</a>). -</p></dd></dl> - -<span id="Reading-the-grammar-definition"></span><h3 class="heading">Reading the grammar definition</h3> -<span id="index-reading-grammar-definition_002c-tree_002dsitter"></span> - -<p>Authors of language definitions define the <em>grammar</em> of a -programming language, which determines how a parser constructs a -concrete syntax tree out of the program text. In order to use the -syntax tree effectively, you need to consult the <em>grammar file</em>. -</p> -<p>The grammar file is usually <samp>grammar.js</samp> in a language -definition’s project repository. The link to a language definition’s -home page can be found on -<a href="https://tree-sitter.github.io/tree-sitter">tree-sitter’s -homepage</a>. -</p> -<p>The grammar definition is written in JavaScript. For example, the -rule matching a <code>function_definition</code> node looks like -</p> -<div class="example"> -<pre class="example">function_definition: $ => seq( - $.declaration_specifiers, - field('declarator', $.declaration), - field('body', $.compound_statement) -) -</pre></div> - -<p>The rules are represented by functions that take a single argument -<var>$</var>, representing the whole grammar. The function itself is -constructed by other functions: the <code>seq</code> function puts together -a sequence of children; the <code>field</code> function annotates a child -with a field name. If we write the above definition in the so-called -<em>Backus-Naur Form</em> (<acronym>BNF</acronym>) syntax, it would look like -</p> -<div class="example"> -<pre class="example">function_definition := - <declaration_specifiers> <declaration> <compound_statement> -</pre></div> - -<p>and the node returned by the parser would look like -</p> -<div class="example"> -<pre class="example">(function_definition - (declaration_specifier) - declarator: (declaration) - body: (compound_statement)) -</pre></div> - -<p>Below is a list of functions that one can see in a grammar definition. -Each function takes other rules as arguments and returns a new rule. -</p> -<dl compact="compact"> -<dt><span><code>seq(<var>rule1</var>, <var>rule2</var>, …)</code></span></dt> -<dd><p>matches each rule one after another. -</p></dd> -<dt><span><code>choice(<var>rule1</var>, <var>rule2</var>, …)</code></span></dt> -<dd><p>matches one of the rules in its arguments. -</p></dd> -<dt><span><code>repeat(<var>rule</var>)</code></span></dt> -<dd><p>matches <var>rule</var> for <em>zero or more</em> times. -This is like the ‘<samp>*</samp>’ operator in regular expressions. -</p></dd> -<dt><span><code>repeat1(<var>rule</var>)</code></span></dt> -<dd><p>matches <var>rule</var> for <em>one or more</em> times. -This is like the ‘<samp>+</samp>’ operator in regular expressions. -</p></dd> -<dt><span><code>optional(<var>rule</var>)</code></span></dt> -<dd><p>matches <var>rule</var> for <em>zero or one</em> time. -This is like the ‘<samp>?</samp>’ operator in regular expressions. -</p></dd> -<dt><span><code>field(<var>name</var>, <var>rule</var>)</code></span></dt> -<dd><p>assigns field name <var>name</var> to the child node matched by <var>rule</var>. -</p></dd> -<dt><span><code>alias(<var>rule</var>, <var>alias</var>)</code></span></dt> -<dd><p>makes nodes matched by <var>rule</var> appear as <var>alias</var> in the syntax -tree generated by the parser. For example, -</p> -<div class="example"> -<pre class="example">alias(preprocessor_call_exp, call_expression) -</pre></div> - -<p>makes any node matched by <code>preprocessor_call_exp</code> appear as -<code>call_expression</code>. -</p></dd> -</dl> - -<p>Below are grammar functions of lesser importance for reading a -language definition. -</p> -<dl compact="compact"> -<dt><span><code>token(<var>rule</var>)</code></span></dt> -<dd><p>marks <var>rule</var> to produce a single leaf node. That is, instead of -generating a parent node with individual child nodes under it, -everything is combined into a single leaf node. See <a href="Retrieving-Nodes.html">Retrieving Nodes</a>. -</p></dd> -<dt><span><code>token.immediate(<var>rule</var>)</code></span></dt> -<dd><p>Normally, grammar rules ignore preceding whitespace; this -changes <var>rule</var> to match only when there is no preceding -whitespaces. -</p></dd> -<dt><span><code>prec(<var>n</var>, <var>rule</var>)</code></span></dt> -<dd><p>gives <var>rule</var> the level-<var>n</var> precedence. -</p></dd> -<dt><span><code>prec.left([<var>n</var>,] <var>rule</var>)</code></span></dt> -<dd><p>marks <var>rule</var> as left-associative, optionally with level <var>n</var>. -</p></dd> -<dt><span><code>prec.right([<var>n</var>,] <var>rule</var>)</code></span></dt> -<dd><p>marks <var>rule</var> as right-associative, optionally with level <var>n</var>. -</p></dd> -<dt><span><code>prec.dynamic(<var>n</var>, <var>rule</var>)</code></span></dt> -<dd><p>this is like <code>prec</code>, but the precedence is applied at runtime -instead. -</p></dd> -</dl> - -<p>The documentation of the tree-sitter project has -<a href="https://tree-sitter.github.io/tree-sitter/creating-parsers">more -about writing a grammar</a>. Read especially “The Grammar DSL” -section. -</p> -</div> -<hr> -<div class="header"> -<p> -Next: <a href="Using-Parser.html">Using Tree-sitter Parser</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/Multiple-Languages.html b/admin/notes/tree-sitter/html-manual/Multiple-Languages.html deleted file mode 100644 index 65507687d51..00000000000 --- a/admin/notes/tree-sitter/html-manual/Multiple-Languages.html +++ /dev/null @@ -1,327 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Multiple Languages (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Multiple Languages (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Multiple Languages (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> -<link href="Tree_002dsitter-major-modes.html" rel="next" title="Tree-sitter major modes"> -<link href="Pattern-Matching.html" rel="prev" title="Pattern Matching"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="section" id="Multiple-Languages"> -<div class="header"> -<p> -Next: <a href="Tree_002dsitter-major-modes.html" accesskey="n" rel="next">Developing major modes with tree-sitter</a>, Previous: <a href="Pattern-Matching.html" accesskey="p" rel="prev">Pattern Matching Tree-sitter Nodes</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Parsing-Text-in-Multiple-Languages"></span><h3 class="section">37.6 Parsing Text in Multiple Languages</h3> -<span id="index-multiple-languages_002c-parsing-with-tree_002dsitter"></span> -<span id="index-parsing-multiple-languages-with-tree_002dsitter"></span> -<p>Sometimes, the source of a programming language could contain snippets -of other languages; <acronym>HTML</acronym> + <acronym>CSS</acronym> + JavaScript is one -example. In that case, text segments written in different languages -need to be assigned different parsers. Traditionally, this is -achieved by using narrowing. While tree-sitter works with narrowing -(see <a href="Using-Parser.html#tree_002dsitter-narrowing">narrowing</a>), the recommended way is -instead to set regions of buffer text (i.e., ranges) in which a parser -will operate. This section describes functions for setting and -getting ranges for a parser. -</p> -<p>Lisp programs should call <code>treesit-update-ranges</code> to make sure -the ranges for each parser are correct before using parsers in a -buffer, and call <code>treesit-language-at</code> to figure out the language -responsible for the text at some position. These two functions don’t -work by themselves, they need major modes to set -<code>treesit-range-settings</code> and -<code>treesit-language-at-point-function</code>, which do the actual work. -These functions and variables are explained in more detail towards the -end of the section. -</p> -<span id="Getting-and-setting-ranges"></span><h3 class="heading">Getting and setting ranges</h3> - -<dl class="def"> -<dt id="index-treesit_002dparser_002dset_002dincluded_002dranges"><span class="category">Function: </span><span><strong>treesit-parser-set-included-ranges</strong> <em>parser ranges</em><a href='#index-treesit_002dparser_002dset_002dincluded_002dranges' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function sets up <var>parser</var> to operate on <var>ranges</var>. The -<var>parser</var> will only read the text of the specified ranges. Each -range in <var>ranges</var> is a list of the form <code>(<var>beg</var> . <var>end</var>)</code><!-- /@w -->. -</p> -<p>The ranges in <var>ranges</var> must come in order and must not overlap. -That is, in pseudo code: -</p> -<div class="example"> -<pre class="example">(cl-loop for idx from 1 to (1- (length ranges)) - for prev = (nth (1- idx) ranges) - for next = (nth idx ranges) - should (<= (car prev) (cdr prev) - (car next) (cdr next))) -</pre></div> - -<span id="index-treesit_002drange_002dinvalid"></span> -<p>If <var>ranges</var> violates this constraint, or something else went -wrong, this function signals the <code>treesit-range-invalid</code> error. -The signal data contains a specific error message and the ranges we -are trying to set. -</p> -<p>This function can also be used for disabling ranges. If <var>ranges</var> -is <code>nil</code>, the parser is set to parse the whole buffer. -</p> -<p>Example: -</p> -<div class="example"> -<pre class="example">(treesit-parser-set-included-ranges - parser '((1 . 9) (16 . 24) (24 . 25))) -</pre></div> -</dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dparser_002dincluded_002dranges"><span class="category">Function: </span><span><strong>treesit-parser-included-ranges</strong> <em>parser</em><a href='#index-treesit_002dparser_002dincluded_002dranges' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the ranges set for <var>parser</var>. The return -value is the same as the <var>ranges</var> argument of -<code>treesit-parser-included-ranges</code>: a list of cons cells of the form -<code>(<var>beg</var> . <var>end</var>)</code><!-- /@w -->. If <var>parser</var> doesn’t have any -ranges, the return value is <code>nil</code>. -</p> -<div class="example"> -<pre class="example">(treesit-parser-included-ranges parser) - ⇒ ((1 . 9) (16 . 24) (24 . 25)) -</pre></div> -</dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dquery_002drange"><span class="category">Function: </span><span><strong>treesit-query-range</strong> <em>source query &optional beg end</em><a href='#index-treesit_002dquery_002drange' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function matches <var>source</var> with <var>query</var> and returns the -ranges of captured nodes. The return value is a list of cons cells of -the form <code>(<var>beg</var> . <var>end</var>)</code><!-- /@w -->, where <var>beg</var> and -<var>end</var> specify the beginning and the end of a region of text. -</p> -<p>For convenience, <var>source</var> can be a language symbol, a parser, or a -node. If it’s a language symbol, this function matches in the root -node of the first parser using that language; if a parser, this -function matches in the root node of that parser; if a node, this -function matches in that node. -</p> -<p>The argument <var>query</var> is the query used to capture nodes -(see <a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>). The capture names don’t matter. The -arguments <var>beg</var> and <var>end</var>, if both non-<code>nil</code>, limit the -range in which this function queries. -</p> -<p>Like other query functions, this function raises the -<code>treesit-query-error</code> error if <var>query</var> is malformed. -</p></dd></dl> - -<span id="Supporting-multiple-languages-in-Lisp-programs"></span><h3 class="heading">Supporting multiple languages in Lisp programs</h3> - -<p>It should suffice for general Lisp programs to call the following two -functions in order to support program sources that mixes multiple -languages. -</p> -<dl class="def"> -<dt id="index-treesit_002dupdate_002dranges"><span class="category">Function: </span><span><strong>treesit-update-ranges</strong> <em>&optional beg end</em><a href='#index-treesit_002dupdate_002dranges' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function updates ranges for parsers in the buffer. It makes sure -the parsers’ ranges are set correctly between <var>beg</var> and <var>end</var>, -according to <code>treesit-range-settings</code>. If omitted, <var>beg</var> -defaults to the beginning of the buffer, and <var>end</var> defaults to the -end of the buffer. -</p> -<p>For example, fontification functions use this function before querying -for nodes in a region. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dlanguage_002dat"><span class="category">Function: </span><span><strong>treesit-language-at</strong> <em>pos</em><a href='#index-treesit_002dlanguage_002dat' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the language of the text at buffer position -<var>pos</var>. Under the hood it calls -<code>treesit-language-at-point-function</code> and returns its return -value. If <code>treesit-language-at-point-function</code> is <code>nil</code>, -this function returns the language of the first parser in the returned -value of <code>treesit-parser-list</code>. If there is no parser in the -buffer, it returns <code>nil</code>. -</p></dd></dl> - -<span id="Supporting-multiple-languages-in-major-modes"></span><h3 class="heading">Supporting multiple languages in major modes</h3> - -<span id="index-host-language_002c-tree_002dsitter"></span> -<span id="index-tree_002dsitter-host-and-embedded-languages"></span> -<span id="index-embedded-language_002c-tree_002dsitter"></span> -<p>Normally, in a set of languages that can be mixed together, there is a -<em>host language</em> and one or more <em>embedded languages</em>. A Lisp -program usually first parses the whole document with the host -language’s parser, retrieves some information, sets ranges for the -embedded languages with that information, and then parses the embedded -languages. -</p> -<p>Take a buffer containing <acronym>HTML</acronym>, <acronym>CSS</acronym> and JavaScript -as an example. A Lisp program will first parse the whole buffer with -an <acronym>HTML</acronym> parser, then query the parser for -<code>style_element</code> and <code>script_element</code> nodes, which -correspond to <acronym>CSS</acronym> and JavaScript text, respectively. Then -it sets the range of the <acronym>CSS</acronym> and JavaScript parser to the -ranges in which their corresponding nodes span. -</p> -<p>Given a simple <acronym>HTML</acronym> document: -</p> -<div class="example"> -<pre class="example"><html> - <script>1 + 2</script> - <style>body { color: "blue"; }</style> -</html> -</pre></div> - -<p>a Lisp program will first parse with a <acronym>HTML</acronym> parser, then set -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)) -</pre><pre class="example"> - -</pre><pre class="example">;; Set CSS ranges. -(setq css-range - (treesit-query-range - 'html - "(style_element (raw_text) @capture)")) -(treesit-parser-set-included-ranges css css-range) -</pre><pre class="example"> - -</pre><pre class="example">;; Set JavaScript ranges. -(setq js-range - (treesit-query-range - 'html - "(script_element (raw_text) @capture)")) -(treesit-parser-set-included-ranges js js-range) -</pre></div> - -<p>Emacs automates this process in <code>treesit-update-ranges</code>. A -multi-language major mode should set <code>treesit-range-settings</code> so -that <code>treesit-update-ranges</code> knows how to perform this process -automatically. Major modes should use the helper function -<code>treesit-range-rules</code> to generate a value that can be assigned to -<code>treesit-range-settings</code>. The settings in the following example -directly translate into operations shown above. -</p> -<div class="example"> -<pre class="example">(setq-local treesit-range-settings - (treesit-range-rules - :embed 'javascript - :host 'html - '((script_element (raw_text) @capture)) -</pre><pre class="example"> - -</pre><pre class="example"> :embed 'css - :host 'html - '((style_element (raw_text) @capture)))) -</pre></div> - -<dl class="def"> -<dt id="index-treesit_002drange_002drules"><span class="category">Function: </span><span><strong>treesit-range-rules</strong> <em>&rest query-specs</em><a href='#index-treesit_002drange_002drules' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function is used to set <var>treesit-range-settings</var>. It -takes care of compiling queries and other post-processing, and outputs -a value that <var>treesit-range-settings</var> can have. -</p> -<p>It takes a series of <var>query-spec</var>s, where each <var>query-spec</var> is -a <var>query</var> preceded by zero or more <var>keyword</var>/<var>value</var> -pairs. Each <var>query</var> is a tree-sitter query in either the -string, s-expression or compiled form, or a function. -</p> -<p>If <var>query</var> is a tree-sitter query, it should be preceded by two -<var>:keyword</var>/<var>value</var> pairs, where the <code>:embed</code> keyword -specifies the embedded language, and the <code>:host</code> keyword -specified the host language. -</p> -<p><code>treesit-update-ranges</code> uses <var>query</var> to figure out how to set -the ranges for parsers for the embedded language. It queries -<var>query</var> in a host language parser, computes the ranges in which -the captured nodes span, and applies these ranges to embedded -language parsers. -</p> -<p>If <var>query</var> is a function, it doesn’t need any <var>:keyword</var> and -<var>value</var> pair. It should be a function that takes 2 arguments, -<var>start</var> and <var>end</var>, and sets the ranges for parsers in the -current buffer in the region between <var>start</var> and <var>end</var>. It is -fine for this function to set ranges in a larger region that -encompasses the region between <var>start</var> and <var>end</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002drange_002dsettings"><span class="category">Variable: </span><span><strong>treesit-range-settings</strong><a href='#index-treesit_002drange_002dsettings' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This variable helps <code>treesit-update-ranges</code> in updating the -ranges for parsers in the buffer. It is a list of <var>setting</var>s -where the exact format of a <var>setting</var> is considered internal. You -should use <code>treesit-range-rules</code> to generate a value that this -variable can have. -</p> -</dd></dl> - - -<dl class="def"> -<dt id="index-treesit_002dlanguage_002dat_002dpoint_002dfunction"><span class="category">Variable: </span><span><strong>treesit-language-at-point-function</strong><a href='#index-treesit_002dlanguage_002dat_002dpoint_002dfunction' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This variable’s value should be a function that takes a single -argument, <var>pos</var>, which is a buffer position, and returns the -language of the buffer text at <var>pos</var>. This variable is used by -<code>treesit-language-at</code>. -</p></dd></dl> - -</div> -<hr> -<div class="header"> -<p> -Next: <a href="Tree_002dsitter-major-modes.html">Developing major modes with tree-sitter</a>, Previous: <a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/Parser_002dbased-Font-Lock.html b/admin/notes/tree-sitter/html-manual/Parser_002dbased-Font-Lock.html deleted file mode 100644 index a3fe6622162..00000000000 --- a/admin/notes/tree-sitter/html-manual/Parser_002dbased-Font-Lock.html +++ /dev/null @@ -1,247 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Parser-based Font Lock (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Parser-based Font Lock (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Parser-based Font Lock (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="Font-Lock-Mode.html" rel="up" title="Font Lock Mode"> -<link href="Multiline-Font-Lock.html" rel="prev" title="Multiline Font Lock"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="subsection" id="Parser_002dbased-Font-Lock"> -<div class="header"> -<p> -Previous: <a href="Multiline-Font-Lock.html" accesskey="p" rel="prev">Multiline Font Lock Constructs</a>, Up: <a href="Font-Lock-Mode.html" accesskey="u" rel="up">Font Lock Mode</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Parser_002dbased-Font-Lock-1"></span><h4 class="subsection">24.6.10 Parser-based Font Lock</h4> -<span id="index-parser_002dbased-font_002dlock"></span> - - -<p>Besides simple syntactic font lock and regexp-based font lock, Emacs -also provides complete syntactic font lock with the help of a parser. -Currently, Emacs uses the tree-sitter library (see <a href="Parsing-Program-Source.html">Parsing Program Source</a>) for this purpose. -</p> -<p>Parser-based font lock and other font lock mechanisms are not mutually -exclusive. By default, if enabled, parser-based font lock runs first, -replacing syntactic font lock, then the regexp-based font lock. -</p> -<p>Although parser-based font lock doesn’t share the same customization -variables with regexp-based font lock, it uses similar customization -schemes. The tree-sitter counterpart of <var>font-lock-keywords</var> is -<var>treesit-font-lock-settings</var>. -</p> -<span id="index-tree_002dsitter-fontifications_002c-overview"></span> -<span id="index-fontifications-with-tree_002dsitter_002c-overview"></span> -<p>In general, tree-sitter fontification works as follows: -</p> -<ul> -<li> A Lisp program (usually, part of a major mode) provides a <em>query</em> -consisting of <em>patterns</em>, each pattern associated with a -<em>capture name</em>. - -</li><li> The tree-sitter library finds the nodes in the parse tree -that match these patterns, tags the nodes with the corresponding -capture names, and returns them to the Lisp program. - -</li><li> The Lisp program uses the returned nodes to highlight the portions of -buffer text corresponding to each node as appropriate, using the -tagged capture names of the nodes to determine the correct -fontification. For example, a node tagged <code>font-lock-keyword</code> -would be highlighted in <code>font-lock-keyword</code> face. -</li></ul> - -<p>For more information about queries, patterns, and capture names, see -<a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>. -</p> -<p>To setup tree-sitter fontification, a major mode should first set -<code>treesit-font-lock-settings</code> with the output of -<code>treesit-font-lock-rules</code>, then call -<code>treesit-major-mode-setup</code>. -</p> -<dl class="def"> -<dt id="index-treesit_002dfont_002dlock_002drules"><span class="category">Function: </span><span><strong>treesit-font-lock-rules</strong> <em>&rest query-specs</em><a href='#index-treesit_002dfont_002dlock_002drules' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function is used to set <var>treesit-font-lock-settings</var>. It -takes care of compiling queries and other post-processing, and outputs -a value that <var>treesit-font-lock-settings</var> accepts. Here’s an -example: -</p> -<div class="example"> -<pre class="example">(treesit-font-lock-rules - :language 'javascript - :feature 'constant - :override t - '((true) @font-lock-constant-face - (false) @font-lock-constant-face) - :language 'html - :feature 'script - "(script_element) @font-lock-builtin-face") -</pre></div> - -<p>This function takes a series of <var>query-spec</var>s, where each -<var>query-spec</var> is a <var>query</var> preceded by one or more -<var>:keyword</var>/<var>value</var> pairs. Each <var>query</var> is a -tree-sitter query in either the string, s-expression or compiled form. -</p> -<p>For each <var>query</var>, the <var>:keyword</var>/<var>value</var> pairs that -precede it add meta information to it. The <code>:language</code> keyword -declares <var>query</var>’s language. The <code>:feature</code> keyword sets the -feature name of <var>query</var>. Users can control which features are -enabled with <code>font-lock-maximum-decoration</code> and -<code>treesit-font-lock-feature-list</code> (described below). These two -keywords are mandatory. -</p> -<p>Other keywords are optional: -</p> -<table> -<thead><tr><th width="15%">Keyword</th><th width="15%">Value</th><th width="60%">Description</th></tr></thead> -<tr><td width="15%"><code>:override</code></td><td width="15%">nil</td><td width="60%">If the region already has a face, discard the new face</td></tr> -<tr><td width="15%"></td><td width="15%">t</td><td width="60%">Always apply the new face</td></tr> -<tr><td width="15%"></td><td width="15%"><code>append</code></td><td width="60%">Append the new face to existing ones</td></tr> -<tr><td width="15%"></td><td width="15%"><code>prepend</code></td><td width="60%">Prepend the new face to existing ones</td></tr> -<tr><td width="15%"></td><td width="15%"><code>keep</code></td><td width="60%">Fill-in regions without an existing face</td></tr> -</table> - -<p>Lisp programs mark patterns in <var>query</var> with capture names (names -that starts with <code>@</code>), and tree-sitter will return matched nodes -tagged with those same capture names. For the purpose of -fontification, capture names in <var>query</var> should be face names like -<code>font-lock-keyword-face</code>. The captured node will be fontified -with that face. -</p> -<span id="index-treesit_002dfontify_002dwith_002doverride"></span> -<p>Capture names can also be function names, in which case the function -is called with 4 arguments: <var>node</var> and <var>override</var>, <var>start</var> -and <var>end</var>, where <var>node</var> is the node itself, <var>override</var> is -the override property of the rule which captured this node, and -<var>start</var> and <var>end</var> limits the region in which this function -should fontify. (If this function wants to respect the <var>override</var> -argument, it can use <code>treesit-fontify-with-override</code>.) -</p> -<p>Beyond the 4 arguments presented, this function should accept more -arguments as optional arguments for future extensibility. -</p> -<p>If a capture name is both a face and a function, the face takes -priority. If a capture name is neither a face nor a function, it is -ignored. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dfont_002dlock_002dfeature_002dlist"><span class="category">Variable: </span><span><strong>treesit-font-lock-feature-list</strong><a href='#index-treesit_002dfont_002dlock_002dfeature_002dlist' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This is a list of lists of feature symbols. Each element of the list -is a list that represents a decoration level. -<code>font-lock-maximum-decoration</code> controls which levels are -activated. -</p> -<p>Each element of the list is a list of the form <code>(<var>feature</var> …)</code><!-- /@w -->, where each <var>feature</var> corresponds to the -<code>:feature</code> value of a query defined in -<code>treesit-font-lock-rules</code>. Removing a feature symbol from this -list disables the corresponding query during font-lock. -</p> -<p>Common feature names, for many programming languages, include -<code>definition</code>, <code>type</code>, <code>assignment</code>, <code>builtin</code>, -<code>constant</code>, <code>keyword</code>, <code>string-interpolation</code>, -<code>comment</code>, <code>doc</code>, <code>string</code>, <code>operator</code>, -<code>preprocessor</code>, <code>escape-sequence</code>, and <code>key</code>. Major -modes are free to subdivide or extend these common features. -</p> -<p>Some of these features warrant some explanation: <code>definition</code> -highlights whatever is being defined, e.g., the function name in a -function definition, the struct name in a struct definition, the -variable name in a variable definition; <code>assignment</code> highlights -the whatever is being assigned to, e.g., the variable or field in an -assignment statement; <code>key</code> highlights keys in key-value pairs, -e.g., keys in a JSON object, or a Python dictionary; <code>doc</code> -highlights docstrings or doc-comments. -</p> -<p>For example, the value of this variable could be: -</p><div class="example"> -<pre class="example">((comment string doc) ; level 1 - (function-name keyword type builtin constant) ; level 2 - (variable-name string-interpolation key)) ; level 3 -</pre></div> - -<p>Major modes should set this variable before calling -<code>treesit-major-mode-setup</code>. -</p> -<span id="index-treesit_002dfont_002dlock_002drecompute_002dfeatures"></span> -<p>For this variable to take effect, a Lisp program should call -<code>treesit-font-lock-recompute-features</code> (which resets -<code>treesit-font-lock-settings</code> accordingly), or -<code>treesit-major-mode-setup</code> (which calls -<code>treesit-font-lock-recompute-features</code>). -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dfont_002dlock_002dsettings"><span class="category">Variable: </span><span><strong>treesit-font-lock-settings</strong><a href='#index-treesit_002dfont_002dlock_002dsettings' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>A list of settings for tree-sitter based font lock. The exact format -of each setting is considered internal. One should always use -<code>treesit-font-lock-rules</code> to set this variable. -</p> -</dd></dl> - -<p>Multi-language major modes should provide range functions in -<code>treesit-range-functions</code>, and Emacs will set the ranges -accordingly before fontifing a region (see <a href="Multiple-Languages.html">Parsing Text in Multiple Languages</a>). -</p> -</div> -<hr> -<div class="header"> -<p> -Previous: <a href="Multiline-Font-Lock.html">Multiline Font Lock Constructs</a>, Up: <a href="Font-Lock-Mode.html">Font Lock Mode</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/Parser_002dbased-Indentation.html b/admin/notes/tree-sitter/html-manual/Parser_002dbased-Indentation.html deleted file mode 100644 index cf1257f3102..00000000000 --- a/admin/notes/tree-sitter/html-manual/Parser_002dbased-Indentation.html +++ /dev/null @@ -1,280 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Parser-based Indentation (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Parser-based Indentation (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Parser-based Indentation (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="Auto_002dIndentation.html" rel="up" title="Auto-Indentation"> -<link href="SMIE.html" rel="prev" title="SMIE"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="subsection" id="Parser_002dbased-Indentation"> -<div class="header"> -<p> -Previous: <a href="SMIE.html" accesskey="p" rel="prev">Simple Minded Indentation Engine</a>, Up: <a href="Auto_002dIndentation.html" accesskey="u" rel="up">Automatic Indentation of code</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Parser_002dbased-Indentation-1"></span><h4 class="subsection">24.7.2 Parser-based Indentation</h4> -<span id="index-parser_002dbased-indentation"></span> - - -<p>When built with the tree-sitter library (see <a href="Parsing-Program-Source.html">Parsing Program Source</a>), Emacs is capable of parsing the program source and producing -a syntax tree. This syntax tree can be used for guiding the program -source indentation commands. For maximum flexibility, it is possible -to write a custom indentation function that queries the syntax tree -and indents accordingly for each language, but that is a lot of work. -It is more convenient to use the simple indentation engine described -below: then the major mode needs only to write some indentation rules -and the engine takes care of the rest. -</p> -<p>To enable the parser-based indentation engine, either set -<var>treesit-simple-indent-rules</var> and call -<code>treesit-major-mode-setup</code>, or equivalently, set the value of -<code>indent-line-function</code> to <code>treesit-indent</code>. -</p> -<dl class="def"> -<dt id="index-treesit_002dindent_002dfunction"><span class="category">Variable: </span><span><strong>treesit-indent-function</strong><a href='#index-treesit_002dindent_002dfunction' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This variable stores the actual function called by -<code>treesit-indent</code>. By default, its value is -<code>treesit-simple-indent</code>. In the future we might add other, -more complex indentation engines. -</p></dd></dl> - -<span id="Writing-indentation-rules"></span><h3 class="heading">Writing indentation rules</h3> -<span id="index-indentation-rules_002c-for-parser_002dbased-indentation"></span> - -<dl class="def"> -<dt id="index-treesit_002dsimple_002dindent_002drules"><span class="category">Variable: </span><span><strong>treesit-simple-indent-rules</strong><a href='#index-treesit_002dsimple_002dindent_002drules' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This local variable stores indentation rules for every language. It is -a list of the form: <code>(<var>language</var> . <var>rules</var>)</code><!-- /@w -->, where -<var>language</var> is a language symbol, and <var>rules</var> is a list of the -form <code>(<var>matcher</var> <var>anchor</var> <var>offset</var>)</code><!-- /@w -->. -</p> -<p>First, Emacs passes the smallest tree-sitter node at the beginning of -the current line to <var>matcher</var>; if it returns non-<code>nil</code>, this -rule is applicable. Then Emacs passes the node to <var>anchor</var>, which -returns a buffer position. Emacs takes the column number of that -position, adds <var>offset</var> to it, and the result is the indentation -column for the current line. <var>offset</var> can be an integer or a -variable whose value is an integer. -</p> -<p>The <var>matcher</var> and <var>anchor</var> are functions, and Emacs provides -convenient defaults for them. -</p> -<p>Each <var>matcher</var> or <var>anchor</var> is a function that takes three -arguments: <var>node</var>, <var>parent</var>, and <var>bol</var>. The argument -<var>bol</var> is the buffer position whose indentation is required: the -position of the first non-whitespace character after the beginning of -the line. The argument <var>node</var> is the largest (highest-in-tree) -node that starts at that position; and <var>parent</var> is the parent of -<var>node</var>. However, when that position is in a whitespace or inside -a multi-line string, no node can start at that position, so -<var>node</var> is <code>nil</code>. In that case, <var>parent</var> would be the -smallest node that spans that position. -</p> -<p>Emacs finds <var>bol</var>, <var>node</var> and <var>parent</var> and -passes them to each <var>matcher</var> and <var>anchor</var>. <var>matcher</var> -should return non-<code>nil</code> if the rule is applicable, and -<var>anchor</var> should return a buffer position. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dsimple_002dindent_002dpresets"><span class="category">Variable: </span><span><strong>treesit-simple-indent-presets</strong><a href='#index-treesit_002dsimple_002dindent_002dpresets' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This is a list of defaults for <var>matcher</var>s and <var>anchor</var>s in -<code>treesit-simple-indent-rules</code>. Each of them represents a function -that takes 3 arguments: <var>node</var>, <var>parent</var> and <var>bol</var>. The -available default functions are: -</p> -<dl compact="compact"> -<dt id='index-no_002dnode'><span><code>no-node</code><a href='#index-no_002dnode' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This matcher is a function that is called with 3 arguments: -<var>node</var>, <var>parent</var>, and <var>bol</var>, and returns non-<code>nil</code>, -indicating a match, if <var>node</var> is <code>nil</code>, i.e., there is no -node that starts at <var>bol</var>. This is the case when <var>bol</var> is on -an empty line or inside a multi-line string, etc. -</p> -</dd> -<dt id='index-parent_002dis'><span><code>parent-is</code><a href='#index-parent_002dis' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This matcher is a function of one argument, <var>type</var>; it returns a -function that is called with 3 arguments: <var>node</var>, <var>parent</var>, -and <var>bol</var>, and returns non-<code>nil</code> (i.e., a match) if -<var>parent</var>’s type matches regexp <var>type</var>. -</p> -</dd> -<dt id='index-node_002dis'><span><code>node-is</code><a href='#index-node_002dis' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This matcher is a function of one argument, <var>type</var>; it returns a -function that is called with 3 arguments: <var>node</var>, <var>parent</var>, -and <var>bol</var>, and returns non-<code>nil</code> if <var>node</var>’s type matches -regexp <var>type</var>. -</p> -</dd> -<dt id='index-query'><span><code>query</code><a href='#index-query' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This matcher is a function of one argument, <var>query</var>; it returns a -function that is called with 3 arguments: <var>node</var>, <var>parent</var>, -and <var>bol</var>, and returns non-<code>nil</code> if querying <var>parent</var> -with <var>query</var> captures <var>node</var> (see <a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>). -</p> -</dd> -<dt id='index-match'><span><code>match</code><a href='#index-match' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This matcher is a function of 5 arguments: <var>node-type</var>, -<var>parent-type</var>, <var>node-field</var>, <var>node-index-min</var>, and -<var>node-index-max</var>). It returns a function that is called with 3 -arguments: <var>node</var>, <var>parent</var>, and <var>bol</var>, and returns -non-<code>nil</code> if <var>node</var>’s type matches regexp <var>node-type</var>, -<var>parent</var>’s type matches regexp <var>parent-type</var>, <var>node</var>’s -field name in <var>parent</var> matches regexp <var>node-field</var>, and -<var>node</var>’s index among its siblings is between <var>node-index-min</var> -and <var>node-index-max</var>. If the value of an argument is <code>nil</code>, -this matcher doesn’t check that argument. For example, to match the -first child where parent is <code>argument_list</code>, use -</p> -<div class="example"> -<pre class="example">(match nil "argument_list" nil nil 0 0) -</pre></div> - -</dd> -<dt id='index-comment_002dend'><span><code>comment-end</code><a href='#index-comment_002dend' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This matcher is a function that is called with 3 arguments: -<var>node</var>, <var>parent</var>, and <var>bol</var>, and returns non-<code>nil</code> if -point is before a comment ending token. Comment ending tokens are -defined by regular expression <code>treesit-comment-end</code> -(see <a href="Tree_002dsitter-major-modes.html">treesit-comment-end</a>). -</p> -</dd> -<dt id='index-first_002dsibling'><span><code>first-sibling</code><a href='#index-first_002dsibling' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, -<var>parent</var>, and <var>bol</var>, and returns the start of the first child -of <var>parent</var>. -</p> -</dd> -<dt id='index-parent'><span><code>parent</code><a href='#index-parent' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, -<var>parent</var>, and <var>bol</var>, and returns the start of <var>parent</var>. -</p> -</dd> -<dt id='index-parent_002dbol'><span><code>parent-bol</code><a href='#index-parent_002dbol' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, -<var>parent</var>, and <var>bol</var>, and returns the first non-space character -on the line of <var>parent</var>. -</p> -</dd> -<dt id='index-prev_002dsibling'><span><code>prev-sibling</code><a href='#index-prev_002dsibling' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, -<var>parent</var>, and <var>bol</var>, and returns the start of the previous -sibling of <var>node</var>. -</p> -</dd> -<dt id='index-no_002dindent'><span><code>no-indent</code><a href='#index-no_002dindent' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, -<var>parent</var>, and <var>bol</var>, and returns the start of <var>node</var>. -</p> -</dd> -<dt id='index-prev_002dline'><span><code>prev-line</code><a href='#index-prev_002dline' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, -<var>parent</var>, and <var>bol</var>, and returns the first non-whitespace -character on the previous line. -</p> -</dd> -<dt id='index-point_002dmin'><span><code>point-min</code><a href='#index-point_002dmin' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, -<var>parent</var>, and <var>bol</var>, and returns the beginning of the buffer. -This is useful as the beginning of the buffer is always at column 0. -</p> -</dd> -<dt id='index-comment_002dstart'><span><code>comment-start</code><a href='#index-comment_002dstart' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, -<var>parent</var>, and <var>bol</var>, and returns the position right after the -comment-start token. Comment-start tokens are defined by regular -expression <code>treesit-comment-start</code> (see <a href="Tree_002dsitter-major-modes.html">treesit-comment-start</a>). This function assumes <var>parent</var> is -the comment node. -</p> -</dd> -<dt id='index-coment_002dstart_002dskip'><span><code>comment-start-skip</code><a href='#index-coment_002dstart_002dskip' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, -<var>parent</var>, and <var>bol</var>, and returns the position after the -comment-start token and any whitespace characters following that -token. Comment-start tokens are defined by regular expression -<code>treesit-comment-start</code>. This function assumes <var>parent</var> is -the comment node. -</p></dd> -</dl> -</dd></dl> - -<span id="Indentation-utilities"></span><h3 class="heading">Indentation utilities</h3> -<span id="index-utility-functions-for-parser_002dbased-indentation"></span> - -<p>Here are some utility functions that can help writing parser-based -indentation rules. -</p> -<dl class="def"> -<dt id="index-treesit_002dcheck_002dindent"><span class="category">Function: </span><span><strong>treesit-check-indent</strong> <em>mode</em><a href='#index-treesit_002dcheck_002dindent' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function checks the current buffer’s indentation against major -mode <var>mode</var>. It indents the current buffer according to -<var>mode</var> and compares the results with the current indentation. -Then it pops up a buffer showing the differences. Correct -indentation (target) is shown in green color, current indentation is -shown in red color. </p></dd></dl> - -<p>It is also helpful to use <code>treesit-inspect-mode</code> (see <a href="Language-Definitions.html">Tree-sitter Language Definitions</a>) when writing indentation rules. -</p> -</div> -<hr> -<div class="header"> -<p> -Previous: <a href="SMIE.html">Simple Minded Indentation Engine</a>, Up: <a href="Auto_002dIndentation.html">Automatic Indentation of code</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/Parsing-Program-Source.html b/admin/notes/tree-sitter/html-manual/Parsing-Program-Source.html deleted file mode 100644 index 58f6b4e9d5a..00000000000 --- a/admin/notes/tree-sitter/html-manual/Parsing-Program-Source.html +++ /dev/null @@ -1,125 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Parsing Program Source (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Parsing Program Source (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Parsing Program Source (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="index.html" rel="up" title="Top"> -<link href="Abbrevs.html" rel="next" title="Abbrevs"> -<link href="Syntax-Tables.html" rel="prev" title="Syntax Tables"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="chapter" id="Parsing-Program-Source"> -<div class="header"> -<p> -Next: <a href="Abbrevs.html" accesskey="n" rel="next">Abbrevs and Abbrev Expansion</a>, Previous: <a href="Syntax-Tables.html" accesskey="p" rel="prev">Syntax Tables</a>, Up: <a href="index.html" accesskey="u" rel="up">Emacs Lisp</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Parsing-Program-Source-1"></span><h2 class="chapter">37 Parsing Program Source</h2> - -<span id="index-syntax-tree_002c-from-parsing-program-source"></span> -<p>Emacs provides various ways to parse program source text and produce a -<em>syntax tree</em>. In a syntax tree, text is no longer considered a -one-dimensional stream of characters, but a structured tree of nodes, -where each node representing a piece of text. Thus, a syntax tree can -enable interesting features like precise fontification, indentation, -navigation, structured editing, etc. -</p> -<p>Emacs has a simple facility for parsing balanced expressions -(see <a href="Parsing-Expressions.html">Parsing Expressions</a>). There is also the SMIE library for -generic navigation and indentation (see <a href="SMIE.html">Simple Minded Indentation Engine</a>). -</p> -<p>In addition to those, Emacs also provides integration with -<a href="https://tree-sitter.github.io/tree-sitter">the tree-sitter -library</a>) if support for it was compiled in. The tree-sitter library -implements an incremental parser and has support from a wide range of -programming languages. -</p> -<dl class="def"> -<dt id="index-treesit_002davailable_002dp"><span class="category">Function: </span><span><strong>treesit-available-p</strong><a href='#index-treesit_002davailable_002dp' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns non-<code>nil</code> if tree-sitter features are -available for the current Emacs session. -</p></dd></dl> - -<p>To be able to parse the program source using the tree-sitter library -and access the syntax tree of the program, a Lisp program needs to -load a language definition library, and create a parser for that -language and the current buffer. After that, the Lisp program can -query the parser about specific nodes of the syntax tree. Then, it -can access various kinds of information about each node, and search -for nodes using a powerful pattern-matching syntax. This chapter -explains how to do all this, and also how a Lisp program can work with -source files that mix multiple programming languages. -</p> - -<ul class="section-toc"> -<li><a href="Language-Definitions.html" accesskey="1">Tree-sitter Language Definitions</a></li> -<li><a href="Using-Parser.html" accesskey="2">Using Tree-sitter Parser</a></li> -<li><a href="Retrieving-Nodes.html" accesskey="3">Retrieving Nodes</a></li> -<li><a href="Accessing-Node-Information.html" accesskey="4">Accessing Node Information</a></li> -<li><a href="Pattern-Matching.html" accesskey="5">Pattern Matching Tree-sitter Nodes</a></li> -<li><a href="Multiple-Languages.html" accesskey="6">Parsing Text in Multiple Languages</a></li> -<li><a href="Tree_002dsitter-major-modes.html" accesskey="7">Developing major modes with tree-sitter</a></li> -<li><a href="Tree_002dsitter-C-API.html" accesskey="8">Tree-sitter C API Correspondence</a></li> -</ul> -</div> -<hr> -<div class="header"> -<p> -Next: <a href="Abbrevs.html">Abbrevs and Abbrev Expansion</a>, Previous: <a href="Syntax-Tables.html">Syntax Tables</a>, Up: <a href="index.html">Emacs Lisp</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/Pattern-Matching.html b/admin/notes/tree-sitter/html-manual/Pattern-Matching.html deleted file mode 100644 index 9ef536b79dd..00000000000 --- a/admin/notes/tree-sitter/html-manual/Pattern-Matching.html +++ /dev/null @@ -1,450 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Pattern Matching (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Pattern Matching (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Pattern Matching (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> -<link href="Multiple-Languages.html" rel="next" title="Multiple Languages"> -<link href="Accessing-Node-Information.html" rel="prev" title="Accessing Node Information"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="section" id="Pattern-Matching"> -<div class="header"> -<p> -Next: <a href="Multiple-Languages.html" accesskey="n" rel="next">Parsing Text in Multiple Languages</a>, Previous: <a href="Accessing-Node-Information.html" accesskey="p" rel="prev">Accessing Node Information</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Pattern-Matching-Tree_002dsitter-Nodes"></span><h3 class="section">37.5 Pattern Matching Tree-sitter Nodes</h3> -<span id="index-pattern-matching-with-tree_002dsitter-nodes"></span> - -<span id="index-capturing_002c-tree_002dsitter-node"></span> -<p>Tree-sitter lets Lisp programs match patterns using a small -declarative language. This pattern matching consists of two steps: -first tree-sitter matches a <em>pattern</em> against nodes in the syntax -tree, then it <em>captures</em> specific nodes that matched the pattern -and returns the captured nodes. -</p> -<p>We describe first how to write the most basic query pattern and how to -capture nodes in a pattern, then the pattern-matching function, and -finally the more advanced pattern syntax. -</p> -<span id="Basic-query-syntax"></span><h3 class="heading">Basic query syntax</h3> - -<span id="index-tree_002dsitter-query-pattern-syntax"></span> -<span id="index-pattern-syntax_002c-tree_002dsitter-query"></span> -<span id="index-query_002c-tree_002dsitter"></span> -<p>A <em>query</em> consists of multiple <em>patterns</em>. Each pattern is an -s-expression that matches a certain node in the syntax node. A -pattern has the form <code>(<var>type</var> (<var>child</var>…))</code><!-- /@w --> -</p> -<p>For example, a pattern that matches a <code>binary_expression</code> node that -contains <code>number_literal</code> child nodes would look like -</p> -<div class="example"> -<pre class="example">(binary_expression (number_literal)) -</pre></div> - -<p>To <em>capture</em> a node using the query pattern above, append -<code>@<var>capture-name</var></code> after the node pattern you want to -capture. For example, -</p> -<div class="example"> -<pre class="example">(binary_expression (number_literal) @number-in-exp) -</pre></div> - -<p>captures <code>number_literal</code> nodes that are inside a -<code>binary_expression</code> node with the capture name -<code>number-in-exp</code>. -</p> -<p>We can capture the <code>binary_expression</code> node as well, with, for -example, the capture name <code>biexp</code>: -</p> -<div class="example"> -<pre class="example">(binary_expression - (number_literal) @number-in-exp) @biexp -</pre></div> - -<span id="Query-function"></span><h3 class="heading">Query function</h3> - -<span id="index-query-functions_002c-tree_002dsitter"></span> -<p>Now we can introduce the <em>query functions</em>. -</p> -<dl class="def"> -<dt id="index-treesit_002dquery_002dcapture"><span class="category">Function: </span><span><strong>treesit-query-capture</strong> <em>node query &optional beg end node-only</em><a href='#index-treesit_002dquery_002dcapture' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function matches patterns in <var>query</var> within <var>node</var>. -The argument <var>query</var> can be either a string, a s-expression, or a -compiled query object. For now, we focus on the string syntax; -s-expression syntax and compiled query are described at the end of the -section. -</p> -<p>The argument <var>node</var> can also be a parser or a language symbol. A -parser means using its root node, a language symbol means find or -create a parser for that language in the current buffer, and use the -root node. -</p> -<p>The function returns all the captured nodes in a list of the form -<code>(<var><span class="nolinebreak">capture_name</span></var> . <var>node</var>)</code><!-- /@w -->. If <var>node-only</var> is -non-<code>nil</code>, it returns the list of nodes instead. By default the -entire text of <var>node</var> is searched, but if <var>beg</var> and <var>end</var> -are both non-<code>nil</code>, they specify the region of buffer text where -this function should match nodes. Any matching node whose span -overlaps with the region between <var>beg</var> and <var>end</var> are captured, -it doesn’t have to be completely in the region. -</p> -<span id="index-treesit_002dquery_002derror"></span> -<span id="index-treesit_002dquery_002dvalidate"></span> -<p>This function raises the <code>treesit-query-error</code> error if -<var>query</var> is malformed. The signal data contains a description of -the specific error. You can use <code>treesit-query-validate</code> to -validate and debug the query. -</p></dd></dl> - -<p>For example, suppose <var>node</var>’s text is <code>1 + 2</code>, and -<var>query</var> is -</p> -<div class="example"> -<pre class="example">(setq query - "(binary_expression - (number_literal) @number-in-exp) @biexp") -</pre></div> - -<p>Matching that query would return -</p> -<div class="example"> -<pre class="example">(treesit-query-capture node query) - ⇒ ((biexp . <var><node for "1 + 2"></var>) - (number-in-exp . <var><node for "1"></var>) - (number-in-exp . <var><node for "2"></var>)) -</pre></div> - -<p>As mentioned earlier, <var>query</var> could contain multiple patterns. -For example, it could have two top-level patterns: -</p> -<div class="example"> -<pre class="example">(setq query - "(binary_expression) @biexp - (number_literal) @number @biexp") -</pre></div> - -<dl class="def"> -<dt id="index-treesit_002dquery_002dstring"><span class="category">Function: </span><span><strong>treesit-query-string</strong> <em>string query language</em><a href='#index-treesit_002dquery_002dstring' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function parses <var>string</var> with <var>language</var>, matches its -root node with <var>query</var>, and returns the result. -</p></dd></dl> - -<span id="More-query-syntax"></span><h3 class="heading">More query syntax</h3> - -<p>Besides node type and capture, tree-sitter’s pattern syntax can -express anonymous node, field name, wildcard, quantification, -grouping, alternation, anchor, and predicate. -</p> -<span id="Anonymous-node"></span><h4 class="subheading">Anonymous node</h4> - -<p>An anonymous node is written verbatim, surrounded by quotes. A -pattern matching (and capturing) keyword <code>return</code> would be -</p> -<div class="example"> -<pre class="example">"return" @keyword -</pre></div> - -<span id="Wild-card"></span><h4 class="subheading">Wild card</h4> - -<p>In a pattern, ‘<samp>(_)</samp>’ matches any named node, and ‘<samp>_</samp>’ matches -any named and anonymous node. For example, to capture any named child -of a <code>binary_expression</code> node, the pattern would be -</p> -<div class="example"> -<pre class="example">(binary_expression (_) @in_biexp) -</pre></div> - -<span id="Field-name"></span><h4 class="subheading">Field name</h4> - -<p>It is possible to capture child nodes that have specific field names. -In the pattern below, <code>declarator</code> and <code>body</code> are field -names, indicated by the colon following them. -</p> -<div class="example"> -<pre class="example">(function_definition - declarator: (_) @func-declarator - body: (_) @func-body) -</pre></div> - -<p>It is also possible to capture a node that doesn’t have a certain -field, say, a <code>function_definition</code> without a <code>body</code> field. -</p> -<div class="example"> -<pre class="example">(function_definition !body) @func-no-body -</pre></div> - -<span id="Quantify-node"></span><h4 class="subheading">Quantify node</h4> - -<span id="index-quantify-node_002c-tree_002dsitter"></span> -<p>Tree-sitter recognizes quantification operators ‘<samp>*</samp>’, ‘<samp>+</samp>’ and -‘<samp>?</samp>’. Their meanings are the same as in regular expressions: -‘<samp>*</samp>’ matches the preceding pattern zero or more times, ‘<samp>+</samp>’ -matches one or more times, and ‘<samp>?</samp>’ matches zero or one time. -</p> -<p>For example, the following pattern matches <code>type_declaration</code> -nodes that has <em>zero or more</em> <code>long</code> keyword. -</p> -<div class="example"> -<pre class="example">(type_declaration "long"*) @long-type -</pre></div> - -<p>The following pattern matches a type declaration that has zero or one -<code>long</code> keyword: -</p> -<div class="example"> -<pre class="example">(type_declaration "long"?) @long-type -</pre></div> - -<span id="Grouping"></span><h4 class="subheading">Grouping</h4> - -<p>Similar to groups in regular expression, we can bundle patterns into -groups and apply quantification operators to them. For example, to -express a comma separated list of identifiers, one could write -</p> -<div class="example"> -<pre class="example">(identifier) ("," (identifier))* -</pre></div> - -<span id="Alternation"></span><h4 class="subheading">Alternation</h4> - -<p>Again, similar to regular expressions, we can express “match anyone -from this group of patterns” in a pattern. The syntax is a list of -patterns enclosed in square brackets. For example, to capture some -keywords in C, the pattern would be -</p> -<div class="example"> -<pre class="example">[ - "return" - "break" - "if" - "else" -] @keyword -</pre></div> - -<span id="Anchor"></span><h4 class="subheading">Anchor</h4> - -<p>The anchor operator ‘<samp>.</samp>’ can be used to enforce juxtaposition, -i.e., to enforce two things to be directly next to each other. The -two “things” can be two nodes, or a child and the end of its parent. -For example, to capture the first child, the last child, or two -adjacent children: -</p> -<div class="example"> -<pre class="example">;; Anchor the child with the end of its parent. -(compound_expression (_) @last-child .) -</pre><pre class="example"> - -</pre><pre class="example">;; Anchor the child with the beginning of its parent. -(compound_expression . (_) @first-child) -</pre><pre class="example"> - -</pre><pre class="example">;; Anchor two adjacent children. -(compound_expression - (_) @prev-child - . - (_) @next-child) -</pre></div> - -<p>Note that the enforcement of juxtaposition ignores any anonymous -nodes. -</p> -<span id="Predicate"></span><h4 class="subheading">Predicate</h4> - -<p>It is possible to add predicate constraints to a pattern. For -example, with the following pattern: -</p> -<div class="example"> -<pre class="example">( - (array . (_) @first (_) @last .) - (#equal @first @last) -) -</pre></div> - -<p>tree-sitter only matches arrays where the first element equals to -the last element. To attach a predicate to a pattern, we need to -group them together. A predicate always starts with a ‘<samp>#</samp>’. -Currently there are two predicates, <code>#equal</code> and <code>#match</code>. -</p> -<dl class="def"> -<dt id="index-equal-1"><span class="category">Predicate: </span><span><strong>equal</strong> <em>arg1 arg2</em><a href='#index-equal-1' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Matches if <var>arg1</var> equals to <var>arg2</var>. Arguments can be either -strings or capture names. Capture names represent the text that the -captured node spans in the buffer. -</p></dd></dl> - -<dl class="def"> -<dt id="index-match-1"><span class="category">Predicate: </span><span><strong>match</strong> <em>regexp capture-name</em><a href='#index-match-1' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Matches if the text that <var>capture-name</var>’s node spans in the buffer -matches regular expression <var>regexp</var>. Matching is case-sensitive. -</p></dd></dl> - -<p>Note that a predicate can only refer to capture names that appear in -the same pattern. Indeed, it makes little sense to refer to capture -names in other patterns. -</p> -<span id="S_002dexpression-patterns"></span><h3 class="heading">S-expression patterns</h3> - -<span id="index-tree_002dsitter-patterns-as-sexps"></span> -<span id="index-patterns_002c-tree_002dsitter_002c-in-sexp-form"></span> -<p>Besides strings, Emacs provides a s-expression based syntax for -tree-sitter patterns. It largely resembles the string-based syntax. -For example, the following query -</p> -<div class="example"> -<pre class="example">(treesit-query-capture - node "(addition_expression - left: (_) @left - \"+\" @plus-sign - right: (_) @right) @addition - - [\"return\" \"break\"] @keyword") -</pre></div> - -<p>is equivalent to -</p> -<div class="example"> -<pre class="example">(treesit-query-capture - node '((addition_expression - left: (_) @left - "+" @plus-sign - right: (_) @right) @addition - - ["return" "break"] @keyword)) -</pre></div> - -<p>Most patterns can be written directly as strange but nevertheless -valid s-expressions. Only a few of them needs modification: -</p> -<ul> -<li> Anchor ‘<samp>.</samp>’ is written as <code>:anchor</code>. -</li><li> ‘<samp>?</samp>’ is written as ‘<samp>:?</samp>’. -</li><li> ‘<samp>*</samp>’ is written as ‘<samp>:*</samp>’. -</li><li> ‘<samp>+</samp>’ is written as ‘<samp>:+</samp>’. -</li><li> <code>#equal</code> is written as <code>:equal</code>. In general, predicates -change their ‘<samp>#</samp>’ to ‘<samp>:</samp>’. -</li></ul> - -<p>For example, -</p> -<div class="example"> -<pre class="example">"( - (compound_expression . (_) @first (_)* @rest) - (#match \"love\" @first) - )" -</pre></div> - -<p>is written in s-expression as -</p> -<div class="example"> -<pre class="example">'(( - (compound_expression :anchor (_) @first (_) :* @rest) - (:match "love" @first) - )) -</pre></div> - -<span id="Compiling-queries"></span><h3 class="heading">Compiling queries</h3> - -<span id="index-compiling-tree_002dsitter-queries"></span> -<span id="index-queries_002c-compiling"></span> -<p>If a query is intended to be used repeatedly, especially in tight -loops, it is important to compile that query, because a compiled query -is much faster than an uncompiled one. A compiled query can be used -anywhere a query is accepted. -</p> -<dl class="def"> -<dt id="index-treesit_002dquery_002dcompile"><span class="category">Function: </span><span><strong>treesit-query-compile</strong> <em>language query</em><a href='#index-treesit_002dquery_002dcompile' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function compiles <var>query</var> for <var>language</var> into a compiled -query object and returns it. -</p> -<p>This function raises the <code>treesit-query-error</code> error if -<var>query</var> is malformed. The signal data contains a description of -the specific error. You can use <code>treesit-query-validate</code> to -validate and debug the query. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dquery_002dlanguage"><span class="category">Function: </span><span><strong>treesit-query-language</strong> <em>query</em><a href='#index-treesit_002dquery_002dlanguage' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function return the language of <var>query</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dquery_002dexpand"><span class="category">Function: </span><span><strong>treesit-query-expand</strong> <em>query</em><a href='#index-treesit_002dquery_002dexpand' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function converts the s-expression <var>query</var> into the string -format. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dpattern_002dexpand"><span class="category">Function: </span><span><strong>treesit-pattern-expand</strong> <em>pattern</em><a href='#index-treesit_002dpattern_002dexpand' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function converts the s-expression <var>pattern</var> into the string -format. -</p></dd></dl> - -<p>For more details, read the tree-sitter project’s documentation about -pattern-matching, which can be found at -<a href="https://tree-sitter.github.io/tree-sitter/using-parsers#pattern-matching-with-queries">https://tree-sitter.github.io/tree-sitter/using-parsers#pattern-matching-with-queries</a>. -</p> -</div> -<hr> -<div class="header"> -<p> -Next: <a href="Multiple-Languages.html">Parsing Text in Multiple Languages</a>, Previous: <a href="Accessing-Node-Information.html">Accessing Node Information</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/Retrieving-Node.html b/admin/notes/tree-sitter/html-manual/Retrieving-Node.html deleted file mode 100644 index 16eeb0b1091..00000000000 --- a/admin/notes/tree-sitter/html-manual/Retrieving-Node.html +++ /dev/null @@ -1,420 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Retrieving Node (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Retrieving Node (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Retrieving Node (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> -<link href="Accessing-Node-Information.html" rel="next" title="Accessing Node Information"> -<link href="Using-Parser.html" rel="prev" title="Using Parser"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="section" id="Retrieving-Node"> -<div class="header"> -<p> -Next: <a href="Accessing-Node-Information.html" accesskey="n" rel="next">Accessing Node Information</a>, Previous: <a href="Using-Parser.html" accesskey="p" rel="prev">Using Tree-sitter Parser</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Retrieving-Node-1"></span><h3 class="section">37.3 Retrieving Node</h3> -<span id="index-retrieve-node_002c-tree_002dsitter"></span> -<span id="index-tree_002dsitter_002c-find-node"></span> -<span id="index-get-node_002c-tree_002dsitter"></span> - -<span id="index-terminology_002c-for-tree_002dsitter-functions"></span> -<p>Here’s some terminology and conventions we use when documenting -tree-sitter functions. -</p> -<p>We talk about a node being “smaller” or “larger”, and “lower” or -“higher”. A smaller and lower node is lower in the syntax tree and -therefore spans a smaller portion of buffer text; a larger and higher -node is higher up in the syntax tree, it contains many smaller nodes -as its children, and therefore spans a larger portion of text. -</p> -<p>When a function cannot find a node, it returns <code>nil</code>. For -convenience, all functions that take a node as argument and return -a node, also accept the node argument of <code>nil</code> and in that case -just return <code>nil</code>. -</p> -<span id="index-treesit_002dnode_002doutdated"></span> -<p>Nodes are not automatically updated when the associated buffer is -modified, and there is no way to update a node once it is retrieved. -Using an outdated node signals the <code>treesit-node-outdated</code> error. -</p> -<span id="Retrieving-node-from-syntax-tree"></span><h3 class="heading">Retrieving node from syntax tree</h3> -<span id="index-retrieving-tree_002dsitter-nodes"></span> -<span id="index-syntax-tree_002c-retrieving-nodes"></span> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dat"><span class="category">Function: </span><span><strong>treesit-node-at</strong> <em>pos &optional parser-or-lang named</em><a href='#index-treesit_002dnode_002dat' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the <em>smallest</em> node that starts at or after -the buffer position <var>pos</var>. In other words, the start of the node -is greater or equal to <var>pos</var>. -</p> -<p>When <var>parser-or-lang</var> is <code>nil</code> or omitted, this function uses -the first parser in <code>(treesit-parser-list)</code> of the current -buffer. If <var>parser-or-lang</var> is a parser object, it uses that -parser; if <var>parser-or-lang</var> is a language, it finds the first -parser using that language in <code>(treesit-parser-list)</code>, and uses -that. -</p> -<p>If <var>named</var> is non-<code>nil</code>, this function looks for a named node -only (see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). -</p> -<p>When <var>pos</var> is after all the text in the buffer, technically there -is no node after <var>pos</var>. But for convenience, this function will -return the last leaf node in the parse tree. If <var>strict</var> is -non-<code>nil</code>, this function will strictly comply to the semantics and -return <var>nil</var>. -</p> -<p>Example: -</p> -<div class="example"> -<pre class="example">;; Find the node at point in a C parser's syntax tree. -(treesit-node-at (point) 'c) - ⇒ #<treesit-node (primitive_type) in 23-27> -</pre></div> -</dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002don"><span class="category">Function: </span><span><strong>treesit-node-on</strong> <em>beg end &optional parser-or-lang named</em><a href='#index-treesit_002dnode_002don' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the <em>smallest</em> node that covers the region -of buffer text between <var>beg</var> and <var>end</var>. In other words, the -start of the node is before or at <var>beg</var>, and the end of the node -is at or after <var>end</var>. -</p> -<p><em>Beware:</em> calling this function on an empty line that is not -inside any top-level construct (function definition, etc.) most -probably will give you the root node, because the root node is the -smallest node that covers that empty line. Most of the time, you want -to use <code>treesit-node-at</code>, described above, instead. -</p> -<p>When <var>parser-or-lang</var> is <code>nil</code>, this function uses the first -parser in <code>(treesit-parser-list)</code> of the current buffer. If -<var>parser-or-lang</var> is a parser object, it uses that parser; if -<var>parser-or-lang</var> is a language, it finds the first parser using -that language in <code>(treesit-parser-list)</code>, and uses that. -</p> -<p>If <var>named</var> is non-<code>nil</code>, this function looks for a named node -only (see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dparser_002droot_002dnode"><span class="category">Function: </span><span><strong>treesit-parser-root-node</strong> <em>parser</em><a href='#index-treesit_002dparser_002droot_002dnode' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the root node of the syntax tree generated by -<var>parser</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dbuffer_002droot_002dnode"><span class="category">Function: </span><span><strong>treesit-buffer-root-node</strong> <em>&optional language</em><a href='#index-treesit_002dbuffer_002droot_002dnode' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function finds the first parser that uses <var>language</var> in -<code>(treesit-parser-list)</code> of the current buffer, and returns the -root node generated by that parser. If it cannot find an appropriate -parser, it returns <code>nil</code>. -</p></dd></dl> - -<p>Given a node, a Lisp program can retrieve other nodes starting from -it, or query for information about this node. -</p> -<span id="Retrieving-node-from-other-nodes"></span><h3 class="heading">Retrieving node from other nodes</h3> -<span id="index-syntax-tree-nodes_002c-retrieving-from-other-nodes"></span> - -<span id="By-kinship"></span><h4 class="subheading">By kinship</h4> -<span id="index-kinship_002c-syntax-tree-nodes"></span> -<span id="index-nodes_002c-by-kinship"></span> -<span id="index-syntax-tree-nodes_002c-by-kinship"></span> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dparent"><span class="category">Function: </span><span><strong>treesit-node-parent</strong> <em>node</em><a href='#index-treesit_002dnode_002dparent' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the immediate parent of <var>node</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dchild"><span class="category">Function: </span><span><strong>treesit-node-child</strong> <em>node n &optional named</em><a href='#index-treesit_002dnode_002dchild' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the <var>n</var>’th child of <var>node</var>. If -<var>named</var> is non-<code>nil</code>, it counts only named nodes -(see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). -</p> -<p>For example, in a node that represents a string <code>"text"</code>, there -are three children nodes: the opening quote <code>"</code>, the string text -<code>text</code>, and the closing quote <code>"</code>. Among these nodes, the -first child is the opening quote <code>"</code>, and the first named child -is the string text. -</p> -<p>This function returns <code>nil</code> if there is no <var>n</var>’th child. -<var>n</var> could be negative, e.g., <code>-1</code> represents the last child. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dchildren"><span class="category">Function: </span><span><strong>treesit-node-children</strong> <em>node &optional named</em><a href='#index-treesit_002dnode_002dchildren' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns all of <var>node</var>’s children as a list. If -<var>named</var> is non-<code>nil</code>, it retrieves only named nodes. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnext_002dsibling"><span class="category">Function: </span><span><strong>treesit-node-next-sibling</strong> <em>node &optional named</em><a href='#index-treesit_002dnext_002dsibling' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function finds the next sibling of <var>node</var>. If <var>named</var> is -non-<code>nil</code>, it finds the next named sibling. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dprev_002dsibling"><span class="category">Function: </span><span><strong>treesit-node-prev-sibling</strong> <em>node &optional named</em><a href='#index-treesit_002dprev_002dsibling' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function finds the previous sibling of <var>node</var>. If -<var>named</var> is non-<code>nil</code>, it finds the previous named sibling. -</p></dd></dl> - -<span id="By-field-name"></span><h4 class="subheading">By field name</h4> -<span id="index-nodes_002c-by-field-name"></span> -<span id="index-syntax-tree-nodes_002c-by-field-name"></span> - -<p>To make the syntax tree easier to analyze, many language definitions -assign <em>field names</em> to child nodes (see <a href="Language-Definitions.html#tree_002dsitter-node-field-name">field name</a>). For example, a <code>function_definition</code> node -could have a <code>declarator</code> node and a <code>body</code> node. -</p> -<dl class="def"> -<dt id="index-treesit_002dchild_002dby_002dfield_002dname"><span class="category">Function: </span><span><strong>treesit-node-child-by-field-name</strong> <em>node field-name</em><a href='#index-treesit_002dchild_002dby_002dfield_002dname' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function finds the child of <var>node</var> whose field name is -<var>field-name</var>, a string. -</p> -<div class="example"> -<pre class="example">;; Get the child that has "body" as its field name. -(treesit-node-child-by-field-name node "body") - ⇒ #<treesit-node (compound_statement) in 45-89> -</pre></div> -</dd></dl> - -<span id="By-position"></span><h4 class="subheading">By position</h4> -<span id="index-nodes_002c-by-position"></span> -<span id="index-syntax-tree-nodes_002c-by-position"></span> - -<dl class="def"> -<dt id="index-treesit_002dfirst_002dchild_002dfor_002dpos"><span class="category">Function: </span><span><strong>treesit-node-first-child-for-pos</strong> <em>node pos &optional named</em><a href='#index-treesit_002dfirst_002dchild_002dfor_002dpos' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function finds the first child of <var>node</var> that extends beyond -buffer position <var>pos</var>. “Extends beyond” means the end of the -child node is greater or equal to <var>pos</var>. This function only looks -for immediate children of <var>node</var>, and doesn’t look in its -grandchildren. If <var>named</var> is non-<code>nil</code>, it looks for the -first named child (see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002ddescendant_002dfor_002drange"><span class="category">Function: </span><span><strong>treesit-node-descendant-for-range</strong> <em>node beg end &optional named</em><a href='#index-treesit_002dnode_002ddescendant_002dfor_002drange' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function finds the <em>smallest</em> descendant node of <var>node</var> -that spans the region of text between positions <var>beg</var> and -<var>end</var>. It is similar to <code>treesit-node-at</code>. If <var>named</var> -is non-<code>nil</code>, it looks for smallest named child. -</p></dd></dl> - -<span id="Searching-for-node"></span><h3 class="heading">Searching for node</h3> - -<dl class="def"> -<dt id="index-treesit_002dsearch_002dsubtree"><span class="category">Function: </span><span><strong>treesit-search-subtree</strong> <em>node predicate &optional backward all limit</em><a href='#index-treesit_002dsearch_002dsubtree' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function traverses the subtree of <var>node</var> (including -<var>node</var> itself), looking for a node for which <var>predicate</var> -returns non-<code>nil</code>. <var>predicate</var> is a regexp that is matched -against each node’s type, or a predicate function that takes a node -and returns non-<code>nil</code> if the node matches. The function returns -the first node that matches, or <code>nil</code> if none does. -</p> -<p>By default, this function only traverses named nodes, but if <var>all</var> -is non-<code>nil</code>, it traverses all the nodes. If <var>backward</var> is -non-<code>nil</code>, it traverses backwards (i.e., it visits the last child first -when traversing down the tree). If <var>limit</var> is non-<code>nil</code>, it -must be a number that limits the tree traversal to that many levels -down the tree. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dsearch_002dforward"><span class="category">Function: </span><span><strong>treesit-search-forward</strong> <em>start predicate &optional backward all</em><a href='#index-treesit_002dsearch_002dforward' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Like <code>treesit-search-subtree</code>, this function also traverses the -parse tree and matches each node with <var>predicate</var> (except for -<var>start</var>), where <var>predicate</var> can be a regexp or a function. -For a tree like the below where <var>start</var> is marked S, this function -traverses as numbered from 1 to 12: -</p> -<div class="example"> -<pre class="example"> 12 - | - S--------3----------11 - | | | -o--o-+--o 1--+--2 6--+-----10 -| | | | -o o +-+-+ +--+--+ - | | | | | - 4 5 7 8 9 -</pre></div> - -<p>Note that this function doesn’t traverse the subtree of <var>start</var>, -and it always traverse leaf nodes first, then upwards. -</p> -<p>Like <code>treesit-search-subtree</code>, this function only searches for -named nodes by default, but if <var>all</var> is non-<code>nil</code>, it -searches for all nodes. If <var>backward</var> is non-<code>nil</code>, it -searches backwards. -</p> -<p>While <code>treesit-search-subtree</code> traverses the subtree of a node, -this function starts with node <var>start</var> and traverses every node -that comes after it in the buffer position order, i.e., nodes with -start positions greater than the end position of <var>start</var>. -</p> -<p>In the tree shown above, <code>treesit-search-subtree</code> traverses node -S (<var>start</var>) and nodes marked with <code>o</code>, where this function -traverses the nodes marked with numbers. This function is useful for -answering questions like “what is the first node after <var>start</var> in -the buffer that satisfies some condition?” -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dsearch_002dforward_002dgoto"><span class="category">Function: </span><span><strong>treesit-search-forward-goto</strong> <em>node predicate &optional start backward all</em><a href='#index-treesit_002dsearch_002dforward_002dgoto' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function moves point to the start or end of the next node after -<var>node</var> in the buffer that matches <var>predicate</var>. If <var>start</var> -is non-<code>nil</code>, stop at the beginning rather than the end of a node. -</p> -<p>This function guarantees that the matched node it returns makes -progress in terms of buffer position: the start/end position of the -returned node is always greater than that of <var>node</var>. -</p> -<p>Arguments <var>predicate</var>, <var>backward</var> and <var>all</var> are the same -as in <code>treesit-search-forward</code>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dinduce_002dsparse_002dtree"><span class="category">Function: </span><span><strong>treesit-induce-sparse-tree</strong> <em>root predicate &optional process-fn limit</em><a href='#index-treesit_002dinduce_002dsparse_002dtree' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function creates a sparse tree from <var>root</var>’s subtree. -</p> -<p>It takes the subtree under <var>root</var>, and combs it so only the nodes -that match <var>predicate</var> are left. Like previous functions, the -<var>predicate</var> can be a regexp string that matches against each -node’s type, or a function that takes a node and return non-<code>nil</code> -if it matches. -</p> -<p>For example, for a subtree on the left that consist of both numbers -and letters, if <var>predicate</var> is “letter only”, the returned tree -is the one on the right. -</p> -<div class="example"> -<pre class="example"> a a a - | | | -+---+---+ +---+---+ +---+---+ -| | | | | | | | | -b 1 2 b | | b c d - | | => | | => | - c +--+ c + e - | | | | | - +--+ d 4 +--+ d - | | | - e 5 e -</pre></div> - -<p>If <var>process-fn</var> is non-<code>nil</code>, instead of returning the matched -nodes, this function passes each node to <var>process-fn</var> and uses the -returned value instead. If non-<code>nil</code>, <var>limit</var> is the number of -levels to go down from <var>root</var>. -</p> -<p>Each node in the returned tree looks like -<code>(<var><span class="nolinebreak">tree-sitter-node</span></var> . (<var>child</var> …))</code><!-- /@w -->. The -<var>tree-sitter-node</var> of the root of this tree will be nil if -<var>root</var> doesn’t match <var>predicate</var>. If no node matches -<var>predicate</var>, the function returns <code>nil</code>. -</p></dd></dl> - -<span id="More-convenience-functions"></span><h3 class="heading">More convenience functions</h3> - -<dl class="def"> -<dt id="index-treesit_002dfilter_002dchild"><span class="category">Function: </span><span><strong>treesit-filter-child</strong> <em>node predicate &optional named</em><a href='#index-treesit_002dfilter_002dchild' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function finds immediate children of <var>node</var> that satisfy -<var>predicate</var>. -</p> -<p>The <var>predicate</var> function takes a node as the argument and should -return non-<code>nil</code> to indicate that the node should be kept. If -<var>named</var> is non-<code>nil</code>, this function only examines the named -nodes. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dparent_002duntil"><span class="category">Function: </span><span><strong>treesit-parent-until</strong> <em>node predicate</em><a href='#index-treesit_002dparent_002duntil' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function repeatedly finds the parents of <var>node</var>, and returns -the parent that satisfies <var>predicate</var>, a function that takes a -node as the argument. If no parent satisfies <var>predicate</var>, this -function returns <code>nil</code>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dparent_002dwhile"><span class="category">Function: </span><span><strong>treesit-parent-while</strong> <em>node predicate</em><a href='#index-treesit_002dparent_002dwhile' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function repeatedly finds the parent of <var>node</var>, and keeps -doing so as long as the nodes satisfy <var>predicate</var>, a function that -takes a node as the argument. That is, this function returns the -farthest parent that still satisfies <var>predicate</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dnode_002dtop_002dlevel"><span class="category">Function: </span><span><strong>treesit-node-top-level</strong> <em>node &optional type</em><a href='#index-treesit_002dnode_002dtop_002dlevel' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the highest parent of <var>node</var> that has the -same type as <var>node</var>. If no such parent exists, it returns -<code>nil</code>. Therefore this function is also useful for testing -whether <var>node</var> is top-level. -</p> -<p>If <var>type</var> is non-<code>nil</code>, this function matches each parent’s -type with <var>type</var> as a regexp, rather than using <var>node</var>’s type. -</p></dd></dl> - -</div> -<hr> -<div class="header"> -<p> -Next: <a href="Accessing-Node-Information.html">Accessing Node Information</a>, Previous: <a href="Using-Parser.html">Using Tree-sitter Parser</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/Tree_002dsitter-C-API.html b/admin/notes/tree-sitter/html-manual/Tree_002dsitter-C-API.html deleted file mode 100644 index 1d992b828ea..00000000000 --- a/admin/notes/tree-sitter/html-manual/Tree_002dsitter-C-API.html +++ /dev/null @@ -1,211 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Tree-sitter C API (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Tree-sitter C API (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Tree-sitter C API (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> -<link href="Tree_002dsitter-major-modes.html" rel="prev" title="Tree-sitter major modes"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="section" id="Tree_002dsitter-C-API"> -<div class="header"> -<p> -Previous: <a href="Tree_002dsitter-major-modes.html" accesskey="p" rel="prev">Developing major modes with tree-sitter</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Tree_002dsitter-C-API-Correspondence"></span><h3 class="section">37.8 Tree-sitter C API Correspondence</h3> - -<p>Emacs’ tree-sitter integration doesn’t expose every feature -provided by tree-sitter’s C API. Missing features include: -</p> -<ul> -<li> Creating a tree cursor and navigating the syntax tree with it. -</li><li> Setting timeout and cancellation flag for a parser. -</li><li> Setting the logger for a parser. -</li><li> Printing a <acronym>DOT</acronym> graph of the syntax tree to a file. -</li><li> Copying and modifying a syntax tree. (Emacs doesn’t expose a tree -object.) -</li><li> Using (row, column) coordinates as position. -</li><li> Updating a node with changes. (In Emacs, retrieve a new node instead -of updating the existing one.) -</li><li> Querying statics of a language definition. -</li></ul> - -<p>In addition, Emacs makes some changes to the C API to make the API more -convenient and idiomatic: -</p> -<ul> -<li> Instead of using byte positions, the Emacs Lisp API uses character -positions. -</li><li> Null nodes are converted to nil. -</li></ul> - -<p>Below is the correspondence between all C API functions and their -ELisp counterparts. Sometimes one ELisp function corresponds to -multiple C functions, and many C functions don’t have an ELisp -counterpart. -</p> -<div class="example"> -<pre class="example">ts_parser_new treesit-parser-create -ts_parser_delete -ts_parser_set_language -ts_parser_language treesit-parser-language -ts_parser_set_included_ranges treesit-parser-set-included-ranges -ts_parser_included_ranges treesit-parser-included-ranges -ts_parser_parse -ts_parser_parse_string treesit-parse-string -ts_parser_parse_string_encoding -ts_parser_reset -ts_parser_set_timeout_micros -ts_parser_timeout_micros -ts_parser_set_cancellation_flag -ts_parser_cancellation_flag -ts_parser_set_logger -ts_parser_logger -ts_parser_print_dot_graphs -ts_tree_copy -ts_tree_delete -ts_tree_root_node -ts_tree_language -ts_tree_edit -ts_tree_get_changed_ranges -ts_tree_print_dot_graph -ts_node_type treesit-node-type -ts_node_symbol -ts_node_start_byte treesit-node-start -ts_node_start_point -ts_node_end_byte treesit-node-end -ts_node_end_point -ts_node_string treesit-node-string -ts_node_is_null -ts_node_is_named treesit-node-check -ts_node_is_missing treesit-node-check -ts_node_is_extra treesit-node-check -ts_node_has_changes -ts_node_has_error treesit-node-check -ts_node_parent treesit-node-parent -ts_node_child treesit-node-child -ts_node_field_name_for_child treesit-node-field-name-for-child -ts_node_child_count treesit-node-child-count -ts_node_named_child treesit-node-child -ts_node_named_child_count treesit-node-child-count -ts_node_child_by_field_name treesit-node-by-field-name -ts_node_child_by_field_id -ts_node_next_sibling treesit-node-next-sibling -ts_node_prev_sibling treesit-node-prev-sibling -ts_node_next_named_sibling treesit-node-next-sibling -ts_node_prev_named_sibling treesit-node-prev-sibling -ts_node_first_child_for_byte treesit-node-first-child-for-pos -ts_node_first_named_child_for_byte treesit-node-first-child-for-pos -ts_node_descendant_for_byte_range treesit-descendant-for-range -ts_node_descendant_for_point_range -ts_node_named_descendant_for_byte_range treesit-descendant-for-range -ts_node_named_descendant_for_point_range -ts_node_edit -ts_node_eq treesit-node-eq -ts_tree_cursor_new -ts_tree_cursor_delete -ts_tree_cursor_reset -ts_tree_cursor_current_node -ts_tree_cursor_current_field_name -ts_tree_cursor_current_field_id -ts_tree_cursor_goto_parent -ts_tree_cursor_goto_next_sibling -ts_tree_cursor_goto_first_child -ts_tree_cursor_goto_first_child_for_byte -ts_tree_cursor_goto_first_child_for_point -ts_tree_cursor_copy -ts_query_new -ts_query_delete -ts_query_pattern_count -ts_query_capture_count -ts_query_string_count -ts_query_start_byte_for_pattern -ts_query_predicates_for_pattern -ts_query_step_is_definite -ts_query_capture_name_for_id -ts_query_string_value_for_id -ts_query_disable_capture -ts_query_disable_pattern -ts_query_cursor_new -ts_query_cursor_delete -ts_query_cursor_exec treesit-query-capture -ts_query_cursor_did_exceed_match_limit -ts_query_cursor_match_limit -ts_query_cursor_set_match_limit -ts_query_cursor_set_byte_range -ts_query_cursor_set_point_range -ts_query_cursor_next_match -ts_query_cursor_remove_match -ts_query_cursor_next_capture -ts_language_symbol_count -ts_language_symbol_name -ts_language_symbol_for_name -ts_language_field_count -ts_language_field_name_for_id -ts_language_field_id_for_name -ts_language_symbol_type -ts_language_version -</pre></div> -</div> -<hr> -<div class="header"> -<p> -Previous: <a href="Tree_002dsitter-major-modes.html">Developing major modes with tree-sitter</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/Using-Parser.html b/admin/notes/tree-sitter/html-manual/Using-Parser.html deleted file mode 100644 index fd8fc482f46..00000000000 --- a/admin/notes/tree-sitter/html-manual/Using-Parser.html +++ /dev/null @@ -1,230 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> -<html> -<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> -<head> -<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> -<!-- This is the GNU Emacs Lisp Reference Manual -corresponding to Emacs version 29.0.50. - -Copyright © 1990-1996, 1998-2023 Free Software Foundation, Inc. - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "GNU General Public License," with the -Front-Cover Texts being "A GNU Manual," and with the Back-Cover -Texts as in (a) below. A copy of the license is included in the -section entitled "GNU Free Documentation License." - -(a) The FSF's Back-Cover Text is: "You have the freedom to copy and -modify this GNU manual. Buying copies from the FSF supports it in -developing GNU and promoting software freedom." --> -<title>Using Parser (GNU Emacs Lisp Reference Manual)</title> - -<meta name="description" content="Using Parser (GNU Emacs Lisp Reference Manual)"> -<meta name="keywords" content="Using Parser (GNU Emacs Lisp Reference Manual)"> -<meta name="resource-type" content="document"> -<meta name="distribution" content="global"> -<meta name="Generator" content="makeinfo"> -<meta name="viewport" content="width=device-width,initial-scale=1"> - -<link href="index.html" rel="start" title="Top"> -<link href="Index.html" rel="index" title="Index"> -<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> -<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> -<link href="Retrieving-Nodes.html" rel="next" title="Retrieving Nodes"> -<link href="Language-Definitions.html" rel="prev" title="Language Definitions"> -<style type="text/css"> -<!-- -a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} -a.summary-letter {text-decoration: none} -blockquote.indentedblock {margin-right: 0em} -div.display {margin-left: 3.2em} -div.example {margin-left: 3.2em} -kbd {font-style: oblique} -pre.display {font-family: inherit} -pre.format {font-family: inherit} -pre.menu-comment {font-family: serif} -pre.menu-preformatted {font-family: serif} -span.nolinebreak {white-space: nowrap} -span.roman {font-family: initial; font-weight: normal} -span.sansserif {font-family: sans-serif; font-weight: normal} -span:hover a.copiable-anchor {visibility: visible} -ul.no-bullet {list-style: none} ---> -</style> -<link rel="stylesheet" type="text/css" href="./manual.css"> - - -</head> - -<body lang="en"> -<div class="section" id="Using-Parser"> -<div class="header"> -<p> -Next: <a href="Retrieving-Nodes.html" accesskey="n" rel="next">Retrieving Nodes</a>, Previous: <a href="Language-Definitions.html" accesskey="p" rel="prev">Tree-sitter Language Definitions</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> -<hr> -<span id="Using-Tree_002dsitter-Parser"></span><h3 class="section">37.2 Using Tree-sitter Parser</h3> -<span id="index-tree_002dsitter-parser_002c-using"></span> - -<p>This section describes how to create and configure a tree-sitter -parser. In Emacs, each tree-sitter parser is associated with a -buffer. As the user edits the buffer, the associated parser and -syntax tree are automatically kept up-to-date. -</p> -<dl class="def"> -<dt id="index-treesit_002dmax_002dbuffer_002dsize"><span class="category">Variable: </span><span><strong>treesit-max-buffer-size</strong><a href='#index-treesit_002dmax_002dbuffer_002dsize' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This variable contains the maximum size of buffers in which -tree-sitter can be activated. Major modes should check this value -when deciding whether to enable tree-sitter features. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dcan_002denable_002dp"><span class="category">Function: </span><span><strong>treesit-can-enable-p</strong><a href='#index-treesit_002dcan_002denable_002dp' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function checks whether the current buffer is suitable for -activating tree-sitter features. It basically checks -<code>treesit-available-p</code> and <code>treesit-max-buffer-size</code>. -</p></dd></dl> - -<span id="index-creating-tree_002dsitter-parsers"></span> -<span id="index-tree_002dsitter-parser_002c-creating"></span> -<dl class="def"> -<dt id="index-treesit_002dparser_002dcreate"><span class="category">Function: </span><span><strong>treesit-parser-create</strong> <em>language &optional buffer no-reuse</em><a href='#index-treesit_002dparser_002dcreate' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>Create a parser for the specified <var>buffer</var> and <var>language</var> -(see <a href="Language-Definitions.html">Tree-sitter Language Definitions</a>). If <var>buffer</var> is omitted or -<code>nil</code>, it stands for the current buffer. -</p> -<p>By default, this function reuses a parser if one already exists for -<var>language</var> in <var>buffer</var>, but if <var>no-reuse</var> is -non-<code>nil</code>, this function always creates a new parser. -</p></dd></dl> - -<p>Given a parser, we can query information about it. -</p> -<dl class="def"> -<dt id="index-treesit_002dparser_002dbuffer"><span class="category">Function: </span><span><strong>treesit-parser-buffer</strong> <em>parser</em><a href='#index-treesit_002dparser_002dbuffer' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the buffer associated with <var>parser</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dparser_002dlanguage"><span class="category">Function: </span><span><strong>treesit-parser-language</strong> <em>parser</em><a href='#index-treesit_002dparser_002dlanguage' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the language used by <var>parser</var>. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dparser_002dp"><span class="category">Function: </span><span><strong>treesit-parser-p</strong> <em>object</em><a href='#index-treesit_002dparser_002dp' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function checks if <var>object</var> is a tree-sitter parser, and -returns non-<code>nil</code> if it is, and <code>nil</code> otherwise. -</p></dd></dl> - -<p>There is no need to explicitly parse a buffer, because parsing is done -automatically and lazily. A parser only parses when a Lisp program -queries for a node in its syntax tree. Therefore, when a parser is -first created, it doesn’t parse the buffer; it waits until the Lisp -program queries for a node for the first time. Similarly, when some -change is made in the buffer, a parser doesn’t re-parse immediately. -</p> -<span id="index-treesit_002dbuffer_002dtoo_002dlarge"></span> -<p>When a parser does parse, it checks for the size of the buffer. -Tree-sitter can only handle buffer no larger than about 4GB. If the -size exceeds that, Emacs signals the <code>treesit-buffer-too-large</code> -error with signal data being the buffer size. -</p> -<p>Once a parser is created, Emacs automatically adds it to the -internal parser list. Every time a change is made to the buffer, -Emacs updates parsers in this list so they can update their syntax -tree incrementally. -</p> -<dl class="def"> -<dt id="index-treesit_002dparser_002dlist"><span class="category">Function: </span><span><strong>treesit-parser-list</strong> <em>&optional buffer</em><a href='#index-treesit_002dparser_002dlist' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the parser list of <var>buffer</var>. If -<var>buffer</var> is <code>nil</code> or omitted, it defaults to the current -buffer. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dparser_002ddelete"><span class="category">Function: </span><span><strong>treesit-parser-delete</strong> <em>parser</em><a href='#index-treesit_002dparser_002ddelete' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function deletes <var>parser</var>. -</p></dd></dl> - -<span id="index-tree_002dsitter-narrowing"></span> -<span id="tree_002dsitter-narrowing"></span><p>Normally, a parser “sees” the whole buffer, but when the buffer is -narrowed (see <a href="Narrowing.html">Narrowing</a>), the parser will only see the accessible -portion of the buffer. As far as the parser can tell, the hidden -region was deleted. When the buffer is later widened, the parser -thinks text is inserted at the beginning and at the end. Although -parsers respect narrowing, modes should not use narrowing as a means -to handle a multi-language buffer; instead, set the ranges in which the -parser should operate. See <a href="Multiple-Languages.html">Parsing Text in Multiple Languages</a>. -</p> -<p>Because a parser parses lazily, when the user or a Lisp program -narrows the buffer, the parser is not affected immediately; as long as -the mode doesn’t query for a node while the buffer is narrowed, the -parser is oblivious of the narrowing. -</p> -<span id="index-tree_002dsitter-parse-string"></span> -<span id="index-parse-string_002c-tree_002dsitter"></span> -<p>Besides creating a parser for a buffer, a Lisp program can also parse a -string. Unlike a buffer, parsing a string is a one-off operation, and -there is no way to update the result. -</p> -<dl class="def"> -<dt id="index-treesit_002dparse_002dstring"><span class="category">Function: </span><span><strong>treesit-parse-string</strong> <em>string language</em><a href='#index-treesit_002dparse_002dstring' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function parses <var>string</var> using <var>language</var>, and returns -the root node of the generated syntax tree. -</p></dd></dl> - -<span id="Be-notified-by-changes-to-the-parse-tree"></span><h3 class="heading">Be notified by changes to the parse tree</h3> -<span id="index-update-callback_002c-for-tree_002dsitter-parse_002dtree"></span> -<span id="index-after_002dchange-notifier_002c-for-tree_002dsitter-parse_002dtree"></span> -<span id="index-tree_002dsitter-parse_002dtree_002c-update-and-after_002dchange-callback"></span> -<span id="index-notifiers_002c-tree_002dsitter"></span> - -<p>A Lisp program might want to be notified of text affected by -incremental parsing. For example, inserting a comment-closing token -converts text before that token into a comment. Even -though the text is not directly edited, it is deemed to be “changed” -nevertheless. -</p> -<p>Emacs lets a Lisp program to register callback functions -(a.k.a. <em>notifiers</em>) for this kind of changes. A notifier -function takes two arguments: <var>ranges</var> and <var>parser</var>. -<var>ranges</var> is a list of cons cells of the form <code>(<var>start</var> . <var>end</var>)</code><!-- /@w -->, where <var>start</var> and <var>end</var> mark the start and the -end positions of a range. <var>parser</var> is the parser issuing the -notification. -</p> -<p>Every time a parser reparses a buffer, it compares the old and new -parse-tree, computes the ranges in which nodes have changed, and -passes the ranges to notifier functions. -</p> -<dl class="def"> -<dt id="index-treesit_002dparser_002dadd_002dnotifier"><span class="category">Function: </span><span><strong>treesit-parser-add-notifier</strong> <em>parser function</em><a href='#index-treesit_002dparser_002dadd_002dnotifier' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function adds <var>function</var> to <var>parser</var>’s list of -after-change notifier functions. <var>function</var> must be a function -symbol, not a lambda function (see <a href="Anonymous-Functions.html">Anonymous Functions</a>). -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dparser_002dremove_002dnotifier"><span class="category">Function: </span><span><strong>treesit-parser-remove-notifier</strong> <em>parser function</em><a href='#index-treesit_002dparser_002dremove_002dnotifier' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function removes <var>function</var> from the list of <var>parser</var>’s -after-change notifier functions. <var>function</var> must be a function -symbol, rather than a lambda function. -</p></dd></dl> - -<dl class="def"> -<dt id="index-treesit_002dparser_002dnotifiers"><span class="category">Function: </span><span><strong>treesit-parser-notifiers</strong> <em>parser</em><a href='#index-treesit_002dparser_002dnotifiers' class='copiable-anchor'> ¶</a></span></dt> -<dd><p>This function returns the list of <var>parser</var>’s notifier functions. -</p></dd></dl> - -</div> -<hr> -<div class="header"> -<p> -Next: <a href="Retrieving-Nodes.html">Retrieving Nodes</a>, Previous: <a href="Language-Definitions.html">Tree-sitter Language Definitions</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> -</div> - - - -</body> -</html> diff --git a/admin/notes/tree-sitter/html-manual/build-manual.sh b/admin/notes/tree-sitter/html-manual/build-manual.sh deleted file mode 100755 index 8d931b143b2..00000000000 --- a/admin/notes/tree-sitter/html-manual/build-manual.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/bash - -MANUAL_DIR="../../../../doc/lispref" -THIS_DIR=$(pwd) - -echo "Build manual" -cd "${MANUAL_DIR}" -make elisp.html HTML_OPTS="--html --css-ref=./manual.css" - -cd "${THIS_DIR}" - -echo "Copy manual" -cp -f "${MANUAL_DIR}/elisp.html/Parsing-Program-Source.html" . -cp -f "${MANUAL_DIR}/elisp.html/Language-Definitions.html" . -cp -f "${MANUAL_DIR}/elisp.html/Using-Parser.html" . -cp -f "${MANUAL_DIR}/elisp.html/Retrieving-Node.html" . -cp -f "${MANUAL_DIR}/elisp.html/Accessing-Node.html" . -cp -f "${MANUAL_DIR}/elisp.html/Pattern-Matching.html" . -cp -f "${MANUAL_DIR}/elisp.html/Multiple-Languages.html" . -cp -f "${MANUAL_DIR}/elisp.html/Tree_002dsitter-C-API.html" . - -cp -f "${MANUAL_DIR}/elisp.html/Parser_002dbased-Font-Lock.html" . -cp -f "${MANUAL_DIR}/elisp.html/Parser_002dbased-Indentation.html" . diff --git a/admin/notes/tree-sitter/html-manual/manual.css b/admin/notes/tree-sitter/html-manual/manual.css deleted file mode 100644 index c03e0d37009..00000000000 --- a/admin/notes/tree-sitter/html-manual/manual.css +++ /dev/null @@ -1,374 +0,0 @@ -/* Style-sheet to use for Emacs manuals */ - -/* Copyright (C) 2013-2014, 2023 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, -are permitted in any medium without royalty provided the copyright -notice and this notice are preserved. This file is offered as-is, -without any warranty. -*/ - -/* style.css begins here */ - -/* This stylesheet is used by manuals and a few older resources. */ - -/* reset.css begins here */ - -/* -Software License Agreement (BSD License) - -Copyright (c) 2006, Yahoo! Inc. -All rights reserved. - -Redistribution and use of this software in source and -binary forms, with or without modification, arepermitted -provided that the following conditions are met: - -* Redistributions of source code must retain the above -copyright notice, this list of conditions and the -following disclaimer. - -* Redistributions in binary form must reproduce the above -copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other -materials provided with the distribution. - -* Neither the name of Yahoo! Inc. nor the names of its -contributors may be used to endorse or promote products -derived from this software without specific prior -written permission of Yahoo! Inc. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND -CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR -CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER -IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -SUCH DAMAGE. -*/ - -html { - color: #000; - background: #FFF; -} - -body, div, dl, dt, dd, ul, ol, li, h1, h2, h3, h4, -h5, h6, pre, code, form, fieldset, legend, input, -button, textarea, p, blockquote, th, td { - margin: 0; - padding: 0; -} - -table { - border-collapse: collapse; - border-spacing: 0; -} - -fieldset, img { - border: 0; -} - -address, caption, cite, code, dfn, em, strong, -th, var, optgroup { - font-style: inherit; - font-weight: inherit; -} - -del, ins { - text-decoration: none; -} - -li { - list-style:none; -} - -caption, th { - text-align: left; -} - -h1, h2, h3, h4, h5, h6 { - font-size: 100%; - font-weight: normal; -} - -q:before, q:after { - content:''; -} - -abbr, acronym { - border: 0; - font-variant: normal; -} - -sup { - vertical-align: baseline; -} -sub { - vertical-align: baseline; -} - -legend { - color: #000; -} - -input, button, textarea, select, optgroup, option { - font-family: inherit; - font-size: inherit; - font-style: inherit; - font-weight: inherit; -} - -input, button, textarea, select { - *font-size: 100%; -} - - -/* reset.css ends here */ - -/*** PAGE LAYOUT ***/ - -html, body { - font-size: 1em; - text-align: left; - text-decoration: none; -} -html { background-color: #e7e7e7; } - -body { - max-width: 74.92em; - margin: 0 auto; - padding: .5em 1em 1em 1em; - background-color: white; - border: .1em solid #c0c0c0; -} - - -/*** BASIC ELEMENTS ***/ - -/* Size and positioning */ - -p, pre, li, dt, dd, table, code, address { line-height: 1.3em; } - -h1 { font-size: 2em; margin: 1em 0 } -h2 { font-size: 1.50em; margin: 1.0em 0 0.87em 0; } -h3 { font-size: 1.30em; margin: 1.0em 0 0.87em 0; } -h4 { font-size: 1.13em; margin: 1.0em 0 0.88em 0; } -h5 { font-size: 1.00em; margin: 1.0em 0 1.00em 0; } - -p, pre { margin: 1em 0; } -pre { overflow: auto; padding-bottom: .3em; } - -ul, ol, blockquote { margin-left: 1.5%; margin-right: 1.5%; } -hr { margin: 1em 0; } -/* Lists of underlined links are difficult to read. The top margin - gives a little more spacing between entries. */ -ul li { margin: .5em 1em; } -ol li { margin: 1em; } -ol ul li { margin: .5em 1em; } -ul li p, ul ul li { margin-top: .3em; margin-bottom: .3em; } -ul ul, ol ul { margin-top: 0; margin-bottom: 0; } - -/* Separate description lists from preceding text */ -dl { margin: 1em 0 0 0; } -/* separate the "term" from subsequent "description" */ -dt { margin: .5em 0; } -/* separate the "description" from subsequent list item - when the final <dd> child is an anonymous box */ -dd { margin: .5em 3% 1em 3%; } -/* separate anonymous box (used to be the first element in <dd>) - from subsequent <p> */ -dd p { margin: .5em 0; } - -table { - display: block; overflow: auto; - margin-top: 1.5em; margin-bottom: 1.5em; -} -th { padding: .3em .5em; text-align: center; } -td { padding: .2em .5em; } - -address { margin-bottom: 1em; } -caption { margin-bottom: .5em; text-align: center; } -sup { vertical-align: super; } -sub { vertical-align: sub; } - -/* Style */ - -h1, h2, h3, h4, h5, h6, strong, dt, th { font-weight: bold; } - -/* The default color (black) is too dark for large text in - bold font. */ -h1, h2, h3, h4 { color: #333; } -h5, h6, dt { color: #222; } - -a[href] { color: #005090; } -a[href]:visited { color: #100070; } -a[href]:active, a[href]:hover { - color: #100070; - text-decoration: none; -} - -h1 a[href]:visited, h2 a[href]:visited, h3 a[href]:visited, -h4 a[href]:visited { color: #005090; } -h1 a[href]:hover, h2 a[href]:hover, h3 a[href]:hover, -h4 a[href]:hover { color: #100070; } - -ol { list-style: decimal outside;} -ul { list-style: square outside; } -ul ul, ol ul { list-style: circle; } -li { list-style: inherit; } - -hr { background-color: #ede6d5; } -table { border: 0; } - -abbr,acronym { - border-bottom:1px dotted #000; - text-decoration: none; - cursor:help; -} -del { text-decoration: line-through; } -em { font-style: italic; } -small { font-size: .9em; } - -img { max-width: 100%} - - -/*** SIMPLE CLASSES ***/ - -.center, .c { text-align: center; } -.nocenter{ text-align: left; } - -.underline { text-decoration: underline; } -.nounderline { text-decoration: none; } - -.no-bullet { list-style: none; } -.inline-list li { display: inline } - -.netscape4, .no-display { display: none; } - - -/*** MANUAL PAGES ***/ - -/* This makes the very long tables of contents in Gnulib and other - manuals easier to read. */ -.contents ul, .shortcontents ul { font-weight: bold; } -.contents ul ul, .shortcontents ul ul { font-weight: normal; } -.contents ul { list-style: none; } - -/* For colored navigation bars (Emacs manual): make the bar extend - across the whole width of the page and give it a decent height. */ -.header, .node { margin: 0 -1em; padding: 0 1em; } -.header p, .node p { line-height: 2em; } - -/* For navigation links */ -.node a, .header a { display: inline-block; line-height: 2em; } -.node a:hover, .header a:hover { background: #f2efe4; } - -/* Inserts */ -table.cartouche td { padding: 1.5em; } - -div.display, div.lisp, div.smalldisplay, -div.smallexample, div.smalllisp { margin-left: 3%; } - -div.example { padding: .8em 1.2em .4em; } -pre.example { padding: .8em 1.2em; } -div.example, pre.example { - margin: 1em 0 1em 3% ; - -webkit-border-radius: .3em; - -moz-border-radius: .3em; - border-radius: .3em; - border: 1px solid #d4cbb6; - background-color: #f2efe4; -} -div.example > pre.example { - padding: 0 0 .4em; - margin: 0; - border: none; -} - -pre.menu-comment { padding-top: 1.3em; margin: 0; } - - -/*** FOR WIDE SCREENS ***/ - -@media (min-width: 40em) { - body { padding: .5em 3em 1em 3em; } - div.header, div.node { margin: 0 -3em; padding: 0 3em; } -} - -/* style.css ends here */ - -/* makeinfo convert @deffn and similar functions to something inside - <blockquote>. style.css uses italic for blockquote. This looks poor - in the Emacs manuals, which make extensive use of @defun (etc). - In particular, references to function arguments appear as <var> - inside <blockquote>. Since <var> is also italic, it makes it - impossible to distinguish variables. We could change <var> to - e.g. bold-italic, or normal, or a different color, but that does - not look as good IMO. So we just override blockquote to be non-italic. - */ -blockquote { font-style: normal; } - -var { font-style: italic; } - -div.header { - background-color: #DDDDFF; - padding-top: 0.2em; -} - - -/*** Customization ***/ - -body { - font-family: Charter, serif; - font-size: 14pt; - line-height: 1.4; - background-color: #fefefc; - color: #202010; -} - -pre.menu-comment { - font-family: Charter, serif; - font-size: 14pt; -} - -body > *, body > div.display, body > div.lisp, body > div.smalldisplay, -body > div.example, body > div.smallexample, body > div.smalllisp { - width: 700px; - margin-left: auto; - margin-right: auto; -} - -div.header { - width: 100%; - min-height: 3em; - font-size: 13pt; -} - -/* Documentation block for functions and variables. Make then - narrower*/ -dd { - margin: .5em 6% 1em 6% -} - -code, pre, kbd, samp, tt { - font-size: 12pt; - font-family: monospace; -} - -/* In each node we have index table to all sub-nodes. Make more space - for the first column, which is the name to each sub-node. */ -table.menu tbody tr td:nth-child(1) { - white-space: nowrap; -} - -div.header p { - text-align: center; - margin: 0.5em auto 0.5em auto; -} diff --git a/admin/notes/tree-sitter/starter-guide b/admin/notes/tree-sitter/starter-guide index 606f7891dfa..846614f1446 100644 --- a/admin/notes/tree-sitter/starter-guide +++ b/admin/notes/tree-sitter/starter-guide @@ -17,6 +17,7 @@ TOC: - More features? - Common tasks (code snippets) - Manual +- Appendix 1 * Building Emacs with tree-sitter @@ -42,11 +43,9 @@ You can use this script that I put together here: https://github.com/casouri/tree-sitter-module -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, -and C#. Better yet, I pre-built these language definitions for +C++, Rust, JSON, Go, HTML, JavaScript, CSS, Python, Typescript, +C#, etc. Better yet, I pre-built these language definitions for GNU/Linux and macOS, they can be downloaded here: https://github.com/casouri/tree-sitter-module/releases/tag/v2.1 @@ -68,6 +67,10 @@ organization has all the "official" language definitions: https://github.com/tree-sitter +Alternatively, you can use treesit-install-language-grammar command +and follow its instructions. If everything goes right, it should +automatically download and compile the language grammar for you. + * Setting up for adding major mode features Start Emacs and load tree-sitter with @@ -78,6 +81,10 @@ Now check if Emacs is built with tree-sitter library (treesit-available-p) +Make sure Emacs can find the language grammar you want to use + + (treesit-language-available-p 'lang) + * Tree-sitter major modes Tree-sitter modes should be separate major modes, so other modes @@ -89,12 +96,15 @@ modes. If the tree-sitter variant and the "native" variant could share some setup, you can create a "base mode", which only contains the common -setup. For example, there is python-base-mode (shared), python-mode -(native), and python-ts-mode (tree-sitter). +setup. For example, python.el defines python-base-mode (shared), +python-mode (native), and python-ts-mode (tree-sitter). In the tree-sitter mode, check if we can use tree-sitter with treesit-ready-p, it will error out if tree-sitter is not ready. +In Emacs 30 we'll introduce some mechanism to more gracefully inherit +modes and fallback to other modes. + * Naming convention Use tree-sitter for text (documentation, comment), use treesit for @@ -180,18 +190,17 @@ mark the offending part in red. To enable tree-sitter font-lock, set ‘treesit-font-lock-settings’ and ‘treesit-font-lock-feature-list’ buffer-locally and call ‘treesit-major-mode-setup’. For example, see -‘python--treesit-settings’ in python.el. Below I paste a snippet of -it. +‘python--treesit-settings’ in python.el. Below is a snippet of it. -Note that like the current font-lock, if the to-be-fontified region -already has a face (ie, an earlier match fontified part/all of the -region), the new face is discarded rather than applied. If you want -later matches always override earlier matches, use the :override -keyword. +Just like the current font-lock, if the to-be-fontified region already +has a face (ie, an earlier match fontified part/all of the region), +the new face is discarded rather than applied. If you want later +matches always override earlier matches, use the :override keyword. Each rule should have a :feature, like function-name, string-interpolation, builtin, etc. Users can then enable/disable each -feature individually. +feature individually. See Appendix 1 at the bottom for a set of common +features names. #+begin_src elisp (defvar python--treesit-settings @@ -247,8 +256,7 @@ Concretely, something like this: (string-interpolation decorator))) (treesit-major-mode-setup)) (t - ;; No tree-sitter - (setq-local font-lock-defaults ...) + ;; No tree-sitter, do nothing or fallback to another mode. ...))) #+end_src @@ -271,7 +279,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 @@ -289,6 +297,7 @@ For ANCHOR we have first-sibling => start of the first sibling parent => start of parent parent-bol => BOL of the line parent is on. + standalone-parent => Like parent-bol but handles more edge cases prev-sibling => start of previous sibling no-indent => current position (don’t indent) prev-line => start of previous line @@ -329,7 +338,8 @@ tells you which rule is applied in the echo area. ...)))) #+end_src -Then you set ‘treesit-simple-indent-rules’ to your rules, and call +To setup indentation for your major mode, set +‘treesit-simple-indent-rules’ to your rules, and call ‘treesit-major-mode-setup’: #+begin_src elisp @@ -339,36 +349,14 @@ Then you set ‘treesit-simple-indent-rules’ to your rules, and call * Imenu -Not much to say except for utilizing ‘treesit-induce-sparse-tree’ (and -explicitly pass a LIMIT argument: most of the time you don't need more -than 10). See ‘js--treesit-imenu-1’ in js.el for an example. - -Once you have the index builder, set ‘imenu-create-index-function’ to -it. +Set ‘treesit-simple-imenu-settings’ and call +‘treesit-major-mode-setup’. * Navigation -Mainly ‘beginning-of-defun-function’ and ‘end-of-defun-function’. -You can find the end of a defun with something like - -(treesit-search-forward-goto "function_definition" 'end) - -where "function_definition" matches the node type of a function -definition node, and ’end means we want to go to the end of that node. - -Tree-sitter has default implementations for -‘beginning-of-defun-function’ and ‘end-of-defun-function’. So for -ordinary languages, it is enough to set ‘treesit-defun-type-regexp’ -to something that matches all the defun struct types in the language, -and call ‘treesit-major-mode-setup’. For example, - -#+begin_src emacs-lisp -(setq-local treesit-defun-type-regexp (rx bol - (or "function" "class") - "_definition" - eol)) -(treesit-major-mode-setup) -#+end_src> +Set ‘treesit-defun-type-regexp’ and call +‘treesit-major-mode-setup’. You can additionally set +‘treesit-defun-name-function’. * Which-func @@ -376,36 +364,7 @@ If you have an imenu implementation, set ‘which-func-functions’ to nil, and which-func will automatically use imenu’s data. If you want an independent implementation for which-func, you can -find the current function by going up the tree and looking for the -function_definition node. See the function below for an example. -Since Python allows nested function definitions, that function keeps -going until it reaches the root node, and records all the function -names along the way. - -#+begin_src elisp -(defun python-info-treesit-current-defun (&optional include-type) - "Identical to `python-info-current-defun' but use tree-sitter. -For INCLUDE-TYPE see `python-info-current-defun'." - (let ((node (treesit-node-at (point))) - (name-list ()) - (type nil)) - (cl-loop while node - if (pcase (treesit-node-type node) - ("function_definition" - (setq type 'def)) - ("class_definition" - (setq type 'class)) - (_ nil)) - do (push (treesit-node-text - (treesit-node-child-by-field-name node "name") - t) - name-list) - do (setq node (treesit-node-parent node)) - finally return (concat (if include-type - (format "%s " type) - "") - (string-join name-list "."))))) -#+end_src +find the current function by ‘treesit-defun-at-point’. * More features? @@ -449,7 +408,51 @@ section is Parsing Program Source. Typing C-h i d m elisp RET g Parsing Program Source RET -will bring you to that section. You can also read the HTML version -under /html-manual in this directory. I find the HTML version easier -to read. You don’t need to read through every sentence, just read the -text paragraphs and glance over function names. +will bring you to that section. You don’t need to read through every +sentence, just read the text paragraphs and glance over function +names. + +* Appendix 1 + +Below is a set of common features used by built-in major mode. + +Basic tokens: + +delimiter ,.; (delimit things) +operator == != || (produces a value) +bracket []{}() +misc-punctuation (other punctuation that you want to highlight) + +constant true, false, null +number +keyword +comment (includes doc-comments) +string (includes chars and docstrings) +string-interpolation f"text {variable}" +escape-sequence "\n\t\\" +function every function identifier +variable every variable identifier +type every type identifier +property a.b <--- highlight b +key { a: b, c: d } <--- highlight a, c +error highlight parse error + +Abstract features: + +assignment: the LHS of an assignment (thing being assigned to), eg: + +a = b <--- highlight a +a.b = c <--- highlight b +a[1] = d <--- highlight a + +definition: the thing being defined, eg: + +int a(int b) { <--- highlight a + return 0 +} + +int a; <-- highlight a + +struct a { <--- highlight a + int b; <--- highlight b +} diff --git a/admin/notes/tree-sitter/treesit_record_change b/admin/notes/tree-sitter/treesit_record_change new file mode 100644 index 00000000000..0dc6491e2d1 --- /dev/null +++ b/admin/notes/tree-sitter/treesit_record_change @@ -0,0 +1,50 @@ +NOTES ON TREESIT_RECORD_CHANGE + +It is vital that Emacs informs tree-sitter of every change made to the +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 relevant +functions in insdel.c as of Emacs 29: + +Function Calls +---------------------------------------------------------------------- +copy_text (*1) +insert insert_1_both +insert_and_inherit insert_1_both +insert_char insert +insert_string insert +insert_before_markers insert_1_both +insert_before_markers_and_inherit insert_1_both +insert_1_both treesit_record_change +insert_from_string insert_from_string_1 +insert_from_string_before_markers insert_from_string_1 +insert_from_string_1 treesit_record_change +insert_from_gap_1 treesit_record_change +insert_from_gap insert_from_gap_1 +insert_from_buffer treesit_record_change +insert_from_buffer_1 (used by insert_from_buffer) (*2) +replace_range treesit_record_change +replace_range_2 (caller needs to call treesit_r_c) +del_range del_range_1 +del_range_1 del_range_2 +del_range_byte del_range_2 +del_range_both del_range_2 +del_range_2 treesit_record_change + +(*1) This functions is used only to copy from string to string when +used outside of insdel.c, and when used inside insdel.c, the caller +calls treesit_record_change. + +(*2) This function is a static function, and insert_from_buffer is its +only caller. So it should be fine to call treesit_record_change in +insert_from_buffer but not insert_from_buffer_1. I also left a +reminder comment. + + +As for casefiddle.c, do_casify_unibyte_region and +do_casify_multibyte_region modifies buffer, but they are static +functions and are called by casify_region, which calls +treesit_record_change. Other higher-level functions calls +casify_region to do the work.
\ No newline at end of file diff --git a/build-aux/config.guess b/build-aux/config.guess index b30b9fdc8ef..69188da73d7 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -4,7 +4,7 @@ # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-09-17' +timestamp='2023-01-01' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -60,7 +60,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2022 Free Software Foundation, Inc. +Copyright 1992-2023 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." diff --git a/build-aux/config.sub b/build-aux/config.sub index 9e118bdee3c..de4259e4047 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -4,7 +4,7 @@ # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-09-17' +timestamp='2023-01-21' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -76,7 +76,7 @@ Report bugs and patches to <config-patches@gnu.org>." version="\ GNU config.sub ($timestamp) -Copyright 1992-2022 Free Software Foundation, Inc. +Copyright 1992-2023 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -1075,7 +1075,7 @@ case $cpu-$vendor in pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) cpu=i586 ;; - pentiumpro-* | p6-* | 6x86-* | athlon-* | athalon_*-*) + pentiumpro-* | p6-* | 6x86-* | athlon-* | athlon_*-*) cpu=i686 ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) diff --git a/build-aux/update-copyright b/build-aux/update-copyright index ce919bac727..99196fceef6 100755 --- a/build-aux/update-copyright +++ b/build-aux/update-copyright @@ -137,7 +137,7 @@ eval 'exec perl -wSx -0777 -pi "$0" "$@"' if 0; -my $VERSION = '2020-04-04.15:07'; # UTC +my $VERSION = '2023-01-11.04:24'; # UTC # The definition above must lie within the first 8 lines in order # for the Emacs time-stamp write hook (at end) to update it. # If you change this file with Emacs, please let the write hook @@ -280,7 +280,7 @@ if (defined $stmt_re) } # Replace the old copyright statement. - s/$stmt_re/$stmt_wrapped/; + s/$stmt_re/$stmt_wrapped/g; } } else diff --git a/configure.ac b/configure.ac index 645082c9746..c5300beb2ba 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. AC_PREREQ([2.65]) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT([GNU Emacs], [29.0.60], [bug-gnu-emacs@gnu.org], [], +AC_INIT([GNU Emacs], [30.0.50], [bug-gnu-emacs@gnu.org], [], [https://www.gnu.org/software/emacs/]) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, @@ -1139,6 +1139,7 @@ AS_IF([test $gl_gcc_warnings = no], # clang is unduly picky about some things. if test "$emacs_cv_clang" = yes; then + gl_WARN_ADD([-Wno-bitwise-instead-of-logical]) gl_WARN_ADD([-Wno-missing-braces]) gl_WARN_ADD([-Wno-null-pointer-arithmetic]) gl_WARN_ADD([-Wno-implicit-const-int-float-conversion]) @@ -1841,7 +1842,9 @@ AC_CHECK_HEADERS_ONCE( coff.h pty.h sys/resource.h sys/utsname.h pwd.h utmp.h util.h - sanitizer/lsan_interface.h]) + sanitizer/lsan_interface.h + sanitizer/asan_interface.h + sanitizer/common_interface_defs.h]) AC_CACHE_CHECK([for ADDR_NO_RANDOMIZE], [emacs_cv_personality_addr_no_randomize], @@ -2693,39 +2696,6 @@ if test "${HAVE_X11}" = "yes"; then export LD_RUN_PATH fi - if test "${opsys}" = "gnu-linux"; then - AC_CACHE_CHECK([whether X on GNU/Linux needs -b to link], [emacs_cv_b_link], - [AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], - [[XOpenDisplay ("foo");]])], - [xgnu_linux_first_failure=no], - [xgnu_linux_first_failure=yes]) - if test "${xgnu_linux_first_failure}" = "yes"; then - OLD_CPPFLAGS="$CPPFLAGS" - OLD_LIBS="$LIBS" - CPPFLAGS="$CPPFLAGS -b i486-linuxaout" - LIBS="$LIBS -b i486-linuxaout" - AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], - [[XOpenDisplay ("foo");]])], - [xgnu_linux_second_failure=no], - [xgnu_linux_second_failure=yes]) - if test "${xgnu_linux_second_failure}" = "yes"; then - # If we get the same failure with -b, there is no use adding -b. - # So leave it out. This plays safe. - emacs_cv_b_link=no - else - emacs_cv_b_link=yes - fi - CPPFLAGS=$OLD_CPPFLAGS - LIBS=$OLD_LIBS - else - emacs_cv_b_link=no - fi]) - if test "x$emacs_cv_b_link" = xyes ; then - LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout" - C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout" - fi - fi - # Reportedly, some broken Solaris systems have XKBlib.h but are missing # header files included from there. AC_CACHE_CHECK([for Xkb], [emacs_cv_xkb], @@ -2806,6 +2776,25 @@ if test "${with_webp}" != "no"; then WEBP_MODULE="libwebpdemux >= $WEBP_REQUIRED" EMACS_CHECK_MODULES([WEBP], [$WEBP_MODULE]) + + # WebPGetInfo is sometimes not present inside libwebpdemux, so + # if it does not link, also check for libwebpdecoder. + + OLD_CFLAGS=$CFLAGS + OLD_LIBS=$LIBS + CFLAGS="$CFLAGS $WEBP_CFLAGS" + LIBS="$LIBS $WEBP_LIBS" + + AC_CHECK_FUNC([WebPGetInfo], [], + [WEBP_MODULE="$WEBP_MODULE libwebpdecoder >= $WEBP_REQUIRED" + HAVE_WEBP=no + AS_UNSET([WEBP_LIBS]) + AS_UNSET([WEBP_CFLAGS]) + EMACS_CHECK_MODULES([WEBP], [$WEBP_MODULE])]) + + CFLAGS=$OLD_CFLAGS + LIBS=$OLD_LIBS + AC_SUBST([WEBP_CFLAGS]) AC_SUBST([WEBP_LIBS]) fi @@ -3613,8 +3602,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 @@ -3935,21 +3928,10 @@ if test "${HAVE_X11}" = "yes"; then if test "${HAVE_XCB}" = "yes"; then AC_CHECK_LIB([X11-xcb], [XGetXCBConnection], [HAVE_X11_XCB=yes]) if test "${HAVE_X11_XCB}" = "yes"; then - AC_CHECK_LIB([xcb-util], [xcb_aux_sync], [HAVE_XCB_UTIL=yes]) - if test "${HAVE_XCB_UTIL}" = "yes"; then - AC_DEFINE([USE_XCB], [1], + AC_DEFINE([USE_XCB], [1], [Define to 1 if you have the XCB library and X11-XCB library for mixed - X11/XCB programming.]) - XCB_LIBS="-lX11-xcb -lxcb -lxcb-util" - else - AC_CHECK_LIB([xcb-aux], [xcb_aux_sync], [HAVE_XCB_AUX=yes]) - if test "${HAVE_XCB_AUX}" = "yes"; then - AC_DEFINE([USE_XCB], [1], -[Define to 1 if you have the XCB library and X11-XCB library for mixed - X11/XCB programming.]) - XCB_LIBS="-lX11-xcb -lxcb -lxcb-aux" - fi - fi +X11/XCB programming.]) + XCB_LIBS="-lX11-xcb -lxcb" fi fi fi @@ -4217,11 +4199,13 @@ AC_SUBST_FILE([module_env_snippet_26]) AC_SUBST_FILE([module_env_snippet_27]) AC_SUBST_FILE([module_env_snippet_28]) AC_SUBST_FILE([module_env_snippet_29]) +AC_SUBST_FILE([module_env_snippet_30]) module_env_snippet_25="$srcdir/src/module-env-25.h" module_env_snippet_26="$srcdir/src/module-env-26.h" module_env_snippet_27="$srcdir/src/module-env-27.h" module_env_snippet_28="$srcdir/src/module-env-28.h" module_env_snippet_29="$srcdir/src/module-env-29.h" +module_env_snippet_30="$srcdir/src/module-env-30.h" emacs_major_version="${PACKAGE_VERSION%%.*}" AC_SUBST([emacs_major_version]) @@ -4305,8 +4289,8 @@ If you really want to try it anyway, use the configure option fi if test "${with_native_compilation}" != "no"; then - if test "${HAVE_PDUMPER}" = no; then - AC_MSG_ERROR(['--with-native-compilation' requires '--with-dumping=pdumper']) + if test "$with_unexec" = yes; then + AC_MSG_ERROR(['--with-native-compilation' is not compatible with unexec]) fi if test "${HAVE_ZLIB}" = no; then AC_MSG_ERROR(['--with-native-compilation' requires zlib]) @@ -4703,7 +4687,7 @@ AC_SUBST([XINERAMA_LIBS]) ### Use Xfixes (-lXfixes) if available HAVE_XFIXES=no if test "${HAVE_X11}" = "yes"; then - XFIXES_REQUIRED=4.0.0 + XFIXES_REQUIRED=1.0.0 XFIXES_MODULES="xfixes >= $XFIXES_REQUIRED" EMACS_CHECK_MODULES([XFIXES], [$XFIXES_MODULES]) if test $HAVE_XFIXES = no; then @@ -5007,6 +4991,7 @@ pthread_sigmask strsignal setitimer \ sendto recvfrom getsockname getifaddrs freeifaddrs \ gai_strerror sync \ getpwent endpwent getgrent endgrent \ +renameat2 \ cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np \ pthread_set_name_np]) LIBS=$OLD_LIBS @@ -6400,7 +6385,7 @@ fi # it temporarily reverts them to their pre-pkg-config values, # because gnulib needs to work with both src (which uses the # pkg-config stuff) and lib-src (which does not). For example, gnulib -# may need to determine whether LIB_CLOCK_GETTIME should contain -lrt, +# may need to determine whether CLOCK_TIME_LIB should contain -lrt, # and it therefore needs to run in an environment where LIBS does not # already contain -lrt merely because 'pkg-config --libs' printed '-lrt' # for some package unrelated to lib-src. @@ -6540,6 +6525,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]) @@ -6592,7 +6583,9 @@ if test "${HAVE_GTK}" = "yes"; then fi if test $USE_ACL -ne 0; then - ACL_SUMMARY="yes $LIB_ACL" + ACL_SUMMARY="yes" + test "$LIB_ACL" && ACL_SUMMARY="$ACL_SUMMARY $LIB_ACL" + test "$LIB_XATTR" && ACL_SUMMARY="$ACL_SUMMARY $LIB_XATTR" else ACL_SUMMARY=no fi @@ -6663,6 +6656,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/basic.texi b/doc/emacs/basic.texi index 2cc45a8805e..a271cb65bdc 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -887,19 +887,40 @@ z z z}. The first @kbd{C-x z} repeats the command once, and each subsequent @kbd{z} repeats it once again. @findex repeat-mode +@findex describe-repeat-maps @vindex repeat-exit-key @vindex repeat-exit-timeout - Also you can activate @code{repeat-mode} that temporarily enables a -transient mode with short keys after a limited number of commands. -Currently supported shorter key sequences are @kbd{C-x u u} instead of -@kbd{C-x u C-x u} to undo many changes, @kbd{C-x o o} instead of -@kbd{C-x o C-x o} to switch several windows, @kbd{C-x @{ @{ @} @} ^ ^ -v v} to resize the selected window interactively, @kbd{M-g n n p p} to -navigate @code{next-error} matches, and @kbd{C-x ] ] [ [} to navigate -through pages. Any other key exits transient mode and then is -executed normally. The user option @code{repeat-exit-key} defines an -additional key to exit this transient mode. Also it's possible to -break the repetition chain automatically after some idle time by -customizing the user option @code{repeat-exit-timeout} to specify the -idle time in seconds after which this transient mode will be turned -off. + You can also activate @code{repeat-mode} which allows repeating +commands bound to sequences of two or more keys by typing a single +character. For example, after typing @w{@kbd{C-x u}} (@code{undo}, +@pxref{Undo}) to undo the most recent edits, you can undo many more +edits by typing @w{@kbd{u u u@dots{}}}. Similarly, type @w{@kbd{C-x o +o o@dots{}}} instead of @w{@kbd{C-x o C-x o C-x o@dots{}}} to switch +to the window several windows away. This works by entering a +transient repeating mode after you type the full key sequence that +invokes the command; the single-key shortcuts are shown in the echo +area. + +Only some commands support repetition in @code{repeat-mode}; type +@w{@kbd{M-x describe-repeat-maps @key{RET}}} to see which ones. + +The single-character shortcuts enabled by the transient repeating mode +do not need to be identical: for example, after typing @w{@kbd{C-x +@{}}, either @kbd{@{} or @kbd{@}} or @kbd{^} or @kbd{v}, or any series +that mixes these characters in any order, will resize the selected +window in respective ways. Similarly, after @w{@kbd{M-g n}} or +@kbd{M-g p}, typing any sequence of @kbd{n} and/or @kbd{p} in any mix +will repeat @code{next-error} and @code{previous-error} to navigate in +a @file{*compilation*} or @file{*grep*} buffer (@pxref{Compilation +Mode}). + +Typing any key other than those defined to repeat the previous command +exits the transient repeating mode, and then the key you typed is +executed normally. You can also define a key which will exit the +transient repeating mode @emph{without} executing the key which caused +the exit. To this end, customize the user option +@code{repeat-exit-key} to name a key; one natural value is @key{RET}. +Finally, it's possible to break the repetition chain automatically +after some amount of idle time: customize the user option +@code{repeat-exit-timeout} to specify the idle time in seconds after +which this transient repetition mode will be turned off automatically. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 98f67ddd9d9..f82b605598e 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -961,9 +961,7 @@ the fringe of a source buffer to set a breakpoint there. @vindex gud-gdb-command-name To run GDB using just the GUD interaction buffer interface, without these additional features, use @kbd{M-x gud-gdb} (@pxref{Starting -GUD}). You must use this if you want to debug multiple programs -within one Emacs session, as that is currently unsupported by @kbd{M-x -gdb}. +GUD}). Internally, @kbd{M-x gdb} informs GDB that its screen size is unlimited; for correct operation, you must not change GDB's screen @@ -1051,9 +1049,9 @@ to restore only when @code{gdb-show-main} is non-@code{nil}. You may also specify additional GDB-related buffers to display, either in the same frame or a different one. Select the buffers you want by typing @kbd{M-x gdb-display-@var{buffertype}-buffer} or -@kbd{M-x gdb-frame-@var{buffertype}-buffer}, where @var{buffertype} -is the relevant buffer type, such as @samp{breakpoints}. You can do -the same with the menu bar, with the @samp{GDB-Windows} and +@kbd{M-x gdb-frame-@var{buffertype}-buffer}, where @var{buffertype} is +the relevant buffer type, such as @samp{breakpoints} or @samp{io}. +You can do the same from the menu bar, with the @samp{GDB-Windows} and @samp{GDB-Frames} sub-menus of the @samp{GUD} menu. @vindex gdb-max-source-window-count @@ -1273,10 +1271,14 @@ non-@code{nil} value. @node Other GDB Buffers @subsubsection Other GDB Buffers +Other buffers provided by @kbd{M-x gdb} whose display you can +optionally request include: + @table @asis +@findex gdb-display-locals-buffer @item Locals Buffer This buffer displays the values of local variables of the current -frame for simple data types (@pxref{Frame Info, Frame Info, +stack frame for simple data types (@pxref{Frame Info, Frame Info, Information on a frame, gdb, The GNU debugger}). Press @key{RET} or click @kbd{mouse-2} on the value if you want to edit it. @@ -1286,20 +1288,35 @@ you can examine the value of the local variable at point by typing GDB, use @key{RET} or @kbd{mouse-2} on the type description (@samp{[struct/union]} or @samp{[array]}). @xref{Watch Expressions}. +To display the Locals buffer, type @kbd{M-x gdb-display-locals-buffer}. + +@findex gdb-display-io-buffer +@item I/O Buffer +If the program you are debugging uses standard input and output +streams for interaction with the user, or emits a significant amount +of output to its standard output, you may wish to separate its I/O +from interaction with GDB. Use the command @w{@kbd{M-x +gdb-display-io-buffer}} to show a window with a buffer to which Emacs +redirects the input and output from the program you are debugging. + +@findex gdb-display-registers-buffer @item Registers Buffer -@findex toggle-gdb-all-registers This buffer displays the values held by the registers -(@pxref{Registers,,, gdb, The GNU debugger}). Press @key{RET} or -click @kbd{mouse-2} on a register if you want to edit its value. With -GDB 6.4 or later, recently changed register values display with -@code{font-lock-warning-face}. +(@pxref{Registers,,, gdb, The GNU debugger}). Request the display of +this buffer with the command @kbd{M-x gdb-display-registers-buffer}. +Press @key{RET} or click @kbd{mouse-2} on a register if you want to +edit its value. With GDB 6.4 or later, recently changed register +values display with @code{font-lock-warning-face}. +@findex gdb-display-disassembly-buffer @item Assembler Buffer The assembler buffer displays the current frame as machine code. An arrow points to the current instruction, and you can set and remove breakpoints as in a source buffer. Breakpoint icons also appear in -the fringe or margin. +the fringe or margin. To request the display of this buffer, use +@kbd{M-x gdb-display-disassembly-buffer}. +@findex gdb-display-memory-buffer @item Memory Buffer The memory buffer lets you examine sections of program memory (@pxref{Memory, Memory, Examining memory, gdb, The GNU debugger}). @@ -1307,7 +1324,8 @@ Click @kbd{mouse-1} on the appropriate part of the header line to change the starting address or number of data items that the buffer displays. Alternatively, use @kbd{S} or @kbd{N} respectively. Click @kbd{mouse-3} on the header line to select the display format or unit -size for these data items. +size for these data items. Use @w{@kbd{M-x +gdb-display-memory-buffer}} to request display of this buffer. @end table When @code{gdb-many-windows} is non-@code{nil}, the locals buffer @@ -1538,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 @@ -1586,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 f77ab569483..7ec843180b8 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1024,17 +1024,65 @@ customize-group @key{RET} font-lock-faces @key{RET}}. You can then use that customization buffer to customize the appearance of these faces. @xref{Face Customization}. +@cindex just-in-time (JIT) font-lock +@cindex background syntax highlighting + Fontifying very large buffers can take a long time. To avoid large +delays when a file is visited, Emacs initially fontifies only the +visible portion of a buffer. As you scroll through the buffer, each +portion that becomes visible is fontified as soon as it is displayed; +this type of Font Lock is called @dfn{Just-In-Time} (or @dfn{JIT}) +Lock. You can control how JIT Lock behaves, including telling it to +perform fontification while idle, by customizing variables in the +customization group @samp{jit-lock}. @xref{Specific Customization}. + + The information that major modes use for determining which parts of +buffer text to fontify and what faces to use can be based on several +different ways of analyzing the text: + +@itemize @bullet +@item +Search for keywords and other textual patterns based on regular +expressions (@pxref{Regexp Search,, Regular Expression Search}). + +@item +Find syntactically distinct parts of text based on built-in syntax +tables (@pxref{Syntax Tables,,, elisp, The Emacs Lisp Reference +Manual}). + +@item +Use syntax tree produced by a full-blown parser, via a special-purpose +library, such as the tree-sitter library (@pxref{Parsing Program +Source,,, elisp, The Emacs Lisp Reference Manual}), or an external +program. +@end itemize + +@menu +* Traditional Font Lock:: Font Lock based on regexps and syntax tables. +* Parser-based Font Lock:: Font Lock based on external parser. +@end menu + +@node Traditional Font Lock +@subsection Traditional Font Lock +@cindex traditional font-lock + + ``Traditional'' methods of providing font-lock information are based +on regular-expression search and on syntactic analysis using syntax +tables built into Emacs. This subsection describes the use and +customization of font-lock for major modes which use these traditional +methods. + @vindex font-lock-maximum-decoration - You can customize the variable @code{font-lock-maximum-decoration} -to alter the amount of fontification applied by Font Lock mode, for -major modes that support this feature. The value should be a number -(with 1 representing a minimal amount of fontification; some modes -support levels as high as 3); or @code{t}, meaning ``as high as -possible'' (the default). To be effective for a given file buffer, -the customization of @code{font-lock-maximum-decoration} should be -done @emph{before} the file is visited; if you already have the file -visited in a buffer when you customize this variable, kill the buffer -and visit the file again after the customization. + You can control the amount of fontification applied by Font Lock +mode by customizing the variable @code{font-lock-maximum-decoration}, +for major modes that support this feature. The value of this variable +should be a number (with 1 representing a minimal amount of +fontification; some modes support levels as high as 3); or @code{t}, +meaning ``as high as possible'' (the default). To be effective for a +given file buffer, the customization of +@code{font-lock-maximum-decoration} should be done @emph{before} the +file is visited; if you already have the file visited in a buffer when +you customize this variable, kill the buffer and visit the file again +after the customization. You can also specify different numbers for particular major modes; for example, to use level 1 for C/C++ modes, and the default level @@ -1082,16 +1130,59 @@ keywords by customizing the @code{font-lock-ignore} option, @pxref{Customizing Keywords,,, elisp, The Emacs Lisp Reference Manual}. -@cindex just-in-time (JIT) font-lock -@cindex background syntax highlighting - Fontifying large buffers can take a long time. To avoid large -delays when a file is visited, Emacs initially fontifies only the -visible portion of a buffer. As you scroll through the buffer, each -portion that becomes visible is fontified as soon as it is displayed; -this type of Font Lock is called @dfn{Just-In-Time} (or @dfn{JIT}) -Lock. You can control how JIT Lock behaves, including telling it to -perform fontification while idle, by customizing variables in the -customization group @samp{jit-lock}. @xref{Specific Customization}. +@node Parser-based Font Lock +@subsection Parser-based Font Lock +@cindex font-lock via tree-sitter +@cindex parser-based font-lock + If your Emacs was built with the tree-sitter library, it can use the +results of parsing the buffer text by that library for the purposes of +fontification. This is usually faster and more accurate than the +``traditional'' methods described in the previous subsection, since +the tree-sitter library provides full-blown parsers for programming +languages and other kinds of formatted text which it supports. Major +modes which utilize the tree-sitter library are named +@code{@var{foo}-ts-mode}, with the @samp{-ts-} part indicating the use +of the library. This subsection documents the Font Lock support based +on the tree-sitter library. + +@vindex treesit-font-lock-level + You can control the amount of fontification applied by Font Lock +mode of major modes based on tree-sitter by customizing the variable +@code{treesit-font-lock-level}. Its value is a number between 1 and +4: + +@table @asis +@item Level 1 +This level usually fontifies only comments and function names in +function definitions. +@item Level 2 +This level adds fontification of keywords, strings, and data types. +@item Level 3 +This is the default level; it adds fontification of assignments, +numbers, etc. +@item Level 4 +This level adds everything else that can be fontified: operators, +delimiters, brackets, other punctuation, function names in function +calls, property look ups, variables, etc. +@end table + +@vindex treesit-font-lock-feature-list +@noindent +What exactly constitutes each of the syntactical categories mentioned +above depends on the major mode and the parser grammar used by +tree-sitter for the major-mode's language. However, in general the +categories follow the conventions of the programming language or the +file format supported by the major mode. The buffer-local value of +the variable @code{treesit-font-lock-feature-list} holds the +fontification features supported by a tree-sitter based major mode, +where each sub-list shows the features provided by the corresponding +fontification level. + + Once you change the value of @code{treesit-font-lock-level} via +@w{@kbd{M-x customize-variable}} (@pxref{Specific Customization}), it +takes effect immediately in all the existing buffers and for files you +visit in the future in the same session. + @node Highlight Interactively @section Interactive Highlighting @@ -1311,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/emacs.texi b/doc/emacs/emacs.texi index b6d149eb3ef..7071ea44edd 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -383,6 +383,10 @@ Controlling the Display * Visual Line Mode:: Word wrap and screen line-based editing. * Display Custom:: Information on variables for customizing display. +Font Lock +* Traditional Font Lock:: Font Lock based on regexps and syntax tables. +* Parser-based Font Lock:: Font Lock based on external parser. + Searching and Replacement * Incremental Search:: Search happens as you type the string. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 6d666831612..a9ae4696a06 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -215,6 +215,17 @@ by the integers that Emacs can represent (@pxref{Buffers}). If you try, Emacs displays an error message saying that the maximum buffer size has been exceeded. +@vindex treesit-max-buffer-size + If you try to visit a file whose major mode (@pxref{Major Modes}) +uses the tree-sitter parsing library, Emacs will display a warning if +the file's size in bytes is larger than the value of the variable +@code{treesit-max-buffer-size}. The default value is 40 megabytes for +64-bit Emacs and 15 megabytes for 32-bit Emacs. This avoids the +danger of having Emacs run out of memory by preventing the activation +of major modes based on tree-sitter in such large buffers, because a +typical tree-sitter parser needs about 10 times as much memory as the +text it parses. + @cindex wildcard characters in file names @vindex find-file-wildcards If the file name you specify contains shell-style wildcard @@ -801,22 +812,21 @@ in these cases, customize the variable @vindex write-region-inhibit-fsync Normally, when a program writes a file, the operating system briefly caches the file's data in main memory before committing the data to -disk. This can greatly improve performance; for example, when running -on laptops, it can avoid a disk spin-up each time a file is written. -However, it risks data loss if the operating system crashes before -committing the cache to disk. +secondary storage. Although this can greatly improve performance, it +risks data loss if the system loses power before committing the cache, +and on some platforms other processes might not immediately notice the +file's change. To lessen this risk, Emacs can invoke the @code{fsync} system call after saving a file. Using @code{fsync} does not eliminate the risk -of data loss, partly because many systems do not implement +of data loss or slow notification, partly because many systems do not support @code{fsync} properly, and partly because Emacs's file-saving procedure typically relies also on directory updates that might not survive a crash even if @code{fsync} works properly. The @code{write-region-inhibit-fsync} variable controls whether Emacs invokes @code{fsync} after saving a file. The variable's -default value is @code{nil} when Emacs is interactive, and @code{t} -when Emacs runs in batch mode (@pxref{Initial Options, Batch Mode}). +default value is @code{t}. Emacs never uses @code{fsync} when writing auto-save files, as these files might lose data anyway. @@ -1727,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 @@ -1889,6 +1903,11 @@ following in the Trash directory: liable to also delete this @code{.dir-locals.el} file, so this should only be done if you delete files from the Trash directory manually. +@vindex remote-file-name-inhibit-delete-by-moving-to-trash + If the variable @code{remote-file-name-inhibit-delete-by-moving-to-trash} +is non-@code{nil}, remote files are never moved to the Trash. They +are deleted instead. + @ifnottex If a file is under version control (@pxref{Version Control}), you should delete it using @kbd{M-x vc-delete-file} instead of @kbd{M-x diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 3ee6eb59dbb..ce631561be7 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -334,6 +334,7 @@ In this way, you can use the mouse to move point over a button without activating it. Dragging the mouse over or onto a button has its usual behavior of setting the region, and does not activate the button. +@vindex mouse-1-click-follows-link You can change how @kbd{mouse-1} applies to buttons by customizing the variable @code{mouse-1-click-follows-link}. If the value is a positive integer, that determines how long you need to hold the mouse diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 2513e6be271..945e12a05d2 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -317,6 +317,16 @@ by using the @kbd{M-x shortdoc} command. This will prompt you for an area of interest, e.g., @code{string}, and pop you to a buffer where many of the functions relevant for handling strings are listed. +You can also request that documentation of functions and commands +shown in @file{*Help*} buffers popped by @kbd{C-h f} includes examples +of their use. To that end, add the following to your initialization +file (@pxref{Init File}): + +@example +(add-hook 'help-fns-describe-function-functions + #'shortdoc-help-fns-examples-function) +@end example + @kindex C-h v @findex describe-variable @kbd{C-h v} (@code{describe-variable}) is like @kbd{C-h f} but diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi index 6b9ae196704..9f2c4721cab 100644 --- a/doc/emacs/macos.texi +++ b/doc/emacs/macos.texi @@ -201,13 +201,6 @@ Setting a lower number makes the trackpad more sensitive, and a higher number makes the trackpad less sensitive. @end table -@subsection Font Panel - -@findex ns-popup-font-panel -The standard Mac / GNUstep font panel is accessible with @kbd{M-x -ns-popup-font-panel} and will set the default font in the frame most -recently used or clicked on. - @c To make the setting permanent, use @samp{Save Options} in the @c Options menu, or run @code{menu-bar-options-save}. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 5191bb2918d..7d49e28d11f 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. @@ -2250,16 +2283,25 @@ buffer, but doesn't select any of them. @kindex M-, @findex xref-go-back - To go back to places @emph{from where} you've displayed the definition, -use @kbd{M-,} (@code{xref-go-back}). It jumps back to the + To go back to places @emph{from where} you've displayed the +definition, use @kbd{M-,} (@code{xref-go-back}). It jumps back to the point of the last invocation of @kbd{M-.}. Thus you can find and examine the definition of something with @kbd{M-.} and then return to -where you were with @kbd{M-,}. +where you were with @kbd{M-,}. @kbd{M-,} allows you to retrace the +steps you made forward in the history of places, all the way to the +first place in history, where you first invoked @kbd{M-.}, or to any +place in-between. @kindex C-M-, @findex xref-go-forward - If you previously went back too far with @kbd{M-,}, @kbd{C-M-,} -(@code{xref-go-forward}) can be used to go forward again. + If you previously went back too far with @kbd{M-,}, or want to +re-examine a place from which you went back, you can use @kbd{C-M-,} +(@code{xref-go-forward}) to go forward again. This is similar to +using @kbd{M-.}, except that you don't need on each step to move point +to the identifier whose definition you want to look up. @kbd{C-M-,} +allows you to retrace all the steps you made back in the history of +places, all the way to the last place in history, where you invoked +@kbd{M-,}, or to any place in-between. @findex xref-etags-mode Some major modes install @code{xref} support facilities that might diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 6fb312ec321..898d9e904f6 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -953,12 +953,14 @@ File ‘foo.el’ exists; overwrite? (y or n) @end smallexample @cindex yes or no prompt +@vindex yes-or-no-prompt The second type of yes-or-no query is typically employed if giving the wrong answer would have serious consequences; it thus features a -longer prompt ending with @samp{(yes or no)}. For example, if you -invoke @kbd{C-x k} (@code{kill-buffer}) on a file-visiting buffer with -unsaved changes, Emacs activates the minibuffer with a prompt like -this: +longer prompt ending with @samp{(yes or no)} (or the value of +@code{yes-or-no-prompt} if you've customized that). For example, if +you invoke @kbd{C-x k} (@code{kill-buffer}) on a file-visiting buffer +with unsaved changes, Emacs activates the minibuffer with a prompt +like this: @smallexample Buffer foo.el modified; kill anyway? (yes or no) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index e2764c34482..37da6b5956d 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -470,11 +470,7 @@ documents. It provides features such as slicing, zooming, and searching inside documents. It works by converting the document to a set of images using the @command{gs} (GhostScript) or @command{pdfdraw}/@command{mutool draw} (MuPDF) commands and other -external tools @footnote{PostScript files require GhostScript, DVI -files require @code{dvipdf} or @code{dvipdfm}, OpenDocument and -Microsoft Office documents require the @code{unoconv} tool, and EPUB, -CBZ, FB2, XPS and OXPS files require @code{mutool} to be available.}, -and displaying those images. +external tools, and then displays those converted images. @findex doc-view-toggle-display @findex doc-view-minor-mode @@ -751,6 +747,8 @@ Command Output*"} (@code{shell-command-buffer-name}) buffer (if the output is long). The variables @code{resize-mini-windows} and @code{max-mini-window-height} (@pxref{Minibuffer Edit}) control when Emacs should consider the output to be too long for the echo area. +Note that customizing @code{shell-command-dont-erase-buffer}, +described below, can affect what is displayed in the echo area. For instance, one way to decompress a file named @file{foo.gz} is to type @kbd{M-! gunzip foo.gz @key{RET}}. That shell command normally @@ -867,6 +865,10 @@ Restores the position of point as it was before inserting the shell-command output. @end table +Note that if this option is non-@code{nil}, the output shown in the +echo area could be from more than just the last command, since the +echo area just displays a portion of the output buffer. + In case the output buffer is not the current buffer, shell command output is appended at the end of this buffer. @@ -1808,31 +1810,28 @@ you can give each daemon its own server name like this: emacs --daemon=foo @end example -@findex server-stop-automatically +@vindex server-stop-automatically The Emacs server can optionally be stopped automatically when -certain conditions are met. To do this, call the function -@code{server-stop-automatically} in your init file (@pxref{Init -File}), with one of the following arguments: - -@itemize -@item -With the argument @code{empty}, the server is stopped when it has no -clients, no unsaved file-visiting buffers and no running processes -anymore. - -@item -With the argument @code{delete-frame}, when the last client frame is -being closed, you are asked whether each unsaved file-visiting buffer -must be saved and each unfinished process can be stopped, and if so, -the server is stopped. +certain conditions are met. To do this, set the option +@code{server-stop-automatically} to one of the following values: -@item -With the argument @code{kill-terminal}, when the last client frame is -being closed with @kbd{C-x C-c} (@code{save-buffers-kill-terminal}), -you are asked whether each unsaved file-visiting buffer must be saved -and each unfinished process can be stopped, and if so, the server is +@table @code +@item empty +This value causes the server to be stopped when it has no clients, no +unsaved file-visiting buffers and no running processes anymore. + +@item delete-frame +This value means that when the last client frame is being closed, you +are asked whether each unsaved file-visiting buffer must be saved and +each unfinished process can be stopped, and if so, the server is stopped. -@end itemize + +@item kill-terminal +This value means that when the last client frame is being closed with +@kbd{C-x C-c} (@code{save-buffers-kill-terminal}), you are asked +whether each unsaved file-visiting buffer must be saved and each +unfinished process can be stopped, and if so, the server is stopped. +@end table @findex server-eval-at If you have defined a server by a unique server name, it is possible @@ -2746,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/package.texi b/doc/emacs/package.texi index d993b7b071f..7a2bc11d03c 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -558,29 +558,6 @@ regular package listing. If you just wish to clone the source of a package, without adding it to the package list, use @code{package-vc-checkout}. -@vindex package-vc-selected-packages -@findex package-vc-install-selected-packages - An alternative way to use @code{package-vc-install} is via the -@code{package-vc-selected-packages} user option. This is an alist of -packages to install, where each key is a package name and the value is -@code{nil}, indicating that any revision is to install, a string, -indicating a specific revision or a package specification plist. The -side effect of setting the user option is to install the package, but -the process can also be manually triggered using the function -@code{package-vc-install-selected-packages}. Here is an example of -how the user option: - -@example -@group -(setopt package-vc-selected-packages - '((modus-themes . "0f39eb3fd9") ;specific revision - (auctex . nil) ;any revision - (foo ;a package specification - :url "https://git.sv.gnu.org/r/foo-mode.git" - :branch "trunk"))) -@end group -@end example - @findex package-report-bug @findex package-vc-prepare-patch With the source checkout, you might want to reproduce a bug against diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 4aac150934b..62df88a731e 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -163,6 +163,7 @@ Emacs we use it for all languages. * Left Margin Paren:: An open-paren or similar opening delimiter starts a defun if it is at the left margin. * Moving by Defuns:: Commands to move over or mark a major definition. +* Moving by Sentences:: Commands to move over certain code units. * Imenu:: Making buffer indexes as menus. * Which Function:: Which Function mode shows which function you are in. @end menu @@ -254,6 +255,77 @@ they do their standard jobs in a way better fitting a particular language. Other major modes may replace any or all of these key bindings for that purpose. +@cindex nested defuns +@vindex treesit-defun-tactic + Some programming languages supported @dfn{nested defuns}, whereby a +defun (such as a function or a method or a class) can be defined +inside (i.e., as part of the body) of another defun. The commands +described above by default find the beginning and the end of the +@emph{innermost} defun around point. Major modes based on the +tree-sitter library provide control of this behavior: if the variable +@code{treesit-defun-tactic} is set to the value @code{top-level}, the +defun commands will find the @emph{outermost} defuns instead. + +@node Moving by Sentences +@subsection Moving by Sentences +@cindex sentences, in programming languages + + These commands move point or set up the region based on units of +code, also called @dfn{sentences}. Even though sentences are usually +considered when writing human languages, Emacs can use the same +commands to move over certain constructs in programming languages +(@pxref{Sentences}, @pxref{Moving by Defuns}). In a programming +language a sentence is usually a complete language construct smaller +than defuns, but larger than sexps (@pxref{List Motion,,, elisp, The +Emacs Lisp Reference Manual}). What exactly is a sentence in this +case depends on the programming language, but usually it is a complete +statement, such as a variable definition and initialization, or a +conditional statement. An example of a sentence in the C language +could be + +@example +int x = 5; +@end example + +@noindent +or in the JavaScript language it could look like + +@example +@group +const thing = () => console.log("Hi"); +@end group +@group +const foo = [1] == '1' + ? "No way" + : "..."; +@end group + +@end example + +@table @kbd +@item M-a +Move to beginning of current or preceding sentence +(@code{backward-sentence}). +@item M-e +Move to end of current or following sentence (@code{forward-sentence}). +@end table + +@cindex move to beginning or end of sentence +@cindex sentence, move to beginning or end +@kindex M-a @r{(programming modes)} +@kindex M-e @r{(programming modes)} +@findex backward-sentence @r{(programming modes)} +@findex forward-sentence @r{(programming modes)} + The commands to move to the beginning and end of the current +sentence are @kbd{M-a} (@code{backward-sentence}) and @kbd{M-e} +(@code{forward-sentence}). If you repeat one of these commands, or +use a positive numeric argument, each repetition moves to the next +sentence in the direction of motion. + + @kbd{M-a} with a negative argument @minus{}@var{n} moves forward +@var{n} times to the next end of a sentence. Likewise, @kbd{M-e} with +a negative argument moves back to the start of a sentence. + @node Imenu @subsection Imenu @cindex index of buffer definitions @@ -420,6 +492,9 @@ large chunks of code: @table @kbd @item C-M-q Reindent all the lines within one parenthetical grouping. +@item M-q +Fill a single paragraph in a defun, or reindent all the lines within +that defun. @item C-u @key{TAB} Shift an entire parenthetical grouping rigidly sideways so that its first line is properly indented. @@ -440,6 +515,21 @@ indentation of the line where the grouping starts). The function that etc. To correct the overall indentation as well, type @kbd{@key{TAB}} first. +@kindex M-q +@findex prog-fill-reindent-defun +@vindex beginning-of-defun-function +@vindex end-of-defun-function +@vindex fill-paragraph-function + To reindent the entire defun around point, type @kbd{M-q} +(@code{prog-fill-reindent-defun}). If point is in a comment or a +string, this command fills and indents the comment or string instead. +What exactly constitutes a comment, a string, or a defun depends on +the major mode: the bounds of a defun are decided by the variables +@code{beginning-of-defun-function} and @code{end-of-defun-function} +(@pxref{List Motion,,, elisp, The Emacs Lisp Reference Manual}), +and the filling mechanism is decided by @code{fill-paragraph-function} +(@pxref{Filling,,, elisp, The Emacs Lisp Reference Manual}). + @kindex C-u TAB If you like the relative indentation within a grouping but not the indentation of its first line, move point to that first line and type @@ -520,20 +610,27 @@ then indent it like this: @item C-c C-q @kindex C-c C-q @r{(C mode)} @findex c-indent-defun +@findex c-ts-mode-indent-defun Reindent the current top-level function definition or aggregate type -declaration (@code{c-indent-defun}). +declaration (@code{c-indent-defun} in CC mode, +@code{c-ts-mode-indent-defun} in @code{c-ts-mode} based on tree-sitter). @item C-M-q @kindex C-M-q @r{(C mode)} @findex c-indent-exp -Reindent each line in the balanced expression that follows point -(@code{c-indent-exp}). A prefix argument inhibits warning messages -about invalid syntax. +@findex prog-indent-sexp +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 @@ -568,7 +665,8 @@ onto the indentation of the @dfn{anchor statement}. @table @kbd @item C-c . @var{style} @key{RET} -Select a predefined style @var{style} (@code{c-set-style}). +Select a predefined style @var{style} (@code{c-set-style} in CC mode, +@code{c-ts-mode-set-style} in @code{c-ts-mode} based on tree-sitter). @end table A @dfn{style} is a named collection of customizations that can be @@ -584,6 +682,7 @@ typing @kbd{C-M-q} at the start of a function definition. @kindex C-c . @r{(C mode)} @findex c-set-style +@findex c-ts-mode-set-style To choose a style for the current buffer, use the command @w{@kbd{C-c .}}. Specify a style name as an argument (case is not significant). This command affects the current buffer only, and it affects only @@ -592,11 +691,11 @@ the code already in the buffer. To reindent the whole buffer in the new style, you can type @kbd{C-x h C-M-\}. @vindex c-default-style - You can also set the variable @code{c-default-style} to specify the -default style for various major modes. Its value should be either the -style's name (a string) or an alist, in which each element specifies -one major mode and which indentation style to use for it. For -example, + When using CC mode, you can also set the variable +@code{c-default-style} to specify the default style for various major +modes. Its value should be either the style's name (a string) or an +alist, in which each element specifies one major mode and which +indentation style to use for it. For example, @example (setq c-default-style @@ -613,6 +712,11 @@ one of the C-like major modes; thus, if you specify a new default style for Java mode, you can make it take effect in an existing Java mode buffer by typing @kbd{M-x java-mode} there. +@vindex c-ts-mode-indent-style + When using the tree-sitter based @code{c-ts-mode}, you can set the +default indentation style by customizing the variable +@code{c-ts-mode-indent-style}. + The @code{gnu} style specifies the formatting recommended by the GNU Project for C; it is the default, so as to encourage use of our recommended style. @@ -1283,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 8fbf731a4f7..3d3f2562617 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -253,6 +253,10 @@ value of @code{sentence-end-double-space}. of a sentence. Set the variable @code{sentence-end-without-period} to @code{t} in such cases. + Even though the above mentioned sentence movement commands are based +on human languages, other Emacs modes can set these command to get +similar functionality (@pxref{Moving by Sentences}). + @node Paragraphs @section Paragraphs @cindex paragraphs @@ -619,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 @@ -958,8 +967,6 @@ hooks. @cindex invisible lines @findex outline-mode -@findex outline-minor-mode -@vindex outline-minor-mode-prefix @vindex outline-mode-hook Outline mode is a major mode derived from Text mode, which is specialized for editing outlines. It provides commands to navigate @@ -982,6 +989,19 @@ previous visible line. Killing the ellipsis at the end of a visible line really kills all the following invisible text associated with the ellipsis. +@menu +* Outline Minor Mode:: Outline mode to use with other major modes. +* Outline Format:: What the text of an outline looks like. +* Outline Motion:: Special commands for moving through outlines. +* Outline Visibility:: Commands to control what is visible. +* Outline Views:: Outlines and multiple views. +* Foldout:: Folding means zooming in on outlines. +@end menu + +@node Outline Minor Mode +@subsection Outline Minor Mode + +@findex outline-minor-mode Outline minor mode is a buffer-local minor mode which provides the same commands as the major mode, Outline mode, but can be used in conjunction with other major modes. You can type @kbd{M-x @@ -990,6 +1010,7 @@ buffer, or use a file-local variable setting to enable it in a specific file (@pxref{File Variables}). @kindex C-c @@ @r{(Outline minor mode)} +@vindex outline-minor-mode-prefix The major mode, Outline mode, provides special key bindings on the @kbd{C-c} prefix. Outline minor mode provides similar bindings with @kbd{C-c @@} as the prefix; this is to reduce the conflicts with the @@ -1005,22 +1026,16 @@ this variable is @code{insert}, the buttons are inserted directly into the buffer text, so @key{RET} on the button will also toggle display of the section, like a mouse click does. If the value is @code{in-margins}, Outline minor mode will use the window margins to -indicate that a section is hidden. +indicate that a section is hidden. The buttons are customizable as icons +(@pxref{Icons}). @vindex outline-minor-mode-cycle If the @code{outline-minor-mode-cycle} user option is -non-@code{nil}, the @kbd{TAB} and @kbd{S-@key{TAB}} keys are enabled on the -outline heading lines. @kbd{TAB} cycles hiding, showing the -sub-heading, and showing all for the current section. @kbd{S-@key{TAB}} -does the same for the entire buffer. - -@menu -* Outline Format:: What the text of an outline looks like. -* Outline Motion:: Special commands for moving through outlines. -* Outline Visibility:: Commands to control what is visible. -* Outline Views:: Outlines and multiple views. -* Foldout:: Folding means zooming in on outlines. -@end menu +non-@code{nil}, the @kbd{TAB} and @kbd{S-@key{TAB}} keys that cycle +the visibility are enabled on the outline heading lines +(@pxref{Outline Visibility, outline-cycle}). @kbd{TAB} cycles hiding, +showing the sub-heading, and showing all for the current section. +@kbd{S-@key{TAB}} does the same for the entire buffer. @node Outline Format @subsection Format of Outlines 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..550d711c73a 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2345,10 +2345,11 @@ newline. The property value can be one of several forms: @item t If the property value is @code{t}, the newline character has no effect on the displayed height of the line---the visible contents -alone determine the height. The @code{line-spacing} property, -described below, is also ignored in this case. This is useful for -tiling small images (or image slices) without adding blank areas -between the images. +alone determine the height. The @code{line-spacing} property of the +newline, described below, is also ignored in this case. This is +useful for tiling small images (or image slices) without adding blank +areas between the images. + @item (@var{height} @var{total}) If the property value is a list of the form shown, that adds extra space @emph{below} the display line. First Emacs uses @var{height} as @@ -2409,7 +2410,9 @@ overrides line spacings specified for the frame. property that can enlarge the default frame line spacing and the buffer local @code{line-spacing} variable: if its value is larger than the buffer or frame defaults, that larger value is used instead, for -the display line ending in that newline. +the display line ending in that newline (unless the newline also has +the @code{line-height} property whose value is one of the special +values which cause @code{line-spacing} to be ignored, see above). One way or another, these mechanisms specify a Lisp value for the spacing of each line. The value is a height spec, and it translates @@ -3501,11 +3504,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 +5288,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 +5305,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 +5321,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 707af6ee64c..b15f2ab4d29 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -692,11 +692,9 @@ files that the user does not need to know about. @defvar write-region-inhibit-fsync If this variable's value is @code{nil}, @code{write-region} uses the -@code{fsync} system call after writing a file. Although this slows -Emacs down, it lessens the risk of data loss after power failure. If -the value is @code{t}, Emacs does not use @code{fsync}. The default -value is @code{nil} when Emacs is interactive, and @code{t} when Emacs -runs in batch mode. @xref{Files and Storage}. +@code{fsync} system call after writing a file. If the value is +@code{t}, Emacs does not use @code{fsync}. The default value is +@code{t}. @xref{Files and Storage}. @end defvar @defmac with-temp-file file body@dots{} @@ -895,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 @@ -1873,6 +1877,11 @@ no prefix argument is given, and @code{nil} otherwise. See also @code{delete-directory} in @ref{Create/Delete Dirs}. @end deffn +@defopt remote-file-name-inhibit-delete-by-moving-to-trash +If this variable is non-@code{nil}, remote files are never moved to +the Trash. They are deleted instead. +@end defopt + @cindex file permissions, setting @cindex permissions, file @cindex file modes, setting @@ -1979,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 @@ -2038,17 +2051,28 @@ data already stored elsewhere on secondary storage until one file or the other is later modified; this will lose both files if the only copy on secondary storage is lost due to media failure. Second, the operating system might not write data to secondary storage -immediately, which will lose the data if power is lost. +immediately, which will lose the data if power is lost +or if there is a media failure. @findex write-region Although both sorts of failures can largely be avoided by a suitably -configured file system, such systems are typically more expensive or -less efficient. In more-typical systems, to survive media failure you +configured system, such systems are typically more expensive or +less efficient. In lower-end systems, to survive media failure you can copy the file to a different device, and to survive a power -failure you can use the @code{write-region} function with the +failure (or be immediately notified of a media failure) you can use +the @code{write-region} function with the @code{write-region-inhibit-fsync} variable set to @code{nil}. +Although this variable is ordinarily @code{t} because that can +significantly improve performance, it may make sense to temporarily +bind it to @code{nil} if using Emacs to implement database-like +transactions that survive power failure on lower-end systems. @xref{Writing to Files}. +On some platforms when Emacs changes a file other processes might not +be notified of the change immediately. Setting +@code{write-region-inhibit-fsync} to @code{nil} may improve +notification speed in this case, though there are no guarantees. + @node File Names @section File Names @cindex file names @@ -2338,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 @@ -2527,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 @@ -3376,7 +3405,8 @@ first, before handlers for jobs such as remote file access. @code{file-readable-p}, @code{file-regular-p}, @code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-system-info}, -@code{file-truename}, @code{file-writable-p}, +@code{file-truename}, @code{file-user-uid}, +@code{file-writable-p}, @code{find-backup-file-name},@* @code{get-file-buffer}, @code{insert-directory}, @@ -3437,7 +3467,8 @@ first, before handlers for jobs such as remote file access. @code{file-readable-p}, @code{file-regular-p}, @code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-system-info}, -@code{file-truename}, @code{file-writable-p}, +@code{file-truename}, @code{file-user-uid}, +@code{file-writable-p}, @code{find-backup-file-name}, @code{get-file-buffer}, @code{insert-directory}, 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/help.texi b/doc/lispref/help.texi index 59b6b6dab1d..d5e4e1c31d3 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -989,3 +989,29 @@ in the function group to insert the function into. If @var{group} doesn't exist, it will be created. If @var{section} doesn't exist, it will be added to the end of the function group. @end defun + +You can also query the examples of use of functions defined in +shortdoc groups. + +@defun shortdoc-function-examples function +This function returns all shortdoc examples for @var{function}. The +return value is an alist with items of the form +@w{@code{(@var{group} . @var{examples})}}, where @var{group} is a +documentation group where @var{function} appears, and @var{examples} +is a string with the examples of @var{function}s use as defined in +@var{group}. + +@code{shortdoc-function-examples} returns @code{nil} if @var{function} +is not a function or if it doesn't have any shortdoc examples. +@end defun + +@vindex help-fns-describe-function-functions +@defun shortdoc-help-fns-examples-function function +This function queries the registered shortdoc groups and inserts +examples of use of a given Emacs Lisp @var{function} into the current +buffer. It is suitable for addition to the +@code{help-fns-describe-function-functions} hook, in which case +examples from shortdoc of using a function will be displayed in the +@file{*Help*} buffer when the documentation of the function is +requested. +@end defun diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index e1a4613875c..9928361f7b2 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -558,12 +558,15 @@ The initial threshold value is @code{GC_DEFAULT_THRESHOLD}, defined in value is 400,000 for the default 32-bit configuration and 800,000 for the 64-bit one. If you specify a larger value, garbage collection will happen less often. This reduces the amount of time spent garbage -collecting, but increases total memory use. You may want to do this -when running a program that creates lots of Lisp data. However, we +collecting (so Lisp programs will run faster between cycles of garbage +collection that happen more rarely), but increases total memory use. +You may want to do this when running a program that creates lots of +Lisp data, especially if you need it to run faster. However, we recommend against increasing the threshold for prolonged periods of time, and advise that you never set it higher than needed for the program to run in reasonable time. Using thresholds higher than -necessary could potentially cause system-wide memory pressure, and +necessary could potentially cause higher system-wide memory pressure, +and also make each garbage-collection cycle take much more time, and should therefore be avoided. You can make collections more frequent by specifying a smaller value, down @@ -732,14 +735,15 @@ Emacs session. @section C Dialect @cindex C programming language -The C part of Emacs is portable to C99 or later: C11-specific features such -as @samp{<stdalign.h>} and @samp{_Noreturn} are not used without a check, +The C part of Emacs is portable to C99 or later: later C features such +as @samp{<stdckdint.h>} and @samp{[[noreturn]]} are not used without a check, typically at configuration time, and the Emacs build procedure -provides a substitute implementation if necessary. Some C11 features, +provides a substitute implementation if necessary. Some later features, such as anonymous structures and unions, are too difficult to emulate, so they are avoided entirely. -At some point in the future the base C dialect will no doubt change to C11. +At some point in the future the base C dialect will no doubt change to +something later than C99. @node Writing Emacs Primitives @section Writing Emacs Primitives @@ -894,15 +898,17 @@ Currently, only the following attributes are recognized: @table @code @item noreturn Declares the C function as one that never returns. This corresponds -to the C11 keyword @code{_Noreturn} and to @w{@code{__attribute__ -((__noreturn__))}} attribute of GCC (@pxref{Function Attributes,,, -gcc, Using the GNU Compiler Collection}). +to C23's @code{[[noreturn]]}, to C11's @code{_Noreturn}, and to GCC's +@w{@code{__attribute__ ((__noreturn__))}} (@pxref{Function +Attributes,,, gcc, Using the GNU Compiler Collection}). (Internally, +Emacs's own C code uses @code{_Noreturn} as it can be defined as a +macro on C platforms that do not support it.) @item const Declares that the function does not examine any values except its arguments, and has no effects except the return value. This -corresponds to @w{@code{__attribute__ ((__const__))}} attribute of -GCC. +corresponds to C23's @code{[[unsequenced]]} and to GCC's +@w{@code{__attribute__ ((__const__))}}. @item noinline This corresponds to @w{@code{__attribute__ ((__noinline__))}} @@ -2550,7 +2556,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/keymaps.texi b/doc/lispref/keymaps.texi index 7876780dcd4..c17c8a2dc3f 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1440,6 +1440,18 @@ bindings in a keymap makes no difference for keyboard input, but it does matter for menu keymaps (@pxref{Menu Keymaps}). @end defun +@findex keymap-unset +@defun keymap-unset keymap key &optional remove +This function is the inverse of @code{keymap-set}, it unsets the +binding for @var{key} in @var{keymap}, which is the same as setting +the binding to @code{nil}. In order to instead remove the binding +completely, specify @var{remove} as non-@code{nil}. This only makes a +difference if @var{keymap} has a parent keymap: if you just unset a key +in a child map, it will still shadow the same key in the parent +keymap; using @var{remove} instead will allow the key in the parent keymap +to be used. +@end defun + This example creates a sparse keymap and makes a number of bindings in it: diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 44b7058e19d..a509325854f 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,7 @@ 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 flatten-tree tree @@ -1914,6 +1917,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/minibuf.texi b/doc/lispref/minibuf.texi index 114e5d38a80..4b957a68401 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2233,10 +2233,12 @@ minibuffer. It returns @code{t} if the user enters @samp{yes}, @code{nil} if the user types @samp{no}. The user must type @key{RET} to finalize the response. Upper and lower case are equivalent. -@code{yes-or-no-p} starts by displaying @var{prompt} in the minibuffer, -followed by @w{@samp{(yes or no) }}. The user must type one of the -expected responses; otherwise, the function responds @samp{Please answer -yes or no.}, waits about two seconds and repeats the request. +@vindex yes-or-no-prompt +@code{yes-or-no-p} starts by displaying @var{prompt} in the +minibuffer, followed by the value of @code{yes-or-no-prompt} @w{(default +@samp{(yes or no) })}. The user must type one of the expected +responses; otherwise, the function responds @w{@samp{Please answer yes or +no.}}, waits about two seconds and repeats the request. @code{yes-or-no-p} requires more work from the user than @code{y-or-n-p} and is appropriate for more crucial decisions. 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/objects.texi b/doc/lispref/objects.texi index 99a3c073971..ad079e0d63a 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -466,19 +466,20 @@ You can specify characters by their Unicode values. @code{?\u@var{xxxx}} and @code{?\U@var{xxxxxxxx}} represent code points @var{xxxx} and @var{xxxxxxxx}, respectively, where each @var{x} is a single hexadecimal digit. For example, @code{?\N@{U+E0@}}, -@code{?\u00e0} and @code{?\U000000E0} are all equivalent to @code{?à} -and to @samp{?\N@{LATIN SMALL LETTER A WITH GRAVE@}}. The Unicode -Standard defines code points only up to @samp{U+@var{10ffff}}, so if -you specify a code point higher than that, Emacs signals an error. +@code{?\u00e0} and @code{?\U000000E0} are all equivalent to +@code{?@`a} and to @samp{?\N@{LATIN SMALL LETTER A WITH GRAVE@}}. The +Unicode Standard defines code points only up to @samp{U+@var{10ffff}}, +so if you specify a code point higher than that, Emacs signals an +error. @item You can specify characters by their hexadecimal character codes. A hexadecimal escape sequence consists of a backslash, @samp{x}, and the hexadecimal character code. Thus, @samp{?\x41} is the character @kbd{A}, @samp{?\x1} is the character @kbd{C-a}, and -@code{?\xe0} is the character @kbd{à} (@kbd{a} with grave accent). -You can use any number of hex digits, so you can represent any -character code in this way. +@code{?\xe0} is the character @kbd{@`a} (@kbd{a} with grave accent). +You can use one or more hex digits after @samp{x}, so you can +represent any character code in this way. @item @cindex octal character code @@ -1007,13 +1008,6 @@ It looks like this: @end example @end ifnottex - As a somewhat peculiar side effect of @code{(a b . c)} and -@code{(a . (b . c))} being equivalent, for consistency this means -that if you replace @code{b} here with the empty sequence, then it -follows that @code{(a . c)} and @code{(a . ( . c))} are equivalent, -too. This also means that @code{( . c)} is equivalent to @code{c}, -but this is seldom used. - @node Association List Type @subsubsection Association List Type diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 3be7036f637..bca62a7a8de 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1277,6 +1277,16 @@ This function returns the real @acronym{UID} of the user. This function returns the effective @acronym{UID} of the user. @end defun +@defun file-user-uid +This function returns the connection-local value for the user's +effective @acronym{UID}. If @code{default-directory} is local, this +is equivalent to @code{user-uid}, but for remote files (@pxref{Remote +Files, , , emacs, The GNU Emacs Manual}), it will return the +@acronym{UID} for the user associated with that remote connection; if +the remote connection has no associated user, it will instead return +-1. +@end defun + @cindex GID @defun group-gid This function returns the effective @acronym{GID} of the Emacs process. 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 f3824436246..edc7c86533c 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -858,6 +858,40 @@ top-level defuns, if the value is @code{nested}, navigation functions recognize nested defuns. @end defvar +@defvar treesit-sentence-type-regexp +The value of this variable is a regexp matching the node type of sentence +nodes. (For ``node'' and ``node type'', @pxref{Parsing Program Source}.) +@end defvar + +@findex treesit-forward-sentence +@findex forward-sentence +@findex backward-sentence +If Emacs is compiled with tree-sitter, it can use the tree-sitter +parser information to move across syntax constructs. Since what +exactly is considered a sentence varies between languages, a major +mode should set @code{treesit-sentence-type-regexp} to determine that. +Then the mode can get navigation-by-sentence functionality for free, +by using @code{forward-sentence} and +@code{backward-sentence}(@pxref{Moving by Sentences,,, emacs, The +extensible self-documenting text editor}). + +@defvar treesit-sexp-type-regexp +The value of this variable is a regexp matching the node type of sexp +nodes. (For ``node'' and ``node type'', @pxref{Parsing Program +Source}.) +@end defvar + +@findex treesit-forward-sexp +@findex forward-sexp@r{, and tree-sitter} +@findex backward-sexp@r{, and tree-sitter} +If Emacs is compiled with tree-sitter, it can use the tree-sitter +parser information to move across syntax constructs. Since what +exactly is considered a sexp varies between languages, a major mode +should set @code{treesit-sexp-type-regexp} to determine that. Then +the mode can get navigation-by-sexp functionality for free, by using +@code{forward-sexp} and @code{backward-sexp}(@pxref{Moving by +Sentences,,, emacs, The extensible self-documenting text editor}). + @node Skipping Characters @subsection Skipping Characters @cindex skipping characters @@ -1037,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 @@ -1065,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 @@ -1086,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. @@ -1135,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/symbols.texi b/doc/lispref/symbols.texi index 5b53cbe310a..c6a0408abd1 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -276,9 +276,8 @@ This function returns the string that is @var{symbol}'s name. For example: @end group @end example -@strong{Warning:} Changing the string by substituting characters does -change the name of the symbol, but fails to update the obarray, so don't -do it! +@strong{Warning:} Never alter the string returned by that function. +Doing that might make Emacs dysfunctional, and might even crash Emacs. @end defun @cindex uninterned symbol, and generating Lisp code 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/variables.texi b/doc/lispref/variables.texi index 39d0906f6c4..5584cbce9a6 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2023,6 +2023,7 @@ file-local variables stored in @code{file-local-variables-alist}. @end defvar @cindex safe local variable +@cindex @code{safe-local-variable}, property of variable You can specify safe values for a variable with a @code{safe-local-variable} property. The property has to be a function of one argument; any value is safe if the function returns 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 c3e32433fc4..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 @@ -11040,7 +11042,8 @@ the year even for older dates. The customizable variable have Calc's date forms switch from the Julian to Gregorian calendar at any specified date. -Today's timekeepers introduce an occasional ``leap second''. +A few platforms support leap seconds, such as the time stamp +1972-06-30 23:59:60 UTC, an extra second appended to June 1972. These do not occur regularly and Calc does not take these minor effects into account. (If it did, it would have to report a non-integer number of days between, say, @@ -17340,8 +17343,12 @@ it can be a variable which is a time zone name in upper- or lower-case. For example @samp{tzone(PST) = tzone(8)} and @samp{tzone(pdt) = tzone(7)} (for Pacific standard and daylight saving times, respectively). -North American and European time zone names are defined as follows; -note that for each time zone there is one name for standard time, +North American and European time zone names are defined as follows. +These names are obsolescent and new code should not rely on them: +the @samp{YST}-related names have disagreed with time in Yukon since 1973, +and other names could well become confusing or wrong in the future +as countries change their time zone rules. +For each time zone there is one name for standard time, another for daylight saving time, and a third for ``generalized'' time in which the daylight saving adjustment is computed from context. @@ -17363,7 +17370,7 @@ To define time zone names that do not appear in the above table, you must modify the Lisp variable @code{math-tzone-names}. This is a list of lists describing the different time zone names; its structure is best explained by an example. The three entries for -Pacific Time look like this: +circa-2022 US Pacific Time look like this: @smallexample @group 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..defdf59e865 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -98,6 +98,7 @@ This manual documents how to configure, use, and customize Eglot. * Eglot and LSP Servers:: How to work with language servers. * Using Eglot:: Important Eglot commands and variables. * Customizing Eglot:: Eglot customization and advanced features. +* Advanced server configuration:: Fine-tune a specific language server * Troubleshooting Eglot:: Troubleshooting and reporting bugs. * GNU Free Documentation License:: The license for this manual. * Index:: @@ -153,11 +154,11 @@ Use Eglot. Most Eglot facilities are integrated into Emacs features, such as ElDoc, Flymake, Xref, and Imenu. However, Eglot also provides -commands of its own, mainly to perform tasks by the LSP server, such -as @kbd{M-x eglot-rename} (to rename an identifier across the entire -project), @kbd{M-x eglot-format} (to reformat and reindent code), and -some others. @xref{Eglot Commands}, for the detailed list of Eglot -commands. +commands of its own, mainly to perform tasks by the language server, +such as @kbd{M-x eglot-rename} (to rename an identifier across the +entire project), @kbd{M-x eglot-format} (to reformat and reindent +code), and some others. @xref{Eglot Commands}, for the detailed list +of Eglot commands. @item That's it! @@ -226,11 +227,10 @@ This says to invoke @var{program} with zero or more arguments standard input and standard output streams. @item (@var{program} @var{args}@dots{} :initializationOptions @var{options}@dots{}) -Like above, but with @var{options} specifying the options to be -used for constructing the @samp{initializationOptions} JSON object for -the server. @var{options} can also be a function of one argument, in -which case it will be called with the server instance as the argument, -and should return the JSON object to use for initialization. +@var{program} is invoked with @var{args} but @var{options} specifies +how to construct the @samp{:initializationOptions} JSON object to pass +the server on during the LSP handshake (@pxref{Advanced server +configuration}). @item (@var{host} @var{port} @var{args}@dots{}) Here @var{host} is a string and @var{port} is a positive integer @@ -465,43 +465,10 @@ ElDoc look nicer on display. @item In addition to enabling and enhancing other features and packages, -Eglot also provides a small number of user commands based directly on -the capabilities of language servers. These commands are: - -@table @kbd -@item M-x eglot-rename -This prompts for a new name for the symbol at point, and then modifies -all the project source files to rename the symbol to the new name, -based on editing data received from the language-server. @xref{Eglot -and Buffers}, for the details of how project files are defined. - -@item M-x eglot-format -This reformats and prettifies the current active region according to -source formatting rules of the language-server. If the region is not -active, it reformats the entire buffer instead. - -@item M-x eglot-format-buffer -This reformats and prettifies the current buffer according to source -formatting rules of the language-server. - -@cindex code actions -@item M-x eglot-code-actions -@itemx M-x eglot-code-action-organize-imports -@itemx M-x eglot-code-action-quickfix -@itemx M-x eglot-code-action-extract -@itemx M-x eglot-code-action-inline -@itemx M-x eglot-code-action-rewrite -These command allow you to invoke the so-called @dfn{code actions}: -requests for the language-server to provide editing commands for -various code fixes, typically either to fix an error diagnostic or to -beautify/refactor code. For example, -@code{eglot-code-action-organize-imports} rearranges the program -@dfn{imports}---declarations of modules whose capabilities the program -uses. These commands affect all the files that belong to the -project. The command @kbd{M-x eglot-code-actions} will pop up a menu -of code applicable actions at point. -@end table - +Eglot also provides a number of user commands based on the +capabilities of language servers. Examples include renaming symbols +with @kbd{eglot-rename} and asking to automatically correct problems +with @kbd{eglot-code-actions}. @xref{Eglot Commands}. @end itemize Not all servers support the full set of LSP capabilities, but most of @@ -704,20 +671,44 @@ entire current buffer. This command reformats the current buffer, in the same manner as @code{eglot-format} does. +@cindex code actions @item M-x eglot-code-actions -@itemx mouse-1 -This command asks the server for any @dfn{code actions} applicable at -point. It can also be invoked by @kbd{mouse-1} clicking on -diagnostics provided by the server. - -@item M-x eglot-code-action-organize-imports +@itemx M-x eglot-code-action-organize-imports @itemx M-x eglot-code-action-quickfix @itemx M-x eglot-code-action-extract @itemx M-x eglot-code-action-inline @itemx M-x eglot-code-action-rewrite -These commands invoke specific code actions supported by the language -server. -@c FIXME: Need more detailed description of each action. +These commands allow you to invoke the so-called @dfn{code actions}: +requests for the language server to provide editing commands for +correcting, refactoring or beautifying your code. These commands may +affect more than one visited file belong to the project. + +The command @code{eglot-code-actions} asks the server if there any +code actions for any point in the buffer or contained in the active +region. If there are, you the choice to execute one of them via the +minibuffer. + +A common use of code actions is fixing the Flymake error diagnostics +issued by Eglot (@pxref{Top,,, flymake, GNU Flymake manual}). +Clicking on a diagnostic with @kbd{mouse-2} invokes +@code{eglot-code-actions-at-mouse} which pops up a menu of available +code actions. The variable @code{eglot-diagnostics-map} can be used +to control the mouse binding. + +Other commands execute a specific code action. For example, +@code{eglot-code-action-organize-imports} rearranges the program's +@dfn{imports}---declarations of modules whose capabilities the program +uses. + +@cindex inlay hints +@item M-x eglot-inlay-hints-mode +This command toggles LSP @dfn{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++ +language server can serve hints about positional parameter names in +function calls and a variable's automatically deduced type. Inlay +hints help the user not have to remember these things by heart. @end ftable The following Eglot commands are used less commonly, mostly for @@ -959,141 +950,316 @@ mechanism. @cindex progress @item eglot-report-progress Set this variable to true if you'd like progress notifications coming -from the LSP server to be handled as Emacs's progress reporting +from the language server to be handled as Emacs's progress reporting facilities. +@end table +@node Advanced server configuration +@chapter Advanced server configuration + +Though many language servers work well out-of-the-box, most allow +fine-grained control of their operation via specific configuration +options that are transmitted over the LSP protocol and vary from +server to server. A small number of servers require such special +configuration to work acceptably, or even to work at all. + +After having setup a server executable program in +@code{eglot-server-programs} (@pxref{Setting Up LSP Servers}) and +ensuring Eglot can invoke it, you may want to take advantage of some +of these options. You should first distinguish two main kinds of +server configuration: + +@itemize @bullet +@item +Project-specific, applying to a specific project; + +@item +User-specific, applying to all projects the server is used for. +@end itemize + +When you have decided which kind you need, the following sections +teach how Eglot's user variables can be used to achieve it: + +@menu +* Project-specific configuration:: +* User-specific configuration:: +* JSONRPC objects in Elisp:: +@end menu + +It's important to note that not all servers allow both kinds of +configuration, nor is it guaranteed that user options can be copied +over to project options, and vice-versa. When in doubt, consult your +language server's documentation. + +It's also worth noting that some language servers can read these +settings from configuration files in the user's @code{HOME} directory +or in a project's directory. For example, the @command{pylsp} Python +server reads the file @file{~/.config/pycodestyle} for user +configuration. The @command{clangd} C/C++ server reads both +@file{~/.config/clangd/config.yaml} for user configuration and +@file{.clangd} for project configuration. It may be advantageous to +use these mechanisms instead of Eglot's, as this will probably work +with other LSP clients and may be easier to debug than options riding +on the LSP wire. + +@node Project-specific configuration +@section Project-specific configuration @vindex eglot-workspace-configuration -@cindex server workspace configuration -@item eglot-workspace-configuration -This variable is meant to be set in the @file{.dir-locals.el} file, to -provide per-project settings, as described below in more detail. -@end table +@cindex workspace configuration + +To set project-specific settings, which the LSP specification calls +@dfn{workspace configuration}, the variable +@code{eglot-workspace-configuration} may be used. + +This variable is a directory-local variable (@pxref{Directory +Variables, , Per-directory Local Variables, emacs, The GNU Emacs +Manual}). It's important to recognize that this variable really only +makes sense when set directory-locally. It usually does not make +sense to set it file-locally or in a major-mode hook. + +The most common way to set @code{eglot-workspace-configuration } is +using a @file{.dir-locals.el} file in the root of your project. If +you can't do that, you may also set it from Elisp code via the +@code{dir-locals-set-class-variables} function. (@pxref{Directory +Local Variables,,, elisp, GNU Emacs Lisp Reference Manual}). -Some language servers need to know project-specific settings, which -the LSP calls @dfn{workspace configuration}. Eglot allows such fine -tuning of per-project settings via the variable -@code{eglot-workspace-configuration}. Eglot sends the settings in -this variable to each server, and each server applies the portion of the -settings relevant to it and ignores the rest. These settings are -communicated to the server initially (upon establishing the -connection) or when the settings are changed, or in response to a -configuration request from the server. - -In many cases, servers can be configured globally using a -configuration file in the user's home directory or in the project -directory, which the language server reads. For example, the -@command{pylsp} server for Python reads the file -@file{~/.config/pycodestyle} and the @command{clangd} server reads the -file @file{.clangd} anywhere in the current project's directory tree. -If possible, we recommend using those configuration files that are -independent of Eglot and Emacs; they have the advantage that they will -work with other LSP clients as well. - -If you do need to provide Emacs-specific configuration for a language -server, we recommend defining the appropriate value in the -@file{.dir-locals.el} file in the project's directory. The value of -this variable should be a property list of the following format: +However you choose to set it, the variable's value is a plist +(@pxref{Property Lists,,, elisp, GNU Emacs Lisp Reference Manual}) with +the following format: @lisp - (:@var{server} @var{plist}@dots{}) + (@var{:server1} @var{plist1} @var{:server2} @var{plist2} @dots{}) @end lisp @noindent -Here @code{:@var{server}} identifies a particular language server and -@var{plist} is the corresponding keyword-value property list of one or -more parameter settings for that server, serialized by Eglot as a JSON -object. @var{plist} may be arbitrarily complex, generally containing -other keyword-value property sublists corresponding to JSON subobjects. -The JSON values @code{true}, @code{false}, @code{null} and @code{@{@}} -are represented by the Lisp values @code{t}, @code{:json-false}, -@code{nil}, and @code{eglot-@{@}}, respectively. +Here, @var{:server1} and @var{:server2} are keywords whose names +identify the LSP language servers to target. Consult server +documentation to find out what name to use. @var{plist1} and +@var{plist2} are plists of options, possibly nesting other plists. @findex eglot-show-workspace-configuration When experimenting with workspace settings, you can use the command @kbd{M-x eglot-show-workspace-configuration} to inspect and debug the -JSON value to be sent to the server. This helper command works even -before actually connecting to the server. +value of this variable in its final JSON form, ready to be sent to the +server (@pxref{JSONRPC objects in Elisp}). This helper command works +even before actually connecting to the server. + +These variable's value doesn't take effect immediately. That happens +upon establishing the connection, in response to an explicit query +from the server, or when issuing the command @kbd{M-x +eglot-signal-didChangeConfiguration} which notifies the server during +an ongoing Eglot session. + +@subsection Examples + +For some users, setting @code{eglot-workspace-configuration} is a +somewhat daunting task. One of the reasons is having to manage the +general Elisp syntax of per-mode directory-local variables, which uses +alists (@pxref{Association Lists,,, elisp, GNU Emacs Lisp Reference +Manual}), and the specific syntax of Eglot's variable, which uses +plists. Some examples are useful. + +Let's say you want to configure two language servers to be used in a +project written in a combination of the Python and Go languages. You +want to use the @command{pylsp} and @command{gopls} languages +servers. In the documentation of the servers in question (or in some +other editor's configuration file, or in some blog article), you find +the following configuration options in informal dotted-notation +syntax: + +@example +pylsp.plugins.jedi_completion.include_params: true +pylsp.plugins.jedi_completion.fuzzy: true +pylsp.pylint.enabled: false +gopls.usePlaceholders: true +@end example + +To apply this to Eglot, and assuming you chose the +@file{.dir-locals.el} file method, the contents of that file could be: -Here's an example of defining the workspace-configuration settings for -a project that uses two different language servers, one for Python, -the other one for Go (presumably, the project is written in a -combination of these two languages). The server for Python in this -case is @command{pylsp}, the server for Go is @command{gopls}. The -value of @code{eglot-workspace-configuration} in this case should be: +@lisp +((nil + . ((eglot-workspace-configuration + . (:pylsp (:plugins (:jedi_completion (:include_params t + :fuzzy t) + :pylint (:enabled :json-false))) + :gopls (:usePlaceholders t))))) + (python-mode . ((indent-tabs-mode . nil))) + (go-mode . ((indent-tabs-mode . t)))) +@end lisp + +@noindent +This sets the value of @code{eglot-workspace-configuration} in all the +buffers inside the project; each server will use only the section of +the parameters intended for that server, and ignore the rest. Note +how alists are used for associating Emacs mode names with alists +associating variable names with variable values. Then notice how +plists are used inside the value of +@code{eglot-workspace-configuration}. + +This following form may also be used: @lisp ((python-mode . ((eglot-workspace-configuration . (:pylsp (:plugins (:jedi_completion (:include_params t :fuzzy t) - :pylint (:enabled :json-false))))))) + :pylint (:enabled :json-false))))) + (indent-tabs-mode . nil))) (go-mode . ((eglot-workspace-configuration - . (:gopls (:usePlaceholders t)))))) + . (:gopls (:usePlaceholders t))) + (indent-tabs-mode . t)))) @end lisp @noindent -This should go into the @file{.dir-locals.el} file in the project's -root directory. It sets up the value of -@code{eglot-workspace-configuration} separately for each major mode. - -Alternatively, the same configuration could be defined as follows: +This sets up the value of @code{eglot-workspace-configuration} +separately depending on the major mode of each of that project's +buffers. @code{python-mode} buffers will have the variable set to +@code{(:pylsp (:plugins ...))}. @code{go-mode} buffers will have the +variable set to @code{(:gopls (:usePlaceholders t))}. + +Some servers will issue workspace configuration for specific files +inside your project. For example, if you know @code{gopls} is asking +about specific files in the @code{src/imported} subdirectory and you +want to set a different option for @code{gopls.usePlaceholders} , you +may use something like: @lisp -((nil +((python-mode . ((eglot-workspace-configuration . (:pylsp (:plugins (:jedi_completion (:include_params t :fuzzy t) - :pylint (:enabled :json-false))) - :gopls (:usePlaceholders t)))))) + :pylint (:enabled :json-false))))) + (indent-tabs-mode nil))) + (go-mode + . ((eglot-workspace-configuration + . (:gopls (:usePlaceholders t))) + (indent-tabs-mode t))) + ("src/imported" + . ((eglot-workspace-configuration + . (:gopls (:usePlaceholders nil)))))) @end lisp -This is an equivalent setup which sets the value for all the -major-modes inside the project; each server will use only the section -of the parameters intended for that server, and ignore the rest. - -As yet another alternative, you can set the value of -@code{eglot-workspace-configuration} programmatically, via the -@code{dir-locals-set-class-variables} function, @pxref{Directory Local -Variables,,, elisp, GNU Emacs Lisp Reference Manual}. - Finally, if one needs to determine the workspace configuration based on some dynamic context, @code{eglot-workspace-configuration} can be set to a function. The function is called with the @code{eglot-lsp-server} instance of the connected server (if any) and with @code{default-directory} set to the root of the project. The -function should return a value of the form described above. +function should return a plist suitable for use as the variable's +value. + +@node User-specific configuration +@section User-specific configuration +@cindex initializationOptions +@cindex command-line arguments -Some servers need special hand-holding to operate correctly. If your -server has some quirks or non-conformity, it's possible to extend -Eglot via Elisp to adapt to it, by defining a suitable -@code{eglot-initialization-options} method via @code{cl-defmethod} -(@pxref{Generic Functions,,, elisp, GNU Emacs Lisp Reference Manual}). +This kind of configuration applies to all projects the server is used +for. Here, there are a number of ways to do this inside Eglot. -Here's an example: +A common way is to pass command-line options to the server invocation +via @code{eglot-server-programs}. Let's say we want to configure +where the @command{clangd} server reads its +@code{compile_commands.json} from. This can be done like so: @lisp -(require 'eglot) +(with-eval-after-load 'eglot + (add-to-list 'eglot-server-programs + `(c++-mode . ("clangd" "--compile-commands-dir=/tmp")))) -(add-to-list 'eglot-server-programs - '((c++-mode c-mode) . (eglot-cquery "cquery"))) +@end lisp -(defclass eglot-cquery (eglot-lsp-server) () - :documentation "A custom class for cquery's C/C++ langserver.") +@noindent +Another way is to have Eglot pass a JSON object to the server during +the LSP handshake. This is done using the +@code{:initializationOptions} syntax of @code{eglot-server-programs}: -(cl-defmethod eglot-initialization-options ((server eglot-cquery)) - "Passes through required cquery initialization options" - (let* ((root (car (project-roots (eglot--project server)))) - (cache (expand-file-name ".cquery_cached_index/" root))) - (list :cacheDirectory (file-name-as-directory cache) - :progressReportFrequencyMs -1))) +@lisp +(with-eval-after-load 'eglot + (add-to-list 'eglot-server-programs + `(c++-mode . ("clangd" :initializationOptions + (:compilationDatabasePath "/tmp"))))) @end lisp @noindent -See the doc string of @code{eglot-initialization-options} for more -details. -@c FIXME: The doc string of eglot-initialization-options should be -@c enhanced and extended. +The argument @code{(:compilationDatabasePath "/tmp")} is Emacs's +representation in plist format of a simple JSON object +@code{@{"compilationDatabasePath": "/tmp"@}}. To learn how to +represent more deeply nested options in this format, @pxref{JSONRPC +objects in Elisp}. + +In this case, the two examples achieve exactly the same, but notice +how the option's name has changed between them. + +@vindex eglot-workspace-configuration +Finally there is another way to do user-specific configuration of +language servers, which may be used if the methods above are not +supported. It consists of @emph{globally} setting +@code{eglot-workspace-configuration}, a variable originally intended +for project-specific configuration. This has the same effect as +giving all your projects a certain default configuration, as described +in @ref{Project-specific configuration}. Here is an example: + +@lisp +(setq-default eglot-workspace-configuration + '(:pylsp (:plugins (:jedi_completion (:include_params t + :fuzzy t) + :pylint (:enabled :json-false))) + :gopls (:usePlaceholders t))) +@end lisp + +Note that the global value of @code{eglot-workspace-configuration} is +always overriden if a directory-local value is detected. + +@node JSONRPC objects in Elisp +@section JSONRPC objects in Elisp + +Emacs's preferred way of representing JSON is via Lisp lists. In +Eglot, the syntax of this list is the simplest possible (the one with +fewer parenthesis), a plist (@pxref{Property Lists,,, elisp, GNU Emacs +Lisp Reference Manual}). + +The plist may be arbitrarily complex, and generally containing other +keyword-value property sub-plists corresponding to JSON sub-objects. + +For representing the JSON leaf values @code{true}, @code{false}, +@code{null} and @code{@{@}}, you can use the Lisp values @code{t}, +@code{:json-false}, @code{nil}, and @code{eglot-@{@}}, respectively. +JSON arrays are represented as Elisp vectors surrounded by square brackets +(@pxref{Vectors,,,elisp,GNU Emacs Lisp Reference Manual}). + +For example, the plist + +@lisp +(:pylsp (:plugins (:jedi_completion (:include_params t + :fuzzy t + :cache_for ["pandas" "numpy"] + :pylint (:enabled :json-false)))) + :gopls (:usePlaceholders t)) +@end lisp + +@noindent +is serialized by Eglot to the following JSON text: + +@example +@{ + "pylsp": @{ + "plugins": @{ + "jedi_completion": @{ + "include_params": true, + "fuzzy": true, + "cache_for": [ "pandas", "numpy" ], + @}, + "pylint": @{ + "enabled": false + @} + @} + @}, + "gopls": @{ + "usePlaceholders":true + @}, +@} +@end example @node Troubleshooting Eglot @chapter Troubleshooting Eglot @@ -1109,53 +1275,104 @@ pop up special buffers that can be used to inspect the communications between the Eglot and language server. In many cases, this will indicate the problems or at least provide a hint. +@cindex performance A common and easy-to-fix cause of performance problems is the length -of these two buffers. If Eglot is operating correctly but slowly, -customize the variable @code{eglot-events-buffer-size} (@pxref{Eglot -Variables}) to limit logging, and thus speed things up. - -If you need to report an Eglot bug, please keep in mind that, because -there are so many variables involved, it is generally both very -@emph{difficult} and @emph{absolutely essential} to reproduce bugs -exactly as they happened to you, the user. Therefore, every bug -report should include: +of the Eglot events buffer because it represent additional work that +Eglot must do. After verifying Eglot is operating correctly but +slowly, try to customize the variable @code{eglot-events-buffer-size} +(@pxref{Eglot Variables}) to 0. This will disable any debug logging +and may speed things up. + +In other situations, the cause of poor performance lies in the +language server itself. Servers use aggressive caching and other +techniques to improve their performance. Often, this can be tweaked +by changing the server configuration (@pxref{Advanced server +configuration}). + +If you think you have found a bug, we want to hear about it. Before +reporting a bug, keep in mind that interaction with language servers +represents a large quantity of unknown variables. Therefore, it is +generally both @emph{difficult} and @emph{absolutely essential} that +the maintainers reproduce bugs exactly as they happened to you, the +user. + +To report an Eglot bug, send e-mail to @email{bug-gnu-emacs@@gnu.org}. + +Get acquainted with Emacs's bug reporting guidelines (@pxref{Bugs,,, +emacs, GNU Emacs Manual}). Then, follow this checklist specific to +Eglot bug rerpots. @enumerate @item -The transcript of events obtained from the buffer popped up by -@kbd{M-x eglot-events-buffer}. If the transcript can be narrowed down -to show the problematic exchange, so much the better. This is -invaluable for the investigation and reproduction of the problem. +Include the transcript of JSONRPC events obtained from the buffer +popped up by @kbd{M-x eglot-events-buffer}. You may narrow down the +transcript if you are sure of where the problematic exchange is, but +it's safer to include the whole transcript, either attached or inline. @item If Emacs signaled an error (an error message was seen or heard), make -sure to repeat the process after toggling @code{debug-on-error} on -(via @kbd{M-x toggle-debug-on-error}). This normally produces a -backtrace of the error that should also be attached to the bug report. +sure to repeat the process after turning on @code{debug-on-error} via +@kbd{M-x toggle-debug-on-error}. This normally produces a backtrace +of the error that should also be attached to the bug report. + +@item +Include a description of how the maintainer should obtain, install, +and configure the language server you used. Maintainers usually have +access to GNU/Linux systems, though not necessarily the distribution +that you may be using. If possible, try to replicate the problem with +the C/C@t{++} or Python servers, as these are very easy to install. @item -An explanation of how to obtain, install, and configure the language -server you used. If possible, try to replicate the problem with the -C/C@t{++} or Python servers, as these are very easy to install. +Describe how to setup a @emph{minimal} project directory where Eglot +should be started for the problem to happen. Describe each file's +name and its contents. Alternatively, you can supply the address of a +public Git repository. @item -A description of how to setup the @emph{minimal} project (one or two -files and their contents) where the problem happens. +Include versions of the software used. The Emacs version can be +obtained with @kbd{M-x emacs-version}. + +It's also essential to include the version of ELPA packages that are +explicitly or implicitly loaded. The optional but popular Company or +Markdown packages are distributed as GNU ELPA packages, not to mention +Eglot itself in some situations. Some major modes (Go, Rust, etc.) +are provided by ELPA packages. It's sometimes easy to miss these, +since they are usually implicitly loaded when visiting a file in that +language. + +ELPA packages usually live in @code{~/.emacs.d/elpa} (or what is in +@code{package-user-dir}). Please show the listing of files in that +directory as well. @item -A recipe to replicate the problem with @emph{a clean Emacs run}. This -means @kbd{emacs -Q} invocation or a very minimal (no more that 10 -lines) @file{.emacs} initialization file. @code{eglot-ensure} and -@code{use-package} calls are generally @emph{not} needed. +Include a recipe to replicate the problem with @emph{a clean Emacs +run}. This means @kbd{emacs -Q -f package-initialize} invocation +which starts Emacs with no configuration and initializes the ELPA +packages. A very minimal (no more that 10 lines) @file{.emacs} +initialization file is also acceptable and good means to describe +changes to variables. + +There is usually no need to include @kbd{require} statements in the +recipe, as Eglot's functionality uses autoloads. + +Likewise, there is rarely the need to use things like +@code{use-package} or @code{eglot-ensure}. This just makes the recipe +harder to follow. Prefer setting variables with @code{setq} and +adding to hooks with @code{add-hook}. Prefer starting Eglot with +@code{M-x eglot}. @item -Make sure to double check all the above elements and re-run the -recipe to see that the problem is reproducible. +Make sure to double check all the above elements and re-run the recipe +to see that the problem is reproducible. Following the recipe should +produce event transcript and error backtraces that are exactly the +same or very similar to the ones you included. If the problem only +happens sometimes, include this information in your bug report. @end enumerate Please keep in mind that some problems reported against Eglot may actually be bugs in the language server or the Emacs feature/package -that used Eglot to communicate with the language server. +that used Eglot to communicate with the language server. Eglot is, in +many cases, just a frontend to that functionality. @node GNU Free Documentation License @appendix GNU Free Documentation License diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 23cdcbff575..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 @@ -539,36 +540,55 @@ so demands special precautions to avoid degrading the user experience. At present, the only such module is @code{networks}, whose library ERC always loads anyway. +@anchor{Local Modules} @subheading Local Modules @cindex local modules All modules operate as minor modes under the hood, and some newer ones may be defined as buffer-local. These so-called ``local modules'' are a work in progress and their behavior and interface are subject to -change. As of ERC 5.5, the only practical differences are +change. As of ERC 5.5, the only practical differences are as follows: @enumerate @item -``Control variables,'' like @code{erc-sasl-mode}, are stateful across -IRC sessions and override @code{erc-module} membership when influencing -module activation in new sessions. +``Control variables,'' like @code{erc-sasl-mode}, retain their values +across IRC sessions and override @code{erc-module} membership when +influencing module activation. @item Removing a local module from @code{erc-modules} via Customize not only disables its mode but also kills its control variable in all ERC buffers. @item -``Mode toggles,'' like @code{erc-sasl-mode} and -@code{erc-sasl-enable}, behave differently relative to each other and -to their global counterparts. (More on this just below.) +``Mode toggles,'' like @code{erc-sasl-mode} and the complementary +@code{erc-sasl-enable}/@code{erc-sasl-disable} pairing, behave +differently than their global counterparts. @end enumerate -By default, all local-mode toggles, like @code{erc-sasl-mode}, only -affect the current buffer, but their ``non-mode'' variants, such as -@code{erc-sasl-enable}, operate on all buffers belonging to a -connection when called interactively. Keep in mind that whether -enabled or not, a module may effectively be ``inert'' in certain types -of buffers, such as queries and channels. Whatever the case, a local -toggle never mutates @code{erc-modules}. +In target buffers, a local module's activation state survives +``reassociation'' by default, but modules themselves always have the +final say. For example, a module may reset all instances of itself in +its network context upon reconnecting. Moreover, the value of a mode +variable may be meaningless in buffers that its module has no interest +in. For example, the value of @code{erc-sasl-mode} doesn't matter in +target buffers and may even remain non-@code{nil} after SASL has been +disabled for the current connection (and vice versa). + +When it comes to server buffers, a module's activation state only +persists for sessions revived via the automatic reconnection mechanism +or a manual @samp{/reconnect} issued at the prompt. In other words, +this doesn't apply to sessions revived by an entry-point command, such +as @code{erc-tls}, because such commands always ensure a clean slate +by looking only to @code{erc-modules}. Although a session revived in +this manner may indeed harvest other information from a previous +server buffer, it simply doesn't care which modules might have been +active during that connection. + +Lastly, a local mode's toggle command, like @code{erc-sasl-mode}, only +affects the current buffer, but its ``non-mode'' cousins, like +@code{erc-sasl-enable} and @code{erc-sasl-disable}, operate on all +buffers belonging to their connection (when called interactively). +And unlike global toggles, none of these ever mutates +@code{erc-modules}. @c PRE5_4: Document every option of every module in its own subnode @@ -1444,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, @@ -1452,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 1789cded9d3..1c33c04f647 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -418,9 +418,9 @@ alias (@pxref{Aliases}). Example: @example ~ $ which sudo eshell/sudo is a compiled Lisp function in `em-tramp.el'. -~ $ alias sudo '*sudo $*' +~ $ alias sudo '*sudo $@@*' ~ $ which sudo -sudo is an alias, defined as "*sudo $*" +sudo is an alias, defined as "*sudo $@@*" @end example Some of the built-in commands have different behavior from their @@ -540,7 +540,7 @@ Manual}. If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this command does not use Emacs's internal @code{diff}. This is the same -as using @samp{alias diff '*diff $*'}. +as using @samp{alias diff '*diff $@@*'}. @item dirname @cmindex dirname @@ -610,9 +610,9 @@ but use Emacs's internal @code{grep} instead. If @code{eshell-plain-grep-behavior} is non-@code{nil}, then these commands do not use Emacs's internal @code{grep}. This is the same as -using @samp{alias grep '*grep $*'}, though this setting applies to all -of the built-in commands for which you would need to create a separate -alias. +using @samp{alias grep '*grep $@@*'}, though this setting applies to +all of the built-in commands for which you would need to create a +separate alias. @item history @cmindex history @@ -668,7 +668,7 @@ Alias to Emacs's @code{locate} function, which simply runs the external If @code{eshell-plain-locate-behavior} is non-@code{nil}, then Emacs's internal @code{locate} is not used. This is the same as using -@samp{alias locate '*locate $*'}. +@samp{alias locate '*locate $@@*'}. @item ls @cmindex ls @@ -1047,12 +1047,21 @@ whenever you change the current directory to a different host the value will automatically update to reflect the search path on that host. +@vindex $UID +@item $UID +This returns the effective @acronym{UID} for the current user. This +variable is connection-aware, so when the current directory is remote, +its value will be @acronym{UID} for the user associated with that +remote connection. + @vindex $_ @item $_ This refers to the last argument of the last command. With a subscript, you can access any argument of the last command. For example, @samp{$_[1]} refers to the second argument of the last -command (excluding the command name itself). +command (excluding the command name itself). To get all arguments of +the last command, you can use an index range like @samp{$_[..]} +(@pxref{Dollars Expansion}). @vindex $$ @item $$ @@ -1078,6 +1087,7 @@ that are currently visible in the Eshell window. They are both copied to the environment, so external commands invoked from Eshell can consult them to do the right thing. +@vindex $INSIDE_EMACS @item $INSIDE_EMACS This variable indicates to external commands that they are being invoked from within Emacs so they can adjust their behavior if @@ -1091,24 +1101,47 @@ necessary. Its value is @code{@var{emacs-version},eshell}. @node Aliases @section Aliases -@vindex $* +@findex eshell-read-aliases-list Aliases are commands that expand to a longer input line. For example, -@command{ll} is a common alias for @code{ls -l}, and would be defined -with the command invocation @kbd{alias ll 'ls -l $*'}; with this defined, -running @samp{ll foo} in Eshell will actually run @samp{ls -l foo}. -Aliases defined (or deleted) by the @command{alias} command are -automatically written to the file named by @code{eshell-aliases-file}, -which you can also edit directly (although you will have to manually -reload it). - -@vindex $1, $2, @dots{} +@command{ll} is a common alias for @code{ls -l}. To define this alias +in Eshell, you can use the command invocation @kbd{alias ll 'ls -l +$@@*'}; with this defined, running @samp{ll foo} in Eshell will +actually run @samp{ls -l foo}. Aliases defined (or deleted) by the +@command{alias} command are automatically written to the file named by +@code{eshell-aliases-file}, which you can also edit directly. After +doing so, use @w{@kbd{M-x eshell-read-aliases-list}} to load the +edited aliases. + Note that unlike aliases in Bash, arguments must be handled -explicitly. Typically the alias definition would end in @samp{$*} to -pass all arguments along. More selective use of arguments via -@samp{$1}, @samp{$2}, etc., is also possible. For example, +explicitly. Within aliases, you can use the special variables +@samp{$*}, @samp{$0}, @samp{$1}, @samp{$2}, etc. to refer to the +arguments passed to the alias. + +@table @code + +@vindex $* +@item $* +This expands to the list of arguments passed to the alias. For +example, if you run @code{my-alias 1 2 3}, then @samp{$*} would be the +list @code{(1 2 3)}. Note that since this variable is a list, using +@samp{$*} in an alias will pass this list as a single argument to the +aliased command. Therefore, when defining an alias, you should +usually use @samp{$@@*} to pass all arguments along, splicing them +into your argument list (@pxref{Dollars Expansion}). + +@vindex $0 +@item $0 +This expands to the name of the alias currently being executed. + +@vindex $1, $2, @dots{}, $9 +@item $1, $2, @dots{}, $9 +These variables expand to the nth argument (starting at 1) passed to +the alias. This lets you selectively use an alias's arguments, so @kbd{alias mcd 'mkdir $1 && cd $1'} would cause @kbd{mcd foo} to create and switch to a directory called @samp{foo}. +@end table + @node History @section History @cmindex history @@ -1339,11 +1372,24 @@ index. The exact behavior depends on the type of @var{expr}'s value: @item a sequence Expands to the element at the (zero-based) index @var{i} of the sequence (@pxref{Sequences Arrays Vectors, Sequences, , elisp, The -Emacs Lisp Reference Manual}). +Emacs Lisp Reference Manual}). If @var{i} is negative, @var{i} counts +from the end, so -1 refers to the last element of the sequence. + +If @var{i} is a range like @code{@var{start}..@var{end}}, this expands +to a subsequence from the indices @var{start} to @var{end}, where +@var{end} is excluded@footnote{This behavior is different from ranges +in Bash (where both the start and end are included in the range), but +matches the behavior of similar Emacs Lisp functions, like +@code{substring} (@pxref{Creating Strings, , , elisp, The Emacs Lisp +Reference Manual}).}. @var{start} and/or @var{end} can also be +omitted, which is equivalent to the start and/or end of the entire +list. For example, @samp{$@var{expr}[-2..]} expands to the last two +values of @var{expr}. @item a string Split the string at whitespace, and then expand to the @var{i}th -element of the resulting sequence. +element of the resulting sequence. As above, @var{i} can be a range +like @code{@var{start}..@var{end}}. @item an alist If @var{i} is a non-numeric value, expand to the value associated with @@ -1370,12 +1416,36 @@ to split the string. @var{regexp} can be any form other than a number. For example, @samp{$@var{var}[: 0]} will return the first element of a colon-delimited string. +@cindex length operator, in variable expansion @item $#@var{expr} -Expands to the length of the result of @var{expr}, an expression in -one of the above forms. For example, @samp{$#@var{var}} returns the -length of the variable @var{var} and @samp{$#@var{var}[0]} returns the -length of the first element of @var{var}. Again, signals an error if -the result of @var{expr} is not a string or a sequence. +This is the @dfn{length operator}. It expands to the length of the +result of @var{expr}, an expression in one of the above forms. For +example, @samp{$#@var{var}} returns the length of the variable +@var{var} and @samp{$#@var{var}[0]} returns the length of the first +element of @var{var}. Again, signals an error if the result of +@var{expr} is not a string or a sequence. + +@cindex splice operator, in variable expansion +@item $@@@var{expr} +This is the @dfn{splice operator}. It ``splices'' the elements of +@var{expr} (an expression of one of the above forms) into the +resulting list of arguments, much like the @samp{,@@} marker in Emacs +Lisp (@pxref{Backquote, , , elisp, The Emacs Lisp Reference Manual}). +The elements of @var{expr} become arguments at the same level as the +other arguments around it. For example, if @var{numbers} is the list +@code{(1 2 3)}, then: + +@example +@group +~ $ echo 0 $numbers +(0 + (1 2 3)) +@end group +@group +~ $ echo 0 $@@numbers +(0 1 2 3) +@end group +@end example @end table @@ -2094,7 +2164,7 @@ Allow for a Bash-compatible syntax, such as: @example alias arg=blah -function arg () @{ blah $* @} +function arg () @{ blah $@@* @} @end example @item Pcomplete sometimes gets stuck @@ -2119,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 @@ -2179,11 +2247,6 @@ So that @kbd{M-@key{DEL}} acts in a predictable manner, etc. @item Allow all Eshell buffers to share the same history and list-dir -@item There is a problem with script commands that output to @file{/dev/null} - -If a script file, somewhere in the middle, uses @samp{> /dev/null}, -output from all subsequent commands is swallowed. - @item Split up parsing of text after @samp{$} in @file{esh-var.el} Make it similar to the way that @file{esh-arg.el} is structured. @@ -2392,13 +2455,6 @@ current being used. This way, the user could change it to use rc syntax: @samp{>[2=1]}. -@item Allow @samp{$_[-1]}, which would indicate the last element of the array - -@item Make @samp{$x[*]} equal to listing out the full contents of @samp{x} - -Return them as a list, so that @samp{$_[*]} is all the arguments of the -last command. - @item Copy ANSI code handling from @file{term.el} into @file{em-term.el} Make it possible for the user to send char-by-char to the underlying diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index bc556ed88e2..836eb38503e 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -92,9 +92,10 @@ searched via @code{eww-search-prefix}. The default search engine is either prefix the file name with @code{file://} or use the command @kbd{M-x eww-open-file}. - If you invoke @code{eww} with a prefix argument, as in @w{@kbd{C-u -M-x eww}}, it will create a new EWW buffer instead of reusing the -default one, which is normally called @file{*eww*}. + If you invoke @code{eww} or @code{eww-open-file} with a prefix +argument, as in @w{@kbd{C-u M-x eww}}, they will create a new EWW +buffer instead of reusing the default one, which is normally called +@file{*eww*}. @findex eww-quit @findex eww-reload 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 3289d66f017..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 @@ -12106,17 +12097,6 @@ if they were public groups, you can add the name of that group to the Also @pxref{Misc Article} for @code{gnus-inhibit-images}. -@item gnus-html-cache-directory -@vindex gnus-html-cache-directory -Gnus will download and cache images according to how -@code{gnus-blocked-images} is set. These images will be stored in -this directory. - -@item gnus-html-cache-size -@vindex gnus-html-cache-size -When @code{gnus-html-cache-size} bytes have been used in that -directory, the oldest files will be deleted. The default is 500MB. - @item gnus-html-frame-width @vindex gnus-html-frame-width The width to use when rendering HTML@. The default is 70. @@ -14529,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: @@ -14566,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, @@ -14575,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 @@ -14590,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 @@ -19828,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/idlwave.texi b/doc/misc/idlwave.texi index 3ec07fb4a50..10fc4c85c7b 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -1372,10 +1372,9 @@ among, with differing advantages and disadvantages. The variable to (as long as @code{idlwave-help-use-assistant} is not set). This function is used to set the variable @code{browse-url-browser-function} locally for IDLWAVE help only. Customize the latter variable to see -what choices of browsers your system offers. Certain browsers like -@code{w3} (bundled with many versions of Emacs) and @code{w3m} -(@uref{http://emacs-w3m.namazu.org/}) are run within Emacs, and use -Emacs buffers to display the HTML help. This can be convenient, +what choices of browsers your system offers. Certain browsers like EWW +(@pxref{Top, EWW,, eww, The Emacs Web Wowser Manual}) are run within Emacs, +and use Emacs buffers to display the HTML help. This can be convenient, especially on small displays, and images can even be displayed in-line on newer Emacs versions. However, better formatting results are often achieved with external browsers, like Mozilla. IDLWAVE assumes any diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index 575a086e2c5..caee0ed2c70 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -793,7 +793,7 @@ You should see the scan line for your message, and perhaps others. Use @cartouche @smallexample - 3 t08/24 root received fax files on Wed Aug 24 11:00:13 PDT 1 + 3 t08/24 root received fax files on Wed Aug 24 11:00:13 -0700 1 # 4+t08/24 To:wohler Test<<This is a test message to get the wheels -:%% @{+inbox/select@} 4 msgs (1-4) Bot L4 (MH-Folder Show)--------- diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index 4bf78379c10..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 3.0.0 -#+macro: release-date 2022-10-28 -#+macro: development-version 3.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:}@@ @@ -21,20 +21,27 @@ #+texinfo: @insertcopying -This manual, written by Protesilaos Stavrou, describes the customization -options for the ~modus-operandi~ and ~modus-vivendi~ themes, and provides -every other piece of information pertinent to them. +This manual, written by Protesilaos Stavrou, describes the +customization options for the Modus themes, and provides every other +piece of information pertinent to them. The documentation furnished herein corresponds to stable version -{{{stable-version}}}, released on {{{release-date}}}. Any reference to a newer -feature which does not yet form part of the latest tagged commit, is -explicitly marked as such. +{{{stable-version}}}, released on {{{release-date}}}. Any reference +to a newer feature which does not yet form part of the latest tagged +commit, is explicitly marked as such. Current development target is {{{development-version}}}. -+ Homepage: https://protesilaos.com/emacs/modus-themes. -+ Git repository: https://git.sr.ht/~protesilaos/modus-themes. -+ Mailing list: https://lists.sr.ht/~protesilaos/modus-themes. ++ Package name (GNU ELPA): ~modus-themes~ ++ Official manual: <https://protesilaos.com/emacs/modus-themes> ++ Change log: <https://protesilaos.com/emacs/modus-themes-changelog> ++ Color palette: <https://protesilaos.com/emacs/modus-themes-colors> ++ Sample pictures: <https://protesilaos.com/emacs/modus-themes-pictures> ++ Git repo on SourceHut: <https://git.sr.ht/~protesilaos/modus-themes> + - Mirrors: + + GitHub: <https://github.com/protesilaos/modus-themes> + + GitLab: <https://gitlab.com/protesilaos/modus-themes> ++ Mailing list: <https://lists.sr.ht/~protesilaos/modus-themes> + Backronym: My Old Display Unexpectedly Sharpened ... themes #+toc: headlines 8 insert TOC here, with eight headline levels @@ -45,7 +52,7 @@ Current development target is {{{development-version}}}. :custom_id: h:b14c3fcb-13dd-4144-9d92-2c58b3ed16d3 :end: -Copyright (C) 2020-2023 Free Software Foundation, Inc. +Copyright (C) 2020-2023 Free Software Foundation, Inc. #+begin_quote Permission is granted to copy, distribute and/or modify this document @@ -64,44 +71,46 @@ modify this GNU manual.” :custom_id: h:f0f3dbcb-602d-40cf-b918-8f929c441baf :end: -The Modus themes are designed for accessible readability. They conform -with the highest standard for color contrast between any given -combination of background and foreground values. This corresponds to -the WCAG AAA standard, which specifies a minimum rate of distance in -relative luminance of 7:1. +The Modus themes are designed for accessible readability. They +conform with the highest standard for color contrast between +combinations of background and foreground values. For small sized +text, this corresponds to the WCAG AAA standard, which specifies a +minimum rate of distance in relative luminance of 7:1. + +The Modus themes consist of six themes, divided into three subgroups. + +- Main themes :: ~modus-operandi~ is the project's main light theme, + while ~modus-vivendi~ is its dark counterpart. These two themes are + part of the project since its inception. They are designed to cover + a broad range of needs and are, in the opinion of the author, the + reference for what a highly legible "default" theme should look + like. + +- Tinted themes :: ~modus-operandi-tinted~ and ~modus-vivendi-tinted~ + are variants of the two main themes. They slightly tone down the + intensity of the background and provide a bit more color variety. + ~modus-operandi-tinted~ has a set of base tones that are shades of + light ochre (earthly colors), while ~modus-vivendi-tinted~ gives a + night sky impression. + +- Deuteranopia themes :: ~modus-operandi-deuteranopia~ and its + companion ~modus-vivendi-deuteranopia~ are optimized for users with + red-green color deficiency. This means that they do not use red and + green hues for color-coding purposes, such as for diff removed and + added lines. Instead, they implement colors that are discernible by + users with deueteranopia or deuteranomaly (mostly yellow and blue + hues). -Modus Operandi (~modus-operandi~) is a light theme, while Modus Vivendi -(~modus-vivendi~) is dark. Each theme's color palette is designed to meet -the needs of the numerous interfaces that are possible in the Emacs -computing environment. +To ensure that users have a consistently accessible experience, the +themes strive to achieve as close to full face coverage as possible, +while still targeting a curated list of well-maintained packages +([[#h:a9c8f29d-7f72-4b54-b74b-ddefe15d6a19][Face coverage]]). The overarching objective of this project is to always offer accessible color combinations. There shall never be a compromise on this principle. If there arises an inescapable trade-off between readability and stylistic considerations, we will always opt for the former. -To ensure that users have a consistently accessible experience, the -themes strive to achieve as close to full face coverage as possible -([[#h:a9c8f29d-7f72-4b54-b74b-ddefe15d6a19][Face coverage]]). - -Furthermore, the themes are designed to empower users with red-green -color deficiency (deuteranopia). This is achieved in three ways: - -1. The conformance with the highest legibility standard means that text - is always readable no matter the perception of its hue. - -2. Most contexts use colors on the blue-cyan-magenta-purple side of the - spectrum. Put differently, green and/or red are seldom used, thus - minimizing the potential for confusion. - - [[#h:0b26cb47-9733-4cb1-87d9-50850cb0386e][Why are colors mostly variants of blue, magenta, cyan?]]. - -3. In contexts where a red/green color-coding is unavoidable, we provide - a universal toggle to customize the themes so that a red/blue scheme - is used instead. - - [[#h:3ed03a48-20d8-4ce7-b214-0eb7e4c79abe][Option for red-green color deficiency or deuteranopia]]. - Starting with version 0.12.0 and onwards, the themes are built into GNU Emacs. @@ -111,12 +120,8 @@ Emacs. :end: #+cindex: Screenshots -Check the web page with [[https://protesilaos.com/emacs/modus-themes-pictures/][the screen shots]]. There are lots of scenarios -on display that draw attention to details and important aspects in the -design of the themes. They also showcase the numerous customization -options. - -[[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization options]]. +Check the web page with [[https://protesilaos.com/emacs/modus-themes-pictures/][the screen shots]]. Note that the themes are +highly customizable ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization options]]). ** Learn about the latest changes :properties: @@ -137,14 +142,21 @@ On older versions of Emacs, they can be installed using Emacs' package manager or manually from their code repository. There also exist packages for distributions of GNU/Linux. +Emacs 28 ships with ~modus-themes~ version =1.6.0=. Emacs 29 includes +version =3.0.0=. Emacs 30 provides a newer, refactored version that +thoroughly refashions how the themes are implemented and customized. +Such major versions are not backward-compatible due to the limited +resources at the maintainer's disposal to support multiple versions of +Emacs and of the themes across the years. + ** Install manually from source :properties: :custom_id: h:da3414b7-1426-46b8-8e76-47b845b76fd0 :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: @@ -218,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. @@ -245,101 +257,110 @@ wrong. :properties: :custom_id: h:3f3c3728-1b34-437d-9d0c-b110f5b161a9 :end: -#+findex: modus-themes-load-themes #+findex: modus-themes-toggle -#+findex: modus-themes-load-operandi -#+findex: modus-themes-load-vivendi -#+cindex: Essential configuration +#+findex: modus-themes-load-theme #+vindex: modus-themes-after-load-theme-hook +#+cindex: Essential configuration + +NOTE that Emacs can load multiple themes, which typically produces +undesirable results and undoes the work of the designer. Use the +~disable-theme~ command if you are trying other themes beside the +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 as -all one needs is to load the theme of their preference by adding either -form to their init file: +because there is no package to speak of. Instead, things are simpler +as built-in themes are considered safe. All one needs is to load the +theme of their preference by adding either form to their init file: #+begin_src emacs-lisp (load-theme 'modus-operandi) ; Light theme (load-theme 'modus-vivendi) ; Dark theme #+end_src +Remember that the Modus themes are six themes ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). Adapt the +above snippet accordingly. + Users of packaged variants of the themes must add a few more lines to ensure that everything works as intended. First, one has to require the -main library before loading either theme: +main library before loading one of the themes: #+begin_src emacs-lisp (require 'modus-themes) #+end_src -Then it is recommended to load the individual theme files with the -helper function ~modus-themes-load-themes~: - -#+begin_src emacs-lisp -;; Load the theme files before enabling a theme (else you get an error). -(modus-themes-load-themes) -#+end_src - -Once the libraries that define the themes are enabled, one can activate -a theme with either of the following expressions: +One can activate a theme with something like the following expression, +replacing ~modus-operandi~ with their preferred Modus theme: #+begin_src emacs-lisp -(modus-themes-load-operandi) ; Light theme -;; OR -(modus-themes-load-vivendi) ; Dark theme +(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]]). An exception to this -norm is when using the various Custom interfaces or with commands like -{{{kbd(M-x customize-set-variable)}}}, which can optionally -automatically reload the theme ([[#h:9001527a-4e2c-43e0-98e8-3ef72d770639][Option for inhibiting theme reload]]). +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': -;; Add all your customizations prior to loading the themes +;;; 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 - modus-themes-bold-constructs nil - modus-themes-region '(bg-only no-extend)) + modus-themes-bold-constructs nil) -;; Load the theme of your choice: -(load-theme 'modus-operandi) ;; OR (load-theme 'modus-vivendi) +;; Load the theme of your choice. +(load-theme 'modus-operandi) +;; Optionally define a key to switch between Modus themes. Also check +;; the user option `modus-themes-to-toggle'. (define-key global-map (kbd "<f5>") #'modus-themes-toggle) -;;; For packaged versions which must use `require': +;;; For packaged versions which must use `require'. + (require 'modus-themes) ;; Add all your customizations prior to loading the themes (setq modus-themes-italic-constructs t - modus-themes-bold-constructs nil - modus-themes-region '(bg-only no-extend)) + modus-themes-bold-constructs nil) -;; Load the theme files before enabling a theme -(modus-themes-load-themes) - -;; Load the theme of your choice: -(modus-themes-load-operandi) ;; OR (modus-themes-load-vivendi) +;; Load the theme of your choice. +(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]]. -With those granted, bear in mind a couple of technical points on -~modus-themes-load-operandi~ and ~modus-themes-load-vivendi~, as well as -~modus-themes-toggle~ which relies on them: +** 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) -1. Those functions call ~load-theme~. Some users prefer to opt for - ~enable-theme~ instead ([[#h:e68560b3-7fb0-42bc-a151-e015948f8a35][Differences between loading and enabling]]). +;; 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) -2. The functions will run the ~modus-themes-after-load-theme-hook~ as - their final step. This can be employed for bespoke configurations - ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). Experienced users may not wish to rely on - such a hook and the functions that run it: they may prefer a custom - solution ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]). +(define-key global-map (kbd "<f5>") #'modus-themes-toggle) +#+end_src ** Sample configuration with and without use-package :properties: @@ -348,70 +369,66 @@ With those granted, bear in mind a couple of technical points on #+cindex: use-package configuration #+cindex: sample configuration +What follows is a variant of what we demonstrate in the previous +section ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). + It is common for Emacs users to rely on ~use-package~ for declaring package configurations in their setup. We use this as an example: #+begin_src emacs-lisp -;;; For the built-in themes which cannot use `require': +;;; 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 - modus-themes-region '(bg-only no-extend)) - :config - ;; Load the theme of your choice: - (load-theme 'modus-operandi) ;; OR (load-theme 'modus-vivendi) - :bind ("<f5>" . modus-themes-toggle)) + 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) + + (define-key global-map (kbd "<f5>") #'modus-themes-toggle)) -;;; For packaged versions which must use `require': +;;; 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 - modus-themes-region '(bg-only no-extend)) + modus-themes-bold-constructs nil) - ;; Load the theme files before enabling a theme - (modus-themes-load-themes) - :config - ;; Load the theme of your choice: - (modus-themes-load-operandi) ;; OR (modus-themes-load-vivendi) - :bind ("<f5>" . modus-themes-toggle)) + ;; 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) + + (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 - modus-themes-region '(bg-only no-extend)) - -;; 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 - modus-themes-region '(bg-only no-extend)) + modus-themes-bold-constructs nil) -;; Load the theme files before enabling a theme -(modus-themes-load-themes) +;; 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: -(modus-themes-load-operandi) ;; OR (modus-themes-load-vivendi) +(load-theme 'modus-operandi :no-confirm) (define-key global-map (kbd "<f5>") #'modus-themes-toggle) #+end_src @@ -433,8 +450,8 @@ package declaration of the themes. The reason we recommend ~load-theme~ instead of the other option of ~enable-theme~ is that the former does a kind of "reset" on the face specs. It quite literally loads (or reloads) the theme. Whereas the -latter simply puts an already loaded theme at the top of the list of -enabled items, re-using whatever state was last loaded. +~enable-theme~ function simply puts an already loaded theme to the top +of the list of enabled items, re-using whatever state was last loaded. As such, ~load-theme~ reads all customizations that may happen during any given Emacs session: even after the initial setup of a theme. @@ -453,10 +470,13 @@ session, are better off using something like this: #+begin_src emacs-lisp (require 'modus-themes) + +;; Activate your desired themes here (load-theme 'modus-operandi t t) (load-theme 'modus-vivendi t t) -(enable-theme 'modus-operandi) ;; OR (enable-theme 'modus-vivendi) +;; Enable the preferred one +(enable-theme 'modus-operandi) #+end_src [[#h:b40aca50-a3b2-4c43-be58-2c26fcd14237][Toggle themes without reloading them]]. @@ -467,198 +487,128 @@ With the above granted, other sections of the manual discuss how to configure custom faces, where ~load-theme~ is expected, though ~enable-theme~ could still apply in stable setups: -[[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Case-by-case face specs using the themes' palette]]. - -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. -* Customization Options +* Customization options :properties: :custom_id: h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f :end: The Modus themes are highly configurable, though they should work well -without any further tweaks. By default, all customization options are -set to nil, unless otherwise noted in this manual. +without any further tweaks. We provide a variety of user options. +The following code block provides an overview. In addition to those +variables, the themes support a comprehensive system of overrides: it +can be used to make thoroughgoing changes to the looks of the themes +([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). We document everything at length in +the pages of this manual and also provide ready-to-use code samples. Remember that all customization options must be evaluated before loading a theme ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). If the theme is already active, it must be -reloaded for changes in user options to come into force. - -Below is a summary of what you will learn in the subsequent sections of -this manual. +reloaded for changes to take effect. #+begin_src emacs-lisp +;; In all of the following, WEIGHT is a symbol such as `semibold', +;; `light', `bold', or anything mentioned in `modus-themes-weights'. (setq modus-themes-italic-constructs t modus-themes-bold-constructs nil - modus-themes-mixed-fonts nil - modus-themes-subtle-line-numbers nil - modus-themes-intense-mouseovers nil - modus-themes-deuteranopia t - modus-themes-tabs-accented t + modus-themes-mixed-fonts t modus-themes-variable-pitch-ui nil - modus-themes-inhibit-reload t ; only applies to `customize-set-variable' and related - - modus-themes-fringes nil ; {nil,'subtle,'intense} - - ;; Options for `modus-themes-lang-checkers' are either nil (the - ;; default), or a list of properties that may include any of those - ;; symbols: `straight-underline', `text-also', `background', - ;; `intense' OR `faint'. - modus-themes-lang-checkers nil - - ;; Options for `modus-themes-mode-line' are either nil, or a list - ;; that can combine any of `3d' OR `moody', `borderless', - ;; `accented', a natural number for extra padding (or a cons cell - ;; of padding and NATNUM), and a floating point for the height of - ;; the text relative to the base font size (or a cons cell of - ;; height and FLOAT) - modus-themes-mode-line '(accented borderless (padding . 4) (height . 0.9)) - - ;; Same as above: - ;; modus-themes-mode-line '(accented borderless 4 0.9) - - ;; Options for `modus-themes-markup' are either nil, or a list - ;; that can combine any of `bold', `italic', `background', - ;; `intense'. - modus-themes-markup '(background italic) - - ;; Options for `modus-themes-syntax' are either nil (the default), - ;; or a list of properties that may include any of those symbols: - ;; `faint', `yellow-comments', `green-strings', `alt-syntax' - modus-themes-syntax nil - - ;; Options for `modus-themes-hl-line' are either nil (the default), - ;; or a list of properties that may include any of those symbols: - ;; `accented', `underline', `intense' - modus-themes-hl-line '(underline accented) - - ;; Options for `modus-themes-paren-match' are either nil (the - ;; default), or a list of properties that may include any of those - ;; symbols: `bold', `intense', `underline' - modus-themes-paren-match '(bold intense) - - ;; Options for `modus-themes-links' are either nil (the default), - ;; or a list of properties that may include any of those symbols: - ;; `neutral-underline' OR `no-underline', `faint' OR `no-color', - ;; `bold', `italic', `background' - modus-themes-links '(neutral-underline background) - - ;; Options for `modus-themes-box-buttons' are either nil (the - ;; default), or a list that can combine any of `flat', `accented', - ;; `faint', `variable-pitch', `underline', `all-buttons', the - ;; symbol of any font weight as listed in `modus-themes-weights', - ;; and a floating point number (e.g. 0.9) for the height of the - ;; button's text. - modus-themes-box-buttons '(variable-pitch flat faint 0.9) + 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 - ;; symbols: `background', `bold', `gray', `intense', `italic' - modus-themes-prompts '(intense bold) + ;; symbols: `italic', `WEIGHT' + modus-themes-prompts '(italic bold) - ;; The `modus-themes-completions' is an alist that reads three - ;; keys: `matches', `selection', `popup'. Each accepts a nil - ;; value (or empty list) or a list of properties that can include - ;; any of the following (for WEIGHT read further below): + ;; The `modus-themes-completions' is an alist that reads two + ;; keys: `matches', `selection'. Each accepts a nil value (or + ;; empty list) or a list of properties that can include any of + ;; the following (for WEIGHT read further below): ;; - ;; `matches' - `background', `intense', `underline', `italic', WEIGHT - ;; `selection' - `accented', `intense', `underline', `italic', `text-also' WEIGHT - ;; `popup' - same as `selected' - ;; `t' - applies to any key not explicitly referenced (check docs) - ;; - ;; WEIGHT is a symbol such as `semibold', `light', or anything - ;; covered in `modus-themes-weights'. Bold is used in the absence - ;; of an explicit WEIGHT. - modus-themes-completions '((matches . (extrabold)) - (selection . (semibold accented)) - (popup . (accented intense))) - - modus-themes-mail-citations nil ; {nil,'intense,'faint,'monochrome} - - ;; Options for `modus-themes-region' are either nil (the default), - ;; or a list of properties that may include any of those symbols: - ;; `no-extend', `bg-only', `accented' - modus-themes-region '(bg-only no-extend) - - ;; Options for `modus-themes-diffs': nil, 'desaturated, 'bg-only - modus-themes-diffs 'desaturated + ;; `matches' :: `underline', `italic', `WEIGHT' + ;; `selection' :: `underline', `italic', `WEIGHT' + modus-themes-completions + '((matches . (extrabold)) + (selection . (semibold italic text-also))) modus-themes-org-blocks 'gray-background ; {nil,'gray-background,'tinted-background} - modus-themes-org-agenda ; this is an alist: read the manual or its doc string - '((header-block . (variable-pitch 1.3)) - (header-date . (grayscale workaholic bold-today 1.1)) - (event . (accented varied)) - (scheduled . uniform) - (habit . traffic-light)) - - modus-themes-headings ; this is an alist: read the manual or its doc string - '((1 . (overline background variable-pitch 1.3)) - (2 . (rainbow overline 1.1)) - (t . (semibold)))) + ;; The `modus-themes-headings' is an alist: read the manual's + ;; node about it or its doc string. Basically, it supports + ;; per-level configurations for the optional use of + ;; `variable-pitch' typography, a height value as a multiple of + ;; the base font size (e.g. 1.5), and a `WEIGHT'. + modus-themes-headings + '((1 . (variable-pitch 1.5)) + (2 . (1.3)) + (agenda-date . (1.3)) + (agenda-structure . (variable-pitch light 1.8)) + (t . (1.1)))) + +;; Remember that more (MUCH MORE) can be done with overrides, which we +;; document extensively in this manual. #+end_src -** Option for inhibiting theme reload +** Option for reloading the theme on custom change :properties: :alt_title: Custom reload theme :description: Toggle auto-reload of the theme when setting custom variables :custom_id: h:9001527a-4e2c-43e0-98e8-3ef72d770639 :end: -#+vindex: modus-themes-inhibit-reload +#+vindex: modus-themes-custom-auto-reload Brief: Toggle reloading of the active theme when an option is changed -through the Customize UI. +through the Custom UI. -Symbol: ~modus-themes-inhibit-reload~ (=boolean= type) +Symbol: ~modus-themes-custom-auto-reload~ (=boolean= type) Possible values: 1. ~nil~ 2. ~t~ (default) -By default, customizing a theme-related user option through the Custom -interfaces or with {{{kbd(M-x customize-set-variable)}}} will not reload the -currently active Modus theme. +All theme user options take effect when a theme is loaded. Any +subsequent changes require the theme to be reloaded. -Enable this behavior by setting this variable to ~nil~. +When this variable has a non-nil value, any change made via the Custom +UI or related functions such as ~customize-set-variable~ and ~setopt~ +(Emacs 29), will trigger a reload automatically. -Regardless of this option, the active theme must be reloaded for changes -to user options to take effect ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). +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 red-green color deficiency or deuteranopia +** Option for disabling other themes while loading Modus :properties: -:alt_title: Deuteranopia style -:description: Toggle red/blue color-coding instead of red/green -:custom_id: h:3ed03a48-20d8-4ce7-b214-0eb7e4c79abe +: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-deuteranopia +#+vindex: modus-themes-disable-other-themes -Brief: When non-~nil~ use red/blue color-coding instead of red/green, -where appropriate. +Brief: Disable all other themes when loading a Modus theme. -Symbol: ~modus-themes-deuteranopia~ (=boolean= type) +Symbol: ~modus-themes-disable-other-themes~ (=boolean= type) Possible values: -1. ~nil~ (default) -2. ~t~ +1. ~nil~ +2. ~t~ (default) -This is to account for red-green color deficiency, also know as -deuteranopia and variants. It applies to all contexts where there can -be a color-coded distinction between failure or success, a to-do or done -state, a mark for deletion versus a mark for selection (e.g. in Dired), -current and lazily highlighted search matches, removed lines in diffs as -opposed to added ones, and so on. +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. -Note that this does not change all colors throughout the active theme, -but only applies to cases that have color-coding significance. For -example, regular code syntax highlighting is not affected. There is no -such need because of the themes' overarching commitment to the highest -legibility standard, which ensures that text is readable regardless of -hue, as well as the predominance of colors on the -blue-cyan-magenta-purple side of the spectrum. +When the value is nil, the aforementioned commands and function will +only disable other themes within the Modus collection. -[[#h:0b26cb47-9733-4cb1-87d9-50850cb0386e][Why are colors mostly variants of blue, magenta, cyan?]]. +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: @@ -680,9 +630,9 @@ Possible values: The default is to use a bold typographic weight only when it is required. -With a non-~nil~ value (~t~) display several syntactic constructs in bold -weight. This concerns keywords and other important aspects of code -syntax. It also affects certain mode line indicators and command-line +With a non-~nil~ value (~t~) display several syntactic constructs in +bold weight. This concerns keywords and other important aspects of +code syntax. It also affects certain mode line indicators and command prompts. Advanced users may also want to configure the exact attributes of the @@ -718,70 +668,6 @@ Advanced users may also want to configure the exact attributes of the [[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. -** Option for syntax highlighting -:properties: -:alt_title: Syntax styles -:description: Choose the overall aesthetic of code syntax -:custom_id: h:c119d7b2-fcd4-4e44-890e-5e25733d5e52 -:end: -#+vindex: modus-themes-syntax - -Brief: Set the overall style of code syntax highlighting. - -Symbol: ~modus-themes-syntax~ (=choice= type, list of properties) - -Possible values are expressed as a list of properties (default is ~nil~ or -an empty list). The list can include any of the following symbols: - -+ ~faint~ -+ ~yellow-comments~ -+ ~green-strings~ -+ ~alt-syntax~ - -The default (a ~nil~ value or an empty list) is to use a balanced -combination of colors on the cyan-blue-magenta side of the spectrum. -There is little to no use of greens, yellows, and reds. Comments are -gray, strings are blue colored, doc strings are a shade of cyan, while -color combinations are designed to avoid exaggerations. - -The property ~faint~ fades the saturation of all applicable colors, where -that is possible or appropriate. - -The property ~yellow-comments~ applies a yellow color to comments. - -The property ~green-strings~ applies a green color to strings and a green -tint to doc strings. - -The property ~alt-syntax~ changes the combination of colors beyond strings -and comments, so that the effective palette is broadened to provide -greater variety relative to the default. - -Combinations of any of those properties are expressed as a list, like in -these examples: - -#+begin_src emacs-lisp -(faint) -(green-strings yellow-comments) -(alt-syntax green-strings yellow-comments) -(faint alt-syntax green-strings yellow-comments) -#+end_src - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - -#+begin_src emacs-lisp -(setq modus-themes-syntax '(faint alt-syntax)) -#+end_src - -Independent of this variable, users may also control the use of a bold -weight or italic text: ~modus-themes-bold-constructs~ and -~modus-themes-italic-constructs~. - -[[#h:b25714f6-0fbe-41f6-89b5-6912d304091e][Option for more bold constructs]]. - -[[#h:977c900d-0d6d-4dbb-82d9-c2aae69543d6][Option for more italic constructs]]. - ** Option for font mixing :properties: :alt_title: Mixed fonts @@ -805,111 +691,31 @@ tables and code blocks to always inherit from the ~fixed-pitch~ face. This is to ensure that certain constructs like code blocks and tables remain monospaced even when users opt for a mode that remaps typeface families, such as the built-in {{{kbd(M-x variable-pitch-mode)}}}. Otherwise -the layout would appear broken, due to how spacing is done. +the layout can appear broken, due to how spacing is done. For a consistent experience, user may need to specify the font family of the ~fixed-pitch~ face. [[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. -Furthermore, users may prefer to use another package for handling mixed -typeface configurations, rather than letting the theme do it, perhaps -because a purpose-specific package has extra functionality. Two -possible options are ~org-variable-pitch~ and ~mixed-pitch~. - -** Option for links +** Option for command prompt styles :properties: -:alt_title: Link styles -:description: Choose among several styles, with or without underline -:custom_id: h:5808be52-361a-4d18-88fd-90129d206f9b +:alt_title: Command prompts +:description: Control the style of command prompts +:custom_id: h:db5a9a7c-2928-4a28-b0f0-6f2b9bd52ba1 :end: -#+vindex: modus-themes-links +#+vindex: modus-themes-prompts -Brief: Control the style of links to web pages, files, buffers... +Brief: Control the style of command prompts (e.g. minibuffer, shell, IRC +clients). -Symbol: ~modus-themes-links~ (=choice= type, list of properties) +Symbol: ~modus-themes-prompts~ (=choice= type, list of properties) Possible values are expressed as a list of properties (default is ~nil~ or an empty list). The list can include any of the following symbols: -+ Underline style: - - ~neutral-underline~ - - ~no-underline~ -+ Text coloration: - - ~faint~ - - ~no-color~ -+ ~bold~ + ~italic~ -+ ~background~ - -The default (a ~nil~ value or an empty list) is a prominent text color, -typically blue, with an underline of the same color. - -For the style of the underline, a ~neutral-underline~ property turns the -color of the line into a subtle gray, while the ~no-underline~ property -removes the line altogether. If both of those are set, the latter takes -precedence. - -For text coloration, a ~faint~ property desaturates the color of the text -and the underline, unless the underline is affected by the -aforementioned properties. While a ~no-color~ property removes the color -from the text. If both of those are set, the latter takes precedence. - -A ~bold~ property applies a heavy typographic weight to the text of the -link. - -An ~italic~ property adds a slant to the link's text (italic or oblique -forms, depending on the typeface). - -A ~background~ property applies a subtle tinted background color. - -In case both ~no-underline~ and ~no-color~ are set, then a subtle gray -background is applied to all links. This can still be combined with the -~bold~ and ~italic~ properties. - -Combinations of any of those properties are expressed as a list, -like in these examples: - -#+begin_src emacs-lisp -(faint) -(no-underline faint) -(no-color no-underline bold) -(italic bold background no-color no-underline) -#+end_src - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - -#+begin_src emacs-lisp -(setq modus-themes-links '(neutral-underline background)) -#+end_src - -The placement of the underline, meaning its proximity to the text, is -controlled by ~x-use-underline-position-properties~, -~x-underline-at-descent-line~, ~underline-minimum-offset~. Please refer to -their documentation strings. - -** Option for box buttons -:properties: -:alt_title: Box buttons -:description: Choose among several styles for buttons -:custom_id: h:8b85f711-ff40-45b0-b7fc-4727503cd2ec -:end: -#+vindex: modus-themes-box-buttons - -Brief: Control the style of buttons in the Custom UI and related. - -Symbol: ~modus-themes-box-buttons~ (=choice= type, list of properties) - -Possible values are expressed as a list of properties (default is ~nil~ or -an empty list). The list can include any of the following symbols: - -+ ~flat~ -+ ~accented~ -+ ~faint~ -+ ~variable-pitch~ -+ ~underline~ ++ ~italic~ + A font weight, which must be supported by the underlying typeface: - ~thin~ - ~ultralight~ @@ -923,213 +729,24 @@ an empty list). The list can include any of the following symbols: - ~heavy~ - ~extrabold~ - ~ultrabold~ -+ A floating point as a height multiple of the default or a cons cell in - the form of =(height . FLOAT)= -+ ~all-buttons~ - -The default (a ~nil~ value or an empty list) is a gray background -combined with a pseudo three-dimensional effect. - -The ~flat~ property makes the button two dimensional. - -The ~accented~ property changes the background from gray to an accent -color. - -The ~faint~ property reduces the overall coloration. - -The ~variable-pitch~ property applies a proportionately spaced typeface -to the button~s text. - -[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. - -The ~underline~ property draws a line below the affected text and -removes whatever box effect. This is optimal when Emacs runs inside a -terminal emulator ([[#h:fbb5e254-afd6-4313-bb05-93b3b4f67358][More accurate colors in terminal emulators]]). If -~flat~ and ~underline~ are defined together, the latter takes -precedence. - -The symbol of a weight attribute adjusts the font of the button -accordingly, such as ~light~, ~semibold~, etc. Valid symbols are -defined in the variable ~modus-themes-weights~. - -[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. - -A number, expressed as a floating point (e.g. =0.9=), adjusts the height -of the button's text to that many times the base font size. The default -height is the same as =1.0=, though it need not be explicitly stated. -Instead of a floating point, an acceptable value can be in the form of a -cons cell like =(height . FLOAT)= or =(height FLOAT)=, where FLOAT is -the given number. - -The ~all-buttons~ property extends the box button effect (or the -aforementioned properties) to the faces of the generic widget library. -By default, those do not look like the buttons of the Custom UI as they -are ordinary text wrapped in square brackets. - -Combinations of any of those properties are expressed as a list, -like in these examples: - -#+begin_src emacs-lisp -(flat) -(variable-pitch flat) -(variable-pitch flat semibold 0.9) -(variable-pitch flat semibold (height 0.9)) ; same as above -(variable-pitch flat semibold (height . 0.9)) ; same as above -#+end_src - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - -#+begin_src emacs-lisp -(setq modus-themes-box-buttons '(variable-pitch flat 0.9)) -#+end_src - -** Option for command prompt styles -:properties: -:alt_title: Command prompts -:description: Choose among plain, subtle, or intense prompts -:custom_id: h:db5a9a7c-2928-4a28-b0f0-6f2b9bd52ba1 -:end: -#+vindex: modus-themes-prompts - -Brief: Control the style of command prompts (e.g. minibuffer, shell, IRC -clients). - -Symbol: ~modus-themes-prompts~ (=choice= type, list of properties) - -Possible values are expressed as a list of properties (default is ~nil~ or -an empty list). The list can include any of the following symbols: - -+ ~background~ -+ ~bold~ -+ ~gray~ -+ ~intense~ -+ ~italic~ The default (a ~nil~ value or an empty list) means to only use a subtle -accented foreground color. +colored foreground color. -The property ~background~ applies a background color to the prompt's text. -By default, this is a subtle accented value. +The ~italic~ property adds a slant to the font's forms (italic or +oblique forms, depending on the typeface). -The property ~intense~ makes the foreground color more prominent. If the -~background~ property is also set, it amplifies the value of the -background as well. - -The property ~gray~ changes the prompt's colors to grayscale. This -affects the foreground and, if the ~background~ property is also set, the -background. Its effect is subtle, unless it is combined with the -~intense~ property. - -The property ~bold~ makes the text use a bold typographic weight. -Similarly, ~italic~ adds a slant to the font's forms (italic or oblique -forms, depending on the typeface). +The symbol of a font weight attribute such as ~light~, ~semibold~, et +cetera, adds the given weight to links. Valid symbols are defined in +the variable ~modus-themes-weights~. The absence of a weight means +that the one of the underlying text will be used. Combinations of any of those properties are expressed as a list, like in these examples: #+begin_src emacs-lisp -(intense) -(bold intense) -(intense bold gray) -(intense background gray bold) -#+end_src - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - -#+begin_src emacs-lisp -(setq modus-themes-prompts '(background gray)) -#+end_src - -** Option for mode line presentation -:properties: -:alt_title: Mode line -:description: Choose among several styles, with or without borders -:custom_id: h:27943af6-d950-42d0-bc23-106e43f50a24 -:end: -#+vindex: modus-themes-mode-line - -Brief: Control the style of the mode lines. - -Symbol: ~modus-themes-mode-line~ (=choice= type, list of properties) - -Possible values, which can be expressed as a list of combinations of box -effect, color, and border visibility: - -+ Overall style: - - ~3d~ - - ~moody~ -+ ~accented~ -+ ~borderless~ -+ A natural number > 1 for extra padding or a cons cell in the form of - ~(padding . NATNUM)~. -+ A floating point to set the height of the mode line's text. It can - also be a cons cell in the form of ~(height . FLOAT)~. - -The default (a ~nil~ value or an empty list) is a two-dimensional -rectangle with a border around it. The active and the inactive mode -lines use different shades of grayscale values for the background, -foreground, border. - -The ~3d~ property applies a three-dimensional effect to the active mode -line. The inactive mode lines remain two-dimensional and are toned down -a bit, relative to the default style. - -The ~moody~ property optimizes the mode line for use with the library of -the same name (hereinafter referred to as 'Moody'). In practice, it -removes the box effect and replaces it with underline and overline -properties. It also tones down the inactive mode lines. Despite its -intended purpose, this option can also be used without the Moody library -(please consult the themes' manual on this point for more details). If -both ~3d~ and ~moody~ properties are set, the latter takes precedence. - -The ~borderless~ property removes the color of the borders. It does not -actually remove the borders, but only makes their color the same as the -background, effectively creating some padding. - -The ~accented~ property ensures that the active mode line uses a colored -background instead of the standard shade of gray. - -A positive integer (natural number or natnum) applies a padding effect -of NATNUM pixels at the boundaries of the mode lines. The default value -is 1 and does not need to be specified explicitly. The padding has no -effect when the ~moody~ property is also used, because Moody already -applies its own tweaks. To ensure that the underline is placed at the -bottom of the mode line, set ~x-underline-at-descent-line~ to non-~nil~ -(this is not needed when the ~borderless~ property is also set). For -users on Emacs 29, the ~x-use-underline-position-properties~ variable must -also be set to nil. - -The padding can also be expressed as a cons cell in the form of -=(padding . NATNUM)= or =(padding NATNUM)= where the key is constant and -NATNUM is the desired natural number. - -A floating point applies an adjusted height to the mode line's text as a -multiple of the main font size. The default rate is 1.0 and does not -need to be specified. Apart from a floating point, the height may also -be expressed as a cons cell in the form of =(height . FLOAT)= or -=(height FLOAT)= where the key is constant and the FLOAT is the desired -number. - -Combinations of any of those properties are expressed as a list, like in -these examples: - -#+begin_src emacs-lisp -(accented) -(borderless 3d) -(moody accented borderless) -#+end_src - -Same as above, using the padding and height as an example (these -all yield the same result): - -#+begin_src emacs-lisp -(accented borderless 4 0.9) -(accented borderless (padding . 4) (height . 0.9)) -(accented borderless (padding 4) (height 0.9)) +(bold italic) +(italic semibold) #+end_src The order in which the properties are set is not significant. @@ -1137,57 +754,10 @@ The order in which the properties are set is not significant. In user configuration files the form may look like this: #+begin_src emacs-lisp -(setq modus-themes-mode-line '(borderless accented)) +(setq modus-themes-prompts '(extrabold italic)) #+end_src -Note that Moody does not expose any faces that the themes could style -directly. Instead it re-purposes existing ones to render its tabs and -ribbons. As such, there may be cases where the contrast ratio falls -below the 7:1 target that the themes conform with (WCAG AAA). To hedge -against this, we configure a fallback foreground for the ~moody~ property, -which will come into effect when the background of the mode line changes -to something less accessible, such as Moody ribbons (read the doc string -of ~set-face-attribute~, specifically ~:distant-foreground~). This fallback -is activated when Emacs determines that the background and foreground of -the given construct are too close to each other in terms of color -distance. In practice, users will need to experiment with the variable -~face-near-same-color-threshold~ to trigger the effect. We find that a -value of =45000= shall suffice, contrary to the default =30000=. Though for -the combinations that involve the ~accented~ and ~moody~ properties, as -mentioned above, that should be raised up to =70000=. Do not set it too -high, because it has the adverse effect of always overriding the default -colors (which have been carefully designed to be highly accessible). - -Furthermore, because Moody expects an underline and overline instead of -a box style, it is strongly advised to set ~x-underline-at-descent-line~ -to a non-~nil~ value. - -Finally, note that various packages which heavily modify the mode line, -such as =doom-modeline=, =nano-modeline=, =powerline=, =spaceline= may not look -as intended with all possible combinations of this user option. - -** Option for accented background in tab interfaces -:properties: -:alt_title: Tab style -:description: Toggle accented background for tabs -:custom_id: h:27cef8f5-dc4e-4c93-ba41-b899e650d936 -:end: -#+vindex: modus-themes-tabs-accented - -Brief: Toggle accent colors for tabbed interfaces. - -Symbol: ~modus-themes-tabs-accented~ (=boolean= type) - -Possible values: - -+ ~nil~ (default) -+ ~t~ - -By default, all tab interfaces use backgrounds which are shades of gray. -When this option is set to non-~nil~, the backgrounds become colorful. - -This affects the built-in ~tab-bar-mode~ and ~tab-line-mode~, as well as the -Centaur tabs package. +[[#h:bd75b43a-0bf1-45e7-b8b4-20944ca8b7f8][Make prompts more or less colorful]]. ** Option for completion framework aesthetics :properties: @@ -1201,204 +771,194 @@ Brief: Set the overall style of completion framework interfaces. Symbol: ~modus-themes-completions~ (=alist= type properties) -This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy, -Orderless, Selectrum, Vertico. The value is an alist that takes the -form of a =(KEY . PROPERTIES)= combination. =KEY= is a symbol, while -=PROPERTIES= is a list. Here is a sample, followed by a description -of the particularities: +This affects Company, Corfu, Flx, Icomplete/Fido, Ido, Ivy, 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: #+begin_src emacs-lisp (setq modus-themes-completions - '((matches . (extrabold background intense)) - (selection . (semibold accented intense)) - (popup . (accented)))) + '((matches . (extrabold underline)) + (selection . (semibold italic)))) #+end_src The ~matches~ key refers to the highlighted characters that correspond -to the user's input. When its properties are ~nil~ or an empty list, +to the user's input. When its properties are nil or an empty list, matching characters in the user interface will have a bold weight and a colored foreground. The list of properties may include any of the following symbols regardless of the order they may appear in: -- ~background~ to add a background color; - -- ~intense~ to increase the overall coloration (also amplifies - the ~background~, if present); - - ~underline~ to draw a line below the characters; - ~italic~ to use a slanted font (italic or oblique forms); -- The symbol of a font weight attribute such as ~light~, ~semibold~, et - cetera. Valid symbols are defined in the ~modus-themes-weights~ - variable. The absence of a weight means that bold will be used. +- The symbol of a font weight attribute such as ~light~, + ~semibold~, et cetera. Valid symbols are defined in the + variable ~modus-themes-weights~. The absence of a weight means + that bold will be used. The ~selection~ key applies to the current line or currently matched candidate, depending on the specifics of the user interface. When its -properties are ~nil~ or an empty list, it has a subtle gray background, +properties are nil or an empty list, it has a subtle gray background, a bold weight, and the base foreground value for the text. The list of properties it accepts is as follows (order is not significant): -- ~accented~ to make the background colorful instead of gray; - -- ~text-also~ to apply extra color to the text of the selected line; - -- ~intense~ to increase the overall coloration; - - ~underline~ to draw a line below the characters; - ~italic~ to use a slanted font (italic or oblique forms); -- The symbol of a font weight attribute such as ~light~, ~semibold~, et - cetera. Valid symbols are defined in the ~modus-themes-weights~ - variable. The absence of a weight means that bold will be used. - -The ~popup~ key takes the same values as ~selection~. The only -difference is that it applies specifically to user interfaces that -display an inline popup and thus have slightly different styling -requirements than the minibuffer. The two prominent packages are -=company= and =corfu=. +- The symbol of a font weight attribute such as ~light~, + ~semibold~, et cetera. Valid symbols are defined in the + variable ~modus-themes-weights~. The absence of a weight means + that bold will be used. -Apart from specifying each key separately, a fallback list is accepted. -This is only useful when the desired aesthetic is the same across all -keys that are not explicitly referenced. For example, this: +Apart from specifying each key separately, a catch-all list is +accepted. This is only useful when the desired aesthetic is the same +across all keys that are not explicitly referenced. For example, +this: #+begin_src emacs-lisp (setq modus-themes-completions - '((t . (extrabold intense)))) + '((t . (extrabold underline)))) #+end_src Is the same as: #+begin_src emacs-lisp (setq modus-themes-completions - '((matches . (extrabold intense)) - (selection . (extrabold intense)) - (popup . (extrabold intense)))) + '((matches . (extrabold underline)) + (selection . (extrabold underline)))) #+end_src -In the case of the fallback, any property that does not apply to the -corresponding key is simply ignored (~matches~ does not have ~accented~ -and ~text-also~, while ~selection~ and ~popup~ do not have -~background~). - -[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. - -Also refer to the documentation of the ~orderless~ package for its -intersection with ~company~ (if you choose to use those in tandem). +[[#h:d959f789-0517-4636-8780-18123f936f91][Make completion matches more or less colorful]]. -** Option for mail citations +** Option for org-mode block styles :properties: -:alt_title: Mail citations -:description: Choose among colorful, desaturated, monochrome citations -:custom_id: h:5a12765d-0ba0-4a75-ab11-e35d3bbb317d +:alt_title: Org mode blocks +:description: Choose among plain, gray, or tinted backgrounds +:custom_id: h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2 :end: -#+vindex: modus-themes-mail-citations +#+vindex: modus-themes-org-blocks -Brief: Set the overall style of citations/quotes when composing -emails. +Brief: Set the overall style of Org code blocks, quotes, and the like. -Symbol: ~modus-themes-mail-citations~ (=choice= type) +Symbol: ~modus-themes-org-blocks~ (=choice= type) Possible values: 1. ~nil~ (default) -2. ~intense~ -3. ~faint~ -4. ~monochrome~ +2. ~gray-background~ +3. ~tinted-background~ -By default (a ~nil~ value) citations are styled with contrasting hues to -denote their depth. Colors are easy to tell apart because they -complement each other, but they otherwise are not very prominent. - -Option ~intense~ is similar to the default in terms of using contrasting -and complementary hues, but applies more saturated colors. - -Option ~faint~ maintains the same color-based distinction between citation -levels though the colors it uses have subtle differences between them. +Nil (the default) means that the block has no background of its own: +it uses the one that applies to the rest of the buffer. In this case, +the delimiter lines have a gray color for their text, making them look +exactly like all other Org properties. -Option ~monochrome~ turns all quotes into a shade of gray. +Option ~gray-background~ applies a subtle gray background to the +block's contents. It also affects the begin and end lines of the +block as they get another shade of gray as their background, which +differentiates them from the contents of the block. All background +colors extend to the edge of the window, giving the area a +rectangular, "blocky" presentation. If the begin/end lines do not +extend in this way, check the value of the Org user option +~org-fontify-whole-block-delimiter-line~. + +Option ~tinted-background~ uses a colored background for the contents +of the block. The exact color value will depend on the programming +language and is controlled by the variable ~org-src-block-faces~ +(refer to the theme's source code for the current association list). +For this to take effect, the Org buffer needs to be restarted with +~org-mode-restart~. + +Code blocks use their major mode's fontification (syntax highlighting) +only when the variable ~org-src-fontify-natively~ is non-nil. While +quote/verse blocks require setting +~org-fontify-quote-and-verse-blocks~ to a non-nil value. -Whatever the value assigned to this variable, citations in emails are -controlled by typographic elements or indentation, which the themes do -not touch. +[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter fontification]]. -** Option for fringe visibility +** Option for the headings' overall style :properties: -:alt_title: Fringes -:description: Choose among invisible, subtle, or intense fringe styles -:custom_id: h:1983c3fc-74f6-44f3-b917-967c403bebae +:alt_title: Heading styles +:description: Choose among several styles, also per heading level +:custom_id: h:271eff19-97aa-4090-9415-a6463c2f9ae1 :end: -#+vindex: modus-themes-fringes - -Brief: Control the overall coloration of the fringes. - -Symbol: ~modus-themes-fringes~ (=choice= type) - -Possible values: - -1. ~nil~ -2. ~subtle~ -3. ~intense~ +#+vindex: modus-themes-headings -When the value is nil, do not apply a distinct background color. +Brief: Heading styles with optional list of values per heading level. -With a value of ~subtle~ use a gray background color that is -visible yet close to the main background color. +Symbol: ~modus-themes-headings~ (=alist= type, multiple properties) -With ~intense~ use a more pronounced gray background color. +This is an alist that accepts a =(KEY . LIST-OF-VALUES)= combination. +The =KEY= is either a number, representing the heading's level (0 +through 8) or ~t~, which pertains to the fallback style. The named +keys =agenda-date= and =agenda-structure= apply to the Org agenda. -** Option for language checkers -:properties: -:alt_title: Language checkers -:description: Control the style of language checkers/linters -:custom_id: h:4b13743a-8ebf-4d2c-a043-cceba10b1eb4 -:end: -#+vindex: modus-themes-lang-checkers - -Brief: Control the style of in-buffer warnings and errors produced by -spell checkers, code linters, and the like. +Level 0 is a special heading: it is used for what counts as a document +title or equivalent, such as the =#+title= construct we find in Org +files. Levels 1-8 are regular headings. -Symbol: ~modus-themes-lang-checkers~ (=choice= type, list of properties) +The =LIST-OF-VALUES= covers symbols that refer to properties, as +described below. Here is a complete sample with various stylistic +combinations, followed by a presentation of all available properties: -Possible values are expressed as a list of properties (default is ~nil~ or -an empty list). The list can include any of the following symbols: +#+begin_src emacs-lisp +(setq modus-themes-headings + '((1 . (variable-pitch 1.5)) + (2 . (1.3)) + (agenda-date . (1.3)) + (agenda-structure . (variable-pitch light 1.8)) + (t . (1.1)))) +#+end_src -+ ~straight-underline~ -+ ~text-also~ -+ ~background~ -+ Overall coloration: - - ~intense~ - - ~faint~ +Properties: -The default (a ~nil~ value or an empty list) applies a color-coded -underline to the affected text, while it leaves the original foreground -intact. If the display spec of Emacs has support for it, the -underline's style is that of a wave, otherwise it is a straight line. ++ A font weight, which must be supported by the underlying typeface: + - ~thin~ + - ~ultralight~ + - ~extralight~ + - ~light~ + - ~semilight~ + - ~regular~ + - ~medium~ + - ~semibold~ + - ~bold~ (default) + - ~heavy~ + - ~extrabold~ + - ~ultrabold~ ++ A floating point as a height multiple of the default or a cons cell in + the form of =(height . FLOAT)=. -The property ~straight-underline~ ensures that the underline under the -affected text is always drawn as a straight line. +By default (a ~nil~ value for this variable), all headings have a bold +typographic weight and use a desaturated text color. -The property ~text-also~ applies the same color of the underline to the -affected text. +A ~variable-pitch~ property changes the font family of the heading to that +of the ~variable-pitch~ face (normally a proportionately spaced typeface). -The property ~background~ adds a color-coded background. +The symbol of a weight attribute adjusts the font of the heading +accordingly, such as ~light~, ~semibold~, etc. Valid symbols are +defined in the variable ~modus-themes-weights~. The absence of a weight +means that bold will be used by virtue of inheriting the ~bold~ face. -The property ~intense~ amplifies the applicable colors if ~background~ -and/or ~text-also~ are set. If ~intense~ is set on its own, then it implies -~text-also~. +[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. -The property ~faint~ uses nuanced colors for the underline and for the -foreground when ~text-also~ is included. If both ~faint~ and ~intense~ are -specified, the former takes precedence. +A number, expressed as a floating point (e.g. 1.5), adjusts the height +of the heading to that many times the base font size. The default +height is the same as 1.0, though it need not be explicitly stated. +Instead of a floating point, an acceptable value can be in the form of a +cons cell like =(height . FLOAT)= or =(height FLOAT)=, where FLOAT is +the given number. -Combinations of any of those properties can be expressed in a list, as -in those examples: +Combinations of any of those properties are expressed as a list, like in +these examples: #+begin_src emacs-lisp -(background) -(straight-underline intense) -(background text-also straight-underline) +(semibold) +(variable-pitch semibold 1.3) +(variable-pitch semibold (height 1.3)) ; same as above +(variable-pitch semibold (height . 1.3)) ; same as above #+end_src The order in which the properties are set is not significant. @@ -1406,752 +966,1406 @@ The order in which the properties are set is not significant. In user configuration files the form may look like this: #+begin_src emacs-lisp -(setq modus-themes-lang-checkers '(text-also background)) +(setq modus-themes-headings + '((1 . (variable-pitch 1.5)) + (2 . (1.3)) + (agenda-date . (1.3)) + (agenda-structure . (variable-pitch light 1.8)) + (t . (1.1)))) #+end_src -NOTE: The placement of the straight underline, though not the wave -style, is controlled by the built-in variables ~underline-minimum-offset~, -~x-underline-at-descent-line~, ~x-use-underline-position-properties~. - -To disable fringe indicators for Flymake or Flycheck, refer to variables -~flymake-fringe-indicator-position~ and ~flycheck-indication-mode~, -respectively. - -** Option for line highlighting -:properties: -:alt_title: Line highlighting -:description: Choose style of current line (hl-line-mode) -:custom_id: h:1dba1cfe-d079-4c13-a810-f768e8789177 -:end: -#+vindex: modus-themes-hl-line - -Brief: Control the style of the current line of ~hl-line-mode~. - -Symbol: ~modus-themes-hl-line~ (=choice= type, list of properties) - -The value is a list of properties, each designated by a symbol. With -a ~nil~ value, or an empty list, the style is a subtle gray background -color. - -Possible properties are the following symbols: - -+ ~accented~ -+ ~intense~ -+ ~underline~ - -The property ~accented~ changes the background to a colored variant. - -An ~underline~ property draws a line below the highlighted area. Its -color is similar to the background, so gray by default or an accent -color when ~accented~ is also set. - -An ~intense~ property amplifies the colors in use, which may be both the -background and the underline. - -Combinations of any of those properties are expressed as a list, like in -these examples: +When defining the styles per heading level, it is possible to pass a +non-~nil~ value (~t~) instead of a list of properties. This will retain the +original aesthetic for that level. For example: #+begin_src emacs-lisp -(intense) -(underline intense) -(accented intense underline) -#+end_src - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: +(setq modus-themes-headings + '((1 . t) ; keep the default style + (2 . (semibold 1.2)) + (t . (rainbow)))) ; style for all other headings -#+begin_src emacs-lisp -(setq modus-themes-hl-line '(underline accented)) +(setq modus-themes-headings + '((1 . (variable-pitch 1.5)) + (2 . (semibold)) + (t . t))) ; default style for all other levels #+end_src -Set ~x-underline-at-descent-line~ to a non-~nil~ value so that the -placement of the underline coincides with the lower boundary of the -colored background. +Note that the text color of headings, of their background, and +overline can all be set via the overrides. It is possible to have any +color combination for any heading level (something that could not be +done in older versions of the themes). -This style affects several packages that enable ~hl-line-mode~, such as -=elfeed=, =notmuch=, and =mu4e=. +[[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]. -[ Also check the =lin= package on GNU ELPA (by the author of the - modus-themes) for a stylistic enhancement to ~hl-line-mode~. ] +[[#h:11297984-85ea-4678-abe9-a73aeab4676a][Make headings more or less colorful]]. -** Option for line numbers +** Option for variable-pitch font in UI elements :properties: -:alt_title: Line numbers -:description: Toggle subtle style for line numbers -:custom_id: h:8c4a6230-2e43-4aa2-a631-3b7179392e09 +:alt_title: UI typeface +:description: Toggle the use of variable-pitch across the User Interface +:custom_id: h:16cf666c-5e65-424c-a855-7ea8a4a1fcac :end: -#+vindex: modus-themes-subtle-line-numbers +#+vindex: modus-themes-variable-pitch-ui -Brief: Toggle subtle line numbers. +Brief: Toggle the use of proportionately spaced (~variable-pitch~) fonts +in the User Interface. -Symbol: ~modus-themes-subtle-line-numbers~ (=boolean= type) +Symbol: ~modus-themes-variable-pitch-ui~ (=boolean= type) -Possible value: +Possible values: 1. ~nil~ (default) 2. ~t~ -The default style for ~display-line-numbers-mode~ and its global variant -is to apply a subtle gray background to the line numbers. The current -line has a more pronounced background and foreground combination to -bring more attention to itself. +This option concerns User Interface elements that are under the direct +control of Emacs. In particular: the mode line, header line, tab bar, +and tab line. + +The default is to use the same font as the rest of Emacs, which usually +is a monospaced family. -Similarly, the faces for ~display-line-numbers-major-tick~ and its -counterpart ~display-line-numbers-minor-tick~ use appropriate styles that -involve a bespoke background and foreground combination. +With a non-~nil~ value (~t~) apply a proportionately spaced typeface. This +is done by assigning the ~variable-pitch~ face to the relevant items. -With a non-~nil~ value (~t~), line numbers have no background of their own. -Instead they retain the primary background of the theme, blending with -the rest of the buffer. Foreground values for all relevant faces are -updated to accommodate this aesthetic. +[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. -** Option for mouseover effects +** Option for palette overrides :properties: -:alt_title: Mouse hover effects -:description: Toggle intense style for mouseover highlights -:custom_id: h:9b869620-fcc5-4b5f-9ab8-225d73b7f22f +:alt_title: Palette overrides +:description: Refashion color values and/or semantic color mappings +:custom_id: h:34c7a691-19bb-4037-8d2f-67a07edab150 :end: -#+vindex: modus-themes-intense-mouseovers -Brief: Toggle intense mouse hover effects. +This section describes palette overrides in detail. For a simpler +alternative, use the presets we provide ([[#h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc][Palette override presets]]). -Symbol: ~modus-themes-intense-mouseovers~ (=boolean= type) +Each Modus theme specifies a color palette that declares named color +values and semantic color mappings: -Possible value: ++ Named colors consist of a symbol and a string that specifies a + hexadecimal RGB value. For example: =(blue-warmer "#354fcf")=. -1. ~nil~ (default) -2. ~t~ ++ The semantic color mappings associate an abstract construct with a + 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")=. -By default all mouseover effects apply a highlight with a subtle colored -background. When non-~nil~, these have a more pronounced effect. +#+vindex: modus-themes-common-palette-overrides +Both of those subsets can be overridden, thus refashioning the theme. +Overrides are either shared, by being stored in the user option +~modus-themes-common-palette-overrides~, or they are specific to the +theme they name. In the latter case, the naming scheme of each +palette variable is =THEME-NAME-palette-overrides=, thus yielding: -Note that this affects the generic ~highlight~ which, strictly speaking, -is not limited to mouse usage. +#+vindex: modus-operandi-palette-overrides ++ ~modus-operandi-palette-overrides~ -** Option for markup style in Org and others -:properties: -:alt_title: Markup -:description: Choose style for markup in Org and others -:custom_id: h:9d9a4e64-99ac-4018-8f66-3051b9c43fd7 -:end: -#+vindex: modus-themes-markup +#+vindex: modus-operandi-deuteranopia-palette-overrides ++ ~modus-operandi-deuteranopia-palette-overrides~ -Brief: Choose style of markup in Org, Markdown, and others (affects -constructs such as Org's ==verbatim== and =~code~=). +#+vindex: modus-operandi-tinted-palette-overrides ++ ~modus-operandi-tinted-palette-overrides~ -Symbol: ~modus-themes-markup~ (=boolean= type) +#+vindex: modus-vivendi-palette-overrides ++ ~modus-vivendi-palette-overrides~ -Possible values are expressed as a list of properties (default is ~nil~ or -an empty list). The list can include any of the following symbols: +#+vindex: modus-vivendi-deuteranopia-palette-overrides ++ ~modus-vivendi-deuteranopia-palette-overrides~ -1. ~bold~ -2. ~italic~ -3. ~background~ -4. ~intense~ +#+vindex: modus-vivendi-tinted-palette-overrides ++ ~modus-vivendi-tinted-palette-overrides~ -The ~italic~ property applies a typographic slant (italics). +Theme-specific overrides take precedence over the shared ones. It is +strongly advised that shared overrides do NOT alter color values, as +those will not be appropriate for both dark and light themes. Common +overrides are best limited to the semantic color mappings as those use +the color value that corresponds to the active theme (e.g. make the +cursor =blue-warmer= in all themes, whatever the value of +=blue-warmer= is in each theme). -The ~bold~ property applies a heavier typographic weight. +The value of any overrides' variable must mirror a theme's palette. +Palette variables are named after their theme as =THEME-NAME-palette=. +For example, the ~modus-operandi-palette~ is like this: -[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. +#+begin_src emacs-lisp +(defconst modus-operandi-palette + '( +;;; Basic values -The ~background~ property adds a background color. The background is a -shade of gray, unless the ~intense~ property is also set. + (bg-main "#ffffff") + (bg-dim "#f0f0f0") + (fg-main "#000000") -The ~intense~ property amplifies the existing coloration. When -~background~ is used, the background color is enhanced as well and -becomes tinted instead of being gray. + ;; ... -Combinations of any of those properties are expressed as a list, -like in these examples: + (red "#a60000") + (red-warmer "#972500") + (red-cooler "#a0132f") + (red-faint "#7f0000") + (red-intense "#d00000") -#+begin_src emacs-lisp -(bold) -(bold italic) -(bold italic intense) -(bold italic intense background) -#+end_src + ;; ... -The order in which the properties are set is not significant. +;;;; Mappings -In user configuration files the form may look like this: + ;; ... -#+begin_src emacs-lisp -(setq modus-themes-markup '(bold italic)) -#+end_src + (cursor fg-main) + (builtin magenta-warmer) + (comment fg-dim) + (constant blue-cooler) + (docstring green-faint) + (fnname magenta) + (keyword magenta-cooler) -Also check the variables ~org-hide-emphasis-markers~, -~org-hide-macro-markers~. + ;; ... + )) +#+end_src -** Option for parenthesis matching -:properties: -:alt_title: Matching parentheses -:description: Choose between various styles for matching delimiters/parentheses -:custom_id: h:e66a7e4d-a512-4bc7-9f86-fbbb5923bf37 -:end: -#+vindex: modus-themes-paren-match +The ~modus-operandi-palette-overrides~ targets the entries that need +to be changed. For example, to make the main foreground colour a dark +gray instead of pure black, use a shade of red for comments, and apply +a cyan hue to keywords: -Brief: Control the style of matching delimiters produced by -~show-paren-mode~. +#+begin_src emacs-lisp +(setq modus-operandi-palette-overrides + '((fg-main "#333333") + (comment red-faint) + (keyword cyan-cooler))) +#+end_src -Symbol: ~modus-themes-paren-match~ (=choice= type, list of properties) +Changes take effect upon theme reload ([[#h:9001527a-4e2c-43e0-98e8-3ef72d770639][Custom reload theme]]). +Overrides are removed by setting their variable to a ~nil~ value. -Possible values are expressed as a list of properties (default is ~nil~ or -an empty list). The list can include any of the following symbols: +The common accented foregrounds in each palette follow a predictable +naming scheme: =HUE{,-warmer,-cooler,-faint,-intense}=. =HUE= is one +of the six basic colors: red, green, blue, yellow, magenta, cyan. -+ ~bold~ -+ ~intense~ -+ ~underline~ +Named colors that are meant to be used as backgrounds contain =bg= in +their name, such as =bg-red-intense=. While special purpose +foregrounds that are meant to be combined with such backgrounds, +contain =fg= in their name, such as =fg-removed= which complements +=bg-removed=. -The default (a ~nil~ value or an empty list) is a subtle background color. +Named colors can be previewed, such as with the command +~modus-themes-list-colors~ ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]). -The ~bold~ property adds a bold weight to the characters of the matching -delimiters. +For a video tutorial that users of all skill levels can approach, +watch: https://protesilaos.com/codelog/2022-12-17-modus-themes-v4-demo/. -The ~intense~ property applies a more prominent background color to the -delimiters. +*** Palette override presets +:PROPERTIES: +:CUSTOM_ID: h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc +:END: -The ~underline~ property draws a straight line under the affected text. +This section shows how to refashion the themes by opting in to the +stylistic presets we provide. Those presets override the default +color mappings to amplify or tone down the overall coloration of the +them. -Combinations of any of those properties are expressed as a list, like in -these examples: +To make almost all aspects of the themes less intense, use this: #+begin_src emacs-lisp -(bold) -(underline intense) -(bold intense underline) +;; Always remember to reload the theme for changes to take effect! +(setq modus-themes-common-palette-overrides modus-themes-preset-overrides-faint) #+end_src -The order in which the properties are set is not significant. +#+vindex: modus-themes-preset-overrides-faint +With ~modus-themes-preset-overrides-faint~ the grays are toned down, +gray backgrounds are removed from some contexts, and almost all accent +colors are desaturated. It makes the themes less attention-grabbing. -In user configuration files the form may look like this: +On the opposite end of the stylistic spectrum, we have this #+begin_src emacs-lisp -(setq modus-themes-paren-match '(bold intense)) +;; Always remember to reload the theme for changes to take effect! +(setq modus-themes-common-palette-overrides modus-themes-preset-overrides-intense) #+end_src -This customization variable affects the built-in ~show-paren-mode~ and the -=smartparens= package. +#+vindex: modus-themes-preset-overrides-intense +The ~modus-themes-preset-overrides-intense~ makes many background +colors accented instead of gray and increases coloration in a number +of places. Colors stand out more and are made easier to spot. -** Option for active region -:properties: -:alt_title: Active region -:description: Choose between various styles for the active region -:custom_id: h:60798063-b4ad-45ea-b9a7-ff7b5c0ab74c -:end: -#+vindex: modus-themes-region +Note that the user is not limited to those presets. The system of +overrides we provide makes it possible to tweak the value of each +individual named color and to change how values are assigned to +semantic color mappings ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). Subsequent +sections provide examples ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic variants using palette overrides]]). -Brief: Control the style of the region. +It is also possible to use those presets as a basis and, for example, +add to them code from the subsequent sections of this manual. This is +the general idea (extra space for didactic purposes): -Symbol: ~modus-themes-region~ (=choice= type, list of properties) +#+begin_src emacs-lisp +(setq modus-themes-common-palette-overrides + `( + ;; From the section "Make the mode line borderless" + (border-mode-line-active unspecified) + (border-mode-line-inactive unspecified) -Possible values are expressed as a list of properties (default is ~nil~ or -an empty list). The list can include any of the following symbols: + ;; From the section "Make matching parenthesis more or less intense" + (bg-paren-match bg-magenta-intense) + (underline-paren-match fg-main) -+ ~no-extend~ -+ ~bg-only~ -+ ~accented~ + ;; And expand the preset here. Note that the ,@ works because + ;; we use the backtick for this list, instead of a straight + ;; quote. + ,@modus-themes-preset-overrides-intense)) +#+end_src -The default (a ~nil~ value or an empty list) is a prominent gray -background that overrides all foreground colors in the area it -encompasses. Its reach extends to the edge of the window. +*** Stylistic variants using palette overrides +:PROPERTIES: +:CUSTOM_ID: h:df1199d8-eaba-47db-805d-6b568a577bf3 +:END: -The ~no-extend~ property limits the region to the end of the line, so that -it does not reach the edge of the window. +This section contains practical examples of overriding the palette of +the themes ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). Users can copy the code to +their init file, evaluate it, and then re-load the theme for changes +to take effect. To apply overrides at startup simply define them +before the call that loads the theme. Remember that we also provide +presets that are easier to apply ([[#h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc][Palette override presets]]). -The ~bg-only~ property makes the region's background color more subtle to -allow the underlying text to retain its foreground colors. +**** Make the mode line borderless +:PROPERTIES: +:CUSTOM_ID: h:80ddba52-e188-411f-8cc0-480ebd75befe +:END: -The ~accented~ property applies a more colorful background to the region. +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]]). To +hide the border around the active and inactive mode lines, we need to +set their color to that of the underlying background. -Combinations of any of those properties are expressed as a list, like in -these examples: +[[#h:e8d781be-eefc-4a81-ac4e-5ed156190df7][Make the active mode line colorful]]. -#+begin_src emacs-lisp -(no-extend) -(bg-only accented) -(accented bg-only no-extend) -#+end_src +[[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]]. -The order in which the properties are set is not significant. +#+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. -In user configuration files the form may look like this: +;; Remove the border +(setq modus-themes-common-palette-overrides + '((border-mode-line-active unspecified) + (border-mode-line-inactive unspecified))) -#+begin_src emacs-lisp -(setq modus-themes-region '(bg-only no-extend)) +;; 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 -** Option for diff buffer looks -:properties: -:alt_title: Diffs -:description: Choose among intense, desaturated, or background-only diffs -:custom_id: h:ea7ac54f-5827-49bd-b09f-62424b3b6427 -:end: -#+vindex: modus-themes-diffs +**** Make the active mode line colorful +:PROPERTIES: +:CUSTOM_ID: h:e8d781be-eefc-4a81-ac4e-5ed156190df7 +:END: -Brief: Set the overall style of diffs. +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 some snippets that apply different stylistic variants. +Of course, it is possible to use theme-specific overrides to, say, +have a blue mode line for ~modus-operandi~ and a red one for +~modus-vivendi~. -Symbol: ~modus-themes-diffs~ (=choice= type) +[[#h:80ddba52-e188-411f-8cc0-480ebd75befe][Make the mode line borderless]]. -Possible values: +[[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]]. -1. ~nil~ (default) -2. ~desaturated~ -3. ~bg-only~ - -The default (~nil~) uses fairly intense color combinations for diffs, by -applying prominently colored backgrounds, with appropriately tinted -foregrounds. +#+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. -Option ~desaturated~ follows the same principles as with the default -(~nil~), though it tones down all relevant colors. +;; Blue background, neutral foreground, intense blue border +(setq modus-themes-common-palette-overrides + '((bg-mode-line-active bg-blue-intense) + (fg-mode-line-active fg-main) + (border-mode-line-active blue-intense))) -Option ~bg-only~ applies a background but does not override the text's -foreground. This makes it suitable for a non-~nil~ value passed to -~diff-font-lock-syntax~ (note: Magit does not support syntax highlighting -in diffs---last checked on 2021-12-02). +;; Subtle blue background, neutral foreground, intense blue border +(setq modus-themes-common-palette-overrides + '((bg-mode-line-active bg-blue-subtle) + (fg-mode-line-active fg-main) + (border-mode-line-active blue-intense))) -When the user option ~modus-themes-deuteranopia~ is non-~nil~, all diffs -will use a red/blue color-coding system instead of the standard -red/green. Other stylistic changes are made in the interest of -optimizing for such a use-case. +;; Subtle red background, red foreground, invisible border +(setq modus-themes-common-palette-overrides + '((bg-mode-line-active bg-red-subtle) + (fg-mode-line-active red-warmer) + (border-mode-line-active bg-red-subtle))) +#+end_src -[[#h:3ed03a48-20d8-4ce7-b214-0eb7e4c79abe][Option for red-green color deficiency or deuteranopia]]. +**** Make the tab bar more or less colorful +:PROPERTIES: +:CUSTOM_ID: h:096658d7-a0bd-4a99-b6dc-9b20a20cda37 +:END: -In versions before =2.0.0= there was an option for foreground-only diffs. -This is no longer supported at the theme level because there are cases -where the perceived contrast and overall contextuality were not good -enough although the applied colors were technically above the 7:1 -contrast threshold. +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 +:END: -[[#h:e2aed9eb-5e1e-45ec-bbd7-bc4faeab3236][Diffs with only the foreground]]. +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 make the fringe invisible or how to assign to it a +different color. The "fringe" is a small area to the right and left +side of the Emacs window which shows indicators such as for truncation +or continuation lines. -[[#h:b0b31802-0216-427e-b071-1a47adcfe608][Ediff without diff color-coding]]. +#+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. -** Option for org-mode block styles -:properties: -:alt_title: Org mode blocks -:description: Choose among plain, gray, or tinted backgrounds -:custom_id: h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2 -:end: -#+vindex: modus-themes-org-blocks +;; Make the fringe invisible +(setq modus-themes-common-palette-overrides + '((fringe unspecified))) -Brief: Set the overall style of Org code blocks, quotes, and the like. +;; Make the fringe more intense +(setq modus-themes-common-palette-overrides + '((fringe bg-active))) -Symbol: ~modus-themes-org-blocks~ (=choice= type) +;; Make the fringe colorful, but nuanced +(setq modus-themes-common-palette-overrides + '((fringe bg-blue-nuanced))) +#+end_src -Possible values: +**** Make links use subtle or no underlines +:PROPERTIES: +:CUSTOM_ID: h:6c1d1dea-5cbf-4d92-b7bb-570a7a23ffe9 +:END: -1. ~nil~ (default) -2. ~gray-background~ (value ~grayscale~ exists for backward compatibility) -3. ~tinted-background~ (value ~rainbow~ exists for backward compatibility) +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 example, we showcase the special use of the ~unspecified~ symbol +that underline mappings can read correctly. -Nil (the default) means that the block has no background of its own: it -uses the one that applies to the rest of the buffer. In this case, the -delimiter lines have a gray color for their text, making them look -exactly like all other Org properties. +#+begin_src emacs-lisp +;; Subtle underlines +(setq modus-themes-common-palette-overrides + '((underline-link border) + (underline-link-visited border) + (underline-link-symbolic border))) -Option ~gray-background~ applies a subtle gray background to the block's -contents. It also affects the begin and end lines of the block as they -get another shade of gray as their background, which differentiates them -from the contents of the block. All background colors extend to the -edge of the window, giving the area a rectangular, "blocky" -presentation. - -Option ~tinted-background~ uses a slightly colored background for the -contents of the block. The exact color will depend on the programming -language and is controlled by the variable ~org-src-block-faces~ (refer to -the theme's source code for the current association list). For this to -take effect, the Org buffer needs to be restarted with ~org-mode-restart~. -In this scenario, it may be better to inhibit the extension of the -delimiter lines' background to the edge of the window because Org does -not provide a mechanism to update their colors depending on the contents -of the block. Disable the extension of such backgrounds by setting -~org-fontify-whole-block-delimiter-line~ to nil. - -Code blocks use their major mode's colors only when the variable -~org-src-fontify-natively~ is non-~nil~. While quote/verse blocks require -setting ~org-fontify-quote-and-verse-blocks~ to a non-~nil~ value. +;; No underlines +(setq modus-themes-common-palette-overrides + '((underline-link unspecified) + (underline-link-visited unspecified) + (underline-link-symbolic unspecified))) +#+end_src -[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter fontification]]. +**** Make prompts more or less colorful +:PROPERTIES: +:CUSTOM_ID: h:bd75b43a-0bf1-45e7-b8b4-20944ca8b7f8 +:END: -Older versions of the themes provided options ~grayscale~ (or ~greyscale~) -and ~rainbow~. Those will continue to work as they are aliases for -~gray-background~ and ~tinted-background~, respectively. +This section contains practical examples of overriding the palette of +the themes ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). In the following code +block we show how to add or remove color from prompts. -** Option for Org agenda constructs -:properties: -:alt_title: Org agenda -:description: Control each element in the presentation of the agenda -:custom_id: h:68f481bc-5904-4725-a3e6-d7ecfa7c3dbc -:end: -#+vindex: modus-themes-org-agenda +[[#h:db5a9a7c-2928-4a28-b0f0-6f2b9bd52ba1][Option for command prompt styles]]. -Brief: Control the style of the Org agenda. Multiple parameters are -available, each with its own options. +#+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. -Symbol: ~modus-themes-org-agenda~ (=alist= type, multiple styles) +;; Keep the background unspecified (like the default), but use a faint +;; foreground color. +(setq modus-themes-common-palette-overrides + '((fg-prompt cyan-faint) + (bg-prompt unspecified))) -This is an alist that accepts a =(key . value)= combination. Some values -are specified as a list. Here is a sample, followed by a description of -all possible combinations: +;; Add a nuanced background to prompts that complements their foreground. +(setq modus-themes-common-palette-overrides + '((fg-prompt cyan) + (bg-prompt bg-cyan-nuanced))) -#+begin_src emacs-lisp -(setq modus-themes-org-agenda - '((header-block . (variable-pitch 1.5)) - (header-date . (grayscale workaholic bold-today 1.2)) - (event . (accented italic varied)) - (scheduled . uniform) - (habit . traffic-light))) +;; Add a yellow background and adjust the foreground accordingly. +(setq modus-themes-common-palette-overrides + '((fg-prompt fg-main) + (bg-prompt bg-yellow-subtle))) ; try to replace "subtle" with "intense" #+end_src -A ~header-block~ key applies to elements that concern the headings which -demarcate blocks in the structure of the agenda. By default (a ~nil~ -value) those are rendered in a bold typographic weight, plus a height -that is slightly taller than the default font size. Acceptable values -come in the form of a list that can include either or both of those -properties: +**** Make completion matches more or less colorful +:PROPERTIES: +:CUSTOM_ID: h:d959f789-0517-4636-8780-18123f936f91 +:END: -- ~variable-pitch~ to use a proportionately spaced typeface; +This section contains practical examples of overriding the palette of +the themes ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). Here we demonstrate how +to activate background coloration for completion matches. We show +three different degrees of intensity. + +[[#h:f1c20c02-7b34-4c35-9c65-99170efb2882][Option for completion framework aesthetics]]. + +#+begin_src emacs-lisp +;; These overrides are common to all Modus themes. We also provide +;; theme-specific options, such as `modus-operandi-palette-overrides'. +;; +;; In general, the theme-specific overrides are better for overriding +;; color values, such as redefining what `blue-faint' looks like. The +;; common overrides are best used for changes to semantic color +;; mappings, as we show below. + +;; Add a nuanced background color to completion matches, while keeping +;; their foreground intact (foregrounds do not need to be specified in +;; this case, but we do it for didactic purposes). +(setq modus-themes-common-palette-overrides + '((fg-completion-match-0 blue) + (fg-completion-match-1 magenta-warmer) + (fg-completion-match-2 cyan) + (fg-completion-match-3 red) + (bg-completion-match-0 bg-blue-nuanced) + (bg-completion-match-1 bg-magenta-nuanced) + (bg-completion-match-2 bg-cyan-nuanced) + (bg-completion-match-3 bg-red-nuanced))) + +;; Add intense background colors to completion matches and adjust the +;; foregrounds accordingly. +(setq modus-themes-common-palette-overrides + '((fg-completion-match-0 fg-main) + (fg-completion-match-1 fg-main) + (fg-completion-match-2 fg-main) + (fg-completion-match-3 fg-main) + (bg-completion-match-0 bg-blue-intense) + (bg-completion-match-1 bg-yellow-intense) + (bg-completion-match-2 bg-cyan-intense) + (bg-completion-match-3 bg-red-intense))) + +;; Like the above, but with subtle backgrounds. +(setq modus-themes-common-palette-overrides + '((fg-completion-match-0 fg-main) + (fg-completion-match-1 fg-main) + (fg-completion-match-2 fg-main) + (fg-completion-match-3 fg-main) + (bg-completion-match-0 bg-blue-subtle) + (bg-completion-match-1 bg-yellow-subtle) + (bg-completion-match-2 bg-cyan-subtle) + (bg-completion-match-3 bg-red-subtle))) +#+end_src + +Adding to the above, it is possible to, say, reduce the number of +colors to two: + +#+begin_src emacs-lisp +;; No backgrounds (like the default) and just use two colors. +(setq modus-themes-common-palette-overrides + '((fg-completion-match-0 blue) + (fg-completion-match-1 yellow) + (fg-completion-match-2 blue) + (fg-completion-match-3 yellow) + (bg-completion-match-0 unspecified) + (bg-completion-match-1 unspecified) + (bg-completion-match-2 unspecified) + (bg-completion-match-3 unspecified))) + +;; Again, a two-color style but this time with backgrounds +(setq modus-themes-common-palette-overrides + '((fg-completion-match-0 blue) + (fg-completion-match-1 yellow) + (fg-completion-match-2 blue) + (fg-completion-match-3 yellow) + (bg-completion-match-0 bg-blue-nuanced) + (bg-completion-match-1 bg-yellow-nuanced) + (bg-completion-match-2 bg-blue-nuanced) + (bg-completion-match-3 bg-yellow-nuanced))) +#+end_src + +The user can mix and match to their liking. + +**** Make comments yellow and strings green +:PROPERTIES: +:CUSTOM_ID: h:26f53daa-0065-48dc-88ab-6a718d16cd95 +:END: -- A number as a floating point (e.g. 1.5) to set the height of the text - to that many times the default font height. A float of 1.0 or the - symbol ~no-scale~ have the same effect of making the font the same - height as the rest of the buffer. When neither a number nor - `no-scale' are present, the default is a small increase in height (a - value of 1.15). +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 +previous versions of the themes, we provided an option for yellow-ish +comments and green-ish strings. For some users, those were still not +good enough, as the exact values were hardcoded. Here we show how to +reproduce the effect, but also how to tweak it to one's liking. - Instead of a floating point, an acceptable value can be in the form of - a cons cell like =(height . FLOAT)= or =(height FLOAT)=, where FLOAT - is the given number. +[[#h:c8767172-bf11-4c96-81dc-e736c464fc9c][Make code syntax use the old alt-syntax style]]. -- The symbol of a weight attribute adjusts the font of the heading - accordingly, such as ~light~, ~semibold~, etc. Valid symbols are - defined in the variable ~modus-themes-weights~. The absence of a - weight means that bold will be used by virtue of inheriting the ~bold~ - face. +[[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for code syntax]]. -[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. +#+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. -In case both a number and ~no-scale~ are in the list, the latter takes -precedence. If two numbers are specified, the first one is applied. +;; Yellow comments and green strings like older versions of the Modus +;; themes +(setq modus-themes-common-palette-overrides + '((comment yellow-cooler) + (string green-cooler))) -Example usage: +;; Faint yellow comments and a different shade of green for strings +(setq modus-themes-common-palette-overrides + '((comment yellow-faint) + (string green-warmer))) -#+begin_src emacs-lisp -(header-block . nil) -(header-block . (1.5)) -(header-block . (no-scale)) -(header-block . (variable-pitch 1.5)) -(header-block . (variable-pitch 1.5 semibold)) +;; Green comments and yellow strings, because now the user has the +;; freedom to do it +(setq modus-themes-common-palette-overrides + '((comment green) + (string yellow-cooler))) #+end_src -A ~header-date~ key covers date headings. Dates use only a foreground -color by default (a ~nil~ value), with weekdays and weekends having a -slight difference in hueness. The current date has an added gray -background. This key accepts a list of values that can include any of -the following properties: - -- ~grayscale~ to make weekdays use the main foreground color and - weekends a more subtle gray; - -- ~workaholic~ to make weekdays and weekends look the same in - terms of color; +**** Make code syntax use the old alt-syntax style +:PROPERTIES: +:CUSTOM_ID: h:c8767172-bf11-4c96-81dc-e736c464fc9c +:END: -- ~bold-today~ to apply a bold typographic weight to the current - date; +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 reproduce what previous versions of the +Modus themes provided as a stylistic alternative for code syntax. The +upside of using overrides for this purpose is that we can tweak the +style to our liking, but first let's start with its recreation: + +#+begin_src emacs-lisp +;; These overrides are common to all Modus themes. We also provide +;; theme-specific options, such as `modus-operandi-palette-overrides'. +;; +;; In general, the theme-specific overrides are better for overriding +;; color values, such as redefining what `blue-faint' looks like. The +;; common overrides are best used for changes to semantic color +;; mappings, as we show below. + + +;; The old "alt-syntax" +(setq modus-themes-common-palette-overrides + '((builtin magenta) + (comment fg-dim) + (constant magenta-cooler) + (docstring magenta-faint) + (docmarkup green-faint) + (fnname magenta-warmer) + (keyword cyan) + (preprocessor cyan-cooler) + (string red-cooler) + (type magenta-cooler) + (variable blue-warmer) + (rx-construct magenta-warmer) + (rx-backslash blue-cooler))) +#+end_src + +The "alt-syntax" could optionally use green strings and yellow +comments ([[#h:26f53daa-0065-48dc-88ab-6a718d16cd95][Make comments yellow and strings green]]): + +#+begin_src emacs-lisp +;; Same as above, but with yellow comments and green strings +(setq modus-themes-common-palette-overrides + '((builtin magenta) + (comment yellow-faint) + (constant magenta-cooler) + (docstring green-faint) + (docmarkup magenta-faint) + (fnname magenta-warmer) + (keyword cyan) + (preprocessor cyan-cooler) + (string green-cooler) + (type magenta-cooler) + (variable blue-warmer) + (rx-construct magenta-warmer) + (rx-backslash blue-cooler))) +#+end_src + +The standard "alt-syntax" has red strings. As such, it is interesting +to experiment with faintly red colored comments: + +#+begin_src emacs-lisp +;; Like the old "alt-syntax" but with faint red comments +(setq modus-themes-common-palette-overrides + '((builtin magenta) + (comment red-faint) + (constant magenta-cooler) + (docstring magenta-faint) + (docmarkup green-faint) + (fnname magenta-warmer) + (keyword cyan) + (preprocessor cyan-cooler) + (string red-cooler) + (type magenta-cooler) + (variable blue-warmer) + (rx-construct magenta-warmer) + (rx-backslash blue-cooler))) +#+end_src + +The user can always mix and match styles to their liking. + +[[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for code syntax]]. + +**** Make use of alternative styles for code syntax +:PROPERTIES: +:CUSTOM_ID: h:943063da-7b27-4ba4-9afe-f8fe77652fd1 +:END: -- ~bold-all~ to render all date headings in a bold weight; +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]]). The +idea here is to change how named colors are mapped to code syntax. +Each of the following snippets give the ~modus-themes~ a different +feel while editing code. + +Note that my ~modus-themes~ and ~ef-themes~ do not use the same +palettes, so some things are different. If you copy from the latter +to the former, double-check that the entries exist in the given Modus +theme palette. + +[[#h:26f53daa-0065-48dc-88ab-6a718d16cd95][Make comments yellow and strings green]]. + +[[*Make code syntax use the old alt-syntax style][Make code syntax use the old alt-syntax style]]. + +#+begin_src emacs-lisp +;; These overrides are common to all Modus themes. We also provide +;; theme-specific options, such as `modus-operandi-palette-overrides'. +;; +;; In general, the theme-specific overrides are better for overriding +;; color values, such as redefining what `blue-faint' looks like. The +;; common overrides are best used for changes to semantic color +;; mappings, as we show below. + + +;; Mimic `ef-night' theme (from my `ef-themes') for code syntax +;; highlighting, while still using the Modus colors (and other +;; mappings). +(setq modus-themes-common-palette-overrides + '((builtin green-cooler) + (comment yellow-faint) + (constant magenta-cooler) + (fnname cyan-cooler) + (keyword blue-warmer) + (preprocessor red-warmer) + (docstring cyan-faint) + (string blue-cooler) + (type magenta-cooler) + (variable cyan))) + +;; Mimic `ef-summer' theme (from my `ef-themes') for code syntax +;; highlighting, while still using the Modus colors (and other +;; mappings). +(setq modus-themes-common-palette-overrides + '((builtin magenta) + (comment yellow-faint) + (constant red-cooler) + (fnname magenta-warmer) + (keyword magenta-cooler) + (preprocessor green-warmer) + (docstring cyan-faint) + (string yellow-warmer) + (type cyan-warmer) + (variable blue-warmer))) + +;; Mimic `ef-bio' theme (from my `ef-themes') for code syntax +;; highlighting, while still using the Modus colors (and other +;; mappings). +(setq modus-themes-common-palette-overrides + '((builtin green) + (comment yellow-faint) + (constant blue) + (fnname green-warmer) + (keyword green-cooler) + (preprocessor green) + (docstring green-faint) + (string magenta-cooler) + (type cyan-warmer) + (variable blue-warmer))) + +;; Mimic `ef-trio-light' theme (from my `ef-themes') for code syntax +;; highlighting, while still using the Modus colors (and other +;; mappings). +(setq modus-themes-common-palette-overrides + '((builtin magenta-cooler) + (comment yellow-faint) + (constant magenta-warmer) + (fnname blue-warmer) + (keyword magenta) + (preprocessor red-cooler) + (docstring magenta-faint) + (string green-cooler) + (type cyan-cooler) + (variable cyan-warmer))) +#+end_src + +**** Make matching parenthesis more or less intense +:PROPERTIES: +:CUSTOM_ID: h:259cf8f5-48ec-4b13-8a69-5d6387094468 +:END: -- ~underline-today~ applies an underline to the current date while - removing the background it has by default; +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 code block we show how to change the background of matching +delimiters when ~show-paren-mode~ is enabled. We also demonstrate how +to enable underlines for those highlights. -- A number as a floating point (e.g. 1.2) to set the height of the text - to that many times the default font height. The default is the same - as the base font height (the equivalent of 1.0). Instead of a - floating point, an acceptable value can be in the form of a cons cell - like =(height . FLOAT)= or =(height FLOAT)=, where FLOAT is the given - number. +#+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. -For example: +;; Change the background to a shade of magenta +(setq modus-themes-common-palette-overrides + '((bg-paren-match bg-magenta-intense))) -#+begin_src emacs-lisp -(header-date . nil) -(header-date . (workaholic)) -(header-date . (grayscale bold-all)) -(header-date . (grayscale workaholic)) -(header-date . (grayscale workaholic bold-today)) -(header-date . (grayscale workaholic bold-today scale-heading)) +;; Enable underlines by applying a color to them +(setq modus-themes-common-palette-overrides + '((bg-paren-match bg-magenta-intense) + (underline-paren-match fg-main))) #+end_src -An ~event~ key covers (i) headings with a plain time stamp that are -shown on the agenda, also known as events, (ii) entries imported from -the diary, and (iii) other items that derive from a symbolic expression -or sexp (phases of the moon, holidays, etc.). By default all those look -the same and have a subtle foreground color (the default is a ~nil~ value -or an empty list). This key accepts a list of properties. Those are: - -- ~accented~ applies an accent value to the event's foreground, - replacing the original gray. It makes all entries stand out more. -- ~italic~ adds a slant to the font's forms (italic or oblique forms, - depending on the typeface). -- ~varied~ differentiates between events with a plain time stamp and - entries that are generated from either the diary or a symbolic - expression. It generally puts more emphasis on events. When ~varied~ - is combined with ~accented~, it makes only events use an accent color, - while diary/sexp entries retain their original subtle foreground. - When ~varied~ is used in tandem with ~italic~, it applies a slant only - to diary and sexp entries, not events. And when ~varied~ is the sole - property passed to the ~event~ key, it has the same meaning as the - list (italic varied). The combination of ~varied~, ~accented~, - ~italic~ covers all of the aforementioned cases. +**** Make box buttons more or less gray +:PROPERTIES: +:CUSTOM_ID: h:4f6b6ca3-f5bb-4830-8312-baa232305360 +:END: -For example: +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]]). By +default, the boxed buttons that appear in {{{kbd(M-x customize)}}} and +related are distinct shades of gray. The following set of overrides +removes the gray from the active buttons and amplifies it for the +inactive ones. #+begin_src emacs-lisp -(event . nil) -(event . (italic)) -(event . (accented italic)) -(event . (accented italic varied)) +;; These overrides are common to all Modus themes. We also provide +;; theme-specific options, such as `modus-operandi-palette-overrides'. +;; +;; In general, the theme-specific overrides are better for overriding +;; color values, such as redefining what `blue-faint' looks like. The +;; common overrides are best used for changes to semantic color +;; mappings, as we show below. + +(setq modus-themes-common-palette-overrides + '((bg-button-active bg-main) + (fg-button-active fg-main) + (bg-button-inactive bg-inactive) + (fg-button-inactive "gray50"))) #+end_src -A ~scheduled~ key applies to tasks with a scheduled date. By default (a -~nil~ value), those use varying shades of yellow to denote (i) a past or -current date and (ii) a future date. Valid values are symbols: +**** Make TODO and DONE more or less intense +:PROPERTIES: +:CUSTOM_ID: h:b57bb50b-a863-4ea8-bb38-6de2275fa868 +:END: -- ~nil~ (default); -- ~uniform~ to make all scheduled dates the same color; -- ~rainbow~ to use contrasting colors for past, present, future - scheduled dates. +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 just the =TODO= and =DONE= keywords that we +encounter in Org buffers. The idea is to make those pop out more or +to subdue them. -For example: +[[#h:11297984-85ea-4678-abe9-a73aeab4676a][Make headings more or less colorful]]. + +[[#h:bb5b396f-5532-4d52-ab13-149ca24854f1][Make inline code in prose use alternative styles]]. #+begin_src emacs-lisp -(scheduled . nil) -(scheduled . uniform) -(scheduled . rainbow) -#+end_src +;; These overrides are common to all Modus themes. We also provide +;; theme-specific options, such as `modus-operandi-palette-overrides'. +;; +;; In general, the theme-specific overrides are better for overriding +;; color values, such as redefining what `blue-faint' looks like. The +;; common overrides are best used for changes to semantic color +;; mappings, as we show below. -A ~habit~ key applies to the ~org-habit~ graph. All possible value are -passed as a symbol. Those are: - -- The default (~nil~) is meant to conform with the original aesthetic of - ~org-habit~. It employs all four color codes that correspond to the - org-habit states---clear, ready, alert, and overdue---while - distinguishing between their present and future variants. This - results in a total of eight colors in use: red, yellow, green, blue, - in tinted and shaded versions. They cover the full set of information - provided by the ~org-habit~ consistency graph. -- ~simplified~ is like the default except that it removes the dichotomy - between current and future variants by applying uniform color-coded - values. It applies a total of four colors: red, yellow, green, blue. - They produce a simplified consistency graph that is more legible (or - less busy) than the default. The intent is to shift focus towards the - distinction between the four states of a habit task, rather than each - state's present/future outlook. -- ~traffic-light~ further reduces the available colors to red, yellow, and - green. As in ~simplified~, present and future variants appear - uniformly, but differently from it, the ~clear~ state is rendered in a - green hue, instead of the original blue. This is meant to capture the - use-case where a habit task being too early is less important than it - being too late. The difference between ready and clear states is - attenuated by painting both of them using shades of green. This - option thus highlights the alert and overdue states. -- When ~modus-themes-deuteranopia~ is non-~nil~ the exact style of the habit - graph adapts to the needs of users with red-green color deficiency by - substituting every instance of green with blue or cyan (depending on - the specifics). - -[[#h:3ed03a48-20d8-4ce7-b214-0eb7e4c79abe][Option for red-green color deficiency or deuteranopia]]. +;; Increase intensity +(setq modus-themes-common-palette-overrides + '((prose-done green-intense) + (prose-todo red-intense))) -For example: +;; Tone down intensity +(setq modus-themes-common-palette-overrides + '((prose-done green-faint) ; OR replace `green-faint' with `olive' + (prose-todo red-faint))) ; OR replace `red-faint' with `rust' -#+begin_src emacs-lisp -(habit . nil) -(habit . simplified) -(habit . traffic-light) +;; Keep TODO at its default (so no override for it), but make DONE +;; gray. +(setq modus-themes-common-palette-overrides + '((prose-done fg-dim))) #+end_src -Putting it all together, the alist can look like this: +**** Make headings more or less colorful +:PROPERTIES: +:CUSTOM_ID: h:11297984-85ea-4678-abe9-a73aeab4676a +:END: -#+begin_src emacs-lisp -'((header-block . (1.5 variable-pitch)) - (header-date . (grayscale workaholic bold-today)) - (event . (accented varied)) - (scheduled . uniform) - (habit . traffic-light)) - -;; Or else: -(setq modus-themes-org-agenda - '((header-block . (1.5 variable-pitch)) - (header-date . (grayscale workaholic bold-today)) - (event . (accented varied)) - (scheduled . uniform) - (habit . traffic-light))) -#+end_src +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 alter the looks of headings, such as in Org mode. +Using overrides here offers far more flexibility than what we could +achieve with previous versions of the themes: the user can mix and +match styles at will. + +[[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more intense]]. + +#+begin_src emacs-lisp +;; These overrides are common to all Modus themes. We also provide +;; theme-specific options, such as `modus-operandi-palette-overrides'. +;; +;; In general, the theme-specific overrides are better for overriding +;; color values, such as redefining what `blue-faint' looks like. The +;; common overrides are best used for changes to semantic color +;; mappings, as we show below. + + +;; Apply more colorful foreground to some headings (headings 0-8). +;; Level 0 is for Org #+title and related. +(setq modus-themes-common-palette-overrides + '((fg-heading-1 blue-warmer) + (fg-heading-2 yellow-cooler) + (fg-heading-3 cyan-cooler))) + +;; Like the above, but with gradient colors +(setq modus-themes-common-palette-overrides + '((fg-heading-1 blue) + (fg-heading-2 cyan) + (fg-heading-3 green))) + +;; Add color to level 1 heading, but use the main foreground for +;; others +(setq modus-themes-common-palette-overrides + '((fg-heading-1 blue) + (fg-heading-2 fg-main) + (fg-heading-3 fg-main))) + +;; Apply colorful foreground, background, and overline (headings 0-8) +(setq modus-themes-common-palette-overrides + '((fg-heading-1 blue-warmer) + (bg-heading-1 bg-blue-nuanced) + (overline-heading-1 blue))) + +;; Apply gray scale foreground, background, and overline (headings 0-8) +(setq modus-themes-common-palette-overrides + '((fg-heading-1 fg-main) + (bg-heading-1 bg-dim) + (overline-heading-1 border))) +#+end_src + +**** Make Org agenda more or less colorful +:PROPERTIES: +:CUSTOM_ID: h:a5af0452-a50f-481d-bf60-d8143f98105f +:END: -** Option for the headings' overall style -:properties: -:alt_title: Heading styles -:description: Choose among several styles, also per heading level -:custom_id: h:271eff19-97aa-4090-9415-a6463c2f9ae1 -:end: -#+vindex: modus-themes-headings +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 provide three distinct code blocks. The first adds +alternative and more varied colors to the Org agenda (and related). +The second uses faint coloration. The third makes the agenda use +various shades of blue. Mix and match at will, while also combining +these styles with what we show in the other chapters with practical +stylistic variants. + +#+begin_src emacs-lisp +;; These overrides are common to all Modus themes. We also provide +;; theme-specific options, such as `modus-operandi-palette-overrides'. +;; +;; In general, the theme-specific overrides are better for overriding +;; color values, such as redefining what `blue-faint' looks like. The +;; common overrides are best used for changes to semantic color +;; mappings, as we show below. + +;; Make the Org agenda use alternative and varied colors. +(setq modus-themes-common-palette-overrides + '((date-common cyan) ; default value (for timestamps and more) + (date-deadline red-warmer) + (date-event magenta-warmer) + (date-holiday blue) ; for M-x calendar + (date-now yellow-warmer) + (date-scheduled magenta-cooler) + (date-weekday cyan-cooler) + (date-weekend blue-faint))) +#+end_src + +An example with faint coloration: + +#+begin_src emacs-lisp +;; Make the Org agenda use faint colors. +(setq modus-themes-common-palette-overrides + '((date-common cyan-faint) ; for timestamps and more + (date-deadline red-faint) + (date-event fg-alt) ; default + (date-holiday magenta) ; default (for M-x calendar) + (date-now fg-main) ; default + (date-scheduled yellow-faint) + (date-weekday fg-dim) + (date-weekend fg-dim))) +#+end_src + +A third example that makes the agenda more blue: + +#+begin_src emacs-lisp +;; Make the Org agenda use more blue instead of yellow and red. +(setq modus-themes-common-palette-overrides + '((date-common cyan) ; default value (for timestamps and more) + (date-deadline blue-cooler) + (date-event blue-faint) + (date-holiday blue) ; for M-x calendar + (date-now blue-faint) + (date-scheduled blue) + (date-weekday fg-main) + (date-weekend fg-dim))) +#+end_src + +**** Make inline code in prose use alternative styles +:PROPERTIES: +:CUSTOM_ID: h:bb5b396f-5532-4d52-ab13-149ca24854f1 +:END: -Brief: Heading styles with optional list of values for levels 0-8. +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 +the following code block we show how to affect constructs such as +Org's verbatim, code, and macro entries. We also provide mappings for +tables, property drawers, tags, and code block delimiters, though we +do not show every possible permutation. + +[[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more or less intense]]. + +#+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. + + +;; These are all the mappings at their default values for didactic +;; purposes +(setq modus-themes-common-palette-overrides + '((prose-block fg-dim) + (prose-code green-cooler) + (prose-done green) + (prose-macro magenta-cooler) + (prose-metadata fg-dim) + (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-tag magenta-faint) + (prose-todo red) + (prose-verbatim magenta-warmer))) + +;; Make code block delimiters use a shade of red, tone down verbatim, +;; code, and macro, and amplify the style of property drawers +(setq modus-themes-common-palette-overrides + '((prose-block red-faint) + (prose-code fg-dim) + (prose-macro magenta-faint) + (prose-metadata cyan) + (prose-metadata-value green-warmer) + (prose-verbatim fg-dim))) + +;; Like the above but with more color variety for the inline code +;; elements +(setq modus-themes-common-palette-overrides + '((prose-block red-faint) + (prose-code blue-cooler) + (prose-macro yellow-warmer) + (prose-metadata cyan) + (prose-metadata-value green-warmer) + (prose-verbatim red-warmer))) +#+end_src + +**** Make mail citations and headers more or less colorful +:PROPERTIES: +:CUSTOM_ID: h:7da7a4ad-5d3a-4f11-9796-5a1abed0f0c4 +:END: -Symbol: ~modus-themes-headings~ (=alist= type, multiple properties) +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 the coloration of email message +headers and citations. Before we show the code, this is the anatomy +of a message: + +#+begin_example message +From: Protesilaos <info@protesilaos.com> +To: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> +Subject: Test subject +--- Headers above this line; message and citations below --- +This is some sample text + +> > Older quote +> Newer quote +#+end_example -This is an alist that accepts a =(key . list-of-values)= combination. -The key is either a number, representing the heading's level (0-8) or t, -which pertains to the fallback style. +We thus have the following: + +#+begin_src emacs-lisp +;; These overrides are common to all Modus themes. We also provide +;; theme-specific options, such as `modus-operandi-palette-overrides'. +;; +;; In general, the theme-specific overrides are better for overriding +;; color values, such as redefining what `blue-faint' looks like. The +;; common overrides are best used for changes to semantic color +;; mappings, as we show below. + + +;; Reduce the intensity of mail citations and headers +(setq modus-themes-common-palette-overrides + '((mail-cite-0 cyan-faint) + (mail-cite-1 yellow-faint) + (mail-cite-2 green-faint) + (mail-cite-3 red-faint) + (mail-part olive) + (mail-recipient indigo) + (mail-subject maroon) + (mail-other slate))) + +;; Make mail citations more intense; adjust the headers accordingly +(setq modus-themes-common-palette-overrides + '((mail-cite-0 blue) + (mail-cite-1 yellow) + (mail-cite-2 green) + (mail-cite-3 magenta) + (mail-part magenta-cooler) + (mail-recipient cyan) + (mail-subject red-warmer) + (mail-other cyan-cooler))) + +;; Make all citations faint and neutral; make most headers green but +;; use red for the subject lie so that it stands out +(setq modus-themes-common-palette-overrides + '((mail-cite-0 fg-dim) + (mail-cite-1 fg-alt) + (mail-cite-2 fg-dim) + (mail-cite-3 fg-alt) + (mail-part yellow-cooler) + (mail-recipient green-cooler) + (mail-subject red-cooler) + (mail-other green))) +#+end_src + +**** Make the region preserve text colors, plus other styles +:PROPERTIES: +:CUSTOM_ID: h:c8605d37-66e1-42aa-986e-d7514c3af6fe +:END: -Level 0 is a special heading: it is used for what counts as a document -title or equivalent, such as the =#+title= construct we find in Org -files. Levels 1-8 are regular headings. +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 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. -The list of values covers symbols that refer to properties, as described -below. Here is a complete sample, followed by a presentation of all -available properties: +[[#h:a5140c9c-18b2-45db-8021-38d0b5074116][Do not extend the region background]]. #+begin_src emacs-lisp -(setq modus-themes-headings - '((1 . (background overline variable-pitch 1.5)) - (2 . (overline rainbow 1.3)) - (3 . (overline 1.1)) - (t . (monochrome)))) -#+end_src +;; 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. -Properties: -+ ~rainbow~ -+ ~overline~ -+ ~background~ -+ ~monochrome~ -+ A font weight, which must be supported by the underlying typeface: - - ~thin~ - - ~ultralight~ - - ~extralight~ - - ~light~ - - ~semilight~ - - ~regular~ - - ~medium~ - - ~semibold~ - - ~bold~ - - ~heavy~ - - ~extrabold~ - - ~ultrabold~ -+ ~no-bold~ (deprecated alias of a ~regular~ weight) -+ A floating point as a height multiple of the default or a cons cell in - the form of =(height . FLOAT)=. +;; A background with no specific foreground (use foreground of +;; underlying text) +(setq modus-themes-common-palette-overrides + '((bg-region bg-ochre) ; try to replace `bg-ochre' with `bg-lavender', `bg-sage' + (fg-region unspecified))) -By default (a ~nil~ value for this variable), all headings have a bold -typographic weight and use a desaturated text color. +;; Subtle gray with a prominent blue foreground +(setq modus-themes-common-palette-overrides + '((bg-region bg-dim) + (fg-region blue-cooler))) -A ~rainbow~ property makes the text color more saturated. - -An ~overline~ property draws a line above the area of the heading. - -A ~background~ property adds a subtle tinted color to the background of -the heading. - -A ~monochrome~ property makes the heading the same as the base color, -which is that of the ~default~ face's foreground. When ~background~ is also -set, ~monochrome~ changes its color to gray. If both ~monochrome~ and -~rainbow~ are set, the former takes precedence. +;; Intense magenta background combined with the main foreground +(setq modus-themes-common-palette-overrides + '((bg-region bg-magenta-intense) + (fg-region fg-main))) +#+end_src -A ~variable-pitch~ property changes the font family of the heading to that -of the ~variable-pitch~ face (normally a proportionately spaced typeface). +**** Make mouse highlights more or less colorful +:PROPERTIES: +:CUSTOM_ID: h:b5cab69d-d7cb-451c-8ff9-1f545ceb6caf +:END: -The symbol of a weight attribute adjusts the font of the heading -accordingly, such as ~light~, ~semibold~, etc. Valid symbols are -defined in the variable ~modus-themes-weights~. The absence of a weight -means that bold will be used by virtue of inheriting the ~bold~ face. -For backward compatibility, the ~no-bold~ value is accepted, though -users are encouraged to specify a ~regular~ weight instead. +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 +the following code block we show how to affect the semantic color +mapping that covers mouse hover effects and related highlights: -[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. +#+begin_src emacs-lisp +;; These overrides are common to all Modus themes. We also provide +;; theme-specific options, such as `modus-operandi-palette-overrides'. +;; +;; In general, the theme-specific overrides are better for overriding +;; color values, such as redefining what `blue-faint' looks like. The +;; common overrides are best used for changes to semantic color +;; mappings, as we show below. -A number, expressed as a floating point (e.g. 1.5), adjusts the height -of the heading to that many times the base font size. The default -height is the same as 1.0, though it need not be explicitly stated. -Instead of a floating point, an acceptable value can be in the form of a -cons cell like =(height . FLOAT)= or =(height FLOAT)=, where FLOAT is -the given number. -Combinations of any of those properties are expressed as a list, like in -these examples: +;; Make the background an intense yellow +(setq modus-themes-common-palette-overrides + '((bg-hover bg-yellow-intense))) -#+begin_src emacs-lisp -(semibold) -(rainbow background) -(overline monochrome semibold 1.3) -(overline monochrome semibold (height 1.3)) ; same as above -(overline monochrome semibold (height . 1.3)) ; same as above +;; Make the background subtle green +(setq modus-themes-common-palette-overrides + '((bg-hover bg-green-subtle))) #+end_src -The order in which the properties are set is not significant. +**** Make language underlines less colorful +:PROPERTIES: +:CUSTOM_ID: h:03dbd5af-6bae-475e-85a2-cec189f69598 +:END: -In user configuration files the form may look like this: +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 color of the underlines that are used +by code linters and prose spell checkers. #+begin_src emacs-lisp -(setq modus-themes-headings - '((1 . (background overline rainbow 1.5)) - (2 . (background overline 1.3)) - (t . (overline semibold)))) -#+end_src +;; 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. -When defining the styles per heading level, it is possible to pass a -non-~nil~ value (~t~) instead of a list of properties. This will retain the -original aesthetic for that level. For example: -#+begin_src emacs-lisp -(setq modus-themes-headings - '((1 . t) ; keep the default style - (2 . (background overline)) - (t . (rainbow)))) ; style for all other headings +;; Make the underlines less intense +(setq modus-themes-common-palette-overrides + '((underline-err red-faint) + (underline-warning yellow-faint) + (underline-note cyan-faint))) -(setq modus-themes-headings - '((1 . (background overline)) - (2 . (rainbow semibold)) - (t . t))) ; default style for all other levels +;; Change the color-coding of the underlines +(setq modus-themes-common-palette-overrides + '((underline-err yellow-intense) + (underline-warning magenta-intense) + (underline-note green-intense))) #+end_src -For Org users, the extent of the heading depends on the variable -~org-fontify-whole-heading-line~. This affects the ~overline~ and -~background~ properties. Depending on the version of Org, there may be -others, such as ~org-fontify-done-headline~. +**** Make line numbers use alternative styles +:PROPERTIES: +:CUSTOM_ID: h:b6466f51-cb58-4007-9ebe-53a27af655c7 +:END: -** Option for variable-pitch font in UI elements -:properties: -:alt_title: UI typeface -:description: Toggle the use of variable-pitch across the User Interface -:custom_id: h:16cf666c-5e65-424c-a855-7ea8a4a1fcac -:end: -#+vindex: modus-themes-variable-pitch-ui +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 affect the ~display-line-numbers-mode~. -Brief: Toggle the use of proportionately spaced (~variable-pitch~) fonts -in the User Interface. +#+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. -Symbol: ~modus-themes-variable-pitch-ui~ (=boolean= type) -Possible values: +;; Make line numbers less intense +(setq modus-themes-common-palette-overrides + '((fg-line-number-inactive "gray50") + (fg-line-number-active fg-main) + (bg-line-number-inactive unspecified) + (bg-line-number-active unspecified))) -1. ~nil~ (default) -2. ~t~ +;; Like the above, but use a shade of red for the current line number +(setq modus-themes-common-palette-overrides + '((fg-line-number-inactive "gray50") + (fg-line-number-active red-cooler) + (bg-line-number-inactive unspecified) + (bg-line-number-active unspecified))) -This option concerns User Interface elements that are under the direct -control of Emacs. In particular: the mode line, header line, tab bar, -and tab line. +;; Make all numbers more intense, use a more pronounce gray +;; background, and make the current line have a colored background +(setq modus-themes-common-palette-overrides + '((fg-line-number-inactive fg-main) + (fg-line-number-active fg-main) + (bg-line-number-inactive bg-inactive) + (bg-line-number-active bg-cyan-intense))) +#+end_src -The default is to use the same font as the rest of Emacs, which usually -is a monospaced family. +**** Make diffs use only a foreground +:PROPERTIES: +:CUSTOM_ID: h:b3761482-bcbf-4990-a41e-4866fb9dad15 +:END: -With a non-~nil~ value (~t~) apply a proportionately spaced typeface. This -is done by assigning the ~variable-pitch~ face to the relevant items. +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: -[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. +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: @@ -2220,7 +2434,7 @@ the background). It thus falls back to the closest approximation, which seldom is appropriate for the purposes of the Modus themes. In such a case, the user is expected to update their terminal's color -palette such as by adapting these resources: +palette such as by adapting these resources ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]): #+begin_src emacs-lisp ! Theme: modus-operandi @@ -2268,27 +2482,46 @@ xterm*color14: #6ae4b9 xterm*color15: #ffffff #+end_src -** Visualize the active Modus theme's palette +** Preview theme colors :properties: :custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d :end: +#+cindex: Preview named colors or semantic color mappings + #+findex: modus-themes-list-colors +The command ~modus-themes-list-colors~ uses minibuffer completion to +select an item from the Modus themes and then produces a buffer with +previews of its color palette entries. The buffer has a naming scheme +that reflects the given choice, like =modus-operandi-list-colors= for +the ~modus-operandi~ theme. + #+findex: modus-themes-list-colors-current -#+cindex: Preview color values +The command ~modus-themes-list-colors-current~ skips the minibuffer +selection process and just produces a preview for the current Modus +theme. -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 each variable in the given theme's color palette. The -command ~modus-themes-list-colors-current~ skips the prompt, using the -current Modus theme. +When called with a prefix argument (=C-u= with the default key +bindings), these commands will show a preview of the palette's +semantic color mappings instead of the named colors. In this context, +"named colors" are entries that associate a symbol to a string color +value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color +mappings" associate a named color to a symbol, like =(string +blue-warmer)=, thus making the theme render all string constructs in +the =blue-warmer= color value ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). + +#+findex: modus-themes-preview-colors +#+findex: modus-themes-preview-colors-current +Aliases for those commands are ~modus-themes-preview-colors~ and +~modus-themes-preview-colors-current~. Each row shows a foreground and background coloration using the underlying value it references. For example a line with =#a60000= (a shade of red) will show red text followed by a stripe with that same color as a backdrop. -The name of the buffer describes the given Modus theme. It is thus -called =*modus-operandi-list-colors*= or =*modus-vivendi-list-colors*=. +The name of the buffer describes the given Modus theme and what the +contents are, such as =*modus-operandi-list-colors*= for named colors +and ==*modus-operandi-list-mappings*= for the semantic color mappings. ** Per-theme customization settings :properties: @@ -2306,12 +2539,12 @@ other). (defun my-demo-modus-operandi () (interactive) (setq modus-themes-bold-constructs t) ; ENABLE bold - (modus-themes-load-operandi)) + (modus-themes-load-theme 'modus-operandi)) (defun my-demo-modus-vivendi () (interactive) (setq modus-themes-bold-constructs nil) ; DISABLE bold - (modus-themes-load-vivendi)) + (modus-themes-load-theme 'modus-vivendi)) (defun my-demo-modus-themes-toggle () (if (eq (car custom-enabled-themes) 'modus-operandi) @@ -2325,232 +2558,188 @@ equivalent the themes provide. For a more elaborate design, it is better to inspect the source code of ~modus-themes-toggle~ and relevant functions. -** Case-by-case face specs using the themes' palette -:properties: -:custom_id: h:1487c631-f4fe-490d-8d58-d72ffa3bd474 -:end: -#+findex: modus-themes-color -#+findex: modus-themes-color-alts -#+cindex: Extracting individual colors +** Get a single color from the palette +:PROPERTIES: +:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e +:END: -This section is about tweaking individual faces. If you plan to do -things at scale, consult the next section: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Set multiple faces]]. +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. -We already covered in previous sections how to toggle between the themes -and how to configure options prior to loading. We also explained that -some of the functions made available to users will fire up a hook that -can be used to pass tweaks in the post-theme-load phase. +#+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=. -Now assume you wish to change a single face, say, the ~cursor~. And you -would like to get the standard "blue" color value of the active Modus -theme, whether it is Modus Operandi or Modus Vivendi. To do that, you -can use the ~modus-themes-color~ function. It accepts a symbol that is -associated with a color in ~modus-themes-operandi-colors~ and -~modus-themes-vivendi-colors~. Like this: +=COLOR= is a symbol that represents a named color entry in the +palette. -#+begin_src emacs-lisp -(modus-themes-color 'blue) -#+end_src +[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]. -The function always extracts the color value of the active Modus theme. +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. -#+begin_src emacs-lisp -(progn - (load-theme 'modus-operandi t) - (modus-themes-color 'blue)) ; "#0031a9" for `modus-operandi' +With an optional =OVERRIDES= argument as a non-nil value, it accounts +for palette overrides. Else it reads only the default palette. -(progn - (load-theme 'modus-vivendi t) - (modus-themes-color 'blue)) ; "#2fafff" for `modus-vivendi' -#+end_src +[[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]. -Do {{{kbd(C-h v)}}} on the aforementioned variables to check all the available -symbols that can be passed to this function. Or simply invoke the -command ~modus-themes-list-colors~ to produce a buffer with a preview of -each entry in the palette. +With optional =THEME= as a symbol among ~modus-themes-items~, use the +palette of that item. Else use the current Modus theme. -[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Visualize the active Modus theme's palette]]. +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. -With that granted, let us expand the example to actually change the -~cursor~ face's background property. We employ the built-in function of -~set-face-attribute~: +An example with ~modus-operandi~ to show how this function behaves +with/without overrides and when recursive mappings are introduced. #+begin_src emacs-lisp -(set-face-attribute 'cursor nil :background (modus-themes-color 'blue)) -#+end_src - -If you evaluate this form, your cursor will become blue. But if you -change themes, such as with ~modus-themes-toggle~, your edits will be -lost, because the newly loaded theme will override the ~:background~ -attribute you had assigned to that face. +;; 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))) -For such changes to persist, we need to make them after loading the -theme. So we rely on ~modus-themes-after-load-theme-hook~, which gets -called from ~modus-themes-load-operandi~, ~modus-themes-load-vivendi~, as -well as the command ~modus-themes-toggle~. Here is a sample function that -tweaks two faces and then gets added to the hook: +;; Ignore the overrides and get the original value. +(modus-themes-get-color-value 'border-mode-line-active) +;; => "#5a5a5a" -#+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () - (set-face-attribute 'cursor nil :background (modus-themes-color 'blue)) - (set-face-attribute 'font-lock-type-face nil :foreground (modus-themes-color 'magenta-alt))) - -(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) +;; 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 -[[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]. +** 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 -Using this principle, it is possible to override the styles of faces -without having to find color values for each case. +[[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette]]. -Another application is to control the precise weight for bold -constructs. This is particularly useful if your typeface has several -variants such as "heavy", "extrabold", "semibold". All you have to do -is edit the ~bold~ face. For example: +Note that users most probably do not need the following. Just rely on +the comprehensive overrides we provide ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). + +#+findex: modus-themes-with-colors +Advanced users may want to apply colors from the palette of the active +Modus theme in their custom code. The ~modus-themes-with-colors~ +macro supplies those to any form called inside of it. For example: #+begin_src emacs-lisp -(set-face-attribute 'bold nil :weight 'semibold) +(modus-themes-with-colors + (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) +;; => ("#354fcf" "#531ab6" "#005000" "#884900" "#005e8b" "#721045") #+end_src -Remember to use the custom function and hook combo we demonstrated -above. Because the themes do not hard-wire a specific weight, this -simple form is enough to change the weight of all bold constructs -throughout the interface. - -Finally, there are cases where you want to tweak colors though wish to -apply different ones to each theme, say, a blue hue for Modus Operandi -and a shade of red for Modus Vivendi. To this end, we provide -~modus-themes-color-alts~ as a convenience function to save you from the -trouble of writing separate wrappers for each theme. It still returns a -single value by querying either of ~modus-themes-operandi-colors~ and -~modus-themes-vivendi-colors~, only here you pass the two keys you want, -first for ~modus-operandi~ then ~modus-vivendi~. - -Take the previous example with the ~cursor~ face: +The above return value is for ~modus-operandi~ when that is the active +theme. Switching to another theme and evaluating this code anew will +give us the relevant results for that theme (remember that since +version 4, the Modus themes consist of six items ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]])). The +same with ~modus-vivendi~ as the active theme: #+begin_src emacs-lisp -;; Blue for `modus-operandi' and red for `modus-vivendi' -(set-face-attribute 'cursor nil :background (modus-themes-color-alts 'blue 'red)) +(modus-themes-with-colors + (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) +;; => ("#79a8ff" "#b6a0ff" "#a0e0a0" "#fec43f" "#00d3d0" "#feacd0") #+end_src -** Face specs at scale using the themes' palette -:properties: -:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae -:end: -#+findex: modus-themes-with-colors -#+cindex: Extracting colors en masse +The ~modus-themes-with-colors~ has access to the whole palette of the +active theme, meaning that it can instantiate both (i) named colors +like =blue-warmer= and (ii) semantic color mappings like =warning=. +We provide commands to inspect those ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]). -The examples here are for large scale operations. For simple, one-off -tweaks, you may prefer the approach documented in the previous section -([[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Case-by-case face specs using the themes' palette]]). +Others sections in this manual show how to use the aforementioned +macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). -The ~modus-themes-with-colors~ macro lets you retrieve multiple color -values by employing the backquote/backtick and comma notation. The -values are stored in the alists ~modus-themes-operandi-colors~ and -~modus-themes-vivendi-colors~, while the macro always queries that of the -active Modus theme (preview the current palette with the command -~modus-themes-list-colors~). +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~. -[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Visualize the active Modus theme's palette]]. +** Do not extend the region background +:PROPERTIES: +:CUSTOM_ID: h:a5140c9c-18b2-45db-8021-38d0b5074116 +:END: -Here is an abstract example that just returns a list of color values -while ~modus-operandi~ is enabled: +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 -(modus-themes-with-colors - (list fg-main - blue-faint - magenta - magenta-alt-other - cyan-alt-other - fg-special-cold - blue-alt - magenta-faint - cyan - fg-main - green-faint - red-alt-faint - blue-alt-faint - fg-special-warm - cyan-alt - blue)) -;; => -;; ("#000000" "#002f88" "#721045" "#5317ac" -;; "#005a5f" "#093060" "#2544bb" "#752f50" -;; "#00538b" "#000000" "#104410" "#702f00" -;; "#003f78" "#5d3026" "#30517f" "#0031a9") +;; Do not extend `region' background past the end of the line. +(custom-set-faces + '(region ((t :extend nil)))) #+end_src -Getting a list of colors may have its applications, though what you are -most likely interested in is how to use those variables to configure -several faces at once. To do so we can rely on the built-in -~custom-set-faces~ function, which sets face specifications for the -special ~user~ theme. That "theme" gets applied on top of regular themes -like ~modus-operandi~ and ~modus-vivendi~. - -This is how it works: +[[#h:c8605d37-66e1-42aa-986e-d7514c3af6fe][Make the region preserve text colors, plus other styles]]. -#+begin_src emacs-lisp -(modus-themes-with-colors - (custom-set-faces - `(cursor ((,class :background ,blue))) - `(mode-line ((,class :background ,yellow-nuanced-bg - :foreground ,yellow-nuanced-fg))) - `(mode-line-inactive ((,class :background ,blue-nuanced-bg - :foreground ,blue-nuanced-fg))))) -#+end_src +** Add padding to mode line +:PROPERTIES: +:CUSTOM_ID: h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c +:END: -The above snippet will immediately refashion the faces it names once it -is evaluated. However, if you switch between the Modus themes, say, -from ~modus-operandi~ to ~modus-vivendi~, the colors will not get updated to -match those of the new theme. To make things work across the themes, we -need to employ the same technique we discussed in the previous section, -namely, to pass our changes at the post-theme-load phase via a hook. +Emacs faces do not have a concept of "padding" for the space between +the text and its box boundaries. We can approximate the effect by +adding a =:box= attribute, making its border several pixels thick, and +using the mode line's background color for it. This way the thick +border will not stand out and will appear as a continuation of the +mode line. -The themes provide the ~modus-themes-after-load-theme-hook~, which gets -called from ~modus-themes-load-operandi~, ~modus-themes-load-vivendi~, as -well as the command ~modus-themes-toggle~. With this knowledge, you can -wrap the macro in a function and then assign that function to the hook. -Thus: +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. #+begin_src emacs-lisp (defun my-modus-themes-custom-faces () (modus-themes-with-colors (custom-set-faces - `(cursor ((,class :background ,blue))) - `(mode-line ((,class :background ,yellow-nuanced-bg - :foreground ,yellow-nuanced-fg))) - `(mode-line-inactive ((,class :background ,blue-nuanced-bg - :foreground ,blue-nuanced-fg)))))) + ;; Add "padding" to the mode lines + `(mode-line ((,c :box (:line-width 10 :color ,bg-mode-line-active)))) + `(mode-line-inactive ((,c :box (:line-width 10 :color ,bg-mode-line-inactive))))))) (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src -[[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]. - -To discover the faces defined by all loaded libraries, you may do -{{{kbd(M-x list-faces-display)}}}. Be warned that when you ~:inherit~ a face -you are introducing an implicit dependency, so try to avoid doing so for -libraries other than the built-in {{{file(faces.el)}}} (or at least understand -that things may break if you inherit from a yet-to-be-loaded face). +The above has the effect of removing the border around the mode lines. +In older versions of the themes, we provided the option for a padded +mode line which could also have borders around it. Those were not +real border, however, but an underline and an overline. Adjusting the +above: -Also bear in mind that these examples are meant to work with the Modus -themes. If you are cycling between multiple themes you may encounter -unforeseen issues, such as the colors of the Modus themes being applied -to a non-Modus item. +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces () + (modus-themes-with-colors + (custom-set-faces + ;; Add "padding" to the mode lines + `(mode-line ((,c :underline ,border-mode-line-active + :overline ,border-mode-line-active + :box (:line-width 10 :color ,bg-mode-line-active)))) + `(mode-line-inactive ((,c :underline ,border-mode-line-inactive + :overline ,border-mode-line-inactive + :box (:line-width 10 :color ,bg-mode-line-inactive))))))) -Finally, note that you can still use other functions where those make -sense. For example, the ~modus-themes-color-alts~ that was discussed in -the previous section. Adapt the above example like this: +;; ESSENTIAL to make the underline move to the bottom of the box: +(setq x-underline-at-descent-line t) -#+begin_src emacs-lisp -... -(modus-themes-with-colors - (custom-set-faces - `(cursor ((,class :background ,(modus-themes-color-alts 'blue 'green)))) - ...)) +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src +The reason we no longer provide this option is because it depends on a +non-nil value for ~x-underline-at-descent-line~. That variable +affects ALL underlines, including those of links. The effect is +intrusive and looks awkard in prose. + +As such, the Modus themes no longer provide that option but instead +offer this piece of documentation to make the user fully aware of the +state of affairs. + ** Remap face with local value :properties: :custom_id: h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f @@ -2564,7 +2753,7 @@ activates ~hl-line-mode~, but we wish to keep it distinct from other buffers. This is where ~face-remap-add-relative~ can be applied and may be combined with ~modus-themes-with-colors~ to deliver consistent results. -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. In this example we will write a simple interactive function that adjusts the background color of the ~region~ face. This is the sample code: @@ -2572,12 +2761,12 @@ the background color of the ~region~ face. This is the sample code: #+begin_src emacs-lisp (defvar my-rainbow-region-colors (modus-themes-with-colors - `((red . ,red-subtle-bg) - (green . ,green-subtle-bg) - (yellow . ,yellow-subtle-bg) - (blue . ,blue-subtle-bg) - (magenta . ,magenta-subtle-bg) - (cyan . ,cyan-subtle-bg))) + `((red . ,bg-red-subtle) + (green . ,bg-green-subtle) + (yellow . ,bg-yellow-subtle) + (blue . ,bg-blue-subtle) + (magenta . ,bg-magenta-subtle) + (cyan . ,bg-cyan-subtle))) "Sample list of color values for `my-rainbow-region'.") (defun my-rainbow-region (color) @@ -2613,768 +2802,6 @@ Perhaps you may wish to generalize those findings in to a set of functions that also accept an arbitrary face. We shall leave the experimentation up to you. -** Cycle through arbitrary colors -:properties: -:custom_id: h:77dc4a30-b96a-4849-85a8-fee3c2995305 -:end: -#+cindex: Cycle colors - -Users may opt to customize individual faces of the themes to accommodate -their particular needs. One such case is with the color intensity of -comments, specifically the foreground of ~font-lock-comment-face~. The -Modus themes set that to a readable value, in accordance with their -accessibility objective, though users may prefer to lower the overall -contrast on an on-demand basis. - -One way to achieve this is to design a command that cycles through three -distinct levels of intensity, though the following can be adapted to any -kind of cyclic behavior, such as to switch between red, green, and blue. - -In the following example, we employ the ~modus-themes-color~ function -which reads a symbol that represents an entry in the active theme's -color palette ([[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Case-by-case face specs using the themes' palette]]). -Those are stored in ~my-modus-themes-comment-colors~. - -#+begin_src emacs-lisp -(defvar my-modus-themes-comment-colors - ;; We are abusing the palette here, as those colors have their own - ;; purpose in the palette, so please ignore the semantics of their - ;; names. - '((low . bg-region) - (medium . bg-tab-inactive-alt) - (high . fg-alt)) - "Alist of levels of intensity mapped to color palette entries. -The entries are found in `modus-themes-operandi-colors' or -`modus-themes-vivendi-colors'.") - -(defvar my-modus-themes--adjust-comment-color-state nil - "The cyclic state of `my-modus-themes-adjust-comment-color'. -For internal use.") - -(defun my-modus-themes--comment-foreground (degree state) - "Set `font-lock-comment-face' foreground. -Use `my-modus-themes-comment-colors' to extract the color value -for each level of intensity. - -This is complementary to `my-modus-themes-adjust-comment-color'." - (let ((palette-colors my-modus-themes-comment-colors)) - (set-face-foreground - 'font-lock-comment-face - (modus-themes-color (alist-get degree palette-colors))) - (setq my-modus-themes--adjust-comment-color-state state) - (message "Comments are set to %s contrast" degree))) - -(defun my-modus-themes-adjust-comment-color () - "Cycle through levels of intensity for comments. -The levels are determined by `my-modus-themes-comment-colors'." - (interactive) - (pcase my-modus-themes--adjust-comment-color-state - ('nil - (my-modus-themes--comment-foreground 'low 1)) - (1 - (my-modus-themes--comment-foreground 'medium 2)) - (_ - (my-modus-themes--comment-foreground 'high nil)))) -#+end_src - -With the above, {{{kbd(M-x my-modus-themes-adjust-comment-color)}}} will cycle -through the three levels of intensity that have been specified. - -Another approach is to not read from the active theme's color palette -and instead provide explicit color values, either in hexadecimal RGB -notation (like =#123456=) or as the names that are displayed in the output -of {{{kbd(M-x list-colors-display)}}}. In this case, the alist with the -colors will have to account for the active theme, so as to set the -appropriate colors. While this introduces a bit more complexity, it -ultimately offers greater flexibility on the choice of colors for such a -niche functionality (so there is no need to abuse the palette of the -active Modus theme): - -#+begin_src emacs-lisp -(defvar my-modus-themes-comment-colors - '((light . ((low . "gray75") - (medium . "gray50") - (high . "#505050"))) ; the default for `modus-operandi' - - (dark . ((low . "gray25") - (medium . "gray50") - (high . "#a8a8a8")))) ; the default for `modus-vivendi' - "Alist of levels of intensity mapped to color values. -For such colors, consult the command `list-colors-display'. Pass -the name of a color or its hex value.") - -(defvar my-modus-themes--adjust-comment-color-state nil - "The cyclic state of `my-modus-themes-adjust-comment-color'. -For internal use.") - -(defun my-modus-themes--comment-foreground (degree state) - "Set `font-lock-comment-face' foreground. -Use `my-modus-themes-comment-colors' to extract the color value -for each level of intensity. - -This is complementary to `my-modus-themes-adjust-comment-color'." - (let* ((colors my-modus-themes-comment-colors) - (levels (pcase (car custom-enabled-themes) - ('modus-operandi (alist-get 'light colors)) - ('modus-vivendi (alist-get 'dark colors))))) - (set-face-foreground - 'font-lock-comment-face - (alist-get degree levels)) - (setq my-modus-themes--adjust-comment-color-state state) - (message "Comments are set to %s contrast" degree))) - -(defun my-modus-themes-adjust-comment-color () - "Cycle through levels of intensity for comments. -The levels are determined by `my-modus-themes-comment-colors'." - (interactive) - (pcase my-modus-themes--adjust-comment-color-state - ('nil - (my-modus-themes--comment-foreground 'low 1)) - (1 - (my-modus-themes--comment-foreground 'medium 2)) - (_ - (my-modus-themes--comment-foreground 'high nil)))) -#+end_src - -The effect of the above configurations on ~font-lock-comment-face~ is -global. To make it buffer-local, one must tweak the code to employ the -function ~face-remap-add-relative~ ([[#h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f][Remap face with local value]]). - -So this form in ~my-modus-themes--comment-foreground~: - -#+begin_src emacs-lisp -;; example 1 -(... - (set-face-foreground - 'font-lock-comment-face - (modus-themes-color (alist-get degree palette-colors))) - ...) - -;; example 2 -(... - (set-face-foreground - 'font-lock-comment-face - (alist-get degree levels)) - ...) -#+end_src - -Must become this: - -#+begin_src emacs-lisp -;; example 1 -(... - (face-remap-add-relative - 'font-lock-comment-face - `(:foreground ,(modus-themes-color (alist-get degree palette-colors)))) - ...) - -;; example 2 -(... - (face-remap-add-relative - 'font-lock-comment-face - `(:foreground ,(alist-get degree levels))) - ...) -#+end_src - -** Override colors -:properties: -:custom_id: h:307d95dd-8dbd-4ece-a543-10ae86f155a6 -:end: -#+vindex: modus-themes-operandi-color-overrides -#+vindex: modus-themes-vivendi-color-overrides -#+cindex: Change a theme's colors - -The themes provide a mechanism for overriding their color values. This -is controlled by the variables ~modus-themes-operandi-color-overrides~ and -~modus-themes-vivendi-color-overrides~, which are alists that should -mirror a subset of the associations in ~modus-themes-operandi-colors~ and -~modus-themes-vivendi-colors~ respectively. As with all customizations, -overriding must be done before loading the affected theme. - -[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Visualize the active Modus theme's palette]]. - -Let us approach the present topic one step at a time. Here is a -simplified excerpt of the default palette for Modus Operandi with some -basic background values that apply to buffers and the mode line -(remember to inspect the actual value to find out all the associations -that can be overridden): - -#+begin_src emacs-lisp -(defconst modus-themes-operandi-colors - '((bg-main . "#ffffff") - (bg-dim . "#f8f8f8") - (bg-alt . "#f0f0f0") - (bg-active . "#d7d7d7") - (bg-inactive . "#efefef"))) -#+end_src - -As one can tell, we bind a key to a hexadecimal RGB color value. Now -say we wish to override those specific values and have our changes -propagate to all faces that use those keys. We could write something -like this, which adds a subtle ocher tint: - -#+begin_src emacs-lisp -(setq modus-themes-operandi-color-overrides - '((bg-main . "#fefcf4") - (bg-dim . "#faf6ef") - (bg-alt . "#f7efe5") - (bg-active . "#e8dfd1") - (bg-inactive . "#f6ece5"))) -#+end_src - -Once this is evaluated, any subsequent loading of ~modus-operandi~ will -use those values instead of the defaults. No further intervention is -required. - -To reset the changes, we apply this and reload the theme: - -#+begin_src emacs-lisp -(setq modus-themes-operandi-color-overrides nil) -#+end_src - -Users who wish to leverage such a mechanism can opt to implement it -on-demand by means of a global minor mode. The following snippet covers -both themes and expands to some more associations in the palette: - -#+begin_src emacs-lisp -(define-minor-mode my-modus-themes-tinted - "Tweak some Modus themes colors." - :init-value nil - :global t - (if my-modus-themes-tinted - (setq modus-themes-operandi-color-overrides - '((bg-main . "#fefcf4") - (bg-dim . "#faf6ef") - (bg-alt . "#f7efe5") - (bg-hl-line . "#f4f0e3") - (bg-active . "#e8dfd1") - (bg-inactive . "#f6ece5") - (bg-region . "#c6bab1") - (bg-header . "#ede3e0") - (bg-tab-active . "#fdf6eb") - (bg-tab-inactive . "#c8bab8")) - modus-themes-vivendi-color-overrides - '((bg-main . "#100b17") - (bg-dim . "#161129") - (bg-alt . "#181732") - (bg-hl-line . "#191628") - (bg-active . "#282e46") - (bg-inactive . "#1a1e39") - (bg-region . "#393a53") - (bg-header . "#202037") - (bg-tab-active . "#120f18") - (bg-tab-inactive . "#3a3a5a"))) - (setq modus-themes-operandi-color-overrides nil - modus-themes-vivendi-color-overrides nil))) -#+end_src - -A more neutral style for ~modus-themes-operandi-color-overrides~ can -look like this: - -#+begin_src emacs-lisp -'((bg-main . "#f7f7f7") - (bg-dim . "#f2f2f2") - (bg-alt . "#e8e8e8") - (bg-hl-line . "#eaeaef") - (bg-active . "#e0e0e0") - (bg-inactive . "#e6e6e6") - (bg-region . "#b5b5b5") - (bg-header . "#e4e4e4") - (bg-tab-active . "#f5f5f5") - (bg-tab-inactive . "#c0c0c0")) -#+end_src - -With those in place, one can use {{{kbd(M-x my-modus-themes-tinted)}}} -and then load the Modus theme of their choice. The new palette subset -will come into effect: subtle ocher tints (or shades of gray) for Modus -Operandi and night sky blue shades for Modus Vivendi. Switching between -the two themes, such as with {{{kbd(M-x modus-themes-toggle)}}} will -also use the overrides. - -Given that this is a user-level customization, one is free to implement -whatever color values they desire, even if the possible combinations -fall below the minimum 7:1 contrast ratio that governs the design of the -themes (the WCAG AAA legibility standard). Alternatively, this can also -be done programmatically ([[#h:4589acdc-2505-41fc-9f5e-699cfc45ab00][Override color saturation]]). - -The above are expanded into a fully fledged derivative elsewhere in this -document ([[#h:736c0ff5-8c9c-4565-82cf-989e57d07d4a][Override colors completely]]). - -For manual interventions it is advised to inspect the source code of -~modus-themes-operandi-colors~ and ~modus-themes-vivendi-colors~ for the -inline commentary: it explains what the intended use of each palette -subset is. - -Furthermore, users may benefit from the ~modus-themes-contrast~ function -that we provide: [[#h:02e25930-e71a-493d-828a-8907fc80f874][test color combinations]]. It measures the contrast -ratio between two color values, so it can help in overriding the palette -(or a subset thereof) without making the end result inaccessible. - -** Override color saturation -:properties: -:custom_id: h:4589acdc-2505-41fc-9f5e-699cfc45ab00 -:end: -#+cindex: Change a theme's color saturation - -In the previous section we documented how one can override color values -manually ([[#h:307d95dd-8dbd-4ece-a543-10ae86f155a6][Override colors]]). Here we use a programmatic approach which -leverages the built-in ~color-saturate-name~ function to adjust the -saturation of all color values used by the active Modus theme. Our goal -is to prepare a counterpart of the active theme's palette that holds -modified color values, adjusted for a percent change in saturation. A -positive number amplifies the effect, while a negative one will move -towards a grayscale spectrum. - -We start with a function that can be either called from Lisp or invoked -interactively. In the former scenario, we pass to it the rate of change -we want. While in the latter, a minibuffer prompt asks for a number to -apply the desired effect. In either case, we intend to assign anew the -value of ~modus-themes-operandi-color-overrides~ (light theme) and the -same for ~modus-themes-vivendi-color-overrides~ (dark theme). - -#+begin_src emacs-lisp -(defun my-modus-themes-saturate (percent) - "Saturate current Modus theme palette overrides by PERCENT." - (interactive - (list (read-number "Saturation by percent: "))) - (let* ((theme (modus-themes--current-theme)) - (palette (pcase theme - ('modus-operandi modus-themes-operandi-colors) - ('modus-vivendi modus-themes-vivendi-colors) - (_ (error "No Modus theme is active")))) - (overrides (pcase theme - ('modus-operandi 'modus-themes-operandi-color-overrides) - ('modus-vivendi 'modus-themes-vivendi-color-overrides) - (_ (error "No Modus theme is active"))))) - (let (name cons colors) - (dolist (cons palette) - (setq name (color-saturate-name (cdr cons) percent)) - (setq name (format "%s" name)) - (setq cons `(,(car cons) . ,name)) - (push cons colors)) - (set overrides colors)) - (pcase theme - ('modus-operandi (modus-themes-load-operandi)) - ('modus-vivendi (modus-themes-load-vivendi))))) - -;; sample Elisp calls (or call `my-modus-themes-saturate' interactively) -(my-modus-themes-saturate 50) -(my-modus-themes-saturate -75) -#+end_src - -Using the above has an immediate effect, as it reloads the active Modus -theme. - -The =my-modus-themes-saturate= function stores new color values in the -variables ~modus-themes-operandi-color-overrides~ and -~modus-themes-vivendi-color-overrides~, meaning that it undoes changes -implemented by the user on individual colors. To have both automatic -saturation adjustment across the board and retain per-case edits to the -palette, some tweaks to the above function are required. For example: - -#+begin_src emacs-lisp -(defvar my-modus-themes-vivendi-extra-color-overrides - '((fg-main . "#ead0c0") - (bg-main . "#050515")) - "My bespoke colors for `modus-vivendi'.") - -(defvar my-modus-themes-operandi-extra-color-overrides - '((fg-main . "#1a1a1a") - (bg-main . "#fefcf4")) - "My bespoke colors for `modus-operandi'.") - -(defun my-modus-themes-saturate (percent) - "Saturate current Modus theme palette overrides by PERCENT. -Preserve the color values stored in -`my-modus-themes-operandi-extra-color-overrides', -`my-modus-themes-vivendi-extra-color-overrides'." - (interactive - (list (read-number "Saturation by percent: "))) - (let* ((theme (modus-themes--current-theme)) - (palette (pcase theme - ('modus-operandi modus-themes-operandi-colors) - ('modus-vivendi modus-themes-vivendi-colors) - (_ (error "No Modus theme is active")))) - (overrides (pcase theme - ('modus-operandi 'modus-themes-operandi-color-overrides) - ('modus-vivendi 'modus-themes-vivendi-color-overrides) - (_ (error "No Modus theme is active")))) - (extra-overrides (pcase theme - ('modus-operandi my-modus-themes-operandi-extra-color-overrides) - ('modus-vivendi my-modus-themes-vivendi-extra-color-overrides) - (_ (error "No Modus theme is active"))))) - (let (name cons colors) - (dolist (cons palette) - (setq name (color-saturate-name (cdr cons) percent)) - (setq name (format "%s" name)) - (setq cons `(,(car cons) . ,name)) - (push cons colors)) - (set overrides (append extra-overrides colors))) - (pcase theme - ('modus-operandi (modus-themes-load-operandi)) - ('modus-vivendi (modus-themes-load-vivendi))))) -#+end_src - -To disable the effect, one must reset the aforementioned variables of -the themes to ~nil~. Or specify a command for it, such as by taking -inspiration from the ~modus-themes-toggle~ we already provide: - -#+begin_src emacs-lisp -(defun my-modus-themes-revert-overrides () - "Reset palette overrides and reload active Modus theme." - (interactive) - (setq modus-themes-operandi-color-overrides nil - modus-themes-vivendi-color-overrides nil) - (pcase (modus-themes--current-theme) - ('modus-operandi (modus-themes-load-operandi)) - ('modus-vivendi (modus-themes-load-vivendi)))) -#+end_src - -** Override colors through blending -:properties: -:custom_id: h:80c326bf-fe32-47b2-8c59-58022256fd6e -:end: -#+cindex: Change theme colors through blending - -This is yet another method of overriding color values. - -[[#h:307d95dd-8dbd-4ece-a543-10ae86f155a6][Override colors]]. - -[[#h:4589acdc-2505-41fc-9f5e-699cfc45ab00][Override color saturation]]. - -Building on ideas and concepts from the previous sections, this method -blends the entire palette at once with the chosen colors. The function -~my-modus-themes-interpolate~ blends two colors, taking a value from the -themes and mixing it with a user-defined color to arrive at a midpoint. -This scales to all background and foreground colors with the help of the -~my-modus-themes-tint-palette~ function. - -#+begin_src emacs-lisp -(setq my-modus-operandi-bg-blend "#fbf1c7" - my-modus-operandi-fg-blend "#3a6084" - my-modus-vivendi-bg-blend "#3a4042" - my-modus-vivendi-fg-blend "#d7b765") - -;; Adapted from the `kurecolor-interpolate' function of kurecolor.el -(defun my-modus-themes-interpolate (color1 color2) - (cl-destructuring-bind (r g b) - (mapcar #'(lambda (n) (* (/ n 2) 255.0)) - (cl-mapcar '+ (color-name-to-rgb color1) (color-name-to-rgb color2))) - (format "#%02X%02X%02X" r g b))) - -(defun my-modus-themes-tint-palette (palette bg-blend fg-blend) - "Modify Modus PALETTE programmatically and return a new palette. -Blend background colors with BG-BLEND and foreground colors with FG-BLEND." - (let (name cons colors) - (dolist (cons palette) - (let ((blend (if (string-match "bg" (symbol-name (car cons))) - bg-blend - fg-blend))) - (setq name (my-modus-themes-interpolate (cdr cons) blend))) - (setq name (format "%s" name)) - (setq cons `(,(car cons) . ,name)) - (push cons colors)) - colors)) - -(define-minor-mode modus-themes-tinted-mode - "Tweak some Modus themes colors." - :init-value nil - :global t - (if modus-themes-tinted-mode - (setq modus-themes-operandi-color-overrides - (my-modus-themes-tint-palette modus-themes-operandi-colors - my-modus-operandi-bg-blend - my-modus-operandi-fg-blend) - modus-themes-vivendi-color-overrides - (my-modus-themes-tint-palette modus-themes-vivendi-colors - my-modus-vivendi-bg-blend - my-modus-vivendi-fg-blend)) - (setq modus-themes-operandi-color-overrides nil - modus-themes-vivendi-color-overrides nil))) - -(modus-themes-tinted-mode 1) -#+end_src - -** Override colors completely -:PROPERTIES: -:CUSTOM_ID: h:736c0ff5-8c9c-4565-82cf-989e57d07d4a -:END: - -Based on the ideas we have already covered in these sections, the -following code block provides a complete, bespoke pair of color palettes -which override the defaults. They are implemented as a minor mode, as -explained before ([[#h:307d95dd-8dbd-4ece-a543-10ae86f155a6][Override colors]]). We call them "Summertime" for -convenience. - -#+begin_src emacs-lisp -;; Read the relevant blog post: -;; <https://protesilaos.com/codelog/2022-07-26-modus-themes-color-override-demo/> -(define-minor-mode modus-themes-summertime - "Refashion the Modus themes by overriding their colors. - -This is a complete technology demonstration to show how to -manually override the colors of the Modus themes. I have taken -good care of those overrides to make them work as a fully fledged -color scheme that is compatible with all user options of the -Modus themes. - -These overrides are usable by those who (i) like something more -fancy than the comparatively austere looks of the Modus themes, -and (ii) can cope with a lower contrast ratio. - -The overrides are set up as a minor mode, so that the user can -activate the effect on demand. Those who want to load the -overrides at all times can either add them directly to their -configuration or enable `modus-themes-summertime' BEFORE loading -either of the Modus themes (if the overrides are evaluated after -the theme, the theme must be reloaded). - -Remember that all changes to theme-related variables require a -reload of the theme to take effect (the Modus themes have lots of -user options, apart from those overrides). - -The `modus-themes-summertime' IS NOT an official extension to the -Modus themes and DOES NOT comply with its lofty accessibility -standards. It is included in the official manual as guidance for -those who want to make use of the color overriding facility we -provide." - :init-value nil - :global t - (if modus-themes-summertime - (setq modus-themes-operandi-color-overrides - '((bg-main . "#fff0f2") - (bg-dim . "#fbe6ef") - (bg-alt . "#f5dae6") - (bg-hl-line . "#fad8e3") - (bg-active . "#efcadf") - (bg-inactive . "#f3ddef") - (bg-active-accent . "#ffbbef") - (bg-region . "#dfc5d1") - (bg-region-accent . "#efbfef") - (bg-region-accent-subtle . "#ffd6ef") - (bg-header . "#edd3e0") - (bg-tab-active . "#ffeff2") - (bg-tab-inactive . "#f8d3ef") - (bg-tab-inactive-accent . "#ffd9f5") - (bg-tab-inactive-alt . "#e5c0d5") - (bg-tab-inactive-alt-accent . "#f3cce0") - (fg-main . "#543f78") - (fg-dim . "#5f476f") - (fg-alt . "#7f6f99") - (fg-unfocused . "#8f6f9f") - (fg-active . "#563068") - (fg-inactive . "#8a5698") - (fg-docstring . "#5f5fa7") - (fg-comment-yellow . "#a9534f") - (fg-escape-char-construct . "#8b207f") - (fg-escape-char-backslash . "#a06d00") - (bg-special-cold . "#d3e0f4") - (bg-special-faint-cold . "#e0efff") - (bg-special-mild . "#c4ede0") - (bg-special-faint-mild . "#e0f0ea") - (bg-special-warm . "#efd0c4") - (bg-special-faint-warm . "#ffe4da") - (bg-special-calm . "#f0d3ea") - (bg-special-faint-calm . "#fadff9") - (fg-special-cold . "#405fb8") - (fg-special-mild . "#407f74") - (fg-special-warm . "#9d6f4f") - (fg-special-calm . "#af509f") - (bg-completion . "#ffc5e5") - (bg-completion-subtle . "#f7cfef") - (red . "#ed2f44") - (red-alt . "#e0403d") - (red-alt-other . "#e04059") - (red-faint . "#ed4f44") - (red-alt-faint . "#e0603d") - (red-alt-other-faint . "#e06059") - (green . "#217a3c") - (green-alt . "#417a1c") - (green-alt-other . "#006f3c") - (green-faint . "#318a4c") - (green-alt-faint . "#518a2c") - (green-alt-other-faint . "#20885c") - (yellow . "#b06202") - (yellow-alt . "#a95642") - (yellow-alt-other . "#a06f42") - (yellow-faint . "#b07232") - (yellow-alt-faint . "#a96642") - (yellow-alt-other-faint . "#a08042") - (blue . "#275ccf") - (blue-alt . "#475cc0") - (blue-alt-other . "#3340ef") - (blue-faint . "#476ce0") - (blue-alt-faint . "#575ccf") - (blue-alt-other-faint . "#3f60d7") - (magenta . "#bf317f") - (magenta-alt . "#d033c0") - (magenta-alt-other . "#844fe4") - (magenta-faint . "#bf517f") - (magenta-alt-faint . "#d053c0") - (magenta-alt-other-faint . "#846fe4") - (cyan . "#007a9f") - (cyan-alt . "#3f709f") - (cyan-alt-other . "#107f7f") - (cyan-faint . "#108aaf") - (cyan-alt-faint . "#3f80af") - (cyan-alt-other-faint . "#3088af") - (red-active . "#cd2f44") - (green-active . "#116a6c") - (yellow-active . "#993602") - (blue-active . "#475ccf") - (magenta-active . "#7f2ccf") - (cyan-active . "#007a8f") - (red-nuanced-bg . "#ffdbd0") - (red-nuanced-fg . "#ed6f74") - (green-nuanced-bg . "#dcf0dd") - (green-nuanced-fg . "#3f9a4c") - (yellow-nuanced-bg . "#fff3aa") - (yellow-nuanced-fg . "#b47232") - (blue-nuanced-bg . "#e3e3ff") - (blue-nuanced-fg . "#201f6f") - (magenta-nuanced-bg . "#fdd0ff") - (magenta-nuanced-fg . "#c0527f") - (cyan-nuanced-bg . "#dbefff") - (cyan-nuanced-fg . "#0f3f60") - (bg-diff-heading . "#b7cfe0") - (fg-diff-heading . "#041645") - (bg-diff-added . "#d6f0d6") - (fg-diff-added . "#004520") - (bg-diff-changed . "#fcefcf") - (fg-diff-changed . "#524200") - (bg-diff-removed . "#ffe0ef") - (fg-diff-removed . "#891626") - (bg-diff-refine-added . "#84cfa4") - (fg-diff-refine-added . "#002a00") - (bg-diff-refine-changed . "#cccf8f") - (fg-diff-refine-changed . "#302010") - (bg-diff-refine-removed . "#da92b0") - (fg-diff-refine-removed . "#500010") - (bg-diff-focus-added . "#a6e5c6") - (fg-diff-focus-added . "#002c00") - (bg-diff-focus-changed . "#ecdfbf") - (fg-diff-focus-changed . "#392900") - (bg-diff-focus-removed . "#efbbcf") - (fg-diff-focus-removed . "#5a0010")) - modus-themes-vivendi-color-overrides - '((bg-main . "#25152a") - (bg-dim . "#2a1930") - (bg-alt . "#382443") - (bg-hl-line . "#332650") - (bg-active . "#463358") - (bg-inactive . "#2d1f3a") - (bg-active-accent . "#50308f") - (bg-region . "#5d4a67") - (bg-region-accent . "#60509f") - (bg-region-accent-subtle . "#3f285f") - (bg-header . "#3a2543") - (bg-tab-active . "#26162f") - (bg-tab-inactive . "#362647") - (bg-tab-inactive-accent . "#36265a") - (bg-tab-inactive-alt . "#3e2f5a") - (bg-tab-inactive-alt-accent . "#3e2f6f") - (fg-main . "#debfe0") - (fg-dim . "#d0b0da") - (fg-alt . "#ae85af") - (fg-unfocused . "#8e7f9f") - (fg-active . "#cfbfef") - (fg-inactive . "#b0a0c0") - (fg-docstring . "#c8d9f7") - (fg-comment-yellow . "#cf9a70") - (fg-escape-char-construct . "#ff75aa") - (fg-escape-char-backslash . "#dbab40") - (bg-special-cold . "#2a3f58") - (bg-special-faint-cold . "#1e283f") - (bg-special-mild . "#0f3f31") - (bg-special-faint-mild . "#0f281f") - (bg-special-warm . "#44331f") - (bg-special-faint-warm . "#372213") - (bg-special-calm . "#4a314f") - (bg-special-faint-calm . "#3a223f") - (fg-special-cold . "#c0b0ff") - (fg-special-mild . "#bfe0cf") - (fg-special-warm . "#edc0a6") - (fg-special-calm . "#ff9fdf") - (bg-completion . "#502d70") - (bg-completion-subtle . "#451d65") - (red . "#ff5f6f") - (red-alt . "#ff8f6d") - (red-alt-other . "#ff6f9d") - (red-faint . "#ffa0a0") - (red-alt-faint . "#f5aa80") - (red-alt-other-faint . "#ff9fbf") - (green . "#51ca5c") - (green-alt . "#71ca3c") - (green-alt-other . "#51ca9c") - (green-faint . "#78bf78") - (green-alt-faint . "#99b56f") - (green-alt-other-faint . "#88bf99") - (yellow . "#f0b262") - (yellow-alt . "#f0e242") - (yellow-alt-other . "#d0a272") - (yellow-faint . "#d2b580") - (yellow-alt-faint . "#cabf77") - (yellow-alt-other-faint . "#d0ba95") - (blue . "#778cff") - (blue-alt . "#8f90ff") - (blue-alt-other . "#8380ff") - (blue-faint . "#82b0ec") - (blue-alt-faint . "#a0acef") - (blue-alt-other-faint . "#80b2f0") - (magenta . "#ff70cf") - (magenta-alt . "#ff77f0") - (magenta-alt-other . "#ca7fff") - (magenta-faint . "#e0b2d6") - (magenta-alt-faint . "#ef9fe4") - (magenta-alt-other-faint . "#cfa6ff") - (cyan . "#30cacf") - (cyan-alt . "#60caff") - (cyan-alt-other . "#40b79f") - (cyan-faint . "#90c4ed") - (cyan-alt-faint . "#a0bfdf") - (cyan-alt-other-faint . "#a4d0bb") - (red-active . "#ff6059") - (green-active . "#64dc64") - (yellow-active . "#ffac80") - (blue-active . "#4fafff") - (magenta-active . "#cf88ff") - (cyan-active . "#50d3d0") - (red-nuanced-bg . "#440a1f") - (red-nuanced-fg . "#ffcccc") - (green-nuanced-bg . "#002904") - (green-nuanced-fg . "#b8e2b8") - (yellow-nuanced-bg . "#422000") - (yellow-nuanced-fg . "#dfdfb0") - (blue-nuanced-bg . "#1f1f5f") - (blue-nuanced-fg . "#bfd9ff") - (magenta-nuanced-bg . "#431641") - (magenta-nuanced-fg . "#e5cfef") - (cyan-nuanced-bg . "#042f49") - (cyan-nuanced-fg . "#a8e5e5") - (bg-diff-heading . "#304466") - (fg-diff-heading . "#dae7ff") - (bg-diff-added . "#0a383a") - (fg-diff-added . "#94ba94") - (bg-diff-changed . "#2a2000") - (fg-diff-changed . "#b0ba9f") - (bg-diff-removed . "#50163f") - (fg-diff-removed . "#c6adaa") - (bg-diff-refine-added . "#006a46") - (fg-diff-refine-added . "#e0f6e0") - (bg-diff-refine-changed . "#585800") - (fg-diff-refine-changed . "#ffffcc") - (bg-diff-refine-removed . "#952838") - (fg-diff-refine-removed . "#ffd9eb") - (bg-diff-focus-added . "#1d4c3f") - (fg-diff-focus-added . "#b4dfb4") - (bg-diff-focus-changed . "#424200") - (fg-diff-focus-changed . "#d0daaf") - (bg-diff-focus-removed . "#6f0f39") - (fg-diff-focus-removed . "#eebdba"))) - (setq modus-themes-operandi-color-overrides nil - modus-themes-vivendi-color-overrides nil))) -#+end_src - ** Font configurations for Org and others :properties: :custom_id: h:defcf4fc-8fa8-4c29-b12e-7119582cc929 @@ -3400,8 +2827,8 @@ the ~variable-pitch~ (proportional spacing) and ~fixed-pitch~ (monospaced) faces respectively. It may also be convenient to set your main typeface by configuring the ~default~ face the same way. -[ The =fontaine= package on GNU ELPA (by the author of the modus-themes) - is designed to handle this case. ] +[ The ~fontaine~ package on GNU ELPA (by Protesilaos) is designed to + handle this case. ] Put something like this in your initialization file (also consider reading the doc string of ~set-face-attribute~): @@ -3537,7 +2964,7 @@ of the themes, which can make it easier to redefine faces in bulk). (add-hook 'modus-themes-after-load-theme-hook #'my-modes-themes-bold-italic-faces) #+end_src -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. ** Custom Org todo keyword and priority faces :properties: @@ -3623,8 +3050,6 @@ Their documentation strings will offer you further guidance. Recall that the themes let you retrieve a color from their palette. Do it if you plan to control face attributes. -[[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Custom face specs using the themes' palette]]. - [[#h:02e25930-e71a-493d-828a-8907fc80f874][Check color combinations]]. ** Custom Org emphasis faces @@ -3649,7 +3074,7 @@ specification of that variable looks like this: With the exception of ~org-verbatim~ and ~org-code~ faces, everything else uses the corresponding type of emphasis: a bold typographic weight, or -italicized, underlined, and struck through text. +italicised, underlined, and struck through text. The best way for users to add some extra attributes, such as a foreground color, is to define their own faces and assign them to the @@ -3872,8 +3297,8 @@ palette in large part because certain colors are only meant to be used in combination with some others. Consult the source code for the minutia and relevant commentary. -Such knowledge may prove valuable while attempting to override some of -the themes' colors: [[#h:307d95dd-8dbd-4ece-a543-10ae86f155a6][Override colors]]. +Such knowledge may prove valuable while attempting to customize the +theme's color palette. ** Load theme depending on time of day :properties: @@ -3884,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 @@ -3895,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) @@ -3925,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 @@ -3946,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) @@ -3972,101 +3399,6 @@ With those in place, PDFs have a distinct backdrop for their page, while buffers with major-mode as ~pdf-view-mode~ automatically switches to dark mode when ~modus-themes-toggle~ is called. -** Decrease mode line height -:properties: -:custom_id: h:03be4438-dae1-4961-9596-60a307c070b5 -:end: -#+cindex: Decrease mode line height - -By default, the mode line of the Modus themes is set to 1 pixel width -for its =:box= attribute. In contrast, the mode line of stock Emacs is -1 -pixel. This small difference is considered necessary for the purposes -of accessibility as our out-of-the-box design has a prominent color -around the mode line (a border) to make its boundaries clear. With a -negative width the border and the text on the mode line can feel a bit -more difficult to read under certain scenaria. - -Furthermore, the user option ~modus-themes-mode-line~ ([[#h:27943af6-d950-42d0-bc23-106e43f50a24][Mode line]]) does not -allow for such a negative value because there are many edge cases that -simply make for a counter-intuitive set of possibilities, such as a =0= -value not being acceptable by the underlying face infrastructure, and -negative values greater than =-2= not being particularly usable. - -For these reasons, users who wish to decrease the overall height of the -mode line must handle things on their own by implementing the methods -for face customization documented herein. - -[[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Basic face customization]]. - -One such method is to create a function that configures the desired -faces and hook it to ~modus-themes-after-load-theme-hook~ so that it -persists while switching between the Modus themes with the command -~modus-themes-toggle~. - -This one simply disables the box altogether, which will reduce the -height of the mode lines, but also remove their border: - -#+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () - (set-face-attribute 'mode-line nil :box nil) - (set-face-attribute 'mode-line-inactive nil :box nil)) - -(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) -#+end_src - -The above relies on the ~set-face-attribute~ function, though users who -plan to re-use colors from the theme and do so at scale are better off -with the more streamlined combination of the ~modus-themes-with-colors~ -macro and ~custom-set-faces~. - -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face customization at scale]]. - -As explained before in this document, this approach has a syntax that is -consistent with the source code of the themes, so it probably is easier -to re-use parts of the design. - -The following emulates the stock Emacs style, while still using the -colors of the Modus themes (whichever attribute is not explicitly stated -is inherited from the underlying theme): - -#+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () - (modus-themes-with-colors - (custom-set-faces - `(mode-line ((,class :box (:line-width -1 :style released-button)))) - `(mode-line-inactive ((,class :box (:line-width -1 :color ,bg-region))))))) - -(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) -#+end_src - -And this one is like the out-of-the-box style of the Modus themes, but -with the -1 height instead of 1: - -#+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () - (modus-themes-with-colors - (custom-set-faces - `(mode-line ((,class :box (:line-width -1 :color ,fg-alt)))) - `(mode-line-inactive ((,class :box (:line-width -1 :color ,bg-region))))))) - -(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) -#+end_src - -Finally, to also change the background color of the active mode line, -such as that it looks like the "accented" variant which is possible via -the user option ~modus-themes-mode-line~, the =:background= attribute needs -to be specified as well: - -#+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () - (modus-themes-with-colors - (custom-set-faces - `(mode-line ((,class :box (:line-width -1 :color ,fg-alt) :background ,bg-active-accent))) - `(mode-line-inactive ((,class :box (:line-width -1 :color ,bg-region))))))) - -(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) -#+end_src - ** Toggle themes without reloading them :properties: :custom_id: h:b40aca50-a3b2-4c43-be58-2c26fcd14237 @@ -4106,13 +3438,13 @@ varying skill levels, from beginners to experts. This means that we try to make things easier by not expecting anyone reading this document to be proficient in Emacs Lisp or programming in general. -Such a case is with the use of the ~modus-themes-after-load-theme-hook~, -which runs after ~modus-themes-toggle~, ~modus-themes-load-operandi~, or -~modus-themes-load-vivendi~ is evaluated. We recommend using that hook -for advanced customizations, because (1) we know for sure that it is +Such a case is with the use of ~modus-themes-after-load-theme-hook~, +which runs after the ~modus-themes-load-theme~ function (used by the +command ~modus-themes-toggle~). We recommend using that hook for +advanced customizations, because (1) we know for sure that it is available once the themes are loaded, and (2) anyone consulting this -manual, especially the sections on enabling and loading the themes, will -be in a good position to benefit from that hook. +manual, especially the sections on enabling and loading the themes, +will be in a good position to benefit from that hook. Advanced users who have a need to switch between the Modus themes and other items will find that such a hook does not meet their requirements: @@ -4138,246 +3470,26 @@ also has the benefit that it does not depend on functions such as ~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is called internally by ~load-theme~, so the hook works everywhere. -Now this specific piece of Elisp may be simple for experienced users, -but it is not easy to read for newcomers, including the author of the -Modus themes for the first several months of their time as an Emacs -user. Hence our hesitation to recommend it as part of the standard -setup of the Modus themes (it is generally a good idea to understand -what the implications are of advising a function). - -** Diffs with only the foreground -:properties: -:custom_id: h:e2aed9eb-5e1e-45ec-bbd7-bc4faeab3236 -:end: -#+cindex: Foreground-only diffs - -Buffers that show differences between versions of a file or buffer, such -as in ~diff-mode~ and ~ediff~ always use color-coded background and -foreground combinations. - -[[#h:ea7ac54f-5827-49bd-b09f-62424b3b6427][Option for diff buffer looks]]. - -User may, however, prefer a style that removes the color-coded -backgrounds from regular changes while keeping them for word-wise (aka -"refined") changes---backgrounds for word-wise diffs are helpful in -context. To make this happen, one can use the ~modus-themes-with-colors~ -macro ([[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]): +The downside of the theme-agnostic hook is that any functions added to +it will likely not be able to benefit from macro calls that read the +active theme, such as ~modus-themes-with-colors~. Not all Emacs +themes have the same capabilities. -#+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () - (modus-themes-with-colors - (custom-set-faces - `(modus-themes-diff-added ((,class :background unspecified :foreground ,green))) ; OR ,blue for deuteranopia - `(modus-themes-diff-changed ((,class :background unspecified :foreground ,yellow))) - `(modus-themes-diff-removed ((,class :background unspecified :foreground ,red))) - - `(modus-themes-diff-refine-added ((,class :background ,bg-diff-added :foreground ,fg-diff-added))) - ;; `(modus-themes-diff-refine-added ((,class :background ,bg-diff-added-deuteran :foreground ,fg-diff-added-deuteran))) - `(modus-themes-diff-refine-changed ((,class :background ,bg-diff-changed :foreground ,fg-diff-changed))) - `(modus-themes-diff-refine-removed ((,class :background ,bg-diff-removed :foreground ,fg-diff-removed))) - - `(modus-themes-diff-focus-added ((,class :background ,bg-dim :foreground ,green))) ; OR ,blue for deuteranopia - `(modus-themes-diff-focus-changed ((,class :background ,bg-dim :foreground ,yellow))) - `(modus-themes-diff-focus-removed ((,class :background ,bg-dim :foreground ,red))) - - `(modus-themes-diff-heading ((,class :background ,bg-alt :foreground ,fg-main))) - - `(diff-indicator-added ((,class :foreground ,green))) ; OR ,blue for deuteranopia - `(diff-indicator-changed ((,class :foreground ,yellow))) - `(diff-indicator-removed ((,class :foreground ,red))) - - `(magit-diff-added ((,class :background unspecified :foreground ,green-faint))) - `(magit-diff-changed ((,class :background unspecified :foreground ,yellow-faint))) - `(magit-diff-removed ((,class :background unspecified :foreground ,red-faint))) - `(magit-diff-context-highlight ((,class :background ,bg-dim :foreground ,fg-dim)))))) - -;; This is so that the changes persist when switching between -;; `modus-operandi' and `modus-vivendi'. -(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) -#+end_src - -This used to be an optional style of ~modus-themes-diffs~, but has been -removed since version =2.0.0= to ensure that the accessibility standard -and aesthetic quality of the themes is not compromised. - -** Ediff without diff color-coding -:properties: -:custom_id: h:b0b31802-0216-427e-b071-1a47adcfe608 -:end: - -Ediff uses the same color-coding as ordinary diffs in ~diff-mode~, Magit, -etc. ([[#h:ea7ac54f-5827-49bd-b09f-62424b3b6427][Option for diff buffer looks]]). This is consistent with the -principle of least surprise. - -Users may, however, prefer to treat Ediff differently on the premise -that it does not need any particular color-coding to show added or -removed lines/words: it does not use the =+= or =-= markers, after all. - -This can be achieved by customizing the Ediff faces with color -combinations that do not carry the same connotations as those of diffs. -Consider this example, which leverages the ~modus-themes-with-colors~ -macro ([[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]): - -#+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () - (modus-themes-with-colors - (custom-set-faces - `(ediff-current-diff-A ((,class :inherit unspecified :background ,bg-special-faint-cold :foreground ,fg-special-cold))) - `(ediff-current-diff-B ((,class :inherit unspecified :background ,bg-special-faint-warm :foreground ,fg-special-warm))) - `(ediff-current-diff-C ((,class :inherit unspecified :background ,bg-special-faint-calm :foreground ,fg-special-calm))) - `(ediff-fine-diff-A ((,class :inherit unspecified :background ,bg-special-cold :foreground ,fg-special-cold))) - `(ediff-fine-diff-B ((,class :inherit unspecified :background ,bg-special-warm :foreground ,fg-special-warm))) - `(ediff-fine-diff-C ((,class :inherit unspecified :background ,bg-special-calm :foreground ,fg-special-calm)))))) - -;; This is so that the changes persist when switching between -;; `modus-operandi' and `modus-vivendi'. -(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) -#+end_src - -Remove the =:foreground= and its value to preserve the underlying -coloration. - -[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Visualize the active Modus theme's palette]]. - -** Near-monochrome syntax highlighting -:properties: -:custom_id: h:c1f3fa8e-7a63-4a6f-baf3-a7febc0661f0 -:end: -#+cindex: Monochrome code syntax - -While the Modus themes do provide a user option to control the overall -style of syntax highlighting in programming major modes, they do not -cover the possibility of a monochromatic or near-monochromatic design -([[#h:c119d7b2-fcd4-4e44-890e-5e25733d5e52][Option for syntax highlighting]]). This is due to the multitude of -preferences involved: one may like comments to be styled with an accent -value, another may want certain constructs to be bold, a third may apply -italics to doc strings but not comments... The possibilities are -virtually endless. As such, this sort of design is best handled at the -user level in accordance with the information furnished elsewhere in -this manual. - -[[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Case-by-case face specs using the themes' palette]]. - -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. - -The gist is that we want to override the font-lock faces. For our -changes to persist while switching between ~modus-operandi~ and -~modus-vivendi~ we wrap our face overrides in a function that we hook to -~modus-themes-after-load-theme-hook~. - -Users who want to replicate the structure of the themes' source code are -advised to use the examples with ~custom-set-faces~. Those who prefer a -different approach can use the snippets which call ~set-face-attribute~. -Below are the code blocks. - -The following uses a yellow accent value for comments and green hues for -strings. Regexp grouping constructs have color values that work in the -context of a green string. All other elements use the main foreground -color, except warnings such as the ~user-error~ function in Elisp -buffers which gets a subtle red tint (not to be confused with the -~warning~ face which is used for genuine warnings). Furthermore, notice -the ~modus-themes-bold~ and ~modus-themes-slant~ which apply the -preference set in the user options ~modus-themes-bold-constructs~ and -~modus-themes-italic-constructs~, respectively. Users who do not want -this conditionally must replace these faces with ~bold~ and ~italic~ -respectively (or ~unspecified~ to disable the effect altogether). - -#+begin_src emacs-lisp -;; This is the hook. It will not be replicated across all code samples. -(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-subtle-syntax) - -(defun my-modus-themes-subtle-syntax () - (modus-themes-with-colors - (custom-set-faces - `(font-lock-builtin-face ((,class :inherit modus-themes-bold :foreground unspecified))) - `(font-lock-comment-delimiter-face ((,class :inherit font-lock-comment-face))) - `(font-lock-comment-face ((,class :inherit unspecified :foreground ,fg-comment-yellow))) - `(font-lock-constant-face ((,class :foreground unspecified))) - `(font-lock-doc-face ((,class :inherit modus-themes-slant :foreground ,fg-special-mild))) - `(font-lock-function-name-face ((,class :foreground unspecified))) - `(font-lock-keyword-face ((,class :inherit modus-themes-bold :foreground unspecified))) - `(font-lock-negation-char-face ((,class :inherit modus-themes-bold :foreground unspecified))) - `(font-lock-preprocessor-face ((,class :foreground unspecified))) - `(font-lock-regexp-grouping-backslash ((,class :inherit bold :foreground ,yellow))) - `(font-lock-regexp-grouping-construct ((,class :inherit bold :foreground ,blue-alt-other))) - `(font-lock-string-face ((,class :foreground ,green-alt-other))) - `(font-lock-type-face ((,class :inherit modus-themes-bold :foreground unspecified))) - `(font-lock-variable-name-face ((,class :foreground unspecified))) - `(font-lock-warning-face ((,class :inherit modus-themes-bold :foreground ,red-nuanced-fg)))))) - -;; Same as above with `set-face-attribute' instead of `custom-set-faces' -(defun my-modus-themes-subtle-syntax () - (modus-themes-with-colors - (set-face-attribute 'font-lock-builtin-face nil :inherit 'modus-themes-bold :foreground 'unspecified) - (set-face-attribute 'font-lock-comment-delimiter-face nil :inherit 'font-lock-comment-face) - (set-face-attribute 'font-lock-comment-face nil :inherit 'unspecified :foreground fg-comment-yellow) - (set-face-attribute 'font-lock-constant-face nil :foreground 'unspecified) - (set-face-attribute 'font-lock-doc-face nil :inherit 'modus-themes-slant :foreground fg-special-mild) - (set-face-attribute 'font-lock-function-name-face nil :foreground 'unspecified) - (set-face-attribute 'font-lock-keyword-face nil :inherit 'modus-themes-bold :foreground 'unspecified) - (set-face-attribute 'font-lock-negation-char-face nil :inherit 'modus-themes-bold :foreground 'unspecified) - (set-face-attribute 'font-lock-preprocessor-face nil :foreground 'unspecified) - (set-face-attribute 'font-lock-regexp-grouping-backslash nil :inherit 'bold :foreground yellow) - (set-face-attribute 'font-lock-regexp-grouping-construct nil :inherit 'bold :foreground blue-alt-other) - (set-face-attribute 'font-lock-string-face nil :foreground green-alt-other) - (set-face-attribute 'font-lock-type-face nil :inherit 'modus-themes-bold :foreground 'unspecified) - (set-face-attribute 'font-lock-variable-name-face nil :foreground 'unspecified) - (set-face-attribute 'font-lock-warning-face nil :inherit 'modus-themes-bold :foreground red-nuanced-fg))) -#+end_src - -The following sample is the same as above, except strings are blue and -comments are gray. Regexp constructs are adapted accordingly. - -#+begin_src emacs-lisp -(defun my-modus-themes-subtle-syntax () - (modus-themes-with-colors - (custom-set-faces - `(font-lock-builtin-face ((,class :inherit modus-themes-bold :foreground unspecified))) - `(font-lock-comment-delimiter-face ((,class :inherit font-lock-comment-face))) - `(font-lock-comment-face ((,class :inherit unspecified :foreground ,fg-alt))) - `(font-lock-constant-face ((,class :foreground unspecified))) - `(font-lock-doc-face ((,class :inherit modus-themes-slant :foreground ,fg-docstring))) - `(font-lock-function-name-face ((,class :foreground unspecified))) - `(font-lock-keyword-face ((,class :inherit modus-themes-bold :foreground unspecified))) - `(font-lock-negation-char-face ((,class :inherit modus-themes-bold :foreground unspecified))) - `(font-lock-preprocessor-face ((,class :foreground unspecified))) - `(font-lock-regexp-grouping-backslash ((,class :inherit bold :foreground ,fg-escape-char-backslash))) - `(font-lock-regexp-grouping-construct ((,class :inherit bold :foreground ,fg-escape-char-construct))) - `(font-lock-string-face ((,class :foreground ,blue-alt))) - `(font-lock-type-face ((,class :inherit modus-themes-bold :foreground unspecified))) - `(font-lock-variable-name-face ((,class :foreground unspecified))) - `(font-lock-warning-face ((,class :inherit modus-themes-bold :foreground ,red-nuanced-fg)))))) - -;; Same as above with `set-face-attribute' instead of `custom-set-faces' -(defun my-modus-themes-subtle-syntax () - (modus-themes-with-colors - (set-face-attribute 'font-lock-builtin-face nil :inherit 'modus-themes-bold :foreground 'unspecified) - (set-face-attribute 'font-lock-comment-delimiter-face nil :inherit 'font-lock-comment-face) - (set-face-attribute 'font-lock-comment-face nil :inherit 'unspecified :foreground fg-alt) - (set-face-attribute 'font-lock-constant-face nil :foreground 'unspecified) - (set-face-attribute 'font-lock-doc-face nil :inherit 'modus-themes-slant :foreground fg-docstring) - (set-face-attribute 'font-lock-function-name-face nil :foreground 'unspecified) - (set-face-attribute 'font-lock-keyword-face nil :inherit 'modus-themes-bold :foreground 'unspecified) - (set-face-attribute 'font-lock-negation-char-face nil :inherit 'modus-themes-bold :foreground 'unspecified) - (set-face-attribute 'font-lock-preprocessor-face nil :foreground 'unspecified) - (set-face-attribute 'font-lock-regexp-grouping-backslash nil :inherit 'bold :foreground fg-escape-char-backslash) - (set-face-attribute 'font-lock-regexp-grouping-construct nil :inherit 'bold :foreground fg-escape-char-construct) - (set-face-attribute 'font-lock-string-face nil :foreground blue-alt) - (set-face-attribute 'font-lock-type-face nil :inherit 'modus-themes-bold :foreground 'unspecified) - (set-face-attribute 'font-lock-variable-name-face nil :foreground 'unspecified) - (set-face-attribute 'font-lock-warning-face nil :inherit 'modus-themes-bold :foreground red-nuanced-fg))) -#+end_src +In this document, we cover ~modus-themes-after-load-theme-hook~ though +the user can replace it with ~after-enable-theme-hook~ should they +need to (provided they understand the implications). ** Custom hl-todo colors :PROPERTIES: :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 () @@ -4411,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, @@ -4441,23 +3553,23 @@ 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: [[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]. -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. #+begin_src emacs-lisp (defun my-modus-themes-custom-faces () (modus-themes-with-colors (custom-set-faces - `(solaire-default-face ((,class :inherit default :background ,bg-alt :foreground ,fg-dim))) - `(solaire-line-number-face ((,class :inherit solaire-default-face :foreground ,fg-unfocused))) - `(solaire-hl-line-face ((,class :background ,bg-active))) - `(solaire-org-hide-face ((,class :background ,bg-alt :foreground ,bg-alt)))))) + `(solaire-default-face ((,c :inherit default :background ,bg-dim :foreground ,fg-dim))) + `(solaire-line-number-face ((,c :inherit solaire-default-face :foreground ,fg-unfocused))) + `(solaire-hl-line-face ((,c :background ,bg-active))) + `(solaire-org-hide-face ((,c :background ,bg-dim :foreground ,bg-dim)))))) (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src @@ -4487,65 +3599,51 @@ affected face groups. The items with an appended asterisk =*= tend to have lots of extensions, so the "full support" may not be 100% true… + ace-window -+ alert ++ agda2-mode + all-the-icons + all-the-icons-dired + all-the-icons-ibuffer + annotate + ansi-color + anzu -+ apropos -+ artbollocks-mode + auctex and TeX + auto-dim-other-buffers + avy -+ awesome-tray + bbdb + binder -+ bm + bongo + boon + bookmark -+ breakpoint (provided by the built-in {{{file(gdb-mi.el)}}} library) + calendar and diary -+ calfw -+ calibredb + centaur-tabs -+ cfrs + change-log and log-view (such as ~vc-print-log~, ~vc-print-root-log~) + chart + cider + circe + citar -+ color-rg ++ clojure-mode + column-enforce-mode + company-mode* -+ company-posframe + compilation-mode + completions + consult + corfu + corfu-quick + counsel* -+ counsel-css -+ cov + cperl-mode + crontab-mode + css-mode + csv-mode + ctrlf + custom (what you get with {{{kbd(M-x customize)}}}) -+ dap-mode +- dashboard + deadgrep -+ debbugs + deft -+ denote + devdocs + dictionary + diff-hl + diff-mode + dim-autoload -+ dir-treeview + dired + dired-async + dired-git @@ -4553,11 +3651,8 @@ have lots of extensions, so the "full support" may not be 100% true… + dired-narrow + dired-subtree + diredfl -+ diredp (dired+) + display-fill-column-indicator-mode + doom-modeline -+ easy-jekyll -+ ebdb + ediff + ein (Emacs IPython Notebook) + eglot @@ -4571,36 +3666,23 @@ have lots of extensions, so the "full support" may not be 100% true… + emms + enh-ruby-mode (enhanced-ruby-mode) + epa -+ equake + erc -+ eros + ert + eshell + eshell-fringe-status -+ eshell-git-prompt -+ eshell-prompt-extras (epe) -+ eshell-syntax-highlighting + evil* (evil-mode) -+ evil-goggles -+ evil-snipe -+ evil-visual-mark-mode + eww + exwm + eyebrowse -+ fancy-dabbrev + flycheck + flycheck-color-mode-line + flycheck-indicator -+ flycheck-posframe + flymake + flyspell + flx -+ freeze-it + focus + fold-this + font-lock (generic syntax highlighting) -+ forge -+ fountain (fountain-mode) + geiser + git-commit + git-gutter (and variants) @@ -4609,23 +3691,16 @@ have lots of extensions, so the "full support" may not be 100% true… + gnus + gotest + golden-ratio-scroll-screen -+ helm* -+ helm-ls-git -+ helm-switch-shell -+ helm-xref + helpful -+ highlight-indentation + highlight-numbers + highlight-parentheses ([[#h:24bab397-dcb2-421d-aa6e-ec5bd622b913][Note on highlight-parentheses.el]]) + highlight-thing -+ hl-defined + hl-fill-column + hl-line-mode + hl-todo + hydra + ibuffer + icomplete -+ icomplete-vertical + ido-mode + iedit + iflipb @@ -4635,7 +3710,6 @@ have lots of extensions, so the "full support" may not be 100% true… + info + info+ (info-plus) + info-colors -+ interaction-log + ioccur + isearch, occur, etc. + ivy* @@ -4644,34 +3718,25 @@ have lots of extensions, so the "full support" may not be 100% true… + journalctl-mode + js2-mode + julia -+ jupyter + kaocha-runner + keycast + ledger-mode + leerzeichen + line numbers (~display-line-numbers-mode~ and global variant) -+ lsp-mode -+ lsp-ui -+ macrostep + magit -+ magit-imerge + make-mode + man + marginalia + markdown-mode + markup-faces (~adoc-mode~) -+ mentor + messages -+ mini-modeline + minimap -+ mmm-mode + mode-line + mood-line + moody + mpdel + mu4e + multiple-cursors -+ nano-modeline + neotree + notmuch + num3-mode @@ -4698,11 +3763,8 @@ have lots of extensions, so the "full support" may not be 100% true… + pdf-tools + persp-mode + perspective -+ phi-grep -+ pomidor + popup + powerline -+ powerline-evil + prism ([[#h:a94272e0-99da-4149-9e80-11a7e67a2cf2][Note for prism.el]]) + prescient + proced @@ -4710,19 +3772,15 @@ have lots of extensions, so the "full support" may not be 100% true… + pulse + pyim + quick-peek -+ racket-mode -+ rainbow-blocks + rainbow-delimiters + rcirc ++ rcirc-color + recursion-indicator + regexp-builder (also known as ~re-builder~) + rg (rg.el) + ripgrep + rmail + ruler-mode -+ selectrum -+ selectrum-prescient -+ semantic + sesman + shell-script-mode + shortdoc @@ -4734,9 +3792,7 @@ have lots of extensions, so the "full support" may not be 100% true… + slime (slbd) + sly + smart-mode-line -+ smartparens + smerge -+ spaceline + speedbar + spell-fu + stripes @@ -4746,20 +3802,16 @@ have lots of extensions, so the "full support" may not be 100% true… + sx + symbol-overlay + syslog-mode -+ tab-bar-groups + tab-bar-mode + tab-line-mode + table (built-in {{{file(table.el)}}}) + telega -+ telephone-line + terraform-mode + term + textsec -+ tomatinho + transient (pop-up windows such as Magit's) + trashed + tree-sitter -+ treemacs + tty-menu + tuareg + typescript @@ -4779,15 +3831,12 @@ have lots of extensions, so the "full support" may not be 100% true… + which-key + whitespace-mode + window-divider-mode -+ winum + writegood-mode + woman + xah-elisp-mode -+ xref + xterm-color (and ansi-colors) + yaml-mode + yasnippet -+ ztree Plus many other miscellaneous faces that are provided by Emacs. @@ -4802,34 +3851,45 @@ inherit from some basic faces or their dependencies which are directly supported by the themes. + ag ++ apropos + apt-sources-list ++ bbdb ++ bm ++ breakpoint (provided by the built-in {{{file(gdb-mi.el)}}} library) + buffer-expose + bufler + counsel-notmuch + counsel-org-capture-string + dashboard (emacs-dashboard) + define-word ++ denote + disk-usage + dtache + dynamic-ruler + easy-kill ++ ebdb + edit-indirect + egerrit + elfeed-summary + evil-owl + flyspell-correct + fortran-mode ++ freeze-it ++ forge + git-walktree + goggles + highlight-defined + highlight-escape-sequences (~hes-mode~) ++ icomplete-vertical + i3wm-config-mode ++ lin + minibuffer-line + no-emoji + org-remark + parrot + perl-mode + php-mode ++ pulsar + rjsx-mode + side-hustle + spell-fu @@ -4840,6 +3900,7 @@ supported by the themes. + vdiff + vertico-indexed + vertico-mouse ++ xref * Notes on individual packages :properties: @@ -4883,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 @@ -4895,16 +3957,21 @@ length elsewhere in this manual: [[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]. -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. #+begin_src emacs-lisp (defun my-modus-themes-custom-faces () (modus-themes-with-colors (custom-set-faces - ;; Replace green with blue if you use `modus-themes-deuteranopia'. - `(git-gutter-fr:added ((,class :foreground ,green-fringe-bg))) - `(git-gutter-fr:deleted ((,class :foreground ,red-fringe-bg))) - `(git-gutter-fr:modified ((,class :foreground ,yellow-fringe-bg)))))) + ;; Make foreground the same as background for a uniform bar on + ;; Doom Emacs. + ;; + ;; Doom should not be implementing such hacks because themes + ;; cannot support them: + ;; <https://protesilaos.com/codelog/2022-08-04-doom-git-gutter-modus-themes/>. + `(git-gutter-fr:added ((,c :foreground ,bg-added-intense))) + `(git-gutter-fr:deleted ((,c :foreground ,bg-removed-intense))) + `(git-gutter-fr:modified ((,c :foreground ,bg-changed-intense)))))) (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src @@ -4917,24 +3984,24 @@ If the above does not work, try this instead: (after! modus-themes (modus-themes-with-colors (custom-set-faces - ;; Replace green with blue if you use `modus-themes-deuteranopia'. - `(git-gutter-fr:added ((,class :foreground ,green-fringe-bg))) - `(git-gutter-fr:deleted ((,class :foreground ,red-fringe-bg))) - `(git-gutter-fr:modified ((,class :foreground ,yellow-fringe-bg)))))) + ;; Make foreground the same as background for a uniform bar on + ;; Doom Emacs. + ;; + ;; Doom should not be implementing such hacks because themes + ;; cannot support them: + ;; <https://protesilaos.com/codelog/2022-08-04-doom-git-gutter-modus-themes/>. + `(git-gutter-fr:added ((,c :foreground ,bg-added-intense))) + `(git-gutter-fr:deleted ((,c :foreground ,bg-removed-intense))) + `(git-gutter-fr:modified ((,c :foreground ,bg-changed-intense)))))) #+end_src -Replace ~green-fringe-bg~ with ~blue-fringe-bg~ if you want to optimize -for red-green color deficiency. - -[[#h:3ed03a48-20d8-4ce7-b214-0eb7e4c79abe][Option for red-green color deficiency or deuteranopia]]. - ** Note on php-mode multiline comments :PROPERTIES: :CUSTOM_ID: h:d0a3157b-9c04-46e8-8742-5fb2a7ae8798 :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: @@ -5042,10 +4109,10 @@ elsewhere in this document. For example: #+begin_src emacs-lisp (modus-themes-with-colors (custom-set-faces - `(fill-column-indicator ((,class :foreground ,bg-active))))) + `(fill-column-indicator ((,c :foreground ,bg-active))))) #+end_src -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. To make the line thicker, set the height to be equal to the base font size instead of the one pixel we use. This is done by specifying a rate @@ -5055,7 +4122,7 @@ For example: #+begin_src emacs-lisp (modus-themes-with-colors (custom-set-faces - `(fill-column-indicator ((,class :height 1.0 :background ,bg-inactive :foreground ,bg-inactive))))) + `(fill-column-indicator ((,c :height 1.0 :background ,bg-inactive :foreground ,bg-inactive))))) #+end_src ** Note on highlight-parentheses.el @@ -5063,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 @@ -5113,14 +4180,14 @@ found): ;; Here we set color combinations that involve both a background ;; and a foreground value. - (setq highlight-parentheses-background-colors (list cyan-refine-bg - magenta-refine-bg - green-refine-bg - yellow-refine-bg) - highlight-parentheses-colors (list cyan-refine-fg - magenta-refine-fg - green-refine-fg - yellow-refine-fg)) + (setq highlight-parentheses-background-colors (list bg-cyan-intense + bg-magenta-intense + bg-green-intense + bg-yellow-intense) + highlight-parentheses-colors (list cyan + magenta + green + yellow)) ;; And here we pass only foreground colors while disabling any ;; backgrounds. @@ -5160,14 +4227,14 @@ implementation: ;; Here we set color combinations that involve both a background ;; and a foreground value. - (setq highlight-parentheses-background-colors (list cyan-refine-bg - magenta-refine-bg - green-refine-bg - yellow-refine-bg) - highlight-parentheses-colors (list cyan-refine-fg - magenta-refine-fg - green-refine-fg - yellow-refine-fg)) + (setq highlight-parentheses-background-colors (list bg-cyan-intense + bg-magenta-intense + bg-green-intense + bg-yellow-intense) + highlight-parentheses-colors (list cyan + magenta + green + yellow)) ;; And here we pass only foreground colors while disabling any ;; backgrounds. @@ -5221,7 +4288,7 @@ Users who might prefer to fall below the minimum 7:1 contrast ratio in relative luminance (the accessibility target we conform with), can opt to configure the relevant faces on their own. -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. This example uses more vivid background colors, though it comes at the very high cost of degraded legibility. @@ -5229,14 +4296,14 @@ very high cost of degraded legibility. #+begin_src emacs-lisp (modus-themes-with-colors (custom-set-faces - `(mmm-cleanup-submode-face ((,class :background ,yellow-refine-bg))) - `(mmm-code-submode-face ((,class :background ,bg-active))) - `(mmm-comment-submode-face ((,class :background ,blue-refine-bg))) - `(mmm-declaration-submode-face ((,class :background ,cyan-refine-bg))) - `(mmm-default-submode-face ((,class :background ,bg-alt))) - `(mmm-init-submode-face ((,class :background ,magenta-refine-bg))) - `(mmm-output-submode-face ((,class :background ,red-refine-bg))) - `(mmm-special-submode-face ((,class :background ,green-refine-bg))))) + `(mmm-cleanup-submode-face ((,c :background ,bg-yellow-intense))) + `(mmm-code-submode-face ((,c :background ,bg-inactive))) + `(mmm-comment-submode-face ((,c :background ,bg-blue-intense))) + `(mmm-declaration-submode-face ((,c :background ,bg-cyan-intense))) + `(mmm-default-submode-face ((,c :background ,bg-dim))) + `(mmm-init-submode-face ((,c :background ,bg-magenta-intense))) + `(mmm-output-submode-face ((,c :background ,bg-red-intense))) + `(mmm-special-submode-face ((,c :background ,bg-green-intense))))) #+end_src ** Note on prism.el @@ -5250,13 +4317,14 @@ 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 {{{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. +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][Face specs at scale using the themes' palette]]. +macro: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. These are the minimum recommended settings with 16 colors: @@ -5269,20 +4337,20 @@ These are the minimum recommended settings with 16 colors: :colors (modus-themes-with-colors (list fg-main magenta - cyan-alt-other - magenta-alt-other + cyan-cooler + magenta-cooler blue - magenta-alt - cyan-alt - red-alt-other + magenta-warmer + cyan-warmer + red-cooler green fg-main cyan yellow - blue-alt - red-alt - green-alt-other - fg-special-warm))) + blue-warmer + red-warmer + green-cooler + yellow-faint))) #+end_src With 8 colors: @@ -5296,11 +4364,11 @@ With 8 colors: :colors (modus-themes-with-colors (list blue magenta - magenta-alt-other - cyan-alt-other + magenta-cooler + cyan-cooler fg-main - blue-alt - red-alt-other + blue-warmer + red-cooler cyan))) #+end_src @@ -5316,8 +4384,8 @@ to the themes' default aesthetic: :colors (modus-themes-with-colors (list blue magenta - magenta-alt-other - green-alt))) + magenta-cooler + green-warmer))) #+end_src If you need to apply desaturation and lightening, you can use what the @@ -5330,47 +4398,11 @@ examples with the 4, 8, 16 colors): :lightens (cl-loop for i from 0 below 16 collect (* i 2.5)) :colors (modus-themes-with-colors (list fg-main - cyan-alt-other - magenta-alt-other + cyan-cooler + magenta-cooler magenta))) #+end_src -** Note on god-mode.el -:properties: -:alt_title: Note for god-mode -:custom_id: h:4da1d515-3e05-47ef-9e45-8251fc7e986a -:end: - -The ~god-mode~ library does not provide faces that could be configured by -the Modus themes. Users who would like to get some visual feedback on -the status of {{{kbd(M-x god-mode)}}} are instead encouraged by upstream to -set up their own configurations, such as by changing the ~mode-line~ face -([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). This is an adaptation of the approach -followed in the upstream README: - -#+begin_src emacs-lisp -(defun my-god-mode-update-mode-line () - "Make `mode-line' blue if God local mode is active." - (modus-themes-with-colors - (if god-local-mode - (set-face-attribute 'mode-line nil - :foreground blue-active - :background bg-active-accent - :box blue) - (set-face-attribute 'mode-line nil - :foreground fg-active - :background bg-active - :box fg-alt)))) - -(add-hook 'post-command-hook 'my-god-mode-update-mode-line) -#+end_src - -We employ the ~modus-themes-with-colors~ which provides access to color -variables defined by the active theme. Its use is covered elsewhere in -this manual ([[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]). As for the -attributes that can be passed to each face, start by consulting the -documentation string of ~set-face-attribute~. - ** Note on company-mode overlay pop-up :properties: :custom_id: h:20cef8c4-d11f-4053-8b2c-2872925780b1 @@ -5387,6 +4419,8 @@ instead of overlays.[fn:: https://github.com/company-mode/company-mode/issues/1010][fn:: https://github.com/tumashu/company-posframe/] +Also consider the ~corfu~ package. + ** Note on ERC escaped color sequences :properties: :custom_id: h:98bdf319-1e32-4469-8a01-771200fba65c @@ -5446,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]]. @@ -5466,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) @@ -5482,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: @@ -5500,38 +4535,6 @@ would be a good baseline for many themes and/or user configurations. Our target is the highest of the sort, though we do not demand that everyone conforms with it. -** Note on Helm grep -:properties: -:custom_id: h:d28879a2-8e4b-4525-986e-14c0f873d229 -:end: - -There is one face from the Helm package that is meant to highlight the -matches of a grep or grep-like command (=ag= or =ripgrep=). It is -~helm-grep-match~. However, this face can only apply when the user does -not pass =--color=always= as a command-line option for their command. - -Here is the docstring for that face, which is defined in the -{{{file(helm-grep.el)}}} library (you can always visit the source code with -{{{kbd(M-x find-library)}}}). - -#+begin_quote -Face used to highlight grep matches. Have no effect when grep backend -use "--color=" -#+end_quote - -The user must either remove =--color= from the flags passed to the grep -function, or explicitly use =--color=never= (or equivalent). Helm -provides user-facing customization options for controlling the grep -function's parameters, such as ~helm-grep-default-command~ and -~helm-grep-git-grep-command~. - -When =--color=always= is in effect, the grep output will use red text in -bold letter forms to present the matching part in the list of -candidates. That style still meets the contrast ratio target of >= 7:1 -(accessibility standard WCAG AAA), because it draws the reference to -ANSI color number 1 (red) from the already-supported array of -~ansi-color-names-vector~. - ** Note on pdf-tools link hints :properties: :custom_id: h:2659d13e-b1a5-416c-9a89-7c3ce3a76574 @@ -5603,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 @@ -5849,15 +4852,15 @@ A good theme is one that does so with consistency, though not uniformity. In practical terms, a color scheme is what one uses when, for example, -they edit the first sixteen escape sequences of a terminal emulator to -the hues of their preference. The terminal offers the option to choose, -say, the exact value of what counts as "red", but does not provide the -means to control where that is mapped to and whether it should also have -other qualities such as a bold weight for the underlying text or an -added background color. In contradistinction, Emacs uses constructs -known as "faces" which allow the user/developer to specify where a given -color will be used and whether it should be accompanied by other -typographic or stylistic attributes. +they replace the first sixteen escape sequences of a terminal emulator +with color values of their preference. The terminal offers the option +to choose, say, the exact value of what counts as "red", but does not +provide the means to control where that is mapped to and whether it +should also have other qualities such as a bold weight for the +underlying text or an added background color. In contradistinction, +Emacs uses constructs known as "faces" which allow the user/developer +to specify where a given color will be used and whether it should be +accompanied by other typographic or stylistic attributes. By configuring the multitude of faces on offer we thus control both which colors are applied and how they appear in their context. When a @@ -5876,9 +4879,7 @@ it is already understood that one must follow the indicator or headline to view its contents and (ii) underlining everything would make the interface virtually unusable. -[[#h:5808be52-361a-4d18-88fd-90129d206f9b][Option for links]]. - -Again, one must exercise judgment in order to avoid discrimination, +Again, one must exercise judgement in order to avoid discrimination, where "discrimination" refers to: + The treatment of substantially different magnitudes as if they were of @@ -5888,9 +4889,9 @@ where "discrimination" refers to: (To treat similar things differently; to treat dissimilar things alike.) -If, in other words, one was to enforce uniformity without accounting for -the particular requirements of each case---the contextual demands for -usability beyond matters of color---they would be making a +If, in other words, one is to enforce uniformity without accounting +for the particular requirements of each case---the contextual demands +for usability beyond matters of color---they are making a not-so-obvious error of treating different cases as if they were the same. @@ -5923,13 +4924,13 @@ doing so would run contrary to how this project is maintained where details matter greatly. Each program has its own requirements so it won't always be -possible---or indeed desirable---to have 1:1 correspondence between what -applies to Emacs and what should be done elsewhere. No port should ever -strive to be a faithful copy of the Emacs implementation, as no other -program is an Emacs equivalent, but instead try to follow the spirit of -the design. For example, some of the customization options accept a -list as their value, or an alist, which may not be possible to reproduce -on other platforms. +possible---or indeed desirable---to have 1:1 correspondence between +what applies to Emacs and what should be done elsewhere. No port +should ever strive to be a copy of the Emacs implementation, as no +other program is an Emacs equivalent, but instead try to follow the +spirit of the design. For example, some of the customization options +accept a list as their value, or an alist, which may not be possible +to reproduce on other platforms. [[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization options]]. @@ -5939,10 +4940,10 @@ standards are not compromised and (ii) the overall character of the themes remains consistent. The former criterion should be crystal clear as it pertains to the -scientific foundations of the themes: high legibility and taking care of -the needs of users with red-green color deficiency (deuteranopia) by -avoiding red+green color coding paradigms and/or by providing red+blue -variants. +scientific foundations of the themes: high legibility and taking care +of the needs of users with red-green color deficiency (deuteranopia) +by avoiding red+green color coding paradigms and/or by providing +yellow+blue variants ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). The latter criterion is the "je ne sais quoi" of the artistic aspect of the themes, which is partially fleshed out in this manual. @@ -5951,7 +4952,7 @@ the themes, which is partially fleshed out in this manual. With regard to the artistic aspect (where "art" qua skill may amount to an imprecise science), there is no hard-and-fast rule in effect as it -requires one to exercise discretion and make decisions based on +requires one to exercize discretion and make decisions based on context-dependent information or constraints. As is true with most things in life, when in doubt, do not cling on to the letter of the law but try to understand its spirit. @@ -5980,13 +4981,17 @@ in which you can contribute to their ongoing development. :end: #+cindex: Sources of the themes -The ~modus-operandi~ and ~modus-vivendi~ themes are built into Emacs 28. - -The source code of the themes is [[https://git.sr.ht/~protesilaos/modus-themes][available on SourceHut]]. Or check the -[[https://gitlab.com/protesilaos/modus-themes/][GitLab mirror (former main source)]] and the [[https://github.com/protesilaos/modus-themes/][GitHub mirror]]. - -An HTML version of this manual is provided as an extension of the -[[https://protesilaos.com/emacs/modus-themes/][author's personal website]] (does not rely on any non-free code). ++ Package name (GNU ELPA): ~modus-themes~ ++ Official manual: <https://protesilaos.com/emacs/modus-themes> ++ Change log: <https://protesilaos.com/emacs/modus-themes-changelog> ++ Color palette: <https://protesilaos.com/emacs/modus-themes-colors> ++ Sample pictures: <https://protesilaos.com/emacs/modus-themes-pictures> ++ Git repo on SourceHut: <https://git.sr.ht/~protesilaos/modus-themes> + - Mirrors: + + GitHub: <https://github.com/protesilaos/modus-themes> + + GitLab: <https://gitlab.com/protesilaos/modus-themes> ++ Mailing list: <https://lists.sr.ht/~protesilaos/modus-themes> ++ Backronym: My Old Display Unexpectedly Sharpened ... themes ** Issues you can help with :properties: @@ -5994,10 +4999,8 @@ An HTML version of this manual is provided as an extension of the :end: #+cindex: Contributing -#+findex: modus-themes-report-bug A few tasks you can help with by sending an email to the general -[[https://lists.sr.ht/~protesilaos/modus-themes][modus-themes public mailing list]] (or use the command -~modus-themes-report-bug~). +[[https://lists.sr.ht/~protesilaos/modus-themes][modus-themes public mailing list]]. + Suggest refinements to packages that are covered. + Report packages not covered thus far. @@ -6014,10 +5017,6 @@ It is preferable that your feedback includes some screenshots, GIFs, or short videos, as well as further instructions to reproduce a given setup. Though this is not a requirement. -#+findex: modus-themes-version -Also consider mentioning the version of the themes you are using, such -as by invoking the command ~modus-themes-version~. - Whatever you do, bear in mind the overarching objective of the Modus themes: to keep a contrast ratio that is greater or equal to 7:1 between background and foreground colors. If a compromise is ever necessary @@ -6097,45 +5096,50 @@ The Modus themes are a collective effort. Every bit of work matters. + Author/maintainer :: Protesilaos Stavrou. -+ Contributions to code or documentation :: Alex Griffin, Anders - Johansson, Antonio Ruiz, Basil L.{{{space()}}} Contovounesios, Björn - Lindström, Carlo Zancanaro, Christian Tietze, Daniel Mendler, Eli - Zaretskii, Fritz Grabo, Illia Ostapyshyn, Kévin 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. ++ Contributions to code or documentation :: Aleksei Gusev, Alex + Griffin, Anders Johansson, Antonio Ruiz, Basil L.{{{space()}}} + Contovounesios, Björn Lindström, Carlo Zancanaro, Christian Tietze, + Daniel Mendler, Eli Zaretskii, Fritz Grabo, Illia Ostapyshyn, Kévin + 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č, 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, 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, Christian Tietze, + 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, 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, Iris Garcia, Ivan Popovych, 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, Len - Trigg, Lennart C. Karssen, Luis Miguel Castañeda, Magne Hov, Manuel - Uberti, Mark Bestley, Mark Burton, Mark Simpson, Markus Beppler, - Matt Armstrong, Matthias Fuchs, 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 + 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, 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, Trey, bepolymathe, bit9tream, derek-upham, doolio, - fleimgruber, gitrj95, iSeeU, jixiuf, okamsn, pRot0ta1p. + 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 @@ -6153,42 +5157,6 @@ themes' design and/or aspects of their functionality. All errors are my own. -* Other notes about the project -:properties: -:custom_id: h:13752581-4378-478c-af17-165b6e76bc1b -:end: -#+cindex: Development notes - -If you are curious about the principles that govern the development of -this project read the essay [[https://protesilaos.com/codelog/2020-03-17-design-modus-themes-emacs/][On the design of the Modus themes]] -(2020-03-17). - -Here are some more publications for those interested in the kind of work -that goes into this project (sometimes the commits also include details -of this sort): - -+ [[https://protesilaos.com/codelog/2020-05-10-modus-operandi-palette-review/][Modus Operandi theme subtle palette review]] (2020-05-10) -+ [[https://protesilaos.com/codelog/2020-06-13-modus-vivendi-palette-review/][Modus Vivendi theme subtle palette review]] (2020-06-13) -+ [[https://protesilaos.com/codelog/2020-07-04-modus-themes-faint-colours/][Modus themes: new "faint syntax" option]] (2020-07-04) -+ [[https://protesilaos.com/codelog/2020-07-08-modus-themes-nuanced-colours/][Modus themes: major review of "nuanced" colours]] (2020-07-08) -+ [[https://protesilaos.com/codelog/2020-09-14-modus-themes-review-blues/][Modus themes: review of blue colours]] (2020-09-14) -+ [[https://protesilaos.com/codelog/2020-12-27-modus-themes-review-rainbow-delimiters/][Modus themes: review rainbow-delimiters faces]] (2020-12-27) -+ [[https://protesilaos.com/codelog/2021-01-11-modus-themes-review-select-faint-colours/][Modus themes: review of select "faint" colours]] (2021-01-11) -+ [[https://protesilaos.com/codelog/2021-02-25-modus-themes-diffs-deuteranopia/][The Modus themes now cover deuteranopia in diffs]] (2021-02-25) -+ [[https://protesilaos.com/codelog/2021-06-02-modus-themes-org-agenda/][Introducing the variable modus-themes-org-agenda]] (2021-06-02) -+ [[https://protesilaos.com/codelog/2022-01-02-review-modus-themes-org-habit-colours/][Modus themes: review of the org-habit graph colours]] (2022-01-02) -+ [[https://protesilaos.com/codelog/2022-01-03-modus-themes-port-faq/][Re: VSCode or Vim ports of the Emacs modus-themes?]] (2022-01-03) -+ [[https://protesilaos.com/codelog/2022-04-20-modus-themes-case-study-avy/][Modus themes: case study on Avy faces and colour combinations]] (2022-04-20) -+ [[https://protesilaos.com/codelog/2022-04-21-modus-themes-colour-theory/][Emacs: colour theory and techniques used in the Modus themes]] (2022-04-21) - -And here are the canonical sources of this project: - -+ Manual :: <https://protesilaos.com/emacs/modus-themes> -+ Change Log :: <https://protesilaos.com/emacs/modus-themes-changelog> -+ Screenshots :: <https://protesilaos.com/emacs/modus-themes-pictures> -+ Git repository :: https://git.sr.ht/~protesilaos/modus-themes -+ Mailing list :: https://lists.sr.ht/~protesilaos/modus-themes - * GNU Free Documentation License :properties: :appendix: t diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi index d71895da5db..4a0311cad42 100644 --- a/doc/misc/newsticker.texi +++ b/doc/misc/newsticker.texi @@ -307,11 +307,16 @@ news ticker. @findex newsticker-start-ticker @findex newsticker-stop-ticker +@vindex newsticker-ticker-period Headlines can be displayed in the echo area, either scrolling like messages in a stock-quote ticker, or just changing. This can be started with the command @code{newsticker-start-ticker}. It can be stopped with @code{newsticker-stop-ticker}. +The ticker by default runs continuously. To only run it once, at a +specific time interval, set the @code{newsticker-ticker-period} +variable. + @node Navigation @section Navigation @@ -542,8 +547,10 @@ are shown in the echo area, i.e., the ``ticker''. @itemize @item @vindex newsticker-display-interval +@vindex newsticker-ticker-period @vindex newsticker-scroll-smoothly -@code{newsticker-ticker-interval} and +@code{newsticker-ticker-interval}, +@code{newsticker-ticker-period}, and @code{newsticker-scroll-smoothly} define how headlines are shown in the echo area. @end itemize 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/rcirc.texi b/doc/misc/rcirc.texi index 41930f154c2..6b10d1ab2a4 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -691,11 +691,11 @@ window is showing them), the mode line will now show you the abbreviated channel or nick name. Use @kbd{C-c C-@key{SPC}} to switch to these buffers. -@cindex rcirc-track-abbrevate-flag +@cindex rcirc-track-abbreviate-flag By default the channel names are abbreviated, set -@code{rcirc-track-abbrevate-flag} to a non-@code{nil} value. This might be -interesting if the IRC activities are not tracked in the mode line, -but somewhere else. +@code{rcirc-track-abbreviate-flag} to a non-@code{nil} value. This +might be interesting if the IRC activities are not tracked in the mode +line, but somewhere else. @vindex rcirc-mode-hook If you prefer not to load @code{rcirc} immediately, you can delay the diff --git a/doc/misc/sc.texi b/doc/misc/sc.texi index d4b39d4ee39..9bf7c36b481 100644 --- a/doc/misc/sc.texi +++ b/doc/misc/sc.texi @@ -404,7 +404,7 @@ from the alist with the @code{sc-mail-field} function. Thus, if the following fields were present in the original article: @example -Date:@: 08 April 1991, 17:32:09 EST +Date:@: 08 Apr 1991 17:32:09 -0500 Subject:@: Better get out your asbestos suit @end example @@ -415,7 +415,7 @@ then, the following lisp constructs return: @example (sc-mail-field "date") -==> "08 April 1991, 17:32:09 EST" +==> "08 Apr 1991 17:32:09 -0500" (sc-mail-field "subject") ==> "Better get out your asbestos suit" diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 7858bf152c3..1ddfef4b878 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2022-11-12.22} +\def\texinfoversion{2023-03-04.12} % -% Copyright 1985--1986, 1988, 1990--2023 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2023 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as @@ -58,12 +58,6 @@ \message{Loading texinfo [version \texinfoversion]:} -% If in a .fmt file, print the version number -% and turn on active characters that we couldn't do earlier because -% they might have appeared in the input file name. -\everyjob{\message{[Texinfo version \texinfoversion]}% - \catcode`+=\active \catcode`\_=\active} - % LaTeX's \typeout. This ensures that the messages it is used for % are identical in format to the corresponding ones from latex/pdflatex. \def\typeout{\immediate\write17}% @@ -530,7 +524,7 @@ % ... but they get defined via ``\envdef\foo{...}'': \long\def\envdef#1#2{\def#1{\startenvironment#1#2}} -\def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}} +\long\def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}} % Check whether we're in the right environment: \def\checkenv#1{% @@ -591,6 +585,9 @@ % @/ allows a line break. \let\/=\allowbreak +% @- allows explicit insertion of hyphenation points +\def\-{\discretionary{\normaldash}{}{}}% + % @. is an end-of-sentence period. \def\.{.\spacefactor=\endofsentencespacefactor\space} @@ -1197,13 +1194,17 @@ output) for that.)} % % Set color, and create a mark which defines \thiscolor accordingly, % so that \makeheadline knows which color to restore. + \def\curcolor{0 0 0}% \def\setcolor#1{% - \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% - \domark - \pdfsetcolor{#1}% + \ifx#1\curcolor\else + \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% + \domark + \pdfsetcolor{#1}% + \xdef\curcolor{#1}% + \fi } % - \def\maincolor{\rgbBlack} + \let\maincolor\rgbBlack \pdfsetcolor{\maincolor} \edef\thiscolor{\maincolor} \def\currentcolordefs{} @@ -1359,7 +1360,7 @@ output) for that.)} % % by default, use black for everything. \def\urlcolor{\rgbBlack} - \def\linkcolor{\rgbBlack} + \let\linkcolor\rgbBlack \def\endlink{\setcolor{\maincolor}\pdfendlink} % % Adding outlines to PDF; macros for calculating structure of outlines @@ -1537,9 +1538,10 @@ output) for that.)} \next} \def\makelink{\addtokens{\toksB}% {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} - \def\pdflink#1{% + \def\pdflink#1{\pdflinkpage{#1}{#1}}% + \def\pdflinkpage#1#2{% \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}} - \setcolor{\linkcolor}#1\endlink} + \setcolor{\linkcolor}#2\endlink} \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} \else % non-pdf mode @@ -1786,10 +1788,11 @@ output) for that.)} \next} \def\makelink{\addtokens{\toksB}% {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} - \def\pdflink#1{% + \def\pdflink#1{\pdflinkpage{#1}{#1}}% + \def\pdflinkpage#1#2{% \special{pdf:bann << /Border [0 0 0] /Type /Annot /Subtype /Link /A << /S /GoTo /D (#1) >> >>}% - \setcolor{\linkcolor}#1\endlink} + \setcolor{\linkcolor}#2\endlink} \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} % % @@ -2134,6 +2137,11 @@ end \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}% }% \fi\fi +% +% This is what gets called when #5 of \setfont is empty. +\let\cmap\gobble +% +% (end of cmaps) % Set the font macro #1 to the font named \fontprefix#2. @@ -2149,11 +2157,10 @@ end \def\setfont#1#2#3#4#5{% \font#1=\fontprefix#2#3 scaled #4 \csname cmap#5\endcsname#1% + \ifx#2\ttshape\hyphenchar#1=-1 \fi + \ifx#2\ttbshape\hyphenchar#1=-1 \fi + \ifx#2\ttslshape\hyphenchar#1=-1 \fi } -% This is what gets called when #5 of \setfont is empty. -\let\cmap\gobble -% -% (end of cmaps) % Use cm as the default font prefix. % To specify the font prefix, you must define \fontprefix @@ -2674,26 +2681,23 @@ end \gdef\setcodequotes{\let`\codequoteleft \let'\codequoteright} \gdef\setregularquotes{\let`\lq \let'\rq} } +\setregularquotes -% Allow an option to not use regular directed right quote/apostrophe -% (char 0x27), but instead the undirected quote from cmtt (char 0x0d). -% The undirected quote is ugly, so don't make it the default, but it -% works for pasting with more pdf viewers (at least evince), the -% lilypond developers report. xpdf does work with the regular 0x27. +% output for ' in @code +% in tt font hex 0D (undirected) or 27 (curly right quote) % \def\codequoteright{% \ifusingtt {\ifflagclear{txicodequoteundirected}% {\ifflagclear{codequoteundirected}% {'}% - {\char'15 }}% - {\char'15 }}% + {\char"0D }}% + {\char"0D }}% {'}% } -% and a similar option for the left quote char vs. a grave accent. -% Modern fonts display ASCII 0x60 as a grave accent, so some people like -% the code environments to do likewise. +% output for ` in @code +% in tt font hex 12 (grave accent) or 60 (curly left quote) % \relax disables Spanish ligatures ?` and !` of \tt font. % \def\codequoteleft{% @@ -2701,8 +2705,8 @@ end {\ifflagclear{txicodequotebacktick}% {\ifflagclear{codequotebacktick}% {\relax`}% - {\char'22 }}% - {\char'22 }}% + {\char"12 }}% + {\char"12 }}% {\relax`}% } @@ -2721,7 +2725,7 @@ end \errmessage{Unknown @codequoteundirected value `\temp', must be on|off}% \fi\fi } -% + \parseargdef\codequotebacktick{% \def\temp{#1}% \ifx\temp\onword @@ -2736,6 +2740,11 @@ end \fi\fi } +% Turn them on by default +\let\SETtxicodequoteundirected = t +\let\SETtxicodequotebacktick = t + + % [Knuth] pp. 380,381,391, disable Spanish ligatures ?` and !` of \tt font. \def\noligaturesquoteleft{\relax\lq} @@ -2815,13 +2824,6 @@ end % @sansserif, explicit sans. \def\sansserif#1{{\sf #1}} -% We can't just use \exhyphenpenalty, because that only has effect at -% the end of a paragraph. Restore normal hyphenation at the end of the -% group within which \nohyphenation is presumably called. -% -\def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation} -\def\restorehyphenation{\hyphenchar\font = `- } - \newif\iffrenchspacing \frenchspacingfalse @@ -2890,27 +2892,29 @@ end % Switch to typewriter. \tt % - % But `\ ' produces the large typewriter interword space. + % `\ ' produces the large typewriter interword space. \def\ {{\spaceskip = 0pt{} }}% % - % Turn off hyphenation. - \nohyphenation - % \plainfrenchspacing #1% }% \null % reset spacefactor to 1000 } -% We *must* turn on hyphenation at `-' and `_' in @code. -% (But see \codedashfinish below.) +% This is for LuaTeX: It is not sufficient to disable hyphenation at +% explicit dashes by setting `\hyphenchar` to -1. +\def\dashnobreak{% + \normaldash + \penalty 10000 } + +% We must turn on hyphenation at `-' and `_' in @code. % Otherwise, it is too hard to avoid overfull hboxes % in the Emacs manual, the Library manual, etc. +% We explicitly allow hyphenation at these characters +% using \discretionary. % -% Unfortunately, TeX uses one parameter (\hyphenchar) to control -% both hyphenation at - and hyphenation within words. -% We must therefore turn them both off (\tclose does that) -% and arrange explicitly to hyphenate at a dash. -- rms. +% Hyphenation at - and hyphenation within words was turned off +% by default for the tt fonts using the \hyphenchar parameter of TeX. { \catcode`\-=\active \catcode`\_=\active \catcode`\'=\active \catcode`\`=\active @@ -2923,13 +2927,9 @@ end \let-\codedash \let_\codeunder \else - \let-\normaldash + \let-\dashnobreak \let_\realunder \fi - % Given -foo (with a single dash), we do not want to allow a break - % after the hyphen. - \global\let\codedashprev=\codedash - % \codex } % @@ -2939,21 +2939,30 @@ end % % Now, output a discretionary to allow a line break, unless % (a) the next character is a -, or - % (b) the preceding character is a -. + % (b) the preceding character is a -, or + % (c) we are at the start of the string. + % In both cases (b) and (c), \codedashnobreak should be set to \codedash. + % % E.g., given --posix, we do not want to allow a break after either -. % Given --foo-bar, we do want to allow a break between the - and the b. \ifx\next\codedash \else - \ifx\codedashprev\codedash + \ifx\codedashnobreak\codedash \else \discretionary{}{}{}\fi \fi % we need the space after the = for the case when \next itself is a % space token; it would get swallowed otherwise. As in @code{- a}. - \global\let\codedashprev= \next + \global\let\codedashnobreak= \next } } \def\normaldash{-} % -\def\codex #1{\tclose{#1}\endgroup} +\def\codex #1{\tclose{% + % Given -foo (with a single dash), we do not want to allow a break + % after the -. \codedashnobreak is set to the first character in + % @code. + \futurelet\codedashnobreak\relax + #1% +}\endgroup} \def\codeunder{% % this is all so @math{@code{var_name}+1} can work. In math mode, _ @@ -3200,7 +3209,7 @@ end % definition of @key with no lozenge. % -\def\key#1{{\setregularquotes \nohyphenation \tt #1}\null} +\def\key#1{{\setregularquotes \tt #1}\null} % @clicksequence{File @click{} Open ...} \def\clicksequence#1{\begingroup #1\endgroup} @@ -3740,13 +3749,14 @@ $$% want the contents after the title page.}}% \parseargdef\shorttitlepage{% - \begingroup \hbox{}\vskip 1.5in \chaprm \centerline{#1}% - \endgroup\page\hbox{}\page} + {\headingsoff \begingroup \hbox{}\vskip 1.5in \chaprm \centerline{#1}% + \endgroup\page\hbox{}\page}\pageone} \envdef\titlepage{% % Open one extra group, as we want to close it in the middle of \Etitlepage. \begingroup \parindent=0pt \textfonts + \headingsoff % Leave some space at the very top of the page. \vglue\titlepagetopglue % No rule at page bottom unless we print one at the top with @title. @@ -3774,11 +3784,9 @@ $$% % If we use the new definition of \page, we always get a blank page % after the title page, which we certainly don't want. \oldpage + \pageone \endgroup % - % Need this before the \...aftertitlepage checks so that if they are - % in effect the toc pages will come out with page numbers. - \HEADINGSon } \def\finishtitlepage{% @@ -3947,35 +3955,24 @@ $$% } \def\HEADINGSoff{{\globaldefs=1 \headingsoff}} % global setting -\HEADINGSoff % it's the default -% When we turn headings on, set the page number to 1. +% Set the page number to 1. \def\pageone{ \global\pageno=1 \global\arabiccount = \pagecount } +\let\contentsalignmacro = \chappager + +% \def\HEADINGSon{\HEADINGSdouble} % defined by \CHAPPAGon + % For double-sided printing, put current file name in lower left corner, % chapter name on inside top of right hand pages, document % title on inside top of left hand pages, and page numbers on outside top % edge of all pages. -\def\HEADINGSdouble{% -\pageone -\HEADINGSdoublex -} -\let\contentsalignmacro = \chappager - -% For single-sided printing, chapter title goes across top left of page, -% page number on top right. -\def\HEADINGSsingle{% -\pageone -\HEADINGSsinglex -} -\def\HEADINGSon{\HEADINGSdouble} - -\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex} +\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdouble} \let\HEADINGSdoubleafter=\HEADINGSafter -\def\HEADINGSdoublex{% +\def\HEADINGSdouble{% \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\folio\hfil\thistitle}} @@ -3985,8 +3982,10 @@ $$% \global\let\contentsalignmacro = \chapoddpage } -\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex} -\def\HEADINGSsinglex{% +% For single-sided printing, chapter title goes across top left of page, +% page number on top right. +\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsingle} +\def\HEADINGSsingle{% \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} @@ -3998,7 +3997,6 @@ $$% % for @setchapternewpage off \def\HEADINGSsinglechapoff{% -\pageone \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} @@ -4104,6 +4102,7 @@ $$% \nobreak\kern\dimen0 \endgroup \itemxneedsnegativevskiptrue + \penalty 10021 % for \indexpar \fi } @@ -4220,6 +4219,7 @@ $$% % We can be in inner vertical mode in a footnote, although an % @itemize looks awful there. }% + \penalty 10021 % for \indexpar \flushcr } @@ -4724,13 +4724,11 @@ $$% % except not \outer, so it can be used within macros and \if's. \edef\newwrite{\makecsname{ptexnewwrite}} -% \newindex {foo} defines an index named IX. +% \newindex {IX} defines an index named IX. % It automatically defines \IXindex such that % \IXindex ...rest of line... puts an entry in the index IX. % It also defines \IXindfile to be the number of the output channel for % the file that accumulates this index. The file's extension is IX. -% The name of an index should be no more than 2 characters long -% for the sake of vms. % \def\newindex#1{% \expandafter\chardef\csname#1indfile\endcsname=0 @@ -4786,28 +4784,19 @@ $$% % and it is the two-letter name of the index. \def\doindex#1{\edef\indexname{#1}\parsearg\doindexxxx} -\def\doindexxxx #1{\doind{\indexname}{#1}} +\def\doindexxxx #1{\indexpar\doind{\indexname}{#1}} % like the previous two, but they put @code around the argument. \def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx} -\def\docodeindexxxx #1{\docind{\indexname}{#1}} - +\def\docodeindexxxx #1{\indexpar\docind{\indexname}{#1}} -% Used for the aux, toc and index files to prevent expansion of Texinfo -% commands. -% -\def\atdummies{% - \definedummyletter\@% - \definedummyletter\ % - \definedummyletter\{% - \definedummyletter\}% - \definedummyletter\&% - % - % Do the redefinitions. - \definedummies - \otherbackslash +% End any open paragraph, unless we are immediately after @item in +% @itemize or @enumerate. +\def\indexpar{% +\ifnum\lastpenalty=10021 \else\endgraf\fi } + % \definedummyword defines \#1 as \string\#1\space, thus effectively % preventing its expansion. This is used only for control words, % not control letters, because the \space would be incorrect for @@ -4823,110 +4812,91 @@ $$% % \def\definedummyword #1{\def#1{\string#1\space}}% \def\definedummyletter#1{\def#1{\string#1}}% -\let\definedummyaccent\definedummyletter -% Called from \atdummies to prevent the expansion of commands. +% Used for the aux, toc and index files to prevent expansion of Texinfo +% commands. Most of the commands are controlled through the +% \ifdummies conditional. % -\def\definedummies{% +\def\atdummies{% + \dummiestrue % - \let\commondummyword\definedummyword - \let\commondummyletter\definedummyletter - \let\commondummyaccent\definedummyaccent - \commondummiesnofonts + \definedummyletter\@% + \definedummyletter\ % + \definedummyletter\{% + \definedummyletter\}% + \definedummyletter\&% % \definedummyletter\_% \definedummyletter\-% % - % Non-English letters. - \definedummyword\AA - \definedummyword\AE - \definedummyword\DH - \definedummyword\L - \definedummyword\O - \definedummyword\OE - \definedummyword\TH - \definedummyword\aa - \definedummyword\ae - \definedummyword\dh - \definedummyword\exclamdown - \definedummyword\l - \definedummyword\o - \definedummyword\oe - \definedummyword\ordf - \definedummyword\ordm - \definedummyword\questiondown - \definedummyword\ss - \definedummyword\th - % - % Although these internal commands shouldn't show up, sometimes they do. - \definedummyword\bf - \definedummyword\gtr - \definedummyword\hat - \definedummyword\less - \definedummyword\sf - \definedummyword\sl - \definedummyword\tclose - \definedummyword\tt - % - \definedummyword\LaTeX - \definedummyword\TeX - % - % Assorted special characters. - \definedummyword\ampchar - \definedummyword\atchar - \definedummyword\arrow - \definedummyword\backslashchar - \definedummyword\bullet - \definedummyword\comma - \definedummyword\copyright - \definedummyword\registeredsymbol - \definedummyword\dots - \definedummyword\enddots - \definedummyword\entrybreak - \definedummyword\equiv - \definedummyword\error - \definedummyword\euro - \definedummyword\expansion - \definedummyword\geq - \definedummyword\guillemetleft - \definedummyword\guillemetright - \definedummyword\guilsinglleft - \definedummyword\guilsinglright - \definedummyword\lbracechar - \definedummyword\leq - \definedummyword\mathopsup - \definedummyword\minus - \definedummyword\ogonek - \definedummyword\pounds - \definedummyword\point - \definedummyword\print - \definedummyword\quotedblbase - \definedummyword\quotedblleft - \definedummyword\quotedblright - \definedummyword\quoteleft - \definedummyword\quoteright - \definedummyword\quotesinglbase - \definedummyword\rbracechar - \definedummyword\result - \definedummyword\sub - \definedummyword\sup - \definedummyword\textdegree - % \definedummyword\subentry % % We want to disable all macros so that they are not expanded by \write. + \let\commondummyword\definedummyword \macrolist \let\value\dummyvalue % - \normalturnoffactive -} - -% \commondummiesnofonts: common to \definedummies and \indexnofonts. -% Define \commondummyletter, \commondummyaccent and \commondummyword before -% using. Used for accents, font commands, and various control letters. -% -\def\commondummiesnofonts{% - % Control letters and accents. + \turnoffactive +} + +\newif\ifdummies +\newif\ifindexnofonts + +\def\commondummyletter#1{% + \expandafter\let\csname\string#1:impl\endcsname#1% + \edef#1{% + \noexpand\ifindexnofonts + % empty expansion + \noexpand\else + \noexpand\ifdummies\string#1% + \noexpand\else + \noexpand\jumptwofi % dispose of the \fi + \expandafter\noexpand\csname\string#1:impl\endcsname + \noexpand\fi + \noexpand\fi}% +} + +\def\commondummyaccent#1{% + \expandafter\let\csname\string#1:impl\endcsname#1% + \edef#1{% + \noexpand\ifindexnofonts + \noexpand\expandafter % dispose of \else ... \fi + \noexpand\asis + \noexpand\else + \noexpand\ifdummies\string#1% + \noexpand\else + \noexpand\jumptwofi % dispose of the \fi + \expandafter\noexpand\csname\string#1:impl\endcsname + \noexpand\fi + \noexpand\fi}% +} + +% Like \commondummyaccent but add a \space at the end of the dummy expansion +% #2 is the expansion used for \indexnofonts. #2 is always followed by +% \asis to remove a pair of following braces. +\def\commondummyword#1#2{% + \expandafter\let\csname\string#1:impl\endcsname#1% + \expandafter\def\csname\string#1:ixnf\endcsname{#2\asis}% + \edef#1{% + \noexpand\ifindexnofonts + \noexpand\expandafter % dispose of \else ... \fi + \expandafter\noexpand\csname\string#1:ixnf\endcsname + \noexpand\else + \noexpand\ifdummies\string#1\space + \noexpand\else + \noexpand\jumptwofi % dispose of the \fi \fi + \expandafter\noexpand\csname\string#1:impl\endcsname + \noexpand\fi + \noexpand\fi}% +} +\def\jumptwofi#1\fi\fi{\fi\fi#1} + +% For \atdummies and \indexnofonts. \atdummies sets +% \dummiestrue and \indexnofonts sets \indexnofontstrue. +\def\definedummies{ + % @-sign is always an escape character when reading auxiliary files + \escapechar = `\@ + % \commondummyletter\!% \commondummyaccent\"% \commondummyaccent\'% @@ -4940,58 +4910,123 @@ $$% \commondummyaccent\^% \commondummyaccent\`% \commondummyaccent\~% - \commondummyword\u - \commondummyword\v - \commondummyword\H - \commondummyword\dotaccent - \commondummyword\ogonek - \commondummyword\ringaccent - \commondummyword\tieaccent - \commondummyword\ubaraccent - \commondummyword\udotaccent - \commondummyword\dotless + % + % Control letters and accents. + \commondummyword\u {}% + \commondummyword\v {}% + \commondummyword\H {}% + \commondummyword\dotaccent {}% + \commondummyword\ogonek {}% + \commondummyword\ringaccent {}% + \commondummyword\tieaccent {}% + \commondummyword\ubaraccent {}% + \commondummyword\udotaccent {}% + \commondummyword\dotless {}% % % Texinfo font commands. - \commondummyword\b - \commondummyword\i - \commondummyword\r - \commondummyword\sansserif - \commondummyword\sc - \commondummyword\slanted - \commondummyword\t + \commondummyword\b {}% + \commondummyword\i {}% + \commondummyword\r {}% + \commondummyword\sansserif {}% + \commondummyword\sc {}% + \commondummyword\slanted {}% + \commondummyword\t {}% % % Commands that take arguments. - \commondummyword\abbr - \commondummyword\acronym - \commondummyword\anchor - \commondummyword\cite - \commondummyword\code - \commondummyword\command - \commondummyword\dfn - \commondummyword\dmn - \commondummyword\email - \commondummyword\emph - \commondummyword\env - \commondummyword\file - \commondummyword\image - \commondummyword\indicateurl - \commondummyword\inforef - \commondummyword\kbd - \commondummyword\key - \commondummyword\math - \commondummyword\option - \commondummyword\pxref - \commondummyword\ref - \commondummyword\samp - \commondummyword\strong - \commondummyword\tie - \commondummyword\U - \commondummyword\uref - \commondummyword\url - \commondummyword\var - \commondummyword\verb - \commondummyword\w - \commondummyword\xref + \commondummyword\abbr {}% + \commondummyword\acronym {}% + \commondummyword\anchor {}% + \commondummyword\cite {}% + \commondummyword\code {}% + \commondummyword\command {}% + \commondummyword\dfn {}% + \commondummyword\dmn {}% + \commondummyword\email {}% + \commondummyword\emph {}% + \commondummyword\env {}% + \commondummyword\file {}% + \commondummyword\image {}% + \commondummyword\indicateurl{}% + \commondummyword\inforef {}% + \commondummyword\kbd {}% + \commondummyword\key {}% + \commondummyword\math {}% + \commondummyword\option {}% + \commondummyword\pxref {}% + \commondummyword\ref {}% + \commondummyword\samp {}% + \commondummyword\strong {}% + \commondummyword\tie {}% + \commondummyword\U {}% + \commondummyword\uref {}% + \commondummyword\url {}% + \commondummyword\var {}% + \commondummyword\verb {}% + \commondummyword\w {}% + \commondummyword\xref {}% + % + \commondummyword\AA {AA}% + \commondummyword\AE {AE}% + \commondummyword\DH {DZZ}% + \commondummyword\L {L}% + \commondummyword\O {O}% + \commondummyword\OE {OE}% + \commondummyword\TH {TH}% + \commondummyword\aa {aa}% + \commondummyword\ae {ae}% + \commondummyword\dh {dzz}% + \commondummyword\exclamdown {!}% + \commondummyword\l {l}% + \commondummyword\o {o}% + \commondummyword\oe {oe}% + \commondummyword\ordf {a}% + \commondummyword\ordm {o}% + \commondummyword\questiondown {?}% + \commondummyword\ss {ss}% + \commondummyword\th {th}% + % + \commondummyword\LaTeX {LaTeX}% + \commondummyword\TeX {TeX}% + % + % Assorted special characters. + \commondummyword\ampchar {\normalamp}% + \commondummyword\atchar {\@}% + \commondummyword\arrow {->}% + \commondummyword\backslashchar {\realbackslash}% + \commondummyword\bullet {bullet}% + \commondummyword\comma {,}% + \commondummyword\copyright {copyright}% + \commondummyword\dots {...}% + \commondummyword\enddots {...}% + \commondummyword\entrybreak {}% + \commondummyword\equiv {===}% + \commondummyword\error {error}% + \commondummyword\euro {euro}% + \commondummyword\expansion {==>}% + \commondummyword\geq {>=}% + \commondummyword\guillemetleft {<<}% + \commondummyword\guillemetright {>>}% + \commondummyword\guilsinglleft {<}% + \commondummyword\guilsinglright {>}% + \commondummyword\lbracechar {\{}% + \commondummyword\leq {<=}% + \commondummyword\mathopsup {sup}% + \commondummyword\minus {-}% + \commondummyword\pounds {pounds}% + \commondummyword\point {.}% + \commondummyword\print {-|}% + \commondummyword\quotedblbase {"}% + \commondummyword\quotedblleft {"}% + \commondummyword\quotedblright {"}% + \commondummyword\quoteleft {`}% + \commondummyword\quoteright {'}% + \commondummyword\quotesinglbase {,}% + \commondummyword\rbracechar {\}}% + \commondummyword\registeredsymbol {R}% + \commondummyword\result {=>}% + \commondummyword\sub {}% + \commondummyword\sup {}% + \commondummyword\textdegree {o}% } \let\indexlbrace\relax @@ -5042,18 +5077,7 @@ $$% % would be for a given command (usually its argument). % \def\indexnofonts{% - % Accent commands should become @asis. - \def\commondummyaccent##1{\let##1\asis}% - % We can just ignore other control letters. - \def\commondummyletter##1{\let##1\empty}% - % All control words become @asis by default; overrides below. - \let\commondummyword\commondummyaccent - \commondummiesnofonts - % - % Don't no-op \tt, since it isn't a user-level command - % and is used in the definitions of the active chars like <, >, |, etc. - % Likewise with the other plain tex font commands. - %\let\tt=\asis + \indexnofontstrue % \def\ { }% \def\@{@}% @@ -5065,84 +5089,19 @@ $$% \let\lbracechar\{% \let\rbracechar\}% % - % Non-English letters. - \def\AA{AA}% - \def\AE{AE}% - \def\DH{DZZ}% - \def\L{L}% - \def\OE{OE}% - \def\O{O}% - \def\TH{TH}% - \def\aa{aa}% - \def\ae{ae}% - \def\dh{dzz}% - \def\exclamdown{!}% - \def\l{l}% - \def\oe{oe}% - \def\ordf{a}% - \def\ordm{o}% - \def\o{o}% - \def\questiondown{?}% - \def\ss{ss}% - \def\th{th}% - % - \let\do\indexnofontsdef - % - \do\LaTeX{LaTeX}% - \do\TeX{TeX}% - % - % Assorted special characters. - \do\atchar{@}% - \do\arrow{->}% - \do\bullet{bullet}% - \do\comma{,}% - \do\copyright{copyright}% - \do\dots{...}% - \do\enddots{...}% - \do\equiv{==}% - \do\error{error}% - \do\euro{euro}% - \do\expansion{==>}% - \do\geq{>=}% - \do\guillemetleft{<<}% - \do\guillemetright{>>}% - \do\guilsinglleft{<}% - \do\guilsinglright{>}% - \do\leq{<=}% - \do\lbracechar{\{}% - \do\minus{-}% - \do\point{.}% - \do\pounds{pounds}% - \do\print{-|}% - \do\quotedblbase{"}% - \do\quotedblleft{"}% - \do\quotedblright{"}% - \do\quoteleft{`}% - \do\quoteright{'}% - \do\quotesinglbase{,}% - \do\rbracechar{\}}% - \do\registeredsymbol{R}% - \do\result{=>}% - \do\textdegree{o}% % % We need to get rid of all macros, leaving only the arguments (if present). % Of course this is not nearly correct, but it is the best we can do for now. - % makeinfo does not expand macros in the argument to @deffn, which ends up - % writing an index entry, and texindex isn't prepared for an index sort entry - % that starts with \. % % Since macro invocations are followed by braces, we can just redefine them % to take a single TeX argument. The case of a macro invocation that % goes to end-of-line is not handled. % + \def\commondummyword##1{\let##1\asis}% \macrolist \let\value\indexnofontsvalue } -% Give the control sequence a definition that removes the {} that follows -% its use, e.g. @AA{} -> AA -\def\indexnofontsdef#1#2{\def#1##1{#2}}% - @@ -5392,7 +5351,9 @@ $$% % ..., ready, GO: % \def\safewhatsit#1{\ifhmode + \whatsitpenalty = \lastpenalty #1% + \ifnum\whatsitpenalty>9999 \penalty\whatsitpenalty \fi \else % \lastskip and \lastpenalty cannot both be nonzero simultaneously. \whatsitskip = \lastskip @@ -5616,6 +5577,11 @@ might help (with 'rm \jobname.?? \jobname.??s')% \newdimen\entryrightmargin \entryrightmargin=0pt +% for PDF output, whether to make the text of the entry a link to the page +% number. set for @contents and @shortcontents where there is only one +% page number. +\newif\iflinkentrytext + % \entry typesets a paragraph consisting of the text (#1), dot leaders, and % then page number (#2) flushed to the right margin. It is used for index % and table of contents entries. The paragraph is indented by \leftskip. @@ -5642,7 +5608,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% } \def\entrybreak{\unskip\space\ignorespaces}% \def\doentry{% - % Save the text of the entry + % Save the text of the entry in \boxA \global\setbox\boxA=\hbox\bgroup \bgroup % Instead of the swallowed brace. \noindent @@ -5652,12 +5618,21 @@ might help (with 'rm \jobname.?? \jobname.??s')% % with catcodes occurring. } {\catcode`\@=11 +% #1 is the page number \gdef\finishentry#1{% - \egroup % end box A + \egroup % end \boxA \dimen@ = \wd\boxA % Length of text of entry + % add any leaders and page number to \boxA. \global\setbox\boxA=\hbox\bgroup - \unhbox\boxA - % #1 is the page number. + \ifpdforxetex + \iflinkentrytext + \pdflinkpage{#1}{\unhbox\boxA}% + \else + \unhbox\boxA + \fi + \else + \unhbox\boxA + \fi % % Get the width of the page numbers, and only use % leaders if they are present. @@ -5676,6 +5651,8 @@ might help (with 'rm \jobname.?? \jobname.??s')% \fi \fi \egroup % end \boxA + % + % now output \ifdim\wd\boxB = 0pt \noindent\unhbox\boxA\par \nobreak @@ -6375,7 +6352,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \fi } -\parseargdef\setchapternewpage{\csname CHAPPAG#1\endcsname} +\parseargdef\setchapternewpage{\csname CHAPPAG#1\endcsname\HEADINGSon} \def\CHAPPAGoff{% \global\let\contentsalignmacro = \chappager @@ -6392,7 +6369,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \global\let\pchapsepmacro=\chapoddpage \global\def\HEADINGSon{\HEADINGSdouble}} -\CHAPPAGon +\setchapternewpage on % \chapmacro - Chapter opening. % @@ -6772,6 +6749,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \def\thistitle{}% no title in double-sided headings % Record where the Roman numerals started. \ifnum\romancount=0 \global\romancount=\pagecount \fi + \linkentrytexttrue } % \raggedbottom in plain.tex hardcodes \topskip so override it @@ -6899,7 +6877,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% % Chapters, in the short toc. % See comments in \dochapentry re vbox and related settings. \def\shortchapentry#1#2#3#4{% - \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno\bgroup#4\egroup}% + \tocentry{\shortchaplabel{#2}\labelspace #1}{#4}% } % Appendices, in the main contents. @@ -6914,7 +6892,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% % Unnumbered chapters. \def\unnchapentry#1#2#3#4{\dochapentry{#1}{#4}} -\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{\doshortpageno\bgroup#4\egroup}} +\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{#4}} % Sections. \def\numsecentry#1#2#3#4{\dosecentry{#2\labelspace#1}{#4}} @@ -6946,24 +6924,24 @@ might help (with 'rm \jobname.?? \jobname.??s')% % Move the page numbers slightly to the right \advance\entryrightmargin by -0.05em \chapentryfonts - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup \nobreak\vskip .25\baselineskip plus.1\baselineskip } \def\dosecentry#1#2{\begingroup \secentryfonts \leftskip=\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup} \def\dosubsecentry#1#2{\begingroup \subsecentryfonts \leftskip=2\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup} \def\dosubsubsecentry#1#2{\begingroup \subsubsecentryfonts \leftskip=3\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup} % We use the same \entry macro as for the index entries. @@ -6972,9 +6950,6 @@ might help (with 'rm \jobname.?? \jobname.??s')% % Space between chapter (or whatever) number and the title. \def\labelspace{\hskip1em \relax} -\def\dopageno#1{{\rm #1}} -\def\doshortpageno#1{{\rm #1}} - \def\chapentryfonts{\secfonts \rm} \def\secentryfonts{\textfonts} \def\subsecentryfonts{\textfonts} @@ -7119,8 +7094,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \newdimen\cartouter\newdimen\cartinner \newskip\normbskip\newskip\normpskip\newskip\normlskip - -\envdef\cartouche{% +\envparseargdef\cartouche{% \cartouchefontdefs \ifhmode\par\fi % can't be in the midst of a paragraph. \startsavinginserts @@ -7150,16 +7124,19 @@ might help (with 'rm \jobname.?? \jobname.??s')% \baselineskip=0pt\parskip=0pt\lineskip=0pt \carttop \hbox\bgroup - \hskip\lskip - \vrule\kern3pt - \vbox\bgroup - \kern3pt - \hsize=\cartinner - \baselineskip=\normbskip - \lineskip=\normlskip - \parskip=\normpskip - \vskip -\parskip - \comment % For explanation, see the end of def\group. + \hskip\lskip + \vrule\kern3pt + \vbox\bgroup + \hsize=\cartinner + \baselineskip=\normbskip + \lineskip=\normlskip + \parskip=\normpskip + \def\arg{#1}% + \ifx\arg\empty\else + \centerV{\hfil \bf #1 \hfil}% + \fi + \kern3pt + \vskip -\parskip } \def\Ecartouche{% \ifhmode\par\fi @@ -7410,8 +7387,9 @@ might help (with 'rm \jobname.?? \jobname.??s')% \endgroup % \def\setupverb{% - \tt % easiest (and conventionally used) font for verbatim + \tt \def\par{\leavevmode\endgraf}% + \parindent = 0pt \setcodequotes \tabeightspaces % Respect line breaks, @@ -7587,32 +7565,19 @@ might help (with 'rm \jobname.?? \jobname.??s')% \exdentamount=\defbodyindent } -\def\dodefunx#1{% - % First, check whether we are in the right environment: - \checkenv#1% - % - % As above, allow line break if we have multiple x headers in a row. - % It's not a great place, though. - \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi - % - % And now, it's time to reuse the body of the original defun: - \expandafter\gobbledefun#1% -} -\def\gobbledefun#1\startdefun{} - -% \printdefunline \deffnheader{text} +% Called as \printdefunline \deffooheader{text} % \def\printdefunline#1#2{% \begingroup \plainfrenchspacing - % call \deffnheader: + % call \deffooheader: #1#2 \endheader % common ending: \interlinepenalty = 10000 \advance\rightskip by 0pt plus 1fil\relax \endgraf \nobreak\vskip -\parskip - \penalty\defunpenalty % signal to \startdefun and \dodefunx + \penalty\defunpenalty % signal to \startdefun and \deffoox % Some of the @defun-type tags do not enable magic parentheses, % rendering the following check redundant. But we don't optimize. \checkparencounts @@ -7621,7 +7586,25 @@ might help (with 'rm \jobname.?? \jobname.??s')% \def\Edefun{\endgraf\medbreak} -% \makedefun{deffoo}{ (definition of \deffooheader) } +% @defblock, @defline do not automatically create index entries +\envdef\defblock{% + \startdefun +} +\let\Edefblock\Edefun + +\def\defline{% + \doingtypefnfalse + \parseargusing\activeparens{\printdefunline\deflineheader}% +} +\def\deflineheader#1 #2 #3\endheader{% + \defname{#1}{}{#2}\magicamp\defunargs{#3\unskip}% +} +\def\deftypeline{% + \doingtypefntrue + \parseargusing\activeparens{\printdefunline\deflineheader}% +} + +% \makedefun{deffoo} (\deffooheader parameters) { (\deffooheader expansion) } % % Define \deffoo, \deffoox \Edeffoo and \deffooheader. \def\makedefun#1{% @@ -7636,8 +7619,18 @@ might help (with 'rm \jobname.?? \jobname.??s')% \doingtypefnfalse % distinguish typed functions from all else \parseargusing\activeparens{\printdefunline#3}% }% - \def#2{\dodefunx#1}% - \def#3% + \def#2{% + % First, check whether we are in the right environment: + \checkenv#1% + % + % As in \startdefun, allow line break if we have multiple x headers + % in a row. It's not a great place, though. + \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi + % + \doingtypefnfalse % distinguish typed functions from all else + \parseargusing\activeparens{\printdefunline#3}% + }% + \def#3% definition of \deffooheader follows } \newif\ifdoingtypefn % doing typed function? @@ -7831,10 +7824,12 @@ might help (with 'rm \jobname.?? \jobname.??s')% % Print arguments. Use slanted for @def*, typewriter for @deftype*. \def\defunargs#1{% - \df \ifdoingtypefn \tt \else \sl \fi - \ifflagclear{txicodevaristt}{}% - {\def\var##1{{\setregularquotes \ttsl ##1}}}% - #1% + \bgroup + \df \ifdoingtypefn \tt \else \sl \fi + \ifflagclear{txicodevaristt}{}% + {\def\var##1{{\setregularquotes \ttsl ##1}}}% + #1% + \egroup } % We want ()&[] to print specially on the defun line. @@ -8592,6 +8587,87 @@ might help (with 'rm \jobname.?? \jobname.??s')% \fi \macnamexxx} +% @linemacro + +\parseargdef\linemacro{% + \linegetargs#1 \linegetargs + \expandafter\linegetparamlist\argl;% + \begingroup \macrobodyctxt \usembodybackslash + \parselinemacrobody +} + +% Parse the arguments to a @linemacro line. Set \macname to the name +% of the macro and \argl to the list of arguments. +\def\linegetargs#1 #2\linegetargs{% + \macname={#1}% + \def\argl{#2}% +} + +% Build up \paramlist which will be used as the parameter text for the macro. +% At the end it will be like "#1 #2 #3\endlinemacro". +\def\linegetparamlist#1;{% + \paramno=0\def\paramlist{}% + \let\hash\relax \let\xeatspaces\relax + \linegetparamlistxxx#1; % +} +\def\linegetparamlistxxx#1 {% + \if#1;\let\next=\linegetparamlistxxxx + \else \let\next=\linegetparamlistxxx + \advance\paramno by 1 + \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname + {\noexpand\xeatspaces{\hash\the\paramno}}% + \edef\paramlist{\paramlist\hash\the\paramno\space}% + \fi\next} +\def\linegetparamlistxxxx{% + \ifx\paramlist\empty + \def\paramlist{\hash 1\endlinemacro}% + \else + \expandafter\fixparamlist\paramlist\fixparamlist + \fi +} +% Replace final space token +\def\fixparamlist#1 \fixparamlist{% + \def\paramlist{#1\endlinemacro}% +} + +% Read the body of the macro, replacing backslash-surrounded variables +% +{\catcode`\ =\other\long\gdef\parselinemacrobody#1@end linemacro{% +\let\xeatspaces\relax +\xdef\macrobody{#1}% +\endgroup +\linemacrodef +}} + +% Make the definition +\def\linemacrodef{% + \let\hash=##% + \let\xeatspaces\relax + \expandafter\xdef\csname\the\macname\endcsname{% + \bgroup + \noexpand\scanctxt + \noexpand\parsearg + \expandafter\noexpand\csname\the\macname @@\endcsname + } + \expandafter\xdef\csname\the\macname @@\endcsname##1{% + \egroup + \expandafter\noexpand + \csname\the\macname @@@\endcsname##1 \noexpand\endlinemacro + % Note that we append a space to the macro line to terminate the last + % argument in case the final argument is empty. @xeatspaces may be needed + % to remove this space. + } + \expandafter\expandafter + \expandafter\xdef + \expandafter\expandafter\csname\the\macname @@@\endcsname\paramlist{% + \newlinechar=13 % split \macrobody into lines + \let\noexpand\xeatspaces\noexpand\eatspaces + \noexpand\scantokens{\macrobody}% + } +} + + + % @alias. % We need some trickery to remove the optional spaces around the equal % sign. Make them active and then expand them all to nothing. @@ -9873,12 +9949,10 @@ directory should work if nowhere else does.} % For native Unicode handling (XeTeX and LuaTeX) \nativeunicodechardefs \else - % For treating UTF-8 as byte sequences (TeX, eTeX and pdfTeX) + % For treating UTF-8 as byte sequences (TeX, eTeX and pdfTeX). + % Since we already invoke \utfeightchardefs at the top level, + % making non-ascii chars active is sufficient. \setnonasciicharscatcode\active - % since we already invoked \utfeightchardefs at the top level - % (below), do not re-invoke it, otherwise our check for duplicated - % definitions gets triggered. Making non-ascii chars active is - % sufficient. \fi % \else @@ -9903,7 +9977,6 @@ directory should work if nowhere else does.} \fi } -% emacs-page % A message to be logged when using a character that isn't available % the default font encoding (OT1). % @@ -9912,12 +9985,6 @@ directory should work if nowhere else does.} % Take account of \c (plain) vs. \, (Texinfo) difference. \def\cedilla#1{\ifx\c\ptexc\c{#1}\else\,{#1}\fi} -% First, make active non-ASCII characters in order for them to be -% correctly categorized when TeX reads the replacement text of -% macros containing the character definitions. -\setnonasciicharscatcode\active -% - \def\gdefchar#1#2{% \gdef#1{% \ifpassthroughchars @@ -9927,8 +9994,14 @@ directory should work if nowhere else does.} \fi }} +\begingroup + +% Make non-ASCII characters active for defining the character definition +% macros. +\setnonasciicharscatcode\active + % Latin1 (ISO-8859-1) character definitions. -\def\latonechardefs{% +\gdef\latonechardefs{% \gdefchar^^a0{\tie} \gdefchar^^a1{\exclamdown} \gdefchar^^a2{{\tcfont \char162}} % cent @@ -10033,7 +10106,7 @@ directory should work if nowhere else does.} } % Latin9 (ISO-8859-15) encoding character definitions. -\def\latninechardefs{% +\gdef\latninechardefs{% % Encoding is almost identical to Latin1. \latonechardefs % @@ -10048,7 +10121,7 @@ directory should work if nowhere else does.} } % Latin2 (ISO-8859-2) character definitions. -\def\lattwochardefs{% +\gdef\lattwochardefs{% \gdefchar^^a0{\tie} \gdefchar^^a1{\ogonek{A}} \gdefchar^^a2{\u{}} @@ -10152,6 +10225,8 @@ directory should work if nowhere else does.} \gdefchar^^ff{\dotaccent{}} } +\endgroup % active chars + % UTF-8 character definitions. % % This code to support UTF-8 is based on LaTeX's utf8.def, with some @@ -10489,7 +10564,7 @@ directory should work if nowhere else does.} \DeclareUnicodeCharacter{00AE}{\registeredsymbol{}}% \DeclareUnicodeCharacter{00AF}{\={ }}% % - \DeclareUnicodeCharacter{00B0}{\textdegree} + \DeclareUnicodeCharacter{00B0}{\textdegree}% \DeclareUnicodeCharacter{00B1}{\ensuremath\pm}% \DeclareUnicodeCharacter{00B2}{$^2$}% \DeclareUnicodeCharacter{00B3}{$^3$}% @@ -11204,14 +11279,14 @@ directory should work if nowhere else does.} \relax } -% Define all Unicode characters we know about. This makes UTF-8 the default -% input encoding and allows @U to work. +% Define all Unicode characters we know about \iftxinativeunicodecapable \nativeunicodechardefsatu \else \utfeightchardefs \fi + \message{formatting,} \newdimen\defaultparindent \defaultparindent = 15pt @@ -11539,7 +11614,7 @@ directory should work if nowhere else does.} \fi } -\microtypeON +\microtypeOFF \parseargdef\microtype{% \def\txiarg{#1}% @@ -11556,6 +11631,9 @@ directory should work if nowhere else does.} \message{and turning on texinfo input format.} +% Make UTF-8 the default encoding. +\documentencodingzzz{UTF-8} + \def^^L{\par} % remove \outer, so ^L can appear in an @comment \catcode`\^^K = 10 % treat vertical tab as whitespace @@ -11618,23 +11696,32 @@ directory should work if nowhere else does.} % Used sometimes to turn off (effectively) the active characters even after % parsing them. \def\turnoffactive{% - \normalturnoffactive + \passthroughcharstrue + \let-=\normaldash + \let"=\normaldoublequote + \let$=\normaldollar %$ font-lock fix + \let+=\normalplus + \let<=\normalless + \let>=\normalgreater + \let^=\normalcaret + \let_=\normalunderscore + \let|=\normalverticalbar + \let~=\normaltilde \otherbackslash + \setregularquotes + \unsepspaces } -\catcode`\@=0 +% If a .fmt file is being used, characters that might appear in a file +% name cannot be active until we have parsed the command line. +% So turn them off again, and have \loadconf turn them back on. +\catcode`+=\other \catcode`\_=\other + % \backslashcurfont outputs one backslash character in current font, % as in \char`\\. \global\chardef\backslashcurfont=`\\ -% \realbackslash is an actual character `\' with catcode other. -{\catcode`\\=\other @gdef@realbackslash{\}} - -% In Texinfo, backslash is an active character; it prints the backslash -% in fixed width font. -\catcode`\\=\active % @ for escape char from now on. - % Print a typewriter backslash. For math mode, we can't simply use % \backslashcurfont: the story here is that in math mode, the \char % of \backslashcurfont ends up printing the roman \ from the math symbol @@ -11644,109 +11731,120 @@ directory should work if nowhere else does.} % ignored family value; char position "5C). We can't use " for the % usual hex value because it has already been made active. -@def@ttbackslash{{@tt @ifmmode @mathchar29020 @else @backslashcurfont @fi}} -@let@backslashchar = @ttbackslash % @backslashchar{} is for user documents. +\def\ttbackslash{{\tt \ifmmode \mathchar29020 \else \backslashcurfont \fi}} +\let\backslashchar = \ttbackslash % \backslashchar{} is for user documents. -% \otherbackslash defines an active \ to be a literal `\' character with -% catcode other. -@gdef@otherbackslash{@let\=@realbackslash} - -% Same as @turnoffactive except outputs \ as {\tt\char`\\} instead of -% the literal character `\'. -% -{@catcode`- = @active - @gdef@normalturnoffactive{% - @passthroughcharstrue - @let-=@normaldash - @let"=@normaldoublequote - @let$=@normaldollar %$ font-lock fix - @let+=@normalplus - @let<=@normalless - @let>=@normalgreater - @let^=@normalcaret - @let_=@normalunderscore - @let|=@normalverticalbar - @let~=@normaltilde - @let\=@ttbackslash - @setregularquotes - @unsepspaces - } -} - -% If a .fmt file is being used, characters that might appear in a file -% name cannot be active until we have parsed the command line. -% So turn them off again, and have @fixbackslash turn them back on. -@catcode`+=@other @catcode`@_=@other - -% \enablebackslashhack - allow file to begin `\input texinfo' -% -% If a .fmt file is being used, we don't want the `\input texinfo' to show up. -% That is what \eatinput is for; after that, the `\' should revert to printing -% a backslash. -% If the file did not have a `\input texinfo', then it is turned off after -% the first line; otherwise the first `\' in the file would cause an error. -% This is used on the very last line of this file, texinfo.tex. -% We also use @c to call @fixbackslash, in case ends of lines are hidden. -{ -@catcode`@^=7 -@catcode`@^^M=13@gdef@enablebackslashhack{% - @global@let\ = @eatinput% - @catcode`@^^M=13% - @def@c{@fixbackslash@c}% - % Definition for the newline at the end of this file. - @def ^^M{@let^^M@secondlinenl}% - % Definition for a newline in the main Texinfo file. - @gdef @secondlinenl{@fixbackslash}% +% These are made active for url-breaking, so need +% active definitions as the normal characters. +\def\normaldot{.} +\def\normalquest{?} +\def\normalslash{/} + +% \newlinesloadsconf - call \loadconf as soon as possible in the +% file, e.g. at the first newline. +% +{\catcode`\^=7 +\catcode`\^^M=13 +\gdef\newlineloadsconf{% + \catcode`\^^M=13 % + \newlineloadsconfzz% +} +\gdef\newlineloadsconfzz#1^^M{% + \def\c{\loadconf\c}% + % Definition for the first newline read in the file + \def ^^M{\loadconf}% % In case the first line has a whole-line command on it - @let@originalparsearg@parsearg - @def@parsearg{@fixbackslash@originalparsearg} + \let\originalparsearg\parsearg% + \def\parsearg{\loadconf\originalparsearg}% }} -{@catcode`@^=7 @catcode`@^^M=13% -@gdef@eatinput input texinfo#1^^M{@fixbackslash}} % Emergency active definition of newline, in case an active newline token % appears by mistake. -{@catcode`@^=7 @catcode13=13% -@gdef@enableemergencynewline{% - @gdef^^M{% - @par% - %<warning: active newline>@par% +{\catcode`\^=7 \catcode13=13% +\gdef\enableemergencynewline{% + \gdef^^M{% + \par% + %<warning: active newline>\par% }}} -@gdef@fixbackslash{% - @ifx\@eatinput @let\ = @ttbackslash @fi - @catcode13=5 % regular end of line - @enableemergencynewline - @let@c=@comment - @let@parsearg@originalparsearg +% \loadconf gets called at the beginning of every Texinfo file. +% If texinfo.cnf is present on the system, read it. Useful for site-wide +% @afourpaper, etc. Not opening texinfo.cnf directly in texinfo.tex +% makes it possible to make a format file for Texinfo. +% +\gdef\loadconf{% + \relax % Terminate the filename if running as "tex '&texinfo' FILE.texi". + % + % Turn off the definitions that trigger \loadconf + \everyjobreset + \catcode13=5 % regular end of line + \enableemergencynewline + \let\c=\comment + \let\parsearg\originalparsearg + % % Also turn back on active characters that might appear in the input % file name, in case not using a pre-dumped format. - @catcode`+=@active - @catcode`@_=@active - % - % If texinfo.cnf is present on the system, read it. - % Useful for site-wide @afourpaper, etc. This macro, @fixbackslash, gets - % called at the beginning of every Texinfo file. Not opening texinfo.cnf - % directly in this file, texinfo.tex, makes it possible to make a format - % file for Texinfo. + \catcode`+=\active + \catcode`\_=\active % - @openin 1 texinfo.cnf - @ifeof 1 @else @input texinfo.cnf @fi - @closein 1 + \openin 1 texinfo.cnf + \ifeof 1 \else \input texinfo.cnf \fi + \closein 1 } +% Redefine some control sequences to be controlled by the \ifdummies +% and \ifindexnofonts switches. Do this at the end so that the control +% sequences are all defined. +\definedummies + + + + +\catcode`\@=0 + +% \realbackslash is an actual character `\' with catcode other. +{\catcode`\\=\other @gdef@realbackslash{\}} + +% In Texinfo, backslash is an active character; it prints the backslash +% in fixed width font. +\catcode`\\=\active % @ for escape char from now on. + +@let\ = @ttbackslash + +% If in a .fmt file, print the version number. +% \eatinput stops the `\input texinfo' from showing up. +% After that, `\' should revert to printing a backslash. +% Turn on active characters that we couldn't do earlier because +% they might have appeared in the input file name. +% +@everyjob{@message{[Texinfo version @texinfoversion]}% + @global@let\ = @eatinput + @catcode`+=@active @catcode`@_=@active} + +{@catcode`@^=7 @catcode`@^^M=13% +@gdef@eatinput input texinfo#1^^M{@loadconf}} + +@def@everyjobreset{@ifx\@eatinput @let\ = @ttbackslash @fi} + +% \otherbackslash defines an active \ to be a literal `\' character with +% catcode other. +@gdef@otherbackslash{@let\=@realbackslash} + +% Same as @turnoffactive except outputs \ as {\tt\char`\\} instead of +% the literal character `\'. +% +{@catcode`- = @active + @gdef@normalturnoffactive{% + @turnoffactive + @let\=@ttbackslash + } +} % Say @foo, not \foo, in error messages. @escapechar = `@@ -% These (along with & and #) are made active for url-breaking, so need -% active definitions as the normal characters. -@def@normaldot{.} -@def@normalquest{?} -@def@normalslash{/} - % These look ok in all fonts, so just make them not special. % @hashchar{} gets its own user-level command, because of #line. @catcode`@& = @other @def@normalamp{&} @@ -11761,15 +11859,11 @@ directory should work if nowhere else does.} @c Do this last of all since we use ` in the previous @catcode assignments. @catcode`@'=@active @catcode`@`=@active -@setregularquotes @c Local variables: @c eval: (add-hook 'before-save-hook 'time-stamp nil t) @c time-stamp-pattern: "texinfoversion{%Y-%02m-%02d.%02H}" -@c page-delimiter: "^\\\\message\\|emacs-page" +@c page-delimiter: "^\\\\message" @c End: -@c vim:sw=2: - -@enablebackslashhack - +@newlineloadsconf diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 56436d32970..6f14fc875f4 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1,5 +1,5 @@ \input texinfo @c -*- mode: texinfo; coding: utf-8 -*- -@setfilename ../info/tramp +@setfilename ../../info/tramp.info @c %**start of header @include docstyle.texi @c In the Tramp GIT, the version number and the bug report address @@ -361,7 +361,7 @@ Another way is to follow the terminal session below: @example @group $ cd ~/emacs -$ git clone git://git.savannah.gnu.org/tramp.git +$ git clone https://git.savannah.gnu.org/git/tramp.git @end group @end example @@ -927,6 +927,17 @@ pod is used. This method does not support user names. +@item @option{toolbox} +@cindex method @option{toolbox} +@cindex @option{toolbox} method + +Integration of Toolbox system containers. The host name may be either +a container's name or ID, as returned by @samp{toolbox list -c}. +Without a host name, the default Toolbox container for the host will +be used. + +This method does not support user names. + @end table @@ -1236,6 +1247,7 @@ syntax requires a leading volume (share) name, for example: @item @option{dav} @item @option{davs} +@cindex WebDAV @cindex method @option{dav} @cindex method @option{davs} @cindex @option{dav} method @@ -2717,6 +2729,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} @@ -2746,20 +2759,33 @@ allows you to set the @option{ControlPath} provided the variable 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: +@vindex tramp-use-connection-share +Using a predefined string in @code{tramp-ssh-controlmaster-options}, +or puzzling an own string, happens only when user option +@code{tramp-use-connection-share} 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) +(customize-set-variable 'tramp-use-connection-share 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-connection-share} 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-connection-share} 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 @@ -2781,12 +2807,16 @@ Host * Check the @samp{ssh_config(5)} man page whether these options are supported on your proxy host. -On MS Windows, @code{tramp-use-ssh-controlmaster-options} is set to -@code{nil} by default, because the MS Windows and MSYS2 -implementations of @command{OpenSSH} do not support this option properly. +On MS Windows, @code{tramp-use-connection-share} is set to @code{nil} +by default, because the MS Windows and MSYS2 implementations of +@command{OpenSSH} do not support this option properly. -In PuTTY, you can achieve connection sharing in the @option{Connection/SSH} -entry, enabling the @option{Share SSH connections if possible} option. +In PuTTY, you can achieve connection sharing in the +@option{Connection/SSH} entry, enabling the @option{Share SSH +connections if possible} option. @code{tramp-use-connection-share} +must be set to @code{nil}. If @code{tramp-use-connection-share} is +set to @code{t} or @code{suppress}, @command{plink} is called with the +option @option{-share} or @option{-noshare}, respectively. @subsection Configure direct copying between two remote servers @@ -3458,12 +3488,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 @@ -3497,10 +3522,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 @@ -3928,12 +3950,12 @@ connection-local variables. @vindex async-shell-command-width @vindex COLUMNS@r{, environment variable} -If Emacs supports the user option @code{async-shell-command-width} -(since @w{Emacs 27}), @value{tramp} cares about its value for -asynchronous shell commands. It specifies the number of display -columns for command output. For synchronous shell commands, a similar -effect can be achieved by adding the environment variable -@env{COLUMNS} to @code{tramp-remote-process-environment}. +@value{tramp} cares about the user option +@code{async-shell-command-width} for asynchronous shell commands. It +specifies the number of display columns for command output. For +synchronous shell commands, a similar effect can be achieved by adding +the environment variable @env{COLUMNS} to +@code{tramp-remote-process-environment}. @subsection Running @code{eshell} on a remote host @@ -4283,9 +4305,10 @@ It does not use @code{tramp-remote-path}. In order to gain even more performance, it is recommended to bind @code{tramp-verbose} to 0 when running @code{make-process} or @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}. +@code{tramp-use-connection-share} 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}, @ref{Using ssh +connection sharing}. @node Cleanup remote connections @@ -4824,8 +4847,8 @@ Where is the latest @value{tramp}? @item Which systems does it work on? -The package works successfully on @w{Emacs 26}, @w{Emacs 27}, @w{Emacs -28}, and @w{Emacs 29}. +The package works successfully on @w{Emacs 27}, @w{Emacs 28}, @w{Emacs +29}, and @w{Emacs 30}. While Unix and Unix-like systems are the primary remote targets, @value{tramp} has equal success connecting to other platforms, such as @@ -5204,9 +5227,10 @@ them, @ref{Misc File Ops, Trashing , , emacs}. @ifnotinfo them. @end ifnotinfo -Remote files are always trashed to the local trash, except remote -encrypted files (@pxref{Keeping files encrypted}), which are deleted -anyway. +Remote files are always trashed to the local trash, except the user +option @code{remote-file-name-inhibit-delete-by-moving-to-trash} is +non-@code{nil}, or it is a remote encrypted file (@pxref{Keeping files +encrypted}), which are deleted anyway. If Emacs is configured to use the XDG conventions for the trash directory, remote files cannot be restored with the respective tools, diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 299fb3fcb31..2f505c6acea 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,10 +7,10 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.6.0.29.1 +@set trampver 2.7.0-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org -@set emacsver 26.1 +@set emacsver 27.1 @c Other flags from configuration. @set instprefix /usr/local diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index 2cd4e985dd2..850930a290f 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -31,7 +31,7 @@ General Public License for more details. @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.3.7 +@subtitle for version 0.3.7.50 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -64,8 +64,17 @@ reading a new value in the minibuffer. Calling a suffix command usually causes the transient to be exited but suffix commands can also be configured to not exit the transient. +@quotation +The second part of this manual, which describes how to modify existing +transients and create new transients from scratch, can be hard to +digest if you are just getting started. A useful resource to get over +that hurdle is Psionic K's interactive tutorial, available at +@uref{https://github.com/positron-solutions/transient-showcase}. + +@end quotation + @noindent -This manual is for Transient version 0.3.7. +This manual is for Transient version 0.3.7.50. @insertcopying @end ifnottex @@ -447,10 +456,10 @@ session. Save the value of the active transient persistently across Emacs sessions. -@item @kbd{C-x C-k} (@code{transient-save}) +@item @kbd{C-x C-k} (@code{transient-reset}) @kindex C-x C-k -@findex transient-save -Clear the set and saved value of the active transient. +@findex transient-reset +Clear the set and saved values of the active transient. @end table @defopt transient-values-file @@ -893,7 +902,16 @@ same customization. To an extent, transients can be customized interactively, see @ref{Enabling and Disabling Suffixes}. This section explains how existing -transients can be further modified non-interactively. +transients can be further modified non-interactively. Let's begin +with an example: + +@lisp +(transient-append-suffix 'magit-patch-apply "-3" + '("-R" "Apply in reverse" "--reverse")) +@end lisp + +This inserts a new infix argument to toggle the @code{--reverse} argument +after the infix argument that toggles @code{-3} in @code{magit-patch-apply}. The following functions share a few arguments: @@ -911,7 +929,6 @@ means the former. @xref{Suffix Specifications}. @var{SUFFIX} may also be a group in the same form as expected by @code{transient-define-prefix}. @xref{Group Specifications}. - @item @var{LOC} is a command, a key vector, a key description (a string as returned by @code{key-description}), or a list specifying coordinates (the @@ -1139,11 +1156,17 @@ suffixes, which assumes that a predicate like this is used: @item The value of @code{:setup-children}, if non-@code{nil}, is a function that takes -two arguments the group object itself and a list of children. -The children are given as a (potentially empty) list consisting -of either group or suffix specifications. It can make arbitrary -changes to the children including constructing new children from -scratch. Also see @code{transient-setup-children}. +one argument, a potentially list of children, and must return a list +of children or an empty list. This can either be used to somehow +transform the group's children that were defined the normal way, or +to dynamically create the children from scratch. + +The returned children must have the same form as stored in the +prefix's @code{transient--layout} property, but it is often more convenient +to use the same form as understood by @code{transient-define-prefix}, +described below. If you use the latter approach, you can use the +@code{transient-parse-child} and @code{transient-parse-children} functions to +transform them from the convenient to the expected form. @item The boolean @code{:pad-keys} argument controls whether keys of all suffixes @@ -1151,23 +1174,21 @@ contained in a group are right padded, effectively aligning the descriptions. @end itemize -The @var{ELEMENT}s are either all subgroups (vectors), or all suffixes -(lists) and strings. (At least currently no group type exists that -would allow mixing subgroups with commands at the same level, though -in principle there is nothing that prevents that.) +The @var{ELEMENT}s are either all subgroups, or all suffixes and strings. +(At least currently no group type exists that would allow mixing +subgroups with commands at the same level, though in principle there +is nothing that prevents that.) If the @var{ELEMENT}s are not subgroups, then they can be a mixture of lists -that specify commands and strings. Strings are inserted verbatim. -The empty string can be used to insert gaps between suffixes, which is -particularly useful if the suffixes are outlined as a table. - -Variables are supported inside group specifications. For example in -place of a direct subgroup specification, a variable can be used whose -value is a vector that qualifies as a group specification. Likewise, -a variable can be used where a suffix specification is expected. -Lists of group or suffix specifications are also supported. Indirect -specifications are resolved when the transient prefix is being -defined. +that specify commands and strings. Strings are inserted verbatim into +the buffer. The empty string can be used to insert gaps between +suffixes, which is particularly useful if the suffixes are outlined as +a table. + +Inside group specifications, including inside contained suffix +specifications, nothing has to be quoted and quoting anyway is +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. @@ -1193,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 @@ -1232,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 support. -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 @@ -1515,7 +1535,18 @@ Call the command without exporting variables and stay transient. @anchor{Pre-commands for Suffixes} @subheading Pre-commands for Suffixes -The default for suffixes is @code{transient--do-exit}. +By default, invoking a suffix causes the transient to be exited. + +If you want a different default behavior for a certain transient +prefix command, then set its @code{:transient-suffix} slot. The value can be +a boolean, answering the question "does the transient stay active, +when a suffix command is invoked?" @code{t} means that the transient stays +active, while @code{nil} means that invoking a suffix exits the transient. +In either case, the exact behavior depends on whether the suffix is +itself a prefix (i.e., a sub-prefix), an infix or a regular suffix. + +The behavior for an individual suffix command can be changed by +setting its @code{transient} slot to one of the following pre-commands. @defun transient--do-exit Call the command after exporting variables and exit the transient. @@ -1566,21 +1597,32 @@ be added to @code{transient-predicate-map}. @anchor{Pre-commands for Non-Suffixes} @subheading Pre-commands for Non-Suffixes -The default for non-suffixes, i.e., commands that are bound in other -keymaps beside the transient keymap, is @code{transient--do-warn}. Silently -ignoring the user-error is also an option, though probably not a good -one. +By default, non-suffixes (commands that are bound in other keymaps +beside the transient keymap) cannot be invoked. Trying to invoke +such a command results in a warning and the transient stays active. -If you want to let the user invoke non-suffix commands, then use -@code{transient--do-stay} as the value of the prefix's @code{transient-non-suffix} -slot. +If you want a different behavior, then set the @code{:transient-non-suffix} +slot of the transient prefix command. The value can be a boolean, +answering the question, "is it allowed to invoke non-suffix commands?" + +If the value is @code{t} or @code{transient--do-stay}, then non-suffixes can be +invoked, when it is @code{nil} or @code{transient--do-warn} (the default) then they +cannot be invoked. + +The only other recommended value is @code{transient--do-leave}. If that is +used, then non-suffixes can be invoked, but if one is invoked, then +that exits the transient. @defun transient--do-warn Call @code{transient-undefined} and stay transient. @end defun -@defun transient--do-noop -Call @code{transient-noop} and stay transient. +@defun transient--do-stay +Call the command without exporting variables and stay transient. +@end defun + +@defun transient--do-leave +Call the command without exporting variables and exit the transient. @end defun @anchor{Special Pre-Commands} @@ -1810,7 +1852,7 @@ indicates that all remaining arguments are files. @item Classes used for infix commands that represent variables should -derived from the abstract @code{transient-variables} class. +derived from the abstract @code{transient-variable} class. @end itemize Magit defines additional classes, which can serve as examples for the @@ -2045,7 +2087,7 @@ called with no argument and returns a string. @item @code{show-help} A function used to display help for the suffix. If -unspecified, the prefix controls how hlep is displayed for its +unspecified, the prefix controls how help is displayed for its suffixes. @end itemize 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/DEBUG b/etc/DEBUG index cfa033d6c0c..c4f0852abb3 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -1007,6 +1007,28 @@ Address sanitization is incompatible with undefined-behavior sanitization, unfortunately. Address sanitization is also incompatible with the --with-dumping=unexec option of 'configure'. +*** Address poisoning/unpoisoning + +When compiled with address sanitization, Emacs will also try to mark +dead/free lisp objects as poisoned, forbidding them from being +accessed without being unpoisoned first. This adds an extra layer +of checking with objects in internal free lists, which may otherwise +evade traditional use-after-free checks. To disable this, add +'allow_user_poisoning=0' to ASAN_OPTIONS, or build Emacs with +'-DGC_ASAN_POISON_OBJECTS=0' in CFLAGS. + +While using GDB, memory addresses can be inspected by using helper +functions additionally provided by the ASan library: + + (gdb) call __asan_describe_address(ptr) + +To check whether an address range is poisoned or not, use: + + (gdb) call __asan_region_is_poisoned(ptr, 8) + +Additional functions can be found in the header +'sanitizer/asan_interface.h' in your compiler's headers directory. + ** Running Emacs under Valgrind Valgrind <https://valgrind.org/> is free software that can be useful diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS new file mode 100644 index 00000000000..dd04e677285 --- /dev/null +++ b/etc/EGLOT-NEWS @@ -0,0 +1,518 @@ +Eglot NEWS -*- outline -*- + +Copyright (C) 2018-2023 Free Software Foundation, Inc. +See the end of the file for license conditions. + +Please send Eglot bug reports to 'bug-gnu-emacs@gnu.org', and Cc (or +X-Debbugs-CC) the maintainer 'joaotavora@gmail.com' as well. Please +read the chapter titled "Troubleshooting" in the Eglot manual, +available https://joaotavora.github.io/eglot/#Troubleshooting-Eglot + +This file is about changes in Eglot, the Emacs client for LSP +(Language Server Protocol) distributed with GNU Emacs since Emacs +version 29.1 and with GNU ELPA since 2018. + +Note: references to some Eglot issues are presented as "github#nnnn". +This refers to https://github.com/joaotavora/eglot/issues/. That is, +to look up issue github#1234, go to +https://github.com/joaotavora/eglot/issues/1234. + + +* Changes in Eglot 1.13 (15/03/2023) + +** ELPA installations on Emacs 26.3 are supported again. + + +* Changes in Eglot 1.12 (13/03/2023) + +** LSP inlay hints are now supported. +Inlay hints are small text annotations 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. +Emacs can display these hints using overlays, helping the user +remember those types and parameter names. + +** Longstanding Tramp instability issues solved. +The solution involves a Tramp-specific workaround in Eglot. Future +Tramp versions will have this problem solved at the origin. The +workaround will then be removed. Emacs bug#61350 has more details. + +(github#859, github#1020, github#883) + +** LSP's 'positionEncoding' capability is now supported. +The position-encoding scheme (UTF-8, UTF-16 or UTF-32) can now +be negotiated with the server. + +** More of the user's Eldoc configuration is respected. +This change addresses the problems reported in many Elglot reports +dating back to early 2021 at least. + +(github#646, github#894, github#920, github#1031, github#1171). + +This is unfinished work, as 'eldoc-documentation-strategy' is still +set by Eglot during its tenure over a buffer. The default value for +it cannot work reasonably with Eglot's additions to +'eldoc-documentation-functions'. + +** Completion labels are correctly displayed in servers like clangd. + +(github#1141) + +** Assorted bugfixes. + +(bug#61312, bug#61478, bug#61532, bug#61726, bug#61866, bug#61748) + + +* Changes in Eglot 1.11 (27/1/2023) + +** New server vscode-json-languageserver added to 'eglot-server-programs'. + +(bug#60198) + +** Assorted bugfixes. + +(bug#60379, bug#60557, (bug#61048) + + +* Changes in Eglot 1.10 (16/12/2022) + +** Emacs progress reporters are used for LSP progress notifications. +(bug#59149) + +** LSP reported URIs other than file:// are passed on to Emacs. +This change allows other URI handlers, such as a 'jar:' handling +package, to cooperate with Eglot and find files inside compressed file +systems (bug#58790). + +** Eglot now shows in the menu bar. + +** Tree-sitter modes added to 'eglot-server-programs'. +These modes are usually handled by the same server that handles the +"classical mode". + +** New servers chsharp-ls and texlab added to 'eglot-server-programs'. + +** Assorted bugfixes. +(bug#59824, bug#59338) + + +* Changes in Eglot 1.9 (8/10/2022) + +This is the last release before integration into Emacs's core. + +** New 'M-x eglot-list-connections' command. +Probably not very useful for now. More keybindings and clickable +shortcuts to connection-specific commands to be added later. + +** Manual temporarily lives in separate MANUAL.md file. +The manual has been rewritten mostly from scratch. It is structured +hierarchically and is more complete. After the merge into Emacs, the +Eglot Texinfo manual bundled with Emacs used this temporary manual as +a starting point. + +** Support for "single server, multiple modes". +Previously, if an entry such as '((c++-mode c-mode) . ("clangd)")' was +found in 'eglot-server-programs', it meant that '.cpp' files '.c' +files would lead to two 'clangd' instances for managing them, even if +these files were in the same project. Now only one is created. It is +assumed that most, if not all, servers configured in +'eglot-server-programs' handle this correctly. + +(github#681) + +** 'eglot-imenu' no longer uses problematic "special elements". +Though Eglot's 'eglot-imenu' returned a fully compliant 'imenu' +structure, that object was not understood by many other frontends +other than 'M-x imenu' itself. Since the special functionality it +enabled wasn't being used anyway, it was decided to remove it to fix +these longstanding problems. + +(github#758, github#536, github#535) + +** 'eglot-workspace-configuration' has been overhauled. +This variable and its uses are now more thoroughly documented. It can +be set to a function for dynamic calculation of the configuration. +The preferred format is a plist, though the earlier alist format is +still supported. + +(github#967, github#590, github#790) + +** 'C-u M-.' lists and completes arbitrary workspace symbols. +A very old request, now made possible by a relatively recent change to +the 'workspace/symbol' RPC method. + +(github#131) + +** Reworked mode-line menus. +New menus help discover Eglot's features and show which of them are +supported by the current server. Menus can be customized away via +'eglot-menu-string', making space in mode-line. + +(github#792) + +** Easier to use LSP 'initialize.initializationOptions'. +In 'eglot-server-programs' a plist may be appended to the usual list +of strings passed as command line arguments. The value of its +':initializationOptions' key constructs the corresponding LSP JSON +object. This may be easier than creating a 'defclass' for a specific +server and specializing 'eglot-initialization-options' to that class. + +(github#901, github#845, github#940) + +** LSP on-type formatting is now supported. +This is the 'documentOnTypeFormattingProvider' LSP capability, which +may be disabled via 'eglot-ignored-server-capabilities' + +(github#899) + +** Basic LSP "workspace folders" support added. +Eglot now advertises 'project-root' and 'project-external-roots' as +workspace-folders. (Configuring 'project-vc-external-roots-function' +via Elisp or 'tags-table-list' via Custtomize are two ways to set the +external roots of a simple git project.) + +(github#893) + +** Eglot can now show project wide diagnosics via Flymake. +Some LSP servers report diagnostics for all files in the current +workspace. Flymake has (as of version 1.2.1) the option to show +diagnostics from buffers other than the currently visited one. The +command 'M-x flymake-show-project-diagnostics' will now show all the +diagnostics relevant to a workspace. + +(github#810) + +** Support LSP completion tags. +An LSP completion tag can be used to tell the editor how to render a +completion. Presently, one kind of tag exists, denoting its +corresponding completion as obsolete. + +(github#797) + +** Support LSP optional diagnostic tags. +A diagnostic tag can indicate either "unused or unnecessary code" or +"deprecated or obsolete code". Following the rendering suggestions in +the protocol, we fade out unnecessary code and strike-through +deprecated code. + +(github#794) + +** The Rust language server is now rust-analyzer by default. +Eglot will now prefer starting "rust-analyzer" to "rls" when it is +available. The special support code for RLS has been removed. + +(github#803) + +** New servers have been added to 'eglot-server-programs'. +- clojure-lsp (github#813) +- racket-langserver (github#694) +- futhark lsp (github#922) +- purescript-language-server (github#905) +- Perl::LanguageServer (github#952) +- marksman (github#1013) +- jedi-language-server ([#994](github#994)) + + +* Changes in Eglot 1.8 (12/1/2022) + +** Alternate servers supported out-of-box for the same major mode. +In practice, this removes the need for Eglot to "officially" bless one +server over another. + +Do not confuse this feature with another missing feature which +consists of supporting multiple servers simultaneously managing a +major mode within a project. + +(github#688) + +** TRAMP support added. +There are no variables to customize: visit a remote file, ensure the +server also exists in the remote, and type "M-x eglot". + +(github#637, github#463, github#84) + +** 'eglot-ignored-server-capabilities' is now correctly spelled. +This user-visible variable used to be spelled +'eglot-ignored-server-capabilites', which is still a valid but +obsolete name. + +(github#724) + +** Eglot can manage cross-referenced files outside project. +This is activated by a new customization option +'eglot-extend-to-xref', which defaults to nil. + +(github#76, github#686, github#695) + +** Code action shortcuts can be added by the user. +'M-x eglot-code-actions' accepts an optional 'action-kind' argument, +specified interactively with 'C-u'. Other shortcuts call specific +actions directly ('eglot-code-action-inline', +'eglot-code-action-extract', 'eglot-code-action-rewrite', +'eglot-code-action-organize-imports' and +'eglot-code-action-quickfix'). One can create one's own shortcuts for +code actions with specific a kind by calling 'eglot-code-actions' from +Lisp. + +(github#411) + +** New command 'eglot-shutdown-all added. +This disconnects all the Eglot connections in the user's session. + +(github#643) + +** New variable 'eglot-withhold-process-id' added. +If non-nil, Eglot will not send the Emacs process ID to the language +server. This can be useful when using docker to run a language +server. + +(github#722) + +** Several new servers have been added to 'eglot-server-programs'. +- cmake-language-server (github#787) +- css-languageserver (github#204, github#769) +- fortls (github#603) +- html-languageserver (github#204, github#769) +- json-languageserver (github#204, github#769) +- lua-lsp (github#721) +- mint ls (github#750) +- pyright (github#742) +- vim-language-server (github#787) +- yaml-language-server (github#751) +- zls (github#646) + + +* Changes in Eglot 1.7 (16/12/2020) + +** Hierarchical symbols are supported in Imenu. +(github#303). + +** Multiple "documentation at point" sources are supported. +Such sources include as LSP's signature, hover and also the Flymake +diagnostic messages. They can all be presented in the echo area +(space permitting), or via 'C-h .'. For now, composition of different +sources can be customized using 'eldoc-documentation-strategy', +'eldoc-echo-area-use-multiline-p' and 'eldoc-prefer-doc-buffer'. + +The variables 'eglot-put-doc-in-help-buffer' and +'eglot-auto-display-help-buffer' have been removed. + +(github#439, github#494, github#481, github#454) + + +* Changes in Eglot 1.6 (16/04/2020) + +** Column offset calculation is now LSP-conformant. +It seems the majority of servers now comply with the language server +specification when it comes to handling non-ASCII texts. Therefore +the default values of 'eglot-move-to-column-function' and +'eglot-current-column-function' have been changed. Consult the +documentation of these variables for how to restore the old behavior. + +(github#361) + +** LSP workspace/configuration requests are supported. +Also a new section "Per-project server configuration" in the README.md +should answer some FAQ's in this regard. + +(github#326) + + +* Changes in Eglot 1.5 (20/10/2019) + +** Eglot takes over Company configuration. +Similar to what was already the case with Flymake, Eldoc and Xref, use +just the backend that can do something useful in Eglot, +'company-capf'. See 'eglot-stay-out-of' to opt out of this. + +(github#324) + +** New option 'eglot-autoshutdown' added. +This disconnects the server after last managed buffer is killed. + +(github#217, github#270) + +** Completion support has been fixed. +Among other things, consider LSP's "filterText" cookies, which enable +a kind of poor-man's flex-matching for some backends. + +(github#235, github#313, github#311, github#279) + +** Supports LSP's "goto declaration/implementation/typeDefinition". + +(github#302) + +** New option 'eglot-send-changes-idle-time' added. + +(github#258) + +** Eglot's Eldoc no longer flickers when moving around. + +(github#198) + +** Large docs shown in help buffer instead of echo area by default. +Also add two new customization variables +'eglot-put-doc-in-help-buffer' and 'eglot-auto-display-help-buffer'. + +(github#198) + +** Built-in support for Go, Elixir and Ada added. + +(github#304, github#264, github#316) + + +* Changes in Eglot 1.4 (5/1/2019) + +** Parameter highlighting in the first line of signature corrected. + +** Markdown documentation strings are rendered with faces. +Eglot uses 'gfm-view-mode' for this. + +** Hard dependencies on Flymake have been removed. +The user can turn Flymake off now in buffers managed by Eglot. + +** Connection hooks are run with proper directory local variables. +This fixes issues with suspiciously empty 'didChangeConfiguration' +messages that are supposed to communicate parameters from a +directory-set 'eglot-workspace-configuration'. + +(github#196) + +** Completion sorting has been fixed. +If the server returns completions in some sensible order, Eglot will +keep it. + +(github#190) + +** Flymake and Eldoc taken over completely while managing buffers. +No longer try to add Eglot's facilities to existing facilities in +these two domains. + + +* Changes in Eglot 1.3 (10/12/2018) + +** Provide strict checking of incoming LSP messagesp. + +(github#144, github#156) + +** Add brief context after 'xref-find-references' when available. + +(github#52) + +** Support 'completionContext' to help servers like 'ccls'. + +** Use Flymake from GNU ELPA. + +(github#178) + + +* Changes in Eglot 1.2 (23/11/2018) + +** Support snippet completions. +Eglot uses 'yasnippet.el' for this, if it is installed. + +(github#50) + +** 'workspace/didChangeConfiguration' implemented. + +(github#29) + +** Handle experimental/unknown server methods gracefully. + +(github#39) + +** Accept functions as entries in 'eglot-server-programs'. +'CONTACT' in the '(MAJOR-MODE . CONTACT)' association in +'eglot-server-programs' can now be a function of no arguments +producing any value previously valid for a contact. Functions can be +interactive or non-interactive. + +(github#63) + +** Improve completion to be snappier and don't hinder typing. + +(github#61) + +** Consider ':triggerCharacters' in company completion. + +(github#80) + +** Add support for LSP 'TextEdit' objects in completion. + +** Prefer ccls over cquery for C/C++ + +(github#94) + +** 'eglot-ignored-server-capabilites' is more user-friendly. + +(github#126) + +** Supports asynchronous connections. +If a connection to the server is taking too long, is will continue in +the background. A new defcustom 'eglot-sync-connect' controls this +feature. + +(github#68) + +** The 'eglot-shutdown' command prompts for the server to shutdown. + +(github#73) + +** Add support for the Eclipse JDT language server. + +(github#63) + +** Add out-of-the-box support for Haskell, Kotlin, Go, Ocaml, R. + +** Add the ability to move to LSP-precise columns. +Some servers like 'clangd' follow the UTF-16-based spec very closely +here. + +(github#124) + +** Fix a potential security issue fontifying LSP doc. + +(github#154) + +** Fix many, many bugs + +(github#44, github#48, github#54, github#58, github#64, github#74, + github#81, github#82, github#86, github#87, github#83, github#93, + github#100, github#115, github#120, github#121, github#126, + github#138, github#144, github#158, github#160, github#167) + + +* Changes in Eglot 1.1 (9/7/2018) + +** Implement TCP autostart/autoconnect (and support Ruby's Solargraph). +The ':autoport' symbol in the server incovation is replaced +dynamically by a local port believed to be vacant, so that the ensuing +TCP connection finds a listening server. + +** Eglot now depends on Emacs library 'jsonrpc.el'. + + +---------------------------------------------------------------------- +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/>. + + +Local Variables: +bug-reference-bug-regexp: "\\(\\(github\\|bug\\)#\\([0-9]+\\)\\)" +bug-reference-url-format: eglot--debbugs-or-github-bug-uri +paragraph-separate: "[ ]" +End: + 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. @@ -1,15 +1,15 @@ GNU Emacs NEWS -- history of user-visible changes. -Copyright (C) 2021-2023 Free Software Foundation, Inc. +Copyright (C) 2022-2023 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'. If possible, use 'M-x report-emacs-bug'. -This file is about changes in Emacs version 29. +This file is about changes in Emacs version 30. See file HISTORY for a list of GNU Emacs versions and release dates. -See files NEWS.28, NEWS.27, ..., NEWS.18, and NEWS.1-17 for changes +See files NEWS.29, NEWS.28, ..., NEWS.18, and NEWS.1-17 for changes in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' @@ -22,4756 +22,400 @@ When you add a new item, use the appropriate mark if you are sure it applies, and please also update docstrings as needed. -* Installation Changes in Emacs 29.1 - ---- -** Ahead-of-time native compilation can now be requested via configure. -Use '--with-native-compilation=aot' to request that all the Lisp files -in the Emacs tree should be natively compiled ahead of time. (This is -slow on most machines.) - -This feature existed in Emacs 28.1, but was less easy to request. - -+++ -** Emacs can be built with the tree-sitter parsing library. -This library, together with separate grammar libraries for each -language, provides incremental parsing capabilities for several -popular programming languages and other formatted files. Emacs built -with this library offers major modes, described elsewhere in this -file, that are based on the tree-sitter's parsers. If you have the -tree-sitter library installed, the configure script will automatically -include it in the build; use '--without-tree-sitter' at configure time -to disable that. - -Emacs modes based on the tree-sitter library require an additional -grammar library for each mode. These grammar libraries provide the -tree-sitter library with language-specific lexical analysis and -parsing capabilities, and are developed separately from the -tree-sitter library itself. If you don't have a grammar library -required by some Emacs major mode, and your distro doesn't provide it -as an installable package, you can compile and install such a library -yourself. Many libraries can be downloaded from the tree-sitter site: - - https://github.com/tree-sitter - -Emacs provides a user command, 'treesit-install-language-grammar', -that automates the download and build process of a grammar library. -It prompts for the language, the URL of the language grammar's VCS -repository, and then uses the installed C/C++ compiler to build the -library and install it. - -You can also do this manually. To compile such a library after -cloning its Git repository, compile the files "scanner.c" and -"parser.c" (sometimes named "scanner.cc" and "parser.cc") in the "src" -subdirectory of the library's source tree using the C or C++ compiler, -then link these two files into a shared library named -"libtree-sitter-LANG.so", where LANG is the name of the language -supported by the grammar as it is expected by the Emacs major mode -(for example, "c" for 'c-ts-mode', "cpp" for 'c++-ts-mode', "python" -for 'python-ts-mode', etc.). Then place the shared library you've -built in the same directory where you keep the other shared libraries -used by Emacs, or in the "tree-sitter" subdirectory of your -'user-emacs-directory', or in a directory mentioned in the variable -'treesit-extra-load-path'. - -You only need to install language grammar libraries required by the -Emacs modes you will use, as Emacs loads these libraries only when the -corresponding mode is turned on in some buffer for the first time in -an Emacs session. - -+++ -** Emacs can be built with built-in support for accessing SQLite databases. -This uses the popular sqlite3 library, and can be disabled by using -the '--without-sqlite3' option to the 'configure' script. - -+++ -** Support for the WebP image format. -This support is built by default when the libwebp library is -available, and includes support for animated WebP images. To disable -WebP support, use the '--without-webp' configure flag. Image -specifiers can now use ':type webp'. - -+++ -** Emacs has been ported to the Haiku operating system. -The configuration process should automatically detect and build for -Haiku. There is also an optional window-system port to Haiku, which -can be enabled by configuring Emacs with the option '--with-be-app', -which will require the Haiku Application Kit development headers and a -C++ compiler to be present on your system. If Emacs is not built with -the option '--with-be-app', the resulting Emacs will only run in -text-mode terminals. - -To enable Cairo support, ensure that the Cairo and FreeType -development files are present on your system, and configure Emacs with -'--with-be-cairo'. - -Unlike X, there is no compile-time option to enable or disable -double-buffering; it is always enabled. To disable it, change the -frame parameter 'inhibit-double-buffering' instead. - ---- -** Emacs now installs the ".pdmp" file using a unique fingerprint in the name. -The file is typically installed using a file name akin to -"...dir/libexec/emacs/29.1/x86_64-pc-linux-gnu/emacs-<fingerprint>.pdmp". -If a constant file name is required, the file can be renamed to -"emacs.pdmp", and Emacs will find it during startup anyway. - ---- -** Emacs on X now uses XInput 2 for input events. -If your X server has support and you have the XInput 2 development -headers installed, Emacs will use the X Input Extension for handling -input. If this causes problems, you can configure Emacs with the -option '--without-xinput2' to disable this support. - -'(featurep 'xinput2)' can be used to test for the presence of XInput 2 -support from Lisp programs. - -+++ -** Emacs now supports being built with pure GTK. -To use this option, make sure the GTK 3 (version 3.22.23 or later) and -Cairo development files are installed, and configure Emacs with the -option '--with-pgtk'. Unlike the default X and GTK build, the -resulting Emacs binary will work on any underlying window system -supported by GDK, such as Wayland and Broadway. We recommend that you -use this configuration only if you are running a window system other -than X that's supported by GDK. Running this configuration on X is -known to have problems, such as undesirable frame positioning and -various issues with keyboard input of sequences such as 'C-;' and -'C-S-u'. - ---- -** Emacs no longer reduces the size of the Japanese dictionary. -Building Emacs includes generation of a Japanese dictionary, which is -used by Japanese input methods. Previously, the build included a step -of reducing the size of this dictionary's vocabulary. This vocabulary -reduction is now optional, by default off. If you need the Emacs -build to include the vocabulary reduction, configure Emacs with the -option '--with-small-ja-dic'. In an Emacs source tree already -configured without that option, you can force the vocabulary reduction -by saying - - make -C leim generate-ja-dic JA_DIC_NO_REDUCTION_OPTION='' - -after deleting "lisp/leim/ja-dic/ja-dic.el". - ---- -** The docstrings of preloaded files are not in "etc/DOC" any more. -Instead, they're fetched as needed from the corresponding ".elc" -files, as was already the case for all the non-preloaded files. +* Installation Changes in Emacs 30.1 -* Startup Changes in Emacs 29.1 - -+++ -** '--batch' and '--script' now adjust the garbage collection levels. -These switches now set 'gc-cons-percentage' to 1.0 (up from the -default of 0.1). This means that batch processes will typically use -more memory than before, but use less time doing garbage collection. -Batch jobs that are supposed to run for a long time should adjust the -limit back down again. - -+++ -** Emacs can now be used more easily in an executable script. -If you start an executable script with - - #!/usr/bin/emacs -x - -Emacs will start without reading any init files (like with '--quick'), -and then execute the rest of the script file as Emacs Lisp. When it -reaches the end of the script, Emacs will exit with an exit code from -the value of the final form. - -+++ -** Emacs now supports setting 'user-emacs-directory' via '--init-directory'. -Use the '--init-directory' command-line option to set -'user-emacs-directory'. - -+++ -** Emacs now has a '--fingerprint' option. -This will output a string identifying the current Emacs build, and exit. - -+++ -** New hook 'after-pdump-load-hook'. -This is run at the end of the Emacs startup process, and is meant to -be used to reinitialize data structures that would normally be done at -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 -system directory where the "*.eln" files are installed (usually, the -last entry in 'native-comp-eln-load-path') are not deleted. - ---- -*** New function 'startup-redirect-eln-cache'. -This function can be called in your init files to change the -user-specific directory where Emacs stores the "*.eln" files produced -by native compilation of Lisp packages Emacs loads. The default -eln cache directory is unchanged: it is the "eln-cache" subdirectory -of 'user-emacs-directory'. +* Startup Changes in Emacs 30.1 -* Incompatible changes in Emacs 29.1 - -+++ -** The image commands have changed key bindings. -In previous Emacs versions, images have had the '+', '-' and 'r' keys -bound when point is over an image. In Emacs 29.1, additional commands -were added, and this made it more likely that users would trigger the -image commands by mistake. To avoid this, all image commands have -moved to the 'i' keymap, so '+' is now 'i +', '-' is now 'i -', and -'r' is now 'i r'. In addition, these commands are now repeating, so -you can rotate an image twice by saying 'i r r', for instance. - -+++ -** Emacs now picks the correct coding-system for X input methods. -Previously, Emacs would use 'locale-coding-system' for input -methods, which could in some circumstances be incorrect, especially -when the input method chose to fall back to some other coding system. - -Emacs now automatically detects the coding-system used by input -methods, and uses that to decode input in preference to the value of -'locale-coding-system'. This unfortunately means that users who have -changed the coding system used to decode X keyboard input must adjust -their customizations to 'locale-coding-system' to the variable -'x-input-coding-system' instead. - -+++ -** Bookmarks no longer include context for encrypted files. -If you're visiting an encrypted file, setting a bookmark no longer -includes excerpts from that buffer in the bookmarks file. This is -implemented by the new hook 'bookmark-inhibit-context-functions', -where packages can register a function which returns non-nil for file -names to be excluded from adding such excerpts. - ---- -** 'show-paren-mode' is now disabled in 'special-mode' buffers. -In Emacs versions previous to Emacs 28.1, 'show-paren-mode' defaulted -off. In Emacs 28.1, the mode was switched on in all buffers. In -Emacs 29.1, this was changed to be switched on in all editing-related -buffers, but not in buffers that inherit from 'special-mode'. To go -back to how things worked in Emacs 28.1, put the following in your -init file: - - (setopt show-paren-predicate t) - -+++ -** Explicitly-set read-only state is preserved when reverting a buffer. -If you use the 'C-x C-q' command to change the read-only state of the -buffer and then revert it, Emacs would previously use the file -permission bits to determine whether the buffer should be read-only -after reverting the buffer. Emacs now remembers the decision made in -'C-x C-q'. - ---- -** The Gtk selection face is no longer used for the region. -The combination of a Gtk-controlled background and a foreground color -controlled by the internal Emacs machinery led to low-contrast faces -in common default setups. Emacs now uses the same 'region' face on -Gtk and non-Gtk setups. - ---- -** 'C-h f' and 'C-h x' may now require confirmation when you press 'RET'. -If the text in the minibuffer cannot be completed to a single function -or command, typing 'RET' will not automatically complete to the shortest -candidate, but will instead ask for confirmation. Typing 'TAB' will -complete as much as possible, and another 'TAB' will show all the -possible completions. This allows you to insist on the functions name -even if Help doesn't appear to know about it, by confirming with a -second 'RET'. - -** Dired - ---- -*** 'w' ('dired-copy-filename-as-kill') has changed behavior. -If there are several files marked, file names containing space and -quote characters will be quoted "like this". - ---- -*** The 'd' command now more consistently skips dot files. -In previous Emacs versions, commands like 'C-u 10 d' would put the "D" -mark on the next ten files, no matter whether they were dot files -(i.e., "." and "..") or not, while marking the next ten lines with the -mouse (in 'transient-mark-mode') and then hitting 'd' would skip dot -files. These now work equivalently. - -+++ -** Warning about "eager macro-expansion failure" is now an error. - ---- -** Previously, the X "reverseVideo" value at startup was heeded for all frames. -This meant that if you had a "reverseVideo" resource on the initial -display, and then opened up a new frame on a display without any -explicit "reverseVideo" setting, it would get heeded there, too. (This -included terminal frames.) In Emacs 29, the "reverseVideo" X resource -is handled like all the other X resources, and set on a per-frame basis. - -+++ -** 'E' in 'query-replace' now edits the replacement with exact case. -Previously, this command did the same as 'e'. - ---- -** '/ a' in "*Packages*" buffer now limits by archive name(s) instead of regexp. - -+++ -** Setting the goal columns now also affects '<prior>' and '<next>'. -Previously, 'C-x C-n' only affected 'next-line' and 'previous-line', -but it now also affects 'scroll-up-command' and 'scroll-down-command'. - ---- -** Isearch in "*Help*" and "*info*" now char-folds quote characters by default. -This means that you can say 'C-s `foo' (GRAVE ACCENT) if the buffer -contains "‘foo" (LEFT SINGLE QUOTATION MARK) and the like. These -quotation characters look somewhat similar in some fonts. To switch -this off, disable the new 'isearch-fold-quotes-mode' minor mode. - ---- -** Sorting commands no longer necessarily change modification status. -In earlier Emacs versions, commands like 'sort-lines' would always -change buffer modification status to "modified", whether they changed -something in the buffer or not. This has been changed: the buffer is -marked as modified only if the sorting ended up actually changing the -contents of the buffer. - ---- -** 'string-lines' handles trailing newlines differently. -It no longer returns an empty final string if the string ends with a -newline. - ---- -** 'TAB' and '<backtab>' are now bound in 'button-map'. -This means that if point is on a button, 'TAB' will take you to the -next button, even if the mode has bound it to something else. This -also means that 'TAB' on a button in an 'outline-minor-mode' heading -will move point instead of collapsing the outline. - ---- -** 'outline-minor-mode-cycle-map' is now parent of 'outline-minor-mode'. -Instead of adding text property 'keymap' with 'outline-minor-mode-cycle' -on outline headings in 'outline-minor-mode', the keymap -'outline-minor-mode-cycle' is now active in the whole buffer. -But keybindings in 'outline-minor-mode-cycle' still take effect -only on outline headings because they are bound with the help of -'outline-minor-mode-cycle--bind' that checks if point is on a heading. - ---- -** 'Info-default-directory-list' is no longer populated at Emacs startup. -If you have code in your init file that removes directories from -'Info-default-directory-list', this will no longer work. - ---- -** 'C-k' no longer deletes files in 'ido-mode'. -To get the previous action back, put something like the following in -your Init file: - - (require 'ido) - (keymap-set ido-file-completion-map "C-k" #'ido-delete-file-at-head) - ---- -** New user option 'term-clear-full-screen-programs'. -By default, term.el will now work like most terminals when displaying -full-screen programs: When they exit, the output is cleared, leaving -what was displayed in the window before the programs started. Set -this user option to nil to revert back to the old behavior. - ---- -** Support for old EIEIO functions is not autoloaded any more. -You need an explicit '(require 'eieio-compat)' to use 'defmethod' -and 'defgeneric' (which have been made obsolete in Emacs 25.1 with -'cl-defmethod' and 'cl-defgeneric'). -Similarly you might need to '(require 'eieio-compat)' before loading -files that were compiled with an old EIEIO (Emacs<25). - ---- -** 'C-x 8 .' has been moved to 'C-x 8 . .'. -This is to open up the 'C-x 8 .' map to bind further characters there. - ---- -** 'C-x 8 =' has been moved to 'C-x 8 = ='. -You can now use 'C-x 8 =' to insert several characters with macron; -for example, 'C-x 8 = a' will insert U+0101 LATIN SMALL LETTER A WITH -MACRON. To insert a lone macron, type 'C-x 8 = =' instead of the -previous 'C-x ='. - -** Eshell - -*** Eshell's PATH is now derived from 'exec-path'. -For consistency with remote connections, Eshell now uses 'exec-path' -to determine the execution path on the local or remote system, instead -of using the PATH environment variable directly. - ---- -*** 'source' and '.' no longer accept the '--help' option. -This is for compatibility with the shell versions of these commands, -which don't handle options like '--help' in any special way. - -+++ -*** String delimiters in argument predicates/modifiers are more restricted. -Previously, some argument predicates/modifiers allowed arbitrary -characters as string delimiters. To provide more unified behavior -across all predicates/modifiers, the list of allowed delimiters has -been restricted to "...", '...', /.../, |...|, (...), [...], <...>, -and {...}. See the "(eshell) Argument Predication and Modification" -node in the Eshell manual for more details. - -+++ -*** Eshell pipelines now only pipe stdout by default. -To pipe both stdout and stderr, use the '|&' operator instead of '|'. - ---- -** The 'delete-forward-char' command now deletes by grapheme clusters. -This command is by default bound to the '<Delete>' function key -(a.k.a. '<deletechar>'). When invoked without a prefix argument or -with a positive prefix numeric argument, the command will now delete -complete grapheme clusters produced by character composition. For -example, if point is before an Emoji sequence, pressing '<Delete>' -will delete the entire sequence, not just a single character at its -beginning. - -+++ -** 'load-history' does not treat autoloads specially any more. -An autoload definition appears just as a '(defun . NAME)' and the -'(t . NAME)' entries are not generated any more. - ---- -** The Tamil input methods no longer insert Tamil digits. -The input methods 'tamil-itrans' and 'tamil-inscript' no longer insert -the Tamil digits, as those digit characters are not used nowadays by -speakers of the Tamil language. To get back the previous behavior, -use the new 'tamil-itrans-digits' and 'tamil-inscript-digits' input -methods instead. - -+++ -** New variable 'current-time-list' governing default timestamp form. -Functions like 'current-time' now yield '(TICKS . HZ)' timestamps if -this new variable is nil. The variable defaults to t, which means -these functions default to timestamps of the forms '(HI LO US PS)', -'(HI LO US)' or '(HI LO)', which are less regular and less efficient. -This is part of a long-planned change first documented in Emacs 27. -Developers are encouraged to test timestamp-related code with this -variable set to nil, as it will default to nil in a future Emacs -version and will be removed some time after that. - -+++ -** Functions that recreate the "*scratch*" buffer now also initialize it. -When functions like 'other-buffer' and 'server-execute' recreate -"*scratch*", they now also insert 'initial-scratch-message' and set -the major mode according to 'initial-major-mode', like at Emacs -startup. Previously, these functions ignored -'initial-scratch-message' and left "*scratch*" in 'fundamental-mode'. - ---- -** Naming of Image-Dired thumbnail files has changed. -Names of thumbnail files generated when 'image-dired-thumbnail-storage' -is 'image-dired' now always end in ".jpg". This fixes various issues -on different platforms, but means that thumbnails generated in Emacs 28 -will not be used in Emacs 29, and vice-versa. If disk space is an -issue, consider deleting the 'image-dired-dir' directory (usually -"~/.emacs.d/image-dired/") after upgrading to Emacs 29. - ---- -** The 'rlogin' method in the URL library is now obsolete. -Emacs will now display a warning if you request a URL like -"rlogin://foo@example.org". - ---- -** Setting 'url-gateway-method' to 'rlogin' is now obsolete. -Emacs will now display a warning when setting it to that value. -The user options 'url-gateway-rlogin-host', -'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name' -are also obsolete. - ---- -** The user function 'url-irc-function' now takes a SCHEME argument. -The user option 'url-irc-function' is now called with a sixth argument -corresponding to the scheme portion of the target URL. For example, -this would be "ircs" for a URL like "ircs://irc.libera.chat". - ---- -** The linum.el library is now obsolete. -We recommend using either the built-in 'display-line-numbers-mode', or -the 'nlinum' package from GNU ELPA instead. The former has better -performance, but the latter is closer to a drop-in replacement. - -1. To use 'display-line-numbers-mode', add something like this to your - Init file: - - (global-display-line-numbers-mode 1) - ;; Alternatively, to use it only in programming modes: - (add-hook 'prog-mode-hook #'display-line-numbers-mode) - -2. To use 'nlinum', add this to your Init file: - - (package-install 'nlinum) - (global-nlinum-mode 1) - ;; Alternatively, to use it only in programming modes: - (add-hook 'prog-mode-hook #'nlinum-mode) - -3. To continue using the obsolete package 'linum', add this line to - your Init file, in addition to any existing customizations: - - (require 'linum) - ---- -** The thumbs.el library is now obsolete. -We recommend using command 'image-dired' instead. - ---- -** The autoarg.el library is now marked obsolete. -This library provides the 'autoarg-mode' and 'autoarg-kp-mode' minor -modes to emulate the behavior of the historical editor Twenex Emacs. -We believe it is no longer useful. - ---- -** The quickurl.el library is now obsolete. -Use 'abbrev', 'skeleton' or 'tempo' instead. - ---- -** The rlogin.el library, and the 'rsh' command are now obsolete. -Use something like 'M-x shell RET ssh <host> RET' instead. - ---- -** The url-about.el library is now obsolete. - ---- -** The autoload.el library is now obsolete. -It is superseded by the new loaddefs-gen.el library. - ---- -** The netrc.el library is now obsolete. -Use the 'auth-source-netrc-parse-all' function in auth-source.el -instead. - ---- -** The url-dired.el library is now obsolete. - ---- -** The fast-lock.el and lazy-lock.el libraries have been removed. -They have been obsolete since Emacs 22.1. - -The variable 'font-lock-support-mode' is occasionally useful for -debugging purposes. It is now a regular variable (instead of a user -option) and can be set to nil to disable Just-in-time Lock mode. - - -* Changes in Emacs 29.1 - -+++ -** New user option 'major-mode-remap-alist' to specify favorite major modes. -This user option lets you remap the default modes (e.g. 'perl-mode' or -'latex-mode') to your favorite ones (e.g. 'cperl-mode' or -'LaTeX-mode') without having to use 'defalias', which can have -undesirable side effects. -This applies to all modes specified via 'auto-mode-alist', file-local -variables, etc. - ---- -** Emacs now supports Unicode Standard version 15.0. - ---- -** New user option 'electric-quote-replace-consecutive'. - ---- -** Emacs is now capable of editing files with very long lines. -The display of long lines has been optimized, and Emacs should no -longer choke when a buffer on display contains long lines. The -variable 'long-line-threshold' controls whether and when these display -optimizations are in effect. - -A companion variable 'large-hscroll-threshold' controls when another -set of display optimizations are in effect, which are aimed -specifically at speeding up display of long lines that are truncated -on display. - -If you still experience slowdowns while editing files with long lines, -this may be due to line truncation, or to one of the enabled minor -modes, or to the current major mode. Try turning off line truncation -with 'C-x x t', or try disabling all known slow minor modes with -'M-x so-long-minor-mode', or try disabling both known slow minor modes -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. - -The new function 'long-line-optimizations-p' returns non-nil when -these optimizations are in effect in the current buffer. - -+++ -** New command to change the font size globally. -To increase the font size, type 'C-x C-M-+' or 'C-x C-M-='; to -decrease it, type 'C-x C-M--'; to restore the font size, type 'C-x -C-M-0'. The final key in these commands may be repeated without the -leading 'C-x' and without the modifiers, e.g. 'C-x C-M-+ C-M-+ C-M-+' -and 'C-x C-M-+ + +' increase the font size by three steps. When -'mouse-wheel-mode' is enabled, 'C-M-wheel-up' and 'C-M-wheel-down' also -increase and decrease the font size globally. Additionally, the -user option 'global-text-scale-adjust-resizes-frames' controls whether -the frames are resized when the font size is changed. - ---- -** New config variable 'syntax-wholeline-max' to reduce the cost of long lines. -This variable is used by some operations (mostly syntax-propertization -and font-locking) to treat lines longer than this variable as if they -were made up of various smaller lines. This can help reduce the -slowdowns seen in buffers made of a single long line, but can also -cause misbehavior in the presence of such long lines (though most of -that misbehavior should usually be limited to mis-highlighting). You -can recover the previous behavior with: - - (setq syntax-wholeline-max most-positive-fixnum) - ---- -** New bindings in 'find-function-setup-keys' for 'find-library'. -When 'find-function-setup-keys' is enabled, 'C-x L' is now bound to -'find-library', 'C-x 4 L' is now bound to 'find-library-other-window' -and 'C-x 5 L' is now bound to 'find-library-other-frame'. - -+++ -** New key binding after 'M-x' or 'M-X': 'M-X'. -Emacs allows different completion predicates to be used with 'M-x' -(i.e., 'execute-extended-command') via the -'read-extended-command-predicate' user option. Emacs also has the -'M-X' (note upper case X) command, which only displays commands -especially relevant to the current buffer. Emacs now allows toggling -between these modes while the user is inputting a command by hitting -'M-X' while in the minibuffer. - ---- -** Interactively, 'kill-buffer' will now offer to save the buffer if unsaved. - ---- -** New commands 'duplicate-line' and 'duplicate-dwim'. -'duplicate-line' duplicates the current line the specified number of times. -'duplicate-dwim' duplicates the region if it is active. If not, it -works like 'duplicate-line'. An active rectangular region is -duplicated on its right-hand side. - ---- -** Files with the ".eld" extension are now visited in 'lisp-data-mode'. - -+++ -** 'network-lookup-address-info' can now check numeric IP address validity. -Specifying 'numeric' as the new optional HINTS argument makes it -check if the passed address is a valid IPv4/IPv6 address (without DNS -traffic). - - (network-lookup-address-info "127.1" 'ipv4 'numeric) - => ([127 0 0 1 0]) - -+++ -** New command 'find-sibling-file'. -This command jumps to a file considered a "sibling file", which is -determined according to the new user option 'find-sibling-rules'. - -+++ -** New user option 'delete-selection-temporary-region'. -When non-nil, 'delete-selection-mode' will only delete the temporary -regions (usually set by mouse-dragging or shift-selection). - -+++ -** New user option 'switch-to-prev-buffer-skip-regexp'. -This should be a regexp or a list of regexps; buffers whose names -match those regexps will be ignored by 'switch-to-prev-buffer' and -'switch-to-next-buffer'. - -+++ -** New command 'rename-visited-file'. -This command renames the file visited by the current buffer by moving -it to a new name or location, and also makes the buffer visit this new -file. - -** Menus - ---- -*** The entries following the buffers in the "Buffers" menu can now be altered. -Change the 'menu-bar-buffers-menu-command-entries' variable to alter -the entries that follow the buffer list. - ---- -** 'delete-process' is now a command. -When called interactively, it will kill the process running in the -current buffer (if any). This can be useful if you have runaway -output in the current buffer (from a process or a network connection), -and want to stop it. - -+++ -** New command 'restart-emacs'. -This is like 'save-buffers-kill-emacs', but instead of just killing -the current Emacs process at the end, it starts a new Emacs process -(using the same command line arguments as the running Emacs process). -'kill-emacs' and 'save-buffers-kill-emacs' have also gained new -optional arguments to restart instead of just killing the current -process. - -** Drag and Drop - -+++ -*** New user option 'mouse-drag-mode-line-buffer'. -If non-nil, dragging on the buffer name part of the mode-line will -drag the buffer's associated file to other programs. This option is -currently only available on X, Haiku and Nextstep (GNUstep or macOS). - -+++ -*** New user option 'mouse-drag-and-drop-region-cross-program'. -If non-nil, this option allows dragging text in the region from Emacs -to another program. - ---- -*** New user option 'mouse-drag-and-drop-region-scroll-margin'. -If non-nil, this option allows scrolling a window while dragging text -around without a scroll wheel. - -+++ -*** The value of 'mouse-drag-copy-region' can now be the symbol 'non-empty'. -This prevents mouse drag gestures from putting empty strings onto the -kill ring. - -+++ -*** New user options 'dnd-indicate-insertion-point' and 'dnd-scroll-margin'. -These options allow adjusting point and scrolling a window when -dragging items from another program. - -+++ -*** The X Direct Save (XDS) protocol is now supported. -This means dropping an image or file link from programs such as -Firefox will no longer create a temporary file in a random directory, -instead asking you where to save the file first. - -+++ -** New user option 'record-all-keys'. -If non-nil, this option will force recording of all input keys, -including those typed in response to passwords prompt (this was the -previous behavior). The default is nil, which inhibits recording of -passwords. - -+++ -** New function 'command-query'. -This function makes its argument command prompt the user for -confirmation before executing. - -+++ -** The 'disabled' property of a command's symbol can now be a list. -The first element of the list should be the symbol 'query', which will -cause the command disabled this way prompt the user with a y/n or a -yes/no question before executing. The new function 'command-query' is -a convenient method of making commands disabled in this way. - ---- -** 'count-words' will now report buffer totals if given a prefix. -Without a prefix, it will only report the word count for the narrowed -part of the buffer. - -+++ -** 'count-words' will now report sentence count when used interactively. - -+++ -** New user option 'set-message-functions'. -It allows selecting more functions for 'set-message-function' -in addition to the default function that handles messages -in the active minibuffer. The most useful are 'inhibit-message' -that allows specifying a list of messages to inhibit via -'inhibit-message-regexps', and 'set-multi-message' that -accumulates recent messages and displays them stacked -in the echo area. - ---- -** New user option 'find-library-include-other-files'. -If set to nil, commands like 'find-library' will only include library -files in the completion candidates. The default is t, which preserves -previous behavior, whereby non-library files could also be included. - -+++ -** New command 'sqlite-mode-open-file' for examining an sqlite3 file. -This uses the new 'sqlite-mode' which allows listing the tables in a -DB file, and examining and modifying the columns and the contents of -those tables. - ---- -** 'write-file' will now copy some file mode bits. -If the current buffer is visiting a file that is executable, the -'C-x C-w' command will now make the new file executable, too. - -+++ -** New user option 'process-error-pause-time'. -This determines how long to pause Emacs after a process -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'. - -+++ -** New face 'variable-pitch-text'. -This face is like 'variable-pitch' (from which it inherits), but is -slightly larger, which should help with the visual size differences -between the default, non-proportional font and proportional fonts when -mixed. - -+++ -** New face 'mode-line-active'. -This inherits from the 'mode-line' face, but is the face actually used -on the mode lines (along with 'mode-line-inactive'). - -+++ -** New face attribute pseudo-value 'reset'. -This value stands for the value of the corresponding attribute of the -'default' face. It can be used to reset attribute values produced by -inheriting from other faces. - -+++ -** New X resource: "borderThickness". -This controls the thickness of the external borders of the menu bars -and pop-up menus. - -+++ -** New X resource: "inputStyle". -This controls the style of the pre-edit and status areas of X input -methods. - -+++ -** New X resources: "highlightForeground" and "highlightBackground". -Only in the Lucid build, this controls colors used for highlighted -menu item widgets. - -+++ -** On X, Emacs now tries to synchronize window resize with the window manager. -This leads to less flicker and empty areas of a frame being displayed -when a frame is being resized. Unfortunately, it does not work on -some ancient buggy window managers, so if Emacs appears to freeze, but -is still responsive to input, you can turn it off by setting the X -resource "synchronizeResize" to "off". - -+++ -** On X, Emacs can optionally synchronize display with the graphics hardware. -When this is enabled by setting the X resource "synchronizeResize" to -"extended", frame content "tearing" is drastically reduced. This is -only supported on the Motif, Lucid, and no-toolkit builds, and -requires an X compositing manager supporting the extended frame -synchronization protocol (see -https://fishsoup.net/misc/wm-spec-synchronization.html). - -This behavior can be toggled on and off via the frame parameter -'use-frame-synchronization'. - -+++ -** New frame parameter 'alpha-background' and X resource "alphaBackground". -This controls the opacity of the text background when running on a -composited display. - -+++ -** New frame parameter 'shaded'. -With window managers which support this, it controls whether or not a -frame's contents will be hidden, leaving only the title bar on display. - ---- -** New user option 'x-gtk-use-native-input'. -This controls whether or not GTK input methods are used by Emacs, -instead of XIM input methods. - -+++ -** New user option 'use-system-tooltips'. -This controls whether to use the toolkit tooltips, or Emacs's own -native implementation of tooltips as small frames. This option is -only meaningful if Emacs was built with GTK+, Nextstep, or Haiku -support, and defaults to t, which makes Emacs use the toolkit -tooltips. The existing GTK-specific option -'x-gtk-use-system-tooltips' is now an alias of this new option. - -+++ -** Non-native tooltips are now supported on Nextstep. -This means Emacs built with GNUstep or built on macOS is now able to -display different faces and images inside tooltips when the -'use-system-tooltips' user option is nil. - ---- -** New minor mode 'pixel-scroll-precision-mode'. -When enabled, and if your mouse supports it, you can scroll the -display up or down at pixel resolution, according to what your mouse -wheel reports. Unlike 'pixel-scroll-mode', this mode scrolls the -display pixel-by-pixel, as opposed to only animating line-by-line -scrolls. - -** Terminal Emacs - ---- -*** Emacs will now use 24-bit colors on terminals that support "Tc" capability. -This is in addition to previously-supported ways of discovering 24-bit -color support: either via the "RGB" or "setf24" capabilities, or if -the 'COLORTERM' environment variable is set to the value "truecolor". - ---- -*** Select active regions with xterm selection support. -On terminals with xterm "setSelection" support, the active region may be -saved to the X primary selection, following the -'select-active-regions' variable. This support is enabled when -'tty-select-active-regions' is non-nil. - ---- -*** New command to set up display of unsupported characters. -The new command 'standard-display-by-replacement-char' produces Lisp -code that sets up the 'standard-display-table' to use a replacement -character for display of characters that the text-mode terminal -doesn't support. This code is intended to be used in your init files. -This feature is most useful with the Linux console and similar -terminals, where Emacs has a reliable way of determining which -characters have glyphs in the font loaded into the terminal's memory. - ---- -*** New functions to set terminal output buffer size. -The new functions 'tty--set-output-buffer-size' and -'tty--output-buffer-size' allow setting and retrieving the output -buffer size of a terminal device. The default buffer size is and has -always been BUFSIZ, which is defined in your system's stdio.h. When -you set a buffer size with 'tty--set-output-buffer-size', this also -prevents Emacs from explicitly flushing the tty output stream, except -at the end of display update. - -** ERT - -+++ -*** New ERT variables 'ert-batch-print-length' and 'ert-batch-print-level'. -These variables will override 'print-length' and 'print-level' when -printing Lisp values in ERT batch test results. - ---- -*** Redefining an ERT test in batch mode now signals an error. -Executing 'ert-deftest' with the same name as an existing test causes -the previous definition to be discarded, which was probably not -intended when this occurs in batch mode. To remedy the error, rename -tests so that they all have unique names. - -+++ -*** ERT can generate JUnit test reports. -When environment variable 'EMACS_TEST_JUNIT_REPORT' is set, ERT -generates a JUnit test report under this file name. This is useful -for Emacs integration into CI/CD test environments. - ---- -*** Unbound test symbols now signal an 'ert-test-unbound' error. -This affects the 'ert-select-tests' function and its callers. - -** Emoji - -+++ -*** Emacs now has several new methods for inserting Emoji. -The Emoji commands are under the new 'C-x 8 e' prefix. - -+++ -*** New command 'emoji-insert' (bound to 'C-x 8 e e' and 'C-x 8 e i'). -This command guides you through various Emoji categories and -combinations in a graphical menu system. - -+++ -*** New command 'emoji-search' (bound to 'C-x 8 e s'). -This command lets you search for Emoji based on names. - -+++ -*** New command 'emoji-list' (bound to 'C-x 8 e l'). -This command lists all Emoji (categorized by themes) in a special -buffer and lets you choose one of them. - ---- -*** New command 'emoji-recent' (bound to 'C-x 8 e r'). -This command lets you choose among the Emoji you have recently -inserted. - -+++ -*** New command 'emoji-describe' (bound to 'C-x 8 e d'). -This command will tell you the name of the Emoji at point. (It also -works for non-Emoji characters.) - ---- -*** New commands 'emoji-zoom-increase' and 'emoji-zoom-decrease'. -These are bound to 'C-x 8 e +' and 'C-x 8 e -', respectively. They -can be used on any character, but are mainly useful for Emoji. - ---- -*** New input method 'emoji'. -This allows you to enter Emoji using short strings, eg ':face_palm:' -or ':scream:'. - -** Help - ---- -*** Variable values displayed by 'C-h v' in "*Help*" are now fontified. - -+++ -*** New user option 'help-clean-buttons'. -If non-nil, link buttons in "*Help*" buffers will have any surrounding -quotes removed. - ---- -*** 'M-x apropos-variable' output now includes values of variables. - -+++ -*** New docstring syntax to indicate that symbols shouldn't be links. -When displaying docstrings in "*Help*" buffers, strings that are -"`like-this'" are made into links (if they point to a bound -function/variable). This can lead to false positives when talking -about values that are symbols that happen to have the same names as -functions/variables. To inhibit this buttonification, use the new -"\\+`like-this'" syntax. - -+++ -*** New user option 'help-window-keep-selected'. -If non-nil, commands to show the info manual and the source will reuse -the same window in which the "*Help*" buffer is shown. - ---- -*** Commands like 'C-h f' have changed how they describe menu bindings. -For instance, previously a command might be described as having the -following bindings: - - It is bound to <open>, C-x C-f, <menu-bar> <file> <new-file>. - -This has been changed to: - - It is bound to <open> and C-x C-f. - It can also be invoked from the menu: File → Visit New File... - -+++ -*** The 'C-h .' command now accepts a prefix argument. -'C-u C-h .' would previously inhibit displaying a warning message if -there's no local help at point. This has been changed to call -'button-describe'/'widget-describe' and display button/widget help -instead. - ---- -*** New user option 'help-enable-variable-value-editing'. -If enabled, 'e' on a value in "*Help*" will pop you to a new buffer -where you can edit the value. This is not enabled by default, because -it is easy to make an edit that yields an invalid result. - ---- -*** 'C-h b' uses outlining by default. -Set 'describe-bindings-outline' to nil to get back the old behavior. - ---- -*** Jumping to function/variable source now saves mark before moving point. -Jumping to source from a "*Help*" buffer moves point when the source -buffer is already open. Now, the old point is pushed onto mark ring. - -+++ -*** New key bindings in "*Help*" buffers: 'n' and 'p'. -These will take you (respectively) to the next and previous "page". - ---- -*** 'describe-char' now also outputs the name of Emoji sequences. - -+++ -*** New key binding in "*Help*" buffer: 'I'. -This will take you to the Emacs Lisp manual entry for the item -displayed, if any. - ---- -*** The 'C-h m' ('describe-mode') "*Help*" buffer has been reformatted. -It now only includes local minor modes at the start, and the global -minor modes are listed after the major mode. - -+++ -*** The user option 'help-window-select' now affects apropos commands. -The apropos commands will now select the apropos window if -'help-window-select' is non-nil. - ---- -*** 'describe-keymap' now considers the symbol at point. -If the symbol at point is a keymap, 'describe-keymap' suggests it as -the default candidate. - ---- -*** New command 'help-quick' displays an overview of common commands. -The command pops up a buffer at the bottom of the screen with a few -helpful commands for various tasks. You can toggle the display using -'C-h C-q'. - -** Emacs now comes with Org v9.6. -See the file "ORG-NEWS" for user-visible changes in Org. - -** Outline Mode - -+++ -*** Support for customizing the default visibility state of headings. -Customize the user option 'outline-default-state' to define what -headings will be visible initially, after Outline mode is turned on. -When the value is a number, the user option 'outline-default-rules' -determines the visibility of the subtree starting at the corresponding -level. Values are provided to control showing a heading subtree -depending on whether the heading matches a regexp, or on whether its -subtree has long lines or is itself too long. - -** Outline Minor Mode - -+++ -*** New user option 'outline-minor-mode-use-buttons'. -If non-nil, Outline Minor Mode will use buttons to hide/show outlines -in addition to the ellipsis. The default is nil, but in 'help-mode' -it has the value 'insert' that inserts the buttons directly into the -buffer, and you can use 'RET' to cycle outline visibility. When -the value is 'in-margins', Outline Minor Mode uses the window margins -for buttons that hide/show outlines. - -** Windows - -+++ -*** New commands 'split-root-window-below' and 'split-root-window-right'. -These commands split the root window in two, and are bound to 'C-x w 2' -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 -buffer on that frame. - -+++ -*** 'display-buffer' now can set up the body size of the chosen window. -For example, a 'display-buffer-alist' entry of - - (window-width . (body-columns . 40)) - -will make the body of the chosen window 40 columns wide. For the -height use 'window-height' and 'body-lines', respectively. - ---- -*** You can customize on which window 'scroll-other-window' operates. -This is controlled by the new 'other-window-scroll-default' variable. - -** Frames - -+++ -*** Deleted frames can now be undeleted. -The 16 most recently deleted frames can be undeleted with 'C-x 5 u' when -'undelete-frame-mode' is enabled. Without a prefix argument, undelete -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. - -** Tab Bars and Tab Lines - ---- -*** New user option 'tab-bar-auto-width' to automatically determine tab width. -This option is non-nil by default, which resizes tab-bar tabs so that -their width is evenly distributed across the tab bar. A companion -option 'tab-bar-auto-width-max' controls the maximum width of a tab -before its name on display is truncated. - ---- -*** 'C-x t RET' creates a new tab when the provided tab name doesn't exist. -It prompts for the name of a tab and switches to it, creating a new -tab if no tab exists by that name. - ---- -*** New keymap 'tab-bar-history-mode-map'. -By default, it contains 'C-c <left>' and 'C-c <right>' to browse -the history of tab window configurations back and forward. - ---- -** Better detection of text suspiciously reordered on display. -The function 'bidi-find-overridden-directionality' has been extended -to detect reordering effects produced by embeddings and isolates -(started by directional formatting control characters such as RLO and -LRI). The new command 'highlight-confusing-reorderings' finds and -highlights segments of buffer text whose reordering for display is -suspicious and could be malicious. - -** Emacs Server and Client - -+++ -*** New command-line option '-r'/'--reuse-frame' for emacsclient. -With this command-line option, Emacs reuses an existing graphical client -frame if one exists; otherwise it creates a new frame. +* Changes in Emacs 30.1 -+++ -*** New command-line option '-w N'/'--timeout=N' for emacsclient. -With this command-line option, emacsclient will exit if Emacs does not -respond within N seconds. The default is to wait forever. - -+++ -*** 'server-stop-automatically' can be used to automatically stop the server. -The Emacs server will be automatically stopped when certain conditions -are met. The conditions are given by the argument, which can be -'empty', 'delete-frame' or 'kill-terminal'. +** X selection requests are now handled much faster and asynchronously. +This means it should be less necessary to disable the likes of +'select-active-regions' when Emacs is running over a slow network +connection. -** Rcirc +** Emacs now updates invisible frames that are made visible by a compositor. +If an invisible or an iconified frame is shown to the user by the +compositing manager, Emacs will now redisplay such a frame even though +'frame-visible-p' returns nil or 'icon' for it. This can happen, for +example, as part of preview for iconified frames. +++ -*** New command 'rcirc-when'. +** 'write-region-inhibit-fsync' now defaults to t in interactive mode, +as it has in batch mode since Emacs 24. +++ -*** New user option 'rcirc-cycle-completion-flag'. -Rcirc will use the default 'completion-at-point' mechanism. The -conventional IRC behavior of completing by cycling through the -available options can be restored by enabling this option. - -+++ -*** New user option 'rcirc-bridge-bot-alist'. -If you are in a channel where a bot is responsible for bridging -between networks, you can use this variable to make these messages -appear more native. For example, you might set the option to: - - (setopt rcirc-bridge-bot-alist '(("bridge" . "{\\(.+?\\)}[[:space:]]+"))) - -for messages like - - 09:47 <bridge> {john} I am not on IRC - -to be reformatted into - - 09:47 <john> I am not on IRC - ---- -*** New formatting commands. -Most IRC clients (including rcirc) support basic formatting using -control codes. Under the 'C-c C-f' prefix a few commands have been -added to insert these automatically. For example, if a region is -active and 'C-c C-f C-b' is invoked, markup is inserted for the region -to be highlighted in bold. - -** Imenu +** New user option 'remote-file-name-inhibit-delete-by-moving-to-trash'. +When non-nil, this option suppresses moving remote files to the local +trash when deleting. Default is nil. +++ -*** 'imenu' is now bound to 'M-g i' globally. - ---- -*** New function 'imenu-flush-cache'. -Use it if you want Imenu to forget the buffer's index alist and -recreate it anew next time 'imenu' is invoked. +** New user option 'yes-or-no-prompt'. +This allows the user to customize the prompt that is appended by +'yes-or-no-p' when asking questions. The default value is +"(yes or no) ". --- -** Emacs is now capable of abandoning a window's redisplay that takes too long. -This is controlled by the new variable 'max-redisplay-ticks'. If that -variable is set to a non-zero value, display of a window will be -aborted after that many low-level redisplay operations, thus -preventing Emacs from becoming wedged when visiting files with very -long lines. The default is zero, which disables the feature: Emacs -will wait forever for redisplay to finish. (We believe you won't need -this feature, given the ability to display buffers with very long -lines.) +** 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 29.1 - -+++ -** 'M-SPC' is now bound to 'cycle-spacing'. -Formerly it invoked 'just-one-space'. The actions performed by -'cycle-spacing' and their order can now be customized via the user -option 'cycle-spacing-actions'. - ---- -** 'zap-to-char' and 'zap-up-to-char' are case-sensitive for upper-case chars. -These commands now behave as case-sensitive for interactive calls when -they are invoked with an uppercase character, regardless of the value -of 'case-fold-search'. - ---- -** 'scroll-other-window' and 'scroll-other-window-down' now respect remapping. -These commands (bound to 'C-M-v' and 'C-M-V') used to scroll the other -windows without looking at customizations in that other window. These -functions now check whether they have been rebound in the buffer shown -in that other window, and then call the remapped function instead. In -addition, these commands now also respect the -'scroll-error-top-bottom' user option. - ---- -** Indentation of 'cl-flet' and 'cl-labels' has changed. -These forms now indent like this: - - (cl-flet ((bla (x) - (* x x))) - (bla 42)) - -This change also affects 'cl-macrolet', 'cl-flet*' and -'cl-symbol-macrolet'. - -+++ -** New user option 'translate-upper-case-key-bindings'. -Set this option to nil to inhibit the default translation of upper -case keys to their lower case variants. - -+++ -** New command 'ensure-empty-lines'. -This command increases (or decreases) the number of empty lines before -point. - ---- -** Improved mouse behavior with auto-scrolling modes. -When clicking inside the 'scroll-margin' or 'hscroll-margin' region, -point is now moved only when releasing the mouse button. This no -longer results in a bogus selection, unless the mouse has also been -dragged. - -+++ -** 'kill-ring-max' now defaults to 120. - ---- -** New user option 'yank-menu-max-items'. -Customize this option to limit the number of entries in the menu -"Edit → Paste from Kill Menu". The default is 60. - -+++ -** Performing a pinch gesture on a touchpad now increases the text scale. - -** Show Paren Mode - -+++ -*** New user option 'show-paren-context-when-offscreen'. -When non-nil, if the point is in a closing delimiter and the opening -delimiter is offscreen, shows some context around the opening -delimiter in the echo area. The default is nil. - -This option can also be set to the symbols 'overlay' or 'child-frame', -in which case the context is shown in an overlay or child-frame at the -top-left of the current window. The latter option requires a -graphical frame. On non-graphical frames, the context is shown in the -echo area. - -** Comint - -+++ -*** 'comint-term-environment' is now aware of connection-local variables. -The user option 'comint-terminfo-terminal' and the variable -'system-uses-terminfo' can now be set as connection-local variables to -change the terminal used on a remote host. - ---- -*** New user option 'comint-delete-old-input'. -When nil, this prevents comint from deleting the current input when -inserting previous input using '<mouse-2>'. The default is t, to -preserve previous behavior. - ---- -*** New minor mode 'comint-fontify-input-mode'. -This minor mode is enabled by default in "*shell*" and "*ielm*" -buffers. It fontifies input text according to 'shell-mode' or -'emacs-lisp-mode' font-lock rules. Customize the user options -'shell-fontify-input-enable' and 'ielm-fontify-input-enable' to nil if -you don't want to enable input fontification by default. - -** Mwheel - ---- -*** New user options for alternate wheel events. -The user options 'mouse-wheel-down-alternate-event' and -'mouse-wheel-up-alternate-event' as well as the variables -'mouse-wheel-left-alternate-event' and -'mouse-wheel-right-alternate-event' have been added to better support -systems where two kinds of wheel events can be received. - -** Internationalization - ---- -*** The '<Delete>' function key now allows deleting the entire composed sequence. -For the details, see the item about the 'delete-forward-char' command -above. - ---- -*** New user option 'composition-break-at-point'. -Setting it to a non-nil value temporarily disables automatic -composition of character sequences at point, and thus makes it easier -to edit such sequences by allowing point to "enter" the composed -sequence. - ---- -*** Support for many old scripts and writing systems. -Emacs now supports, and has language-environments and input methods, -for several dozens of old scripts that were used in the past for -various languages. For each such script Emacs now has font-selection -and character composition rules, a language environment, and an input -method. The newly-added scripts and the corresponding language -environments are: - - Tai Tham script and the Northern Thai language environment - - Brahmi script and language environment - - Kaithi script and language environment - - Tirhuta script and language environment - - Sharada script and language environment - - Siddham script and language environment - - Syloti Nagri script and language environment - - Modi script and language environment - - Baybayin script and Tagalog language environment - - Hanunoo script and language environment - - Buhid script and language environment - - Tagbanwa script and language environment - - Limbu script and language environment - - Balinese script and language environment - - Javanese script and language environment - - Sundanese script and language environment - - Batak script and language environment - - Rejang script and language environment - - Makasar script and language environment - - Lontara script and language environment - - Hanifi Rohingya script and language environment - - Grantha script and language environment - - Kharoshthi script and language environment - - Lepcha script and language environment - - Meetei Mayek script and language environment - - Adlam script and language environment - - Mende Kikakui script and language environment - - Wancho script and language environment - - Toto script and language environment - - Gothic script and language environment - - Coptic script and language environment - ---- -*** The "Oriya" language environment was renamed to "Odia". -This is to follow the change in the official name of the script. The -'oriya' input method was also renamed to 'odia'. However, the old -name of the language environment and the input method are still -supported. - ---- -*** New Greek translation of the Emacs tutorial. -Type 'C-u C-h t' to select it in case your language setup does not do -so automatically. - ---- -*** New Ukrainian translation of the Emacs Tutorial. +* Editing Changes in Emacs 30.1 --- -*** New default phonetic input method for the Tamil language environment. -The default input method for the Tamil language environment is now -"tamil-phonetic" which is a customizable phonetic input method. To -change the input method's translation rules, customize the user option -'tamil-translation-rules'. +** 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 'tamil99' input method for the Tamil language. -This supports the keyboard layout specifically designed for the Tamil -language. - ---- -*** New input method 'slovak-qwerty'. -This is a variant of the 'slovak' input method, which corresponds to -the QWERTY Slovak keyboards. - ---- -*** New input method 'cyrillic-chuvash'. -This input method is based on the russian-computer input method, and -is intended for typing in the Chuvash language written in the Cyrillic -script. +** New command 'kill-matching-buffers-no-ask'. +This works like 'kill-matching-buffers', but without asking for +confirmation. -* Changes in Specialized Modes and Packages in Emacs 29.1 - -** Ecomplete - ---- -*** New commands 'ecomplete-edit' and 'ecomplete-remove'. -These allow you to (respectively) edit and bulk-remove entries from -the ecomplete database. - ---- -*** New user option 'ecomplete-auto-select'. -If non-nil and there's only one matching option, auto-select that. - ---- -*** New user option 'ecomplete-filter-regexp'. -If non-nil, this user option describes what entries not to add to the -database stored on disk. - -** Auth Source - -+++ -*** New user option 'auth-source-pass-extra-query-keywords'. -Whether to recognize additional keyword params, like ':max' and -':require', as well as accept lists of query terms paired with -applicable keywords. This disables most known behavioral quirks -unique to auth-source-pass, such as wildcard subdomain matching. - -** Dired - -+++ -*** 'dired-guess-shell-command' moved from dired-x to dired. -This means that 'dired-do-shell-command' will now provide smarter -defaults without first having to require 'dired-x'. See the node -"(emacs) Shell Command Guessing" in the Emacs manual for more details. - ---- -*** 'dired-clean-up-buffers-too' moved from dired-x to dired. -This means that Dired now offers to kill buffers visiting files and -dirs when they are deleted in Dired. Before, you had to require -'dired-x' to enable this behavior. To disable this behavior, -customize the user option 'dired-clean-up-buffers-too' to nil. The -related user option 'dired-clean-confirm-killing-deleted-buffers' -(which see) has also been moved to 'dired'. - -+++ -*** 'dired-do-relsymlink' moved from dired-x to dired. -The corresponding key 'Y' is now bound by default in Dired. - -+++ -*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. -The corresponding key sequence '% 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-info' and 'dired-man' moved from dired-x to dired. -The 'dired-info' and 'dired-man' commands have been moved from the -dired-x package to dired. They have also been renamed to -'dired-do-info' and 'dired-do-man'; the old command names are obsolete -aliases. - -The keys 'I' ('dired-do-info') and 'N' ('dired-do-man') are now bound -in Dired mode by default. The user options 'dired-bind-man' and -'dired-bind-info' no longer have any effect and are obsolete. - -To get the old behavior back and unbind these keys in Dired mode, add -the following to your Init file: - - (with-eval-after-load 'dired - (keymap-set dired-mode-map "N" nil) - (keymap-set dired-mode-map "I" nil)) - ---- -*** New command 'dired-do-eww'. -This command visits the file on the current line with EWW. - ---- -*** New user option 'dired-omit-lines'. -This is used by 'dired-omit-mode', and now allows you to hide based on -other things than just the file names. - -+++ -*** New user option 'dired-mouse-drag-files'. -If non-nil, dragging file names with the mouse in a Dired buffer will -initiate a drag-and-drop session allowing them to be opened in other -programs. - -+++ -*** New user option 'dired-free-space'. -Dired will now, by default, include the free space in the first line -instead of having it on a separate line. To get the previous behavior -back, say: - - (setopt dired-free-space 'separate) - ---- -*** New user option 'dired-make-directory-clickable'. -If non-nil (which is the default), hitting 'RET' or 'mouse-1' on -the directory components at the directory displayed at the start of -the buffer will take you to that directory. - ---- -*** Search and replace in Dired/Wdired supports more regexps. -For example, the regexp ".*" will match only characters that are part -of the file name. Also "^.*$" can be used to match at the beginning -of the file name and at the end of the file name. This is used only -when searching on file names. In Wdired this can be used when the new -user option 'wdired-search-replace-filenames' is non-nil (which is the -default). - -** Elisp - ---- -*** New command 'elisp-eval-region-or-buffer' (bound to 'C-c C-e'). -This command evals the forms in the active region or in the whole buffer. - ---- -*** New commands 'elisp-byte-compile-file' and 'elisp-byte-compile-buffer'. -These commands (bound to 'C-c C-f' and 'C-c C-b', respectively) -byte-compile the visited file and the current buffer, respectively. - -** Games - ---- -*** New user option 'tetris-allow-repetitions'. -This controls how randomness is implemented (whether to use pure -randomness as before, or to use a bag). - -** Battery - -+++ -*** New user option 'battery-update-functions'. -This can be used to trigger actions based on the battery status. - -** DocView - ---- -*** doc-view can now generate SVG images when viewing PDF files. -If Emacs is built with SVG support, doc-view can generate SVG files -when using MuPDF as the converter for PDF files, which generally leads -to sharper images (especially when zooming), and allows customization -of background and foreground color of the page via the new user -options 'doc-view-svg-background' and 'doc-view-svg-foreground'. To -activate this behavior, set 'doc-view-mupdf-use-svg' to non-nil if -your Emacs has SVG support. Note that, with some versions of MuPDF, -SVG generation is known to sometimes produce SVG files that are buggy -or can take a long time to render. - -** Enriched Mode - -+++ -*** New command 'enriched-toggle-markup'. -This allows you to see the markup in 'enriched-mode' buffers (e.g., -the "HELLO" file). - -** Shell Script Mode - ---- -*** New user option 'sh-indent-statement-after-and'. -This controls how statements like the following are indented: - - foo && - bar - -*** New Flymake backend using the ShellCheck program. -It is enabled by default, but requires that the external "shellcheck" -command is installed. - -** CC Mode - ---- -*** C++ Mode now supports most of the new features in the C++20 Standard. - -** Cperl Mode +* Changes in Specialized Modes and Packages in Emacs 30.1 --- -*** New user option 'cperl-file-style'. -This option determines the indentation style to be used. It can also -be used as a file-local variable. +** Variable order and truncation can now be configured in 'gdb-many-windows'. +The new user option 'gdb-locals-table-row-config' allows users to +configure the order and max length of various properties in the local +variables buffer when using 'gdb-many-windows'. -** Gud +By default, this user option is set to write the properties in the order: +name, type and value, where the name and type are truncated to 20 +characters, and the value is truncated according to the value of +'gdb-locals-value-limit'. ---- -*** 'gud-go' is now bound to 'C-c C-v'. -If given a prefix, it will prompt for an argument to use for the -run/continue command. +If you want to get back the old behavior, set the user option to the value ---- -*** 'perldb' now recognizes '-E'. -As of Perl 5.10, 'perl -E 0' behaves like 'perl -e 0' but also activates -all optional features of the Perl version in use. 'perldb' now uses -this invocation as its default. - -** Customize - ---- -*** New command 'custom-toggle-hide-all-widgets'. -This is bound to 'H' and toggles whether to hide or show the widget -contents. - -** Diff Mode - ---- -*** New user option 'diff-whitespace-style'. -Sets the value of the buffer-local variable 'whitespace-style' in -'diff-mode' buffers. By default, this variable is '(face trailing)', -which preserves behavior of previous Emacs versions. - -+++ -*** New user option 'diff-add-log-use-relative-names'. -If non-nil insert file names in ChangeLog skeletons relative to the -VC root directory. - -** Ispell - ---- -*** 'ispell-region' and 'ispell-buffer' now push the mark. -These commands push onto the mark ring the location of the last -misspelled word where corrections were offered, so that you can then -skip back to that location with 'C-x C-x'. - -** Dabbrev - ---- -*** New function 'dabbrev-capf' for use on 'completion-at-point-functions'. - -+++ -*** New user option 'dabbrev-ignored-buffer-modes'. -Buffers with major modes in this list will be ignored. By default, -this includes "binary" buffers like 'archive-mode' and 'image-mode'. - -** Package - -+++ -*** New command 'package-update'. -This command allows you to upgrade packages without using 'M-x -list-packages'. - -+++ -*** New command 'package-update-all'. -This command allows updating all packages without any queries. - -+++ -*** New commands 'package-recompile' and 'package-recompile-all'. -These commands can be useful if the ".elc" files are out of date -(invalid byte code and macros). - -+++ -*** New DWIM action on 'x' in "*Packages*" buffer. -If no packages are marked, 'x' will install the package under point if -it isn't already, and remove it if it is installed. - -+++ -*** New command 'package-vc-install'. -Packages can now be installed directly from source by cloning from -their repository. - -+++ -*** New command 'package-vc-install-from-checkout'. -An existing checkout can now be loaded via package.el, by creating a -symbolic link from the usual package directory to the checkout. - -+++ -*** New command 'package-vc-checkout'. -Used to fetch the source of a package by cloning a repository without -activating the package. - -+++ -*** New command 'package-vc-prepare-patch'. -This command allows you to send patches to package maintainers, for -packages checked out using 'package-vc-install'. - -+++ -*** New command 'package-report-bug'. -This command helps you compose an email for sending bug reports to -package maintainers. - -+++ -*** New user option 'package-vc-selected-packages'. -By customizing this user option you can specify specific packages to -install. - -** Emacs Sessions (Desktop) - -+++ -*** New user option to load a locked desktop if locking Emacs is not running. -The option 'desktop-load-locked-desktop' can now be set to the value -'check-pid', which means to allow loading a locked ".emacs.desktop" -file if the Emacs process which locked it is no longer running on the -local machine. This allows avoiding questions about locked desktop -files when the Emacs session which locked it crashes, or was otherwise -interrupted and didn't exit gracefully. See the "(emacs) Saving -Emacs Sessions" node in the Emacs manual for more details. - -** Miscellaneous - -+++ -*** New command 'scratch-buffer'. -This command switches to the "*scratch*" buffer. If "*scratch*" doesn't -exist, the command creates it first. You can use this command if you -inadvertently delete the "*scratch*" buffer. - -** Debugging - ---- -*** 'q' in a "*Backtrace*" buffer no longer clears the buffer. -Instead it just buries the buffer and switches the mode from -'debugger-mode' to 'backtrace-mode', since commands like 'e' are no -longer available after exiting the recursive edit. - -+++ -*** New user option 'debug-allow-recursive-debug'. -This user option controls whether the 'e' (in a "*Backtrace*" -buffer or while edebugging) and 'C-x C-e' (while edebugging) commands -lead to a (further) backtrace. By default, this variable is nil, -which is a change in behavior from previous Emacs versions. - -+++ -*** 'e' in edebug can now take a prefix arg to pretty-print the results. -When invoked with a prefix argument, as in 'C-u e', this command will -pop up a new buffer and show the full pretty-printed value there. - -+++ -*** 'C-x C-e' now interprets a non-zero prefix arg to pretty-print the results. -When invoked with a non-zero prefix argument, as in 'C-u C-x C-e', -this command will pop up a new buffer and show the full pretty-printed -value there. - -+++ -*** You can now generate a backtrace from Lisp errors in redisplay. -To do this, set the new variable 'backtrace-on-redisplay-error' to a -non-nil value. The backtrace will be written to a special buffer -named "*Redisplay-trace*". This buffer will not be automatically -displayed in a window. + (setopt gdb-locals-table-row-config + `((type . 0) (name . 0) (value . ,gdb-locals-value-limit))) ** Compile -+++ -*** New user option 'compilation-hidden-output'. -This can be used to make specific parts of compilation output -invisible. - -+++ -*** The 'compilation-auto-jump-to-first-error' user option has been extended. -It can now have the additional values 'if-location-known' (which will -only jump if the location of the first error is known), and -'first-known' (which will jump to the first known error location). - -+++ -*** New user option 'compilation-max-output-line-length'. -Lines longer than the value of this option will have their ends -hidden, with a button to reveal the hidden text. This speeds up -operations like grepping on files that have few newlines. The default -value is 400; set to nil to disable hiding. - -** Flymake - -+++ -*** New user option 'flymake-mode-line-lighter'. - -+++ -** New minor mode 'word-wrap-whitespace-mode' for extending 'word-wrap'. -This mode switches 'word-wrap' on, and breaks on all the whitespace -characters instead of just 'SPC' and 'TAB'. - ---- -** New mode, 'emacs-news-mode', for editing the NEWS file. -This mode adds some highlighting, makes the 'M-q' command aware of the -format of NEWS entries, and has special commands for doing maintenance -of the Emacs NEWS files. In addition, this mode turns on -'outline-minor-mode', and thus displays customizable icons (see -'icon-preference') in the margins. To disable these icons, set -'outline-minor-mode-use-buttons' to a nil value. - ---- -** Kmacro -Kmacros are now OClosures and have a new constructor 'kmacro' which -uses the 'key-parse' syntax. It replaces the old 'kmacro-lambda-form' -(which is now declared obsolete). - ---- -** savehist.el can now truncate variables that are too long. -An element of user option 'savehist-additional-variables' can now be -of the form '(VARIABLE . MAX-ELTS)', which means to truncate the -VARIABLE's value to at most MAX-ELTS elements (if the value is a list) -before saving the value. - -** Minibuffer and Completions - -+++ -*** New commands for navigating completions from the minibuffer. -When the minibuffer is the current buffer, typing 'M-<up>' or -'M-<down>' selects a previous/next completion candidate from the -"*Completions*" buffer and inserts it to the minibuffer. -When the user option 'minibuffer-completion-auto-choose' is nil, -'M-<up>' and 'M-<down>' do the same, but without inserting -a completion candidate to the minibuffer, then 'M-RET' can be used -to choose the currently active candidate from the "*Completions*" -buffer and exit the minibuffer. With a prefix argument, 'C-u M-RET' -inserts the currently active candidate to the minibuffer, but doesn't -exit the minibuffer. These keys are also available for in-buffer -completion, but they don't insert candidates automatically, you need -to type 'M-RET' to insert the selected candidate to the buffer. - -+++ -*** Choosing a completion with a prefix argument doesn't exit the minibuffer. -This means that typing 'C-u RET' on a completion candidate in the -"*Completions*" buffer inserts the completion into the minibuffer, -but doesn't exit the minibuffer. - -+++ -*** The "*Completions*" buffer can now be automatically selected. -To enable this behavior, customize the user option -'completion-auto-select' to t, then pressing 'TAB' will switch to the -"*Completions*" buffer when it pops up that buffer. If the value is -'second-tab', then the first 'TAB' will display "*Completions*", and -the second one will switch to the "*Completions*" buffer. - ---- -*** New user option 'completion-auto-wrap'. -When non-nil, the commands 'next-completion' and 'previous-completion' -automatically wrap around on reaching the beginning or the end of -the "*Completions*" buffer. - -+++ -*** New values for the 'completion-auto-help' user option. -There are two new values to control the way the "*Completions*" buffer -behaves after pressing a 'TAB' if completion is not unique. The value -'always' updates or shows the "*Completions*" buffer after any attempt -to complete. The value 'visual' is like 'always', but only updates -the completions if they are already visible. The default value t -always hides the completion buffer after some completion is made. - ---- -*** New commands to complete the minibuffer history. -'minibuffer-complete-history' ('C-x <up>') is like 'minibuffer-complete' -but completes on the history items instead of the default completion -table. 'minibuffer-complete-defaults' ('C-x <down>') completes -on the list of default items. - -+++ -*** User option 'minibuffer-eldef-shorten-default' is now obsolete. -Customize the user option 'minibuffer-default-prompt-format' instead. - -+++ -*** New user option 'completions-sort'. -This option controls the sorting of the completion candidates in -the "*Completions*" buffer. Available styles are no sorting, -alphabetical (the default), or a custom sort function. - -+++ -*** New user option 'completions-max-height'. -This option limits the height of the "*Completions*" buffer. - -+++ -*** New user option 'completions-header-format'. -This is a string to control the header line to show in the -"*Completions*" buffer before the list of completions. -If it contains "%s", that is replaced with the number of completions. -If nil, the header line is not shown. - -+++ -*** New user option 'completions-highlight-face'. -When this user option names a face, the current -candidate in the "*Completions*" buffer is highlighted with that face. -The nil value disables this highlighting. The default is to highlight -using the 'completions-highlight' face. - -+++ -*** You can now define abbrevs for the minibuffer modes. -'minibuffer-mode-abbrev-table' and -'minibuffer-inactive-mode-abbrev-table' are now defined. - -** Isearch and Replace - -+++ -*** Changes in how Isearch responds to 'mouse-yank-at-point'. -If a user does 'C-s' and then uses '<mouse-2>' ('mouse-yank-primary') -outside the echo area, Emacs will, by default, end the Isearch and -yank the text at mouse cursor. But if 'mouse-yank-at-point' is -non-nil, the text will now be added to the Isearch instead. - -+++ -*** Changes for values 'no' and 'no-ding' of 'isearch-wrap-pause'. -Now with these values the search will wrap around not only on repeating -with 'C-s C-s', but also after typing a character. - -+++ -*** New user option 'char-fold-override'. -Non-nil means that the default definitions of equivalent characters -are overridden. - -*** New command 'describe-char-fold-equivalences'. -It displays character equivalences used by 'char-fold-to-regexp'. - -+++ -*** New command 'isearch-emoji-by-name'. -It is bound to 'C-x 8 e RET' during an incremental search. The -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. - -** Glyphless Characters - -+++ -*** New minor mode 'glyphless-display-mode'. -This allows an easy way to toggle seeing all glyphless characters in -the current buffer. - ---- -*** The extra slot of 'glyphless-char-display' can now have cons values. -The extra slot of the 'glyphless-char-display' char-table can now have -values that are cons cells, specifying separate values for text-mode -and GUI terminals. - -+++ -*** "Replacement character" feature for undisplayable characters on TTYs. -The 'acronym' method of displaying glyphless characters on text-mode -frames treats single-character acronyms specially: they are displayed -without the surrounding '[..]' "box", thus in effect treating such -"acronyms" as replacement characters. - -** Registers - -+++ -*** Buffer names can now be stored in registers. -For instance, to enable jumping to the "*Messages*" buffer with -'C-x r j m': - - (set-register ?m '(buffer . "*Messages*")) - -** Pixel Fill - -+++ -*** This is a new package that deals with filling variable-pitch text. - -+++ -*** New function 'pixel-fill-region'. -This fills the region to be no wider than a specified pixel width. - -** Info - -+++ -*** Command 'info-apropos' now takes a prefix argument to search for regexps. - ---- -*** New command 'Info-goto-node-web' and key binding 'G'. -This will take you to the "gnu.org" web server's version of the current -info node. This command only works for the Emacs and Emacs Lisp manuals. - -** Shortdoc - ---- -*** New command 'shortdoc-copy-function-as-kill' bound to 'w'. -It copies the name of the function near point into the kill ring. - ---- -*** 'N' and 'P' are now bound to 'shortdoc-{next,previous}-section'. -This is in addition to the old keybindings 'C-c C-n' and 'C-c C-p'. +*** 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 --- -*** New command 'vc-pull-and-push'. -This commands first does a "pull" command, and if that is successful, -does a "push" command afterwards. - -+++ -*** 'C-x v b' prefix key is used now for branch commands. -'vc-print-branch-log' is bound to 'C-x v b l', and new commands are -'vc-create-branch' ('C-x v b c') and 'vc-switch-branch' ('C-x v b s'). -The VC Directory buffer now uses the prefix 'b' for these branch-related -commands. - -+++ -*** New command 'vc-dir-mark-by-regexp' bound to '% m' and '* %'. -This command marks files based on a regexp. If given a prefix -argument, unmark instead. - -+++ -*** New command 'C-x v !' ('vc-edit-next-command'). -This prefix command requests editing of the next VC shell command -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. - ---- -*** 'C-x v v' in a diffs buffer allows to commit only some of the changes. -This command is intended to allow you to commit only some of the -changes you have in your working tree. Begin by creating a buffer -with the changes against the last commit, e.g. with 'C-x v D' -('vc-root-diff'). Then edit the diffs to remove the hunks you don't -want to commit. Finally, type 'C-x v v' in that diff buffer to commit -only part of your changes, those whose hunks were left in the buffer. - ---- -*** 'C-x v v' on an unregistered file will now use the most specific backend. -Previously, if you had an SVN-covered "~/" directory, and a Git-covered -directory in "~/foo/bar", using 'C-x v v' on a new, unregistered file -"~/foo/bar/zot" would register it in the SVN repository in "~/" instead of -in the Git repository in "~/foo/bar". This makes this command -consistent with 'vc-responsible-backend'. - ---- -*** Log Edit now fontifies long Git commit summary lines. -Writing shorter summary lines avoids truncation in contexts in which -Git commands display summary lines. See the two new user options -'vc-git-log-edit-summary-target-len' and 'vc-git-log-edit-summary-max-len'. - ---- -*** New 'log-edit-headers-separator' face. -It is used to style the line that separates the 'log-edit' headers -from the 'log-edit' summary. - ---- -*** The function 'vc-read-revision' accepts a new MULTIPLE argument. -If non-nil, multiple revisions can be queried. This is done using -'completing-read-multiple'. - ---- -*** New function 'vc-read-multiple-revisions'. -This function invokes 'vc-read-revision' with a non-nil value for -MULTIPLE. - -+++ -*** New command 'vc-prepare-patch'. -Patches for any version control system can be prepared using VC. The -command will query what commits to send and will compose messages for -your mail user agent. The behavior of 'vc-prepare-patch' can be -modified by the user options 'vc-prepare-patches-separately' and -'vc-default-patch-addressee'. - -** Message - ---- -*** New user option 'mml-attach-file-at-the-end'. -If non-nil, 'C-c C-a' will put attached files at the end of the message. - ---- -*** Message Mode now supports image yanking. - -+++ -*** New user option 'message-server-alist'. -This controls automatic insertion of the "X-Message-SMTP-Method" -header before sending a message. - -** HTML Mode - ---- -*** HTML Mode now supports "text/html" and "image/*" yanking. - -** Texinfo Mode - ---- -*** 'texinfo-mode' now has a specialized 'narrow-to-defun' definition. -It narrows to the current node. - -** EUDC - -+++ -*** Deprecations planned for next release. -After Emacs 29.1, some aspects of EUDC will be deprecated. The goal -of these deprecations is to simplify EUDC server configuration by -making 'eudc-server-hotlist' the only place to add servers. There -will not be a need to set the server using the 'eudc-set-server' -command. Instead, the 'eudc-server-hotlist' user option should be -customized to have an entry for the server. The plan is to obsolete -the 'eudc-hotlist' package since Customize is sufficient for changing -'eudc-server-hotlist'. How the 'eudc-server' user option works in this -context is to-be-determined; it can't be removed, because that would -break compatibility, but it may become synchronized with -'eudc-server-hotlist' so that 'eudc-server' is always equal to '(car -eudc-server-hotlist)'. The first entry in 'eudc-server-hotlist' is the -first server tried by 'eudc-expand-try-all'. The hotlist -simplification will allow 'eudc-query-form' to show a drop down of -possible servers, instead of requiring a call to 'eudc-set-server' -like it does in this release. The default value of -'eudc-ignore-options-file' will be changed from nil to t. - -+++ -*** New user option 'eudc-ignore-options-file' that defaults to nil. -The 'eudc-ignore-options-file' user option can be configured to ignore -the 'eudc-options-file' (typically "~/.emacs.d/eudc-options"). Most -users should configure this to t and put EUDC configuration in the -main Emacs initialization file ("~/.emacs" or "~/.emacs.d/init.el"). - -+++ -*** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'. -The user option 'eudc-expansion-overwrites-query' is renamed to -'eudc-expansion-save-query-as-kill' to reflect the actual behavior of -the user option. The former is kept as alias. - -+++ -*** New command 'eudc-expand-try-all'. -This command can be used in place of 'eudc-expand-inline'. It takes a -prefix argument that causes 'eudc-expand-try-all' to return matches -from all servers instead of just the matches from the first server to -return any. This is useful for example, if one wants to search LDAP -for a name that happens to match a contact in one's BBDB. - -+++ -*** New behavior and default for user option 'eudc-inline-expansion-format'. -EUDC inline expansion result formatting defaulted to - - ("%s %s <%s>" firstname name email) - -Since email address specifications need to comply with RFC 5322 in -order to be useful in messages, there was a risk to produce syntax -which was standard with RFC 822, but is marked as obsolete syntax by -its successor RFC 5322. Also, the first and last name part was never -enclosed in double quotes, potentially producing invalid address -specifications, which may be rejected by a receiving MTA. Thus, this -variable can now additionally be set to nil (the new default), or a -function. In both cases, the formatted result will be in compliance -with RFC 5322. When set to nil, a default format very similar to the -old default will be produced. When set to a function, that function -is called, and the returned values are used to populate the phrase and -comment parts (see RFC 5322 for definitions). In both cases, the -phrase part will be automatically quoted if necessary. - -+++ -*** New function 'eudc-capf-complete' with 'message-mode' integration. -EUDC can now contribute email addresses to 'completion-at-point' by -adding the new function 'eudc-capf-complete' to -'completion-at-point-functions' in 'message-mode'. - -+++ -*** Additional attributes of query and results in eudcb-macos-contacts.el. -The EUDC back-end for the macOS Contacts app now provides a wider set -of attributes to use for queries, and delivers more attributes in -query results. - -+++ -*** New back-end for ecomplete. -A new back-end for ecomplete allows information from that database to -be queried by EUDC, too. The attributes present in the EUDC query are -used to select the entry type in the ecomplete database. - -+++ -*** New back-end for mailabbrev. -A new back-end for mailabbrev allows information from that database to -be queried by EUDC, too. The attributes 'email', 'name', and 'firstname' -are supported only. - -** EWW/SHR - -+++ -*** New user option to automatically rename EWW buffers. -The 'eww-auto-rename-buffer' user option can be configured to rename -rendered web pages by using their title, URL, or a user-defined -function which returns a string. For the first two cases, the length -of the resulting name is controlled by the user option -'eww-buffer-name-length'. By default, no automatic renaming is -performed. - -+++ -*** New user option 'shr-allowed-images'. -This complements 'shr-blocked-images', but allows specifying just the -allowed images. - -+++ -*** New user option 'shr-use-xwidgets-for-media'. -If non-nil (and Emacs has been built with support for xwidgets), -display <video> elements with an xwidget. Note that this is -experimental; it is known to crash Emacs on some systems, and just -doesn't work on other systems. Also see etc/PROBLEMS. - -+++ -*** New user option 'eww-url-transformers'. -These are used to alter an URL before using it. By default it removes -the common "utm_" trackers from URLs. - -** Find Dired - ---- -*** New command 'find-dired-with-command'. -This enables users to run 'find-dired' with an arbitrary command, -enabling running commands previously unsupported and also enabling new -commands to be built on top. - -** Gnus - -+++ -*** Tool bar changes in Gnus/Message. -There were previously two styles of tool bars available in Gnus and -Message, referred to as 'gnus-summary-tool-bar-retro', -'gnus-group-tool-bar-retro' and 'message-tool-bar-retro', and -'gnus-summary-tool-bar-gnome', 'gnus-group-tool-bar-gnome' and -'message-tool-bar-gnome'. The "retro" tool bars have been removed (as -well as the icons used), and the "gnome" tool bars are now the only -pre-defined toolbars. - ---- -*** 'gnus-summary-up-thread' and 'gnus-summary-down-thread' bindings removed. -The 'gnus-summary-down-thread' binding to 'M-C-d' was shadowed by -'gnus-summary-read-document', and these commands are also available on -'T u' and 'T d' respectively. - ---- -*** Gnus now uses a variable-pitch font in the headers by default. -To get the monospace font back, you can put something like the -following in your ".gnus" file: - - (set-face-attribute 'gnus-header nil :inherit 'unspecified) - ---- -*** The default value of 'gnus-treat-fold-headers' is now 'head'. - ---- -*** New face 'gnus-header'. -All other 'gnus-header-*' faces inherit from this face now. - -+++ -*** New user option 'gnus-treat-emojize-symbols'. -If non-nil, symbols that have an Emoji representation will be -displayed as emojis. The default is nil. - -+++ -*** New command 'gnus-article-emojize-symbols'. -This is bound to 'W D e' and will display symbols that have Emoji -representation as Emoji. - -+++ -*** New mu backend for gnus-search. -Configuration is very similar to the notmuch and namazu backends. It -supports the unified search syntax. - ---- -*** 'gnus-html-image-cache-ttl' is now a seconds count. -Formerly it was a pair of numbers '(A B)' that represented 65536*A + B, -to cater to older Emacs implementations that lacked bignums. -The older form still works but is undocumented. - -** Rmail - ---- -*** Rmail partial summaries can now be applied one on top of the other. -You can now narrow the set of messages selected by Rmail summary's -criteria (recipients, topic, senders, etc.) by making a summary of the -already summarized messages. For example, invoking -'rmail-summary-by-senders', followed by 'rmail-summary-by-topic' will -produce a summary where both the senders and the topic are according -to your selection. The new user option -'rmail-summary-progressively-narrow' controls whether the stacking of -the filters is in effect; customize it to a non-nil value to enable -this feature. - ---- -*** New Rmail summary: by thread. -The new command 'rmail-summary-by-thread' produces a summary of -messages that belong to a single thread of discussion. - -** EIEIO - -+++ -*** 'slot-value' can now be used to access slots of 'cl-defstruct' objects. - -** Align - ---- -*** Alignment in 'text-mode' has changed. -Previously, 'M-x align' didn't do anything, and you had to say 'C-u -M-x align' for it to work. This has now been changed. The default -regexp for 'C-u M-x align-regexp' has also been changed to be easier -for inexperienced users to use. - -** Help - ---- -*** New mode, 'emacs-news-view-mode', for viewing the NEWS file. -This mode is used by the 'C-h N' command, and adds buttons to manual -entries and symbol references. - ---- -*** New user option 'help-link-key-to-documentation'. -When this option is non-nil (which is the default), key bindings -displayed in the "*Help*" buffer will be linked to the documentation -for the command they are bound to. This does not affect listings of -key bindings and functions (such as 'C-h b'). - -** Info Look - ---- -*** info-look specs can now be expanded at run time instead of a load time. -The new ':doc-spec-function' element can be used to compute the -':doc-spec' element when the user asks for info on that particular -mode (instead of at load time). - -** Ansi Color - ---- -*** Support for ANSI 256-color and 24-bit colors. -256-color and 24-bit color codes are now handled by ANSI color -filters and displayed with the specified color. - -** Term Mode - ---- -*** New user option 'term-bind-function-keys'. -If non-nil, 'term-mode' will pass the function keys on to the -underlying shell instead of using the normal Emacs bindings. - ---- -*** Support for ANSI 256-color and 24-bit colors, italic and other fonts. -'term-mode' can now display 256-color and 24-bit color codes. It can -also handle ANSI codes for faint, italic and blinking text, displaying -it with new 'term-{faint,italic,slow-blink,fast-blink}' faces. - -** Project - -+++ -*** 'project-find-file' and 'project-or-external-find-file' can include all. -The commands 'project-find-file' and 'project-or-external-find-file' -now accept a prefix argument, which is interpreted to mean "include -all files". - -+++ -*** New command 'project-list-buffers' bound to 'C-x p C-b'. -This command displays a list of buffers from the current project. - -+++ -*** 'project-kill-buffers' can display the list of buffers to kill. -Customize the user option 'project-kill-buffers-display-buffer-list' -to enable the display of the buffer list. - -*** New user option 'project-vc-extra-root-markers'. -Use it to add detection of nested projects (inside a VCS repository), -or projects outside of VCS repositories. - -As a consequence, the 'VC project backend' is formally renamed to -'VC-aware project backend'. - -+++ -*** New user option 'project-vc-include-untracked'. -If non-nil, files untracked by a VCS are considered to be part of -the project by a VC project based on that VCS. - -** Xref - -+++ -*** New command 'xref-go-forward'. -It is bound to 'C-M-,' and jumps to the location where 'xref-go-back' -('M-,', also known as 'xref-pop-marker-stack') was invoked previously. - -+++ -*** 'xref-query-replace-in-results' prompting change. -This command no longer prompts for FROM when called without prefix -argument. This makes the most common case faster: replacing entire -matches. - -+++ -*** New command 'xref-find-references-and-replace' to rename one identifier. - ---- -*** New variable 'xref-current-item' (renamed from a private version). - ---- -*** New function 'xref-show-xrefs'. - -** File Notifications - -+++ -*** The new command 'file-notify-rm-all-watches' removes all file notifications. - -** Sql - ---- -*** Sql now supports sending of passwords in-process. -To improve security, if an sql product has ':password-in-comint' set -to t, a password supplied via the minibuffer will be sent in-process, -as opposed to via the command-line. - -** Image Mode - -+++ -*** New command 'image-transform-fit-to-window'. -This command fits the image to the current window by scaling down or -up as necessary. Unlike 'image-transform-fit-both', this does not -only scale the image down, but up as well. It is bound to 's w' in -Image Mode by default. - ---- -*** New command 'image-mode-wallpaper-set'. -This command sets the desktop background to the current image. It is -bound to 'W' by default. - -+++ -*** 'image-transform-fit-to-{height,width}' are now obsolete. -Use the new command 'image-transform-fit-to-window' instead. -The keybinding for 'image-transform-fit-to-width' is now 's i'. - ---- -*** User option 'image-auto-resize' can now be set to 'fit-window'. -This works like 'image-transform-fit-to-window'. - ---- -*** New user option 'image-auto-resize-max-scale-percent'. -The new 'fit-window' option will never scale an image more than this -much (in percent). It is nil by default, which means no limit. - ---- -*** New user option 'image-text-based-formats'. -This controls whether or not to show a message when opening certain -image formats saying how to edit it as text. The default is to show -this message for SVG and XPM. - -+++ -*** New commands: 'image-flip-horizontally' and 'image-flip-vertically'. -These commands horizontally and vertically flip the image under point, -and are bound to 'i h' and 'i v', respectively. - -+++ -*** New command 'image-transform-set-percent'. -It allows setting the image size to a percentage of its original size, -and is bound to 's p' in Image mode. - -+++ -*** 'image-transform-original' renamed to 'image-transform-reset-to-original'. -The old name was confusing, and is now an obsolete function alias. - -+++ -*** 'image-transform-reset' renamed to 'image-transform-reset-to-initial'. -The old name was confusing, and is now an obsolete function alias. - -** Images - -+++ -*** Users can now add special image conversion functions. -This is done via 'image-converter-add-handler'. - -** Image Dired - -+++ -*** 'image-dired-image-mode' is now based on 'image-mode'. -This avoids converting images in the background, and makes Image-Dired -noticeably faster. New keybindings from 'image-mode' are now -available in the "*image-dired-display-image*" buffer; press '?' or -'h' in that buffer to see the full list. - ---- -*** Navigation and marking commands now work in image display buffer. -The following new bindings have been added: -- 'n', 'SPC' => 'image-dired-display-next' -- 'p', 'DEL' => 'image-dired-display-previous' -- 'm' => 'image-dired-mark-thumb-original-file' -- 'd' => 'image-dired-flag-thumb-original-file' -- 'u' => 'image-dired-unmark-thumb-original-file' - ---- -*** New command 'image-dired-unmark-all-marks'. -It removes all marks from all files in the thumbnail and the -associated Dired buffer, and is bound to 'U' in the thumbnail and -display buffer. +*** New user option 'vc-git-shortlog-switches'. +This is a string or a list of strings that specifies the Git log +switches for shortlogs, such as the one produced by 'C-x v L'. +'vc-git-log-switches' is no longer used for shortlogs. ---- -*** New command 'image-dired-do-flagged-delete'. -It deletes all flagged files, and is bound to 'x' in the thumbnail -buffer. It replaces the command 'image-dired-delete-marked', which is -now an obsolete alias. - ---- -*** New command 'image-dired-copy-filename-as-kill'. -It copies the name of the marked or current image to the kill ring, -and is bound to 'w' in the thumbnail buffer. - ---- -*** New command 'image-dired-wallpaper-set'. -This command sets the desktop background to the image at point in the -thumbnail buffer. It is bound to 'W' by default. - ---- -*** 'image-dired-slideshow-start' is now bound to 'S'. -It is bound in both the thumbnail and display buffer, and no longer -prompts for a timeout; use a numerical prefix (e.g. 'C-u 8 S') to set -the timeout. - ---- -*** New user option 'image-dired-marking-shows-next'. -If this option is non-nil (the default), marking, unmarking or -flagging an image in either the thumbnail or display buffer shows the -next image. - ---- -*** New face 'image-dired-thumb-flagged'. -If 'image-dired-thumb-mark' is non-nil (the default), this face is -used for images that are flagged for deletion in the Dired buffer -associated with Image-Dired. - ---- -*** Image information is now shown in the header line of the thumbnail buffer. -This replaces the message that most navigation commands in the -thumbnail buffer used to show at the bottom of the screen. - ---- -*** New specifiers for 'image-dired-display-properties-format'. -This is used to format the new header line. The new specifiers are: -"%d" for the name of the directory that the file is in, "%n" for -file's number in the thumbnail buffer, and "%s" for the file size. - -The default format has been updated to use this. If you prefer the -old format, add this to your Init file: - - (setopt image-dired-display-properties-format "%b: %f (%t): %c") - ---- -*** New faces for the header line of the thumbnail buffer. -These faces correspond to different parts of the header line, as -specified in 'image-dired-display-properties-format': -- 'image-dired-thumb-header-directory-name' -- 'image-dired-thumb-header-file-name' -- 'image-dired-thumb-header-file-size' -- 'image-dired-thumb-header-image-count' - ---- -*** PDF support. -Image-Dired now displays thumbnails for PDF files. Type 'RET' on a -PDF file in the thumbnail buffer to visit the corresponding PDF. - ---- -*** Support GraphicsMagick command line tools. -Support for the GraphicsMagick command line tool ("gm") has been -added, and is used when it is available instead of ImageMagick. - ---- -*** Support Thumbnail Managing Standard v0.9.0 (Dec 2020). -This standard allows sharing generated thumbnails across different -programs. Version 0.9.0 adds two larger thumbnail sizes: 512x512 and -1024x1024 pixels. See the user option 'image-dired-thumbnail-storage' -to use it; it is not enabled by default. - ---- -*** Reduce dependency on external "exiftool" program. -The 'image-dired-copy-with-exif-file-name' command no longer requires -an external "exiftool" program to be available. The user options -'image-dired-cmd-read-exif-data-program' and -'image-dired-cmd-read-exif-data-options' are now obsolete. - ---- -*** Support for bookmark.el. -The command 'bookmark-set' (bound to 'C-x r m') is now supported in -the thumbnail view, and will create a bookmark that opens the current -directory in Image-Dired. - ---- -*** The 'image-dired-slideshow-start' command no longer prompts. -It no longer inconveniently prompts for a number of images and a -delay: it runs indefinitely, but stops automatically on any command. -You can set the delay with a prefix argument, or a negative prefix -argument to prompt for a delay. Customize the user option -'image-dired-slideshow-delay' to change the default from 5 seconds. +** Diff Mode +++ -*** 'image-dired-show-all-from-dir-max-files' increased to 1000. -This user option controls asking for confirmation when starting -Image-Dired in a directory with many files. Since Image-Dired creates -thumbnails in the background in recent versions, this is not as -important as it used to be. You can now also customize this option to -nil to disable this confirmation completely. - ---- -*** 'image-dired-thumb-size' increased to 128. +*** '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. +++ -*** 'image-dired-db-file' renamed to 'image-dired-tags-db-file'. +*** 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". ---- -*** 'image-dired-display-image-mode' renamed to 'image-dired-image-mode'. -The corresponding keymap is now named 'image-dired-image-mode-map'. - -+++ -*** Some commands have been renamed to be shorter. -- 'image-dired-display-thumbnail-original-image' has been renamed to - 'image-dired-display-this'. -- 'image-dired-display-next-thumbnail-original' has been renamed to - 'image-dired-display-next'. -- 'image-dired-display-previous-thumbnail-original' has been renamed - to 'image-dired-display-previous'. -The old names are now obsolete aliases. - ---- -*** 'image-dired-thumb-{height,width}' are now obsolete. -Customize 'image-dired-thumb-size' instead, which will set both the -height and width. +** Buffer Selection --- -*** HTML image gallery generation is now obsolete. -The 'image-dired-gallery-generate' command and these user options are -now obsolete: 'image-dired-gallery-thumb-image-root-url', -'image-dired-gallery-hidden-tags', 'image-dired-gallery-dir', -'image-dired-gallery-image-root-url'. +*** New user option 'bs-default-action-list'. +You can now configure how to display the "*buffer-selection*" buffer +using this new option. (Or set 'display-buffer-alist' directly.) ---- -*** 'image-dired-rotate-thumbnail-{left,right}' are now obsolete. -Instead, use commands 'image-dired-refresh-thumb' to generate a new -thumbnail, or 'image-rotate' to rotate the thumbnail without updating -the thumbnail file. +** Eshell +++ -*** Some commands and user options are now obsolete. -Since 'image-dired-display-image-mode' is now based on 'image-mode', -some commands and user options are no longer needed and are now obsolete: -'image-dired-cmd-create-temp-image-options', -'image-dired-cmd-create-temp-image-program', -'image-dired-display-current-image-full', -'image-dired-display-current-image-sized', -'image-dired-display-window-height-correction', -'image-dired-display-window-width-correction', -'image-dired-temp-image-file'. - -** Bookmarks - ---- -*** 'list-bookmarks' now includes a type column. -Types are registered via a 'bookmark-handler-type' symbol property on -the jumping function. +*** New splice operator for Eshell dollar expansions. +Dollar expansions in Eshell now let you splice the elements of the +expansion in-place using '$@expr'. This makes it easier to fill lists +of arguments into a command, such as when defining aliases. For more +information, see the "(eshell) Dollars Expansion" node in the Eshell +manual. +++ -*** 'bookmark-sort-flag' can now be set to 'last-modified'. -This will display bookmark list from most recently set to least -recently set. - ---- -*** When editing a bookmark annotation, 'C-c C-k' will now cancel. -It is bound to the new command 'bookmark-edit-annotation-cancel'. - ---- -*** New user option 'bookmark-fringe-mark'. -This option controls the bitmap used to indicate bookmarks in the -fringe (or nil to disable showing this marker). - -** Exif +*** Eshell now supports negative numbers and ranges for indices. +Now, you can retrieve the last element of a list with '$my-list[-1]' +or get a sublist of elements 2 through 4 with '$my-list[2..5]'. For +more information, see the "(eshell) Dollars Expansion" node in the +Eshell manual. --- -*** New function 'exif-field'. -This is a convenience function to extract the field data from -'exif-parse-file' and 'exif-parse-buffer'. - -** Xwidget +*** Eshell now uses 'field' properties in its output. +In particular, this means that pressing the '<home>' key moves the +point to the beginning of your input, not the beginning of the whole +line. If you want to go back to the old behavior, add something like +this to your configuration: ---- -*** New user option 'xwidget-webkit-buffer-name-format'. -This option controls how xwidget-webkit buffers are named. + (keymap-set eshell-mode-map "<home>" #'eshell-bol-ignoring-prompt) --- -*** New user option 'xwidget-webkit-cookie-file'. -This option controls whether the xwidget-webkit buffers save cookies -set by web pages, and if so, in which file to save them. +*** 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. +++ -*** New minor mode 'xwidget-webkit-edit-mode'. -When this mode is enabled, self-inserting characters and other common -web browser shortcut keys are redefined to send themselves to the -WebKit widget. +*** 'eshell-read-aliases-list' is now an interactive command. +After manually editing 'eshell-aliases-file', you can use this command +to load the edited aliases. -+++ -*** New minor mode 'xwidget-webkit-isearch-mode'. -This mode acts similarly to incremental search, and allows searching -the contents of a WebKit widget. In xwidget-webkit mode, it is bound -to 'C-s' and 'C-r'. +** Prog Mode +++ -*** New command 'xwidget-webkit-browse-history'. -This command displays a buffer containing the page load history of -the current WebKit widget, and allows you to navigate it. - ---- -*** On X, the WebKit inspector is now available inside xwidgets. -To access the inspector, right click on the widget and select "Inspect -Element". - ---- -*** "Open in New Window" in a WebKit widget's context menu now works. -The newly created buffer will be displayed via 'display-buffer', which -can be customized through the usual mechanism of 'display-buffer-alist' -and friends. +*** New command 'prog-fill-reindent-defun'. +This command either fills a single paragraph in a defun, such as a +docstring, or a comment, or (re)indents the surrounding defun if +point is not in a comment or a string. It is by default bound to +'M-q' in 'prog-mode' and all its descendants. ** Tramp +++ -*** New connection methods "docker", "podman" and "kubernetes". -They allow accessing containers provided by Docker and similar -programs. - ---- -*** Tramp supports abbreviating remote home directories now. -When calling 'abbreviate-file-name' on a Tramp file name, the result -will abbreviate the user's home directory, for example by abbreviating -"/ssh:user@host:/home/user" to "/ssh:user@host:~". +*** New connection method "toolbox". +This allows accessing system containers provided by Toolbox. +++ -*** New user option 'tramp-use-scp-direct-remote-copying'. -When set to non-nil, Tramp does not copy files between two remote -hosts via a local copy in its temporary directory, but lets the 'scp' -command do this job. +*** Rename 'tramp-use-ssh-controlmaster-options' to 'tramp-use-connection-share. +The old name still exists as defvaralias. This user option controls +now connection sharing for both ssh-based and plink-based methods. It +allows the values t, nil, and 'suppress'. The latter suppresses +also "ControlMaster" settings in the user's "~/.ssh/config" file, +or connection share configuration in PuTTY sessions, respectively. -+++ -*** Proper password prompts for methods "doas", "sudo" and "sudoedit". -The password prompts for these methods reflect now the credentials of -the user requesting such a connection, and not of the user who is the -target. This has always been needed, just the password prompt and the -related 'auth-sources' entry were wrong. +** EWW +++ -*** New user option 'tramp-completion-use-cache'. -During user and host name completion in the minibuffer, results from -Tramp's connection cache are taken into account. This can be disabled -by setting the user option 'tramp-completion-use-cache' to nil. +*** 'eww-open-file' can now display the file in a new buffer. +By default, the command reuses the "*eww*" buffer, but if called with +the new argument NEW-BUFFER non-nil, it will use a new buffer instead. +Interactively, invoke 'eww-open-file' with a prefix argument to +activate this behavior. -** Browse URL - ---- -*** New user option 'browse-url-default-scheme'. -This user option decides which URL scheme that 'browse-url' and -related functions will use by default. For example, you could -customize this to "https" to always prefer HTTPS URLs. - ---- -*** New user option 'browse-url-irc-function'. -This option specifies a function for opening "irc://" links. It -defaults to the new function 'browse-url-irc'. - ---- -*** New function 'browse-url-irc'. -This multipurpose autoloaded function can be used for opening "irc://" -and "ircs://" URLS by any caller that passes a URL string as an initial -arg. - ---- -*** Support for the Netscape web browser has been removed. -This support has been obsolete since Emacs 25.1. The final version of -the Netscape web browser was released in February, 2008. - ---- -*** Support for the Galeon web browser has been removed. -This support has been obsolete since Emacs 25.1. The final version of -the Galeon web browser was released in September, 2008. - ---- -*** Support for the Mozilla web browser is now obsolete. -Note that this historical web browser is different from Mozilla -Firefox; it is its predecessor. - -** Python Mode +** go-ts-mode +++ -*** Project shells and a new user option 'python-shell-dedicated'. -When called with a prefix argument, 'run-python' now offers the choice -of creating a shell dedicated to the current project. This shell runs -in the project root directory and is shared among all project buffers. - -Without a prefix argument, the kind of shell (buffer-dedicated, -project-dedicated or global) is specified by the new -'python-shell-dedicated' user option. - -** Ruby Mode - ---- -*** New user option 'ruby-toggle-block-space-before-parameters'. - ---- -*** Support for endless methods. - ---- -*** New user options that determine indentation logic. -'ruby-method-params-indent', 'ruby-block-indent', -'ruby-after-operator-indent', 'ruby-method-call-indent', -'ruby-parenless-call-arguments-indent'. See the docstrings for -explanations and examples. +*** New command 'go-ts-mode-docstring'. +This command adds a docstring comment to the current defun. If a +comment already exists, point is only moved to the comment. It is +bound to 'C-c C-d' in 'go-ts-mode'. -** Eshell - -+++ -*** New feature to easily bypass Eshell's own pipelining. -Prefixing '|', '<' or '>' with an asterisk, i.e. '*|', '*<' or '*>', -will cause the whole command to be passed to the operating system -shell. This is particularly useful to bypass Eshell's own pipelining -support for pipelines which will move a lot of data. See section -"Running Shell Pipelines Natively" in the Eshell manual, node -"(eshell) Pipelines". +** Man-mode +++ -*** New module to help supplying absolute file names to remote commands. -After enabling the new 'eshell-elecslash' module, typing a forward -slash as the first character of a command line argument will -automatically insert the Tramp prefix. The automatic insertion -applies only when 'default-directory' is remote and the command is a -Lisp function. This frees you from having to keep track of whether -commands are Lisp function or external when supplying absolute file -name arguments. See the "(eshell) Electric forward slash" node in the -Eshell manual for details. +*** 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). -+++ -*** Improved support for redirection operators in Eshell. -Eshell now supports a wider variety of redirection operators. For -example, you can now redirect both stdout and stderr via '&>' or -duplicate one output handle to another via 'NEW-FD>&OLD-FD'. For more -information, see the "(eshell) Redirection" node in the Eshell manual. - -+++ -*** New eshell built-in command 'doas'. -The privilege-escalation program 'doas' has been added to the existing -'su' and 'sudo' commands from the 'eshell-tramp' module. The external -command may still be accessed by using '*doas'. - -+++ -*** Double-quoting an Eshell expansion now treats the result as a single string. -If an Eshell expansion like '$FOO' is surrounded by double quotes, the -result will always be a single string, no matter the type that would -otherwise be returned. - -+++ -*** Concatenating Eshell expansions now works more similarly to other shells. -When concatenating an Eshell expansion that returns a list, "adjacent" -elements of each operand are now concatenated together, -e.g. '$(list "a" "b")c' returns '("a" "bc")'. See the "(eshell) -Expansion" node in the Eshell manual for more details. - -+++ -*** Eshell subcommands with multiline numeric output return lists of numbers. -If every line of the output of an Eshell subcommand like '${COMMAND}' -is numeric, the result will be a list of numbers (or a single number -if only one line of output). Previously, this only converted numbers -when there was a single line of output. - ---- -*** Built-in Eshell commands now follow Posix/GNU argument syntax conventions. -Built-in commands in Eshell now accept command-line options with -values passed as a single token, such as '-oVALUE' or -'--option=VALUE'. New commands can take advantage of this with the -'eshell-eval-using-options' macro. See "Defining new built-in -commands" in the "(eshell) Built-ins" node of the Eshell manual. - ---- -*** Eshell globs ending with "/" now match only directories. -Additionally, globs ending with "**/" or "***/" no longer raise an -error, and now expand to all directories recursively (following -symlinks in the latter case). - -+++ -*** Lisp forms in Eshell now treat a nil result as a failed exit status. -When executing a command that looks like '(lisp form)' and returns -nil, Eshell will set the exit status (available in the '$?' -variable) to 2. This allows commands like that to be used in -conditionals. To change this behavior, customize the new -'eshell-lisp-form-nil-is-failure' user option. - -** Shell - ---- -*** New user option 'shell-kill-buffer-on-exit'. -Enabling this will automatically kill a "*shell*" buffer as soon as -the shell session terminates. +** DocView --- -*** New minor mode 'shell-highlight-undef-mode'. -Customize 'shell-highlight-undef-enable' to t if you want to enable -this minor mode in "*shell*" buffers. It will highlight undefined -commands with a warning face as you type. - -** Calc +*** New face 'doc-view-svg-face'. +This replaces 'doc-view-svg-foreground' and 'doc-view-svg-background'. -+++ -*** New user option 'calc-kill-line-numbering'. -Set it to nil to exclude line numbering from kills and copies. - -** Hierarchy +** Shortdoc +++ -*** Tree Display can delay computation of children. -'hierarchy-add-tree' and 'hierarchy-add-trees' have an optional -argument which allows tree-widget display to be activated and computed -only when the user expands the node. - -** Proced - ---- -*** proced.el shows system processes of remote hosts. -When 'default-directory' is remote, and 'proced' is invoked with a -negative argument like 'C-u - proced', the system processes of that -remote host are shown. Alternatively, the user option -'proced-show-remote-processes' can be set to non-nil. -'proced-signal-function' has been marked obsolete. - ---- -*** Proced can now optionally show process details in color. -New user option 'proced-enable-color-flag' enables coloring of Proced -buffers. This option is disabled by default; customize it to a -non-nil value to enable colors. - -** Miscellaneous - ---- -*** New user option 'webjump-use-internal-browser'. -When non-nil, WebJump will use an internal browser to open web pages, -instead of the default external browser. +*** New function 'shortdoc-function-examples'. +This function returns examples of use of a given Emacs Lisp function +from the available shortdoc information. +++ -*** New user option 'font-lock-ignore'. -This option provides a mechanism to selectively disable font-lock -keyword-driven fontifications. - ---- -*** New user option 'auto-save-visited-predicate'. -This user option is a predicate function which is called by -'auto-save-visited-mode' to decide whether or not to save a buffer. -You can use it to automatically save only specific buffers, for -example buffers using a particular mode or in some directory. - ---- -*** New user option 'remote-file-name-inhibit-auto-save-visited'. -If this user option is non-nil, 'auto-save-visited-mode' will not -auto-save remote buffers. The default is nil. - -+++ -*** New package vtable.el for formatting tabular data. -This package allows formatting data using variable-pitch fonts. -The resulting tables can display text in variable pitch fonts, text -using fonts of different sizes, and images. See the "(vtable) Top" -manual for more details. - ---- -*** New minor mode 'elide-head-mode'. -Enabling this minor mode turns on hiding header material, like -'elide-head' does; disabling it shows the header. The commands -'elide-head' and 'elide-head-show' are now obsolete. - -*** New package ansi-osc.el. -Support for OSC ("Operating System Command") escape sequences has been -extracted from comint.el in order to provide interpretation of OSC -sequences in compilation buffers. - -Adding the new function 'ansi-osc-compilation-filter' to -'compilation-filter-hook' enables interpretation of OSC escape -sequences in compilation buffers. By default, all sequences are -filtered out. - -The list of handlers (already covering OSC 7 and 8) has been extended -with a handler for OSC 2, the command to set a window title. - ---- -*** 'recentf-mode' now uses abbreviated file names by default. -This means that e.g. "/home/foo/bar" is now displayed as "~/bar". -Customize the user option 'recentf-filename-handlers' to nil to get -back the old behavior. - ---- -*** New command 'recentf-open'. -This command prompts for a recently opened file in the minibuffer, and -visits it. - ---- -*** 'ffap-machine-at-point' no longer pings hosts by default. -It will now simply look at a hostname to determine if it is valid, -instead of also trying to ping it. Customize the user option -'ffap-machine-p-known' to 'ping' to get the old behavior back. - ---- -*** The 'run-dig' command is now obsolete; use 'dig' instead. - ---- -*** Some 'bib-mode' commands and variables have been renamed. -To respect Emacs naming conventions, the variable 'unread-bib-file' -has been renamed to 'bib-unread-file'. The following commands have -also been renamed: - 'addbib' to 'bib-add' - 'return-key-bib' to 'bib-return-key' - 'mark-bib' to 'bib-mark' - 'unread-bib' to 'bib-unread' - ---- -*** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'. -The old name is still available as an obsolete function alias. - ---- -*** The url-irc library now understands "ircs://" links. - ---- -*** New command 'world-clock-copy-time-as-kill' for 'world-clock-mode'. -It copies the current line into the kill ring. +*** New function 'shortdoc-help-fns-examples-function'. +This function inserts into the current buffer examples of use of a +given Emacs Lisp function, which it gleans from the shortdoc +information. If you want 'describe-function' ('C-h f') to insert +examples of using the function into regular "*Help*" buffers, add the +following to your init file: ---- -*** 'edit-abbrevs' now uses font-locking. -The new face 'abbrev-table-name' is used to display the abbrev table -name. - ---- -*** New key binding 'O' in "*Buffer List*". -This key is now bound to 'Buffer-menu-view-other-window', which will -view this line's buffer in View mode in another window. - -** Scheme Mode - ---- -*** Auto-detection of Scheme library files. -Emacs now automatically enables the Scheme mode when opening R6RS -Scheme Library Source (".sls") files and R7RS Scheme Library -Definition (".sld") files. - ---- -*** Imenu members for R6RS and R7RS library members. -Imenu now lists the members directly nested in R6RS Scheme libraries -('library') and R7RS libraries ('define-library'). + (add-hook 'help-fns-describe-function-functions + #'shortdoc-help-fns-examples-function) -* New Modes and Packages in Emacs 29.1 - -+++ -** Eglot: Emacs Client for the Language Server Protocol. -Emacs now comes with the Eglot package, which enhances various Emacs -features, such as completion, documentation, error detection, etc., -based on data provided by language servers using the Language Server -Protocol (LSP). See the new Info manual "(eglot) Top" for more. - -+++ -** use-package: Declarative package configuration. -use-package is now shipped with Emacs. It provides the 'use-package' -macro, which allows you to isolate package configuration in your init -file in a way that is declarative, tidy, and performance-oriented. -See the new Info manual "(use-package) Top" for more. +* New Modes and Packages in Emacs 30.1 -+++ -** New commands 'image-crop' and 'image-cut'. -These commands allow interactively cropping/cutting the image at -point. The commands are bound to keys 'i c' and 'i x' (respectively) -in the local keymap over images. They rely on external programs, by -default "convert" from ImageMagick, to do the actual cropping/eliding -of the image file. - ---- -** New package 'wallpaper'. -This package provides the command 'wallpaper-set', which sets the -desktop background image. Depending on the system and the desktop, -this may require an external program (such as "swaybg", "gm", -"display" or "xloadimage"). If so, a suitable command should be -detected automatically in most cases. It can also be customized -manually if needed, using the new user options 'wallpaper-command' and -'wallpaper-command-args'. +** New major modes based on the tree-sitter library +++ -** New package 'oclosure'. -This allows the creation of "functions with slots" or "function -objects" via the macros 'oclosure-define' and 'oclosure-lambda'. - -+++ -*** New generic function 'oclosure-interactive-form'. -Used by 'interactive-form' when called on an OClosure. -This allows specific OClosure types to compute their interactive specs -on demand rather than precompute them when created. +*** New major mode 'html-ts-mode'. +An optional major mode based on the tree-sitter library for editing +HTML files. --- -** New theme 'leuven-dark'. -This is a dark version of the 'leuven' theme. - -+++ -** New mode 'erts-mode'. -This mode is used to edit files geared towards testing actions in -Emacs buffers, like indentation and the like. The new ert function -'ert-test-erts-file' is used to parse these files. +*** New major mode 'heex-ts-mode'. +A major mode based on the tree-sitter library for editing HEEx files. --- -** New major mode 'js-json-mode'. -This is a lightweight variant of 'js-mode' that is used by default -when visiting JSON files. - -+++ -** New major mode 'csharp-mode'. -A major mode based on CC Mode for editing programs in the C# language. -This mode is auto-enabled for files with the ".cs" extension. - -+++ -** New major modes based on the tree-sitter library. -These new major modes are available if Emacs was built with the -tree-sitter library. They provide support for font-locking, -indentation, and navigation by defuns based on parsing the buffer text -by a tree-sitter parser. Some major modes also offer support for -Imenu and 'which-func'. - -The new modes based on tree-sitter are for now entirely optional, and -you must turn them on manually, or load them in your init file, or -customize 'auto-mode-alist' to turn them on automatically for certain -files. You can also customize 'major-mode-remap-alist' to -automatically turn on some tree-sitter based modes for the same files -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 -improving them. - -Each major mode based on tree-sitter needs a language grammar library, -usually named "libtree-sitter-LANG.so" ("libtree-sitter-LANG.dll" on -MS-Windows), where LANG is the corresponding language name. Emacs -looks for these libraries in the following places: - - . in the directories mentioned in the list 'treesit-extra-load-path' - . in the "tree-sitter" subdirectory of your 'user-emacs-directory' - (by default, "~/.emacs.d/tree-sitter") - . in the standard system directories where other shared libraries are - usually installed - -We recommend to install these libraries in one of the standard system -locations (the last place in the above list). - -If a language grammar library required by a mode is not found in any -of the above places, the mode will display a warning when you try to -turn it on. - -+++ -*** New major mode 'typescript-ts-mode'. -A major mode based on the tree-sitter library for editing programs -in the TypeScript language. - -+++ -*** New major mode 'tsx-ts-mode'. -A major mode based on the tree-sitter library for editing programs -in the TypeScript language, with support for TSX. - -+++ -*** New major mode 'c-ts-mode'. -An optional major mode based on the tree-sitter library for editing -programs in the C language. - -+++ -*** New major mode 'c++-ts-mode'. -An optional major mode based on the tree-sitter library for editing -programs in the C++ language. - -+++ -*** New command 'c-or-c++-ts-mode'. -A command that automatically guesses the language of a header file, -and enables either 'c-ts-mode' or 'c++-ts-mode' accordingly. - -+++ -*** New major mode 'java-ts-mode'. -An optional major mode based on the tree-sitter library for editing -programs in the Java language. - -+++ -*** New major mode 'python-ts-mode'. -An optional major mode based on the tree-sitter library for editing -programs in the Python language. - -+++ -*** New major mode 'css-ts-mode'. -An optional major mode based on the tree-sitter library for editing -CSS (Cascading Style Sheets). - -+++ -*** New major mode 'json-ts-mode'. -An optional major mode based on the tree-sitter library for editing -programs in the JSON language. - -+++ -*** New major mode 'csharp-ts-mode'. -An optional major mode based on the tree-sitter library for editing -programs in the C# language. - -+++ -*** New major mode 'bash-ts-mode'. -Am optional major mode based on the tree-sitter library for editing -Bash shell scripts. - -+++ -*** New major mode 'dockerfile-ts-mode'. -A major mode based on the tree-sitter library for editing -Dockerfiles. - -+++ -*** New major mode 'cmake-ts-mode'. -A major mode based on the tree-sitter library for editing CMake files. - -+++ -*** New major mode 'toml-ts-mode'. -An optional major mode based on the tree-sitter library for editing -files written in TOML, a format for writing configuration files. - -+++ -*** New major mode 'go-ts-mode'. -A major mode based on the tree-sitter library for editing programs in -the Go language. - -+++ -*** New major mode 'go-mod-ts-mode'. -A major mode based on the tree-sitter library for editing "go.mod" +*** New major mode 'elixir-ts-mode'. +A major mode based on the tree-sitter library for editing Elixir files. -+++ -*** New major mode 'yaml-ts-mode'. -A major mode based on the tree-sitter library for editing files -written in YAML. - -+++ -*** New major mode 'rust-ts-mode'. -A major mode based on the tree-sitter library for editing programs in -the Rust language. - --- -*** New major mode 'ruby-ts-mode'. -An optional major mode based on the tree-sitter library for editing -programs in the Ruby language. +** The highly accessible Modus themes collection has six items. +The 'modus-operandi' and 'modus-vivendi' are the main themes that have +been part of Emacs since version 28. The former is light, the latter +dark. In addition to these, we now have 'modus-operandi-tinted' and +'modus-vivendi-tinted' for easier legibility, as well as +'modus-operandi-deuteranopia' and 'modus-vivendi-deuteranopia' to +cover the needs of users with red-green color deficiency. The Info +manual "(modus-themes) Top" describes the details and showcases all +their customization options. -* Incompatible Lisp Changes in Emacs 29.1 - -+++ -** The implementation of overlays has changed. -Emacs now uses an implementation of overlays that is much more -efficient than the original one, and should speed up all the -operations that involve overlays, especially when there are lots of -them in a buffer. - -As result of this, some minor incompatibilities in behavior could be -observed, as described below. Except those minor incompatibilities, -no other changes in behavior of overlays should be visible on the Lisp -or user level, with the exception of better performance and the order -of overlays returned by functions that don't promise any particular -order. - ---- -*** The function 'overlay-recenter' is now a no-op. -This function does nothing, and in particular has no effect on the -value returned by 'overlay-lists'. The purpose of 'overlay-recenter' -was to allow more efficient lookup of overlays around a certain buffer -position; however with the new implementation the lookup of overlays -is efficient regardless of their position, and there's no longer any -need to "optimize" the lookup, nor any notion of a "center" of the -overlays. - ---- -*** The function 'overlay-lists' returns one unified list of overlays. -This function used to return a cons of two lists, one with overlays -before the "center" position, the other after that "center". It now -returns a list whose 'car' is the list of all the buffer overlays, and -whose 'cdr' is always nil. - -+++ -** 'format-prompt' now uses 'substitute-command-keys'. -This means that both the prompt and 'minibuffer-default-prompt-format' -will have key definitions and single quotes handled specially. - -+++ -** New function 'substitute-quotes'. -This function works like 'substitute-command-keys' but only -substitutes quote characters. - ---- -** 'find-image' now uses 'create-image'. -This means that images found through 'find-image' also have -auto-scaling applied. (This only makes a difference on HiDPI -displays.) - -+++ -** Changes in how "raw" in-memory XBM images are specified. -Some years back Emacs gained the ability to scale images, and you -could then specify ':width' and ':height' when using 'create-image' on all -image types -- except XBM images, because this format already used the -':width' and ':height' arguments to specify the width/height of the "raw" -in-memory format. This meant that if you used these specifications -on, for instance, XBM files, Emacs would refuse to display them. This -has been changed, and ':width'/':height' now works as with all other image -formats, and the way to specify the width/height of the "raw" -in-memory format is now by using ':data-width' and ':data-height'. - -+++ -** "loaddefs.el" generation has been reimplemented. -The various "loaddefs.el" files in the Emacs tree (which contain -information about autoloads, built-in packages and package prefixes) -used to be generated by functions in autoloads.el. These are now -generated by loaddefs-gen.el instead. This leads to functionally -equivalent "loaddefs.el" files, but they do not use exactly the same -syntax, so using 'M-x update-file-autoloads' no longer works. (This -didn't work well in most files in the past, either, but it will now -signal an error in any file.) - -In addition, files are scanned in a slightly different way. -Previously, ';;;###' specs inside a top-level form (i.e., something -like '(when ... ;;;### ...)' would be ignored. They are now parsed as -usual. - ---- -** Themes have special autoload cookies. -All built-in themes are scraped for ';;;###theme-autoload' cookies -that are loaded along with the regular auto-loaded code. - -+++ -** 'buffer-modified-p' has been extended. -This function was previously documented to return only nil or t. This -has been changed to nil/'autosaved'/non-nil. The new 'autosaved' -value means that the buffer is modified, but that it hasn't been -modified since the time of last auto-save. - ---- -** 'with-silent-modifications' also restores buffer autosave status. -'with-silent-modifications' is a macro meant to be used by the font -locking machinery to allow applying text properties without changing -the modification status of the buffer. However, it didn't restore the -buffer autosave status, so applying font locking to a modified buffer -that had already been auto-saved would trigger another auto-saving. -This is no longer the case. - ---- -** 'prin1' doesn't always escape "." and "?" in symbols any more. -Previously, symbols like 'foo.bar' would be printed by 'prin1' as -"foo\.bar". This now prints as "foo.bar" instead. The Emacs Lisp -reader interprets these strings as referring to the same symbol, so -this is virtually always backwards-compatible, but there may -theoretically be code out there that expects a specific printed -representation. - -The same is the case with the "?" character: The 'foo?' symbol is now -printed as "foo?" instead of "foo\?". - -If the "." and "?" characters are the first character in the symbol, -they will still be escaped, so the '.foo' symbol is still printed as -"\.foo" and the '?bar' symbol is still printed as "\?bar". - -+++ -** Remapping 'mode-line' face no longer works as expected. -'mode-line' is now the parent face of the new 'mode-line-active' face, -and remapping parent of basic faces does not work reliably. -Instead of remapping 'mode-line', you have to remap 'mode-line-active'. - -+++ -** 'make-process' has been extended to support ptys when ':stderr' is set. -Previously, setting ':stderr' to a non-nil value would force the -process's connection to use pipes. Now, Emacs will use a pty for -stdin and stdout if requested no matter the value of ':stderr'. - ---- -** User option 'mail-source-ignore-errors' is now obsolete. -The whole mechanism for prompting users to continue in case of -mail-source errors has been removed, so this option is no longer -needed. - -** Fonts - ---- -*** Emacs now supports 'medium' fonts. -Emacs previously didn't distinguish between the 'regular'/'normal' -weight and the 'medium' weight, but it now also supports the (heavier) -'medium' weight. However, this means that if you specify a weight of -'normal' and the font doesn't have this weight, Emacs won't find the -font spec. In these cases, replacing ":weight 'normal" with ":weight -'medium" should fix the issue. - ---- -** Keymap descriptions have changed. -'help--describe-command', 'C-h b' and associated functions that output -keymap descriptions have changed. In particular, prefix commands are -not output at all, and instead of "??" for closures/functions, -"[closure]"/"[lambda]" is output. - ---- -** 'downcase' details have changed slightly. -In certain locales, changing the case of an ASCII-range character may -turn it into a multibyte character, most notably with "I" in Turkish -(the lowercase is "ı", 0x0131). Previously, 'downcase' on a unibyte -string was buggy, and would mistakenly just return the lower byte of -this, 0x31 (the digit "1"). 'downcase' on a unibyte string has now -been changed to downcase such characters as if they were ASCII. To -get proper locale-dependent downcasing, the string has to be converted -to multibyte first. (This goes for the other case-changing functions, -too.) - ---- -** Functions in 'tramp-foreign-file-name-handler-alist' have changed. -Functions to determine which Tramp file name handler to use are now -passed a file name in dissected form (via 'tramp-dissect-file-name') -instead of in string form. - ---- -** 'def' indentation changes. -In 'emacs-lisp-mode', forms with a symbol with a name that start with -"def" have been automatically indented as if they were 'defun'-like -forms, for instance: - - (defzot 1 - 2 3) - -This heuristic has now been removed, and all functions/macros that -want to be indented this way have to be marked with - - (declare (indent defun)) - -or the like. If the function/macro definition itself can't be -changed, the indentation can also be adjusted by saying something -like: - - (put 'defzot 'lisp-indent-function 'defun) - ---- -** The 'inhibit-changing-match-data' variable is now obsolete. -Instead, functions like 'string-match' and 'looking-at' now take an -optional INHIBIT-MODIFY argument. - ---- -** 'gnus-define-keys' is now obsolete. -Use 'define-keymap' instead. - ---- -** MozRepl has been removed from js.el. -MozRepl was removed from Firefox in 2017, so this code doesn't work -with recent versions of Firefox. - ---- -** The function 'image-dired-get-exif-data' is now obsolete. -Use 'exif-parse-file' and 'exif-field' instead. - ---- -** 'insert-directory' alternatives should not change the free disk space line. -This change is now applied in 'dired-insert-directory'. - ---- -** 'compilation-last-buffer' is (finally) declared obsolete. -It has been obsolete since Emacs 22.1, actually. - ---- -** Calling 'lsh' now elicits a byte-compiler warning. -'lsh' behaves in somewhat surprising and platform-dependent ways for -negative arguments, and is generally slower than 'ash', which should be -used instead. This warning can be suppressed by surrounding calls to -'lsh' with the construct '(with-suppressed-warnings ((suspicious lsh)) ...)', -but switching to 'ash' is generally much preferable. - ---- -** Some functions and variables obsolete since Emacs 24 have been removed: -'Buffer-menu-buffer+size-width', 'Electric-buffer-menu-mode', -'Info-edit-map', 'allout-abbreviate-flattened-numbering', -'allout-exposure-change-hook', 'allout-mode-deactivate-hook', -'allout-structure-added-hook', 'allout-structure-deleted-hook', -'allout-structure-shifted-hook', 'ansi-color-unfontify-region', -'archive-extract-hooks', 'auth-source-forget-user-or-password', -'auth-source-hide-passwords', 'auth-source-user-or-password', -'automatic-hscrolling', 'automount-dir-prefix', 'bibtex-complete', -'bibtex-entry-field-alist', 'buffer-has-markers-at', -'buffer-substring-filters', 'byte-compile-disable-print-circle', -'c-prepare-bug-report-hooks', 'cfengine-mode-abbrevs', -'change-log-acknowledgement', 'chart-map', -'checkdoc-comment-style-hooks', 'comint--unquote&expand-filename', -'comint-dynamic-complete', 'comint-dynamic-complete-as-filename', -'comint-dynamic-simple-complete', 'comint-unquote-filename', -'command-history-map', 'compilation-parse-errors-function', -'completion-annotate-function', 'condition-case-no-debug', -'count-lines-region', 'crisp-mode-modeline-string', -'custom-print-functions', 'cvs-string-prefix-p', 'data-debug-map', -'deferred-action-function', 'deferred-action-list', -'dired-pop-to-buffer', 'dired-shrink-to-fit', -'dired-sort-set-modeline', 'dired-x-submit-report', -'display-buffer-function', -'ediff-choose-window-setup-function-automatically', -'eieio-defgeneric', 'eieio-defmethod', 'emacs-lock-from-exiting', -'erc-complete-word', 'erc-dcc-chat-filter-hook', -'eshell-add-to-window-buffer-names', 'eshell-cmpl-suffix-list', -'eshell-for', 'eshell-remove-from-window-buffer-names', -'eshell-status-in-modeline', 'filesets-cache-fill-content-hooks', -'font-list-limit', 'font-lock-maximum-size', -'font-lock-reference-face', 'gnus-carpal', -'gnus-debug-exclude-variables', 'gnus-debug-files', -'gnus-local-domain', 'gnus-outgoing-message-group', -'gnus-registry-user-format-function-M', 'gnus-secondary-servers', -'gnus-subscribe-newsgroup-hooks', 'gud-inhibit-global-bindings', -'hangul-input-method-inactivate', 'hfy-post-html-hooks', -'image-extension-data', 'image-library-alist', -'inactivate-current-input-method-function', 'inactivate-input-method', -'inhibit-first-line-modes-regexps', -'inhibit-first-line-modes-suffixes', 'input-method-inactivate-hook', -'intdos', 'javascript-generic-mode', 'javascript-generic-mode-hook', -'latex-string-prefix-p', 'macro-declaration-function' (function), -'macro-declaration-function' (variable), 'mail-complete', -'mail-complete-function', 'mail-mailer-swallows-blank-line', -'mail-sent-via', 'make-register', 'makefile-complete', -'menu-bar-kill-ring-save', 'meta-complete-symbol', 'meta-mode-map', -'mh-kill-folder-suppress-prompt-hooks', -'minibuffer-completing-symbol', -'minibuffer-local-filename-must-match-map', 'mode25', 'mode4350', -'mpc-string-prefix-p', 'msb-after-load-hooks', -'nndiary-request-accept-article-hooks', -'nndiary-request-create-group-hooks', -'nndiary-request-update-info-hooks', 'nnimap-split-rule', -'nntp-authinfo-file', 'ns-alternatives-map', -'ns-store-cut-buffer-internal', 'package-menu-view-commentary', -'pascal-last-completions', 'pascal-show-completions', -'pascal-toggle-completions', 'pcomplete-arg-quote-list', -'pcomplete-quote-argument', 'prolog-char-quote-workaround', -'python-buffer', 'python-guess-indent', 'python-indent', -'python-info-ppss-comment-or-string-p', 'python-info-ppss-context', -'python-info-ppss-context-type', 'python-preoutput-result', -'python-proc', 'python-send-receive', 'python-send-string', -'python-use-skeletons', 'quail-inactivate', 'quail-inactivate-hook', -'query-replace-interactive', 'rcirc-activity-hooks', -'rcirc-print-hooks', 'rcirc-receive-message-hooks', -'rcirc-sentinel-hooks', 'read-filename-at-point', 'redraw-modeline', -'reftex-index-map', 'reftex-index-phrases-map', -'reftex-select-bib-map', 'reftex-select-label-map', 'reftex-toc-map', -'register-name-alist', 'register-value', 'report-emacs-bug-info', -'report-emacs-bug-pretest-address', -'rmail-default-dont-reply-to-names', 'rmail-dont-reply-to', -'rmail-dont-reply-to-names', 'robin-inactivate', -'robin-inactivate-hook', 'rst-block-face', 'rst-comment-face', -'rst-definition-face', 'rst-directive-face', 'rst-emphasis1-face', -'rst-emphasis2-face', 'rst-external-face', 'rst-literal-face', -'rst-reference-face', 'semantic-change-hooks', -'semantic-edits-delete-change-hooks', -'semantic-edits-new-change-hooks', -'semantic-edits-reparse-change-hooks', 'semantic-grammar-map', -'semantic-grammar-syntax-table', 'semantic-lex-reset-hooks', -'semanticdb-elisp-sym-function-arglist', -'semanticdb-save-database-hooks', 'set-face-underline-p', -'set-register-value', 'sh-maybe-here-document', 'speedbar-key-map', -'speedbar-syntax-table', 'starttls-any-program-available', -'strokes-modeline-string', 'strokes-report-bug', -'term-default-bg-color', 'term-default-fg-color', -'tex-string-prefix-p', 'timeclock-modeline-display', -'timeclock-modeline-display', 'timeclock-update-modeline', -'toggle-emacs-lock', 'tooltip-use-echo-area', 'turn-on-cwarn-mode', -'turn-on-iimage-mode', 'ucs-input-inactivate', 'ucs-insert', -'url-recreate-url-attributes', 'user-variable-p', -'vc-string-prefix-p', 'vc-toggle-read-only', 'view-return-to-alist', -'view-return-to-alist-update', 'w32-default-color-map' (function), -'which-func-mode' (function), 'window-system-version', -'winner-mode-leave-hook', 'x-cut-buffer-or-selection-value'. - ---- -** Some functions and variables obsolete since Emacs 23 have been removed: -'find-emacs-lisp-shadows', 'newsticker-cache-filename', -'process-filter-multibyte-p', 'redisplay-end-trigger-functions', -'set-process-filter-multibyte', 'set-window-redisplay-end-trigger', -'unify-8859-on-decoding-mode', 'unify-8859-on-encoding-mode', -'vc-arch-command', 'window-redisplay-end-trigger', 'x-selection'. - ---- -** Some functions and variables obsolete since Emacs 21 or 22 have been removed: -'c-toggle-auto-state', 'find-file-not-found-hooks', -'ls-lisp-dired-ignore-case', 'query-replace-regexp-eval'. - -+++ -** New generic function 'function-documentation'. -It can dynamically generate a raw docstring depending on the type of a -function. Used mainly for docstrings of OClosures. - -+++ -** Base64 encoding no longer tolerates latin-1 input. -The functions 'base64-encode-string', 'base64url-encode-string', -'base64-encode-region' and 'base64url-encode-region' no longer accept -characters in the range U+0080..U+00FF as substitutes for single bytes -in the range 128..255, but signal an error for all multibyte characters. -The input must be unibyte encoded text. +* Incompatible Lisp Changes in Emacs 30.1 -+++ -** The 'clone-indirect-buffer-hook' is now run by 'make-indirect-buffer'. -It was previously only run by 'clone-indirect-buffer' and -'clone-indirect-buffer-other-window'. Since 'make-indirect-buffer' is -called by both of these, the hook is now run by all 3 of these -functions. - ---- -** '?\' at the end of a line now signals an error. -Previously, it produced a nonsense value, -1, that was never intended. +** User option 'tramp-completion-reread-directory-timeout' has been removed. +This user option has been obsoleted in Emacs 27, use +'remote-file-name-inhibit-cache' instead. --- -** Some libraries obsolete since Emacs 24.1 and 24.3 have been removed: -abbrevlist.el, assoc.el, complete.el, cust-print.el, -erc-hecomplete.el, mailpost.el, mouse-sel.el, old-emacs-lock.el, -patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el. - -+++ -** Many seldom-used generalized variables have been made obsolete. -Emacs has a number of rather obscure generalized variables defined, -that, for instance, allowed you to say things like: - - (setf (point-min) 4) - -These never caught on and have been made obsolete. The form above, -for instance, is the same as saying - - (narrow-to-region 4 (point-max)) - -The following generalized variables have been made obsolete: -'buffer-file-name', 'buffer-local-value', 'buffer-modified-p', -'buffer-name', 'buffer-string', 'buffer-substring', 'current-buffer', -'current-column', 'current-global-map', 'current-input-mode', -'current-local-map', 'current-window-configuration', -'default-file-modes', 'documentation-property', 'eq', 'frame-height', -'frame-width', 'frame-visible-p', 'global-key-binding', -'local-key-binding', 'mark', 'mark-marker', 'marker-position', -'mouse-position', 'point', 'point-marker', 'point-max', 'point-min', -'read-mouse-position', 'screen-height', 'screen-width', -'selected-frame', 'selected-screen', 'selected-window', -'standard-case-table', 'syntax-table', 'visited-file-modtime', -'window-height', 'window-width', and 'x-get-secondary-selection'. +** 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 29.1 - -+++ -** Interpreted closures are "safe for space". -As was already the case for byte-compiled closures, instead of capturing -the whole current lexical environment, interpreted closures now only -capture the part of the environment that they need. -The previous behavior could occasionally lead to memory leaks or -to problems where a printed closure would not be 'read'able because -of an un'read'able value in an unrelated lexical variable. - -+++ -** New accessor function 'file-attribute-file-identifier'. -It returns the list of the inode number and device identifier -retrieved by 'file-attributes'. This value can be used to identify a -file uniquely. The device identifier can be a single number or (for -remote files) a cons of 2 numbers. - -+++ -** New macro 'while-let'. -This is like 'when-let', but repeats until a binding form is nil. +* Lisp Changes in Emacs 30.1 -+++ -** New function 'make-obsolete-generalized-variable'. -This can be used to mark setters used by 'setf' as obsolete, and the -byte-compiler will then warn about using them. - -+++ -** New functions 'pos-eol' and 'pos-bol'. -These are like 'line-end-position' and 'line-beginning-position' -(respectively), but ignore fields (and are more efficient). - -+++ -** New function 'compiled-function-p'. -This returns non-nil if its argument is either a built-in, or a -byte-compiled, or a natively-compiled function object, or a function -loaded from a dynamic module. - ---- -** 'deactivate-mark' can have new value 'dont-save'. -This value means that Emacs should deactivate the mark as usual, but -without setting the primary selection, if 'select-active-regions' is -enabled. - -+++ -** New 'declare' form 'interactive-args'. -This can be used to specify what forms to put into 'command-history' -when executing commands interactively. +** Functions and variables to transpose sexps +++ -** The FORM argument of 'time-convert' is mandatory. -'time-convert' can still be called without it, as before, but the -compiler now emits a warning about this deprecated usage. +*** New helper variable 'transpose-sexps-function'. +Emacs now can set this variable to customize the behavior of the +'transpose-sexps' function. +++ -** Emacs now supports user-customizable and themable icons. -These can be used for buttons in buffers and the like. See the -"(elisp) Icons" and "(emacs) Icons" nodes in the manuals for details. - -+++ -** New arguments MESSAGE and TIMEOUT of 'set-transient-map'. -MESSAGE specifies a message to display after activating the transient -map, including a special formatting spec to list available keys. -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'. - -** Connection Local Variables +*** New function 'transpose-sexps-default-function'. +The previous implementation is moved into its own function, to be +bound by 'transpose-sexps-function'. -+++ -*** Some connection-local variables are now user options. -The variables 'connection-local-profile-alist' and -'connection-local-criteria-alist' are now user options, in order to -make it more convenient to inspect and modify them. +*** 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'. -+++ -*** New function 'connection-local-update-profile-variables'. -This function allows to modify the settings of an existing -connection-local profile. +** Functions and variables to move by program statements -+++ -*** New macro 'with-connection-local-application-variables'. -This macro works like 'with-connection-local-variables', but it allows -to use another application but 'tramp'. This is useful when running -code in a buffer where Tramp has already set some connection-local -variables. +*** New variable 'forward-sentence-function'. +Major modes can now set this variable to customize the behavior of the +'forward-sentence' command. -+++ -*** New macro 'setq-connection-local'. -This allows dynamically setting variable values for a particular -connection within the body of 'with-connection-local-{application-}variables'. -See the "(elisp) Connection Local Variables" node in the Lisp -Reference manual for more information. +*** 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'. -+++ -** 'plist-get', 'plist-put' and 'plist-member' are no longer limited to 'eq'. -These function now take an optional comparison PREDICATE argument. +*** 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. -+++ -** 'read-multiple-choice' can now use long-form answers. +*** 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'. -+++ -** 'M-s c' in 'read-regexp' now toggles case folding. +** Functions and variables to move by program sexps -+++ -** 'completing-read' now allows a function as its REQUIRE-MATCH argument. -This function is called to see whether what the user has typed is a -match. This is also available from functions that call -'completing-read', like 'read-file-name'. +*** 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. -+++ -** 'posn-col-row' can now give position data based on windows. -Previously, it reported data only based on the frame. +*** 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. -+++ -** 'file-expand-wildcards' can now also take a regexp as PATTERN argument. +** New or changed byte-compilation warnings --- -** vc-mtn (the VC backend for Monotone) has been made obsolete. +*** Warn about empty bodies for more special forms and macros. +The compiler now warns about an empty body argument to 'when', +'unless', 'ignore-error' and 'with-suppressed-warnings' in addition to +the existing warnings for 'let' and 'let*'. Example: -+++ -** 'gui-set-selection' can specify different values for different data types. -If DATA is a string, then its text properties are searched for values -for each specific data type while the selection is being converted. + (when (> x 2)) ---- -** New eldoc function 'elisp-eldoc-var-docstring-with-value'. -This function includes the current value of the variable in eldoc display -and can be used as a more detailed alternative to 'elisp-eldoc-var-docstring'. - -+++ -** 'save-some-buffers' can now be extended to save other things. -Traditionally, 'save-some-buffers' saved buffers, and also saved -abbrevs. This has been generalized via the -'save-some-buffers-functions' variable, and packages can now register -things to be saved. - -+++ -** New function 'string-equal-ignore-case'. -This compares strings ignoring case differences. - -+++ -** 'symbol-file' can now report natively-compiled ".eln" files. -If Emacs was built with native-compilation enabled, Lisp programs can -now call 'symbol-file' with the new optional 3rd argument non-nil to -request the name of the ".eln" file which defined a given symbol. - -+++ -** New macro 'with-memoization' provides a very primitive form of memoization. - -+++ -** 'max-char' can now report the maximum codepoint according to Unicode. -When called with a new optional argument UNICODE non-nil, 'max-char' -will now report the maximum valid codepoint defined by the Unicode -Standard. - -** Seq - -+++ -*** New function 'seq-split'. -This returns a list of sub-sequences of the specified sequence. - -+++ -*** New function 'seq-remove-at-position'. -This function returns a copy of the specified sequence where the -element at a given (zero-based) index got removed. - -+++ -*** New function 'seq-positions'. -This returns a list of the (zero-based) indices of elements matching a -given predicate in the specified sequence. - -+++ -*** New function 'seq-keep'. -This is like 'seq-map', but removes all nil results from the returned -list. - -** Themes - ---- -*** New hooks 'enable-theme-functions' and 'disable-theme-functions'. -These are run after enabling and disabling a theme, respectively. +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'empty-body'. --- -*** Themes can now be made obsolete. -Using 'make-obsolete' on a theme is now supported. This will make -'load-theme' issue a warning when loading the theme. +*** Warn about quoted error names in 'condition-case' and 'ignore-error'. +The compiler now warns about quoted condition (error) names +in 'condition-case' and 'ignore-error'. Example: -+++ -** New hook 'display-monitors-changed-functions'. -It is called whenever the configuration of different monitors on a -display changes. + (condition-case nil + (/ x y) + ('arith-error "division by zero")) -+++ -** 'prin1' and 'prin1-to-string' now take an optional OVERRIDES argument. -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. - -+++ -** New global minor mode 'lost-selection-mode'. -This global minor mode makes Emacs deactivate the mark in all buffers -when the primary selection is obtained by another program. +Quoting them adds the error name 'quote' to those handled or ignored +respectively, which was probably not intended. --- -** On X, Emacs will try to preserve selection ownership when a frame is deleted. -This means that if you make Emacs the owner of a selection, such as by -selecting some text into the clipboard or primary selection, and then -delete the current frame, you will still be able to insert the -contents of that selection into other programs as long as another -frame is open on the same display. This behavior can be disabled by -setting the user option 'x-auto-preserve-selections' to nil. - -+++ -** New predicate 'char-uppercase-p'. -This returns non-nil if its argument its an uppercase character. +*** Warn about comparison with literal constants without defined identity. +The compiler now warns about comparisons by identity with a literal +string, cons, vector, record, function, large integer or float as this +may not match any value at all. Example: -** Byte Compilation + (eq x "hello") ---- -*** Byte compilation will now warn about some quoting mistakes in docstrings. -When writing code snippets that contains the "'" character (APOSTROPHE), -that quote character has to be escaped to avoid Emacs displaying it as -"’" (LEFT SINGLE QUOTATION MARK), which would make code examples like +Only literals for symbols and small integers (fixnums), including +characters, are guaranteed to have a consistent (unique) identity. +This warning applies to 'eq', 'eql', 'memq', 'memql', 'assq', 'rassq', +'remq' and 'delq'. - (setq foo '(1 2 3)) +To compare by (structural) value, use 'equal', 'member', 'assoc', +'rassoc', 'remove' or 'delete' instead. Floats and bignums can also +be compared using 'eql', '=' and 'memql'. Function literals cannot be +compared reliably at all. -invalid. Emacs will now warn during byte compilation if it seems -something like that, and also warn about when using RIGHT/LEFT SINGLE -QUOTATION MARK directly. In both these cases, if these characters -should really be present in the docstring, they should be quoted with -"\=". +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'suspicious'. --- -*** Byte compilation will now warn about some malformed 'defcustom' types. -It is very common to write 'defcustom' types on the form: - - :type '(choice (const :tag "foo" 'bar)) +*** Warn about 'condition-case' without handlers. +The compiler now warns when the 'condition-case' form is used without +any actual handlers, as in -I.e., double-quoting the 'bar', which is almost never the correct -value. The byte compiler will now issue a warning if it encounters -these forms. + (condition-case nil (read buffer)) -+++ -** 'restore-buffer-modified-p' can now alter buffer auto-save state. -With a FLAG value of 'autosaved', it will mark the buffer as having -been auto-saved since the time of last modification. +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'. ---- -** New minor mode 'isearch-fold-quotes-mode'. -This sets up 'search-default-mode' so that quote characters are -char-folded into each other. It is used, by default, in "*Help*" and -"*info*" buffers. +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'suspicious'. +++ -** New macro 'buffer-local-set-state'. -This is a helper macro to be used by minor modes that wish to restore -buffer-local variables back to their original states when the mode is -switched off. - ---- -** New macro 'with-buffer-unmodified-if-unchanged'. -If the buffer is marked as unmodified, and code does modifications -that, in total, means that the buffer is identical to the buffer -before, mark the buffer as unmodified again. - ---- -** New function 'malloc-trim'. -This function allows returning unused memory back to the operating -system, and is mainly meant as a debugging tool. It is currently -available only when Emacs was built with glibc as the C library. - ---- -** 'x-show-tip' no longer hard-codes a timeout default. -The new variable 'x-show-tooltip-timeout' allows the user to alter -this for packages that don't use 'tooltip-show', but instead call the -lower level function directly. - ---- -** New function 'current-cpu-time'. -It gives access to the CPU time used by the Emacs process, for -example for benchmarking purposes. - ---- -** New function 'string-edit'. -This is meant to be used when the user has to edit a (potentially) -long string. It pops up a new buffer where you can edit the string, -and a callback is called when the user types 'C-c C-c'. +** 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). +++ -** New function 'read-string-from-buffer'. -This is a modal version of 'string-edit', and can be used as an -alternative to 'read-string'. +** '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 -+++ -** The return value of 'clear-message-function' is not ignored anymore. -If the function returns 'dont-clear-message', then the message is not -cleared, with the assumption that the function cleared it itself. + (defalias 'able 'baker) + (defalias 'baker 'able) -+++ -** The local variables section now supports defining fallback modes. -This was previously only available when using a property line (i.e., -putting the modes on the first line of a file). +but trying to call them would often make Emacs hang. Now, an attempt +to create such a loop results in an error. -+++ -** New function 'flush-standard-output'. -This enables display of lines that don't end in a newline from -batch-based Emacs scripts. - -+++ -** New convenience function 'buttonize-region'. -This works like 'buttonize', but for a region instead of a string. - -+++ -** 'macroexp-let2*' can omit TEST argument and use single-var bindings. - -+++ -** New macro-writing macros, 'cl-with-gensyms' and 'cl-once-only'. -See the "(cl) Macro-Writing Macros" manual section for descriptions. - -+++ -** New variable 'last-event-device' and new function 'device-class'. -On X Windows, 'last-event-device' specifies the input extension device -from which the last input event originated, and 'device-class' can be -used to determine the type of an input device. - -+++ -** Variable 'track-mouse' can have a new value 'drag-source'. -This means the same as 'dropping', but modifies the mouse position -list in reported motion events if there is no frame underneath the -mouse pointer. - -+++ -** New functions for dragging items from Emacs to other programs. -The new functions 'x-begin-drag', 'dnd-begin-file-drag', -'dnd-begin-drag-files', and 'dnd-direct-save' allow dragging contents -(such as files and text) from Emacs to other programs. - ---- -** New function 'ietf-drums-parse-date-string'. -This function parses RFC5322 (and RFC822) date strings, and should be -used instead of 'parse-time-string' when parsing data that's standards -compliant. - -+++ -** New macro 'setopt'. -This is like 'setq', but is meant to be used for user options instead -of plain variables, and uses 'custom-set'/'set-default' to set them. - -+++ -** New utility predicate 'mode-line-window-selected-p'. -This is meant to be used from ':eval' mode line constructs to create -different mode line looks for selected and unselected windows. - -+++ -** New variable 'messages-buffer-name'. -This variable (defaulting to "*Messages*") allows packages to override -where messages are logged. - -+++ -** New function 'readablep'. -This function says whether an object can be written out and then -read back by the Emacs Lisp reader. - -+++ -** New variable 'print-unreadable-function'. -This variable allows changing how Emacs prints unreadable objects. - ---- -** The user option 'polling-period' now accepts floating point values. -This means Emacs can now poll for input during Lisp execution more -frequently than once in a second. - ---- -** New function 'bidi-string-strip-control-characters'. -This utility function is meant for displaying strings when it is -essential that there's no bidirectional context. It removes all the -bidirectional formatting control characters (such as RLM, LRO, PDF, -etc.) from its argument string. The characters it removes are listed -in the value of 'bidi-control-characters'. - ---- -** The Gnus range functions have been moved to a new library, range.el. -All the old names have been made obsolete. - -+++ -** New function 'function-alias-p'. -This predicate says whether an object is a function alias, and if it -is, the alias chain is returned. - -+++ -** New variable 'lisp-directory' holds the directory of Emacs's own Lisp files. - -+++ -** New facility for handling session state: 'multisession-value'. -This can be used as a convenient way to store (simple) application -state, and the command 'list-multisession-values' allows users to list -(and edit) this data. - -+++ -** New function 'get-display-property'. -This is like 'get-text-property', but works on the 'display' text -property. - -+++ -** New function 'add-display-text-property'. -This is like 'put-text-property', but works on the 'display' text -property. - -+++ -** New 'min-width' 'display' property. -This allows setting a minimum display width for a region of text. - -+++ -** New 'cursor-face' text property. -This uses 'cursor-face' instead of the default face when cursor is on or -near the character and 'cursor-face-highlight-mode' is enabled. The -user option 'cursor-face-highlight-nonselected-window' is similar to -'highlight-nonselected-windows', but for this property. - -+++ -** New event type 'touch-end'. -This event is sent whenever the user's finger moves off the mouse -wheel on some mice, or when the user's finger moves off the touchpad. - -+++ -** New event type 'pinch'. -This event is sent when a user performs a pinch gesture on a touchpad, -which is comprised of placing two fingers on the touchpad and moving -them towards or away from each other. - -+++ -** New hook 'x-pre-popup-menu-hook'. -This hook, run before 'x-popup-menu', is about to display a -deck-of-cards menu on screen. - ---- -** New hook 'post-select-region-hook'. -This hook is run immediately after 'select-active-regions'. It causes -the region to be set as the primary selection. - -+++ -** New function 'buffer-match-p'. -Check if a buffer satisfies some condition. Some examples for -conditions can be regular expressions that match a buffer name, a -cons-cell like '(major-mode . shell-mode)' that matches any buffer -where 'major-mode' is 'shell-mode' or a combination with a condition -like '(and "\\`\\*.+\\*\\'" (major-mode . special-mode))'. - -+++ -** New function 'match-buffers'. -It uses 'buffer-match-p' to gather a list of buffers that match a -condition. - ---- -** New optional arguments TEXT-FACE and DEFAULT-FACE for 'tooltip-show'. -They allow changing the faces used for the tooltip text and frame -colors of the resulting tooltip frame from the default 'tooltip' face. - -** Text Security and Suspiciousness - -+++ -*** New library textsec.el. -This library contains a number of checks for whether a string is -"suspicious". This usually means that the string contains characters -that have glyphs that can be confused with other, more commonly used -glyphs, or contains bidirectional (or other) formatting characters -that may be used to confuse a user. - -+++ -*** New user option 'textsec-check'. -If non-nil (which is the default), Emacs packages that are vulnerable -to attackers trying to confuse the users will use the textsec library -to mark suspicious text. For instance shr/eww will mark suspicious -URLs and links, Gnus will mark suspicious From addresses, and -Message mode will query the user if the user is sending mail to a -suspicious address. If this variable is nil, these checks are -disabled. - -+++ -*** New function 'textsec-suspicious-p'. -This is the main function Emacs applications should be using to check -whether a string is suspicious. It heeds the 'textsec-check' user -option. - -** Keymaps and Key Definitions - -+++ -*** 'where-is-internal' can now filter events marked as non key events. -If a command maps to a key binding like '[some-event]', and 'some-event' -has a symbol plist containing a non-nil 'non-key-event' property, then -that binding is ignored by 'where-is-internal'. - -+++ -*** New functions for defining and manipulating keystrokes. -These all take the syntax defined by 'key-valid-p'. None of the older -functions have been deprecated or altered, but they are now -de-emphasized in the documentation. - -+++ -*** Use 'keymap-set' instead of 'define-key'. - -+++ -*** Use 'keymap-global-set' instead of 'global-set-key'. - -+++ -*** Use 'keymap-local-set' instead of 'local-set-key'. - -+++ -*** Use 'keymap-global-unset' instead of 'global-unset-key'. - -+++ -*** Use 'keymap-local-unset' instead of 'local-unset-key'. - -+++ -*** Use 'keymap-substitute' instead of 'substitute-key-definition'. - -+++ -*** Use 'keymap-set-after' instead of 'define-key-after'. - -+++ -*** Use 'keymap-lookup' instead of 'lookup-key' and 'key-binding'. - -+++ -*** Use 'keymap-local-lookup' instead of 'local-key-binding'. - -+++ -*** Use 'keymap-global-lookup' instead of 'global-key-binding'. - -+++ -*** 'define-key' now takes an optional REMOVE argument. -If non-nil, remove the definition from the keymap. This is subtly -different from setting a definition to nil (when the keymap has a -parent). - -+++ -*** 'read-multiple-choice' now takes an optional SHOW-HELP argument. -If non-nil, show the help buffer immediately, before any user input. - -+++ -*** New function 'key-valid-p'. -The 'kbd' function is quite permissive, and will try to return -something usable even if the syntax of the argument isn't completely -correct. The 'key-valid-p' predicate does a stricter check of the -syntax. - ---- -*** New function 'key-parse'. -This is like 'kbd', but only returns vectors instead of a mix of -vectors and strings. - -+++ -*** New ':type' for 'defcustom' for keys. -The new 'key' type can be used for options that should be a valid key -according to 'key-valid-p'. The type 'key-sequence' is now obsolete. - -+++ -** New substitution in docstrings and 'substitute-command-keys'. -Use \\`KEYSEQ' to insert a literal key sequence "KEYSEQ" (for example -\\`C-k') in a docstring or when calling 'substitute-command-keys', -which will use the same face as a command substitution. This should -be used only when a key sequence has no corresponding command, for -example when it is read directly with 'read-key-sequence'. It must be -a valid key sequence according to 'key-valid-p'. - -+++ -** New function 'file-name-split'. -This returns a list of all the components of a file name. - -+++ -** New function 'file-name-parent-directory'. -This returns the parent directory of a file name. - -+++ -** New macro 'with-undo-amalgamate'. -It records a particular sequence of operations as a single undo step. - -+++ -** New command 'yank-media'. -This command supports yanking non-plain-text media like images and -HTML from other applications into Emacs. It is only supported in -modes that have registered support for it, and only on capable -platforms. - -+++ -** New command 'yank-media-types'. -This command lets you examine all data in the current selection and -the clipboard, and insert it into the buffer. - -+++ -** New variable 'yank-transform-functions'. -This variable allows the user to alter the string to be inserted. - ---- -** New command 'yank-in-context'. -This command tries to preserve string/comment syntax when yanking. - ---- -** New function 'minibuffer-lazy-highlight-setup'. -This function allows setting up the minibuffer so that lazy -highlighting of its content is applied in the original window. - -+++ -** New text property 'inhibit-isearch'. -If set, 'isearch' will skip these areas, which can be useful (for -instance) when covering huge amounts of data (that has no meaningful -searchable data, like image data) with a 'display' text property. - -+++ -** 'insert-image' now takes an INHIBIT-ISEARCH optional argument. -It marks the image with the 'inhibit-isearch' text property, which -inhibits 'isearch' matching the STRING argument. - ---- -** New variable 'replace-regexp-function'. -Function to call to convert the entered FROM string to an Emacs -regexp in 'query-replace' and similar commands. It can be used to -implement a different regexp syntax for search/replace. - ---- -** New variables to customize defaults of FROM for 'query-replace*' commands. -The new variable 'query-replace-read-from-default' can be set to a -function that returns the default value of FROM when 'query-replace' -prompts for a string to be replaced. An example of such a function is -'find-tag-default'. - -The new variable 'query-replace-read-from-regexp-default' can be set -to a function (such as 'find-tag-default-as-regexp') that returns the -default value of FROM when 'query-replace-regexp' prompts for a regexp -whose matches are to be replaced. If these variables are nil (which -is the default), 'query-replace' and 'query-replace-regexp' take the -default value from the previous FROM-TO pair. - -** Lisp pretty-printer ('pp') - ---- -*** New function 'pp-emacs-lisp-code'. -'pp' formats general Lisp sexps. This function does much the same, -but applies formatting rules appropriate for Emacs Lisp code. Note -that this could currently be quite slow, and is thus appropriate only -for relatively small code fragments. - ---- -*** New user option 'pp-use-max-width'. -If non-nil, 'pp' and all 'pp-*' commands that format the results, will -attempt to limit the line length when formatting long lists and -vectors. This uses 'pp-emacs-lisp-code', and thus could be slow for -large lists. - -+++ -** New function 'file-has-changed-p'. -This convenience function is useful when writing code that parses -files at run-time, and allows Lisp programs to re-parse files only -when they have changed. - -+++ -** 'abbreviate-file-name' now respects magic file name handlers. - ---- -** New function 'font-has-char-p'. -This can be used to check whether a specific font has a glyph for a -character. - -+++ -** 'window-text-pixel-size' now accepts a new argument IGNORE-LINE-AT-END. -This controls whether or not the last screen line of the text being -measured will be counted for the purpose of calculating the text -dimensions. - -+++ -** 'window-text-pixel-size' understands a new meaning of FROM. -Specifying a cons as the FROM argument allows to start measuring text -from a specified amount of pixels above or below a position. - -+++ -** 'window-body-width' and 'window-body-height' can use remapped faces. -Specifying 'remap' as the PIXELWISE argument now checks if the default -face was remapped, and if so, uses the remapped face to determine the -character width/height. - -+++ -** 'set-window-vscroll' now accepts a new argument PRESERVE-VSCROLL-P. -This means the vscroll will not be reset when set on a window that is -"frozen" due to a mini-window being resized. - -** XDG Support - ---- -*** New function 'xdg-state-home'. -It returns the new 'XDG_STATE_HOME' environment variable. It should -point to a file name that "contains state data that should persist -between (application) restarts, but that is not important or portable -enough to the user that it should be stored in $XDG_DATA_HOME". -(This variable was introduced in the XDG Base Directory Specification -version 0.8 released on May 8, 2021.) - ---- -*** New function 'xdg-current-desktop'. -It returns a list of strings, corresponding to the colon-separated -list of names in the 'XDG_CURRENT_DESKTOP' environment variable, which -identify the current desktop environment. -(This variable was introduced in XDG Desktop Entry Specification -version 1.2.) - ---- -*** New function 'xdg-session-type'. -It returns the 'XDG_SESSION_TYPE' environment variable. (This is not -part of any official standard; see the man page pam_systemd(8) for -more information.) - -+++ -** New macro 'with-delayed-message'. -This macro is like 'progn', but will output the specified message if -the body takes longer to execute than the specified timeout. - ---- -** New function 'funcall-with-delayed-message'. -This function is like 'funcall', but will output the specified message -if the function takes longer to execute than the specified timeout. - -** Locale - ---- -*** New variable 'current-locale-environment'. -This holds the value of the previous call to 'set-locale-environment'. - ---- -*** New macro 'with-locale-environment'. -This macro can be used to change the locale temporarily while -executing code. - -** Table - ---- -*** New user option 'table-latex-environment'. -This allows switching between "table" and "tabular". - -** Tabulated List Mode - -+++ -*** A column can now be set to an image descriptor. -The 'tabulated-list-entries' variable now supports using an image -descriptor, which means to insert an image in that column instead of -text. See the documentation string of that variable for details. - -+++ -** ':keys' in 'menu-item' can now be a function. -If so, it is called whenever the menu is computed, and can be used to -calculate the keys dynamically. - -+++ -** New major mode 'clean-mode'. -This is a new major mode meant for debugging. It kills absolutely all -local variables and removes overlays and text properties. - -+++ -** 'kill-all-local-variables' can now kill all local variables. -If given the new optional KILL-PERMANENT argument, it also kills -permanent local variables. - -+++ -** Third 'mapconcat' argument SEPARATOR is now optional. -An explicit nil always meant the empty string, now it can be left out. - -+++ -** New function 'define-keymap'. -This function allows defining a number of keystrokes with one form. - -+++ -** New macro 'defvar-keymap'. -This macro allows defining keymap variables more conveniently. - -** 'defvar-keymap' can specify 'repeat-mode' behavior for the keymap. -Use ':repeat t' to have all bindings be repeatable or for more -advanced usage: - - :repeat (:enter (commands ...) :exit (commands ...)) - ---- -** 'kbd' can now be used in built-in, preloaded libraries. -It no longer depends on edmacro.el and cl-lib.el. - -+++ -** New function 'image-at-point-p'. -This function returns t if point is on a valid image, and nil -otherwise. - -+++ -** New function 'buffer-text-pixel-size'. -This is similar to 'window-text-pixel-size', but can be used when the -buffer isn't displayed. - -+++ -** New function 'string-pixel-width'. -This returns the width of a string in pixels. This can be useful when -dealing with variable pitch fonts and glyphs that have widths that -aren't integer multiples of the default font. - -+++ -** New function 'string-glyph-split'. -This function splits a string into a list of strings representing -separate glyphs. This takes into account combining characters and -grapheme clusters, by treating each sequence of characters composed on -display as a single unit. - ---- -** 'lookup-key' is more permissive when searching for extended menu items. -In Emacs 28.1, the behavior of 'lookup-key' was changed: when looking -for a menu item '[menu-bar Foo-Bar]', first try to find an exact -match, then look for the lowercased '[menu-bar foo-bar]'. - -This has been extended, so that when looking for a menu item with a -symbol containing spaces, as in '[menu-bar Foo\ Bar]', first look for -an exact match, then the lowercased '[menu-bar foo\ bar]' and finally -'[menu-bar foo-bar]'. This further improves backwards-compatibility -when converting menus to use 'easy-menu-define'. - -** Xwidget - -+++ -*** The function 'make-xwidget' now accepts an optional RELATED argument. -This argument is used as another widget for the newly created WebKit -widget to share settings and subprocesses with. It must be another -WebKit widget. - -+++ -*** New function 'xwidget-perform-lispy-event'. -This function allows you to send events to xwidgets. Usually, some -equivalent of the event will be sent, but there is no guarantee of -what the widget will actually receive. - -On GTK+, only key and function key events are implemented. - -+++ -*** New function 'xwidget-webkit-load-html'. -This function is used to load HTML text into WebKit xwidgets -directly, in contrast to creating a temporary file to hold the -markup, and passing the URI of the file as an argument to -'xwidget-webkit-goto-uri'. - -+++ -*** New functions for performing searches on WebKit xwidgets. -Some new functions, such as 'xwidget-webkit-search', have been added -for performing searches on WebKit xwidgets. - -+++ -*** New function 'xwidget-webkit-back-forward-list'. -This function returns the history of page-loads in a WebKit xwidget. - -+++ -*** New function 'xwidget-webkit-estimated-load-progress'. -This function returns the estimated progress of page loading in a -WebKit xwidget. - -+++ -*** New function 'xwidget-webkit-stop-loading'. -This function terminates all data transfer during page loads in a -WebKit xwidget. - -+++ -*** 'load-changed' xwidget events are now more detailed. -In particular, they can now have different arguments based on the -state of the WebKit widget. 'load-finished' is sent when a load has -completed, 'load-started' when a load first starts, 'load-redirected' -after a redirect, and 'load-committed' when the WebKit widget first -commits to the load. - -+++ -*** New event type 'xwidget-display-event'. -These events are sent whenever an xwidget requests that Emacs displays -another xwidget. The only arguments to this event are the xwidget -that should be displayed, and the xwidget that asked to display it. - -+++ -*** New function 'xwidget-webkit-set-cookie-storage-file'. -This function is used to control where and if an xwidget stores -cookies set by web pages on disk. - ---- -** New variable 'help-buffer-under-preparation'. -This variable is bound to t during the preparation of a "*Help*" buffer. - -+++ -** Timestamps like '(1 . 1000)' now work without warnings being generated. -For example, '(time-add nil '(1 . 1000))' no longer warns that the -'(1 . 1000)' acts like '(1000 . 1000000)'. This warning, which was a -temporary transition aid for Emacs 27, has served its purpose. - -+++ -** 'encode-time' now also accepts a 6-element list with just time and date. -'(encode-time (list SECOND MINUTE HOUR DAY MONTH YEAR))' is now short for -'(encode-time (list SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil))'. - -+++ -** 'date-to-time' now accepts arguments that lack month, day, or time. -The function now assumes the earliest possible values if its argument -lacks month, day, or time. For example, (date-to-time "2021-12-04") -now assumes a time of "00:00" instead of signaling an error. - -+++ -** 'format-seconds' now allows suppressing zero-value trailing elements. -The new "%x" non-printing control character will suppress zero-value -elements that appear after "%x". - -+++ -** New events for taking advantage of touchscreen devices. -The events 'touchscreen-begin', 'touchscreen-update', and -'touchscreen-end' have been added to take better advantage of -touch-capable display panels. - -+++ -** New error symbol 'permission-denied'. -This is a subcategory of 'file-error', and is signaled when some file -operation fails because the OS doesn't allow Emacs to access a file or -a directory. - -+++ -** The ':underline' face attribute now accepts a new property. -The property ':position' now specifies the position of the underline -when used as part of a property list specification for the -':underline' attribute. - -+++ -** 'defalias' records a more precise history of definitions. -This is recorded in the 'function-history' symbol property. - ---- -** New hook 'save-place-after-find-file-hook'. -This is called at the end of 'save-place-find-file-hook'. - ---- -** 'indian-tml-base-table' no longer translates digits. -Use 'indian-tml-base-digits-table' if you want digits translation. - ---- -** 'indian-tml-itrans-v5-hash' no longer translates digits. -Use 'indian-tml-itrans-digits-v5-hash' if you want digits -translation. - -+++ -** 'shell-quote-argument' has a new optional argument POSIX. -This is useful when quoting shell arguments for a remote shell -invocation. Such shells are POSIX conformant by default. - -+++ -** 'make-process' can set connection type independently for input and output. -When calling 'make-process', communication via pty can be enabled -selectively for just input or output by passing a cons cell for -':connection-type', e.g. '(pipe . pty)'. When examining a process -later, you can determine whether a particular stream for a process -uses a pty by passing one of 'stdin', 'stdout', or 'stderr' as the -second argument to 'process-tty-name'. - -+++ -** 'signal-process' now consults the list 'signal-process-functions'. -This is to determine which function has to be called in order to -deliver the signal. This allows Tramp to send the signal to remote -asynchronous processes. The hitherto existing implementation has been -moved to 'internal-default-signal-process'. - -+++ -** Some system information functions honor remote systems now. -'list-system-processes' returns remote process IDs. -'memory-info' returns memory information of remote systems. -'process-attributes' expects a remote process ID. -This happens only when the current buffer's 'default-directory' is -remote. In order to preserve the old behavior, bind -'default-directory' to a local directory, like - - (let ((default-directory temporary-file-directory)) - (list-system-processes)) - -+++ -** New functions 'take' and 'ntake'. -'(take N LIST)' returns the first N elements of LIST; 'ntake' does -the same but works by modifying LIST destructively. - ---- -** 'string-split' is now an alias for 'split-string'. - -+++ -** 'format-spec' now accepts functions in the replacement. -The function is called only when used in the format string. This is -useful to avoid side-effects such as prompting, when the value is not -actually being used for anything. - -+++ -** The variable 'max-specpdl-size' has been made obsolete. -Now 'max-lisp-eval-depth' alone is used for limiting Lisp recursion -and stack usage. 'max-specpdl-size' is still present as a plain -variable for compatibility but its limiting powers have been taken away. - -** New function 'external-completion-table'. -This function returns a completion table designed to ease -communication between Emacs's completion facilities and external tools -offering completion services, particularly tools whose full working -set is too big to transfer to Emacs every time a completion is -needed. The table uses new 'external' completion style exclusively -and cannot work with regular styles such as 'basic' or 'flex'. - -+++ -** Magic file name handlers for 'make-directory-internal' are no longer needed. -Instead, Emacs uses the already-existing 'make-directory' handlers. - -+++ -** '(make-directory DIR t)' returns non-nil if DIR already exists. -This can let a caller know whether it created DIR. Formerly, -'make-directory's return value was unspecified. +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 29.1 on Non-Free Operating Systems - -** MS-Windows - ---- -*** Emacs now supports double-buffering on MS-Windows to reduce display flicker. -(This was supported on Free systems since Emacs 26.1.) - -To disable double-buffering (e.g., if it causes display problems), set -the frame parameter 'inhibit-double-buffering' to a non-nil value. -You can do that either by adding - - '(inhibit-double-buffering . t) - -to 'default-frame-alist', or by modifying the frame parameters of the -selected frame by evaluating - - (modify-frame-parameters nil '((inhibit-double-buffering . t))) - -+++ -*** Emacs now supports system dark mode. -On Windows 10 (version 1809 and higher) and Windows 11, Emacs will now -follow the system's dark mode: GUI frames use the appropriate light or -dark title bar and scroll bars, based on the user's Windows-wide color -settings. - ---- -*** Emacs now uses native image APIs to display some image formats. -On Windows 2000 and later, Emacs now defaults to using the native -image APIs for displaying the BMP, GIF, JPEG, PNG, and TIFF images. -This means Emacs on MS-Windows needs no longer use external image -support libraries to display those images. Other image types -- XPM, -SVG, and WEBP -- still need support libraries for Emacs to be able to -display them. - -The use of native image APIs is controlled by the variable -'w32-use-native-image-API', whose value now defaults to t on systems -where those APIs are available. - -+++ -*** Emacs now supports display of BMP images using native image APIs. -When 'w32-use-native-image-API' is non-nil, Emacs on MS-Windows now -has built-in support for displaying BMP images. - ---- -*** GUI Yes/No dialogs now include a "Cancel" button. -The "Cancel" button is in addition to "Yes" and "No", and is intended -to allow users to quit the dialog, as an equivalent of 'C-g' when Emacs -asks a yes/no question via the echo area. This is controlled by the -new variable 'w32-yes-no-dialog-show-cancel', by default t. Set it to -nil to get back the old behavior of showing a modal dialog with only -two buttons: "Yes" and "No". - -** Cygwin - ---- -*** 'process-attributes' is now implemented. +* Changes in Emacs 30.1 on Non-Free Operating Systems ---------------------------------------------------------------------- diff --git a/etc/NEWS.29 b/etc/NEWS.29 new file mode 100644 index 00000000000..0b651f7a519 --- /dev/null +++ b/etc/NEWS.29 @@ -0,0 +1,4925 @@ +GNU Emacs NEWS -- history of user-visible changes. + +Copyright (C) 2021-2023 Free Software Foundation, Inc. +See the end of the file for license conditions. + +Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'. +If possible, use 'M-x report-emacs-bug'. + +This file is about changes in Emacs version 29. + +See file HISTORY for a list of GNU Emacs versions and release dates. +See files NEWS.28, NEWS.27, ..., NEWS.18, and NEWS.1-17 for changes +in older Emacs versions. + +You can narrow news to a specific version by calling 'view-emacs-news' +with a prefix argument or by typing 'C-u C-h C-n'. + +Temporary note: ++++ indicates that all relevant manuals in doc/ have been updated. +--- means no change in the manuals is needed. +When you add a new item, use the appropriate mark if you are sure it +applies, and please also update docstrings as needed. + + +* Installation Changes in Emacs 29.1 + +--- +** Ahead-of-time native compilation can now be requested via configure. +Use '--with-native-compilation=aot' to request that all the Lisp files +in the Emacs tree should be natively compiled ahead of time. (This is +slow on most machines.) + +This feature existed in Emacs 28.1, but was less easy to request. + ++++ +** Emacs can be built with the tree-sitter parsing library. +This library, together with separate grammar libraries for each +language, provides incremental parsing capabilities for several +popular programming languages and other formatted files. Emacs built +with this library offers major modes, described elsewhere in this +file, that are based on the tree-sitter's parsers. If you have the +tree-sitter library installed, the configure script will automatically +include it in the build; use '--without-tree-sitter' at configure time +to disable that. + +Emacs modes based on the tree-sitter library require an additional +grammar library for each mode. These grammar libraries provide the +tree-sitter library with language-specific lexical analysis and +parsing capabilities, and are developed separately from the +tree-sitter library itself. If you don't have a grammar library +required by some Emacs major mode, and your distro doesn't provide it +as an installable package, you can compile and install such a library +yourself. Many libraries can be downloaded from the tree-sitter site: + + https://github.com/tree-sitter + +Emacs provides a user command, 'treesit-install-language-grammar', +that automates the download and build process of a grammar library. +It prompts for the language, the URL of the language grammar's VCS +repository, and then uses the installed C/C++ compiler to build the +library and install it. + +You can also do this manually. To compile such a library after +cloning its Git repository, compile the files "scanner.c" and +"parser.c" (sometimes named "scanner.cc" and "parser.cc") in the "src" +subdirectory of the library's source tree using the C or C++ compiler, +then link these two files into a shared library named +"libtree-sitter-LANG.so", where LANG is the name of the language +supported by the grammar as it is expected by the Emacs major mode +(for example, "c" for 'c-ts-mode', "cpp" for 'c++-ts-mode', "python" +for 'python-ts-mode', etc.). Then place the shared library you've +built in the same directory where you keep the other shared libraries +used by Emacs, or in the "tree-sitter" subdirectory of your +'user-emacs-directory', or in a directory mentioned in the variable +'treesit-extra-load-path'. + +You only need to install language grammar libraries required by the +Emacs modes you will use, as Emacs loads these libraries only when the +corresponding mode is turned on in some buffer for the first time in +an Emacs session. + ++++ +** Emacs can be built with built-in support for accessing SQLite databases. +This uses the popular sqlite3 library, and can be disabled by using +the '--without-sqlite3' option to the 'configure' script. + ++++ +** Support for the WebP image format. +This support is built by default when the libwebp library is +available, and includes support for animated WebP images. To disable +WebP support, use the '--without-webp' configure flag. Image +specifiers can now use ':type webp'. + ++++ +** Emacs has been ported to the Haiku operating system. +The configuration process should automatically detect and build for +Haiku. There is also an optional window-system port to Haiku, which +can be enabled by configuring Emacs with the option '--with-be-app', +which will require the Haiku Application Kit development headers and a +C++ compiler to be present on your system. If Emacs is not built with +the option '--with-be-app', the resulting Emacs will only run in +text-mode terminals. + +To enable Cairo support, ensure that the Cairo and FreeType +development files are present on your system, and configure Emacs with +'--with-be-cairo'. + +Unlike X, there is no compile-time option to enable or disable +double-buffering; it is always enabled. To disable it, change the +frame parameter 'inhibit-double-buffering' instead. + +--- +** Emacs now installs the ".pdmp" file using a unique fingerprint in the name. +The file is typically installed using a file name akin to +"...dir/libexec/emacs/29.1/x86_64-pc-linux-gnu/emacs-<fingerprint>.pdmp". +If a constant file name is required, the file can be renamed to +"emacs.pdmp", and Emacs will find it during startup anyway. + +--- +** Emacs on X now uses XInput 2 for input events. +If your X server has support and you have the XInput 2 development +headers installed, Emacs will use the X Input Extension for handling +input. If this causes problems, you can configure Emacs with the +option '--without-xinput2' to disable this support. + +'(featurep 'xinput2)' can be used to test for the presence of XInput 2 +support from Lisp programs. + ++++ +** Emacs now supports being built with pure GTK. +To use this option, make sure the GTK 3 (version 3.22.23 or later) and +Cairo development files are installed, and configure Emacs with the +option '--with-pgtk'. Unlike the default X and GTK build, the +resulting Emacs binary will work on any underlying window system +supported by GDK, such as Wayland and Broadway. We recommend that you +use this configuration only if you are running a window system other +than X that's supported by GDK. Running this configuration on X is +known to have problems, such as undesirable frame positioning and +various issues with keyboard input of sequences such as 'C-;' and +'C-S-u'. + +--- +** Emacs no longer reduces the size of the Japanese dictionary. +Building Emacs includes generation of a Japanese dictionary, which is +used by Japanese input methods. Previously, the build included a step +of reducing the size of this dictionary's vocabulary. This vocabulary +reduction is now optional, by default off. If you need the Emacs +build to include the vocabulary reduction, configure Emacs with the +option '--with-small-ja-dic'. In an Emacs source tree already +configured without that option, you can force the vocabulary reduction +by saying + + make -C leim generate-ja-dic JA_DIC_NO_REDUCTION_OPTION='' + +after deleting "lisp/leim/ja-dic/ja-dic.el". + +--- +** The docstrings of preloaded files are not in "etc/DOC" any more. +Instead, they're fetched as needed from the corresponding ".elc" +files, as was already the case for all the non-preloaded files. + + +* Startup Changes in Emacs 29.1 + ++++ +** '--batch' and '--script' now adjust the garbage collection levels. +These switches now set 'gc-cons-percentage' to 1.0 (up from the +default of 0.1). This means that batch processes will typically use +more memory than before, but use less time doing garbage collection. +Batch jobs that are supposed to run for a long time should adjust the +limit back down again. + ++++ +** Emacs can now be used more easily in an executable script. +If you start an executable script with + + #!/usr/bin/emacs -x + +Emacs will start without reading any init files (like with '--quick'), +and then execute the rest of the script file as Emacs Lisp. When it +reaches the end of the script, Emacs will exit with an exit code from +the value of the final form. + ++++ +** Emacs now supports setting 'user-emacs-directory' via '--init-directory'. +Use the '--init-directory' command-line option to set +'user-emacs-directory'. + ++++ +** Emacs now has a '--fingerprint' option. +This will output a string identifying the current Emacs build, and exit. + ++++ +** New hook 'after-pdump-load-hook'. +This is run at the end of the Emacs startup process, and is meant to +be used to reinitialize data structures that would normally be done at +load time. + +** 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 +system directory where the "*.eln" files are installed (usually, the +last entry in 'native-comp-eln-load-path') are not deleted. + +--- +*** New function 'startup-redirect-eln-cache'. +This function can be called in your init files to change the +user-specific directory where Emacs stores the "*.eln" files produced +by native compilation of Lisp packages Emacs loads. The default +eln cache directory is unchanged: it is the "eln-cache" subdirectory +of 'user-emacs-directory'. + + +* Incompatible changes in Emacs 29.1 + ++++ +** The image commands have changed key bindings. +In previous Emacs versions, images have had the '+', '-' and 'r' keys +bound when point is over an image. In Emacs 29.1, additional commands +were added, and this made it more likely that users would trigger the +image commands by mistake. To avoid this, all image commands have +moved to the 'i' keymap, so '+' is now 'i +', '-' is now 'i -', and +'r' is now 'i r'. In addition, these commands are now repeating, so +you can rotate an image twice by saying 'i r r', for instance. + ++++ +** Emacs now picks the correct coding-system for X input methods. +Previously, Emacs would use 'locale-coding-system' for input +methods, which could in some circumstances be incorrect, especially +when the input method chose to fall back to some other coding system. + +Emacs now automatically detects the coding-system used by input +methods, and uses that to decode input in preference to the value of +'locale-coding-system'. This unfortunately means that users who have +changed the coding system used to decode X keyboard input must adjust +their customizations to 'locale-coding-system' to the variable +'x-input-coding-system' instead. + ++++ +** Bookmarks no longer include context for encrypted files. +If you're visiting an encrypted file, setting a bookmark no longer +includes excerpts from that buffer in the bookmarks file. This is +implemented by the new hook 'bookmark-inhibit-context-functions', +where packages can register a function which returns non-nil for file +names to be excluded from adding such excerpts. + +--- +** 'show-paren-mode' is now disabled in 'special-mode' buffers. +In Emacs versions previous to Emacs 28.1, 'show-paren-mode' defaulted +off. In Emacs 28.1, the mode was switched on in all buffers. In +Emacs 29.1, this was changed to be switched on in all editing-related +buffers, but not in buffers that inherit from 'special-mode'. To go +back to how things worked in Emacs 28.1, put the following in your +init file: + + (setopt show-paren-predicate t) + ++++ +** Explicitly-set read-only state is preserved when reverting a buffer. +If you use the 'C-x C-q' command to change the read-only state of the +buffer and then revert it, Emacs would previously use the file +permission bits to determine whether the buffer should be read-only +after reverting the buffer. Emacs now remembers the decision made in +'C-x C-q'. + +--- +** The Gtk selection face is no longer used for the region. +The combination of a Gtk-controlled background and a foreground color +controlled by the internal Emacs machinery led to low-contrast faces +in common default setups. Emacs now uses the same 'region' face on +Gtk and non-Gtk setups. + +--- +** 'C-h f' and 'C-h x' may now require confirmation when you press 'RET'. +If the text in the minibuffer cannot be completed to a single function +or command, typing 'RET' will not automatically complete to the shortest +candidate, but will instead ask for confirmation. Typing 'TAB' will +complete as much as possible, and another 'TAB' will show all the +possible completions. This allows you to insist on the functions name +even if Help doesn't appear to know about it, by confirming with a +second 'RET'. + +** Dired + +--- +*** 'w' ('dired-copy-filename-as-kill') has changed behavior. +If there are several files marked, file names containing space and +quote characters will be quoted "like this". + +--- +*** The 'd' command now more consistently skips dot files. +In previous Emacs versions, commands like 'C-u 10 d' would put the "D" +mark on the next ten files, no matter whether they were dot files +(i.e., "." and "..") or not, while marking the next ten lines with the +mouse (in 'transient-mark-mode') and then hitting 'd' would skip dot +files. These now work equivalently. + ++++ +** Warning about "eager macro-expansion failure" is now an error. + +--- +** Previously, the X "reverseVideo" value at startup was heeded for all frames. +This meant that if you had a "reverseVideo" resource on the initial +display, and then opened up a new frame on a display without any +explicit "reverseVideo" setting, it would get heeded there, too. (This +included terminal frames.) In Emacs 29, the "reverseVideo" X resource +is handled like all the other X resources, and set on a per-frame basis. + ++++ +** 'E' in 'query-replace' now edits the replacement with exact case. +Previously, this command did the same as 'e'. + +--- +** '/ a' in "*Packages*" buffer now limits by archive name(s) instead of regexp. + ++++ +** Setting the goal columns now also affects '<prior>' and '<next>'. +Previously, 'C-x C-n' only affected 'next-line' and 'previous-line', +but it now also affects 'scroll-up-command' and 'scroll-down-command'. + +--- +** Isearch in "*Help*" and "*info*" now char-folds quote characters by default. +This means that you can say 'C-s `foo' (GRAVE ACCENT) if the buffer +contains "‘foo" (LEFT SINGLE QUOTATION MARK) and the like. These +quotation characters look somewhat similar in some fonts. To switch +this off, disable the new 'isearch-fold-quotes-mode' minor mode. + +--- +** Sorting commands no longer necessarily change modification status. +In earlier Emacs versions, commands like 'sort-lines' would always +change buffer modification status to "modified", whether they changed +something in the buffer or not. This has been changed: the buffer is +marked as modified only if the sorting ended up actually changing the +contents of the buffer. + +--- +** 'string-lines' handles trailing newlines differently. +It no longer returns an empty final string if the string ends with a +newline. + +--- +** 'TAB' and '<backtab>' are now bound in 'button-map'. +This means that if point is on a button, 'TAB' will take you to the +next button, even if the mode has bound it to something else. This +also means that 'TAB' on a button in an 'outline-minor-mode' heading +will move point instead of collapsing the outline. + +--- +** 'outline-minor-mode-cycle-map' is now parent of 'outline-minor-mode'. +Instead of adding text property 'keymap' with 'outline-minor-mode-cycle' +on outline headings in 'outline-minor-mode', the keymap +'outline-minor-mode-cycle' is now active in the whole buffer. +But keybindings in 'outline-minor-mode-cycle' still take effect +only on outline headings because they are bound with the help of +'outline-minor-mode-cycle--bind' that checks if point is on a heading. + +--- +** 'Info-default-directory-list' is no longer populated at Emacs startup. +If you have code in your init file that removes directories from +'Info-default-directory-list', this will no longer work. + +--- +** 'C-k' no longer deletes files in 'ido-mode'. +To get the previous action back, put something like the following in +your Init file: + + (require 'ido) + (keymap-set ido-file-completion-map "C-k" #'ido-delete-file-at-head) + +--- +** New user option 'term-clear-full-screen-programs'. +By default, term.el will now work like most terminals when displaying +full-screen programs: When they exit, the output is cleared, leaving +what was displayed in the window before the programs started. Set +this user option to nil to revert back to the old behavior. + +--- +** Support for old EIEIO functions is not autoloaded any more. +You need an explicit '(require 'eieio-compat)' to use 'defmethod' +and 'defgeneric' (which have been made obsolete in Emacs 25.1 with +'cl-defmethod' and 'cl-defgeneric'). +Similarly you might need to '(require 'eieio-compat)' before loading +files that were compiled with an old EIEIO (Emacs<25). + +--- +** 'C-x 8 .' has been moved to 'C-x 8 . .'. +This is to open up the 'C-x 8 .' map to bind further characters there. + +--- +** 'C-x 8 =' has been moved to 'C-x 8 = ='. +You can now use 'C-x 8 =' to insert several characters with macron; +for example, 'C-x 8 = a' will insert U+0101 LATIN SMALL LETTER A WITH +MACRON. To insert a lone macron, type 'C-x 8 = =' instead of the +previous 'C-x ='. + +** Eshell + +*** Eshell's PATH is now derived from 'exec-path'. +For consistency with remote connections, Eshell now uses 'exec-path' +to determine the execution path on the local or remote system, instead +of using the PATH environment variable directly. + +--- +*** 'source' and '.' no longer accept the '--help' option. +This is for compatibility with the shell versions of these commands, +which don't handle options like '--help' in any special way. + ++++ +*** String delimiters in argument predicates/modifiers are more restricted. +Previously, some argument predicates/modifiers allowed arbitrary +characters as string delimiters. To provide more unified behavior +across all predicates/modifiers, the list of allowed delimiters has +been restricted to "...", '...', /.../, |...|, (...), [...], <...>, +and {...}. See the "(eshell) Argument Predication and Modification" +node in the Eshell manual for more details. + ++++ +*** Eshell pipelines now only pipe stdout by default. +To pipe both stdout and stderr, use the '|&' operator instead of '|'. + +--- +** The 'delete-forward-char' command now deletes by grapheme clusters. +This command is by default bound to the '<Delete>' function key +(a.k.a. '<deletechar>'). When invoked without a prefix argument or +with a positive prefix numeric argument, the command will now delete +complete grapheme clusters produced by character composition. For +example, if point is before an Emoji sequence, pressing '<Delete>' +will delete the entire sequence, not just a single character at its +beginning. + ++++ +** 'load-history' does not treat autoloads specially any more. +An autoload definition appears just as a '(defun . NAME)' and the +'(t . NAME)' entries are not generated any more. + +--- +** The Tamil input methods no longer insert Tamil digits. +The input methods 'tamil-itrans' and 'tamil-inscript' no longer insert +the Tamil digits, as those digit characters are not used nowadays by +speakers of the Tamil language. To get back the previous behavior, +use the new 'tamil-itrans-digits' and 'tamil-inscript-digits' input +methods instead. + ++++ +** New variable 'current-time-list' governing default timestamp form. +Functions like 'current-time' now yield '(TICKS . HZ)' timestamps if +this new variable is nil. The variable defaults to t, which means +these functions default to timestamps of the forms '(HI LO US PS)', +'(HI LO US)' or '(HI LO)', which are less regular and less efficient. +This is part of a long-planned change first documented in Emacs 27. +Developers are encouraged to test timestamp-related code with this +variable set to nil, as it will default to nil in a future Emacs +version and will be removed some time after that. + ++++ +** Functions that recreate the "*scratch*" buffer now also initialize it. +When functions like 'other-buffer' and 'server-execute' recreate +"*scratch*", they now also insert 'initial-scratch-message' and set +the major mode according to 'initial-major-mode', like at Emacs +startup. Previously, these functions ignored +'initial-scratch-message' and left "*scratch*" in 'fundamental-mode'. + +--- +** Naming of Image-Dired thumbnail files has changed. +Names of thumbnail files generated when 'image-dired-thumbnail-storage' +is 'image-dired' now always end in ".jpg". This fixes various issues +on different platforms, but means that thumbnails generated in Emacs 28 +will not be used in Emacs 29, and vice-versa. If disk space is an +issue, consider deleting the 'image-dired-dir' directory (usually +"~/.emacs.d/image-dired/") after upgrading to Emacs 29. + +--- +** The 'rlogin' method in the URL library is now obsolete. +Emacs will now display a warning if you request a URL like +"rlogin://foo@example.org". + +--- +** Setting 'url-gateway-method' to 'rlogin' is now obsolete. +Emacs will now display a warning when setting it to that value. +The user options 'url-gateway-rlogin-host', +'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name' +are also obsolete. + +--- +** The user function 'url-irc-function' now takes a SCHEME argument. +The user option 'url-irc-function' is now called with a sixth argument +corresponding to the scheme portion of the target URL. For example, +this would be "ircs" for a URL like "ircs://irc.libera.chat". + +--- +** The linum.el library is now obsolete. +We recommend using either the built-in 'display-line-numbers-mode', or +the 'nlinum' package from GNU ELPA instead. The former has better +performance, but the latter is closer to a drop-in replacement. + +1. To use 'display-line-numbers-mode', add something like this to your + Init file: + + (global-display-line-numbers-mode 1) + ;; Alternatively, to use it only in programming modes: + (add-hook 'prog-mode-hook #'display-line-numbers-mode) + +2. To use 'nlinum', add this to your Init file: + + (package-install 'nlinum) + (global-nlinum-mode 1) + ;; Alternatively, to use it only in programming modes: + (add-hook 'prog-mode-hook #'nlinum-mode) + +3. To continue using the obsolete package 'linum', add this line to + your Init file, in addition to any existing customizations: + + (require 'linum) + +--- +** The thumbs.el library is now obsolete. +We recommend using command 'image-dired' instead. + +--- +** The autoarg.el library is now marked obsolete. +This library provides the 'autoarg-mode' and 'autoarg-kp-mode' minor +modes to emulate the behavior of the historical editor Twenex Emacs. +We believe it is no longer useful. + +--- +** The quickurl.el library is now obsolete. +Use 'abbrev', 'skeleton' or 'tempo' instead. + +--- +** The rlogin.el library, and the 'rsh' command are now obsolete. +Use something like 'M-x shell RET ssh <host> RET' instead. + +--- +** The url-about.el library is now obsolete. + +--- +** The autoload.el library is now obsolete. +It is superseded by the new loaddefs-gen.el library. + +--- +** The netrc.el library is now obsolete. +Use the 'auth-source-netrc-parse-all' function in auth-source.el +instead. + +--- +** The url-dired.el library is now obsolete. + +--- +** The fast-lock.el and lazy-lock.el libraries have been removed. +They have been obsolete since Emacs 22.1. + +The variable 'font-lock-support-mode' is occasionally useful for +debugging purposes. It is now a regular variable (instead of a user +option) and can be set to nil to disable Just-in-time Lock mode. + ++++ +** The 'utf-8-auto' coding-system now produces BOM on encoding. +This is actually a bugfix, since this is how 'utf-8-auto' was +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 +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. + +In general, this coding-system should probably never be used for +encoding, only for decoding. + + +* Changes in Emacs 29.1 + ++++ +** New user option 'major-mode-remap-alist' to specify favorite major modes. +This user option lets you remap the default modes (e.g. 'perl-mode' or +'latex-mode') to your favorite ones (e.g. 'cperl-mode' or +'LaTeX-mode') without having to use 'defalias', which can have +undesirable side effects. +This applies to all modes specified via 'auto-mode-alist', file-local +variables, etc. + +--- +** Emacs now supports Unicode Standard version 15.0. + +--- +** New user option 'electric-quote-replace-consecutive'. + +--- +** Emacs is now capable of editing files with very long lines. +The display of long lines has been optimized, and Emacs should no +longer choke when a buffer on display contains long lines. The +variable 'long-line-threshold' controls whether and when these display +optimizations are in effect. + +A companion variable 'large-hscroll-threshold' controls when another +set of display optimizations are in effect, which are aimed +specifically at speeding up display of long lines that are truncated +on display. + +If you still experience slowdowns while editing files with long lines, +this may be due to line truncation, or to one of the enabled minor +modes, or to the current major mode. Try turning off line truncation +with 'C-x x t', or try disabling all known slow minor modes with +'M-x so-long-minor-mode', or try disabling both known slow minor modes +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'. + +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. + ++++ +** New command to change the font size globally. +To increase the font size, type 'C-x C-M-+' or 'C-x C-M-='; to +decrease it, type 'C-x C-M--'; to restore the font size, type 'C-x +C-M-0'. The final key in these commands may be repeated without the +leading 'C-x' and without the modifiers, e.g. 'C-x C-M-+ C-M-+ C-M-+' +and 'C-x C-M-+ + +' increase the font size by three steps. When +'mouse-wheel-mode' is enabled, 'C-M-wheel-up' and 'C-M-wheel-down' also +increase and decrease the font size globally. Additionally, the +user option 'global-text-scale-adjust-resizes-frames' controls whether +the frames are resized when the font size is changed. + +--- +** New config variable 'syntax-wholeline-max' to reduce the cost of long lines. +This variable is used by some operations (mostly syntax-propertization +and font-locking) to treat lines longer than this variable as if they +were made up of various smaller lines. This can help reduce the +slowdowns seen in buffers made of a single long line, but can also +cause misbehavior in the presence of such long lines (though most of +that misbehavior should usually be limited to mis-highlighting). You +can recover the previous behavior with: + + (setq syntax-wholeline-max most-positive-fixnum) + +--- +** New bindings in 'find-function-setup-keys' for 'find-library'. +When 'find-function-setup-keys' is enabled, 'C-x L' is now bound to +'find-library', 'C-x 4 L' is now bound to 'find-library-other-window' +and 'C-x 5 L' is now bound to 'find-library-other-frame'. + ++++ +** New key binding after 'M-x' or 'M-X': 'M-X'. +Emacs allows different completion predicates to be used with 'M-x' +(i.e., 'execute-extended-command') via the +'read-extended-command-predicate' user option. Emacs also has the +'M-X' (note upper case X) command, which only displays commands +especially relevant to the current buffer. Emacs now allows toggling +between these modes while the user is inputting a command by hitting +'M-X' while in the minibuffer. + +--- +** Interactively, 'kill-buffer' will now offer to save the buffer if unsaved. + +--- +** New commands 'duplicate-line' and 'duplicate-dwim'. +'duplicate-line' duplicates the current line the specified number of times. +'duplicate-dwim' duplicates the region if it is active. If not, it +works like 'duplicate-line'. An active rectangular region is +duplicated on its right-hand side. + +--- +** Files with the ".eld" extension are now visited in 'lisp-data-mode'. + ++++ +** 'network-lookup-address-info' can now check numeric IP address validity. +Specifying 'numeric' as the new optional HINTS argument makes it +check if the passed address is a valid IPv4/IPv6 address (without DNS +traffic). + + (network-lookup-address-info "127.1" 'ipv4 'numeric) + => ([127 0 0 1 0]) + ++++ +** New command 'find-sibling-file'. +This command jumps to a file considered a "sibling file", which is +determined according to the new user option 'find-sibling-rules'. + ++++ +** New user option 'delete-selection-temporary-region'. +When non-nil, 'delete-selection-mode' will only delete the temporary +regions (usually set by mouse-dragging or shift-selection). + ++++ +** New user option 'switch-to-prev-buffer-skip-regexp'. +This should be a regexp or a list of regexps; buffers whose names +match those regexps will be ignored by 'switch-to-prev-buffer' and +'switch-to-next-buffer'. + ++++ +** New command 'rename-visited-file'. +This command renames the file visited by the current buffer by moving +it to a new name or location, and also makes the buffer visit this new +file. + +** Menus + +--- +*** The entries following the buffers in the "Buffers" menu can now be altered. +Change the 'menu-bar-buffers-menu-command-entries' variable to alter +the entries that follow the buffer list. + +--- +** 'delete-process' is now a command. +When called interactively, it will kill the process running in the +current buffer (if any). This can be useful if you have runaway +output in the current buffer (from a process or a network connection), +and want to stop it. + ++++ +** New command 'restart-emacs'. +This is like 'save-buffers-kill-emacs', but instead of just killing +the current Emacs process at the end, it starts a new Emacs process +(using the same command line arguments as the running Emacs process). +'kill-emacs' and 'save-buffers-kill-emacs' have also gained new +optional arguments to restart instead of just killing the current +process. + +** Drag and Drop + ++++ +*** New user option 'mouse-drag-mode-line-buffer'. +If non-nil, dragging on the buffer name part of the mode-line will +drag the buffer's associated file to other programs. This option is +currently only available on X, Haiku and Nextstep (GNUstep or macOS). + ++++ +*** New user option 'mouse-drag-and-drop-region-cross-program'. +If non-nil, this option allows dragging text in the region from Emacs +to another program. + +--- +*** New user option 'mouse-drag-and-drop-region-scroll-margin'. +If non-nil, this option allows scrolling a window while dragging text +around without a scroll wheel. + ++++ +*** The value of 'mouse-drag-copy-region' can now be the symbol 'non-empty'. +This prevents mouse drag gestures from putting empty strings onto the +kill ring. + ++++ +*** New user options 'dnd-indicate-insertion-point' and 'dnd-scroll-margin'. +These options allow adjusting point and scrolling a window when +dragging items from another program. + ++++ +*** The X Direct Save (XDS) protocol is now supported. +This means dropping an image or file link from programs such as +Firefox will no longer create a temporary file in a random directory, +instead asking you where to save the file first. + ++++ +** New user option 'record-all-keys'. +If non-nil, this option will force recording of all input keys, +including those typed in response to passwords prompt (this was the +previous behavior). The default is nil, which inhibits recording of +passwords. + ++++ +** New function 'command-query'. +This function makes its argument command prompt the user for +confirmation before executing. + ++++ +** The 'disabled' property of a command's symbol can now be a list. +The first element of the list should be the symbol 'query', which will +cause the command disabled this way prompt the user with a y/n or a +yes/no question before executing. The new function 'command-query' is +a convenient method of making commands disabled in this way. + +--- +** 'count-words' will now report buffer totals if given a prefix. +Without a prefix, it will only report the word count for the narrowed +part of the buffer. + ++++ +** 'count-words' will now report sentence count when used interactively. + ++++ +** New user option 'set-message-functions'. +It allows selecting more functions for 'set-message-function' +in addition to the default function that handles messages +in the active minibuffer. The most useful are 'inhibit-message' +that allows specifying a list of messages to inhibit via +'inhibit-message-regexps', and 'set-multi-message' that +accumulates recent messages and displays them stacked +in the echo area. + +--- +** New user option 'find-library-include-other-files'. +If set to nil, commands like 'find-library' will only include library +files in the completion candidates. The default is t, which preserves +previous behavior, whereby non-library files could also be included. + ++++ +** New command 'sqlite-mode-open-file' for examining an sqlite3 file. +This uses the new 'sqlite-mode' which allows listing the tables in a +DB file, and examining and modifying the columns and the contents of +those tables. + +--- +** 'write-file' will now copy some file mode bits. +If the current buffer is visiting a file that is executable, the +'C-x C-w' command will now make the new file executable, too. + ++++ +** New user option 'process-error-pause-time'. +This determines how long to pause Emacs after a process +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-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'. +This face is like 'variable-pitch' (from which it inherits), but is +slightly larger, which should help with the visual size differences +between the default, non-proportional font and proportional fonts when +mixed. + ++++ +** New face 'mode-line-active'. +This inherits from the 'mode-line' face, but is the face actually used +on the mode lines (along with 'mode-line-inactive'). + ++++ +** New face attribute pseudo-value 'reset'. +This value stands for the value of the corresponding attribute of the +'default' face. It can be used to reset attribute values produced by +inheriting from other faces. + ++++ +** New X resource: "borderThickness". +This controls the thickness of the external borders of the menu bars +and pop-up menus. + ++++ +** New X resource: "inputStyle". +This controls the style of the pre-edit and status areas of X input +methods. + ++++ +** New X resources: "highlightForeground" and "highlightBackground". +Only in the Lucid build, this controls colors used for highlighted +menu item widgets. + ++++ +** On X, Emacs now tries to synchronize window resize with the window manager. +This leads to less flicker and empty areas of a frame being displayed +when a frame is being resized. Unfortunately, it does not work on +some ancient buggy window managers, so if Emacs appears to freeze, but +is still responsive to input, you can turn it off by setting the X +resource "synchronizeResize" to "off". + ++++ +** On X, Emacs can optionally synchronize display with the graphics hardware. +When this is enabled by setting the X resource "synchronizeResize" to +"extended", frame content "tearing" is drastically reduced. This is +only supported on the Motif, Lucid, and no-toolkit builds, and +requires an X compositing manager supporting the extended frame +synchronization protocol (see +https://fishsoup.net/misc/wm-spec-synchronization.html). + +This behavior can be toggled on and off via the frame parameter +'use-frame-synchronization'. + ++++ +** New frame parameter 'alpha-background' and X resource "alphaBackground". +This controls the opacity of the text background when running on a +composited display. + ++++ +** New frame parameter 'shaded'. +With window managers which support this, it controls whether or not a +frame's contents will be hidden, leaving only the title bar on display. + +--- +** New user option 'x-gtk-use-native-input'. +This controls whether or not GTK input methods are used by Emacs, +instead of XIM input methods. + ++++ +** New user option 'use-system-tooltips'. +This controls whether to use the toolkit tooltips, or Emacs's own +native implementation of tooltips as small frames. This option is +only meaningful if Emacs was built with GTK+, Nextstep, or Haiku +support, and defaults to t, which makes Emacs use the toolkit +tooltips. The existing GTK-specific option +'x-gtk-use-system-tooltips' is now an alias of this new option. + ++++ +** Non-native tooltips are now supported on Nextstep. +This means Emacs built with GNUstep or built on macOS is now able to +display different faces and images inside tooltips when the +'use-system-tooltips' user option is nil. + +--- +** New minor mode 'pixel-scroll-precision-mode'. +When enabled, and if your mouse supports it, you can scroll the +display up or down at pixel resolution, according to what your mouse +wheel reports. Unlike 'pixel-scroll-mode', this mode scrolls the +display pixel-by-pixel, as opposed to only animating line-by-line +scrolls. + +** Terminal Emacs + +--- +*** Emacs will now use 24-bit colors on terminals that support "Tc" capability. +This is in addition to previously-supported ways of discovering 24-bit +color support: either via the "RGB" or "setf24" capabilities, or if +the 'COLORTERM' environment variable is set to the value "truecolor". + +--- +*** Select active regions with xterm selection support. +On terminals with xterm "setSelection" support, the active region may be +saved to the X primary selection, following the +'select-active-regions' variable. This support is enabled when +'tty-select-active-regions' is non-nil. + +--- +*** New command to set up display of unsupported characters. +The new command 'standard-display-by-replacement-char' produces Lisp +code that sets up the 'standard-display-table' to use a replacement +character for display of characters that the text-mode terminal +doesn't support. This code is intended to be used in your init files. +This feature is most useful with the Linux console and similar +terminals, where Emacs has a reliable way of determining which +characters have glyphs in the font loaded into the terminal's memory. + +--- +*** New functions to set terminal output buffer size. +The new functions 'tty--set-output-buffer-size' and +'tty--output-buffer-size' allow setting and retrieving the output +buffer size of a terminal device. The default buffer size is and has +always been BUFSIZ, which is defined in your system's stdio.h. When +you set a buffer size with 'tty--set-output-buffer-size', this also +prevents Emacs from explicitly flushing the tty output stream, except +at the end of display update. + +** ERT + ++++ +*** New ERT variables 'ert-batch-print-length' and 'ert-batch-print-level'. +These variables will override 'print-length' and 'print-level' when +printing Lisp values in ERT batch test results. + +--- +*** Redefining an ERT test in batch mode now signals an error. +Executing 'ert-deftest' with the same name as an existing test causes +the previous definition to be discarded, which was probably not +intended when this occurs in batch mode. To remedy the error, rename +tests so that they all have unique names. + ++++ +*** ERT can generate JUnit test reports. +When environment variable 'EMACS_TEST_JUNIT_REPORT' is set, ERT +generates a JUnit test report under this file name. This is useful +for Emacs integration into CI/CD test environments. + +--- +*** Unbound test symbols now signal an 'ert-test-unbound' error. +This affects the 'ert-select-tests' function and its callers. + +** Emoji + ++++ +*** Emacs now has several new methods for inserting Emoji. +The Emoji commands are under the new 'C-x 8 e' prefix. + ++++ +*** New command 'emoji-insert' (bound to 'C-x 8 e e' and 'C-x 8 e i'). +This command guides you through various Emoji categories and +combinations in a graphical menu system. + ++++ +*** New command 'emoji-search' (bound to 'C-x 8 e s'). +This command lets you search for Emoji based on names. + ++++ +*** New command 'emoji-list' (bound to 'C-x 8 e l'). +This command lists all Emoji (categorized by themes) in a special +buffer and lets you choose one of them. + +--- +*** New command 'emoji-recent' (bound to 'C-x 8 e r'). +This command lets you choose among the Emoji you have recently +inserted. + ++++ +*** New command 'emoji-describe' (bound to 'C-x 8 e d'). +This command will tell you the name of the Emoji at point. (It also +works for non-Emoji characters.) + +--- +*** New commands 'emoji-zoom-increase' and 'emoji-zoom-decrease'. +These are bound to 'C-x 8 e +' and 'C-x 8 e -', respectively. They +can be used on any character, but are mainly useful for Emoji. + +--- +*** New input method 'emoji'. +This allows you to enter Emoji using short strings, eg ':face_palm:' +or ':scream:'. + +** Help + +--- +*** Variable values displayed by 'C-h v' in "*Help*" are now fontified. + ++++ +*** New user option 'help-clean-buttons'. +If non-nil, link buttons in "*Help*" buffers will have any surrounding +quotes removed. + +--- +*** 'M-x apropos-variable' output now includes values of variables. +Such apropos buffer is more easily viewed with outlining after +enabling 'outline-minor-mode' in 'apropos-mode'. + ++++ +*** New docstring syntax to indicate that symbols shouldn't be links. +When displaying docstrings in "*Help*" buffers, strings that are +"`like-this'" are made into links (if they point to a bound +function/variable). This can lead to false positives when talking +about values that are symbols that happen to have the same names as +functions/variables. To inhibit this buttonification, use the new +"\\+`like-this'" syntax. + ++++ +*** New user option 'help-window-keep-selected'. +If non-nil, commands to show the info manual and the source will reuse +the same window in which the "*Help*" buffer is shown. + +--- +*** Commands like 'C-h f' have changed how they describe menu bindings. +For instance, previously a command might be described as having the +following bindings: + + It is bound to <open>, C-x C-f, <menu-bar> <file> <new-file>. + +This has been changed to: + + It is bound to <open> and C-x C-f. + It can also be invoked from the menu: File → Visit New File... + ++++ +*** The 'C-h .' command now accepts a prefix argument. +'C-u C-h .' would previously inhibit displaying a warning message if +there's no local help at point. This has been changed to call +'button-describe'/'widget-describe' and display button/widget help +instead. + +--- +*** New user option 'help-enable-variable-value-editing'. +If enabled, 'e' on a value in "*Help*" will pop you to a new buffer +where you can edit the value. This is not enabled by default, because +it is easy to make an edit that yields an invalid result. + +--- +*** 'C-h b' uses outlining by default. +Set 'describe-bindings-outline' to nil to get back the old behavior. + +--- +*** Jumping to function/variable source now saves mark before moving point. +Jumping to source from a "*Help*" buffer moves point when the source +buffer is already open. Now, the old point is pushed onto mark ring. + ++++ +*** New key bindings in "*Help*" buffers: 'n' and 'p'. +These will take you (respectively) to the next and previous "page". + +--- +*** 'describe-char' now also outputs the name of Emoji sequences. + ++++ +*** New key binding in "*Help*" buffer: 'I'. +This will take you to the Emacs Lisp manual entry for the item +displayed, if any. + +--- +*** The 'C-h m' ('describe-mode') "*Help*" buffer has been reformatted. +It now only includes local minor modes at the start, and the global +minor modes are listed after the major mode. + ++++ +*** The user option 'help-window-select' now affects apropos commands. +The apropos commands will now select the apropos window if +'help-window-select' is non-nil. + +--- +*** 'describe-keymap' now considers the symbol at point. +If the symbol at point is a keymap, 'describe-keymap' suggests it as +the default candidate. + +--- +*** New command 'help-quick' displays an overview of common commands. +The command pops up a buffer at the bottom of the screen with a few +helpful commands for various tasks. You can toggle the display using +'C-h C-q'. + +** Emacs now comes with Org v9.6. +See the file "ORG-NEWS" for user-visible changes in Org. + +** Outline Mode + ++++ +*** Support for customizing the default visibility state of headings. +Customize the user option 'outline-default-state' to define what +headings will be visible initially, after Outline mode is turned on. +When the value is a number, the user option 'outline-default-rules' +determines the visibility of the subtree starting at the corresponding +level. Values are provided to control showing a heading subtree +depending on whether the heading matches a regexp, or on whether its +subtree has long lines or is itself too long. + +** Outline Minor Mode + ++++ +*** New user option 'outline-minor-mode-use-buttons'. +If non-nil, Outline Minor Mode will use buttons to hide/show outlines +in addition to the ellipsis. The default is nil, but in 'help-mode' +it has the value 'insert' that inserts the buttons directly into the +buffer, and you can use 'RET' to cycle outline visibility. When +the value is 'in-margins', Outline Minor Mode uses the window margins +for buttons that hide/show outlines. + ++++ +*** Buttons and headings now have their own keymaps. +'outline-button-icon-map', 'outline-overlay-button-map', and +'outline-inserted-button-map' are now available as defined keymaps +instead of being anonymous keymaps. + +** Windows + ++++ +*** New commands 'split-root-window-below' and 'split-root-window-right'. +These commands split the root window in two, and are bound to 'C-x w 2' +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 display action 'display-buffer-full-frame'. +This action removes other windows from the frame when displaying a +buffer on that frame. + ++++ +*** 'display-buffer' now can set up the body size of the chosen window. +For example, a 'display-buffer-alist' entry of + + (window-width . (body-columns . 40)) + +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. + +** Frames + ++++ +*** Deleted frames can now be undeleted. +The 16 most recently deleted frames can be undeleted with 'C-x 5 u' when +'undelete-frame-mode' is enabled. Without a prefix argument, undelete +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 + +--- +*** New user option 'tab-bar-auto-width' to automatically determine tab width. +This option is non-nil by default, which resizes tab-bar tabs so that +their width is evenly distributed across the tab bar. A companion +option 'tab-bar-auto-width-max' controls the maximum width of a tab +before its name on display is truncated. + +--- +*** 'C-x t RET' creates a new tab when the provided tab name doesn't exist. +It prompts for the name of a tab and switches to it, creating a new +tab if no tab exists by that name. + +--- +*** New keymap 'tab-bar-history-mode-map'. +By default, it contains 'C-c <left>' and 'C-c <right>' to browse +the history of tab window configurations back and forward. + +--- +** Better detection of text suspiciously reordered on display. +The function 'bidi-find-overridden-directionality' has been extended +to detect reordering effects produced by embeddings and isolates +(started by directional formatting control characters such as RLO and +LRI). The new command 'highlight-confusing-reorderings' finds and +highlights segments of buffer text whose reordering for display is +suspicious and could be malicious. + +** Emacs Server and Client + ++++ +*** New command-line option '-r'/'--reuse-frame' for emacsclient. +With this command-line option, Emacs reuses an existing graphical client +frame if one exists; otherwise it creates a new frame. + ++++ +*** New command-line option '-w N'/'--timeout=N' for emacsclient. +With this command-line option, emacsclient will exit if Emacs does not +respond within N seconds. The default is to wait forever. + ++++ +*** 'server-stop-automatically' can be used to automatically stop the server. +The Emacs server will be automatically stopped when certain conditions +are met. The conditions are given by the argument, which can be +'empty', 'delete-frame' or 'kill-terminal'. + +** Rcirc + ++++ +*** New command 'rcirc-when'. + ++++ +*** New user option 'rcirc-cycle-completion-flag'. +Rcirc will use the default 'completion-at-point' mechanism. The +conventional IRC behavior of completing by cycling through the +available options can be restored by enabling this option. + ++++ +*** New user option 'rcirc-bridge-bot-alist'. +If you are in a channel where a bot is responsible for bridging +between networks, you can use this variable to make these messages +appear more native. For example, you might set the option to: + + (setopt rcirc-bridge-bot-alist '(("bridge" . "{\\(.+?\\)}[[:space:]]+"))) + +for messages like + + 09:47 <bridge> {john} I am not on IRC + +to be reformatted into + + 09:47 <john> I am not on IRC + +--- +*** New formatting commands. +Most IRC clients (including rcirc) support basic formatting using +control codes. Under the 'C-c C-f' prefix a few commands have been +added to insert these automatically. For example, if a region is +active and 'C-c C-f C-b' is invoked, markup is inserted for the region +to be highlighted in bold. + +** Imenu + ++++ +*** 'imenu' is now bound to 'M-g i' globally. + +--- +*** New function 'imenu-flush-cache'. +Use it if you want Imenu to forget the buffer's index alist and +recreate it anew next time 'imenu' is invoked. + +--- +** Emacs is now capable of abandoning a window's redisplay that takes too long. +This is controlled by the new variable 'max-redisplay-ticks'. If that +variable is set to a non-zero value, display of a window will be +aborted after that many low-level redisplay operations, thus +preventing Emacs from becoming wedged when visiting files with very +long lines. The default is zero, which disables the feature: Emacs +will wait forever for redisplay to finish. (We believe you won't need +this feature, given the ability to display buffers with very long +lines.) + + +* Editing Changes in Emacs 29.1 + ++++ +** 'M-SPC' is now bound to 'cycle-spacing'. +Formerly it invoked 'just-one-space'. The actions performed by +'cycle-spacing' and their order can now be customized via the user +option 'cycle-spacing-actions'. + +--- +** 'zap-to-char' and 'zap-up-to-char' are case-sensitive for upper-case chars. +These commands now behave as case-sensitive for interactive calls when +they are invoked with an uppercase character, regardless of the value +of 'case-fold-search'. + +--- +** 'scroll-other-window' and 'scroll-other-window-down' now respect remapping. +These commands (bound to 'C-M-v' and 'C-M-V') used to scroll the other +windows without looking at customizations in that other window. These +functions now check whether they have been rebound in the buffer shown +in that other window, and then call the remapped function instead. In +addition, these commands now also respect the +'scroll-error-top-bottom' user option. + +--- +** Indentation of 'cl-flet' and 'cl-labels' has changed. +These forms now indent like this: + + (cl-flet ((bla (x) + (* x x))) + (bla 42)) + +This change also affects 'cl-macrolet', 'cl-flet*' and +'cl-symbol-macrolet'. + ++++ +** New user option 'translate-upper-case-key-bindings'. +Set this option to nil to inhibit the default translation of upper +case keys to their lower case variants. + ++++ +** New command 'ensure-empty-lines'. +This command increases (or decreases) the number of empty lines before +point. + +--- +** Improved mouse behavior with auto-scrolling modes. +When clicking inside the 'scroll-margin' or 'hscroll-margin' region, +point is now moved only when releasing the mouse button. This no +longer results in a bogus selection, unless the mouse has also been +dragged. + ++++ +** 'kill-ring-max' now defaults to 120. + +--- +** New user option 'yank-menu-max-items'. +Customize this option to limit the number of entries in the menu +"Edit → Paste from Kill Menu". The default is 60. + +--- +** New user option 'copy-region-blink-predicate'. +By default, when copying a region with 'kill-ring-save', Emacs only +blinks point and mark when the region is not denoted visually, that +is, when either the region is inactive, or the 'region' face is +indistinguishable from the 'default' face. + +Users who would rather enable blinking unconditionally can now set +this user option to 'always'. To disable blinking unconditionally, +either set this option to 'ignore', or set 'copy-region-blink-delay' +to 0. + ++++ +** Performing a pinch gesture on a touchpad now increases the text scale. + +** Show Paren Mode + ++++ +*** New user option 'show-paren-context-when-offscreen'. +When non-nil, if the point is in a closing delimiter and the opening +delimiter is offscreen, shows some context around the opening +delimiter in the echo area. The default is nil. + +This option can also be set to the symbols 'overlay' or 'child-frame', +in which case the context is shown in an overlay or child-frame at the +top-left of the current window. The latter option requires a +graphical frame. On non-graphical frames, the context is shown in the +echo area. + +** Comint + ++++ +*** 'comint-term-environment' is now aware of connection-local variables. +The user option 'comint-terminfo-terminal' and the variable +'system-uses-terminfo' can now be set as connection-local variables to +change the terminal used on a remote host. + +--- +*** New user option 'comint-delete-old-input'. +When nil, this prevents comint from deleting the current input when +inserting previous input using '<mouse-2>'. The default is t, to +preserve previous behavior. + +--- +*** New minor mode 'comint-fontify-input-mode'. +This minor mode is enabled by default in "*shell*" and "*ielm*" +buffers. It fontifies input text according to 'shell-mode' or +'emacs-lisp-mode' font-lock rules. Customize the user options +'shell-fontify-input-enable' and 'ielm-fontify-input-enable' to nil if +you don't want to enable input fontification by default. + +** Mwheel + +--- +*** New user options for alternate wheel events. +The user options 'mouse-wheel-down-alternate-event' and +'mouse-wheel-up-alternate-event' as well as the variables +'mouse-wheel-left-alternate-event' and +'mouse-wheel-right-alternate-event' have been added to better support +systems where two kinds of wheel events can be received. + +** Internationalization + +--- +*** The '<Delete>' function key now allows deleting the entire composed sequence. +For the details, see the item about the 'delete-forward-char' command +above. + +--- +*** New user option 'composition-break-at-point'. +Setting it to a non-nil value temporarily disables automatic +composition of character sequences at point, and thus makes it easier +to edit such sequences by allowing point to "enter" the composed +sequence. + +--- +*** Support for many old scripts and writing systems. +Emacs now supports, and has language-environments and input methods, +for several dozens of old scripts that were used in the past for +various languages. For each such script Emacs now has font-selection +and character composition rules, a language environment, and an input +method. The newly-added scripts and the corresponding language +environments are: + + Tai Tham script and the Northern Thai language environment + + Brahmi script and language environment + + Kaithi script and language environment + + Tirhuta script and language environment + + Sharada script and language environment + + Siddham script and language environment + + Syloti Nagri script and language environment + + Modi script and language environment + + Baybayin script and Tagalog language environment + + Hanunoo script and language environment + + Buhid script and language environment + + Tagbanwa script and language environment + + Limbu script and language environment + + Balinese script and language environment + + Javanese script and language environment + + Sundanese script and language environment + + Batak script and language environment + + Rejang script and language environment + + Makasar script and language environment + + Lontara script and language environment + + Hanifi Rohingya script and language environment + + Grantha script and language environment + + Kharoshthi script and language environment + + Lepcha script and language environment + + Meetei Mayek script and language environment + + Adlam script and language environment + + Mende Kikakui script and language environment + + Wancho script and language environment + + Toto script and language environment + + Gothic script and language environment + + Coptic script and language environment + +--- +*** The "Oriya" language environment was renamed to "Odia". +This is to follow the change in the official name of the script. The +'oriya' input method was also renamed to 'odia'. However, the old +name of the language environment and the input method are still +supported. + +--- +*** New Greek translation of the Emacs tutorial. +Type 'C-u C-h t' to select it in case your language setup does not do +so automatically. + +--- +*** New Ukrainian translation of the Emacs Tutorial. + +--- +*** New default phonetic input method for the Tamil language environment. +The default input method for the Tamil language environment is now +"tamil-phonetic" which is a customizable phonetic input method. To +change the input method's translation rules, customize the user option +'tamil-translation-rules'. + +--- +*** New 'tamil99' input method for the Tamil language. +This supports the keyboard layout specifically designed for the Tamil +language. + +--- +*** New input method 'slovak-qwerty'. +This is a variant of the 'slovak' input method, which corresponds to +the QWERTY Slovak keyboards. + +--- +*** New input method 'cyrillic-chuvash'. +This input method is based on the russian-computer input method, and +is intended for typing in the Chuvash language written in the Cyrillic +script. + + +* Changes in Specialized Modes and Packages in Emacs 29.1 + +** Ecomplete + +--- +*** New commands 'ecomplete-edit' and 'ecomplete-remove'. +These allow you to (respectively) edit and bulk-remove entries from +the ecomplete database. + +--- +*** New user option 'ecomplete-auto-select'. +If non-nil and there's only one matching option, auto-select that. + +--- +*** New user option 'ecomplete-filter-regexp'. +If non-nil, this user option describes what entries not to add to the +database stored on disk. + +** Auth Source + ++++ +*** New user option 'auth-source-pass-extra-query-keywords'. +Whether to recognize additional keyword params, like ':max' and +':require', as well as accept lists of query terms paired with +applicable keywords. This disables most known behavioral quirks +unique to auth-source-pass, such as wildcard subdomain matching. + +** Dired + ++++ +*** 'dired-guess-shell-command' moved from dired-x to dired. +This means that 'dired-do-shell-command' will now provide smarter +defaults without first having to require 'dired-x'. See the node +"(emacs) Shell Command Guessing" in the Emacs manual for more details. + +--- +*** 'dired-clean-up-buffers-too' moved from dired-x to dired. +This means that Dired now offers to kill buffers visiting files and +dirs when they are deleted in Dired. Before, you had to require +'dired-x' to enable this behavior. To disable this behavior, +customize the user option 'dired-clean-up-buffers-too' to nil. The +related user option 'dired-clean-confirm-killing-deleted-buffers' +(which see) has also been moved to 'dired'. + ++++ +*** 'dired-do-relsymlink' moved from dired-x to dired. +The corresponding key 'Y' is now bound by default in Dired. + ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key sequence '% 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-info' and 'dired-man' moved from dired-x to dired. +The 'dired-info' and 'dired-man' commands have been moved from the +dired-x package to dired. They have also been renamed to +'dired-do-info' and 'dired-do-man'; the old command names are obsolete +aliases. + +The keys 'I' ('dired-do-info') and 'N' ('dired-do-man') are now bound +in Dired mode by default. The user options 'dired-bind-man' and +'dired-bind-info' no longer have any effect and are obsolete. + +To get the old behavior back and unbind these keys in Dired mode, add +the following to your Init file: + + (with-eval-after-load 'dired + (keymap-set dired-mode-map "N" nil) + (keymap-set dired-mode-map "I" nil)) + +--- +*** New command 'dired-do-eww'. +This command visits the file on the current line with EWW. + +--- +*** New user option 'dired-omit-lines'. +This is used by 'dired-omit-mode', and now allows you to hide based on +other things than just the file names. + ++++ +*** New user option 'dired-mouse-drag-files'. +If non-nil, dragging file names with the mouse in a Dired buffer will +initiate a drag-and-drop session allowing them to be opened in other +programs. + ++++ +*** New user option 'dired-free-space'. +Dired will now, by default, include the free space in the first line +instead of having it on a separate line. To get the previous behavior +back, say: + + (setopt dired-free-space 'separate) + +--- +*** New user option 'dired-make-directory-clickable'. +If non-nil (which is the default), hitting 'RET' or 'mouse-1' on +the directory components at the directory displayed at the start of +the buffer will take you to that directory. + +--- +*** Search and replace in Dired/Wdired supports more regexps. +For example, the regexp ".*" will match only characters that are part +of the file name. Also "^.*$" can be used to match at the beginning +of the file name and at the end of the file name. This is used only +when searching on file names. In Wdired this can be used when the new +user option 'wdired-search-replace-filenames' is non-nil (which is the +default). + +** Elisp + +--- +*** New command 'elisp-eval-region-or-buffer' (bound to 'C-c C-e'). +This command evals the forms in the active region or in the whole buffer. + +--- +*** New commands 'elisp-byte-compile-file' and 'elisp-byte-compile-buffer'. +These commands (bound to 'C-c C-f' and 'C-c C-b', respectively) +byte-compile the visited file and the current buffer, respectively. + +** Games + +--- +*** New user option 'tetris-allow-repetitions'. +This controls how randomness is implemented (whether to use pure +randomness as before, or to use a bag). + +** Battery + ++++ +*** New user option 'battery-update-functions'. +This can be used to trigger actions based on the battery status. + +** DocView + +--- +*** doc-view can now generate SVG images when viewing PDF files. +If Emacs is built with SVG support, doc-view can generate SVG files +when using MuPDF as the converter for PDF files, which generally leads +to sharper images (especially when zooming), and allows customization +of background and foreground color of the page via the new user +options 'doc-view-svg-background' and 'doc-view-svg-foreground'. To +activate this behavior, set 'doc-view-mupdf-use-svg' to non-nil if +your Emacs has SVG support. Note that, with some versions of MuPDF, +SVG generation is known to sometimes produce SVG files that are buggy +or can take a long time to render. + +** Enriched Mode + ++++ +*** New command 'enriched-toggle-markup'. +This allows you to see the markup in 'enriched-mode' buffers (e.g., +the "HELLO" file). + +** Shell Script Mode + +--- +*** New user option 'sh-indent-statement-after-and'. +This controls how statements like the following are indented: + + foo && + bar + +*** New Flymake backend using the ShellCheck program. +It is enabled by default, but requires that the external "shellcheck" +command is installed. + +** CC Mode + +--- +*** C++ Mode now supports most of the new features in the C++20 Standard. + +--- +*** In Objective-C Mode, no extra types are recognized by default. +The default value of 'objc-font-lock-extra-types' has been changed to +nil, since too many identifiers were getting misfontified as types. +This may cause some actual types not to get fontified. To get the old +behavior back, customize the user option to the value suggested in its +doc string. + +** Cperl Mode + +--- +*** New user option 'cperl-file-style'. +This option determines the indentation style to be used. It can also +be used as a file-local variable. + +** Gud + +--- +*** 'gud-go' is now bound to 'C-c C-v'. +If given a prefix, it will prompt for an argument to use for the +run/continue command. + +--- +*** 'perldb' now recognizes '-E'. +As of Perl 5.10, 'perl -E 0' behaves like 'perl -e 0' but also activates +all optional features of the Perl version in use. 'perldb' now uses +this invocation as its default. + +** Customize + +--- +*** New command 'custom-toggle-hide-all-widgets'. +This is bound to 'H' and toggles whether to hide or show the widget +contents. + +** Diff Mode + +--- +*** New user option 'diff-whitespace-style'. +Sets the value of the buffer-local variable 'whitespace-style' in +'diff-mode' buffers. By default, this variable is '(face trailing)', +which preserves behavior of previous Emacs versions. + ++++ +*** New user option 'diff-add-log-use-relative-names'. +If non-nil insert file names in ChangeLog skeletons relative to the +VC root directory. + +** Ispell + +--- +*** 'ispell-region' and 'ispell-buffer' now push the mark. +These commands push onto the mark ring the location of the last +misspelled word where corrections were offered, so that you can then +skip back to that location with 'C-x C-x'. + +** Dabbrev + +--- +*** New function 'dabbrev-capf' for use on 'completion-at-point-functions'. + ++++ +*** New user option 'dabbrev-ignored-buffer-modes'. +Buffers with major modes in this list will be ignored. By default, +this includes "binary" buffers like 'archive-mode' and 'image-mode'. + +** Package + ++++ +*** New command 'package-update'. +This command allows you to upgrade packages without using 'M-x +list-packages'. + ++++ +*** New command 'package-update-all'. +This command allows updating all packages without any queries. + ++++ +*** New commands 'package-recompile' and 'package-recompile-all'. +These commands can be useful if the ".elc" files are out of date +(invalid byte code and macros). + ++++ +*** New DWIM action on 'x' in "*Packages*" buffer. +If no packages are marked, 'x' will install the package under point if +it isn't already, and remove it if it is installed. + ++++ +*** New command 'package-vc-install'. +Packages can now be installed directly from source by cloning from +their repository. + ++++ +*** New command 'package-vc-install-from-checkout'. +An existing checkout can now be loaded via package.el, by creating a +symbolic link from the usual package directory to the checkout. + ++++ +*** New command 'package-vc-checkout'. +Used to fetch the source of a package by cloning a repository without +activating the package. + ++++ +*** New command 'package-vc-prepare-patch'. +This command allows you to send patches to package maintainers, for +packages checked out using 'package-vc-install'. + ++++ +*** New command 'package-report-bug'. +This command helps you compose an email for sending bug reports to +package maintainers. + ++++ +*** New user option 'package-vc-selected-packages'. +By customizing this user option you can specify specific packages to +install. + +** Emacs Sessions (Desktop) + ++++ +*** New user option to load a locked desktop if locking Emacs is not running. +The option 'desktop-load-locked-desktop' can now be set to the value +'check-pid', which means to allow loading a locked ".emacs.desktop" +file if the Emacs process which locked it is no longer running on the +local machine. This allows avoiding questions about locked desktop +files when the Emacs session which locked it crashes, or was otherwise +interrupted and didn't exit gracefully. See the "(emacs) Saving +Emacs Sessions" node in the Emacs manual for more details. + +** Miscellaneous + ++++ +*** New command 'scratch-buffer'. +This command switches to the "*scratch*" buffer. If "*scratch*" doesn't +exist, the command creates it first. You can use this command if you +inadvertently delete the "*scratch*" buffer. + +** Debugging + +--- +*** 'q' in a "*Backtrace*" buffer no longer clears the buffer. +Instead it just buries the buffer and switches the mode from +'debugger-mode' to 'backtrace-mode', since commands like 'e' are no +longer available after exiting the recursive edit. + ++++ +*** New user option 'debug-allow-recursive-debug'. +This user option controls whether the 'e' (in a "*Backtrace*" +buffer or while edebugging) and 'C-x C-e' (while edebugging) commands +lead to a (further) backtrace. By default, this variable is nil, +which is a change in behavior from previous Emacs versions. + ++++ +*** 'e' in edebug can now take a prefix arg to pretty-print the results. +When invoked with a prefix argument, as in 'C-u e', this command will +pop up a new buffer and show the full pretty-printed value there. + ++++ +*** 'C-x C-e' now interprets a non-zero prefix arg to pretty-print the results. +When invoked with a non-zero prefix argument, as in 'C-u C-x C-e', +this command will pop up a new buffer and show the full pretty-printed +value there. + ++++ +*** You can now generate a backtrace from Lisp errors in redisplay. +To do this, set the new variable 'backtrace-on-redisplay-error' to a +non-nil value. The backtrace will be written to a special buffer +named "*Redisplay-trace*". This buffer will not be automatically +displayed in a window. + +** Compile + ++++ +*** New user option 'compilation-hidden-output'. +This can be used to make specific parts of compilation output +invisible. + ++++ +*** The 'compilation-auto-jump-to-first-error' user option has been extended. +It can now have the additional values 'if-location-known' (which will +only jump if the location of the first error is known), and +'first-known' (which will jump to the first known error location). + ++++ +*** New user option 'compilation-max-output-line-length'. +Lines longer than the value of this option will have their ends +hidden, with a button to reveal the hidden text. This speeds up +operations like grepping on files that have few newlines. The default +value is 400; set to nil to disable hiding. + +** Flymake + ++++ +*** New user option 'flymake-mode-line-lighter'. + ++++ +** New minor mode 'word-wrap-whitespace-mode' for extending 'word-wrap'. +This mode switches 'word-wrap' on, and breaks on all the whitespace +characters instead of just 'SPC' and 'TAB'. + +--- +** New mode, 'emacs-news-mode', for editing the NEWS file. +This mode adds some highlighting, makes the 'M-q' command aware of the +format of NEWS entries, and has special commands for doing maintenance +of the Emacs NEWS files. In addition, this mode turns on +'outline-minor-mode', and thus displays customizable icons (see +'icon-preference') in the margins. To disable these icons, set +'outline-minor-mode-use-buttons' to a nil value. + +--- +** Kmacro +Kmacros are now OClosures and have a new constructor 'kmacro' which +uses the 'key-parse' syntax. It replaces the old 'kmacro-lambda-form' +(which is now declared obsolete). + +--- +** savehist.el can now truncate variables that are too long. +An element of user option 'savehist-additional-variables' can now be +of the form '(VARIABLE . MAX-ELTS)', which means to truncate the +VARIABLE's value to at most MAX-ELTS elements (if the value is a list) +before saving the value. + +** Minibuffer and Completions + ++++ +*** New commands for navigating completions from the minibuffer. +When the minibuffer is the current buffer, typing 'M-<up>' or +'M-<down>' selects a previous/next completion candidate from the +"*Completions*" buffer and inserts it to the minibuffer. +When the user option 'minibuffer-completion-auto-choose' is nil, +'M-<up>' and 'M-<down>' do the same, but without inserting +a completion candidate to the minibuffer, then 'M-RET' can be used +to choose the currently active candidate from the "*Completions*" +buffer and exit the minibuffer. With a prefix argument, 'C-u M-RET' +inserts the currently active candidate to the minibuffer, but doesn't +exit the minibuffer. These keys are also available for in-buffer +completion, but they don't insert candidates automatically, you need +to type 'M-RET' to insert the selected candidate to the buffer. + ++++ +*** Choosing a completion with a prefix argument doesn't exit the minibuffer. +This means that typing 'C-u RET' on a completion candidate in the +"*Completions*" buffer inserts the completion into the minibuffer, +but doesn't exit the minibuffer. + ++++ +*** The "*Completions*" buffer can now be automatically selected. +To enable this behavior, customize the user option +'completion-auto-select' to t, then pressing 'TAB' will switch to the +"*Completions*" buffer when it pops up that buffer. If the value is +'second-tab', then the first 'TAB' will display "*Completions*", and +the second one will switch to the "*Completions*" buffer. + +--- +*** New user option 'completion-auto-wrap'. +When non-nil, the commands 'next-completion' and 'previous-completion' +automatically wrap around on reaching the beginning or the end of +the "*Completions*" buffer. + ++++ +*** New values for the 'completion-auto-help' user option. +There are two new values to control the way the "*Completions*" buffer +behaves after pressing a 'TAB' if completion is not unique. The value +'always' updates or shows the "*Completions*" buffer after any attempt +to complete. The value 'visual' is like 'always', but only updates +the completions if they are already visible. The default value t +always hides the completion buffer after some completion is made. + +--- +*** New commands to complete the minibuffer history. +'minibuffer-complete-history' ('C-x <up>') is like 'minibuffer-complete' +but completes on the history items instead of the default completion +table. 'minibuffer-complete-defaults' ('C-x <down>') completes +on the list of default items. + ++++ +*** User option 'minibuffer-eldef-shorten-default' is now obsolete. +Customize the user option 'minibuffer-default-prompt-format' instead. + ++++ +*** New user option 'completions-sort'. +This option controls the sorting of the completion candidates in +the "*Completions*" buffer. Available styles are no sorting, +alphabetical (the default), or a custom sort function. + ++++ +*** New user option 'completions-max-height'. +This option limits the height of the "*Completions*" buffer. + ++++ +*** New user option 'completions-header-format'. +This is a string to control the header line to show in the +"*Completions*" buffer before the list of completions. +If it contains "%s", that is replaced with the number of completions. +If nil, the header line is not shown. + ++++ +*** New user option 'completions-highlight-face'. +When this user option names a face, the current +candidate in the "*Completions*" buffer is highlighted with that face. +The nil value disables this highlighting. The default is to highlight +using the 'completions-highlight' face. + ++++ +*** You can now define abbrevs for the minibuffer modes. +'minibuffer-mode-abbrev-table' and +'minibuffer-inactive-mode-abbrev-table' are now defined. + +** Isearch and Replace + ++++ +*** Changes in how Isearch responds to 'mouse-yank-at-point'. +If a user does 'C-s' and then uses '<mouse-2>' ('mouse-yank-primary') +outside the echo area, Emacs will, by default, end the Isearch and +yank the text at mouse cursor. But if 'mouse-yank-at-point' is +non-nil, the text will now be added to the Isearch instead. + ++++ +*** Changes for values 'no' and 'no-ding' of 'isearch-wrap-pause'. +Now with these values the search will wrap around not only on repeating +with 'C-s C-s', but also after typing a character. + ++++ +*** New user option 'char-fold-override'. +Non-nil means that the default definitions of equivalent characters +are overridden. + +*** New command 'describe-char-fold-equivalences'. +It displays character equivalences used by 'char-fold-to-regexp'. + ++++ +*** New command 'isearch-emoji-by-name'. +It is bound to 'C-x 8 e RET' during an incremental search. The +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 + ++++ +*** New minor mode 'glyphless-display-mode'. +This allows an easy way to toggle seeing all glyphless characters in +the current buffer. + +--- +*** The extra slot of 'glyphless-char-display' can now have cons values. +The extra slot of the 'glyphless-char-display' char-table can now have +values that are cons cells, specifying separate values for text-mode +and GUI terminals. + ++++ +*** "Replacement character" feature for undisplayable characters on TTYs. +The 'acronym' method of displaying glyphless characters on text-mode +frames treats single-character acronyms specially: they are displayed +without the surrounding '[..]' "box", thus in effect treating such +"acronyms" as replacement characters. + +** Registers + ++++ +*** Buffer names can now be stored in registers. +For instance, to enable jumping to the "*Messages*" buffer with +'C-x r j m': + + (set-register ?m '(buffer . "*Messages*")) + +** Pixel Fill + ++++ +*** This is a new package that deals with filling variable-pitch text. + ++++ +*** New function 'pixel-fill-region'. +This fills the region to be no wider than a specified pixel width. + +** Info + ++++ +*** Command 'info-apropos' now takes a prefix argument to search for regexps. + +--- +*** New command 'Info-goto-node-web' and key binding 'G'. +This will take you to the "gnu.org" web server's version of the current +info node. This command only works for the Emacs and Emacs Lisp manuals. + +** Shortdoc + +--- +*** New command 'shortdoc-copy-function-as-kill' bound to 'w'. +It copies the name of the function near point into the kill ring. + +--- +*** 'N' and 'P' are now bound to 'shortdoc-{next,previous}-section'. +This is in addition to the old keybindings 'C-c C-n' and 'C-c C-p'. + +** VC + +--- +*** New command 'vc-pull-and-push'. +This commands first does a "pull" command, and if that is successful, +does a "push" command afterwards. Currently supported in Git and Bzr. + ++++ +*** 'C-x v b' prefix key is used now for branch commands. +'vc-print-branch-log' is bound to 'C-x v b l', and new commands are +'vc-create-branch' ('C-x v b c') and 'vc-switch-branch' ('C-x v b s'). +The VC Directory buffer now uses the prefix 'b' for these branch-related +commands. + ++++ +*** New command 'vc-dir-mark-by-regexp' bound to '% m' and '* %'. +This command marks files based on a regexp. If given a prefix +argument, unmark instead. + ++++ +*** New command 'C-x v !' ('vc-edit-next-command'). +This prefix command requests editing of the next VC shell command +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 +changes you have in your working tree. Begin by creating a buffer +with the changes against the last commit, e.g. with 'C-x v D' +('vc-root-diff'). Then edit the diffs to remove the hunks you don't +want to commit. Finally, type 'C-x v v' in that diff buffer to commit +only part of your changes, those whose hunks were left in the buffer. + +--- +*** 'C-x v v' on an unregistered file will now use the most specific backend. +Previously, if you had an SVN-covered "~/" directory, and a Git-covered +directory in "~/foo/bar", using 'C-x v v' on a new, unregistered file +"~/foo/bar/zot" would register it in the SVN repository in "~/" instead of +in the Git repository in "~/foo/bar". This makes this command +consistent with 'vc-responsible-backend'. + +--- +*** Log Edit now fontifies long Git commit summary lines. +Writing shorter summary lines avoids truncation in contexts in which +Git commands display summary lines. See the two new user options +'vc-git-log-edit-summary-target-len' and 'vc-git-log-edit-summary-max-len'. + +--- +*** New 'log-edit-headers-separator' face. +It is used to style the line that separates the 'log-edit' headers +from the 'log-edit' summary. + +--- +*** The function 'vc-read-revision' accepts a new MULTIPLE argument. +If non-nil, multiple revisions can be queried. This is done using +'completing-read-multiple'. + +--- +*** New function 'vc-read-multiple-revisions'. +This function invokes 'vc-read-revision' with a non-nil value for +MULTIPLE. + ++++ +*** New command 'vc-prepare-patch'. +Patches for any version control system can be prepared using VC. The +command will query what commits to send and will compose messages for +your mail user agent. The behavior of 'vc-prepare-patch' can be +modified by the user options 'vc-prepare-patches-separately' and +'vc-default-patch-addressee'. + +** Message + +--- +*** New user option 'mml-attach-file-at-the-end'. +If non-nil, 'C-c C-a' will put attached files at the end of the message. + +--- +*** Message Mode now supports image yanking. + ++++ +*** New user option 'message-server-alist'. +This controls automatic insertion of the "X-Message-SMTP-Method" +header before sending a message. + +** HTML Mode + +--- +*** HTML Mode now supports "text/html" and "image/*" yanking. + +** Texinfo Mode + +--- +*** 'texinfo-mode' now has a specialized 'narrow-to-defun' definition. +It narrows to the current node. + +** EUDC + ++++ +*** Deprecations planned for next release. +After Emacs 29.1, some aspects of EUDC will be deprecated. The goal +of these deprecations is to simplify EUDC server configuration by +making 'eudc-server-hotlist' the only place to add servers. There +will not be a need to set the server using the 'eudc-set-server' +command. Instead, the 'eudc-server-hotlist' user option should be +customized to have an entry for the server. The plan is to obsolete +the 'eudc-hotlist' package since Customize is sufficient for changing +'eudc-server-hotlist'. How the 'eudc-server' user option works in this +context is to-be-determined; it can't be removed, because that would +break compatibility, but it may become synchronized with +'eudc-server-hotlist' so that 'eudc-server' is always equal to '(car +eudc-server-hotlist)'. The first entry in 'eudc-server-hotlist' is the +first server tried by 'eudc-expand-try-all'. The hotlist +simplification will allow 'eudc-query-form' to show a drop down of +possible servers, instead of requiring a call to 'eudc-set-server' +like it does in this release. The default value of +'eudc-ignore-options-file' will be changed from nil to t. + ++++ +*** New user option 'eudc-ignore-options-file' that defaults to nil. +The 'eudc-ignore-options-file' user option can be configured to ignore +the 'eudc-options-file' (typically "~/.emacs.d/eudc-options"). Most +users should configure this to t and put EUDC configuration in the +main Emacs initialization file ("~/.emacs" or "~/.emacs.d/init.el"). + ++++ +*** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'. +The user option 'eudc-expansion-overwrites-query' is renamed to +'eudc-expansion-save-query-as-kill' to reflect the actual behavior of +the user option. The former is kept as alias. + ++++ +*** New command 'eudc-expand-try-all'. +This command can be used in place of 'eudc-expand-inline'. It takes a +prefix argument that causes 'eudc-expand-try-all' to return matches +from all servers instead of just the matches from the first server to +return any. This is useful for example, if one wants to search LDAP +for a name that happens to match a contact in one's BBDB. + ++++ +*** New behavior and default for user option 'eudc-inline-expansion-format'. +EUDC inline expansion result formatting defaulted to + + ("%s %s <%s>" firstname name email) + +Since email address specifications need to comply with RFC 5322 in +order to be useful in messages, there was a risk to produce syntax +which was standard with RFC 822, but is marked as obsolete syntax by +its successor RFC 5322. Also, the first and last name part was never +enclosed in double quotes, potentially producing invalid address +specifications, which may be rejected by a receiving MTA. Thus, this +variable can now additionally be set to nil (the new default), or a +function. In both cases, the formatted result will be in compliance +with RFC 5322. When set to nil, a default format very similar to the +old default will be produced. When set to a function, that function +is called, and the returned values are used to populate the phrase and +comment parts (see RFC 5322 for definitions). In both cases, the +phrase part will be automatically quoted if necessary. + ++++ +*** New function 'eudc-capf-complete' with 'message-mode' integration. +EUDC can now contribute email addresses to 'completion-at-point' by +adding the new function 'eudc-capf-complete' to +'completion-at-point-functions' in 'message-mode'. + ++++ +*** Additional attributes of query and results in eudcb-macos-contacts.el. +The EUDC back-end for the macOS Contacts app now provides a wider set +of attributes to use for queries, and delivers more attributes in +query results. + ++++ +*** New back-end for ecomplete. +A new back-end for ecomplete allows information from that database to +be queried by EUDC, too. The attributes present in the EUDC query are +used to select the entry type in the ecomplete database. + ++++ +*** New back-end for mailabbrev. +A new back-end for mailabbrev allows information from that database to +be queried by EUDC, too. The attributes 'email', 'name', and 'firstname' +are supported only. + +** EWW/SHR + ++++ +*** New user option to automatically rename EWW buffers. +The 'eww-auto-rename-buffer' user option can be configured to rename +rendered web pages by using their title, URL, or a user-defined +function which returns a string. For the first two cases, the length +of the resulting name is controlled by the user option +'eww-buffer-name-length'. By default, no automatic renaming is +performed. + ++++ +*** New user option 'shr-allowed-images'. +This complements 'shr-blocked-images', but allows specifying just the +allowed images. + ++++ +*** New user option 'shr-use-xwidgets-for-media'. +If non-nil (and Emacs has been built with support for xwidgets), +display <video> elements with an xwidget. Note that this is +experimental; it is known to crash Emacs on some systems, and just +doesn't work on other systems. Also see etc/PROBLEMS. + ++++ +*** New user option 'eww-url-transformers'. +These are used to alter an URL before using it. By default it removes +the common "utm_" trackers from URLs. + +** Find Dired + +--- +*** New command 'find-dired-with-command'. +This enables users to run 'find-dired' with an arbitrary command, +enabling running commands previously unsupported and also enabling new +commands to be built on top. + +** Gnus + ++++ +*** Tool bar changes in Gnus/Message. +There were previously two styles of tool bars available in Gnus and +Message, referred to as 'gnus-summary-tool-bar-retro', +'gnus-group-tool-bar-retro' and 'message-tool-bar-retro', and +'gnus-summary-tool-bar-gnome', 'gnus-group-tool-bar-gnome' and +'message-tool-bar-gnome'. The "retro" tool bars have been removed (as +well as the icons used), and the "gnome" tool bars are now the only +pre-defined toolbars. + +--- +*** 'gnus-summary-up-thread' and 'gnus-summary-down-thread' bindings removed. +The 'gnus-summary-down-thread' binding to 'M-C-d' was shadowed by +'gnus-summary-read-document', and these commands are also available on +'T u' and 'T d' respectively. + +--- +*** Gnus now uses a variable-pitch font in the headers by default. +To get the monospace font back, you can put something like the +following in your ".gnus" file: + + (set-face-attribute 'gnus-header nil :inherit 'unspecified) + +--- +*** The default value of 'gnus-treat-fold-headers' is now 'head'. + +--- +*** New face 'gnus-header'. +All other 'gnus-header-*' faces inherit from this face now. + ++++ +*** New user option 'gnus-treat-emojize-symbols'. +If non-nil, symbols that have an Emoji representation will be +displayed as emojis. The default is nil. + ++++ +*** New command 'gnus-article-emojize-symbols'. +This is bound to 'W D e' and will display symbols that have Emoji +representation as Emoji. + ++++ +*** New mu backend for gnus-search. +Configuration is very similar to the notmuch and namazu backends. It +supports the unified search syntax. + +--- +*** 'gnus-html-image-cache-ttl' is now a seconds count. +Formerly it was a pair of numbers '(A B)' that represented 65536*A + B, +to cater to older Emacs implementations that lacked bignums. +The older form still works but is undocumented. + +** Rmail + +--- +*** Rmail partial summaries can now be applied one on top of the other. +You can now narrow the set of messages selected by Rmail summary's +criteria (recipients, topic, senders, etc.) by making a summary of the +already summarized messages. For example, invoking +'rmail-summary-by-senders', followed by 'rmail-summary-by-topic' will +produce a summary where both the senders and the topic are according +to your selection. The new user option +'rmail-summary-progressively-narrow' controls whether the stacking of +the filters is in effect; customize it to a non-nil value to enable +this feature. + +--- +*** New Rmail summary: by thread. +The new command 'rmail-summary-by-thread' produces a summary of +messages that belong to a single thread of discussion. + +** EIEIO + ++++ +*** 'slot-value' can now be used to access slots of 'cl-defstruct' objects. + +** Align + +--- +*** Alignment in 'text-mode' has changed. +Previously, 'M-x align' didn't do anything, and you had to say 'C-u +M-x align' for it to work. This has now been changed. The default +regexp for 'C-u M-x align-regexp' has also been changed to be easier +for inexperienced users to use. + +** Help + +--- +*** New mode, 'emacs-news-view-mode', for viewing the NEWS file. +This mode is used by the 'C-h N' command, and adds buttons to manual +entries and symbol references. + +--- +*** New user option 'help-link-key-to-documentation'. +When this option is non-nil (which is the default), key bindings +displayed in the "*Help*" buffer will be linked to the documentation +for the command they are bound to. This does not affect listings of +key bindings and functions (such as 'C-h b'). + +** Info Look + +--- +*** info-look specs can now be expanded at run time instead of a load time. +The new ':doc-spec-function' element can be used to compute the +':doc-spec' element when the user asks for info on that particular +mode (instead of at load time). + +** Ansi Color + +--- +*** Support for ANSI 256-color and 24-bit colors. +256-color and 24-bit color codes are now handled by ANSI color +filters and displayed with the specified color. + +** Term Mode + +--- +*** New user option 'term-bind-function-keys'. +If non-nil, 'term-mode' will pass the function keys on to the +underlying shell instead of using the normal Emacs bindings. + +--- +*** Support for ANSI 256-color and 24-bit colors, italic and other fonts. +'term-mode' can now display 256-color and 24-bit color codes. It can +also handle ANSI codes for faint, italic and blinking text, displaying +it with new 'term-{faint,italic,slow-blink,fast-blink}' faces. + +** Project + ++++ +*** 'project-find-file' and 'project-or-external-find-file' can include all. +The commands 'project-find-file' and 'project-or-external-find-file' +now accept a prefix argument, which is interpreted to mean "include +all files". + ++++ +*** New command 'project-list-buffers' bound to 'C-x p C-b'. +This command displays a list of buffers from the current project. + ++++ +*** 'project-kill-buffers' can display the list of buffers to kill. +Customize the user option 'project-kill-buffers-display-buffer-list' +to enable the display of the buffer list. + +*** New user option 'project-vc-extra-root-markers'. +Use it to add detection of nested projects (inside a VCS repository), +or projects outside of VCS repositories. + +As a consequence, the 'VC project backend' is formally renamed to +'VC-aware project backend'. + ++++ +*** New user option 'project-vc-include-untracked'. +If non-nil, files untracked by a VCS are considered to be part of +the project by a VC project based on that VCS. + +** Xref + ++++ +*** New command 'xref-go-forward'. +It is bound to 'C-M-,' and jumps to the location where you previously +invoked 'xref-go-back' ('M-,', also known as 'xref-pop-marker-stack'). + ++++ +*** The depth of the Xref marker stack is now infinite. +The implementation of the Xref marker stack was changed in a way that +allows as many places to be saved on the stack as needed, limited only +by the available memory. Therefore, the variables +'find-tag-marker-ring-length' and 'xref-marker-ring-length' are now +obsolete and unused; setting them has no effect. + ++++ +*** 'xref-query-replace-in-results' prompting change. +This command no longer prompts for FROM when called without prefix +argument. This makes the most common case faster: replacing entire +matches. + ++++ +*** New command 'xref-find-references-and-replace' to rename one identifier. + +--- +*** New variable 'xref-current-item' (renamed from a private version). + +--- +*** New function 'xref-show-xrefs'. + +*** 'outline-minor-mode' is supported in Xref buffers. +You can enable outlining by adding 'outline-minor-mode' to +'xref-after-update-hook'. + +** File Notifications + ++++ +*** The new command 'file-notify-rm-all-watches' removes all file notifications. + +** Sql + +--- +*** Sql now supports sending of passwords in-process. +To improve security, if an sql product has ':password-in-comint' set +to t, a password supplied via the minibuffer will be sent in-process, +as opposed to via the command-line. + +** Image Mode + ++++ +*** New command 'image-transform-fit-to-window'. +This command fits the image to the current window by scaling down or +up as necessary. Unlike 'image-transform-fit-both', this does not +only scale the image down, but up as well. It is bound to 's w' in +Image Mode by default. + +--- +*** New command 'image-mode-wallpaper-set'. +This command sets the desktop background to the current image. It is +bound to 'W' by default. + ++++ +*** 'image-transform-fit-to-{height,width}' are now obsolete. +Use the new command 'image-transform-fit-to-window' instead. +The keybinding for 'image-transform-fit-to-width' is now 's i'. + +--- +*** User option 'image-auto-resize' can now be set to 'fit-window'. +This works like 'image-transform-fit-to-window'. + +--- +*** New user option 'image-auto-resize-max-scale-percent'. +The new 'fit-window' option will never scale an image more than this +much (in percent). It is nil by default, which means no limit. + +--- +*** New user option 'image-text-based-formats'. +This controls whether or not to show a message when opening certain +image formats saying how to edit it as text. The default is to show +this message for SVG and XPM. + ++++ +*** New commands: 'image-flip-horizontally' and 'image-flip-vertically'. +These commands horizontally and vertically flip the image under point, +and are bound to 'i h' and 'i v', respectively. + ++++ +*** New command 'image-transform-set-percent'. +It allows setting the image size to a percentage of its original size, +and is bound to 's p' in Image mode. + ++++ +*** 'image-transform-original' renamed to 'image-transform-reset-to-original'. +The old name was confusing, and is now an obsolete function alias. + ++++ +*** 'image-transform-reset' renamed to 'image-transform-reset-to-initial'. +The old name was confusing, and is now an obsolete function alias. + +** Images + ++++ +*** Users can now add special image conversion functions. +This is done via 'image-converter-add-handler'. + +** Image Dired + ++++ +*** 'image-dired-image-mode' is now based on 'image-mode'. +This avoids converting images in the background, and makes Image-Dired +noticeably faster. New keybindings from 'image-mode' are now +available in the "*image-dired-display-image*" buffer; press '?' or +'h' in that buffer to see the full list. + +--- +*** Navigation and marking commands now work in image display buffer. +The following new bindings have been added: +- 'n', 'SPC' => 'image-dired-display-next' +- 'p', 'DEL' => 'image-dired-display-previous' +- 'm' => 'image-dired-mark-thumb-original-file' +- 'd' => 'image-dired-flag-thumb-original-file' +- 'u' => 'image-dired-unmark-thumb-original-file' + +--- +*** New command 'image-dired-unmark-all-marks'. +It removes all marks from all files in the thumbnail and the +associated Dired buffer, and is bound to 'U' in the thumbnail and +display buffer. + +--- +*** New command 'image-dired-do-flagged-delete'. +It deletes all flagged files, and is bound to 'x' in the thumbnail +buffer. It replaces the command 'image-dired-delete-marked', which is +now an obsolete alias. + +--- +*** New command 'image-dired-copy-filename-as-kill'. +It copies the name of the marked or current image to the kill ring, +and is bound to 'w' in the thumbnail buffer. + +--- +*** New command 'image-dired-wallpaper-set'. +This command sets the desktop background to the image at point in the +thumbnail buffer. It is bound to 'W' by default. + +--- +*** 'image-dired-slideshow-start' is now bound to 'S'. +It is bound in both the thumbnail and display buffer, and no longer +prompts for a timeout; use a numerical prefix (e.g. 'C-u 8 S') to set +the timeout. + +--- +*** New user option 'image-dired-marking-shows-next'. +If this option is non-nil (the default), marking, unmarking or +flagging an image in either the thumbnail or display buffer shows the +next image. + +--- +*** New face 'image-dired-thumb-flagged'. +If 'image-dired-thumb-mark' is non-nil (the default), this face is +used for images that are flagged for deletion in the Dired buffer +associated with Image-Dired. + +--- +*** Image information is now shown in the header line of the thumbnail buffer. +This replaces the message that most navigation commands in the +thumbnail buffer used to show at the bottom of the screen. + +--- +*** New specifiers for 'image-dired-display-properties-format'. +This is used to format the new header line. The new specifiers are: +"%d" for the name of the directory that the file is in, "%n" for +file's number in the thumbnail buffer, and "%s" for the file size. + +The default format has been updated to use this. If you prefer the +old format, add this to your Init file: + + (setopt image-dired-display-properties-format "%b: %f (%t): %c") + +--- +*** New faces for the header line of the thumbnail buffer. +These faces correspond to different parts of the header line, as +specified in 'image-dired-display-properties-format': +- 'image-dired-thumb-header-directory-name' +- 'image-dired-thumb-header-file-name' +- 'image-dired-thumb-header-file-size' +- 'image-dired-thumb-header-image-count' + +--- +*** PDF support. +Image-Dired now displays thumbnails for PDF files. Type 'RET' on a +PDF file in the thumbnail buffer to visit the corresponding PDF. + +--- +*** Support GraphicsMagick command line tools. +Support for the GraphicsMagick command line tool ("gm") has been +added, and is used when it is available instead of ImageMagick. + +--- +*** Support Thumbnail Managing Standard v0.9.0 (Dec 2020). +This standard allows sharing generated thumbnails across different +programs. Version 0.9.0 adds two larger thumbnail sizes: 512x512 and +1024x1024 pixels. See the user option 'image-dired-thumbnail-storage' +to use it; it is not enabled by default. + +--- +*** Reduce dependency on external "exiftool" program. +The 'image-dired-copy-with-exif-file-name' command no longer requires +an external "exiftool" program to be available. The user options +'image-dired-cmd-read-exif-data-program' and +'image-dired-cmd-read-exif-data-options' are now obsolete. + +--- +*** Support for bookmark.el. +The command 'bookmark-set' (bound to 'C-x r m') is now supported in +the thumbnail view, and will create a bookmark that opens the current +directory in Image-Dired. + +--- +*** The 'image-dired-slideshow-start' command no longer prompts. +It no longer inconveniently prompts for a number of images and a +delay: it runs indefinitely, but stops automatically on any command. +You can set the delay with a prefix argument, or a negative prefix +argument to prompt for a delay. Customize the user option +'image-dired-slideshow-delay' to change the default from 5 seconds. + ++++ +*** 'image-dired-show-all-from-dir-max-files' increased to 1000. +This user option controls asking for confirmation when starting +Image-Dired in a directory with many files. Since Image-Dired creates +thumbnails in the background in recent versions, this is not as +important as it used to be. You can now also customize this option to +nil to disable this confirmation completely. + +--- +*** 'image-dired-thumb-size' increased to 128. + ++++ +*** 'image-dired-db-file' renamed to 'image-dired-tags-db-file'. + +--- +*** 'image-dired-display-image-mode' renamed to 'image-dired-image-mode'. +The corresponding keymap is now named 'image-dired-image-mode-map'. + ++++ +*** Some commands have been renamed to be shorter. +- 'image-dired-display-thumbnail-original-image' has been renamed to + 'image-dired-display-this'. +- 'image-dired-display-next-thumbnail-original' has been renamed to + 'image-dired-display-next'. +- 'image-dired-display-previous-thumbnail-original' has been renamed + to 'image-dired-display-previous'. +The old names are now obsolete aliases. + +--- +*** 'image-dired-thumb-{height,width}' are now obsolete. +Customize 'image-dired-thumb-size' instead, which will set both the +height and width. + +--- +*** HTML image gallery generation is now obsolete. +The 'image-dired-gallery-generate' command and these user options are +now obsolete: 'image-dired-gallery-thumb-image-root-url', +'image-dired-gallery-hidden-tags', 'image-dired-gallery-dir', +'image-dired-gallery-image-root-url'. + +--- +*** 'image-dired-rotate-thumbnail-{left,right}' are now obsolete. +Instead, use commands 'image-dired-refresh-thumb' to generate a new +thumbnail, or 'image-rotate' to rotate the thumbnail without updating +the thumbnail file. + ++++ +*** Some commands and user options are now obsolete. +Since 'image-dired-display-image-mode' is now based on 'image-mode', +some commands and user options are no longer needed and are now obsolete: +'image-dired-cmd-create-temp-image-options', +'image-dired-cmd-create-temp-image-program', +'image-dired-display-current-image-full', +'image-dired-display-current-image-sized', +'image-dired-display-window-height-correction', +'image-dired-display-window-width-correction', +'image-dired-temp-image-file'. + +** Exif + +--- +*** New function 'exif-field'. +This is a convenience function to extract the field data from +'exif-parse-file' and 'exif-parse-buffer'. + +** Bookmarks + +--- +*** 'list-bookmarks' now includes a type column. +Types are registered via a 'bookmark-handler-type' symbol property on +the jumping function. + ++++ +*** 'bookmark-sort-flag' can now be set to 'last-modified'. +This will display bookmark list from most recently set to least +recently set. + +--- +*** When editing a bookmark annotation, 'C-c C-k' will now cancel. +It is bound to the new command 'bookmark-edit-annotation-cancel'. + +--- +*** New user option 'bookmark-fringe-mark'. +This option controls the bitmap used to indicate bookmarks in the +fringe (or nil to disable showing this marker). + +** Xwidget + +--- +*** New user option 'xwidget-webkit-buffer-name-format'. +This option controls how xwidget-webkit buffers are named. + +--- +*** New user option 'xwidget-webkit-cookie-file'. +This option controls whether the xwidget-webkit buffers save cookies +set by web pages, and if so, in which file to save them. + ++++ +*** New minor mode 'xwidget-webkit-edit-mode'. +When this mode is enabled, self-inserting characters and other common +web browser shortcut keys are redefined to send themselves to the +WebKit widget. + ++++ +*** New minor mode 'xwidget-webkit-isearch-mode'. +This mode acts similarly to incremental search, and allows searching +the contents of a WebKit widget. In xwidget-webkit mode, it is bound +to 'C-s' and 'C-r'. + ++++ +*** New command 'xwidget-webkit-browse-history'. +This command displays a buffer containing the page load history of +the current WebKit widget, and allows you to navigate it. + +--- +*** On X, the WebKit inspector is now available inside xwidgets. +To access the inspector, right click on the widget and select "Inspect +Element". + +--- +*** "Open in New Window" in a WebKit widget's context menu now works. +The newly created buffer will be displayed via 'display-buffer', which +can be customized through the usual mechanism of 'display-buffer-alist' +and friends. + +** Tramp + ++++ +*** New connection methods "docker", "podman" and "kubernetes". +They allow accessing containers provided by Docker and similar +programs. + +--- +*** Tramp supports abbreviating remote home directories now. +When calling 'abbreviate-file-name' on a Tramp file name, the result +will abbreviate the user's home directory, for example by abbreviating +"/ssh:user@host:/home/user" to "/ssh:user@host:~". + ++++ +*** New user option 'tramp-use-scp-direct-remote-copying'. +When set to non-nil, Tramp does not copy files between two remote +hosts via a local copy in its temporary directory, but lets the 'scp' +command do this job. + ++++ +*** Proper password prompts for methods "doas", "sudo" and "sudoedit". +The password prompts for these methods reflect now the credentials of +the user requesting such a connection, and not of the user who is the +target. This has always been needed, just the password prompt and the +related 'auth-sources' entry were wrong. + ++++ +*** New user option 'tramp-completion-use-cache'. +During user and host name completion in the minibuffer, results from +Tramp's connection cache are taken into account. This can be disabled +by setting the user option 'tramp-completion-use-cache' to nil. + +** Browse URL + +--- +*** New user option 'browse-url-default-scheme'. +This user option decides which URL scheme that 'browse-url' and +related functions will use by default. For example, you could +customize this to "https" to always prefer HTTPS URLs. + +--- +*** New user option 'browse-url-irc-function'. +This option specifies a function for opening "irc://" links. It +defaults to the new function 'browse-url-irc'. + +--- +*** New function 'browse-url-irc'. +This multipurpose autoloaded function can be used for opening "irc://" +and "ircs://" URLS by any caller that passes a URL string as an initial +arg. + +--- +*** Support for the Netscape web browser has been removed. +This support has been obsolete since Emacs 25.1. The final version of +the Netscape web browser was released in February, 2008. + +--- +*** Support for the Galeon web browser has been removed. +This support has been obsolete since Emacs 25.1. The final version of +the Galeon web browser was released in September, 2008. + +--- +*** Support for the Mozilla web browser is now obsolete. +Note that this historical web browser is different from Mozilla +Firefox; it is its predecessor. + +** Python Mode + ++++ +*** Project shells and a new user option 'python-shell-dedicated'. +When called with a prefix argument, 'run-python' now offers the choice +of creating a shell dedicated to the current project. This shell runs +in the project root directory and is shared among all project buffers. + +Without a prefix argument, the kind of shell (buffer-dedicated, +project-dedicated or global) is specified by the new +'python-shell-dedicated' user option. + +** Ruby Mode + +--- +*** New user option 'ruby-toggle-block-space-before-parameters'. + +--- +*** Support for endless methods. + +--- +*** New user options that determine indentation logic. +'ruby-method-params-indent', 'ruby-block-indent', +'ruby-after-operator-indent', 'ruby-method-call-indent', +'ruby-parenless-call-arguments-indent'. See the docstrings for +explanations and examples. + +** Eshell + ++++ +*** New feature to easily bypass Eshell's own pipelining. +Prefixing '|', '<' or '>' with an asterisk, i.e. '*|', '*<' or '*>', +will cause the whole command to be passed to the operating system +shell. This is particularly useful to bypass Eshell's own pipelining +support for pipelines which will move a lot of data. See section +"Running Shell Pipelines Natively" in the Eshell manual, node +"(eshell) Pipelines". + ++++ +*** New module to help supplying absolute file names to remote commands. +After enabling the new 'eshell-elecslash' module, typing a forward +slash as the first character of a command line argument will +automatically insert the Tramp prefix. The automatic insertion +applies only when 'default-directory' is remote and the command is a +Lisp function. This frees you from having to keep track of whether +commands are Lisp function or external when supplying absolute file +name arguments. See the "(eshell) Electric forward slash" node in the +Eshell manual for details. + ++++ +*** Improved support for redirection operators in Eshell. +Eshell now supports a wider variety of redirection operators. For +example, you can now redirect both stdout and stderr via '&>' or +duplicate one output handle to another via 'NEW-FD>&OLD-FD'. For more +information, see the "(eshell) Redirection" node in the Eshell manual. + ++++ +*** New eshell built-in command 'doas'. +The privilege-escalation program 'doas' has been added to the existing +'su' and 'sudo' commands from the 'eshell-tramp' module. The external +command may still be accessed by using '*doas'. + ++++ +*** Double-quoting an Eshell expansion now treats the result as a single string. +If an Eshell expansion like '$FOO' is surrounded by double quotes, the +result will always be a single string, no matter the type that would +otherwise be returned. + ++++ +*** Concatenating Eshell expansions now works more similarly to other shells. +When concatenating an Eshell expansion that returns a list, "adjacent" +elements of each operand are now concatenated together, +e.g. '$(list "a" "b")c' returns '("a" "bc")'. See the "(eshell) +Expansion" node in the Eshell manual for more details. + ++++ +*** Eshell subcommands with multiline numeric output return lists of numbers. +If every line of the output of an Eshell subcommand like '${COMMAND}' +is numeric, the result will be a list of numbers (or a single number +if only one line of output). Previously, this only converted numbers +when there was a single line of output. + +--- +*** Built-in Eshell commands now follow Posix/GNU argument syntax conventions. +Built-in commands in Eshell now accept command-line options with +values passed as a single token, such as '-oVALUE' or +'--option=VALUE'. New commands can take advantage of this with the +'eshell-eval-using-options' macro. See "Defining new built-in +commands" in the "(eshell) Built-ins" node of the Eshell manual. + +--- +*** Eshell globs ending with "/" now match only directories. +Additionally, globs ending with "**/" or "***/" no longer raise an +error, and now expand to all directories recursively (following +symlinks in the latter case). + ++++ +*** Lisp forms in Eshell now treat a nil result as a failed exit status. +When executing a command that looks like '(lisp form)' and returns +nil, Eshell will set the exit status (available in the '$?' +variable) to 2. This allows commands like that to be used in +conditionals. To change this behavior, customize the new +'eshell-lisp-form-nil-is-failure' user option. + +** Shell + +--- +*** New user option 'shell-kill-buffer-on-exit'. +Enabling this will automatically kill a "*shell*" buffer as soon as +the shell session terminates. + +--- +*** New minor mode 'shell-highlight-undef-mode'. +Customize 'shell-highlight-undef-enable' to t if you want to enable +this minor mode in "*shell*" buffers. It will highlight undefined +commands with a warning face as you type. + +** Calc + ++++ +*** New user option 'calc-kill-line-numbering'. +Set it to nil to exclude line numbering from kills and copies. + +** Hierarchy + ++++ +*** Tree Display can delay computation of children. +'hierarchy-add-tree' and 'hierarchy-add-trees' have an optional +argument which allows tree-widget display to be activated and computed +only when the user expands the node. + +** Proced + +--- +*** proced.el shows system processes of remote hosts. +When 'default-directory' is remote, and 'proced' is invoked with a +negative argument like 'C-u - proced', the system processes of that +remote host are shown. Alternatively, the user option +'proced-show-remote-processes' can be set to non-nil. +'proced-signal-function' has been marked obsolete. + +--- +*** Proced can now optionally show process details in color. +New user option 'proced-enable-color-flag' enables coloring of Proced +buffers. This option is disabled by default; customize it to a +non-nil value to enable colors. + +** Miscellaneous + +--- +*** New user option 'webjump-use-internal-browser'. +When non-nil, WebJump will use an internal browser to open web pages, +instead of the default external browser. + ++++ +*** New user option 'font-lock-ignore'. +This option provides a mechanism to selectively disable font-lock +keyword-driven fontifications. + +--- +*** New user option 'auto-save-visited-predicate'. +This user option is a predicate function which is called by +'auto-save-visited-mode' to decide whether or not to save a buffer. +You can use it to automatically save only specific buffers, for +example buffers using a particular mode or in some directory. + +--- +*** New user option 'remote-file-name-inhibit-auto-save-visited'. +If this user option is non-nil, 'auto-save-visited-mode' will not +auto-save remote buffers. The default is nil. + ++++ +*** New package vtable.el for formatting tabular data. +This package allows formatting data using variable-pitch fonts. +The resulting tables can display text in variable pitch fonts, text +using fonts of different sizes, and images. See the "(vtable) Top" +manual for more details. + +--- +*** New minor mode 'elide-head-mode'. +Enabling this minor mode turns on hiding header material, like +'elide-head' does; disabling it shows the header. The commands +'elide-head' and 'elide-head-show' are now obsolete. + +*** New package ansi-osc.el. +Support for OSC ("Operating System Command") escape sequences has been +extracted from comint.el in order to provide interpretation of OSC +sequences in compilation buffers. + +Adding the new function 'ansi-osc-compilation-filter' to +'compilation-filter-hook' enables interpretation of OSC escape +sequences in compilation buffers. By default, all sequences are +filtered out. + +The list of handlers (already covering OSC 7 and 8) has been extended +with a handler for OSC 2, the command to set a window title. + +--- +*** 'recentf-mode' now uses abbreviated file names by default. +This means that e.g. "/home/foo/bar" is now displayed as "~/bar". +Customize the user option 'recentf-filename-handlers' to nil to get +back the old behavior. + +--- +*** New command 'recentf-open'. +This command prompts for a recently opened file in the minibuffer, and +visits it. + +--- +*** 'ffap-machine-at-point' no longer pings hosts by default. +It will now simply look at a hostname to determine if it is valid, +instead of also trying to ping it. Customize the user option +'ffap-machine-p-known' to 'ping' to get the old behavior back. + +--- +*** The 'run-dig' command is now obsolete; use 'dig' instead. + +--- +*** Some 'bib-mode' commands and variables have been renamed. +To respect Emacs naming conventions, the variable 'unread-bib-file' +has been renamed to 'bib-unread-file'. The following commands have +also been renamed: + 'addbib' to 'bib-add' + 'return-key-bib' to 'bib-return-key' + 'mark-bib' to 'bib-mark' + 'unread-bib' to 'bib-unread' + +--- +*** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'. +The old name is still available as an obsolete function alias. + +--- +*** The url-irc library now understands "ircs://" links. + +--- +*** New command 'world-clock-copy-time-as-kill' for 'world-clock-mode'. +It copies the current line into the kill ring. + +--- +*** 'edit-abbrevs' now uses font-locking. +The new face 'abbrev-table-name' is used to display the abbrev table +name. + +--- +*** New key binding 'O' in "*Buffer List*". +This key is now bound to 'Buffer-menu-view-other-window', which will +view this line's buffer in View mode in another window. + +** Scheme Mode + +--- +*** Auto-detection of Scheme library files. +Emacs now automatically enables the Scheme mode when opening R6RS +Scheme Library Source (".sls") files and R7RS Scheme Library +Definition (".sld") files. + +--- +*** Imenu members for R6RS and R7RS library members. +Imenu now lists the members directly nested in R6RS Scheme libraries +('library') and R7RS libraries ('define-library'). + + +* New Modes and Packages in Emacs 29.1 + ++++ +** Eglot: Emacs Client for the Language Server Protocol. +Emacs now comes with the Eglot package, which enhances various Emacs +features, such as completion, documentation, error detection, etc., +based on data provided by language servers using the Language Server +Protocol (LSP). See the new Info manual "(eglot) Top" for more. Also +see "etc/EGLOT-NEWS". + ++++ +** use-package: Declarative package configuration. +use-package is now shipped with Emacs. It provides the 'use-package' +macro, which allows you to isolate package configuration in your init +file in a way that is declarative, tidy, and performance-oriented. +See the new Info manual "(use-package) Top" for more. + ++++ +** New commands 'image-crop' and 'image-cut'. +These commands allow interactively cropping/cutting the image at +point. The commands are bound to keys 'i c' and 'i x' (respectively) +in the local keymap over images. They rely on external programs, by +default "convert" from ImageMagick, to do the actual cropping/eliding +of the image file. + +--- +** New package 'wallpaper'. +This package provides the command 'wallpaper-set', which sets the +desktop background image. Depending on the system and the desktop, +this may require an external program (such as "swaybg", "gm", +"display" or "xloadimage"). If so, a suitable command should be +detected automatically in most cases. It can also be customized +manually if needed, using the new user options 'wallpaper-command' and +'wallpaper-command-args'. + ++++ +** New package 'oclosure'. +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'. +Used by 'interactive-form' when called on an OClosure. +This allows specific OClosure types to compute their interactive specs +on demand rather than precompute them when created. + +--- +** New theme 'leuven-dark'. +This is a dark version of the 'leuven' theme. + ++++ +** New mode 'erts-mode'. +This mode is used to edit files geared towards testing actions in +Emacs buffers, like indentation and the like. The new ert function +'ert-test-erts-file' is used to parse these files. + +--- +** New major mode 'js-json-mode'. +This is a lightweight variant of 'js-mode' that is used by default +when visiting JSON files. + ++++ +** New major mode 'csharp-mode'. +A major mode based on CC Mode for editing programs in the C# language. +This mode is auto-enabled for files with the ".cs" extension. + ++++ +** New major modes based on the tree-sitter library. +These new major modes are available if Emacs was built with the +tree-sitter library. They provide support for font-locking, +indentation, and navigation by defuns based on parsing the buffer text +by a tree-sitter parser. Some major modes also offer support for +Imenu and 'which-func'. + +The new modes based on tree-sitter are for now entirely optional, and +you must turn them on manually, or load them in your init file, or +customize 'auto-mode-alist' to turn them on automatically for certain +files. You can also customize 'major-mode-remap-alist' to +automatically turn on some tree-sitter based modes for the same files +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. (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, +usually named "libtree-sitter-LANG.so" ("libtree-sitter-LANG.dll" on +MS-Windows), where LANG is the corresponding language name. Emacs +looks for these libraries in the following places: + + . in the directories mentioned in the list 'treesit-extra-load-path' + . in the "tree-sitter" subdirectory of your 'user-emacs-directory' + (by default, "~/.emacs.d/tree-sitter") + . in the standard system directories where other shared libraries are + usually installed + +We recommend to install these libraries in one of the standard system +locations (the last place in the above list). + +If a language grammar library required by a mode is not found in any +of the above places, the mode will display a warning when you try to +turn it on. + ++++ +*** New major mode 'typescript-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the TypeScript language. + ++++ +*** New major mode 'tsx-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the TypeScript language, with support for TSX. + ++++ +*** New major mode 'c-ts-mode'. +An optional major mode based on the tree-sitter library for editing +programs in the C language. + ++++ +*** New major mode 'c++-ts-mode'. +An optional major mode based on the tree-sitter library for editing +programs in the C++ language. + ++++ +*** New command 'c-or-c++-ts-mode'. +A command that automatically guesses the language of a header file, +and enables either 'c-ts-mode' or 'c++-ts-mode' accordingly. + ++++ +*** New major mode 'java-ts-mode'. +An optional major mode based on the tree-sitter library for editing +programs in the Java language. + ++++ +*** New major mode 'python-ts-mode'. +An optional major mode based on the tree-sitter library for editing +programs in the Python language. + ++++ +*** New major mode 'css-ts-mode'. +An optional major mode based on the tree-sitter library for editing +CSS (Cascading Style Sheets). + ++++ +*** New major mode 'json-ts-mode'. +An optional major mode based on the tree-sitter library for editing +programs in the JSON language. + ++++ +*** New major mode 'csharp-ts-mode'. +An optional major mode based on the tree-sitter library for editing +programs in the C# language. + ++++ +*** New major mode 'bash-ts-mode'. +Am optional major mode based on the tree-sitter library for editing +Bash shell scripts. + ++++ +*** New major mode 'dockerfile-ts-mode'. +A major mode based on the tree-sitter library for editing +Dockerfiles. + ++++ +*** New major mode 'cmake-ts-mode'. +A major mode based on the tree-sitter library for editing CMake files. + ++++ +*** New major mode 'toml-ts-mode'. +An optional major mode based on the tree-sitter library for editing +files written in TOML, a format for writing configuration files. + ++++ +*** New major mode 'go-ts-mode'. +A major mode based on the tree-sitter library for editing programs in +the Go language. + ++++ +*** New major mode 'go-mod-ts-mode'. +A major mode based on the tree-sitter library for editing "go.mod" +files. + ++++ +*** New major mode 'yaml-ts-mode'. +A major mode based on the tree-sitter library for editing files +written in YAML. + ++++ +*** New major mode 'rust-ts-mode'. +A major mode based on the tree-sitter library for editing programs in +the Rust language. + +--- +*** New major mode 'ruby-ts-mode'. +An optional major mode based on the tree-sitter library for editing +programs in the Ruby language. + + +* Incompatible Lisp Changes in Emacs 29.1 + ++++ +** The implementation of overlays has changed. +Emacs now uses an implementation of overlays that is much more +efficient than the original one, and should speed up all the +operations that involve overlays, especially when there are lots of +them in a buffer. + +As result of this, some minor incompatibilities in behavior could be +observed, as described below. Except those minor incompatibilities, +no other changes in behavior of overlays should be visible on the Lisp +or user level, with the exception of better performance and the order +of overlays returned by functions that don't promise any particular +order. + +--- +*** The function 'overlay-recenter' is now a no-op. +This function does nothing, and in particular has no effect on the +value returned by 'overlay-lists'. The purpose of 'overlay-recenter' +was to allow more efficient lookup of overlays around a certain buffer +position; however with the new implementation the lookup of overlays +is efficient regardless of their position, and there's no longer any +need to "optimize" the lookup, nor any notion of a "center" of the +overlays. + +--- +*** The function 'overlay-lists' returns one unified list of overlays. +This function used to return a cons of two lists, one with overlays +before the "center" position, the other after that "center". It now +returns a list whose 'car' is the list of all the buffer overlays, and +whose 'cdr' is always nil. + ++++ +** 'format-prompt' now uses 'substitute-command-keys'. +This means that both the prompt and 'minibuffer-default-prompt-format' +will have key definitions and single quotes handled specially. + ++++ +** New function 'substitute-quotes'. +This function works like 'substitute-command-keys' but only +substitutes quote characters. + +--- +** 'find-image' now uses 'create-image'. +This means that images found through 'find-image' also have +auto-scaling applied. (This only makes a difference on HiDPI +displays.) + ++++ +** Changes in how "raw" in-memory XBM images are specified. +Some years back Emacs gained the ability to scale images, and you +could then specify ':width' and ':height' when using 'create-image' on all +image types -- except XBM images, because this format already used the +':width' and ':height' arguments to specify the width/height of the "raw" +in-memory format. This meant that if you used these specifications +on, for instance, XBM files, Emacs would refuse to display them. This +has been changed, and ':width'/':height' now works as with all other image +formats, and the way to specify the width/height of the "raw" +in-memory format is now by using ':data-width' and ':data-height'. + ++++ +** "loaddefs.el" generation has been reimplemented. +The various "loaddefs.el" files in the Emacs tree (which contain +information about autoloads, built-in packages and package prefixes) +used to be generated by functions in autoloads.el. These are now +generated by loaddefs-gen.el instead. This leads to functionally +equivalent "loaddefs.el" files, but they do not use exactly the same +syntax, so using 'M-x update-file-autoloads' no longer works. (This +didn't work well in most files in the past, either, but it will now +signal an error in any file.) + +In addition, files are scanned in a slightly different way. +Previously, ';;;###' specs inside a top-level form (i.e., something +like '(when ... ;;;### ...)' would be ignored. They are now parsed as +usual. + +--- +** Themes have special autoload cookies. +All built-in themes are scraped for ';;;###theme-autoload' cookies +that are loaded along with the regular auto-loaded code. + ++++ +** 'buffer-modified-p' has been extended. +This function was previously documented to return only nil or t. This +has been changed to nil/'autosaved'/non-nil. The new 'autosaved' +value means that the buffer is modified, but that it hasn't been +modified since the time of last auto-save. + +--- +** 'with-silent-modifications' also restores buffer autosave status. +'with-silent-modifications' is a macro meant to be used by the font +locking machinery to allow applying text properties without changing +the modification status of the buffer. However, it didn't restore the +buffer autosave status, so applying font locking to a modified buffer +that had already been auto-saved would trigger another auto-saving. +This is no longer the case. + +--- +** 'prin1' doesn't always escape "." and "?" in symbols any more. +Previously, symbols like 'foo.bar' would be printed by 'prin1' as +"foo\.bar". This now prints as "foo.bar" instead. The Emacs Lisp +reader interprets these strings as referring to the same symbol, so +this is virtually always backwards-compatible, but there may +theoretically be code out there that expects a specific printed +representation. + +The same is the case with the "?" character: The 'foo?' symbol is now +printed as "foo?" instead of "foo\?". + +If the "." and "?" characters are the first character in the symbol, +they will still be escaped, so the '.foo' symbol is still printed as +"\.foo" and the '?bar' symbol is still printed as "\?bar". + ++++ +** Remapping 'mode-line' face no longer works as expected. +'mode-line' is now the parent face of the new 'mode-line-active' face, +and remapping parent of basic faces does not work reliably. +Instead of remapping 'mode-line', you have to remap 'mode-line-active'. + ++++ +** 'make-process' has been extended to support ptys when ':stderr' is set. +Previously, setting ':stderr' to a non-nil value would force the +process's connection to use pipes. Now, Emacs will use a pty for +stdin and stdout if requested no matter the value of ':stderr'. + +--- +** User option 'mail-source-ignore-errors' is now obsolete. +The whole mechanism for prompting users to continue in case of +mail-source errors has been removed, so this option is no longer +needed. + +** Fonts + +--- +*** Emacs now supports 'medium' fonts. +Emacs previously didn't distinguish between the 'regular'/'normal' +weight and the 'medium' weight, but it now also supports the (heavier) +'medium' weight. However, this means that if you specify a weight of +'normal' and the font doesn't have this weight, Emacs won't find the +font spec. In these cases, replacing ":weight 'normal" with ":weight +'medium" should fix the issue. + +--- +** Keymap descriptions have changed. +'help--describe-command', 'C-h b' and associated functions that output +keymap descriptions have changed. In particular, prefix commands are +not output at all, and instead of "??" for closures/functions, +"[closure]"/"[lambda]" is output. + +--- +** 'downcase' details have changed slightly. +In certain locales, changing the case of an ASCII-range character may +turn it into a multibyte character, most notably with "I" in Turkish +(the lowercase is "ı", 0x0131). Previously, 'downcase' on a unibyte +string was buggy, and would mistakenly just return the lower byte of +this, 0x31 (the digit "1"). 'downcase' on a unibyte string has now +been changed to downcase such characters as if they were ASCII. To +get proper locale-dependent downcasing, the string has to be converted +to multibyte first. (This goes for the other case-changing functions, +too.) + +--- +** Functions in 'tramp-foreign-file-name-handler-alist' have changed. +Functions to determine which Tramp file name handler to use are now +passed a file name in dissected form (via 'tramp-dissect-file-name') +instead of in string form. + +--- +** 'def' indentation changes. +In 'emacs-lisp-mode', forms with a symbol with a name that start with +"def" have been automatically indented as if they were 'defun'-like +forms, for instance: + + (defzot 1 + 2 3) + +This heuristic has now been removed, and all functions/macros that +want to be indented this way have to be marked with + + (declare (indent defun)) + +or the like. If the function/macro definition itself can't be +changed, the indentation can also be adjusted by saying something +like: + + (put 'defzot 'lisp-indent-function 'defun) + +--- +** The 'inhibit-changing-match-data' variable is now obsolete. +Instead, functions like 'string-match' and 'looking-at' now take an +optional INHIBIT-MODIFY argument. + +--- +** 'gnus-define-keys' is now obsolete. +Use 'define-keymap' instead. + +--- +** MozRepl has been removed from js.el. +MozRepl was removed from Firefox in 2017, so this code doesn't work +with recent versions of Firefox. + +--- +** The function 'image-dired-get-exif-data' is now obsolete. +Use 'exif-parse-file' and 'exif-field' instead. + +--- +** 'insert-directory' alternatives should not change the free disk space line. +This change is now applied in 'dired-insert-directory'. + +--- +** 'compilation-last-buffer' is (finally) declared obsolete. +It has been obsolete since Emacs 22.1, actually. + +--- +** Calling 'lsh' now elicits a byte-compiler warning. +'lsh' behaves in somewhat surprising and platform-dependent ways for +negative arguments, and is generally slower than 'ash', which should be +used instead. This warning can be suppressed by surrounding calls to +'lsh' with the construct '(with-suppressed-warnings ((suspicious lsh)) ...)', +but switching to 'ash' is generally much preferable. + +--- +** Some functions and variables obsolete since Emacs 24 have been removed: +'Buffer-menu-buffer+size-width', 'Electric-buffer-menu-mode', +'Info-edit-map', 'allout-abbreviate-flattened-numbering', +'allout-exposure-change-hook', 'allout-mode-deactivate-hook', +'allout-structure-added-hook', 'allout-structure-deleted-hook', +'allout-structure-shifted-hook', 'ansi-color-unfontify-region', +'archive-extract-hooks', 'auth-source-forget-user-or-password', +'auth-source-hide-passwords', 'auth-source-user-or-password', +'automatic-hscrolling', 'automount-dir-prefix', 'bibtex-complete', +'bibtex-entry-field-alist', 'buffer-has-markers-at', +'buffer-substring-filters', 'byte-compile-disable-print-circle', +'c-prepare-bug-report-hooks', 'cfengine-mode-abbrevs', +'change-log-acknowledgement', 'chart-map', +'checkdoc-comment-style-hooks', 'comint--unquote&expand-filename', +'comint-dynamic-complete', 'comint-dynamic-complete-as-filename', +'comint-dynamic-simple-complete', 'comint-unquote-filename', +'command-history-map', 'compilation-parse-errors-function', +'completion-annotate-function', 'condition-case-no-debug', +'count-lines-region', 'crisp-mode-modeline-string', +'custom-print-functions', 'cvs-string-prefix-p', 'data-debug-map', +'deferred-action-function', 'deferred-action-list', +'dired-pop-to-buffer', 'dired-shrink-to-fit', +'dired-sort-set-modeline', 'dired-x-submit-report', +'display-buffer-function', +'ediff-choose-window-setup-function-automatically', +'eieio-defgeneric', 'eieio-defmethod', 'emacs-lock-from-exiting', +'erc-complete-word', 'erc-dcc-chat-filter-hook', +'eshell-add-to-window-buffer-names', 'eshell-cmpl-suffix-list', +'eshell-for', 'eshell-remove-from-window-buffer-names', +'eshell-status-in-modeline', 'filesets-cache-fill-content-hooks', +'font-list-limit', 'font-lock-maximum-size', +'font-lock-reference-face', 'gnus-carpal', +'gnus-debug-exclude-variables', 'gnus-debug-files', +'gnus-local-domain', 'gnus-outgoing-message-group', +'gnus-registry-user-format-function-M', 'gnus-secondary-servers', +'gnus-subscribe-newsgroup-hooks', 'gud-inhibit-global-bindings', +'hangul-input-method-inactivate', 'hfy-post-html-hooks', +'image-extension-data', 'image-library-alist', +'inactivate-current-input-method-function', 'inactivate-input-method', +'inhibit-first-line-modes-regexps', +'inhibit-first-line-modes-suffixes', 'input-method-inactivate-hook', +'intdos', 'javascript-generic-mode', 'javascript-generic-mode-hook', +'latex-string-prefix-p', 'macro-declaration-function' (function), +'macro-declaration-function' (variable), 'mail-complete', +'mail-complete-function', 'mail-mailer-swallows-blank-line', +'mail-sent-via', 'make-register', 'makefile-complete', +'menu-bar-kill-ring-save', 'meta-complete-symbol', 'meta-mode-map', +'mh-kill-folder-suppress-prompt-hooks', +'minibuffer-completing-symbol', +'minibuffer-local-filename-must-match-map', 'mode25', 'mode4350', +'mpc-string-prefix-p', 'msb-after-load-hooks', +'nndiary-request-accept-article-hooks', +'nndiary-request-create-group-hooks', +'nndiary-request-update-info-hooks', 'nnimap-split-rule', +'nntp-authinfo-file', 'ns-alternatives-map', +'ns-store-cut-buffer-internal', 'package-menu-view-commentary', +'pascal-last-completions', 'pascal-show-completions', +'pascal-toggle-completions', 'pcomplete-arg-quote-list', +'pcomplete-quote-argument', 'prolog-char-quote-workaround', +'python-buffer', 'python-guess-indent', 'python-indent', +'python-info-ppss-comment-or-string-p', 'python-info-ppss-context', +'python-info-ppss-context-type', 'python-preoutput-result', +'python-proc', 'python-send-receive', 'python-send-string', +'python-use-skeletons', 'quail-inactivate', 'quail-inactivate-hook', +'query-replace-interactive', 'rcirc-activity-hooks', +'rcirc-print-hooks', 'rcirc-receive-message-hooks', +'rcirc-sentinel-hooks', 'read-filename-at-point', 'redraw-modeline', +'reftex-index-map', 'reftex-index-phrases-map', +'reftex-select-bib-map', 'reftex-select-label-map', 'reftex-toc-map', +'register-name-alist', 'register-value', 'report-emacs-bug-info', +'report-emacs-bug-pretest-address', +'rmail-default-dont-reply-to-names', 'rmail-dont-reply-to', +'rmail-dont-reply-to-names', 'robin-inactivate', +'robin-inactivate-hook', 'rst-block-face', 'rst-comment-face', +'rst-definition-face', 'rst-directive-face', 'rst-emphasis1-face', +'rst-emphasis2-face', 'rst-external-face', 'rst-literal-face', +'rst-reference-face', 'semantic-change-hooks', +'semantic-edits-delete-change-hooks', +'semantic-edits-new-change-hooks', +'semantic-edits-reparse-change-hooks', 'semantic-grammar-map', +'semantic-grammar-syntax-table', 'semantic-lex-reset-hooks', +'semanticdb-elisp-sym-function-arglist', +'semanticdb-save-database-hooks', 'set-face-underline-p', +'set-register-value', 'sh-maybe-here-document', 'speedbar-key-map', +'speedbar-syntax-table', 'starttls-any-program-available', +'strokes-modeline-string', 'strokes-report-bug', +'term-default-bg-color', 'term-default-fg-color', +'tex-string-prefix-p', 'timeclock-modeline-display', +'timeclock-modeline-display', 'timeclock-update-modeline', +'toggle-emacs-lock', 'tooltip-use-echo-area', 'turn-on-cwarn-mode', +'turn-on-iimage-mode', 'ucs-input-inactivate', 'ucs-insert', +'url-recreate-url-attributes', 'user-variable-p', +'vc-string-prefix-p', 'vc-toggle-read-only', 'view-return-to-alist', +'view-return-to-alist-update', 'w32-default-color-map' (function), +'which-func-mode' (function), 'window-system-version', +'winner-mode-leave-hook', 'x-cut-buffer-or-selection-value'. + +--- +** Some functions and variables obsolete since Emacs 23 have been removed: +'find-emacs-lisp-shadows', 'newsticker-cache-filename', +'process-filter-multibyte-p', 'redisplay-end-trigger-functions', +'set-process-filter-multibyte', 'set-window-redisplay-end-trigger', +'unify-8859-on-decoding-mode', 'unify-8859-on-encoding-mode', +'vc-arch-command', 'window-redisplay-end-trigger', 'x-selection'. + +--- +** Some functions and variables obsolete since Emacs 21 or 22 have been removed: +'c-toggle-auto-state', 'find-file-not-found-hooks', +'ls-lisp-dired-ignore-case', 'query-replace-regexp-eval'. + ++++ +** New generic function 'function-documentation'. +It can dynamically generate a raw docstring depending on the type of a +function. Used mainly for docstrings of OClosures. + ++++ +** Base64 encoding no longer tolerates latin-1 input. +The functions 'base64-encode-string', 'base64url-encode-string', +'base64-encode-region' and 'base64url-encode-region' no longer accept +characters in the range U+0080..U+00FF as substitutes for single bytes +in the range 128..255, but signal an error for all multibyte characters. +The input must be unibyte encoded text. + ++++ +** The 'clone-indirect-buffer-hook' is now run by 'make-indirect-buffer'. +It was previously only run by 'clone-indirect-buffer' and +'clone-indirect-buffer-other-window'. Since 'make-indirect-buffer' is +called by both of these, the hook is now run by all 3 of these +functions. + +--- +** '?\' at the end of a line now signals an error. +Previously, it produced a nonsense value, -1, that was never intended. + +--- +** Some libraries obsolete since Emacs 24.1 and 24.3 have been removed: +abbrevlist.el, assoc.el, complete.el, cust-print.el, +erc-hecomplete.el, mailpost.el, mouse-sel.el, old-emacs-lock.el, +patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el. + ++++ +** Many seldom-used generalized variables have been made obsolete. +Emacs has a number of rather obscure generalized variables defined, +that, for instance, allowed you to say things like: + + (setf (point-min) 4) + +These never caught on and have been made obsolete. The form above, +for instance, is the same as saying + + (narrow-to-region 4 (point-max)) + +The following generalized variables have been made obsolete: +'buffer-file-name', 'buffer-local-value', 'buffer-modified-p', +'buffer-name', 'buffer-string', 'buffer-substring', 'current-buffer', +'current-column', 'current-global-map', 'current-input-mode', +'current-local-map', 'current-window-configuration', +'default-file-modes', 'documentation-property', 'eq', 'frame-height', +'frame-width', 'frame-visible-p', 'global-key-binding', +'local-key-binding', 'mark', 'mark-marker', 'marker-position', +'mouse-position', 'point', 'point-marker', 'point-max', 'point-min', +'read-mouse-position', 'screen-height', 'screen-width', +'selected-frame', 'selected-screen', 'selected-window', +'standard-case-table', 'syntax-table', 'visited-file-modtime', +'window-height', 'window-width', and 'x-get-secondary-selection'. + + +* Lisp Changes in Emacs 29.1 + ++++ +** Interpreted closures are "safe for space". +As was already the case for byte-compiled closures, instead of capturing +the whole current lexical environment, interpreted closures now only +capture the part of the environment that they need. +The previous behavior could occasionally lead to memory leaks or +to problems where a printed closure would not be 'read'able because +of an un'read'able value in an unrelated lexical variable. + ++++ +** New accessor function 'file-attribute-file-identifier'. +It returns the list of the inode number and device identifier +retrieved by 'file-attributes'. This value can be used to identify a +file uniquely. The device identifier can be a single number or (for +remote files) a cons of 2 numbers. + ++++ +** New macro 'while-let'. +This is like 'when-let', but repeats until a binding form is nil. + ++++ +** New function 'make-obsolete-generalized-variable'. +This can be used to mark setters used by 'setf' as obsolete, and the +byte-compiler will then warn about using them. + ++++ +** New functions 'pos-eol' and 'pos-bol'. +These are like 'line-end-position' and 'line-beginning-position' +(respectively), but ignore fields (and are more efficient). + ++++ +** New function 'compiled-function-p'. +This returns non-nil if its argument is either a built-in, or a +byte-compiled, or a natively-compiled function object, or a function +loaded from a dynamic module. + +--- +** 'deactivate-mark' can have new value 'dont-save'. +This value means that Emacs should deactivate the mark as usual, but +without setting the primary selection, if 'select-active-regions' is +enabled. + ++++ +** New 'declare' form 'interactive-args'. +This can be used to specify what forms to put into 'command-history' +when executing commands interactively. + ++++ +** The FORM argument of 'time-convert' is mandatory. +'time-convert' can still be called without it, as before, but the +compiler now emits a warning about this deprecated usage. + ++++ +** Emacs now supports user-customizable and themable icons. +These can be used for buttons in buffers and the like. See the +"(elisp) Icons" and "(emacs) Icons" nodes in the manuals for details. + ++++ +** New arguments MESSAGE and TIMEOUT of 'set-transient-map'. +MESSAGE specifies a message to display after activating the transient +map, including a special formatting spec to list available keys. +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 + ++++ +*** Some connection-local variables are now user options. +The variables 'connection-local-profile-alist' and +'connection-local-criteria-alist' are now user options, in order to +make it more convenient to inspect and modify them. + ++++ +*** New function 'connection-local-update-profile-variables'. +This function allows to modify the settings of an existing +connection-local profile. + ++++ +*** New macro 'with-connection-local-application-variables'. +This macro works like 'with-connection-local-variables', but it allows +to use another application but 'tramp'. This is useful when running +code in a buffer where Tramp has already set some connection-local +variables. + ++++ +*** New macro 'setq-connection-local'. +This allows dynamically setting variable values for a particular +connection within the body of 'with-connection-local-{application-}variables'. +See the "(elisp) Connection Local Variables" node in the Lisp +Reference manual for more information. + ++++ +** 'plist-get', 'plist-put' and 'plist-member' are no longer limited to 'eq'. +These function now take an optional comparison PREDICATE argument. + ++++ +** 'read-multiple-choice' can now use long-form answers. + ++++ +** 'M-s c' in 'read-regexp' now toggles case folding. + ++++ +** 'completing-read' now allows a function as its REQUIRE-MATCH argument. +This function is called to see whether what the user has typed is a +match. This is also available from functions that call +'completing-read', like 'read-file-name'. + ++++ +** 'posn-col-row' can now give position data based on windows. +Previously, it reported data only based on the frame. + ++++ +** 'file-expand-wildcards' can now also take a regexp as PATTERN argument. + +--- +** vc-mtn (the VC backend for Monotone) has been made obsolete. + ++++ +** 'gui-set-selection' can specify different values for different data types. +If DATA is a string, then its text properties are searched for values +for each specific data type while the selection is being converted. + +--- +** New eldoc function 'elisp-eldoc-var-docstring-with-value'. +This function includes the current value of the variable in eldoc display +and can be used as a more detailed alternative to 'elisp-eldoc-var-docstring'. + ++++ +** 'save-some-buffers' can now be extended to save other things. +Traditionally, 'save-some-buffers' saved buffers, and also saved +abbrevs. This has been generalized via the +'save-some-buffers-functions' variable, and packages can now register +things to be saved. + ++++ +** New function 'string-equal-ignore-case'. +This compares strings ignoring case differences. + ++++ +** 'symbol-file' can now report natively-compiled ".eln" files. +If Emacs was built with native-compilation enabled, Lisp programs can +now call 'symbol-file' with the new optional 3rd argument non-nil to +request the name of the ".eln" file which defined a given symbol. + ++++ +** New macro 'with-memoization' provides a very primitive form of memoization. + ++++ +** 'max-char' can now report the maximum codepoint according to Unicode. +When called with a new optional argument UNICODE non-nil, 'max-char' +will now report the maximum valid codepoint defined by the Unicode +Standard. + +** Seq + ++++ +*** New function 'seq-split'. +This returns a list of sub-sequences of the specified sequence. + ++++ +*** New function 'seq-remove-at-position'. +This function returns a copy of the specified sequence where the +element at a given (zero-based) index got removed. + ++++ +*** New function 'seq-positions'. +This returns a list of the (zero-based) indices of elements matching a +given predicate in the specified sequence. + ++++ +*** New function 'seq-keep'. +This is like 'seq-map', but removes all nil results from the returned +list. + +** Themes + +--- +*** New hooks 'enable-theme-functions' and 'disable-theme-functions'. +These are run after enabling and disabling a theme, respectively. + +--- +*** Themes can now be made obsolete. +Using 'make-obsolete' on a theme is now supported. This will make +'load-theme' issue a warning when loading the theme. + ++++ +** New hook 'display-monitors-changed-functions'. +It is called whenever the configuration of different monitors on a +display changes. + ++++ +** 'prin1' and 'prin1-to-string' now take an optional OVERRIDES argument. +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 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'. +This global minor mode makes Emacs deactivate the mark in all buffers +when the primary selection is obtained by another program. + +--- +** On X, Emacs will try to preserve selection ownership when a frame is deleted. +This means that if you make Emacs the owner of a selection, such as by +selecting some text into the clipboard or primary selection, and then +delete the current frame, you will still be able to insert the +contents of that selection into other programs as long as another +frame is open on the same display. This behavior can be disabled by +setting the user option 'x-auto-preserve-selections' to nil. + ++++ +** New predicate 'char-uppercase-p'. +This returns non-nil if its argument its an uppercase character. + +** Byte Compilation + +--- +*** Byte compilation will now warn about some quoting mistakes in docstrings. +When writing code snippets that contains the "'" character (APOSTROPHE), +that quote character has to be escaped to avoid Emacs displaying it as +"’" (LEFT SINGLE QUOTATION MARK), which would make code examples like + + (setq foo '(1 2 3)) + +invalid. Emacs will now warn during byte compilation if it seems +something like that, and also warn about when using RIGHT/LEFT SINGLE +QUOTATION MARK directly. In both these cases, if these characters +should really be present in the docstring, they should be quoted with +"\=". + +--- +*** Byte compilation will now warn about some malformed 'defcustom' types. +It is very common to write 'defcustom' types on the form: + + :type '(choice (const :tag "foo" 'bar)) + +I.e., double-quoting the 'bar', which is almost never the correct +value. The byte compiler will now issue a warning if it encounters +these forms. + ++++ +** 'restore-buffer-modified-p' can now alter buffer auto-save state. +With a FLAG value of 'autosaved', it will mark the buffer as having +been auto-saved since the time of last modification. + +--- +** New minor mode 'isearch-fold-quotes-mode'. +This sets up 'search-default-mode' so that quote characters are +char-folded into each other. It is used, by default, in "*Help*" and +"*info*" buffers. + ++++ +** New macro 'buffer-local-set-state'. +This is a helper macro to be used by minor modes that wish to restore +buffer-local variables back to their original states when the mode is +switched off. + +--- +** New macro 'with-buffer-unmodified-if-unchanged'. +If the buffer is marked as unmodified, and code does modifications +that, in total, means that the buffer is identical to the buffer +before, mark the buffer as unmodified again. + +--- +** New function 'malloc-trim'. +This function allows returning unused memory back to the operating +system, and is mainly meant as a debugging tool. It is currently +available only when Emacs was built with glibc as the C library. + +--- +** 'x-show-tip' no longer hard-codes a timeout default. +The new variable 'x-show-tooltip-timeout' allows the user to alter +this for packages that don't use 'tooltip-show', but instead call the +lower level function directly. + +--- +** New function 'current-cpu-time'. +It gives access to the CPU time used by the Emacs process, for +example for benchmarking purposes. + +--- +** New function 'string-edit'. +This is meant to be used when the user has to edit a (potentially) +long string. It pops up a new buffer where you can edit the string, +and a callback is called when the user types 'C-c C-c'. + ++++ +** New function 'read-string-from-buffer'. +This is a modal version of 'string-edit', and can be used as an +alternative to 'read-string'. + ++++ +** The return value of 'clear-message-function' is not ignored anymore. +If the function returns 'dont-clear-message', then the message is not +cleared, with the assumption that the function cleared it itself. + ++++ +** The local variables section now supports defining fallback modes. +This was previously only available when using a property line (i.e., +putting the modes on the first line of a file). + ++++ +** New function 'flush-standard-output'. +This enables display of lines that don't end in a newline from +batch-based Emacs scripts. + ++++ +** New convenience function 'buttonize-region'. +This works like 'buttonize', but for a region instead of a string. + ++++ +** 'macroexp-let2*' can omit TEST argument and use single-var bindings. + ++++ +** New macro-writing macros, 'cl-with-gensyms' and 'cl-once-only'. +See the "(cl) Macro-Writing Macros" manual section for descriptions. + ++++ +** New variable 'last-event-device' and new function 'device-class'. +On X Windows, 'last-event-device' specifies the input extension device +from which the last input event originated, and 'device-class' can be +used to determine the type of an input device. + ++++ +** Variable 'track-mouse' can have a new value 'drag-source'. +This means the same as 'dropping', but modifies the mouse position +list in reported motion events if there is no frame underneath the +mouse pointer. + ++++ +** New functions for dragging items from Emacs to other programs. +The new functions 'x-begin-drag', 'dnd-begin-file-drag', +'dnd-begin-drag-files', and 'dnd-direct-save' allow dragging contents +(such as files and text) from Emacs to other programs. + +--- +** New function 'ietf-drums-parse-date-string'. +This function parses RFC5322 (and RFC822) date strings, and should be +used instead of 'parse-time-string' when parsing data that's standards +compliant. + ++++ +** New macro 'setopt'. +This is like 'setq', but is meant to be used for user options instead +of plain variables, and uses 'custom-set'/'set-default' to set them. + ++++ +** New utility predicate 'mode-line-window-selected-p'. +This is meant to be used from ':eval' mode line constructs to create +different mode line looks for selected and unselected windows. + ++++ +** New variable 'messages-buffer-name'. +This variable (defaulting to "*Messages*") allows packages to override +where messages are logged. + ++++ +** New function 'readablep'. +This function says whether an object can be written out and then +read back by the Emacs Lisp reader. + ++++ +** New variable 'print-unreadable-function'. +This variable allows changing how Emacs prints unreadable objects. + +--- +** The user option 'polling-period' now accepts floating point values. +This means Emacs can now poll for input during Lisp execution more +frequently than once in a second. + +--- +** New function 'bidi-string-strip-control-characters'. +This utility function is meant for displaying strings when it is +essential that there's no bidirectional context. It removes all the +bidirectional formatting control characters (such as RLM, LRO, PDF, +etc.) from its argument string. The characters it removes are listed +in the value of 'bidi-control-characters'. + +--- +** The Gnus range functions have been moved to a new library, range.el. +All the old names have been made obsolete. + ++++ +** New function 'function-alias-p'. +This predicate says whether an object is a function alias, and if it +is, the alias chain is returned. + ++++ +** New variable 'lisp-directory' holds the directory of Emacs's own Lisp files. + ++++ +** New facility for handling session state: 'multisession-value'. +This can be used as a convenient way to store (simple) application +state, and the command 'list-multisession-values' allows users to list +(and edit) this data. + ++++ +** New function 'get-display-property'. +This is like 'get-text-property', but works on the 'display' text +property. + ++++ +** New function 'add-display-text-property'. +This is like 'put-text-property', but works on the 'display' text +property. + ++++ +** New 'min-width' 'display' property. +This allows setting a minimum display width for a region of text. + ++++ +** New 'cursor-face' text property. +This uses 'cursor-face' instead of the default face when cursor is on or +near the character and 'cursor-face-highlight-mode' is enabled. The +user option 'cursor-face-highlight-nonselected-window' is similar to +'highlight-nonselected-windows', but for this property. + ++++ +** New event type 'touch-end'. +This event is sent whenever the user's finger moves off the mouse +wheel on some mice, or when the user's finger moves off the touchpad. + ++++ +** New event type 'pinch'. +This event is sent when a user performs a pinch gesture on a touchpad, +which is comprised of placing two fingers on the touchpad and moving +them towards or away from each other. + ++++ +** New hook 'x-pre-popup-menu-hook'. +This hook, run before 'x-popup-menu', is about to display a +deck-of-cards menu on screen. + +--- +** New hook 'post-select-region-hook'. +This hook is run immediately after 'select-active-regions'. It causes +the region to be set as the primary selection. + ++++ +** New function 'buffer-match-p'. +Check if a buffer satisfies some condition. Some examples for +conditions can be regular expressions that match a buffer name, a +cons-cell like '(major-mode . shell-mode)' that matches any buffer +where 'major-mode' is 'shell-mode' or a combination with a condition +like '(and "\\`\\*.+\\*\\'" (major-mode . special-mode))'. + ++++ +** New function 'match-buffers'. +It uses 'buffer-match-p' to gather a list of buffers that match a +condition. + +--- +** New optional arguments TEXT-FACE and DEFAULT-FACE for 'tooltip-show'. +They allow changing the faces used for the tooltip text and frame +colors of the resulting tooltip frame from the default 'tooltip' face. + +** Text Security and Suspiciousness + ++++ +*** New library textsec.el. +This library contains a number of checks for whether a string is +"suspicious". This usually means that the string contains characters +that have glyphs that can be confused with other, more commonly used +glyphs, or contains bidirectional (or other) formatting characters +that may be used to confuse a user. + ++++ +*** New user option 'textsec-check'. +If non-nil (which is the default), Emacs packages that are vulnerable +to attackers trying to confuse the users will use the textsec library +to mark suspicious text. For instance shr/eww will mark suspicious +URLs and links, Gnus will mark suspicious From addresses, and +Message mode will query the user if the user is sending mail to a +suspicious address. If this variable is nil, these checks are +disabled. + ++++ +*** New function 'textsec-suspicious-p'. +This is the main function Emacs applications should be using to check +whether a string is suspicious. It heeds the 'textsec-check' user +option. + +** Keymaps and Key Definitions + ++++ +*** 'where-is-internal' can now filter events marked as non key events. +If a command maps to a key binding like '[some-event]', and 'some-event' +has a symbol plist containing a non-nil 'non-key-event' property, then +that binding is ignored by 'where-is-internal'. + ++++ +*** New functions for defining and manipulating keystrokes. +These all take the syntax defined by 'key-valid-p'. None of the older +functions have been deprecated or altered, but they are now +de-emphasized in the documentation. + ++++ +*** Use 'keymap-set' instead of 'define-key'. + ++++ +*** Use 'keymap-global-set' instead of 'global-set-key'. + ++++ +*** Use 'keymap-local-set' instead of 'local-set-key'. + ++++ +*** Use 'keymap-global-unset' instead of 'global-unset-key'. + ++++ +*** Use 'keymap-local-unset' instead of 'local-unset-key'. + ++++ +*** Use 'keymap-substitute' instead of 'substitute-key-definition'. + ++++ +*** Use 'keymap-set-after' instead of 'define-key-after'. + ++++ +*** Use 'keymap-lookup' instead of 'lookup-key' and 'key-binding'. + ++++ +*** Use 'keymap-local-lookup' instead of 'local-key-binding'. + ++++ +*** Use 'keymap-global-lookup' instead of 'global-key-binding'. + ++++ +*** 'define-key' now takes an optional REMOVE argument. +If non-nil, remove the definition from the keymap. This is subtly +different from setting a definition to nil (when the keymap has a +parent). + ++++ +*** 'read-multiple-choice' now takes an optional SHOW-HELP argument. +If non-nil, show the help buffer immediately, before any user input. + ++++ +*** New function 'key-valid-p'. +The 'kbd' function is quite permissive, and will try to return +something usable even if the syntax of the argument isn't completely +correct. The 'key-valid-p' predicate does a stricter check of the +syntax. + +--- +*** New function 'key-parse'. +This is like 'kbd', but only returns vectors instead of a mix of +vectors and strings. + ++++ +*** New ':type' for 'defcustom' for keys. +The new 'key' type can be used for options that should be a valid key +according to 'key-valid-p'. The type 'key-sequence' is now obsolete. + ++++ +** New function 'define-keymap'. +This function allows defining a number of keystrokes with one form. + ++++ +** New macro 'defvar-keymap'. +This macro allows defining keymap variables more conveniently. + +** 'defvar-keymap' can specify 'repeat-mode' behavior for the keymap. +Use ':repeat t' to have all bindings be repeatable or for more +advanced usage: + + :repeat (:enter (commands ...) :exit (commands ...)) + +--- +** 'kbd' can now be used in built-in, preloaded libraries. +It no longer depends on edmacro.el and cl-lib.el. + ++++ +** New substitution in docstrings and 'substitute-command-keys'. +Use \\`KEYSEQ' to insert a literal key sequence "KEYSEQ" (for example +\\`C-k') in a docstring or when calling 'substitute-command-keys', +which will use the same face as a command substitution. This should +be used only when a key sequence has no corresponding command, for +example when it is read directly with 'read-key-sequence'. It must be +a valid key sequence according to 'key-valid-p'. + +--- +** 'lookup-key' is more permissive when searching for extended menu items. +In Emacs 28.1, the behavior of 'lookup-key' was changed: when looking +for a menu item '[menu-bar Foo-Bar]', first try to find an exact +match, then look for the lowercased '[menu-bar foo-bar]'. + +This has been extended, so that when looking for a menu item with a +symbol containing spaces, as in '[menu-bar Foo\ Bar]', first look for +an exact match, then the lowercased '[menu-bar foo\ bar]' and finally +'[menu-bar foo-bar]'. This further improves backwards-compatibility +when converting menus to use 'easy-menu-define'. + ++++ +** New function 'file-name-split'. +This returns a list of all the components of a file name. + ++++ +** New function 'file-name-parent-directory'. +This returns the parent directory of a file name. + ++++ +** New macro 'with-undo-amalgamate'. +It records a particular sequence of operations as a single undo step. + ++++ +** New command 'yank-media'. +This command supports yanking non-plain-text media like images and +HTML from other applications into Emacs. It is only supported in +modes that have registered support for it, and only on capable +platforms. + ++++ +** New command 'yank-media-types'. +This command lets you examine all data in the current selection and +the clipboard, and insert it into the buffer. + ++++ +** New variable 'yank-transform-functions'. +This variable allows the user to alter the string to be inserted. + +--- +** New command 'yank-in-context'. +This command tries to preserve string/comment syntax when yanking. + +--- +** New function 'minibuffer-lazy-highlight-setup'. +This function allows setting up the minibuffer so that lazy +highlighting of its content is applied in the original window. + ++++ +** New text property 'inhibit-isearch'. +If set, 'isearch' will skip these areas, which can be useful (for +instance) when covering huge amounts of data (that has no meaningful +searchable data, like image data) with a 'display' text property. + ++++ +** 'insert-image' now takes an INHIBIT-ISEARCH optional argument. +It marks the image with the 'inhibit-isearch' text property, which +inhibits 'isearch' matching the STRING argument. + +--- +** New variable 'replace-regexp-function'. +Function to call to convert the entered FROM string to an Emacs +regexp in 'query-replace' and similar commands. It can be used to +implement a different regexp syntax for search/replace. + +--- +** New variables to customize defaults of FROM for 'query-replace*' commands. +The new variable 'query-replace-read-from-default' can be set to a +function that returns the default value of FROM when 'query-replace' +prompts for a string to be replaced. An example of such a function is +'find-tag-default'. + +The new variable 'query-replace-read-from-regexp-default' can be set +to a function (such as 'find-tag-default-as-regexp') that returns the +default value of FROM when 'query-replace-regexp' prompts for a regexp +whose matches are to be replaced. If these variables are nil (which +is the default), 'query-replace' and 'query-replace-regexp' take the +default value from the previous FROM-TO pair. + +** Lisp pretty-printer ('pp') + +--- +*** New function 'pp-emacs-lisp-code'. +'pp' formats general Lisp sexps. This function does much the same, +but applies formatting rules appropriate for Emacs Lisp code. Note +that this could currently be quite slow, and is thus appropriate only +for relatively small code fragments. + +--- +*** New user option 'pp-use-max-width'. +If non-nil, 'pp' and all 'pp-*' commands that format the results, will +attempt to limit the line length when formatting long lists and +vectors. This uses 'pp-emacs-lisp-code', and thus could be slow for +large lists. + ++++ +** New function 'file-has-changed-p'. +This convenience function is useful when writing code that parses +files at run-time, and allows Lisp programs to re-parse files only +when they have changed. + ++++ +** 'abbreviate-file-name' now respects magic file name handlers. + +--- +** New function 'font-has-char-p'. +This can be used to check whether a specific font has a glyph for a +character. + ++++ +** 'window-text-pixel-size' now accepts a new argument IGNORE-LINE-AT-END. +This controls whether or not the last screen line of the text being +measured will be counted for the purpose of calculating the text +dimensions. + ++++ +** 'window-text-pixel-size' understands a new meaning of FROM. +Specifying a cons as the FROM argument allows to start measuring text +from a specified amount of pixels above or below a position. + ++++ +** 'window-body-width' and 'window-body-height' can use remapped faces. +Specifying 'remap' as the PIXELWISE argument now checks if the default +face was remapped, and if so, uses the remapped face to determine the +character width/height. + ++++ +** 'set-window-vscroll' now accepts a new argument PRESERVE-VSCROLL-P. +This means the vscroll will not be reset when set on a window that is +"frozen" due to a mini-window being resized. + +** XDG Support + +--- +*** New function 'xdg-state-home'. +It returns the new 'XDG_STATE_HOME' environment variable. It should +point to a file name that "contains state data that should persist +between (application) restarts, but that is not important or portable +enough to the user that it should be stored in $XDG_DATA_HOME". +(This variable was introduced in the XDG Base Directory Specification +version 0.8 released on May 8, 2021.) + +--- +*** New function 'xdg-current-desktop'. +It returns a list of strings, corresponding to the colon-separated +list of names in the 'XDG_CURRENT_DESKTOP' environment variable, which +identify the current desktop environment. +(This variable was introduced in XDG Desktop Entry Specification +version 1.2.) + +--- +*** New function 'xdg-session-type'. +It returns the 'XDG_SESSION_TYPE' environment variable. (This is not +part of any official standard; see the man page pam_systemd(8) for +more information.) + ++++ +** New macro 'with-delayed-message'. +This macro is like 'progn', but will output the specified message if +the body takes longer to execute than the specified timeout. + +--- +** New function 'funcall-with-delayed-message'. +This function is like 'funcall', but will output the specified message +if the function takes longer to execute than the specified timeout. + +** Locale + +--- +*** New variable 'current-locale-environment'. +This holds the value of the previous call to 'set-locale-environment'. + +--- +*** New macro 'with-locale-environment'. +This macro can be used to change the locale temporarily while +executing code. + +** Table + +--- +*** New user option 'table-latex-environment'. +This allows switching between "table" and "tabular". + +** Tabulated List Mode + ++++ +*** A column can now be set to an image descriptor. +The 'tabulated-list-entries' variable now supports using an image +descriptor, which means to insert an image in that column instead of +text. See the documentation string of that variable for details. + ++++ +** ':keys' in 'menu-item' can now be a function. +If so, it is called whenever the menu is computed, and can be used to +calculate the keys dynamically. + ++++ +** New major mode 'clean-mode'. +This is a new major mode meant for debugging. It kills absolutely all +local variables and removes overlays and text properties. + ++++ +** 'kill-all-local-variables' can now kill all local variables. +If given the new optional KILL-PERMANENT argument, it also kills +permanent local variables. + ++++ +** Third 'mapconcat' argument SEPARATOR is now optional. +An explicit nil always meant the empty string, now it can be left out. + ++++ +** New function 'image-at-point-p'. +This function returns t if point is on a valid image, and nil +otherwise. + ++++ +** New function 'buffer-text-pixel-size'. +This is similar to 'window-text-pixel-size', but can be used when the +buffer isn't displayed. + ++++ +** New function 'string-pixel-width'. +This returns the width of a string in pixels. This can be useful when +dealing with variable pitch fonts and glyphs that have widths that +aren't integer multiples of the default font. + ++++ +** New function 'string-glyph-split'. +This function splits a string into a list of strings representing +separate glyphs. This takes into account combining characters and +grapheme clusters, by treating each sequence of characters composed on +display as a single unit. + +** Xwidget + ++++ +*** The function 'make-xwidget' now accepts an optional RELATED argument. +This argument is used as another widget for the newly created WebKit +widget to share settings and subprocesses with. It must be another +WebKit widget. + ++++ +*** New function 'xwidget-perform-lispy-event'. +This function allows you to send events to xwidgets. Usually, some +equivalent of the event will be sent, but there is no guarantee of +what the widget will actually receive. + +On GTK+, only key and function key events are implemented. + ++++ +*** New function 'xwidget-webkit-load-html'. +This function is used to load HTML text into WebKit xwidgets +directly, in contrast to creating a temporary file to hold the +markup, and passing the URI of the file as an argument to +'xwidget-webkit-goto-uri'. + ++++ +*** New functions for performing searches on WebKit xwidgets. +Some new functions, such as 'xwidget-webkit-search', have been added +for performing searches on WebKit xwidgets. + ++++ +*** New function 'xwidget-webkit-back-forward-list'. +This function returns the history of page-loads in a WebKit xwidget. + ++++ +*** New function 'xwidget-webkit-estimated-load-progress'. +This function returns the estimated progress of page loading in a +WebKit xwidget. + ++++ +*** New function 'xwidget-webkit-stop-loading'. +This function terminates all data transfer during page loads in a +WebKit xwidget. + ++++ +*** 'load-changed' xwidget events are now more detailed. +In particular, they can now have different arguments based on the +state of the WebKit widget. 'load-finished' is sent when a load has +completed, 'load-started' when a load first starts, 'load-redirected' +after a redirect, and 'load-committed' when the WebKit widget first +commits to the load. + ++++ +*** New event type 'xwidget-display-event'. +These events are sent whenever an xwidget requests that Emacs displays +another xwidget. The only arguments to this event are the xwidget +that should be displayed, and the xwidget that asked to display it. + ++++ +*** New function 'xwidget-webkit-set-cookie-storage-file'. +This function is used to control where and if an xwidget stores +cookies set by web pages on disk. + +--- +** New variable 'help-buffer-under-preparation'. +This variable is bound to t during the preparation of a "*Help*" buffer. + ++++ +** Timestamps like '(1 . 1000)' now work without warnings being generated. +For example, '(time-add nil '(1 . 1000))' no longer warns that the +'(1 . 1000)' acts like '(1000 . 1000000)'. This warning, which was a +temporary transition aid for Emacs 27, has served its purpose. + ++++ +** 'encode-time' now also accepts a 6-element list with just time and date. +'(encode-time (list SECOND MINUTE HOUR DAY MONTH YEAR))' is now short for +'(encode-time (list SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil))'. + ++++ +** 'date-to-time' now accepts arguments that lack month, day, or time. +The function now assumes the earliest possible values if its argument +lacks month, day, or time. For example, (date-to-time "2021-12-04") +now assumes a time of "00:00" instead of signaling an error. + ++++ +** 'format-seconds' now allows suppressing zero-value trailing elements. +The new "%x" non-printing control character will suppress zero-value +elements that appear after "%x". + ++++ +** New events for taking advantage of touchscreen devices. +The events 'touchscreen-begin', 'touchscreen-update', and +'touchscreen-end' have been added to take better advantage of +touch-capable display panels. + ++++ +** New error symbol 'permission-denied'. +This is a subcategory of 'file-error', and is signaled when some file +operation fails because the OS doesn't allow Emacs to access a file or +a directory. + ++++ +** The ':underline' face attribute now accepts a new property. +The property ':position' now specifies the position of the underline +when used as part of a property list specification for the +':underline' attribute. + ++++ +** 'defalias' records a more precise history of definitions. +This is recorded in the 'function-history' symbol property. + +--- +** New hook 'save-place-after-find-file-hook'. +This is called at the end of 'save-place-find-file-hook'. + +--- +** 'indian-tml-base-table' no longer translates digits. +Use 'indian-tml-base-digits-table' if you want digits translation. + +--- +** 'indian-tml-itrans-v5-hash' no longer translates digits. +Use 'indian-tml-itrans-digits-v5-hash' if you want digits +translation. + ++++ +** 'shell-quote-argument' has a new optional argument POSIX. +This is useful when quoting shell arguments for a remote shell +invocation. Such shells are POSIX conformant by default. + ++++ +** 'make-process' can set connection type independently for input and output. +When calling 'make-process', communication via pty can be enabled +selectively for just input or output by passing a cons cell for +':connection-type', e.g. '(pipe . pty)'. When examining a process +later, you can determine whether a particular stream for a process +uses a pty by passing one of 'stdin', 'stdout', or 'stderr' as the +second argument to 'process-tty-name'. + ++++ +** 'signal-process' now consults the list 'signal-process-functions'. +This is to determine which function has to be called in order to +deliver the signal. This allows Tramp to send the signal to remote +asynchronous processes. The hitherto existing implementation has been +moved to 'internal-default-signal-process'. + ++++ +** Some system information functions honor remote systems now. +'list-system-processes' returns remote process IDs. +'memory-info' returns memory information of remote systems. +'process-attributes' expects a remote process ID. +This happens only when the current buffer's 'default-directory' is +remote. In order to preserve the old behavior, bind +'default-directory' to a local directory, like + + (let ((default-directory temporary-file-directory)) + (list-system-processes)) + ++++ +** New functions 'take' and 'ntake'. +'(take N LIST)' returns the first N elements of LIST; 'ntake' does +the same but works by modifying LIST destructively. + +--- +** 'string-split' is now an alias for 'split-string'. + ++++ +** 'format-spec' now accepts functions in the replacement. +The function is called only when used in the format string. This is +useful to avoid side-effects such as prompting, when the value is not +actually being used for anything. + ++++ +** The variable 'max-specpdl-size' has been made obsolete. +Now 'max-lisp-eval-depth' alone is used for limiting Lisp recursion +and stack usage. 'max-specpdl-size' is still present as a plain +variable for compatibility but its limiting powers have been taken away. + +** New function 'external-completion-table'. +This function returns a completion table designed to ease +communication between Emacs's completion facilities and external tools +offering completion services, particularly tools whose full working +set is too big to transfer to Emacs every time a completion is +needed. The table uses new 'external' completion style exclusively +and cannot work with regular styles such as 'basic' or 'flex'. + ++++ +** Magic file name handlers for 'make-directory-internal' are no longer needed. +Instead, Emacs uses the already-existing 'make-directory' handlers. + ++++ +** '(make-directory DIR t)' returns non-nil if DIR already exists. +This can let a caller know whether it created DIR. Formerly, +'make-directory's return value was unspecified. + + +* Changes in Emacs 29.1 on Non-Free Operating Systems + +** MS-Windows + +--- +*** Emacs now supports double-buffering on MS-Windows to reduce display flicker. +(This was supported on Free systems since Emacs 26.1.) + +To disable double-buffering (e.g., if it causes display problems), set +the frame parameter 'inhibit-double-buffering' to a non-nil value. +You can do that either by adding + + '(inhibit-double-buffering . t) + +to 'default-frame-alist', or by modifying the frame parameters of the +selected frame by evaluating + + (modify-frame-parameters nil '((inhibit-double-buffering . t))) + ++++ +*** Emacs now supports system dark mode. +On Windows 10 (version 1809 and higher) and Windows 11, Emacs will now +follow the system's dark mode: GUI frames use the appropriate light or +dark title bar and scroll bars, based on the user's Windows-wide color +settings. + +--- +*** Emacs now uses native image APIs to display some image formats. +On Windows 2000 and later, Emacs now defaults to using the native +image APIs for displaying the BMP, GIF, JPEG, PNG, and TIFF images. +This means Emacs on MS-Windows needs no longer use external image +support libraries to display those images. Other image types -- XPM, +SVG, and WEBP -- still need support libraries for Emacs to be able to +display them. + +The use of native image APIs is controlled by the variable +'w32-use-native-image-API', whose value now defaults to t on systems +where those APIs are available. + ++++ +*** Emacs now supports display of BMP images using native image APIs. +When 'w32-use-native-image-API' is non-nil, Emacs on MS-Windows now +has built-in support for displaying BMP images. + +--- +*** GUI Yes/No dialogs now include a "Cancel" button. +The "Cancel" button is in addition to "Yes" and "No", and is intended +to allow users to quit the dialog, as an equivalent of 'C-g' when Emacs +asks a yes/no question via the echo area. This is controlled by the +new variable 'w32-yes-no-dialog-show-cancel', by default t. Set it to +nil to get back the old behavior of showing a modal dialog with only +two buttons: "Yes" and "No". + +** Cygwin + +--- +*** 'process-attributes' is now implemented. + +** macOS + ++++ +*** The 'ns-popup-font-panel' command has been removed. +Use the general command 'M-x menu-set-font' instead. + + +---------------------------------------------------------------------- +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/>. + + +Local variables: +coding: utf-8 +mode: outline +mode: emacs-news +paragraph-separate: "[ ]" +end: diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index d610a63b09d..5f92c056018 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -332,7 +332,7 @@ When the block type starts from the upper case, structure template will now insert =#+BEGIN_TYPE=. Previously, lower-case =#+begin_type= was inserted unconditionally. *** New ox-latex tabbing support for tables. -Latex tables can now be exported to the latex tabbing environment +LaTeX tables can now be exported to the latex tabbing environment tabbing environment]]. This is done by adding =#+ATTR_LATEX: :mode tabbing= at the top of the table. @@ -4284,7 +4284,7 @@ parameters specific to some pre-defined translators, e.g., ~:environment~ and ~:booktabs~ for ~orgtbl-to-latex~. See translators docstrings (including ~orgtbl-to-generic~) for details. -*** Non-floating minted listings in Latex export +*** Non-floating minted listings in LaTeX export It is not possible to specify =#+attr_latex: :float nil= in conjunction with source blocks exported by the minted package. @@ -6540,7 +6540,7 @@ that Calc formulas can operate on them. *** Hyperlinks -**** Org-Bibtex -- major improvements +**** Org-BibTeX -- major improvements Provides support for managing bibtex bibliographical references data in headline properties. Each headline corresponds to a diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 69c42e9bed0..9ef231d4b16 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1239,6 +1239,20 @@ you should use an Emacs input method instead. * X runtime problems +** X security problems + +*** Emacs faces trouble when running as an untrusted client. + +When Emacs is running as an untrusted client under X servers with the +Security extension, it is unable to use some window manager features +but reports them to the window manager anyway. This can lead to +constant prompting by the window manager about Emacs being +unresponsive. To resolve the problem, place: + + (setq x-detect-server-trust t) + +in your early-init.el. + ** X keyboard problems *** `x-focus-frame' fails to activate the frame. @@ -1710,8 +1724,8 @@ which can be carried out at the same time: 7) If selecting text with the mouse is slow, the main culprit is likely `select-active-regions', coupled with a program monitoring - the clipboard on the X server you are connected to. Try turning - that off. + the clipboard or primary selection on the X server you are + connected to. Try turning that off. However, over networks with moderate to high latency, with no clipboard monitor running, the bottleneck is likely to be @@ -1721,6 +1735,12 @@ which can be carried out at the same time: cause Emacs features that relies on accurate mouse position reporting to stop working reliably. +8) If creating or resizing frames is slow, turn off + `frame-resize-pixelwise' (this will not take effect until you + create a new frame); then, enable `x-lax-frame-positioning'. This + means frame placement will be less accurate, but makes frame + creation, movement, and resize visibly faster. + *** Emacs gives the error, Couldn't find per display information. This can result if the X server runs out of memory because Emacs uses 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..0a2420ddead 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=$(echo "$1" | sed 's/[\"]/\\&/g'); exec emacsclient --alternate-editor= --display="$DISPLAY" --eval "(message-mailto \"$u\")" +# Special chars '"', '$', and '\' must be escaped as '\\"', '\\$', and '\\\\'. +Exec=sh -c "u=\\$(echo \\"\\$1\\" | sed 's/[\\\\\\"]/\\\\\\\\&/g'); exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" --eval \\"(message-mailto \\\\\\"\\$u\\\\\\")\\"" sh %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=sh -c "u=\\$(echo \\"\\$1\\" | sed 's/[\\\\\\"]/\\\\\\\\&/g'); exec emacsclient --alternate-editor= --create-frame --eval \\"(message-mailto \\\\\\"\\$u\\\\\\")\\"" sh %u [Desktop Action new-instance] Name=New Instance diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt index 60d72fd0d53..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-11-29T15:14:18Z +// 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 @@ -10461,9 +10473,6 @@ xin // xn--jlq480n2rg : 2019-12-19 Amazon Registry Services, Inc. 亚马逊 -// xn--jlq61u9w7b : 2015-01-08 Nokia Corporation -诺基亚 - // xn--jvr189m : 2015-02-26 Amazon Registry Services, Inc. 食品 @@ -10668,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 @@ -10682,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 @@ -10926,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 @@ -11054,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 @@ -11971,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 @@ -12485,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 @@ -12943,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 @@ -13009,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> @@ -13529,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 @@ -13681,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/ @@ -13956,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/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex index 3124ce4f7c7..815a2db2f6d 100644 --- a/etc/refcards/ru-refcard.tex +++ b/etc/refcards/ru-refcard.tex @@ -40,7 +40,7 @@ \newlength{\ColThreeWidth} \setlength{\ColThreeWidth}{25mm} -\newcommand{\versionemacs}[0]{29} % version of Emacs this is for +\newcommand{\versionemacs}[0]{30} % version of Emacs this is for \newcommand{\cyear}[0]{2023} % copyright year \newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill diff --git a/etc/themes/modus-operandi-deuteranopia-theme.el b/etc/themes/modus-operandi-deuteranopia-theme.el new file mode 100644 index 00000000000..fff62e3da9f --- /dev/null +++ b/etc/themes/modus-operandi-deuteranopia-theme.el @@ -0,0 +1,419 @@ +;;; modus-operandi-deuteranopia-theme.el --- Elegant, highly legible and customizable light theme -*- lexical-binding:t -*- + +;; Copyright (C) 2019-2023 Free Software Foundation, Inc. + +;; Author: Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> +;; URL: https://git.sr.ht/~protesilaos/modus-themes +;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Keywords: faces, theme, accessibility + +;; 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: +;; +;; The Modus themes conform with the highest standard for +;; color-contrast accessibility between background and foreground +;; values (WCAG AAA). Please refer to the official Info manual for +;; further documentation (distributed with the themes, or available +;; at: <https://protesilaos.com/emacs/modus-themes>). + +;;; Code: + + + +(eval-and-compile + (unless (and (fboundp 'require-theme) + load-file-name + (equal (file-name-directory load-file-name) + (expand-file-name "themes/" data-directory)) + (require-theme 'modus-themes t)) + (require 'modus-themes)) + + (deftheme modus-operandi-deuteranopia + "Elegant, highly legible and customizable light theme. +This variant is optimized for users with red-green color +deficiency (deuteranopia). It conforms with the highest +legibility standard for color contrast between background and +foreground in any given piece of text, which corresponds to a +minimum contrast in relative luminance of 7:1 (WCAG AAA +standard).") + + (defconst modus-operandi-deuteranopia-palette + '( +;;; Basic values + + (bg-main "#ffffff") + (bg-dim "#f0f0f0") + (fg-main "#000000") + (fg-dim "#595959") + (fg-alt "#193668") + (bg-active "#c4c4c4") + (bg-inactive "#e0e0e0") + (border "#9f9f9f") + +;;; Common accent foregrounds + + (red "#a60000") + (red-warmer "#972500") + (red-cooler "#a0132f") + (red-faint "#7f0000") + (red-intense "#d00000") + (green "#006800") + (green-warmer "#316500") + (green-cooler "#00663f") + (green-faint "#2a5045") + (green-intense "#008900") + (yellow "#7b5000") + (yellow-warmer "#884900") + (yellow-cooler "#7a4f2f") + (yellow-faint "#624416") + (yellow-intense "#808000") + (blue "#0031a9") + (blue-warmer "#3548cf") + (blue-cooler "#0000b0") + (blue-faint "#003497") + (blue-intense "#0000ff") + (magenta "#721045") + (magenta-warmer "#8f0075") + (magenta-cooler "#531ab6") + (magenta-faint "#7c318f") + (magenta-intense "#dd22dd") + (cyan "#005e8b") + (cyan-warmer "#3f578f") + (cyan-cooler "#005f5f") + (cyan-faint "#005077") + (cyan-intense "#008899") + +;;; Uncommon accent foregrounds + + (rust "#8a290f") + (gold "#80601f") + (olive "#56692d") + (slate "#2f3f83") + (indigo "#4a3a8a") + (maroon "#731c52") + (pink "#7b435c") + +;;; Common accent backgrounds + + (bg-red-intense "#ff8f88") + (bg-green-intense "#8adf80") + (bg-yellow-intense "#f3d000") + (bg-blue-intense "#bfc9ff") + (bg-magenta-intense "#dfa0f0") + (bg-cyan-intense "#a4d5f9") + + (bg-red-subtle "#ffcfbf") + (bg-green-subtle "#b3fabf") + (bg-yellow-subtle "#fff576") + (bg-blue-subtle "#ccdfff") + (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") + +;;; Uncommon accent backgrounds + + (bg-ochre "#f0e0cc") + (bg-lavender "#dfdbfa") + (bg-sage "#c0e7d4") + +;;; Graphs + + (bg-graph-red-0 "#b0b029") + (bg-graph-red-1 "#e0cab4") + (bg-graph-green-0 "#90b7c0") + (bg-graph-green-1 "#a3dfe5") + (bg-graph-yellow-0 "#ffcf00") + (bg-graph-yellow-1 "#f9ff00") + (bg-graph-blue-0 "#7f9fff") + (bg-graph-blue-1 "#9fc6ff") + (bg-graph-magenta-0 "#b0b0d0") + (bg-graph-magenta-1 "#d0dfdf") + (bg-graph-cyan-0 "#6faad9") + (bg-graph-cyan-1 "#bfe0ff") + +;;; Special purpose + + (bg-completion "#c0deff") + (bg-hover "#97dfed") + (bg-hover-secondary "#f5d0a0") + (bg-hl-line "#dae5ec") + (bg-region "#bdbdbd") + (fg-region "#000000") + + (bg-char-0 "#7feaff") + (bg-char-1 "#ffaaff") + (bg-char-2 "#dff000") + + (bg-mode-line-active "#d0d6ff") + (fg-mode-line-active "#0f0f0f") + (border-mode-line-active "#4f4f74") + (bg-mode-line-inactive "#e6e6e6") + (fg-mode-line-inactive "#585858") + (border-mode-line-inactive "#a3a3a3") + + (modeline-err "#603a00") + (modeline-warning "#454500") + (modeline-info "#023d92") + + (bg-tab-bar "#dfdfdf") + (bg-tab-current "#ffffff") + (bg-tab-other "#c2c2c2") + +;;; Diffs + + (bg-added "#d5d7ff") + (bg-added-faint "#e6e6ff") + (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-fringe "#9f6ab0") + (fg-changed "#6f1343") + (fg-changed-intense "#7f0f9f") + + (bg-removed "#f4f099") + (bg-removed-faint "#f6f6b7") + (bg-removed-refine "#f0e56f") + (bg-removed-fringe "#c0b200") + (fg-removed "#553d00") + (fg-removed-intense "#7f6f00") + + (bg-diff-context "#f3f3f3") + +;;; Paren match + + (bg-paren-match "#5fcfff") + (bg-paren-expression "#efd3f5") + (underline-paren-match unspecified) + +;;; Mappings + +;;;; General mappings + + (fringe bg-dim) + (cursor blue-intense) + + (keybind blue-cooler) + (name blue-cooler) + (identifier yellow-faint) + + (err yellow-warmer) + (warning yellow-cooler) + (info blue) + + (underline-err yellow-intense) + (underline-warning magenta-faint) + (underline-note cyan) + +;;;; Code mappings + + (builtin magenta-warmer) + (comment yellow) + (constant blue-cooler) + (docstring green-faint) + (docmarkup magenta-faint) + (fnname magenta) + (keyword magenta-cooler) + (preprocessor red-cooler) + (string blue-warmer) + (type cyan-cooler) + (variable cyan) + (rx-construct yellow-cooler) + (rx-backslash blue-cooler) + +;;;; Accent mappings + + (accent-0 blue) + (accent-1 yellow-warmer) + (accent-2 cyan) + (accent-3 magenta-cooler) + +;;;; Button mappings + + (fg-button-active fg-main) + (fg-button-inactive fg-dim) + (bg-button-active bg-active) + (bg-button-inactive bg-dim) + +;;;; Completion mappings + + (fg-completion-match-0 blue) + (fg-completion-match-1 yellow-warmer) + (fg-completion-match-2 cyan) + (fg-completion-match-3 magenta-cooler) + (bg-completion-match-0 unspecified) + (bg-completion-match-1 unspecified) + (bg-completion-match-2 unspecified) + (bg-completion-match-3 unspecified) + +;;;; Date mappings + + (date-common cyan) + (date-deadline yellow-warmer) + (date-event fg-alt) + (date-holiday yellow-warmer) + (date-now blue-faint) + (date-scheduled yellow-cooler) + (date-weekday cyan) + (date-weekend yellow-faint) + +;;;; Line number mappings + + (fg-line-number-inactive fg-dim) + (fg-line-number-active fg-main) + (bg-line-number-inactive bg-dim) + (bg-line-number-active bg-active) + +;;;; Link mappings + + (fg-link blue-warmer) + (bg-link unspecified) + (underline-link blue-warmer) + + (fg-link-symbolic cyan) + (bg-link-symbolic unspecified) + (underline-link-symbolic cyan) + + (fg-link-visited yellow-faint) + (bg-link-visited unspecified) + (underline-link-visited yellow-faint) + +;;;; Mail mappings + + (mail-cite-0 blue-warmer) + (mail-cite-1 yellow) + (mail-cite-2 blue-cooler) + (mail-cite-3 yellow-faint) + (mail-part blue) + (mail-recipient blue) + (mail-subject yellow-warmer) + (mail-other cyan-faint) + +;;;; Prompt mappings + + (fg-prompt blue) + (bg-prompt unspecified) + +;;;; Prose mappings + + (prose-block fg-dim) + (prose-code cyan-cooler) + (prose-done blue) + (prose-macro magenta-cooler) + (prose-metadata fg-dim) + (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-tag magenta-faint) + (prose-todo yellow-warmer) + (prose-verbatim magenta-warmer) + +;;;; Rainbow mappings + + (rainbow-0 blue) + (rainbow-1 yellow) + (rainbow-2 blue-warmer) + (rainbow-3 yellow-cooler) + (rainbow-4 blue-cooler) + (rainbow-5 yellow-warmer) + (rainbow-6 blue-faint) + (rainbow-7 yellow-faint) + (rainbow-8 cyan) + +;;;; Heading mappings + + (fg-heading-0 cyan-cooler) + (fg-heading-1 fg-main) + (fg-heading-2 yellow-faint) + (fg-heading-3 fg-alt) + (fg-heading-4 magenta) + (fg-heading-5 green-faint) + (fg-heading-6 red-faint) + (fg-heading-7 cyan-warmer) + (fg-heading-8 fg-dim) + + (bg-heading-0 unspecified) + (bg-heading-1 unspecified) + (bg-heading-2 unspecified) + (bg-heading-3 unspecified) + (bg-heading-4 unspecified) + (bg-heading-5 unspecified) + (bg-heading-6 unspecified) + (bg-heading-7 unspecified) + (bg-heading-8 unspecified) + + (overline-heading-0 unspecified) + (overline-heading-1 unspecified) + (overline-heading-2 unspecified) + (overline-heading-3 unspecified) + (overline-heading-4 unspecified) + (overline-heading-5 unspecified) + (overline-heading-6 unspecified) + (overline-heading-7 unspecified) + (overline-heading-8 unspecified)) + "The entire palette of the `modus-operandi-deuteranopia' theme. + +Named colors have the form (COLOR-NAME HEX-VALUE) with the former +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.") + + (defcustom modus-operandi-deuteranopia-palette-overrides nil + "Overrides for `modus-operandi-deuteranopia-palette'. + +Mirror the elements of the aforementioned palette, overriding +their value. + +For overrides that are shared across all of the Modus themes, +refer to `modus-themes-common-palette-overrides'. + +Theme-specific overrides take precedence over shared overrides. +The idea of common overrides is to change semantic color +mappings, such as to make the cursor red. Wherea theme-specific +overrides can also be used to change the value of a named color, +such as what hexadecimal RGB value the red-warmer symbol +represents." + :group 'modus-themes + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :type '(repeat (list symbol (choice symbol string))) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Palette overrides")) + + (modus-themes-theme modus-operandi-deuteranopia + modus-operandi-deuteranopia-palette + modus-operandi-deuteranopia-palette-overrides) + + (provide-theme 'modus-operandi-deuteranopia)) + +;;;###theme-autoload +(put 'modus-operandi-deuteranopia 'theme-properties '(:background-mode light :kind color-scheme :family modus)) + +;;; modus-operandi-deuteranopia-theme.el ends here diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index 0d258a26bc8..0705f926de6 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -1,13 +1,11 @@ ;;; modus-operandi-theme.el --- Elegant, highly legible and customizable light theme -*- lexical-binding:t -*- -;; Copyright (C) 2019-2023 Free Software Foundation, Inc. +;; Copyright (C) 2019-2023 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> ;; URL: https://git.sr.ht/~protesilaos/modus-themes ;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes -;; Version: 3.0.0 -;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -27,26 +25,11 @@ ;;; Commentary: ;; -;; Modus Operandi is the light variant of the Modus themes (Modus -;; Vivendi is the dark one). The themes are designed for color-contrast -;; accessibility. More specifically: -;; -;; 1. Provide a consistent minimum contrast ratio between background -;; and foreground values of 7:1 or higher. This meets the highest -;; such accessibility criterion per the guidelines of the Worldwide -;; Web Consortium's Working Group on Accessibility (WCAG AAA -;; standard). -;; -;; 2. Offer as close to full face coverage as possible. The list is -;; already quite long, with more additions to follow as part of the -;; ongoing development process. -;; -;; For a complete view of the project, also refer to the following files -;; (should be distributed in the same repository/directory as the -;; current item): -;; -;; - modus-themes.el (Main code shared between the themes) -;; - modus-vivendi-theme.el (Dark theme) +;; The Modus themes conform with the highest standard for +;; color-contrast accessibility between background and foreground +;; values (WCAG AAA). Please refer to the official Info manual for +;; further documentation (distributed with the themes, or available +;; at: <https://protesilaos.com/emacs/modus-themes>). ;;; Code: @@ -67,7 +50,364 @@ between background and foreground in any given piece of text, which corresponds to a minimum contrast in relative luminance of 7:1 (WCAG AAA standard).") - (modus-themes-theme modus-operandi) + (defconst modus-operandi-palette + '( +;;; Basic values + + (bg-main "#ffffff") + (bg-dim "#f0f0f0") + (fg-main "#000000") + (fg-dim "#595959") + (fg-alt "#193668") + (bg-active "#c4c4c4") + (bg-inactive "#e0e0e0") + (border "#9f9f9f") + +;;; Common accent foregrounds + + (red "#a60000") + (red-warmer "#972500") + (red-cooler "#a0132f") + (red-faint "#7f0000") + (red-intense "#d00000") + (green "#006800") + (green-warmer "#316500") + (green-cooler "#00663f") + (green-faint "#2a5045") + (green-intense "#008900") + (yellow "#6f5500") + (yellow-warmer "#884900") + (yellow-cooler "#7a4f2f") + (yellow-faint "#624416") + (yellow-intense "#808000") + (blue "#0031a9") + (blue-warmer "#3548cf") + (blue-cooler "#0000b0") + (blue-faint "#003497") + (blue-intense "#0000ff") + (magenta "#721045") + (magenta-warmer "#8f0075") + (magenta-cooler "#531ab6") + (magenta-faint "#7c318f") + (magenta-intense "#dd22dd") + (cyan "#005e8b") + (cyan-warmer "#3f578f") + (cyan-cooler "#005f5f") + (cyan-faint "#005077") + (cyan-intense "#008899") + +;;; Uncommon accent foregrounds + + (rust "#8a290f") + (gold "#80601f") + (olive "#56692d") + (slate "#2f3f83") + (indigo "#4a3a8a") + (maroon "#731c52") + (pink "#7b435c") + +;;; Common accent backgrounds + + (bg-red-intense "#ff8f88") + (bg-green-intense "#8adf80") + (bg-yellow-intense "#f3d000") + (bg-blue-intense "#bfc9ff") + (bg-magenta-intense "#dfa0f0") + (bg-cyan-intense "#a4d5f9") + + (bg-red-subtle "#ffcfbf") + (bg-green-subtle "#b3fabf") + (bg-yellow-subtle "#fff576") + (bg-blue-subtle "#ccdfff") + (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") + +;;; Uncommon accent backgrounds + + (bg-ochre "#f0e0cc") + (bg-lavender "#dfdbfa") + (bg-sage "#c0e7d4") + +;;; Graphs + + (bg-graph-red-0 "#ef7969") + (bg-graph-red-1 "#ffaab4") + (bg-graph-green-0 "#4faa09") + (bg-graph-green-1 "#8fef00") + (bg-graph-yellow-0 "#ffcf00") + (bg-graph-yellow-1 "#f9ff00") + (bg-graph-blue-0 "#7090ff") + (bg-graph-blue-1 "#9fc6ff") + (bg-graph-magenta-0 "#e07fff") + (bg-graph-magenta-1 "#fad0ff") + (bg-graph-cyan-0 "#70d3f0") + (bg-graph-cyan-1 "#afefff") + +;;; Special purpose + + (bg-completion "#c0deff") + (bg-hover "#94d4ff") + (bg-hover-secondary "#f5d0a0") + (bg-hl-line "#dae5ec") + (bg-region "#bdbdbd") + (fg-region "#000000") + + (bg-char-0 "#7feaff") + (bg-char-1 "#ffaaff") + (bg-char-2 "#dff000") + + (bg-mode-line-active "#c8c8c8") + (fg-mode-line-active "#000000") + (border-mode-line-active "#5a5a5a") + (bg-mode-line-inactive "#e6e6e6") + (fg-mode-line-inactive "#585858") + (border-mode-line-inactive "#a3a3a3") + + (modeline-err "#7f0000") + (modeline-warning "#5f0070") + (modeline-info "#002580") + + (bg-tab-bar "#dfdfdf") + (bg-tab-current "#ffffff") + (bg-tab-other "#c2c2c2") + +;;; Diffs + + (bg-added "#c1f2d1") + (bg-added-faint "#d8f8e1") + (bg-added-refine "#aee5be") + (bg-added-fringe "#6cc06c") + (fg-added "#005000") + (fg-added-intense "#006700") + + (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") + + (bg-diff-context "#f3f3f3") + +;;; Paren match + + (bg-paren-match "#5fcfff") + (bg-paren-expression "#efd3f5") + (underline-paren-match unspecified) + +;;; Mappings + +;;;; General mappings + + (fringe bg-dim) + (cursor fg-main) + + (keybind blue-cooler) + (name magenta) + (identifier yellow-cooler) + + (err red) + (warning yellow-warmer) + (info cyan-cooler) + + (underline-err red-intense) + (underline-warning yellow-intense) + (underline-note cyan-intense) + +;;;; Code mappings + + (builtin magenta-warmer) + (comment fg-dim) + (constant blue-cooler) + (docstring green-faint) + (docmarkup magenta-faint) + (fnname magenta) + (keyword magenta-cooler) + (preprocessor red-cooler) + (string blue-warmer) + (type cyan-cooler) + (variable cyan) + (rx-construct green-cooler) + (rx-backslash magenta) + +;;;; Accent mappings + + (accent-0 blue) + (accent-1 magenta-warmer) + (accent-2 cyan) + (accent-3 red) + +;;;; Button mappings + + (fg-button-active fg-main) + (fg-button-inactive fg-dim) + (bg-button-active bg-active) + (bg-button-inactive bg-dim) + +;;;; Completion mappings + + (fg-completion-match-0 blue) + (fg-completion-match-1 magenta-warmer) + (fg-completion-match-2 cyan) + (fg-completion-match-3 red) + (bg-completion-match-0 unspecified) + (bg-completion-match-1 unspecified) + (bg-completion-match-2 unspecified) + (bg-completion-match-3 unspecified) + +;;;; Date mappings + + (date-common cyan) + (date-deadline red) + (date-event fg-alt) + (date-holiday magenta) + (date-now fg-main) + (date-scheduled yellow-warmer) + (date-weekday cyan) + (date-weekend red-faint) + +;;;; Line number mappings + + (fg-line-number-inactive fg-dim) + (fg-line-number-active fg-main) + (bg-line-number-inactive bg-dim) + (bg-line-number-active bg-active) + +;;;; Link mappings + + (fg-link blue-warmer) + (bg-link unspecified) + (underline-link blue-warmer) + + (fg-link-symbolic cyan) + (bg-link-symbolic unspecified) + (underline-link-symbolic cyan) + + (fg-link-visited magenta) + (bg-link-visited unspecified) + (underline-link-visited magenta) + +;;;; Mail mappings + + (mail-cite-0 blue-faint) + (mail-cite-1 yellow-warmer) + (mail-cite-2 cyan-cooler) + (mail-cite-3 red-cooler) + (mail-part cyan) + (mail-recipient magenta-cooler) + (mail-subject magenta-warmer) + (mail-other magenta-faint) + +;;;; Prompt mappings + + (fg-prompt cyan-cooler) + (bg-prompt unspecified) + +;;;; Prose mappings + + (prose-block fg-dim) + (prose-code green-cooler) + (prose-done green) + (prose-macro magenta-cooler) + (prose-metadata fg-dim) + (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-tag magenta-faint) + (prose-todo red) + (prose-verbatim magenta-warmer) + +;;;; Rainbow mappings + + (rainbow-0 fg-main) + (rainbow-1 magenta-intense) + (rainbow-2 cyan-intense) + (rainbow-3 red-warmer) + (rainbow-4 yellow-intense) + (rainbow-5 magenta-cooler) + (rainbow-6 green-intense) + (rainbow-7 blue-warmer) + (rainbow-8 magenta-warmer) + +;;;; Heading mappings + + (fg-heading-0 cyan-cooler) + (fg-heading-1 fg-main) + (fg-heading-2 yellow-faint) + (fg-heading-3 fg-alt) + (fg-heading-4 magenta) + (fg-heading-5 green-faint) + (fg-heading-6 red-faint) + (fg-heading-7 cyan-warmer) + (fg-heading-8 fg-dim) + + (bg-heading-0 unspecified) + (bg-heading-1 unspecified) + (bg-heading-2 unspecified) + (bg-heading-3 unspecified) + (bg-heading-4 unspecified) + (bg-heading-5 unspecified) + (bg-heading-6 unspecified) + (bg-heading-7 unspecified) + (bg-heading-8 unspecified) + + (overline-heading-0 unspecified) + (overline-heading-1 unspecified) + (overline-heading-2 unspecified) + (overline-heading-3 unspecified) + (overline-heading-4 unspecified) + (overline-heading-5 unspecified) + (overline-heading-6 unspecified) + (overline-heading-7 unspecified) + (overline-heading-8 unspecified)) + "The entire palette of the `modus-operandi' theme. + +Named colors have the form (COLOR-NAME HEX-VALUE) with the former +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.") + + (defcustom modus-operandi-palette-overrides nil + "Overrides for `modus-operandi-palette'. + +Mirror the elements of the aforementioned palette, overriding +their value. + +For overrides that are shared across all of the Modus themes, +refer to `modus-themes-common-palette-overrides'. + +Theme-specific overrides take precedence over shared overrides. +The idea of common overrides is to change semantic color +mappings, such as to make the cursor red. Wherea theme-specific +overrides can also be used to change the value of a named color, +such as what hexadecimal RGB value the red-warmer symbol +represents." + :group 'modus-themes + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :type '(repeat (list symbol (choice symbol string))) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Palette overrides")) + + (modus-themes-theme modus-operandi + modus-operandi-palette + modus-operandi-palette-overrides) (provide-theme 'modus-operandi)) diff --git a/etc/themes/modus-operandi-tinted-theme.el b/etc/themes/modus-operandi-tinted-theme.el new file mode 100644 index 00000000000..4bb820cf686 --- /dev/null +++ b/etc/themes/modus-operandi-tinted-theme.el @@ -0,0 +1,416 @@ +;;; modus-operandi-tinted-theme.el --- Elegant, highly legible and customizable light theme -*- lexical-binding:t -*- + +;; Copyright (C) 2019-2023 Free Software Foundation, Inc. + +;; Author: Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> +;; URL: https://git.sr.ht/~protesilaos/modus-themes +;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes + +;; 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: +;; +;; The Modus themes conform with the highest standard for +;; color-contrast accessibility between background and foreground +;; values (WCAG AAA). Please refer to the official Info manual for +;; further documentation (distributed with the themes, or available +;; at: <https://protesilaos.com/emacs/modus-themes>). + +;;; Code: + + + +(eval-and-compile + (unless (and (fboundp 'require-theme) + load-file-name + (equal (file-name-directory load-file-name) + (expand-file-name "themes/" data-directory)) + (require-theme 'modus-themes t)) + (require 'modus-themes)) + + (deftheme modus-operandi-tinted + "Elegant, highly legible and customizable light theme. +Conforms with the highest legibility standard for color contrast +between background and foreground in any given piece of text, +which corresponds to a minimum contrast in relative luminance of +7:1 (WCAG AAA standard).") + + (defconst modus-operandi-tinted-palette + '( +;;; Basic values + + (bg-main "#fbf7f0") + (bg-dim "#ede7db") + (fg-main "#000000") + (fg-dim "#595959") + (fg-alt "#193668") + (bg-active "#c9b9b0") + (bg-inactive "#dfd5cf") + (border "#9f9690") + +;;; Common accent foregrounds + + (red "#a60000") + (red-warmer "#972500") + (red-cooler "#a0132f") + (red-faint "#7f0000") + (red-intense "#d00000") + (green "#006800") + (green-warmer "#316500") + (green-cooler "#00663f") + (green-faint "#2a5045") + (green-intense "#008900") + (yellow "#6f5500") + (yellow-warmer "#884900") + (yellow-cooler "#7a4f2f") + (yellow-faint "#624416") + (yellow-intense "#808000") + (blue "#0031a9") + (blue-warmer "#3548cf") + (blue-cooler "#0000b0") + (blue-faint "#003497") + (blue-intense "#0000ff") + (magenta "#721045") + (magenta-warmer "#8f0075") + (magenta-cooler "#531ab6") + (magenta-faint "#7c318f") + (magenta-intense "#dd22dd") + (cyan "#005e8b") + (cyan-warmer "#3f578f") + (cyan-cooler "#005f5f") + (cyan-faint "#005077") + (cyan-intense "#008899") + +;;; Uncommon accent foregrounds + + (rust "#8a290f") + (gold "#80601f") + (olive "#56692d") + (slate "#2f3f83") + (indigo "#4a3a8a") + (maroon "#731c52") + (pink "#7b435c") + +;;; Common accent backgrounds + + (bg-red-intense "#ff8f88") + (bg-green-intense "#8adf80") + (bg-yellow-intense "#f3d000") + (bg-blue-intense "#bfc9ff") + (bg-magenta-intense "#dfa0f0") + (bg-cyan-intense "#a4d5f9") + + (bg-red-subtle "#ffcfbf") + (bg-green-subtle "#b3fabf") + (bg-yellow-subtle "#fff576") + (bg-blue-subtle "#ccdfff") + (bg-magenta-subtle "#ffddff") + (bg-cyan-subtle "#bfefff") + + (bg-red-nuanced "#ffe8f0") + (bg-green-nuanced "#e0f5e0") + (bg-yellow-nuanced "#f9ead0") + (bg-blue-nuanced "#ebebff") + (bg-magenta-nuanced "#f6e7ff") + (bg-cyan-nuanced "#e1f3fc") + +;;; Uncommon accent backgrounds + + (bg-ochre "#f0e0cc") + (bg-lavender "#dfdbfa") + (bg-sage "#c0e7d4") + +;;; Graphs + + (bg-graph-red-0 "#ef7969") + (bg-graph-red-1 "#ffaab4") + (bg-graph-green-0 "#4faa09") + (bg-graph-green-1 "#8fef00") + (bg-graph-yellow-0 "#ffcf00") + (bg-graph-yellow-1 "#f9ff00") + (bg-graph-blue-0 "#7090ff") + (bg-graph-blue-1 "#9fc6ff") + (bg-graph-magenta-0 "#e07fff") + (bg-graph-magenta-1 "#fad0ff") + (bg-graph-cyan-0 "#70d3f0") + (bg-graph-cyan-1 "#afefff") + +;;; Special purpose + + (bg-completion "#f0c1cf") + (bg-hover "#94d4ff") + (bg-hover-secondary "#f5d0a0") + (bg-hl-line "#f1d5d0") + (bg-region "#c2bcb5") + (fg-region "#000000") + + (bg-char-0 "#7feaff") + (bg-char-1 "#ffaaff") + (bg-char-2 "#dff000") + + (bg-mode-line-active "#cab9b2") + (fg-mode-line-active "#000000") + (border-mode-line-active "#545454") + (bg-mode-line-inactive "#dfd9cf") + (fg-mode-line-inactive "#585858") + (border-mode-line-inactive "#a59a94") + + (modeline-err "#7f0000") + (modeline-warning "#5f0070") + (modeline-info "#002580") + + (bg-tab-bar "#e0d4ce") + (bg-tab-current "#fbf7f0") + (bg-tab-other "#c8b8b2") + +;;; Diffs + + (bg-added "#c3ebc1") + (bg-added-faint "#dcf8d1") + (bg-added-refine "#acd6a5") + (bg-added-fringe "#6cc06c") + (fg-added "#005000") + (fg-added-intense "#006700") + + (bg-changed "#ffdfa9") + (bg-changed-faint "#ffefbf") + (bg-changed-refine "#fac090") + (bg-changed-fringe "#c0b200") + (fg-changed "#553d00") + (fg-changed-intense "#655000") + + (bg-removed "#f4d0cf") + (bg-removed-faint "#ffe9e5") + (bg-removed-refine "#f3b5a7") + (bg-removed-fringe "#d84a4f") + (fg-removed "#8f1313") + (fg-removed-intense "#aa2222") + + (bg-diff-context "#efe9df") + +;;; Paren match + + (bg-paren-match "#7fdfcf") + (bg-paren-expression "#efd3f5") + (underline-paren-match unspecified) + +;;; Mappings + +;;;; General mappings + + (fringe bg-dim) + (cursor red) + + (keybind blue-cooler) + (name magenta) + (identifier yellow-cooler) + + (err red) + (warning yellow-warmer) + (info cyan-cooler) + + (underline-err red-intense) + (underline-warning yellow-intense) + (underline-note cyan-intense) + +;;;; Code mappings + + (builtin magenta-warmer) + (comment red-faint) + (constant blue-cooler) + (docstring green-faint) + (docmarkup magenta-faint) + (fnname magenta) + (keyword magenta-cooler) + (preprocessor red-cooler) + (string blue-warmer) + (type cyan-cooler) + (variable cyan) + (rx-construct green-cooler) + (rx-backslash magenta) + +;;;; Accent mappings + + (accent-0 blue) + (accent-1 magenta-warmer) + (accent-2 cyan) + (accent-3 red) + +;;;; Button mappings + + (fg-button-active fg-main) + (fg-button-inactive fg-dim) + (bg-button-active bg-active) + (bg-button-inactive bg-dim) + +;;;; Completion mappings + + (fg-completion-match-0 blue) + (fg-completion-match-1 magenta-warmer) + (fg-completion-match-2 cyan) + (fg-completion-match-3 red) + (bg-completion-match-0 unspecified) + (bg-completion-match-1 unspecified) + (bg-completion-match-2 unspecified) + (bg-completion-match-3 unspecified) + +;;;; Date mappings + + (date-common cyan) + (date-deadline red) + (date-event fg-alt) + (date-holiday magenta) + (date-now fg-main) + (date-scheduled yellow-warmer) + (date-weekday cyan) + (date-weekend red-faint) + +;;;; Line number mappings + + (fg-line-number-inactive fg-dim) + (fg-line-number-active fg-main) + (bg-line-number-inactive bg-dim) + (bg-line-number-active bg-active) + +;;;; Link mappings + + (fg-link blue-warmer) + (bg-link unspecified) + (underline-link blue-warmer) + + (fg-link-symbolic cyan) + (bg-link-symbolic unspecified) + (underline-link-symbolic cyan) + + (fg-link-visited magenta) + (bg-link-visited unspecified) + (underline-link-visited magenta) + +;;;; Mail mappings + + (mail-cite-0 blue-faint) + (mail-cite-1 yellow-warmer) + (mail-cite-2 cyan-cooler) + (mail-cite-3 red-cooler) + (mail-part cyan) + (mail-recipient magenta-cooler) + (mail-subject magenta-warmer) + (mail-other magenta-faint) + +;;;; Prompt mappings + + (fg-prompt cyan-cooler) + (bg-prompt unspecified) + +;;;; Prose mappings + + (prose-block fg-dim) + (prose-code green-cooler) + (prose-done green) + (prose-macro magenta-cooler) + (prose-metadata fg-dim) + (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-tag magenta-faint) + (prose-todo red) + (prose-verbatim magenta-warmer) + +;;;; Rainbow mappings + + (rainbow-0 fg-main) + (rainbow-1 magenta-intense) + (rainbow-2 cyan-intense) + (rainbow-3 red-warmer) + (rainbow-4 yellow-intense) + (rainbow-5 magenta-cooler) + (rainbow-6 green-intense) + (rainbow-7 blue-warmer) + (rainbow-8 magenta-warmer) + +;;;; Heading mappings + + (fg-heading-0 cyan-cooler) + (fg-heading-1 fg-main) + (fg-heading-2 yellow-faint) + (fg-heading-3 fg-alt) + (fg-heading-4 magenta) + (fg-heading-5 green-faint) + (fg-heading-6 red-faint) + (fg-heading-7 cyan-warmer) + (fg-heading-8 fg-dim) + + (bg-heading-0 unspecified) + (bg-heading-1 unspecified) + (bg-heading-2 unspecified) + (bg-heading-3 unspecified) + (bg-heading-4 unspecified) + (bg-heading-5 unspecified) + (bg-heading-6 unspecified) + (bg-heading-7 unspecified) + (bg-heading-8 unspecified) + + (overline-heading-0 unspecified) + (overline-heading-1 unspecified) + (overline-heading-2 unspecified) + (overline-heading-3 unspecified) + (overline-heading-4 unspecified) + (overline-heading-5 unspecified) + (overline-heading-6 unspecified) + (overline-heading-7 unspecified) + (overline-heading-8 unspecified)) + "The entire palette of the `modus-operandi-tinted' theme. + +Named colors have the form (COLOR-NAME HEX-VALUE) with the former +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.") + + (defcustom modus-operandi-tinted-palette-overrides nil + "Overrides for `modus-operandi-tinted-palette'. + +Mirror the elements of the aforementioned palette, overriding +their value. + +For overrides that are shared across all of the Modus themes, +refer to `modus-themes-common-palette-overrides'. + +Theme-specific overrides take precedence over shared overrides. +The idea of common overrides is to change semantic color +mappings, such as to make the cursor red. Wherea theme-specific +overrides can also be used to change the value of a named color, +such as what hexadecimal RGB value the red-warmer symbol +represents." + :group 'modus-themes + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :type '(repeat (list symbol (choice symbol string))) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Palette overrides")) + + (modus-themes-theme modus-operandi-tinted + modus-operandi-tinted-palette + modus-operandi-tinted-palette-overrides) + + (provide-theme 'modus-operandi-tinted)) + +;;;###theme-autoload +(put 'modus-operandi-tinted 'theme-properties '(:background-mode light :kind color-scheme :family modus)) + +;;; modus-operandi-tinted-theme.el ends here diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index 79409cd01b1..805f25b458f 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -1,12 +1,12 @@ ;;; modus-themes.el --- Elegant, highly legible and customizable themes -*- lexical-binding:t -*- -;; Copyright (C) 2019-2023 Free Software Foundation, Inc. +;; Copyright (C) 2019-2023 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> ;; URL: https://git.sr.ht/~protesilaos/modus-themes ;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes -;; Version: 3.0.0 +;; Version: 4.1.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -27,57 +27,11 @@ ;;; Commentary: ;; -;; The Modus themes conform with the highest standard for color-contrast -;; accessibility between background and foreground values (WCAG AAA). -;; This file contains all customization variables, helper functions, -;; interactive commands, and face specifications. Please refer to the -;; official Info manual for further documentation (distributed with the -;; themes, or available at: <https://protesilaos.com/emacs/modus-themes>). -;; -;; The themes share the following customization variables: -;; -;; modus-themes-completions (alist) -;; modus-themes-headings (alist) -;; modus-themes-org-agenda (alist) -;; modus-themes-bold-constructs (boolean) -;; modus-themes-deuteranopia (boolean) -;; modus-themes-inhibit-reload (boolean) -;; modus-themes-intense-mouseovers (boolean) -;; modus-themes-italic-constructs (boolean) -;; modus-themes-mixed-fonts (boolean) -;; modus-themes-subtle-line-numbers (boolean) -;; modus-themes-variable-pitch-ui (boolean) -;; modus-themes-box-buttons (choice) -;; modus-themes-diffs (choice) -;; modus-themes-fringes (choice) -;; modus-themes-hl-line (choice) -;; modus-themes-lang-checkers (choice) -;; modus-themes-links (choice) -;; modus-themes-mail-citations (choice) -;; modus-themes-markup (choice) -;; modus-themes-mode-line (choice) -;; modus-themes-org-blocks (choice) -;; modus-themes-paren-match (choice) -;; modus-themes-prompts (choice) -;; modus-themes-region (choice) -;; modus-themes-syntax (choice) -;; -;; There also exist two unique customization variables for overriding -;; color palette values. The specifics are documented in the manual. -;; The symbols are: -;; -;; modus-themes-operandi-color-overrides (alist) -;; modus-themes-vivendi-color-overrides (alist) -;; -;; Check the manual for all supported packages (there are hundreds of -;; them). -;; -;; For a complete view of the project, also refer to the following files -;; (should be distributed in the same repository/directory as the -;; current item): -;; -;; - modus-operandi-theme.el (Light theme) -;; - modus-vivendi-theme.el (Dark theme) +;; The Modus themes conform with the highest standard for +;; color-contrast accessibility between background and foreground +;; values (WCAG AAA). Please refer to the official Info manual for +;; further documentation (distributed with the themes, or available +;; at: <https://protesilaos.com/emacs/modus-themes>). ;;; Code: @@ -88,7 +42,7 @@ (require 'subr-x)) (defgroup modus-themes () - "Options for `modus-operandi', `modus-vivendi' themes. + "User options for the Modus themes. The Modus themes conform with the WCAG AAA standard for color contrast between background and foreground combinations (a minimum contrast of 7:1---the highest standard of its kind). The @@ -103,1139 +57,156 @@ cover the blue-cyan-magenta side of the spectrum." :tag "Modus Themes") (defgroup modus-themes-faces () - "Faces defined by `modus-operandi' and `modus-vivendi' themes." + "Faces defined by the Modus themes." :group 'modus-themes :link '(info-link "(modus-themes) Top") :prefix "modus-themes-" :tag "Modus Themes Faces") -(defvar modus-themes--version "3.0.0" - "Current version of the Modus themes. - -The version either is the last tagged release, such as '1.0.0', -or an in-development version like '1.1.0-dev'. As we use -semantic versioning, tags of the '1.0.1' sort are not reported: -those would count as part of '1.1.0-dev'.") - -;;;###autoload -(defun modus-themes-version (&optional insert) - "Print `modus-themes--version' in the echo area. -If optional INSERT argument is provided from Lisp or as a prefix -argument, insert the `modus-themes--version' at point." - (interactive "P") - (funcall (if insert 'insert 'message) modus-themes--version)) - -;;;###autoload -(defun modus-themes-report-bug () - "Submit a bug report or issue to the Modus themes developers." - (interactive) - (reporter-submit-bug-report - "~protesilaos/modus-themes@lists.sr.ht" - (format "modus-themes (%s)\n" modus-themes--version) - ;; I am just getting started with this. Let's first see what people - ;; think about it. - nil nil nil nil)) - -;;; Variables for each theme variant - -;;;; Modus Operandi - -(defconst modus-themes-operandi-colors - '(;; base values - (bg-main . "#ffffff") (fg-main . "#000000") - (bg-dim . "#f8f8f8") (fg-dim . "#282828") - (bg-alt . "#f0f0f0") (fg-alt . "#505050") - ;; specifically for on/off states and must be combined with - ;; themselves, though the backgrounds are also meant to be used with - ;; other "active" values, defined further below; bg-active-accent - ;; can work as a substitute for bg-active - (bg-active . "#d7d7d7") (fg-active . "#0a0a0a") - (bg-inactive . "#efefef") (fg-inactive . "#404148") - (bg-active-accent . "#d0d6ff") - ;; these special values are intended as alternatives to the base - ;; values for cases where we need to avoid confusion between the - ;; highlighted constructs; they must either be used as pairs based - ;; on their name or each can be combined with {fg,bg}-{main,alt,dim} - ;; always in accordance with their role as background or foreground - (bg-special-cold . "#dde3f4") (bg-special-faint-cold . "#f0f1ff") (fg-special-cold . "#093060") - (bg-special-mild . "#c4ede0") (bg-special-faint-mild . "#ebf5eb") (fg-special-mild . "#184034") - (bg-special-warm . "#f0e0d4") (bg-special-faint-warm . "#fef2ea") (fg-special-warm . "#5d3026") - (bg-special-calm . "#f8ddea") (bg-special-faint-calm . "#faeff9") (fg-special-calm . "#61284f") - ;; foregrounds that can be combined with bg-main, bg-dim, bg-alt - (red . "#a60000") - (red-alt . "#972500") - (red-alt-other . "#a0132f") - (red-faint . "#7f1010") - (red-alt-faint . "#702f00") - (red-alt-other-faint . "#7f002f") - (green . "#005e00") - (green-alt . "#315b00") - (green-alt-other . "#145c33") - (green-faint . "#104410") - (green-alt-faint . "#30440f") - (green-alt-other-faint . "#0f443f") - (yellow . "#813e00") - (yellow-alt . "#70480f") - (yellow-alt-other . "#863927") - (yellow-faint . "#5f4400") - (yellow-alt-faint . "#5d5000") - (yellow-alt-other-faint . "#5e3a20") - (blue . "#0031a9") - (blue-alt . "#2544bb") - (blue-alt-other . "#0000c0") - (blue-faint . "#003497") - (blue-alt-faint . "#0f3d8c") - (blue-alt-other-faint . "#001087") - (magenta . "#721045") - (magenta-alt . "#8f0075") - (magenta-alt-other . "#5317ac") - (magenta-faint . "#752f50") - (magenta-alt-faint . "#7b206f") - (magenta-alt-other-faint . "#55348e") - (cyan . "#00538b") - (cyan-alt . "#30517f") - (cyan-alt-other . "#005a5f") - (cyan-faint . "#005077") - (cyan-alt-faint . "#354f6f") - (cyan-alt-other-faint . "#125458") - ;; these foreground values can only be combined with bg-main and are - ;; thus not suitable for general purpose highlighting - (red-intense . "#b60000") - (orange-intense . "#904200") - (green-intense . "#006800") - (yellow-intense . "#605b00") - (blue-intense . "#1f1fce") - (magenta-intense . "#a8007f") - (purple-intense . "#7f10d0") - (cyan-intense . "#005f88") - ;; those foregrounds are meant exclusively for bg-active, bg-inactive - (red-active . "#8a0000") - (green-active . "#004c2e") - (yellow-active . "#702f00") - (blue-active . "#0030b4") - (magenta-active . "#5c2092") - (cyan-active . "#003f8a") - ;; the "subtle" values below be combined with fg-dim, while the - ;; "intense" should be paired with fg-main - (red-subtle-bg . "#f2b0a2") - (red-intense-bg . "#ff9f9f") - (green-subtle-bg . "#aecf90") - (green-intense-bg . "#5ada88") - (yellow-subtle-bg . "#e4c340") - (yellow-intense-bg . "#f5df23") - (blue-subtle-bg . "#b5d0ff") - (blue-intense-bg . "#77baff") - (magenta-subtle-bg . "#f0d3ff") - (magenta-intense-bg . "#d5baff") - (cyan-subtle-bg . "#c0efff") - (cyan-intense-bg . "#42cbd4") - ;; those background values must be combined with fg-main and should - ;; only be used for indicators that are placed on the fringes - (red-fringe-bg . "#f08290") - (green-fringe-bg . "#62c86a") - (yellow-fringe-bg . "#dbba3f") - (blue-fringe-bg . "#82afff") - (magenta-fringe-bg . "#e0a3ff") - (cyan-fringe-bg . "#2fcddf") - ;; those background values should only be used for graphs or similar - ;; applications where colored blocks are expected to be positioned - ;; next to each other - (red-graph-0-bg . "#ef7969") - (red-graph-1-bg . "#ffaab4") - (green-graph-0-bg . "#4faa09") - (green-graph-1-bg . "#8fef00") - (yellow-graph-0-bg . "#ffcf00") - (yellow-graph-1-bg . "#f9ff00") - (blue-graph-0-bg . "#7090ff") - (blue-graph-1-bg . "#9fc6ff") - (magenta-graph-0-bg . "#e07fff") - (magenta-graph-1-bg . "#fad0ff") - (cyan-graph-0-bg . "#70d3f0") - (cyan-graph-1-bg . "#afefff") - ;; the following are for cases where both the foreground and the - ;; background need to have a similar hue and so must be combined - ;; with themselves, even though the foregrounds can be paired with - ;; any of the base backgrounds - (red-refine-bg . "#ffcccc") (red-refine-fg . "#780000") - (green-refine-bg . "#aceaac") (green-refine-fg . "#004c00") - (yellow-refine-bg . "#fff29a") (yellow-refine-fg . "#604000") - (blue-refine-bg . "#8fcfff") (blue-refine-fg . "#002f88") - (magenta-refine-bg . "#ffccff") (magenta-refine-fg . "#770077") - (cyan-refine-bg . "#8eecf4") (cyan-refine-fg . "#004850") - ;; the "nuanced" backgrounds can be combined with all of the above - ;; foregrounds, as well as those included here, while the "nuanced" - ;; foregrounds can in turn also be combined with bg-main, bg-dim, - ;; bg-alt - (red-nuanced-bg . "#fff1f0") (red-nuanced-fg . "#5f0000") - (green-nuanced-bg . "#ecf7ed") (green-nuanced-fg . "#004000") - (yellow-nuanced-bg . "#fff3da") (yellow-nuanced-fg . "#3f3000") - (blue-nuanced-bg . "#f3f3ff") (blue-nuanced-fg . "#201f55") - (magenta-nuanced-bg . "#fdf0ff") (magenta-nuanced-fg . "#541f4f") - (cyan-nuanced-bg . "#ebf6fa") (cyan-nuanced-fg . "#0f3360") - ;; the following are reserved for specific cases - ;; - ;; bg-hl-line is between bg-dim and bg-alt, so it should - ;; work with all accents that cover those two, plus bg-main - ;; - ;; bg-hl-alt and bg-hl-alt-intense should only be used when no - ;; other grayscale or fairly neutral background is available to - ;; properly draw attention to a given construct - ;; - ;; bg-header is between bg-active and bg-inactive, so it - ;; can be combined with any of the "active" values, plus the - ;; "special" and base foreground colors - ;; - ;; bg-paren-match, bg-paren-match-intense, bg-region, - ;; bg-region-accent and bg-tab-active must be combined with fg-main, - ;; while bg-tab-inactive should be combined with fg-dim, whereas - ;; bg-tab-inactive-alt goes together with fg-main - ;; - ;; bg-completion-* and bg-char-* variants are meant to be combined - ;; with fg-main - ;; - ;; fg-escape-char-construct and fg-escape-char-backslash can - ;; be combined bg-main, bg-dim, bg-alt - ;; - ;; fg-lang-error, fg-lang-warning, fg-lang-note can be - ;; combined with bg-main, bg-dim, bg-alt - ;; - ;; fg-mark-sel, fg-mark-del, fg-mark-alt can be combined - ;; with bg-main, bg-dim, bg-alt, bg-hl-line - ;; - ;; fg-unfocused must be combined with bg-main - ;; - ;; fg-docstring, fg-comment-yellow can be combined with - ;; bg-main, bg-dim, bg-alt - ;; - ;; the window divider colors apply to faces with just an fg value - ;; - ;; all pairs are combinable with themselves - (bg-hl-line . "#f2eff3") - (bg-hl-line-intense . "#e0e0e0") - (bg-hl-line-intense-accent . "#cfe2ff") - (bg-hl-alt . "#fbeee0") - (bg-hl-alt-intense . "#e8dfd1") - (bg-paren-match . "#e0af82") - (bg-paren-match-intense . "#c488ff") - (bg-paren-expression . "#dff0ff") - (bg-region . "#bcbcbc") - (bg-region-accent . "#afafef") - (bg-region-accent-subtle . "#efdfff") - - (bg-completion . "#b7dbff") - (bg-completion-subtle . "#def3ff") - - (bg-char-0 . "#7feaff") - (bg-char-1 . "#ffaaff") - (bg-char-2 . "#dff000") - - (bg-tab-active . "#f6f6f6") - (bg-tab-inactive . "#b7b7b7") - (bg-tab-inactive-accent . "#a9b4f6") - (bg-tab-inactive-alt . "#9f9f9f") - (bg-tab-inactive-alt-accent . "#9fa6d0") - - (red-tab . "#680000") - (green-tab . "#003900") - (yellow-tab . "#393000") - (orange-tab . "#502300") - (blue-tab . "#000080") - (cyan-tab . "#052f60") - (magenta-tab . "#5f004d") - (purple-tab . "#400487") - - (fg-escape-char-construct . "#8b1030") - (fg-escape-char-backslash . "#654d0f") - - (fg-lang-error . "#9f004f") - (fg-lang-warning . "#604f0f") - (fg-lang-note . "#4040ae") - (fg-lang-underline-error . "#ef4f54") - (fg-lang-underline-warning . "#cf9f00") - (fg-lang-underline-note . "#3f6fef") - - (fg-window-divider-inner . "#888888") - (fg-window-divider-outer . "#585858") - - (fg-unfocused . "#56576d") - - (fg-docstring . "#2a486a") - (fg-comment-yellow . "#794319") - - (bg-header . "#e5e5e5") (fg-header . "#2a2a2a") - - (bg-whitespace . "#f5efef") (fg-whitespace . "#624956") - - (bg-diff-heading . "#b7cfe0") (fg-diff-heading . "#041645") - (bg-diff-added . "#d4fad4") (fg-diff-added . "#004500") - (bg-diff-added-deuteran . "#daefff") (fg-diff-added-deuteran . "#002044") - (bg-diff-changed . "#fcefcf") (fg-diff-changed . "#524200") - (bg-diff-removed . "#ffe8ef") (fg-diff-removed . "#691616") - - (bg-diff-refine-added . "#94cf94") (fg-diff-refine-added . "#002a00") - (bg-diff-refine-added-deuteran . "#77c0ef") (fg-diff-refine-added-deuteran . "#000035") - (bg-diff-refine-changed . "#cccf8f") (fg-diff-refine-changed . "#302010") - (bg-diff-refine-removed . "#daa2b0") (fg-diff-refine-removed . "#400000") - - (bg-diff-focus-added . "#bbeabb") (fg-diff-focus-added . "#002c00") - (bg-diff-focus-added-deuteran . "#bacfff") (fg-diff-focus-added-deuteran . "#001755") - (bg-diff-focus-changed . "#ecdfbf") (fg-diff-focus-changed . "#392900") - (bg-diff-focus-removed . "#efcbcf") (fg-diff-focus-removed . "#4a0000") - - (bg-mark-sel . "#a0f0cf") (fg-mark-sel . "#005040") - (bg-mark-del . "#ffccbb") (fg-mark-del . "#840040") - (bg-mark-alt . "#f5d88f") (fg-mark-alt . "#782900")) - "The entire palette of the `modus-operandi' theme. -Each element has the form (NAME . HEX) with the former as a -symbol and the latter as a string.") - -;;;; Modus Vivendi - -(defconst modus-themes-vivendi-colors - '(;; base values - (bg-main . "#000000") (fg-main . "#ffffff") - (bg-dim . "#100f10") (fg-dim . "#e0e6f0") - (bg-alt . "#191a1b") (fg-alt . "#a8a8a8") - ;; specifically for on/off states and must be combined with - ;; themselves, though the backgrounds are also meant to be used with - ;; other "active" values, defined further below; bg-active-accent - ;; can work as a substitute for bg-active - (bg-active . "#323232") (fg-active . "#f4f4f4") - (bg-inactive . "#1e1e1e") (fg-inactive . "#bfc0c4") - (bg-active-accent . "#2a2a66") - ;; these special values are intended as alternatives to the base - ;; values for cases where we need to avoid confusion between the - ;; highlighted constructs; they must either be used as pairs based - ;; on their name or each can be combined with {fg,bg}-{main,alt,dim} - ;; always in accordance with their role as background or foreground - (bg-special-cold . "#203448") (bg-special-faint-cold . "#0e183a") (fg-special-cold . "#c6eaff") - (bg-special-mild . "#00322e") (bg-special-faint-mild . "#001f1a") (fg-special-mild . "#bfebe0") - (bg-special-warm . "#382f27") (bg-special-faint-warm . "#241613") (fg-special-warm . "#f8dec0") - (bg-special-calm . "#392a48") (bg-special-faint-calm . "#251232") (fg-special-calm . "#fbd6f4") - ;; foregrounds that can be combined with bg-main, bg-dim, bg-alt - (red . "#ff8059") - (red-alt . "#ef8b50") - (red-alt-other . "#ff9077") - (red-faint . "#ffa0a0") - (red-alt-faint . "#f5aa80") - (red-alt-other-faint . "#ff9fbf") - (green . "#44bc44") - (green-alt . "#70b900") - (green-alt-other . "#00c06f") - (green-faint . "#78bf78") - (green-alt-faint . "#99b56f") - (green-alt-other-faint . "#88bf99") - (yellow . "#d0bc00") - (yellow-alt . "#c0c530") - (yellow-alt-other . "#d3b55f") - (yellow-faint . "#d2b580") - (yellow-alt-faint . "#cabf77") - (yellow-alt-other-faint . "#d0ba95") - (blue . "#2fafff") - (blue-alt . "#79a8ff" ) - (blue-alt-other . "#00bcff") - (blue-faint . "#82b0ec") - (blue-alt-faint . "#a0acef") - (blue-alt-other-faint . "#80b2f0") - (magenta . "#feacd0") - (magenta-alt . "#f78fe7") - (magenta-alt-other . "#b6a0ff") - (magenta-faint . "#e0b2d6") - (magenta-alt-faint . "#ef9fe4") - (magenta-alt-other-faint . "#cfa6ff") - (cyan . "#00d3d0") - (cyan-alt . "#4ae2f0") - (cyan-alt-other . "#6ae4b9") - (cyan-faint . "#90c4ed") - (cyan-alt-faint . "#a0bfdf") - (cyan-alt-other-faint . "#a4d0bb") - ;; these foreground values can only be combined with bg-main and are - ;; thus not suitable for general purpose highlighting - (red-intense . "#fe6060") - (orange-intense . "#fba849") - (green-intense . "#4fe42f") - (yellow-intense . "#f0dd60") - (blue-intense . "#4fafff") - (magenta-intense . "#ff62d4") - (purple-intense . "#9f80ff") - (cyan-intense . "#3fdfd0") - ;; those foregrounds are meant exclusively for bg-active, bg-inactive - (red-active . "#ffa7ba") - (green-active . "#70d73f") - (yellow-active . "#dbbe5f") - (blue-active . "#34cfff") - (magenta-active . "#d5b1ff") - (cyan-active . "#00d8b4") - ;; the "subtle" values below be combined with fg-dim, while the - ;; "intense" should be paired with fg-main - (red-subtle-bg . "#762422") - (red-intense-bg . "#a4202a") - (green-subtle-bg . "#2f4a00") - (green-intense-bg . "#006800") - (yellow-subtle-bg . "#604200") - (yellow-intense-bg . "#874900") - (blue-subtle-bg . "#10387c") - (blue-intense-bg . "#2a40b8") - (magenta-subtle-bg . "#49366e") - (magenta-intense-bg . "#7042a2") - (cyan-subtle-bg . "#00415e") - (cyan-intense-bg . "#005f88") - ;; those background values must be combined with fg-main and should - ;; only be used for indicators that are placed on the fringes - (red-fringe-bg . "#8f1f4b") - (green-fringe-bg . "#006700") - (yellow-fringe-bg . "#6f4f00") - (blue-fringe-bg . "#3f33af") - (magenta-fringe-bg . "#6f2f89") - (cyan-fringe-bg . "#004f8f") - ;; those background values should only be used for graphs or similar - ;; applications where colored blocks are expected to be positioned - ;; next to each other - (red-graph-0-bg . "#b52c2c") - (red-graph-1-bg . "#702020") - (green-graph-0-bg . "#4fd100") - (green-graph-1-bg . "#007800") - (yellow-graph-0-bg . "#f1e00a") - (yellow-graph-1-bg . "#b08600") - (blue-graph-0-bg . "#2fafef") - (blue-graph-1-bg . "#1f2f8f") - (magenta-graph-0-bg . "#bf94fe") - (magenta-graph-1-bg . "#5f509f") - (cyan-graph-0-bg . "#47dfea") - (cyan-graph-1-bg . "#00808f") - ;; the following are for cases where both the foreground and the - ;; background need to have a similar hue and so must be combined - ;; with themselves, even though the foregrounds can be paired with - ;; any of the base backgrounds - (red-refine-bg . "#77002a") (red-refine-fg . "#ffb9ab") - (green-refine-bg . "#00422a") (green-refine-fg . "#9ff0cf") - (yellow-refine-bg . "#693200") (yellow-refine-fg . "#e2d980") - (blue-refine-bg . "#242679") (blue-refine-fg . "#8ecfff") - (magenta-refine-bg . "#71206a") (magenta-refine-fg . "#ffcaf0") - (cyan-refine-bg . "#004065") (cyan-refine-fg . "#8ae4f2") - ;; the "nuanced" backgrounds can be combined with all of the above - ;; foregrounds, as well as those included here, while the "nuanced" - ;; foregrounds can in turn also be combined with bg-main, bg-dim, - ;; bg-alt - (red-nuanced-bg . "#2c0614") (red-nuanced-fg . "#ffcccc") - (green-nuanced-bg . "#001904") (green-nuanced-fg . "#b8e2b8") - (yellow-nuanced-bg . "#221000") (yellow-nuanced-fg . "#dfdfb0") - (blue-nuanced-bg . "#0f0e39") (blue-nuanced-fg . "#bfd9ff") - (magenta-nuanced-bg . "#230631") (magenta-nuanced-fg . "#e5cfef") - (cyan-nuanced-bg . "#041529") (cyan-nuanced-fg . "#a8e5e5") - ;; the following are reserved for specific cases - ;; - ;; bg-hl-line is between bg-dim and bg-alt, so it should - ;; work with all accents that cover those two, plus bg-main - ;; - ;; bg-hl-alt and bg-hl-alt-intense should only be used when no - ;; other grayscale or fairly neutral background is available to - ;; properly draw attention to a given construct - ;; - ;; bg-header is between bg-active and bg-inactive, so it - ;; can be combined with any of the "active" values, plus the - ;; "special" and base foreground colors - ;; - ;; bg-paren-match, bg-paren-match-intense, bg-region, - ;; bg-region-accent and bg-tab-active must be combined with fg-main, - ;; while bg-tab-inactive should be combined with fg-dim, whereas - ;; bg-tab-inactive-alt goes together with fg-main - ;; - ;; bg-completion-* and bg-char-* variants are meant to be combined - ;; with fg-main - ;; - ;; fg-escape-char-construct and fg-escape-char-backslash can - ;; be combined bg-main, bg-dim, bg-alt - ;; - ;; fg-lang-error, fg-lang-warning, fg-lang-note can be - ;; combined with bg-main, bg-dim, bg-alt - ;; - ;; fg-mark-sel, fg-mark-del, fg-mark-alt can be combined - ;; with bg-main, bg-dim, bg-alt, bg-hl-line - ;; - ;; fg-unfocused must be combined with bg-main - ;; - ;; fg-docstring, fg-comment-yellow can be combined with - ;; bg-main, bg-dim, bg-alt - ;; - ;; the window divider colors apply to faces with just an fg value - ;; - ;; all pairs are combinable with themselves - (bg-hl-line . "#151823") - (bg-hl-line-intense . "#292929") - (bg-hl-line-intense-accent . "#002a4f") - (bg-hl-alt . "#181732") - (bg-hl-alt-intense . "#282e46") - (bg-paren-match . "#6f3355") - (bg-paren-match-intense . "#7416b5") - (bg-paren-expression . "#221044") - (bg-region . "#3c3c3c") - (bg-region-accent . "#4f3d88") - (bg-region-accent-subtle . "#240f55") - - (bg-completion . "#142f69") - (bg-completion-subtle . "#0e194b") - - (bg-char-0 . "#0050af") - (bg-char-1 . "#7f1f7f") - (bg-char-2 . "#625a00") - - (bg-tab-active . "#0e0e0e") - (bg-tab-inactive . "#424242") - (bg-tab-inactive-accent . "#35398f") - (bg-tab-inactive-alt . "#595959") - (bg-tab-inactive-alt-accent . "#505588") - - (red-tab . "#ffc0bf") - (green-tab . "#88ef88") - (yellow-tab . "#d2e580") - (orange-tab . "#f5ca80") - (blue-tab . "#92d9ff") - (cyan-tab . "#60e7e0") - (magenta-tab . "#ffb8ff") - (purple-tab . "#cfcaff") - - (fg-escape-char-construct . "#e7a59a") - (fg-escape-char-backslash . "#abab00") - - (fg-lang-error . "#ef8690") - (fg-lang-warning . "#b0aa00") - (fg-lang-note . "#9d9def") - (fg-lang-underline-error . "#ff4a6f") - (fg-lang-underline-warning . "#d0de00") - (fg-lang-underline-note . "#5f6fff") - - (fg-window-divider-inner . "#646464") - (fg-window-divider-outer . "#969696") - - (fg-unfocused . "#93959b") - - (fg-docstring . "#b0d6f5") - (fg-comment-yellow . "#d0a070") - - (bg-header . "#212121") (fg-header . "#dddddd") - - (bg-whitespace . "#101424") (fg-whitespace . "#aa9e9f") - - (bg-diff-heading . "#304466") (fg-diff-heading . "#dae7ff") - (bg-diff-added . "#0a280a") (fg-diff-added . "#94ba94") - (bg-diff-added-deuteran . "#001a3f") (fg-diff-added-deuteran . "#c4cdf2") - (bg-diff-changed . "#2a2000") (fg-diff-changed . "#b0ba9f") - (bg-diff-removed . "#40160f") (fg-diff-removed . "#c6adaa") - - (bg-diff-refine-added . "#005a36") (fg-diff-refine-added . "#e0f6e0") - (bg-diff-refine-added-deuteran . "#234f8f") (fg-diff-refine-added-deuteran . "#dde4ff") - (bg-diff-refine-changed . "#585800") (fg-diff-refine-changed . "#ffffcc") - (bg-diff-refine-removed . "#852828") (fg-diff-refine-removed . "#ffd9eb") - - (bg-diff-focus-added . "#1d3c25") (fg-diff-focus-added . "#b4ddb4") - (bg-diff-focus-added-deuteran . "#003959") (fg-diff-focus-added-deuteran . "#bfe4ff") - (bg-diff-focus-changed . "#424200") (fg-diff-focus-changed . "#d0daaf") - (bg-diff-focus-removed . "#601f29") (fg-diff-focus-removed . "#eebdba") - - (bg-mark-sel . "#002f2f") (fg-mark-sel . "#60cfa2") - (bg-mark-del . "#5a0000") (fg-mark-del . "#ff99aa") - (bg-mark-alt . "#3f2210") (fg-mark-alt . "#f0aa20")) - "The entire palette of the `modus-vivendi' theme. -Each element has the form (NAME . HEX) with the former as a -symbol and the latter as a string.") +(make-obsolete-variable 'modus-themes-operandi-colors nil "4.0.0") +(make-obsolete-variable 'modus-themes-vivendi-colors nil "4.0.0") +(make-obsolete-variable 'modus-themes-version nil "4.0.0") +(make-obsolete 'modus-themes-report-bug nil "4.0.0") -;;; Custom faces +;;;; Custom faces ;; These faces are used internally to ensure consistency between various ;; groups and to streamline the evaluation of relevant customization ;; options. -(defface modus-themes-subtle-red nil - "Subtle red background combined with a dimmed foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-subtle-green nil - "Subtle green background combined with a dimmed foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-subtle-yellow nil - "Subtle yellow background combined with a dimmed foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-subtle-blue nil - "Subtle blue background combined with a dimmed foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-subtle-magenta nil - "Subtle magenta background combined with a dimmed foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-subtle-cyan nil - "Subtle cyan background combined with a dimmed foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-subtle-neutral nil - "Subtle gray background combined with a dimmed foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-intense-red nil - "Intense red background combined with the main foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-intense-green nil - "Intense green background combined with the main foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-intense-yellow nil - "Intense yellow background combined with the main foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-intense-blue nil - "Intense blue background combined with the main foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-intense-magenta nil - "Intense magenta background combined with the main foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-intense-cyan nil - "Intense cyan background combined with the main foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-intense-neutral nil - "Intense gray background combined with the main foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-refine-red nil - "Combination of accented red background and foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-refine-green nil - "Combination of accented green background and foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-refine-yellow nil - "Combination of accented yellow background and foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-refine-blue nil - "Combination of accented blue background and foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-refine-magenta nil - "Combination of accented magenta background and foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-refine-cyan nil - "Combination of accented cyan background and foreground. -This is used for general purpose highlighting, mostly in buffers -or for completion interfaces. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-active-red nil - "A red background meant for use on the mode line or similar. -This is combined with the mode lines primary foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-active-green nil - "A green background meant for use on the mode line or similar. -This is combined with the mode lines primary foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-active-yellow nil - "A yellow background meant for use on the mode line or similar. -This is combined with the mode lines primary foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-active-blue nil - "A blue background meant for use on the mode line or similar. -This is combined with the mode lines primary foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-active-magenta nil - "A magenta background meant for use on the mode line or similar. -This is combined with the mode lines primary foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-active-cyan nil - "A cyan background meant for use on the mode line or similar. -This is combined with the mode lines primary foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-fringe-red nil - "A red background meant for use on the fringe or similar. -This is combined with the main foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-fringe-green nil - "A green background meant for use on the fringe or similar. -This is combined with the main foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-fringe-yellow nil - "A yellow background meant for use on the fringe or similar. -This is combined with the main foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-fringe-blue nil - "A blue background meant for use on the fringe or similar. -This is combined with the main foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-fringe-magenta nil - "A magenta background meant for use on the fringe or similar. -This is combined with the main foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-fringe-cyan nil - "A cyan background meant for use on the fringe or similar. -This is combined with the main foreground value. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-nuanced-red nil - "A nuanced red background. -This does not specify a foreground of its own. Instead it is -meant to serve as the backdrop for elements such as Org blocks, -headings, and any other surface that needs to retain the colors -on display. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-nuanced-green nil - "A nuanced green background. -This does not specify a foreground of its own. Instead it is -meant to serve as the backdrop for elements such as Org blocks, -headings, and any other surface that needs to retain the colors -on display. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-nuanced-yellow nil - "A nuanced yellow background. -This does not specify a foreground of its own. Instead it is -meant to serve as the backdrop for elements such as Org blocks, -headings, and any other surface that needs to retain the colors -on display. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-nuanced-blue nil - "A nuanced blue background. -This does not specify a foreground of its own. Instead it is -meant to serve as the backdrop for elements such as Org blocks, -headings, and any other surface that needs to retain the colors -on display. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-nuanced-magenta nil - "A nuanced magenta background. -This does not specify a foreground of its own. Instead it is -meant to serve as the backdrop for elements such as Org blocks, -headings, and any other surface that needs to retain the colors -on display. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-nuanced-cyan nil - "A nuanced cyan background. -This does not specify a foreground of its own. Instead it is -meant to serve as the backdrop for elements such as Org blocks, -headings, and any other surface that needs to retain the colors -on display. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-special-cold nil - "Combines the special cold background and foreground values. -This is intended for cases when a neutral gray background is not -suitable and where a combination of more saturated colors would -not be appropriate. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-special-mild nil - "Combines the special mild background and foreground values. -This is intended for cases when a neutral gray background is not -suitable and where a combination of more saturated colors would -not be appropriate. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-special-warm nil - "Combines the special warm background and foreground values. -This is intended for cases when a neutral gray background is not -suitable and where a combination of more saturated colors would -not be appropriate. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-special-calm nil - "Combines the special calm background and foreground values. -This is intended for cases when a neutral gray background is not -suitable and where a combination of more saturated colors would -not be appropriate. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-added nil - "Combines green colors for the added state in diffs. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-changed nil - "Combines yellow colors for the changed state in diffs. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-removed nil - "Combines red colors for the removed state in diffs. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-refine-added nil - "Combines green colors for word-wise added state in diffs. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-refine-changed nil - "Combines yellow colors for word-wise changed state in diffs. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-refine-removed nil - "Combines red colors for word-wise removed state in diffs. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-focus-added nil - "Combines green colors for the focused added state in diffs. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-focus-changed nil - "Combines yellow colors for the focused changed state in diffs. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-focus-removed nil - "Combines red colors for the focused removed state in diffs. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-diff-heading nil - "Combines blue colors for the diff hunk heading. -The applied colors are contingent on the value assigned to -`modus-themes-diffs'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-pseudo-header nil - "Generic style for some elements that function like headings. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-mark-alt nil - "Combines yellow colors for marking special lines. -This is intended for use in modes such as Dired, Ibuffer, Proced. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-mark-del nil - "Combines red colors for marking deletable lines. -This is intended for use in modes such as Dired, Ibuffer, Proced. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-mark-sel nil - "Combines green colors for marking lines. -This is intended for use in modes such as Dired, Ibuffer, Proced. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-mark-symbol nil - "Applies a blue color and other styles for mark indicators. -This is intended for use in modes such as Dired, Ibuffer, Proced. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-heading-0 nil - "General purpose face for use as the document's title. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-headings' variable. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-heading-1 nil - "General purpose face for use in headings level 1. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-headings' variable. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-heading-2 nil - "General purpose face for use in headings level 2. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-headings' variable. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-heading-3 nil - "General purpose face for use in headings level 3. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-headings' variable. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-heading-4 nil - "General purpose face for use in headings level 4. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-headings' variable. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-heading-5 nil - "General purpose face for use in headings level 5. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-headings' variable. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-heading-6 nil - "General purpose face for use in headings level 6. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-headings' variable. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-heading-7 nil - "General purpose face for use in headings level 7. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-headings' variable. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-heading-8 nil - "General purpose face for use in headings level 8. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-headings' variable. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-hl-line nil - "General purpose face for the current line. -The exact attributes assigned to this face are contingent on the -values assigned to the `modus-themes-hl-line' variable. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) +(dolist (color '( red green blue yellow magenta cyan + red-warmer green-warmer blue-warmer yellow-warmer magenta-warmer cyan-warmer + red-cooler green-cooler blue-cooler yellow-cooler magenta-cooler cyan-cooler + red-faint green-faint blue-faint yellow-faint magenta-faint cyan-faint + red-intense green-intense blue-intense yellow-intense magenta-intense cyan-intense)) + (custom-declare-face + (intern (format "modus-themes-fg-%s" color)) + nil (format "Face with %s foreground." color) + :package-version '(modus-themes . "4.0.0") + :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)) + nil (format "Subtle %s background." color) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :group 'modus-themes-faces)) + +(dolist (color '(red green yellow blue magenta cyan)) + (custom-declare-face + (intern (format "modus-themes-intense-%s" color)) + nil (format "Intense %s background." color) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :group 'modus-themes-faces)) + +(dolist (scope '(alt del sel)) + (custom-declare-face + (intern (format "modus-themes-mark-%s" scope)) + nil (format "Mark of type %s." scope) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :group 'modus-themes-faces)) + +(dolist (scope '(note warning error)) + (custom-declare-face + (intern (format "modus-themes-lang-%s" scope)) + nil (format "Linter or spell check of type %s." scope) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :group 'modus-themes-faces)) + +(dolist (scope '(current lazy)) + (custom-declare-face + (intern (format "modus-themes-search-%s" scope)) + nil (format "Search of type %s." scope) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :group 'modus-themes-faces)) + +(define-obsolete-variable-alias + 'modus-themes-search-success + 'modus-themes-search-current + "4.0.0") + +(define-obsolete-variable-alias + 'modus-themes-search-success-lazy + 'modus-themes-search-lazy + "4.0.0") + +(dolist (scope '(code macro verbatim)) + (custom-declare-face + (intern (format "modus-themes-prose-%s" scope)) + nil (format "Construct of type %s for prose." scope) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :group 'modus-themes-faces)) + +(define-obsolete-variable-alias + 'modus-themes-markup-code + 'modus-themes-prose-code + "4.0.0") + +(define-obsolete-variable-alias + 'modus-themes-markup-macro + 'modus-themes-prose-macro + "4.0.0") + +(define-obsolete-variable-alias + 'modus-themes-markup-verbatim + 'modus-themes-prose-verbatim + "4.0.0") + +(dotimes (n 9) + (custom-declare-face + (intern (format "modus-themes-heading-%d" n)) + nil (format "Level %d heading." n) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :group 'modus-themes-faces)) (defface modus-themes-bold nil "Generic face for applying a conditional bold weight. -This behaves in accordance with `modus-themes-bold-constructs'. - -The actual styling of the face is done by `modus-themes-faces'." +This behaves in accordance with `modus-themes-bold-constructs'." + :package-version '(modus-themes . "4.0.0") + :version "30.1" :group 'modus-themes-faces) (defface modus-themes-slant nil "Generic face for applying a conditional slant (italics). -This behaves in accordance with `modus-themes-italic-constructs'. - -The actual styling of the face is done by `modus-themes-faces'." +This behaves in accordance with `modus-themes-italic-constructs'." + :package-version '(modus-themes . "4.0.0") + :version "30.1" :group 'modus-themes-faces) -(defface modus-themes-variable-pitch nil - "Generic face for applying a conditional `variable-pitch'. -This behaves in accordance with `modus-themes-mixed-fonts' and/or -`modus-themes-variable-pitch-ui'. - -The actual styling of the face is done by `modus-themes-faces'." +(defface modus-themes-key-binding nil + "Face for key bindings." + :package-version '(modus-themes . "4.0.0") + :version "30.1" :group 'modus-themes-faces) (defface modus-themes-fixed-pitch nil - "Generic face for applying a conditional `fixed-pitch'. -This behaves in accordance with `modus-themes-mixed-fonts'. - -The actual styling of the face is done by `modus-themes-faces'." + "Face for `fixed-pitch' if `modus-themes-mixed-fonts' is non-nil." + :package-version '(modus-themes . "4.0.0") + :version "30.1" :group 'modus-themes-faces) (defface modus-themes-ui-variable-pitch nil - "Face for `modus-themes-variable-pitch-ui'. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-lang-note nil - "Generic face for linter or spell checker notes. -The exact attributes and color combinations are controlled by -`modus-themes-lang-checkers'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-lang-warning nil - "Generic face for linter or spell checker warnings. -The exact attributes and color combinations are controlled by -`modus-themes-lang-checkers'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-lang-error nil - "Generic face for linter or spell checker errors. -The exact attributes and color combinations are controlled by -`modus-themes-lang-checkers'. - -The actual styling of the face is done by `modus-themes-faces'." + "Face for `variable-pitch' if `modus-themes-variable-pitch-ui' is non-nil." + :package-version '(modus-themes . "4.0.0") + :version "30.1" :group 'modus-themes-faces) (defface modus-themes-reset-soft nil @@ -1243,231 +214,201 @@ The actual styling of the face is done by `modus-themes-faces'." This is intended to be inherited by faces that should not retain properties from their context (e.g. an overlay over an underlined -text should not be underlined as well) yet still blend in. Also -see `modus-themes-reset-hard'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-reset-hard nil - "Generic face to set all face properties to nil. - -This is intended to be inherited by faces that should not retain -properties from their context (e.g. an overlay over an underlined -text should not be underlined as well) and not blend in. Also -see `modus-themes-reset-soft'. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-key-binding nil - "Generic face for key bindings. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-search-success nil - "Generic face for successful search. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-search-success-modeline nil - "Generic mode line indicator for successful search. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-search-success-lazy nil - "Generic face for successful, lazily highlighted search. -The actual styling of the face is done by `modus-themes-faces'." +text should not be underlined as well) yet still blend in." :group 'modus-themes-faces) (defface modus-themes-prompt nil - "Generic face for command prompts. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -;; "Grue" is "green" and "blue". -(defface modus-themes-grue nil - "Generic face for `modus-themes-deuteranopia' foreground. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-grue-active nil - "Face for `modus-themes-deuteranopia' active foreground. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-grue-nuanced nil - "Face for `modus-themes-deuteranopia' nuanced foreground. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-grue-background-active nil - "Face for `modus-themes-deuteranopia' active background. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-grue-background-intense nil - "Face for `modus-themes-deuteranopia' intense background. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-grue-background-subtle nil - "Face for `modus-themes-deuteranopia' subtle background. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-grue-background-refine nil - "Face for `modus-themes-deuteranopia' refined background. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-link-symlink nil - "Face for `modus-themes-links' symbolic link. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-link-broken nil - "Face for `modus-themes-links' broken link. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-tab-backdrop nil - "Face of backdrop in tabbed interfaces. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-tab-active nil - "Face of active tab. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-tab-inactive nil - "Face of inactive tab. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-markup-code nil - "Face of inline code markup. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-markup-macro nil - "Face of macro markup. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-markup-verbatim nil - "Face of verbatim markup. -The actual styling of the face is done by `modus-themes-faces'." + "Generic face for command prompts." :group 'modus-themes-faces) (defface modus-themes-completion-selected nil - "Face for current selection in completion UIs. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-completion-selected-popup nil - "Face for current selection in completion UI popups. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-completion-match-0 nil - "Face for completions matches 0. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-completion-match-1 nil - "Face for completions matches 1. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-completion-match-2 nil - "Face for completions matches 2. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-completion-match-3 nil - "Face for completions matches 3. -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-box-button nil - "Face for widget buttons (e.g. in the Custom UI). -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) - -(defface modus-themes-box-button-pressed nil - "Face for pressed widget buttons (e.g. in the Custom UI). -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-themes-faces) + "Face for current selection in completion UIs." + :group 'modus-themes-faces) + +(defface modus-themes-button nil + "Face for graphical buttons." + :group 'modus-themes-faces) + +(dotimes (n 4) + (custom-declare-face + (intern (format "modus-themes-completion-match-%d" n)) + nil (format "Completions match level %d." n) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :group 'modus-themes-faces)) + +(make-obsolete-variable 'modus-themes-reset-hard nil "4.0.0") +(make-obsolete-variable 'modus-themes-subtle-neutral nil "4.0.0") +(make-obsolete-variable 'modus-themes-intense-neutral nil "4.0.0") +(make-obsolete-variable 'modus-themes-refine-red nil "4.0.0") +(make-obsolete-variable 'modus-themes-refine-green nil "4.0.0") +(make-obsolete-variable 'modus-themes-refine-yellow nil "4.0.0") +(make-obsolete-variable 'modus-themes-refine-blue nil "4.0.0") +(make-obsolete-variable 'modus-themes-refine-magenta nil "4.0.0") +(make-obsolete-variable 'modus-themes-refine-cyan nil "4.0.0") +(make-obsolete-variable 'modus-themes-active-red nil "4.0.0") +(make-obsolete-variable 'modus-themes-active-green nil "4.0.0") +(make-obsolete-variable 'modus-themes-active-yellow nil "4.0.0") +(make-obsolete-variable 'modus-themes-active-blue nil "4.0.0") +(make-obsolete-variable 'modus-themes-active-magenta nil "4.0.0") +(make-obsolete-variable 'modus-themes-active-cyan nil "4.0.0") +(make-obsolete-variable 'modus-themes-fringe-red nil "4.0.0") +(make-obsolete-variable 'modus-themes-fringe-green nil "4.0.0") +(make-obsolete-variable 'modus-themes-fringe-yellow nil "4.0.0") +(make-obsolete-variable 'modus-themes-fringe-blue nil "4.0.0") +(make-obsolete-variable 'modus-themes-fringe-magenta nil "4.0.0") +(make-obsolete-variable 'modus-themes-fringe-cyan nil "4.0.0") +(make-obsolete-variable 'modus-themes-grue nil "4.0.0") +(make-obsolete-variable 'modus-themes-grue-nuanced nil "4.0.0") +(make-obsolete-variable 'modus-themes-red-nuanced nil "4.0.0") +(make-obsolete-variable 'modus-themes-green-nuanced nil "4.0.0") +(make-obsolete-variable 'modus-themes-yellow-nuanced nil "4.0.0") +(make-obsolete-variable 'modus-themes-blue-nuanced nil "4.0.0") +(make-obsolete-variable 'modus-themes-magenta-nuanced nil "4.0.0") +(make-obsolete-variable 'modus-themes-cyan-nuanced nil "4.0.0") +(make-obsolete-variable 'modus-themes-special-calm nil "4.0.0") +(make-obsolete-variable 'modus-themes-special-cold nil "4.0.0") +(make-obsolete-variable 'modus-themes-special-mild nil "4.0.0") +(make-obsolete-variable 'modus-themes-special-warm nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-added nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-changed nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-removed nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-refine-added nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-refine-changed nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-refine-removed nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-focus-added nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-focus-changed nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-focus-removed nil "4.0.0") +(make-obsolete-variable 'modus-themes-diff-heading nil "4.0.0") +(make-obsolete-variable 'modus-themes-pseudo-header nil "4.0.0") +(make-obsolete-variable 'modus-themes-mark-symbol nil "4.0.0") +(make-obsolete-variable 'modus-themes-hl-line nil "4.0.0") +(make-obsolete-variable 'modus-themes-search-success-modeline nil "4.0.0") +(make-obsolete-variable 'modus-themes-grue-active nil "4.0.0") +(make-obsolete-variable 'modus-themes-grue-background-active nil "4.0.0") +(make-obsolete-variable 'modus-themes-grue-background-intense nil "4.0.0") +(make-obsolete-variable 'modus-themes-grue-background-subtle nil "4.0.0") +(make-obsolete-variable 'modus-themes-grue-background-refine nil "4.0.0") +(make-obsolete-variable 'modus-themes-link-broken nil "4.0.0") +(make-obsolete-variable 'modus-themes-link-symlink nil "4.0.0") +(make-obsolete-variable 'modus-themes-tab-backdrop nil "4.0.0") +(make-obsolete-variable 'modus-themes-tab-active nil "4.0.0") +(make-obsolete-variable 'modus-themes-tab-inactive nil "4.0.0") +(make-obsolete-variable 'modus-themes-completion-selected-popup nil "4.0.0") +(make-obsolete-variable 'modus-themes-box-button nil "4.0.0") +(make-obsolete-variable 'modus-themes-box-button-pressed nil "4.0.0") -;;; Customization variables +;;;; Customization variables + +(defcustom modus-themes-custom-auto-reload t + "Automatically reload theme after setting options with Customize. -(defcustom modus-themes-inhibit-reload t - "Control theme reload when setting options with Customize. +All theme user options take effect when a theme is loaded. Any +subsequent changes require the theme to be reloaded. -By default, customizing a theme-related user option through the -Custom interfaces or with `customize-set-variable' will not -reload the currently active Modus theme. +When this variable has a non-nil value, any change made via the +Custom UI or related functions such as `customize-set-variable' +and `setopt' (Emacs 29), will trigger a reload automatically. -Enable this behavior by setting this variable to nil." +With a nil value, changes to user options have no further +consequences. The user must manually reload the theme." :group 'modus-themes - :package-version '(modus-themes . "1.5.0") - :version "28.1" + :package-version '(modus-themes . "4.0.0") + :version "30.1" :type 'boolean :link '(info-link "(modus-themes) Custom reload theme")) +(make-obsolete-variable 'modus-themes-inhibit-reload 'modus-themes-custom-auto-reload "4.0.0") + (defun modus-themes--set-option (sym val) "Custom setter for theme related user options. Will set SYM to VAL, and reload the current theme, unless -`modus-themes-inhibit-reload' is non-nil." +`modus-themes-custom-auto-reload' is nil." (set-default sym val) - (unless (or modus-themes-inhibit-reload - ;; Check if a theme is being loaded, in which case we - ;; don't want to reload a theme if the setter is - ;; invoked. `custom--inhibit-theme-enable' is set to nil - ;; by `enable-theme'. - (null (bound-and-true-p custom--inhibit-theme-enable))) - (let ((modus-themes-inhibit-reload t)) - (pcase (modus-themes--current-theme) - ('modus-operandi (modus-themes-load-operandi)) - ('modus-vivendi (modus-themes-load-vivendi)))))) - -(defcustom modus-themes-operandi-color-overrides nil - "Override colors in the Modus Operandi palette. - -For form, see `modus-themes-operandi-colors'." + (when (and modus-themes-custom-auto-reload + ;; Check if a theme is being loaded, in which case we + ;; don't want to reload a theme if the setter is + ;; invoked. `custom--inhibit-theme-enable' is set to nil + ;; by `enable-theme'. + (bound-and-true-p custom--inhibit-theme-enable)) + (when-let* ((modus-themes-custom-auto-reload t) + (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 . "1.1.0") - :version "28.1" - :type '(alist :key-type symbol :value-type color) + :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 + modus-operandi-deuteranopia modus-vivendi-deuteranopia) + "Symbols of the Modus themes.") + +(defcustom modus-themes-to-toggle '(modus-operandi modus-vivendi) + "Specify two Modus themes for `modus-themes-toggle' command. +The variable `modus-themes-items' contains the symbols of all +official themes that form part of this collection. + +The default value of this user option includes the original +themes: `modus-operandi' (light) and `modus-vivendi' (dark). + +If the value is nil or otherwise does not specify two valid Modus +themes, the command `modus-themes-toggle' reverts to selecting a +theme from the list of available Modus themes. In effect, it is +the same as using the command `modus-themes-select'." + :type `(choice + (const :tag "No toggle" nil) + (list :tag "Pick two themes to toggle between" + (choice :tag "Theme one of two" + ,@(mapcar (lambda (theme) + (list 'const theme)) + modus-themes-items)) + (choice :tag "Theme two of two" + ,@(mapcar (lambda (theme) + (list 'const theme)) + modus-themes-items)))) + :package-version '(modus-themes . "4.0.0") + :version "30.1" :set #'modus-themes--set-option :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Override colors")) + :group 'modus-themes) -(defcustom modus-themes-vivendi-color-overrides nil - "Override colors in the Modus Vivendi palette. +(defvaralias 'modus-themes-post-load-hook 'modus-themes-after-load-theme-hook) -For form, see `modus-themes-vivendi-colors'." - :group 'modus-themes - :package-version '(modus-themes . "1.1.0") - :version "28.1" - :type '(alist :key-type symbol :value-type color) +(defcustom modus-themes-after-load-theme-hook nil + "Hook that runs after loading a Modus theme. +This is used by the command `modus-themes-toggle'." + :type 'hook + :package-version '(modus-themes . "4.0.0") + :version "30.1" :set #'modus-themes--set-option :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Override colors")) - -;; The byte compiler complains when a defcustom isn't a top level form -(let* ((names (mapcar (lambda (pair) - (symbol-name (car pair))) - modus-themes-operandi-colors)) - (colors (mapcar #'intern (sort names #'string<)))) - (put 'modus-themes-operandi-color-overrides - 'custom-options (copy-sequence colors)) - (put 'modus-themes-vivendi-color-overrides - 'custom-options (copy-sequence colors))) + :group 'modus-themes) + +(make-obsolete-variable 'modus-themes-operandi-color-overrides nil "4.0.0") +(make-obsolete-variable 'modus-themes-vivendi-color-overrides nil "4.0.0") (defvaralias 'modus-themes-slanted-constructs 'modus-themes-italic-constructs) @@ -1510,7 +451,9 @@ tables and code blocks, to remain monospaced when users opt for something like the command `variable-pitch-mode'. Users may need to explicitly configure the font family of -`fixed-pitch' in order to get a consistent experience." +`fixed-pitch' in order to get a consistent experience with their +typography (also check the `fontaine' package on GNU ELPA (by +Protesilaos))." :group 'modus-themes :package-version '(modus-themes . "1.7.0") :version "29.1" @@ -1519,68 +462,60 @@ Users may need to explicitly configure the font family of :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Mixed fonts")) -(defcustom modus-themes-intense-mouseovers nil - "When non-nil use more intense style for mouse hover effects. - -This affects the generic `highlight' face which, strictly -speaking, is not limited to mouse usage." - :group 'modus-themes - :package-version '(modus-themes . "2.3.0") - :version "29.1" - :type 'boolean - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Mouse hover effects")) - -(defconst modus-themes--headings-choice - '(set :tag "Properties" :greedy t - (const :tag "Background color" background) +(make-obsolete-variable 'modus-themes-intense-mouseovers nil "4.0.0") + +(defconst modus-themes--weight-widget + '(choice :tag "Font weight (must be supported by the typeface)" + (const :tag "Unspecified (use whatever the default is)" nil) + (const :tag "Thin" thin) + (const :tag "Ultra-light" ultralight) + (const :tag "Extra-light" extralight) + (const :tag "Light" light) + (const :tag "Semi-light" semilight) + (const :tag "Regular" regular) + (const :tag "Medium" medium) + (const :tag "Semi-bold" semibold) + (const :tag "Bold" bold) + (const :tag "Extra-bold" extrabold) + (const :tag "Ultra-bold" ultrabold)) + "List of supported font weights used by `defcustom' forms.") + +(defconst modus-themes--headings-widget + `(set :tag "Properties" :greedy t (const :tag "Proportionately spaced font (variable-pitch)" variable-pitch) - (const :tag "Overline" overline) - (choice :tag "Font weight (must be supported by the typeface)" - (const :tag "Bold (default)" nil) - (const :tag "Thin" thin) - (const :tag "Ultra-light" ultralight) - (const :tag "Extra-light" extralight) - (const :tag "Light" light) - (const :tag "Semi-light" semilight) - (const :tag "Regular" regular) - (const :tag "Medium" medium) - (const :tag "Semi-bold" semibold) - (const :tag "Extra-bold" extrabold) - (const :tag "Ultra-bold" ultrabold)) + ,modus-themes--weight-widget (radio :tag "Height" (float :tag "Floating point to adjust height by") (cons :tag "Cons cell of `(height . FLOAT)'" (const :tag "The `height' key (constant)" height) - (float :tag "Floating point"))) - (choice :tag "Colors" - (const :tag "Subtle colors" nil) - (const :tag "Rainbow colors" rainbow) - (const :tag "Monochrome" monochrome))) + (float :tag "Floating point")))) "Refer to the doc string of `modus-themes-headings'. This is a helper variable intended for internal use.") (defcustom modus-themes-headings nil - "Heading styles with optional list of values for levels 0-8. + "Heading styles with optional list of values per heading level. -This is an alist that accepts a (key . list-of-values) -combination. The key is either a number, representing the +This is an alist that accepts a (KEY . LIST-OF-VALUES) +combination. The KEY is either a number, representing the heading's level (0-8) or t, which pertains to the fallback style. +The named keys `agenda-date' and `agenda-structure' apply to the +Org agenda. -Level 0 is a special heading: it is used for what counts as a -document title or equivalent, such as the #+title construct we -find in Org files. Levels 1-8 are regular headings. +Level 0 is used for what counts as a document title or +equivalent, such as the #+title construct we find in Org files. +Levels 1-8 are regular headings. -The list of values covers symbols that refer to properties, as -described below. Here is a complete sample, followed by a -presentation of all available properties: +The LIST-OF-VALUES covers symbols that refer to properties, as +described below. Here is a complete sample with various +stylistic combinations, followed by a presentation of all +available properties: (setq modus-themes-headings - (quote ((1 . (background overline variable-pitch 1.5)) - (2 . (overline rainbow 1.3)) - (3 . (overline 1.1)) - (t . (monochrome))))) + (quote ((1 . (variable-pitch 1.5)) + (2 . (1.3)) + (agenda-date . (1.3)) + (agenda-structure . (variable-pitch light 1.8)) + (t . (1.1))))) By default (a nil value for this variable), all headings have a bold typographic weight, use a desaturated text color, have a @@ -1588,20 +523,6 @@ font family that is the same as the `default' face (typically monospaced), and a height that is equal to the `default' face's height. -A `rainbow' property makes the text color more saturated. - -An `overline' property draws a line above the area of the -heading. - -A `background' property applies a subtle tinted color to the -background of the heading. - -A `monochrome' property makes the heading the same as the base -color, which is that of the `default' face's foreground. When -`background' is also set, `monochrome' changes its color to gray. -If both `monochrome' and `rainbow' are set, the former takes -precedence. - A `variable-pitch' property changes the font family of the heading to that of the `variable-pitch' face (normally a proportionately spaced typeface). @@ -1611,9 +532,7 @@ accordingly, such as `light', `semibold', etc. Valid symbols are defined in the variable `modus-themes-weights'. The absence of a weight means that bold will be used by virtue of inheriting the `bold' face (check the manual for tweaking bold and italic -faces). For backward compatibility, the `no-bold' value is -accepted, though users are encouraged to specify a `regular' -weight instead. +faces). A number, expressed as a floating point (e.g. 1.5), adjusts the height of the heading to that many times the base font size. The @@ -1626,19 +545,20 @@ Combinations of any of those properties are expressed as a list, like in these examples: (semibold) - (rainbow background) - (overline monochrome semibold 1.3) - (overline monochrome semibold (height 1.3)) ; same as above - (overline monochrome semibold (height . 1.3)) ; same as above + (variable-pitch semibold 1.3) + (variable-pitch semibold (height 1.3)) ; same as above + (variable-pitch semibold (height . 1.3)) ; same as above The order in which the properties are set is not significant. In user configuration files the form may look like this: (setq modus-themes-headings - (quote ((1 . (background overline rainbow 1.5)) - (2 . (background overline 1.3)) - (t . (overline semibold))))) + (quote ((1 . (variable-pitch 1.5)) + (2 . (1.3)) + (agenda-date . (1.3)) + (agenda-structure . (variable-pitch light 1.8)) + (t . (1.1))))) When defining the styles per heading level, it is possible to pass a non-nil value (t) instead of a list of properties. This @@ -1646,350 +566,39 @@ will retain the original aesthetic for that level. For example: (setq modus-themes-headings (quote ((1 . t) ; keep the default style - (2 . (background overline)) - (t . (rainbow))))) ; style for all other headings + (2 . (semibold 1.2)) + (t . (variable-pitch))))) ; style for all other headings (setq modus-themes-headings - (quote ((1 . (background overline)) - (2 . (rainbow semibold)) + (quote ((1 . (variable-pitch extrabold 1.5)) + (2 . (semibold)) (t . t)))) ; default style for all other levels -For Org users, the extent of the heading depends on the variable -`org-fontify-whole-heading-line'. This affects the `overline' -and `background' properties. Depending on the version of Org, -there may be others, such as `org-fontify-done-headline'." +Note that the text color of headings, of their background, and +overline can all be set via the overrides. It is possible to +have any color combination for any heading level (something that +could not be done in older versions of the themes). + +Read Info node `(modus-themes) Option for palette overrides' as +well as Info node `(modus-themes) Make headings more or less +colorful'. Else check `modus-themes-common-palette-overrides' +and related user options." :group 'modus-themes - :package-version '(modus-themes . "2.5.0") - :version "29.1" + :package-version '(modus-themes . "4.0.0") + :version "30.1" :type `(alist :options ,(mapcar (lambda (el) - (list el modus-themes--headings-choice)) - '(0 1 2 3 4 5 6 7 8 t)) + (list el modus-themes--headings-widget)) + '(0 1 2 3 4 5 6 7 8 t agenda-date agenda-structure)) :key-type symbol - :value-type ,modus-themes--headings-choice) + :value-type ,modus-themes--headings-widget) :set #'modus-themes--set-option :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Heading styles")) -(defcustom modus-themes-org-agenda nil - "Control the style of individual Org agenda constructs. - -This is an alist that accepts a (key . value) combination. Here -is a sample, followed by a description of all possible -combinations: - - (setq modus-themes-org-agenda - (quote ((header-block . (variable-pitch 1.5 semibold)) - (header-date . (grayscale workaholic bold-today 1.2)) - (event . (accented italic varied)) - (scheduled . uniform) - (habit . traffic-light)))) - -A `header-block' key applies to elements that concern the -headings which demarcate blocks in the structure of the agenda. -By default (a nil value) those are rendered in a bold typographic -weight, plus a height that is slightly taller than the default -font size. Acceptable values come in the form of a list that can -include either or both of those properties: - -- `variable-pitch' to use a proportionately spaced typeface; - -- A number as a floating point (e.g. 1.5) to set the height of - the text to that many times the default font height. A float - of 1.0 or the symbol `no-scale' have the same effect of making - the font the same height as the rest of the buffer. When - neither a number nor `no-scale' are present, the default is a - small increase in height (a value of 1.15). - - Instead of a floating point, an acceptable value can be in the - form of a cons cell like (height . FLOAT) or (height FLOAT), - where FLOAT is the given number. - -- The symbol of a weight attribute adjusts the font of the - heading accordingly, such as `light', `semibold', etc. Valid - symbols are defined in the variable `modus-themes-weights'. - The absence of a weight means that bold will be used by virtue - of inheriting the `bold' face (check the manual for tweaking - bold and italic faces). - -In case both a number and `no-scale' are in the list, the latter -takes precedence. If two numbers are specified, the first one is -applied. - -Example usage: - - (header-block . nil) - (header-block . (1.5)) - (header-block . (no-scale)) - (header-block . (variable-pitch 1.5)) - (header-block . (variable-pitch 1.5 semibold)) - -A `header-date' key covers date headings. Dates use only a -foreground color by default (a nil value), with weekdays and -weekends having a slight difference in hueness. The current date -has an added gray background. This key accepts a list of values -that can include any of the following properties: - -- `grayscale' to make weekdays use the main foreground color and - weekends a more subtle gray; - -- `workaholic' to make weekdays and weekends look the same in - terms of color; - -- `bold-today' to apply a bold typographic weight to the current - date; - -- `bold-all' to render all date headings in a bold weight; - -- `underline-today' applies an underline to the current date - while removing the background it has by default; - -- A number as a floating point (e.g. 1.2) to set the height of - the text to that many times the default font height. The - default is the same as the base font height (the equivalent of - 1.0). Instead of a floating point, an acceptable value can be - in the form of a cons cell like (height . FLOAT) or (height - FLOAT), where FLOAT is the given number. - -For example: - - (header-date . nil) - (header-date . (workaholic)) - (header-date . (grayscale bold-all)) - (header-date . (grayscale workaholic)) - (header-date . (grayscale workaholic bold-today)) - (header-date . (grayscale workaholic bold-today 1.2)) - -An `event' key covers (i) headings with a plain time stamp that -are shown on the agenda, also known as events, (ii) entries -imported from the diary, and (iii) other items that derive from a -symbolic expression or sexp (phases of the moon, holidays, etc.). -By default all those look the same and have a subtle foreground -color (the default is a nil value or an empty list). This key -accepts a list of properties. Those are: - -- `accented' applies an accent value to the event's foreground, - replacing the original gray. It makes all entries stand out more. -- `italic' adds a slant to the font's forms (italic or oblique - forms, depending on the typeface). -- `varied' differentiates between events with a plain time stamp - and entries that are generated from either the diary or a - symbolic expression. It generally puts more emphasis on - events. When `varied' is combined with `accented', it makes - only events use an accent color, while diary/sexp entries - retain their original subtle foreground. When `varied' is used - in tandem with `italic', it applies a slant only to diary and - sexp entries, not events. And when `varied' is the sole - property passed to the `event' key, it has the same meaning as - the list (italic varied). The combination of `varied', - `accented', `italic' covers all of the aforementioned cases. - -For example: - - (event . nil) - (event . (italic)) - (event . (accented italic)) - (event . (accented italic varied)) - -A `scheduled' key applies to tasks with a scheduled date. By -default (a nil value), these use varying shades of yellow to -denote (i) a past or current date and (ii) a future date. Valid -values are symbols: - -- nil (default); -- `uniform' to make all scheduled dates the same color; -- `rainbow' to use contrasting colors for past, present, future - scheduled dates. - -For example: - - (scheduled . nil) - (scheduled . uniform) - (scheduled . rainbow) - -A `habit' key applies to the `org-habit' graph. All possible -value are passed as a symbol. Those are: - -- The default (nil) is meant to conform with the original - aesthetic of `org-habit'. It employs all four color codes that - correspond to the org-habit states---clear, ready, alert, and - overdue---while distinguishing between their present and future - variants. This results in a total of eight colors in use: red, - yellow, green, blue, in tinted and shaded versions. They cover - the full set of information provided by the `org-habit' - consistency graph. - -- `simplified' is like the default except that it removes the - dichotomy between current and future variants by applying - uniform color-coded values. It applies a total of four colors: - red, yellow, green, blue. They produce a simplified - consistency graph that is more legible (or less \"busy\") than - the default. The intent is to shift focus towards the - distinction between the four states of a habit task, rather - than each state's present/future outlook. - -- `traffic-light' further reduces the available colors to red, - yellow, and green. As in `simplified', present and future - variants appear uniformly, but differently from it, the CLEAR - state is rendered in a green hue, instead of the original blue. - This is meant to capture the use-case where a habit task being - too early is less important than it being too late. The - difference between READY and CLEAR states is attenuated by - painting both of them using shades of green. This option thus - highlights the alert and overdue states. - -- When `modus-themes-deuteranopia' is non-nil the exact style of - the habit graph adapts to the needs of users with red-green - color deficiency by substituting every instance of green with - blue or cyan (depending on the specifics). - -For example: - - (habit . nil) - (habit . simplified) - (habit . traffic-light)" - :group 'modus-themes - :package-version '(modus-themes . "2.3.0") - :version "29.1" - :type '(set - (cons :tag "Block header" - (const header-block) - (set :tag "Header presentation" :greedy t - (choice :tag "Font style" - (const :tag "Use the original typeface (default)" nil) - (const :tag "Use `variable-pitch' font" variable-pitch)) - (choice :tag "Font weight (must be supported by the typeface)" - (const :tag "Bold (default)" nil) - (const :tag "Thin" thin) - (const :tag "Ultra-light" ultralight) - (const :tag "Extra-light" extralight) - (const :tag "Light" light) - (const :tag "Semi-light" semilight) - (const :tag "Regular" regular) - (const :tag "Medium" medium) - (const :tag "Semi-bold" semibold) - (const :tag "Extra-bold" extrabold) - (const :tag "Ultra-bold" ultrabold)) - (radio :tag "Scaling" - (const :tag "Slight increase in height (default)" nil) - (const :tag "Do not scale" no-scale) - (radio :tag "Number (float) to adjust height by" - (float :tag "Just the number") - (cons :tag "Cons cell of `(height . FLOAT)'" - (const :tag "The `height' key (constant)" height) - (float :tag "Floating point")))))) - (cons :tag "Date header" :greedy t - (const header-date) - (set :tag "Header presentation" :greedy t - (const :tag "Use grayscale for date headers" grayscale) - (const :tag "Do not differentiate weekdays from weekends" workaholic) - (const :tag "Make today bold" bold-today) - (const :tag "Make all dates bold" bold-all) - (const :tag "Make today underlined; remove the background" underline-today) - (radio :tag "Number (float) to adjust height by" - (float :tag "Just the number") - (cons :tag "Cons cell of `(height . FLOAT)'" - (const :tag "The `height' key (constant)" height) - (float :tag "Floating point"))))) - (cons :tag "Event entry" :greedy t - (const event) - (set :tag "Text presentation" :greedy t - (const :tag "Apply an accent color" accented) - (const :tag "Italic font slant (oblique forms)" italic) - (const :tag "Differentiate events from diary/sexp entries" varied))) - (cons :tag "Scheduled tasks" - (const scheduled) - (choice (const :tag "Yellow colors to distinguish current and future tasks (default)" nil) - (const :tag "Uniform subtle warm color for all scheduled tasks" uniform) - (const :tag "Rainbow-colored scheduled tasks" rainbow))) - (cons :tag "Habit graph" - (const habit) - (choice (const :tag "Follow the original design of `org-habit' (default)" nil) - (const :tag "Do not distinguish between present and future variants" simplified) - (const :tag "Use only red, yellow, green" traffic-light)))) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Org agenda")) - -(defcustom modus-themes-fringes 'subtle - "Control the visibility of fringes. - -When the value is nil, do not apply a distinct background color. - -With a value of `subtle' use a gray background color that is -visible yet close to the main background color. - -With `intense' use a more pronounced gray background color." - :group 'modus-themes - :package-version '(modus-themes . "3.0.0") - :version "29.1" - :type '(choice - (const :format "[%v] %t\n" :tag "No visible fringes" nil) - (const :format "[%v] %t\n" :tag "Subtle gray background" subtle) - (const :format "[%v] %t\n" :tag "Intense gray background" intense)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Fringes")) - -(defcustom modus-themes-lang-checkers nil - "Control the style of spelling and code checkers/linters. - -The value is a list of properties, each designated by a symbol. -The default (nil) applies a color-coded underline to the affected -text, while it leaves the original foreground intact. If the -display spec of Emacs has support for it, the underline's style -is that of a wave, otherwise it is a straight line. - -The property `straight-underline' ensures that the underline -under the affected text is always drawn as a straight line. - -The property `text-also' applies the same color of the underline -to the affected text. - -The property `background' adds a color-coded background. - -The property `intense' amplifies the applicable colors if -`background' and/or `text-also' are set. If `intense' is set on -its own, then it implies `text-also'. - -The property `faint' uses nuanced colors for the underline and -for the foreground when `text-also' is included. If both `faint' -and `intense' are specified, the former takes precedence. - -Combinations of any of those properties can be expressed in a -list, as in those examples: - - (background) - (straight-underline intense) - (background text-also straight-underline) - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - - (setq modus-themes-lang-checkers (quote (text-also background))) - -NOTE: The placement of the straight underline, though not the -wave style, is controlled by the built-in variables -`underline-minimum-offset', `x-underline-at-descent-line', -`x-use-underline-position-properties'. - -To disable fringe indicators for Flymake or Flycheck, refer to -variables `flymake-fringe-indicator-position' and -`flycheck-indication-mode', respectively." - :group 'modus-themes - :package-version '(modus-themes . "1.7.0") - :version "29.1" - :type '(set :tag "Properties" :greedy t - (const :tag "Straight underline" straight-underline) - (const :tag "Colorise text as well" text-also) - (const :tag "With background" background) - (choice :tag "Overall coloration" - (const :tag "Intense colors" intense) - (const :tag "Faint colors" faint))) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Language checkers")) +(make-obsolete-variable 'modus-themes-org-agenda nil "4.0.0") +(make-obsolete-variable 'modus-themes-fringes nil "4.0.0") +(make-obsolete-variable 'modus-themes-lang-checkers nil "4.0.0") (defcustom modus-themes-org-blocks nil "Set the overall style of Org code blocks, quotes, and the like. @@ -2004,208 +613,48 @@ block's contents. It also affects the begin and end lines of the block as they get another shade of gray as their background, which differentiates them from the contents of the block. All background colors extend to the edge of the window, giving the -area a rectangular, \"blocky\" presentation. +area a rectangular, \"blocky\" presentation. If the begin/end +lines do not extend in this way, check the value of the Org user +option `org-fontify-whole-block-delimiter-line'. -Option `tinted-background' uses a slightly colored background for -the contents of the block. The exact color will depend on the +Option `tinted-background' uses a colored background for the +contents of the block. The exact color value will depend on the programming language and is controlled by the variable `org-src-block-faces' (refer to the theme's source code for the current association list). For this to take effect, the Org -buffer needs to be restarted with `org-mode-restart'. In this -scenario, it may be better to inhibit the extension of the -delimiter lines' background to the edge of the window because Org -does not provide a mechanism to update their colors depending on -the contents of the block. Disable the extension of such -backgrounds by setting `org-fontify-whole-block-delimiter-line' -to nil. - -Code blocks use their major mode's colors only when the variable -`org-src-fontify-natively' is non-nil. While quote/verse blocks -require setting `org-fontify-quote-and-verse-blocks' to a non-nil -value. +buffer needs to be restarted with `org-mode-restart'. -Older versions of the themes provided options `grayscale' (or -`greyscale') and `rainbow'. Those will continue to work as they -are aliases for `gray-background' and `tinted-background', -respectively." +Code blocks use their major mode's fontification (syntax +highlighting) only when the variable `org-src-fontify-natively' +is non-nil. While quote/verse blocks require setting +`org-fontify-quote-and-verse-blocks' to a non-nil value." :group 'modus-themes - :package-version '(modus-themes . "2.1.0") - :version "28.1" + :package-version '(modus-themes . "4.0.0") + :version "30.1" :type '(choice (const :format "[%v] %t\n" :tag "No Org block background (default)" nil) (const :format "[%v] %t\n" :tag "Subtle gray block background" gray-background) - (const :format "[%v] %t\n" :tag "Alias for `gray-background'" grayscale) ; for backward compatibility - (const :format "[%v] %t\n" :tag "Alias for `gray-background'" greyscale) - (const :format "[%v] %t\n" :tag "Color-coded background per programming language" tinted-background) - (const :format "[%v] %t\n" :tag "Alias for `tinted-background'" rainbow)) ; back compat + (const :format "[%v] %t\n" :tag "Color-coded background per programming language" tinted-background)) :set #'modus-themes--set-option :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Org mode blocks")) -(defcustom modus-themes-mode-line nil - "Control the overall style of the mode line. - -The value is a list of properties, each designated by a symbol. -The default (a nil value or an empty list) is a two-dimensional -rectangle with a border around it. The active and the inactive -mode lines use different shades of grayscale values for the -background, foreground, border. - -The `3d' property applies a three-dimensional effect to the -active mode line. The inactive mode lines remain two-dimensional -and are toned down a bit, relative to the default style. - -The `moody' property optimizes the mode line for use with the -library of the same name (hereinafter referred to as Moody). -In practice, it removes the box effect and replaces it with -underline and overline properties. It also tones down the -inactive mode lines. Despite its intended purpose, this option -can also be used without the Moody library (please consult the -themes' manual on this point for more details). If both `3d' and -`moody' properties are set, the latter takes precedence. - -The `borderless' property removes the color of the borders. It -does not actually remove the borders, but only makes their color -the same as the background, effectively creating some padding. - -The `accented' property ensures that the active mode line uses a -colored background instead of the standard shade of gray. - -A positive integer (natural number or natnum) applies a padding -effect of NATNUM pixels at the boundaries of the mode lines. The -default value is 1 and does not need to be specified explicitly. -The padding has no effect when the `moody' property is also used, -because Moody already applies its own tweaks. To ensure that the -underline is placed at the bottom of the mode line, set -`x-underline-at-descent-line' to non-nil (this is not needed when -the `borderless' property is also set). For users on Emacs 29, -the `x-use-underline-position-properties' variable must also be -set to nil. - -The padding can also be expressed as a cons cell in the form -of (padding . NATNUM) or (padding NATNUM) where the key is -constant and NATNUM is the desired natural number. - -A floating point (e.g. 0.9) applies an adjusted height to the -mode line's text as a multiple of the main font size. The -default rate is 1.0 and does not need to be specified. Apart -from a floating point, the height may also be expressed as a cons -cell in the form of (height . FLOAT) or (height FLOAT) where the -key is constant and the FLOAT is the desired number. +(make-obsolete-variable 'modus-themes-mode-line nil "4.0.0") +(make-obsolete-variable 'modus-themes-diffs nil "4.0.0") -Combinations of any of those properties are expressed as a list, -like in these examples: - - (accented) - (borderless 3d) - (moody accented borderless) - -Same as above, using the padding and height as an example (these -all yield the same result): - - (accented borderless 4 0.9) - (accented borderless (padding . 4) (height . 0.9)) - (accented borderless (padding 4) (height 0.9)) - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - - (setq modus-themes-mode-line (quote (borderless accented))) - -Note that Moody does not expose any faces that the themes could -style directly. Instead it re-purposes existing ones to render -its tabs and ribbons. As such, there may be cases where the -contrast ratio falls below the 7:1 target that the themes conform -with (WCAG AAA). To hedge against this, we configure a fallback -foreground for the `moody' property, which will come into effect -when the background of the mode line changes to something less -accessible, such as Moody ribbons (read the doc string of -`set-face-attribute', specifically `:distant-foreground'). This -fallback is activated when Emacs determines that the background -and foreground of the given construct are too close to each other -in terms of color distance. In practice, users will need to -experiment with the variable `face-near-same-color-threshold' to -trigger the effect. We find that a value of 45000 shall suffice, -contrary to the default 30000. Though for the combinations that -involve the `accented' and `moody' properties, as mentioned -above, that should be raised up to 70000. Do not set it too -high, because it has the adverse effect of always overriding the -default colors (which have been carefully designed to be highly -accessible). - -Furthermore, because Moody expects an underline and overline -instead of a box style, it is strongly advised to set -`x-underline-at-descent-line' to a non-nil value." - :group 'modus-themes - :package-version '(modus-themes . "2.3.0") - :version "29.1" - :type '(set :tag "Properties" :greedy t - (choice :tag "Overall style" - (const :tag "Rectangular Border" nil) - (const :tag "3d borders" 3d) - (const :tag "No box effects (Moody-compatible)" moody)) - (const :tag "Colored background" accented) - (const :tag "Without border color" borderless) - (radio :tag "Padding" - (natnum :tag "Natural number (e.g. 4)") - (cons :tag "Cons cell of `(padding . NATNUM)'" - (const :tag "The `padding' key (constant)" padding) - (natnum :tag "Natural number"))) - (radio :tag "Height" - (float :tag "Floating point (e.g. 0.9)") - (cons :tag "Cons cell of `(height . FLOAT)'" - (const :tag "The `height' key (constant)" height) - (float :tag "Floating point")))) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Mode line")) - -(defcustom modus-themes-diffs nil - "Adjust the overall style of diffs. - -The default (nil) uses fairly intense color combinations for -diffs, by applying prominently colored backgrounds, with -appropriately tinted foregrounds. - -Option `desaturated' follows the same principles as with the -default (nil), though it tones down all relevant colors. - -Option `bg-only' applies a background but does not override the -text's foreground. This makes it suitable for a non-nil value -passed to `diff-font-lock-syntax' (note: Magit does not support -syntax highlighting in diffs---last checked on 2021-12-02). - -When the user option `modus-themes-deuteranopia' is non-nil, all -diffs will use a red/blue color-coding system instead of the -standard red/green. Other stylistic changes are made in the -interest of optimizing for such a use-case." - :group 'modus-themes - :package-version '(modus-themes . "2.0.0") - :version "29.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Intensely colored backgrounds (default)" nil) - (const :format "[%v] %t\n" :tag "Slightly accented backgrounds with tinted text" desaturated) - (const :format "[%v] %t\n" :tag "Apply color-coded backgrounds; keep syntax colors intact" bg-only)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Diffs")) - -(defcustom modus-themes-completions - '((selection . (intense)) - (popup . (intense))) +(defcustom modus-themes-completions nil "Control the style of completion user interfaces. -This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy, -Orderless, Selectrum, Vertico. The value is an alist that takes -the form of a (KEY . PROPERTIES) combination. KEY is a symbol, -while PROPERTIES is a list. Here is a sample, followed by a -description of the particularities: +This affects Company, Corfu, Flx, Icomplete/Fido, Ido, Ivy, +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 intense)) - (selection . (semibold accented intense)) - (popup . (accented))))) + (quote ((matches . (extrabold underline)) + (selection . (semibold italic))))) The `matches' key refers to the highlighted characters that correspond to the user's input. When its properties are nil or @@ -2214,11 +663,6 @@ have a bold weight and a colored foreground. The list of properties may include any of the following symbols regardless of the order they may appear in: -- `background' to add a background color; - -- `intense' to increase the overall coloration (also amplifies - the `background', if present); - - `underline' to draw a line below the characters; - `italic' to use a slanted font (italic or oblique forms); @@ -2235,13 +679,6 @@ a subtle gray background, a bold weight, and the base foreground value for the text. The list of properties it accepts is as follows (order is not significant): -- `accented' to make the background colorful instead of gray; - -- `text-also' to apply extra color to the text of the selected - line; - -- `intense' to increase the overall coloration; - - `underline' to draw a line below the characters; - `italic' to use a slanted font (italic or oblique forms); @@ -2251,99 +688,39 @@ follows (order is not significant): variable `modus-themes-weights'. The absence of a weight means that bold will be used. -The `popup' key takes the same values as `selection'. The only -difference is that it applies specifically to user interfaces -that display an inline popup and thus have slightly different -styling requirements than the minibuffer. The two prominent -packages are `company' and `corfu'. - -Apart from specifying each key separately, a fallback list is +Apart from specifying each key separately, a catch-all list is accepted. This is only useful when the desired aesthetic is the same across all keys that are not explicitly referenced. For example, this: (setq modus-themes-completions - (quote ((t . (extrabold intense))))) + (quote ((t . (extrabold underline))))) Is the same as: (setq modus-themes-completions - (quote ((matches . (extrabold intense)) - (selection . (extrabold intense)) - (popup . (extrabold intense))))) - -In the case of the fallback, any property that does not apply to -the corresponding key is simply ignored (`matches' does not have -`accented' and `text-also', while `selection' and `popup' do not -have `background'). - -Check the manual for tweaking `bold' and `italic' faces: Info -node `(modus-themes) Configure bold and italic faces'. - -Also refer to the documentation of the `orderless' package for -its intersection with `company' (if you choose to use those in -tandem)." + (quote ((matches . (extrabold underline)) + (selection . (extrabold underline)))))" :group 'modus-themes - :package-version '(modus-themes . "3.0.0") - :version "29.1" + :package-version '(modus-themes . "4.0.0") + :version "30.1" :type `(set (cons :tag "Matches" (const matches) (set :tag "Style of matches" :greedy t - (choice :tag "Font weight (must be supported by the typeface)" - (const :tag "Bold (default)" nil) - (const :tag "Thin" thin) - (const :tag "Ultra-light" ultralight) - (const :tag "Extra-light" extralight) - (const :tag "Light" light) - (const :tag "Semi-light" semilight) - (const :tag "Regular" regular) - (const :tag "Medium" medium) - (const :tag "Semi-bold" semibold) - (const :tag "Extra-bold" extrabold) - (const :tag "Ultra-bold" ultrabold)) - (const :tag "With added background" background) - (const :tag "Increased coloration" intense) + ,modus-themes--weight-widget (const :tag "Italic font (oblique or slanted forms)" italic) (const :tag "Underline" underline))) (cons :tag "Selection" (const selection) (set :tag "Style of selection" :greedy t - (choice :tag "Font weight (must be supported by the typeface)" - (const :tag "Bold (default)" nil) - (const :tag "Thin" thin) - (const :tag "Ultra-light" ultralight) - (const :tag "Extra-light" extralight) - (const :tag "Light" light) - (const :tag "Semi-light" semilight) - (const :tag "Regular" regular) - (const :tag "Medium" medium) - (const :tag "Semi-bold" semibold) - (const :tag "Extra-bold" extrabold) - (const :tag "Ultra-bold" ultrabold)) - (const :tag "Apply color to the line's text" text-also) - (const :tag "With accented background" accented) - (const :tag "Increased coloration" intense) + ,modus-themes--weight-widget (const :tag "Italic font (oblique or slanted forms)" italic) (const :tag "Underline" underline))) - (cons :tag "Popup" - (const popup) - (set :tag "Style of completion pop-ups" :greedy t - (choice :tag "Font weight (must be supported by the typeface)" - (const :tag "Bold (default)" nil) - (const :tag "Thin" thin) - (const :tag "Ultra-light" ultralight) - (const :tag "Extra-light" extralight) - (const :tag "Light" light) - (const :tag "Semi-light" semilight) - (const :tag "Regular" regular) - (const :tag "Medium" medium) - (const :tag "Semi-bold" semibold) - (const :tag "Extra-bold" extrabold) - (const :tag "Ultra-bold" ultrabold)) - (const :tag "Apply color to the line's text" text-also) - (const :tag "With accented background" accented) - (const :tag "Increased coloration" intense) + (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)))) :set #'modus-themes--set-option @@ -2355,512 +732,584 @@ tandem)." The value is a list of properties, each designated by a symbol. The default (a nil value or an empty list) means to only use a -subtle accented foreground color. - -The property `background' applies a background color to the -prompt's text. By default, this is a subtle accented value. - -The property `intense' makes the foreground color more prominent. -If the `background' property is also set, it amplifies the value -of the background as well. +subtle colored foreground color. -The property `gray' changes the prompt's colors to grayscale. -This affects the foreground and, if the `background' property is -also set, the background. Its effect is subtle, unless it is -combined with the `intense' property. - -The property `bold' makes the text use a bold typographic weight. -Similarly, `italic' adds a slant to the font's forms (italic or +The `italic' property adds a slant to the font's forms (italic or oblique forms, depending on the typeface). -Combinations of any of those properties are expressed as a list, -like in these examples: - - (intense) - (bold intense) - (intense bold gray) - (intense background gray bold) - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - - (setq modus-themes-prompts (quote (background gray)))" - :group 'modus-themes - :package-version '(modus-themes . "1.5.0") - :version "28.1" - :type '(set :tag "Properties" :greedy t - (const :tag "With Background" background) - (const :tag "Intense" intense) - (const :tag "Grayscale" gray) - (const :tag "Bold font weight" bold) - (const :tag "Italic font slant" italic)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Command prompts")) - -(defcustom modus-themes-hl-line '(intense) - "Control the current line highlight of `hl-line-mode'. - -The value is a list of properties, each designated by a symbol. -With a nil value, or an empty list, the style is a subtle gray -background color. - -The property `accented' changes the background to a colored -variant. - -An `underline' property draws a line below the highlighted area. -Its color is similar to the background, so gray by default or an -accent color when `accented' is also set. - -An `intense' property amplifies the colors in use, which may be -both the background and the underline. - -Combinations of any of those properties are expressed as a list, -like in these examples: - - (intense) - (underline intense) - (accented intense underline) - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - - (setq modus-themes-hl-line (quote (underline accented))) - -Set `x-underline-at-descent-line' to a non-nil value so that the -placement of the underline coincides with the lower boundary of -the colored background." - :group 'modus-themes - :package-version '(modus-themes . "3.0.0") - :version "29.1" - :type '(set :tag "Properties" :greedy t - (const :tag "Colored background" accented) - (const :tag "Underline" underline) - (const :tag "Intense style" intense)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Line highlighting")) - -(defcustom modus-themes-subtle-line-numbers nil - "Use more subtle style for command `display-line-numbers-mode'." - :group 'modus-themes - :package-version '(modus-themes . "1.2.0") - :version "28.1" - :type 'boolean - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Line numbers")) - -(defcustom modus-themes-markup nil - "Style markup in Org, Markdown, and others. - -This affects constructs such as Org's =verbatim= and ~code~. - -The value is a list of properties, each designated by a symbol. -The default (a nil value or an empty list) is a foreground -color. - -The `italic' property applies a typographic slant (italics). - -The `bold' property applies a heavier typographic weight. - -The `background' property adds a background color. The -background is a shade of gray, unless the `intense' property is -also set. - -The `intense' property amplifies the existing coloration. When -`background' is used, the background color is enhanced as well -and becomes tinted instead of being gray. +The symbol of a font weight attribute such as `light', `semibold', +et cetera, adds the given weight to links. Valid symbols are +defined in the variable `modus-themes-weights'. The absence of a +weight means that the one of the underlying text will be used. Combinations of any of those properties are expressed as a list, like in these examples: - (bold) (bold italic) - (bold italic intense) - (bold italic intense background) + (italic semibold) The order in which the properties are set is not significant. In user configuration files the form may look like this: - (setq modus-themes-markup (quote (bold italic))) - -Also check the variables `org-hide-emphasis-markers', -`org-hide-macro-markers'." + (setq modus-themes-prompts (quote (extrabold italic)))" :group 'modus-themes - :package-version '(modus-themes . "2.1.0") - :version "29.1" - :type '(set :tag "Properties" :greedy t - (const :tag "Added background" background) - (const :tag "Intense colors" intense) - (const :tag "Bold weight" bold) - (const :tag "Italics (slanted text)" italic)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Markup")) - -(defcustom modus-themes-paren-match nil - "Control the style of matching parentheses or delimiters. - -The value is a list of properties, each designated by a symbol. -The default (a nil value or an empty list) is a subtle background -color. - -The `bold' property adds a bold weight to the characters of the -matching delimiters. - -The `intense' property applies a more prominent background color -to the delimiters. - -The `underline' property draws a straight line under the affected -text. - -Combinations of any of those properties are expressed as a list, -like in these examples: - - (bold) - (underline intense) - (bold intense underline) - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - - (setq modus-themes-paren-match (quote (bold intense)))" - :group 'modus-themes - :package-version '(modus-themes . "1.5.0") - :version "28.1" - :type '(set :tag "Properties" :greedy t - (const :tag "Bold weight" bold) - (const :tag "Intense background color" intense) - (const :tag "Underline" underline)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Matching parentheses")) - -(defcustom modus-themes-syntax nil - "Control the overall style of code syntax highlighting. - -The value is a list of properties, each designated by a symbol. -The default (a nil value or an empty list) is to use a balanced -combination of colors on the cyan-blue-magenta side of the -spectrum. There is little to no use of greens, yellows, and -reds. Comments are gray, strings are blue colored, doc strings -are a shade of cyan, while color combinations are designed to -avoid exaggerations. - -The property `faint' fades the saturation of all applicable -colors, where that is possible or appropriate. - -The property `yellow-comments' applies a yellow color to -comments. - -The property `green-strings' applies a green color to strings and -a green tint to doc strings. - -The property `alt-syntax' changes the combination of colors -beyond strings and comments, so that the effective palette is -broadened to provide greater variety relative to the default. - -Combinations of any of those properties are expressed as a list, -like in these examples: - - (faint) - (green-strings yellow-comments) - (alt-syntax green-strings yellow-comments) - (faint alt-syntax green-strings yellow-comments) - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - - (setq modus-themes-syntax (quote (faint alt-syntax))) - -Independent of this variable, users may also control the use of a -bold weight or italic text: `modus-themes-bold-constructs' and -`modus-themes-italic-constructs'." - :group 'modus-themes - :package-version '(modus-themes . "1.5.0") - :version "28.1" - :type '(set :tag "Properties" :greedy t - (const :tag "Faint colors" faint) - (const :tag "Yellow comments" yellow-comments) - (const :tag "Green strings" green-strings) - (const :tag "Alternative set of colors" alt-syntax)) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :type `(set :tag "Properties" :greedy t + (const :tag "Italic font slant" italic) + ,modus-themes--weight-widget) :set #'modus-themes--set-option :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Syntax styles")) - -(defcustom modus-themes-links nil - "Set the style of links. - -The value is a list of properties, each designated by a symbol. -The default (a nil value or an empty list) is a prominent text -color, typically blue, with an underline of the same color. - -For the style of the underline, a `neutral-underline' property -turns the color of the line into a subtle gray, while the -`no-underline' property removes the line altogether. If both of -those are set, the latter takes precedence. - -For text coloration, a `faint' property desaturates the color of -the text and the underline, unless the underline is affected by -the aforementioned properties. While a `no-color' property -removes the color from the text. If both of those are set, the -latter takes precedence. - -A `bold' property applies a heavy typographic weight to the text -of the link. - -An `italic' property adds a slant to the link's text (italic or -oblique forms, depending on the typeface). - -A `background' property applies a subtle tinted background color. - -In case both `no-underline' and `no-color' are set, then a subtle -gray background is applied to all links. This can still be -combined with the `bold' and `italic' properties. - -Combinations of any of those properties are expressed as a list, -like in these examples: - - (faint) - (no-underline faint) - (no-color no-underline bold) - (italic bold background no-color no-underline) - -The order in which the properties are set is not significant. - -In user configuration files the form may look like this: - - (setq modus-themes-links (quote (neutral-underline background))) + :link '(info-link "(modus-themes) Command prompts")) -The placement of the underline, meaning its proximity to the -text, is controlled by `x-use-underline-position-properties', -`x-underline-at-descent-line', `underline-minimum-offset'. -Please refer to their documentation strings." +(make-obsolete-variable 'modus-themes-subtle-line-numbers nil "4.0.0") +(make-obsolete-variable 'modus-themes-markup nil "4.0.0") +(make-obsolete-variable 'modus-themes-paren-match nil "4.0.0") +(make-obsolete-variable 'modus-themes-syntax nil "4.0.0") +(make-obsolete-variable 'modus-themes-links nil "4.0.0") +(make-obsolete-variable 'modus-themes-region nil "4.0.0") +(make-obsolete-variable 'modus-themes-deuteranopia nil "4.0.0") +(make-obsolete-variable 'modus-themes-mail-citations nil "4.0.0") +(make-obsolete-variable 'modus-themes-tabs-accented nil "4.0.0") +(make-obsolete-variable 'modus-themes-box-buttons nil "4.0.0") + +(defcustom modus-themes-common-palette-overrides nil + "Set palette overrides for all the Modus themes. + +Mirror the elements of a theme's palette, overriding their value. +The palette variables are named THEME-NAME-palette, while +individual theme overrides are THEME-NAME-palette-overrides. The +THEME-NAME is one of the symbols in `modus-themes-items'. For +example: + +- `modus-operandi-palette' +- `modus-operandi-palette-overrides' + +Individual theme overrides take precedence over these common +overrides. + +The idea of common overrides is to change semantic color +mappings, such as to make the cursor red. Wherea theme-specific +overrides can also be used to change the value of a named color, +such as what hexadecimal RGB value the red-warmer symbol +represents." :group 'modus-themes - :package-version '(modus-themes . "1.5.0") - :version "28.1" - :type '(set :tag "Properties" :greedy t - (choice :tag "Text coloration" - (const :tag "Saturared color (default)" nil) - (const :tag "Faint coloration" faint) - (const :tag "No color (use main black/white)" no-color)) - (choice :tag "Underline" - (const :tag "Same color as text (default)" nil) - (const :tag "Neutral (gray) underline color" neutral-underline) - (const :tag "No underline" no-underline)) - (const :tag "Bold font weight" bold) - (const :tag "Italic font slant" italic) - (const :tag "Subtle background color" background)) + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :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) Link styles")) - -(defcustom modus-themes-region nil - "Control the overall style of the active region. - -The value is a list of properties, each designated by a symbol. -The default (a nil value or an empty list) is a prominent gray -background that overrides all foreground colors in the area it -encompasses. Its reach extends to the edge of the window. + :link '(info-link "(modus-themes) Palette overrides")) -The `no-extend' property limits the region to the end of the -line, so that it does not reach the edge of the window. + -The `bg-only' property makes the region's background color more -subtle to allow the underlying text to retain its foreground -colors. +;;;; Presets of palette overrides + +(defvar modus-themes-preset-overrides-faint + '((bg-completion bg-inactive) + (bg-hover bg-cyan-subtle) + (bg-hover-secondary bg-magenta-subtle) + (bg-hl-line bg-dim) + (bg-paren-match bg-cyan-subtle) + (bg-region bg-active) + + (bg-mode-line-active bg-inactive) + (border-mode-line-active fg-dim) + (bg-mode-line-inactive bg-dim) + (border-mode-line-inactive bg-active) + + (bg-tab-bar bg-inactive) + (bg-tab-current bg-main) + (bg-tab-other bg-active) + + (fringe unspecified) + (builtin maroon) + (comment fg-dim) + (constant blue-faint) + (docstring fg-alt) + (docmarkup magenta-faint) + (fnname pink) + (keyword indigo) + (preprocessor rust) + (string slate) + (type cyan-faint) + (variable cyan-faint) + (rx-construct gold) + (rx-backslash olive) + + (underline-err red-faint) + (underline-warning yellow-faint) + (underline-note cyan-faint) + + (bg-button-active bg-main) + (fg-button-active fg-main) + (bg-button-inactive bg-inactive) + (fg-button-inactive "gray50") + + (date-common cyan-faint) + (date-deadline red-faint) + (date-event fg-alt) + (date-holiday magenta) + (date-now fg-main) + (date-scheduled yellow-faint) + (date-weekday fg-dim) + (date-weekend fg-dim) + + (name maroon) + (identifier fg-dim) + + (fg-line-number-active fg-main) + (fg-line-number-inactive "gray50") + (bg-line-number-active unspecified) + (bg-line-number-inactive unspecified) + + (fg-link blue-faint) + (bg-link unspecified) + (underline-link bg-active) + + (fg-link-symbolic cyan-faint) + (bg-link-symbolic unspecified) + (underline-link-symbolic bg-active) + + (fg-link-visited magenta-faint) + (bg-link-visited unspecified) + (underline-link-visited bg-active) + + (mail-cite-0 cyan-faint) + (mail-cite-1 yellow-faint) + (mail-cite-2 green-faint) + (mail-cite-3 red-faint) + (mail-part olive) + (mail-recipient indigo) + (mail-subject maroon) + (mail-other slate) + + (fg-prompt cyan-faint) + + (prose-code olive) + (prose-done green-faint) + (prose-macro indigo) + (prose-tag rust) + (prose-todo red-faint) + (prose-verbatim maroon) + + (rainbow-0 fg-main) + (rainbow-1 magenta) + (rainbow-2 cyan) + (rainbow-3 red-faint) + (rainbow-4 yellow-faint) + (rainbow-5 magenta-cooler) + (rainbow-6 green) + (rainbow-7 blue-warmer) + (rainbow-8 magenta-faint)) + "Preset for palette overrides with faint coloration. + +This changes many parts of the theme to make them look less +colorful/intense. Grays are toned down, gray backgrounds are +removed from some contexts, and almost all accent colors are +desaturated. + +To set a preset, assign its symbol without a quote as the value +of the `modus-themes-common-palette-overrides' or as the value of +theme-specific options such as `modus-operandi-palette-overrides'. + +Also see `modus-themes-preset-overrides-intense'. + +For overriding named colors and/or semantic color mappings read +Info node `(modus-themes) Option for palette overrides'.") + +(defvar modus-themes-preset-overrides-intense + '((bg-region bg-cyan-intense) + + (bg-completion bg-cyan-subtle) + (bg-hover bg-yellow-intense) + (bg-hover-secondary bg-magenta-intense) + (bg-hl-line bg-cyan-subtle) + + (bg-mode-line-active bg-blue-subtle) + (fg-mode-line-active fg-main) + (border-mode-line-active blue-intense) + + (fringe bg-inactive) + (comment red-faint) + + (date-common cyan) + (date-deadline red) + (date-event blue) + (date-holiday magenta-warmer) + (date-now blue-faint) + (date-scheduled yellow-warmer) + (date-weekday fg-main) + (date-weekend red-faint) + + (keybind blue-intense) + + (mail-cite-0 blue) + (mail-cite-1 yellow) + (mail-cite-2 green) + (mail-cite-3 magenta) + (mail-part magenta-cooler) + (mail-recipient cyan) + (mail-subject red-warmer) + (mail-other cyan-cooler) + + (fg-prompt blue-intense) + + (prose-block red-faint) + (prose-done green-intense) + (prose-metadata cyan-faint) + (prose-metadata-value blue-cooler) + (prose-table cyan) + (prose-todo red-intense) + + (fg-heading-0 blue-cooler) + (fg-heading-1 magenta-cooler) + (fg-heading-2 magenta-warmer) + (fg-heading-3 blue) + (fg-heading-4 cyan) + (fg-heading-5 green-warmer) + (fg-heading-6 yellow) + (fg-heading-7 red) + (fg-heading-8 magenta) + + (bg-heading-0 unspecified) + (bg-heading-1 bg-magenta-nuanced) + (bg-heading-2 bg-red-nuanced) + (bg-heading-3 bg-blue-nuanced) + (bg-heading-4 bg-cyan-nuanced) + (bg-heading-5 bg-green-nuanced) + (bg-heading-6 bg-yellow-nuanced) + (bg-heading-7 bg-red-nuanced) + (bg-heading-8 bg-magenta-nuanced) + + (overline-heading-0 unspecified) + (overline-heading-1 magenta-cooler) + (overline-heading-2 magenta-warmer) + (overline-heading-3 blue) + (overline-heading-4 cyan) + (overline-heading-5 green) + (overline-heading-6 yellow-cooler) + (overline-heading-7 red-cooler) + (overline-heading-8 magenta)) + "Preset for palette overrides with faint coloration. + +This changes many parts of the theme to make them look more +colorful/intense. Many background colors are accented and +coloration is increased to pop out more. + +To set a preset, assign its symbol without a quote as the value +of the `modus-themes-common-palette-overrides' or as the value of +theme-specific options such as `modus-operandi-palette-overrides'. + +Also see `modus-themes-preset-overrides-faint'. + +For overriding named colors and/or semantic color mappings read +Info node `(modus-themes) Option for palette overrides'.") -The `accented' property applies a more colorful background to the -region. + -Combinations of any of those properties are expressed as a list, -like in these examples: +;;;; Helper functions for theme setup - (no-extend) - (bg-only accented) - (accented bg-only no-extend) +;; This is the WCAG formula: https://www.w3.org/TR/WCAG20-TECHS/G18.html +(defun modus-themes-wcag-formula (hex) + "Get WCAG value of color value HEX. +The value is defined in hexadecimal RGB notation, such #123456." + (cl-loop for k in '(0.2126 0.7152 0.0722) + for x in (color-name-to-rgb hex) + sum (* k (if (<= x 0.03928) + (/ x 12.92) + (expt (/ (+ x 0.055) 1.055) 2.4))))) -The order in which the properties are set is not significant. +;;;###autoload +(defun modus-themes-contrast (c1 c2) + "Measure WCAG contrast ratio between C1 and C2. +C1 and C2 are color values written in hexadecimal RGB." + (let ((ct (/ (+ (modus-themes-wcag-formula c1) 0.05) + (+ (modus-themes-wcag-formula c2) 0.05)))) + (max ct (/ ct)))) -In user configuration files the form may look like this: +(make-obsolete 'modus-themes-color nil "4.0.0") +(make-obsolete 'modus-themes-color-alts nil "4.0.0") + +(declare-function cl-remove-if-not "cl-seq" (cl-pred cl-list &rest cl-keys)) + +(defun modus-themes--list-enabled-themes () + "Return list of `custom-enabled-themes' with modus- prefix." + (cl-remove-if-not + (lambda (theme) + (string-prefix-p "modus-" (symbol-name theme))) + custom-enabled-themes)) + +(defun modus-themes--enable-themes () + "Enable the Modus themes." + (mapc (lambda (theme) + (unless (memq theme custom-known-themes) + (load-theme theme :no-confirm :no-enable))) + modus-themes-items)) + +(defun modus-themes--list-known-themes () + "Return list of `custom-known-themes' with modus- prefix." + (modus-themes--enable-themes) + (cl-remove-if-not + (lambda (theme) + (string-prefix-p "modus-" (symbol-name theme))) + custom-known-themes)) - (setq modus-themes-region (quote (bg-only no-extend)))" - :group 'modus-themes - :package-version '(modus-themes . "1.5.0") - :version "28.1" - :type '(set :tag "Properties" :greedy t - (const :tag "Do not extend to the edge of the window" no-extend) - (const :tag "Background only (preserve underlying colors)" bg-only) - (const :tag "Accented background" accented)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Active region")) - -(defcustom modus-themes-deuteranopia nil - "When non-nil use red/blue color-coding instead of red/green. - -This is to account for red-green color deficiency, also know as -deuteranopia and variants. It applies to all contexts where -there can be a color-coded distinction between failure or -success, a to-do or done state, a mark for deletion versus a mark -for selection (e.g. in Dired), current and lazily highlighted -search matches, removed lines in diffs as opposed to added ones, -and so on. - -Note that this does not change all colors throughout the active -theme, but only applies to cases that have color-coding -significance. For example, regular code syntax highlighting is -not affected. There is no such need because of the themes' -overarching commitment to the highest legibility standard, which -ensures that text is readable regardless of hue, as well as the -predominance of colors on the blue-cyan-magenta-purple side of -the spectrum." - :group 'modus-themes - :package-version '(modus-themes . "2.0.0") - :version "29.1" - :type 'boolean - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Deuteranopia style")) +(defun modus-themes--current-theme () + "Return first enabled Modus theme." + (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. +With optional OVERRIDES, return THEME palette overrides as a +symbol." + (when-let ((suffix (cond + ((and theme overrides) + "palette-overrides") + (theme + "palette")))) + (intern (format "%s-%s" theme suffix)))) + +(defun modus-themes--palette-value (theme &optional overrides) + "Return palette value of THEME with optional OVERRIDES." + (let ((base-value (symbol-value (modus-themes--palette-symbol theme)))) + (if overrides + (append (symbol-value (modus-themes--palette-symbol theme :overrides)) + modus-themes-common-palette-overrides + base-value) + base-value))) + +(defun modus-themes--current-theme-palette (&optional overrides) + "Return palette value of active Modus theme, else produce `user-error'. +With optional OVERRIDES return palette value plus whatever +overrides." + (if-let ((theme (modus-themes--current-theme))) + (if overrides + (modus-themes--palette-value theme :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 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)) -(defcustom modus-themes-mail-citations nil - "Control the color of citations/quotes in messages or emails. +(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. -By default (a nil value) citations are styled with contrasting -hues to denote their depth. Colors are easy to tell apart -because they complement each other, but they otherwise are not -very prominent. +Return `unspecified' if the value of COLOR cannot be determined. +This symbol is accepted by faces and is thus harmless. -Option `intense' is similar to the default in terms of using -contrasting and complementary hues, but applies more saturated -colors. +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)))) -Option `faint' maintains the same color-based distinction between -citation levels though the colors it uses have subtle differences -between them. +(defun modus-themes-get-color-value (color &optional overrides theme) + "Return color value of named COLOR for current Modus theme. -Option `monochrome' turns all quotes into a shade of gray. +COLOR is a symbol that represents a named color entry in the +palette. -Whatever the value assigned to this variable, citations in emails -are controlled by typographic elements and/or indentation, which -the themes do not touch." - :group 'modus-themes - :package-version '(modus-themes . "2.1.0") - :version "29.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Colorful email citations with contrasting hues (default)" nil) - (const :format "[%v] %t\n" :tag "Like the default, but with more saturated colors" intense) - (const :format "[%v] %t\n" :tag "Like the default, but with less saturated colors" faint) - (const :format "[%v] %t\n" :tag "Deprecated alias of `faint'" desaturated) - (const :format "[%v] %t\n" :tag "Uniformly gray mail citations" monochrome)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Mail citations")) +If the value is the name of another color entry in the +palette (so a mapping), recur until you find the underlying color +value. -(defcustom modus-themes-tabs-accented nil - "Toggle accented tab backgrounds, instead of the default gray. -This affects the built-in tab-bar mode and tab-line mode, as well -as the Centaur tabs package." - :group 'modus-themes - :package-version '(modus-themes . "1.6.0") - :version "28.1" - :type 'boolean - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Tab style")) +With optional OVERRIDES as a non-nil value, account for palette +overrides. Else use the default palette. -(defcustom modus-themes-box-buttons nil - "Control the style of buttons in the Custom UI and related. +With optional THEME as a symbol among `modus-themes-items', use +the palette of that item. Else use the current Modus theme. -The value is a list of properties, each designated by a symbol. -The default (a nil value or an empty list) is a gray background -combined with a pseudo three-dimensional effect. +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)) -The `flat' property makes the button two dimensional. +;;;; Commands -The `accented' property changes the background from gray to an -accent color. +(make-obsolete 'modus-themes-load-themes nil "4.0.0") +(make-obsolete 'modus-themes-load-operandi nil "4.0.0; Check `modus-themes-load-theme'") +(make-obsolete 'modus-themes-load-vivendi nil "4.0.0; Check `modus-themes-load-theme'") -The `faint' property reduces the overall coloration. +(defvar modus-themes--select-theme-history nil + "Minibuffer history of `modus-themes--select-prompt'.") -The `variable-pitch' property applies a proportionately spaced -typeface to the button's text. +(defun modus-themes--select-prompt () + "Minibuffer prompt to select a Modus theme." + (intern + (completing-read + "Select Modus theme: " + (modus-themes--list-known-themes) + nil t nil + 'modus-themes--select-theme-history))) -The `underline' property draws a line below the affected text and -removes whatever box effect. This is optimal when Emacs runs -inside a terminal emulator. If `flat' and `underline' are -defined together, the latter takes precedence. +;;;###autoload +(defun modus-themes-select (theme) + "Load a Modus THEME using minibuffer completion. +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)) + +(defun modus-themes--toggle-theme-p () + "Return non-nil if `modus-themes-to-toggle' are valid." + (mapc (lambda (theme) + (if (or (memq theme modus-themes-items) + (memq theme (modus-themes--list-known-themes))) + theme + (user-error "`%s' is not part of `modus-themes-items'" theme))) + modus-themes-to-toggle)) -The symbol of a weight attribute adjusts the font of the button -accordingly, such as `light', `semibold', etc. Valid symbols are -defined in the variable `modus-themes-weights'. +;;;###autoload +(defun modus-themes-toggle () + "Toggle between the two `modus-themes-to-toggle'. +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). -A number, expressed as a floating point (e.g. 0.9), adjusts the -height of the button's text to that many times the base font -size. The default height is the same as 1.0, though it need not -be explicitly stated. Instead of a floating point, an acceptable -value can be in the form of a cons cell like (height . FLOAT) -or (height FLOAT), where FLOAT is the given number. +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)) + (two (cadr themes))) + (if (eq (car custom-enabled-themes) one) + (modus-themes-load-theme two) + (modus-themes-load-theme one)) + (modus-themes-load-theme (modus-themes--select-prompt)))) + +(defun modus-themes--list-colors-render (buffer theme &optional mappings &rest _) + "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-palette (modus-themes--palette-value theme mappings)) + (palette (if mappings + (seq-remove (lambda (cell) + (stringp (cadr cell))) + current-palette) + current-palette)) + (current-buffer buffer) + (current-theme theme)) + (with-help-window buffer + (with-current-buffer standard-output + (erase-buffer) + (when (<= (display-color-cells) 256) + (insert (concat "Your display terminal may not render all color previews!\n" + "It seems to only support <= 256 colors.\n\n")) + (put-text-property (point-min) (point) 'face 'warning)) + ;; We need this to properly render the first line. + (insert " ") + (dolist (cell palette) + (let* ((name (car cell)) + (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" color pad)) + (put-text-property old-point (point) 'face `( :foreground ,color))) + (let ((old-point (point))) + (insert (format " %s %s %s\n" color pad name)) + (put-text-property old-point (point) + '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 mappings))))))) -The `all-buttons' property extends the box button effect (or the -aforementioned properties) to the faces of the generic widget -library. By default, those do not look like the buttons of the -Custom UI as they are ordinary text wrapped in square brackets. +(defvar modus-themes--list-colors-prompt-history '() + "Minibuffer history for `modus-themes--list-colors-prompt'.") -Combinations of any of those properties are expressed as a list, -like in these examples: +(defun modus-themes--list-colors-prompt () + "Prompt for Modus theme. +Helper function for `modus-themes-list-colors'." + (let ((def (format "%s" (modus-themes--current-theme)))) + (completing-read + (format "Use palette from theme [%s]: " def) + (modus-themes--list-known-themes) nil t nil + 'modus-themes--list-colors-prompt-history def))) - (flat) - (variable-pitch flat) - (variable-pitch flat semibold 0.9) - (variable-pitch flat semibold (height 0.9)) ; same as above - (variable-pitch flat semibold (height . 0.9)) ; same as above +(defun modus-themes-list-colors (theme &optional mappings) + "Preview named colors of the Modus THEME of choice. +With optional prefix argument for MAPPINGS preview the semantic +color mappings instead of the named colors." + (interactive (list (intern (modus-themes--list-colors-prompt)) current-prefix-arg)) + (modus-themes--list-colors-render + (format (if mappings "*%s-list-mappings*" "*%s-list-colors*") theme) + theme + mappings)) -The order in which the properties are set is not significant. +(defalias 'modus-themes-preview-colors 'modus-themes-list-colors + "Alias of `modus-themes-list-colors'.") -In user configuration files the form may look like this: +(defun modus-themes-list-colors-current (&optional mappings) + "Call `modus-themes-list-colors' for the current Modus theme. +Optional prefix argument MAPPINGS has the same meaning as for +`modus-themes-list-colors'." + (interactive "P") + (modus-themes-list-colors (modus-themes--current-theme) mappings)) - (setq modus-themes-box-buttons (quote (variable-pitch flat 0.9)))" - :group 'modus-themes - :package-version '(modus-themes . "2.3.0") - :version "29.1" - :type '(set :tag "Properties" :greedy t - (const :tag "Two-dimensional button" flat) - (const :tag "Accented background instead of gray" accented) - (const :tag "Reduce overall coloration" faint) - (const :tag "Proportionately spaced font (variable-pitch)" variable-pitch) - (const :tag "Underline instead of a box effect" underline) - (const :tag "Apply box button style to generic widget faces" all-buttons) - (choice :tag "Font weight (must be supported by the typeface)" - (const :tag "Thin" thin) - (const :tag "Ultra-light" ultralight) - (const :tag "Extra-light" extralight) - (const :tag "Light" light) - (const :tag "Semi-light" semilight) - (const :tag "Regular (default)" nil) - (const :tag "Medium" medium) - (const :tag "Bold" bold) - (const :tag "Semi-bold" semibold) - (const :tag "Extra-bold" extrabold) - (const :tag "Ultra-bold" ultrabold)) - (radio :tag "Height" - (float :tag "Floating point to adjust height by") - (cons :tag "Cons cell of `(height . FLOAT)'" - (const :tag "The `height' key (constant)" height) - (float :tag "Floating point")))) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Box buttons")) +(defalias 'modus-themes-preview-colors-current 'modus-themes-list-colors-current + "Alias of `modus-themes-list-colors-current'.") -;;; Internal functions +;;;; Internal functions (defun modus-themes--warn (option) "Warn that OPTION has changed." @@ -2890,51 +1339,6 @@ list given LIST-PRED, using DEFAULT as a fallback." (car val) val)) -(defun modus-themes--palette (theme) - "Return color palette for Modus theme THEME. -THEME is a symbol, either `modus-operandi' or `modus-vivendi'." - (pcase theme - ('modus-operandi - (append modus-themes-operandi-color-overrides - modus-themes-operandi-colors)) - ('modus-vivendi - (append modus-themes-vivendi-color-overrides - modus-themes-vivendi-colors)) - (_theme - (error "'%s' is not a Modus theme" theme)))) - -(defvar modus-themes-faces) -(defvar modus-themes-custom-variables) - -(defmacro modus-themes-theme (name) - "Bind NAME's color palette around face specs and variables. - -NAME should be the proper name of a Modus theme, either -`modus-operandi' or `modus-vivendi'. - -Face specifications are passed to `custom-theme-set-faces'. -While variables are handled by `custom-theme-set-variables'. -Those are stored in `modus-themes-faces' and -`modus-themes-custom-variables' respectively." - (declare (indent 0)) - (let ((palette-sym (gensym)) - (colors (mapcar #'car modus-themes-operandi-colors))) - `(let* ((class '((class color) (min-colors 89))) - (,palette-sym (modus-themes--palette ',name)) - ,@(mapcar (lambda (color) - (list color `(alist-get ',color ,palette-sym))) - colors)) - (custom-theme-set-faces ',name ,@modus-themes-faces) - (custom-theme-set-variables ',name ,@modus-themes-custom-variables)))) - -(defun modus-themes--current-theme () - "Return current modus theme." - (car - (seq-filter - (lambda (theme) - (string-match-p "^modus" (symbol-name theme))) - custom-enabled-themes))) - ;; Helper functions that are meant to ease the implementation of the ;; above customization variables. (defun modus-themes--bold-weight () @@ -2957,145 +1361,13 @@ Those are stored in `modus-themes-faces' and (when modus-themes-variable-pitch-ui (list :inherit 'variable-pitch))) -(defun modus-themes--fringe (mainbg subtlebg intensebg) - "Conditional use of background colors for fringes. -MAINBG is the default. SUBTLEBG should be a subtle grayscale -value. INTENSEBG must be a more pronounced grayscale color." - (pcase modus-themes-fringes - ('intense (list :background intensebg)) - ('subtle (list :background subtlebg)) - (_ (list :background mainbg)))) - -(defun modus-themes--line-numbers (mainfg mainbg altfg &optional altbg) - "Conditional use of colors for line numbers. -MAINBG and MAINFG are the default colors. ALTFG is a color that -combines with the theme's primary background (white/black)." - (if modus-themes-subtle-line-numbers - (list :background (or altbg 'unspecified) :foreground altfg) - (list :background mainbg :foreground mainfg))) - -(defun modus-themes--markup (mainfg intensefg subtlebg intensebg) - "Conditional use of colors for markup in Org and others. -MAINFG is the default foreground. SUBTLEBG is a gray background. -INTENSEBG is a colorful background for use with the main -foreground. INTENSEFG is an alternative to the default." - (let ((properties modus-themes-markup)) - (list - :inherit - (cond - ((and (memq 'bold properties) - (memq 'italic properties)) - (list 'bold-italic 'modus-themes-fixed-pitch)) - ((memq 'italic properties) - (list 'italic 'modus-themes-fixed-pitch)) - ((memq 'bold properties) - (list 'bold 'modus-themes-fixed-pitch)) - (t 'modus-themes-fixed-pitch)) - :background - (cond - ((and (memq 'background properties) - (memq 'intense properties)) - intensebg) - ((memq 'background properties) - subtlebg) - (t - 'unspecified)) - :foreground - (cond - ((and (memq 'background properties) - (memq 'intense properties)) - mainfg) - ((memq 'intense properties) - intensefg) - (t - mainfg))))) - -(defun modus-themes--lang-check (underline subtlefg intensefg intensefg-alt subtlebg intensebg faintfg) - "Conditional use of foreground colors for language checkers. -UNDERLINE is a color-code value for the affected text's underline -property. SUBTLEFG and INTENSEFG follow the same color-coding -pattern and represent a value that is faint or vibrant -respectively. INTENSEFG-ALT is used when the intensity is high. -SUBTLEBG and INTENSEBG are color-coded background colors that -differ in overall intensity. FAINTFG is a nuanced color." - (let ((properties (modus-themes--list-or-warn 'modus-themes-lang-checkers))) - (list :underline - (list :color - (if (memq 'faint properties) - faintfg underline) - :style - (if (memq 'straight-underline properties) - 'line 'wave)) - :background - (cond - ((and (memq 'background properties) - (memq 'faint properties)) - subtlebg) - ((and (memq 'background properties) - (memq 'intense properties)) - intensebg) - ((memq 'background properties) - subtlebg) - ('unspecified)) - :foreground - (cond - ((and (memq 'faint properties) - (memq 'text-also properties)) - faintfg) - ((and (memq 'background properties) - (memq 'intense properties)) - intensefg-alt) - ((memq 'intense properties) - intensefg) - ((memq 'text-also properties) - subtlefg) - ('unspecified))))) - -(defun modus-themes--prompt (mainfg intensefg grayfg subtlebg intensebg intensebg-fg subtlebggray intensebggray) +(defun modus-themes--prompt (fg bg) "Conditional use of colors for text prompt faces. -MAINFG is the prompt's standard foreground. INTENSEFG is a more -prominent alternative to the main foreground, while GRAYFG is a -less luminant shade of gray. - -SUBTLEBG is a subtle accented background that works with either -MAINFG or INTENSEFG. - -INTENSEBG is a more pronounced accented background color that -should be combinable with INTENSEBG-FG. - -SUBTLEBGGRAY and INTENSEBGGRAY are background values. The former -can be combined with GRAYFG, while the latter only works with the -theme's fallback text color." - (let ((properties (modus-themes--list-or-warn 'modus-themes-prompts))) - (list :foreground - (cond - ((and (memq 'gray properties) - (memq 'intense properties)) - 'unspecified) - ((memq 'gray properties) - grayfg) - ((and (memq 'background properties) - (memq 'intense properties)) - intensebg-fg) - ((memq 'intense properties) - intensefg) - (mainfg)) - :background - (cond - ((and (memq 'gray properties) - (memq 'background properties) - (memq 'intense properties)) - intensebggray) - ((and (memq 'gray properties) - (memq 'background properties)) - subtlebggray) - ((and (memq 'background properties) - (memq 'intense properties)) - intensebg) - ((memq 'background properties) - subtlebg) - ('unspecified)) - :inherit +FG is the prompt's standard foreground. BG is a background +color that is combined with FG-FOR-BG." + (let* ((properties (modus-themes--list-or-warn 'modus-themes-prompts)) + (weight (modus-themes--weight properties))) + (list :inherit (cond ((and (memq 'bold properties) (memq 'italic properties)) @@ -3104,104 +1376,16 @@ theme's fallback text color." 'italic) ((memq 'bold properties) 'bold) - ('unspecified))))) - -(defun modus-themes--paren (normalbg intensebg) - "Conditional use of intense colors for matching parentheses. -NORMALBG should be the special palette color bg-paren-match or -something similar. INTENSEBG must be easier to discern next to -other backgrounds, such as the special palette color -bg-paren-match-intense." - (let ((properties (modus-themes--list-or-warn 'modus-themes-paren-match))) - (list :inherit - (if (memq 'bold properties) - 'bold - 'unspecified) - :background - (if (memq 'intense properties) - intensebg - normalbg) - :underline - (if (memq 'underline properties) - t - nil)))) - -(defun modus-themes--syntax-foreground (fg faint) - "Apply foreground value to code syntax. -FG is the default. FAINT is typically the same color in its -desaturated version." - (let ((properties (modus-themes--list-or-warn 'modus-themes-syntax))) - (list :foreground - (cond - ((memq 'faint properties) - faint) - (fg))))) - -(defun modus-themes--syntax-extra (fg faint alt &optional faint-alt) - "Apply foreground value to code syntax. -FG is the default. FAINT is typically the same color in its -desaturated version. ALT is another hue while optional FAINT-ALT -is its subtle alternative." - (let ((properties (modus-themes--list-or-warn 'modus-themes-syntax))) - (list :foreground - (cond - ((and (memq 'alt-syntax properties) - (memq 'faint properties)) - (or faint-alt alt)) - ((memq 'faint properties) - faint) - ((memq 'alt-syntax properties) - alt) - (fg))))) - -(defun modus-themes--syntax-string (fg faint green alt &optional faint-green faint-alt) - "Apply foreground value to strings in code syntax. -FG is the default. FAINT is typically the same color in its -desaturated version. GREEN is a color variant in that side of -the spectrum. ALT is another hue. Optional FAINT-GREEN is a -subtle alternative to GREEN. Optional FAINT-ALT is a subtle -alternative to ALT." - (let ((properties (modus-themes--list-or-warn 'modus-themes-syntax))) - (list :foreground - (cond - ((and (memq 'faint properties) - (memq 'green-strings properties)) - (or faint-green green)) - ((and (memq 'alt-syntax properties) - (memq 'faint properties)) - (or faint-alt faint)) - ((memq 'faint properties) - faint) - ((memq 'green-strings properties) - green) - ((memq 'alt-syntax properties) - alt) - (fg))))) - -(defun modus-themes--syntax-comment (fg yellow &optional faint-yellow faint) - "Apply foreground value to strings in code syntax. -FG is the default. YELLOW is a color variant of that name while -optional FAINT-YELLOW is its subtle variant. Optional FAINT is -an alternative to the default value." - (let ((properties (modus-themes--list-or-warn 'modus-themes-syntax))) - (list :foreground - (cond - ((and (memq 'faint properties) - (memq 'yellow-comments properties)) - (or faint-yellow yellow)) - ((and (memq 'alt-syntax properties) - (memq 'yellow-comments properties) - (not (memq 'green-strings properties))) - yellow) - ((memq 'yellow-comments properties) - yellow) - ((memq 'faint properties) - (or faint fg)) - (fg))))) - -(defun modus-themes--key-cdr (key alist) - "Get cdr of KEY in ALIST." - (cdr (assoc key alist))) + ('unspecified)) + :background bg + :foreground fg + :weight + ;; If we have `bold' specifically, we inherit the face of + ;; the same name. This allows the user to customise that + ;; face, such as to change its font family. + (if (and weight (not (eq weight 'bold))) + weight + 'unspecified)))) (defconst modus-themes-weights '( thin ultralight extralight light semilight regular medium @@ -3209,29 +1393,23 @@ an alternative to the default value." "List of font weights.") (defun modus-themes--weight (list) - "Search for `modus-themes--heading' weight in LIST." + "Search for `modus-themes-weights' weight in LIST." (catch 'found (dolist (elt list) (when (memq elt modus-themes-weights) (throw 'found elt))))) -(defun modus-themes--heading (level fg fg-alt bg bg-gray border) +(defun modus-themes--heading (level fg &optional bg ol) "Conditional styles for `modus-themes-headings'. LEVEL is the heading's position in their order. FG is the -default text color. FG-ALT is an accented, more saturated value -than the default. BG is a nuanced, typically accented, -background that can work well with either of the foreground -values. BG-GRAY is a gray background. BORDER is a color value -that combines well with the background and foreground." - (let* ((key (modus-themes--key-cdr level modus-themes-headings)) - (style (or key (modus-themes--key-cdr t modus-themes-headings))) +default text color. Optional BG is an appropriate background. +Optional OL is the color of an overline." + (let* ((key (alist-get level modus-themes-headings)) + (style (or key (alist-get t modus-themes-headings))) (style-listp (listp style)) (properties style) (var (when (memq 'variable-pitch properties) 'variable-pitch)) - (varbold (if var - (append (list 'bold) (list var)) - 'bold)) (weight (when style-listp (modus-themes--weight style)))) (list :inherit (cond @@ -3239,336 +1417,28 @@ that combines well with the background and foreground." ;; deprecate a variable's value. ((or weight (memq 'no-bold properties)) var) - (varbold)) - :background - (cond - ((and (memq 'monochrome properties) - (memq 'background properties)) - bg-gray) - ((memq 'background properties) - bg) - ('unspecified)) - :foreground - (cond - ((memq 'monochrome properties) - 'unspecified) - ((memq 'rainbow properties) - fg-alt) - (fg)) - :height - (modus-themes--property-lookup properties 'height #'floatp 'unspecified) - :weight - (or weight 'unspecified) - :overline - (if (memq 'overline properties) - border - 'unspecified)))) - -(defun modus-themes--agenda-structure (fg) - "Control the style of the Org agenda structure. -FG is the foreground color to use." - (let* ((properties (modus-themes--key-cdr 'header-block modus-themes-org-agenda)) - (weight (modus-themes--weight properties))) - (list :inherit - (cond - ((and weight (memq 'variable-pitch properties)) - 'variable-pitch) - (weight 'unspecified) - ((memq 'variable-pitch properties) - (list 'bold 'variable-pitch)) + (var (append (list 'bold) (list var))) ('bold)) - :weight - (or weight 'unspecified) - :height - (cond ((memq 'no-scale properties) 'unspecified) - ((modus-themes--property-lookup properties 'height #'floatp 1.15))) - :foreground fg))) - -(defun modus-themes--agenda-date (defaultfg grayscalefg &optional workaholicfg grayscaleworkaholicfg bg bold ul) - "Control the style of date headings in Org agenda buffers. -DEFAULTFG is the original accent color for the foreground. -GRAYSCALEFG is a neutral color. Optional WORKAHOLICFG and -GRAYSCALEWORKAHOLICFG are alternative foreground colors. -Optional BG is a background color. Optional BOLD applies a bold -weight. Optional UL applies an underline." - (let ((properties (modus-themes--key-cdr 'header-date modus-themes-org-agenda))) - (list :inherit - (cond - ((or (memq 'bold-all properties) - (and bold (memq 'bold-today properties))) - 'bold) - (t - 'unspecified)) - :background - (cond - ((memq 'underline-today properties) - 'unspecified) - ((or bg 'unspecified))) - :foreground - (cond - ((and (memq 'grayscale properties) - (memq 'workaholic properties)) - (or grayscaleworkaholicfg grayscalefg)) - ((memq 'grayscale properties) - grayscalefg) - ((memq 'workaholic properties) - (or workaholicfg defaultfg)) - (t - defaultfg)) - :height - (modus-themes--property-lookup properties 'height #'floatp 'unspecified) - :underline - (if (and ul (memq 'underline-today properties)) - t - 'unspecified)))) - -(defun modus-themes--agenda-event (fg-accent &optional varied) - "Control the style of the Org agenda events. -FG-ACCENT is the accent color to use. Optional VARIED is a -toggle to behave in accordance with the semantics of the `varied' -property that the `event' key accepts in -`modus-themes-org-agenda'." - (let ((properties (modus-themes--key-cdr 'event modus-themes-org-agenda))) - (list :foreground - (cond - ((or (and (memq 'varied properties) varied) - (and (memq 'accented properties) - (memq 'varied properties) - varied)) - 'unspecified) - ((memq 'accented properties) - fg-accent) - ('unspecified)) - :inherit - (cond - ((and (memq 'italic properties) - (memq 'varied properties) - varied) - '(shadow italic)) - ((and (memq 'accented properties) - (memq 'varied properties) - varied) - 'shadow) - ((or (and (memq 'varied properties) varied) - (and (memq 'italic properties) varied)) - '(shadow italic)) - ((and (memq 'italic properties) - (not (memq 'varied properties))) - '(shadow italic)) - ('shadow))))) - -(defun modus-themes--agenda-scheduled (defaultfg uniformfg rainbowfg) - "Control the style of the Org agenda scheduled tasks. -DEFAULTFG is an accented foreground color that is meant to -differentiate between past or present and future tasks. -UNIFORMFG is a more subtle color that eliminates the color coding -for scheduled tasks. RAINBOWFG is a prominent accent value that -clearly distinguishes past, present, future tasks." - (pcase (modus-themes--key-cdr 'scheduled modus-themes-org-agenda) - ('uniform (list :foreground uniformfg)) - ('rainbow (list :foreground rainbowfg)) - (_ (list :foreground defaultfg)))) - -(defun modus-themes--agenda-habit (default traffic simple &optional default-d traffic-d simple-d) - "Specify background values for `modus-themes-org-agenda' habits. -DEFAULT is the original foregrounc color. TRAFFIC is to be used -when the traffic-light style is applied, while SIMPLE corresponds -to the simplified style. - -Optional DEFAULT-D, TRAFFIC-D, SIMPLE-D are alternatives to the -main colors, meant for dopia when `modus-themes-deuteranopia' is -non-nil." - (let ((habit (modus-themes--key-cdr 'habit modus-themes-org-agenda))) - (cond - ((and modus-themes-deuteranopia (null habit)) - (list :background (or default-d default))) - ((and modus-themes-deuteranopia (eq habit 'traffic-light)) - (list :background (or traffic-d traffic))) - ((and modus-themes-deuteranopia (eq habit 'simplified)) - (list :background (or simple-d simple))) - (t - (pcase habit - ('traffic-light (list :background traffic)) - ('simplified (list :background simple)) - (_ (list :background default))))))) - -(defun modus-themes--org-block (bgblk fgdefault &optional fgblk) - "Conditionally set the background of Org blocks. -BGBLK applies to a distinct neutral background. Else blocks have -no background of their own (the default), so they look the same -as the rest of the buffer. FGDEFAULT is used when no distinct -background is present. While optional FGBLK specifies a -foreground value that can be combined with BGBLK. - -`modus-themes-org-blocks' also accepts `tinted-background' (alias -`rainbow') as a value which applies to `org-src-block-faces' (see -the theme's source code)." - (if (or (eq modus-themes-org-blocks 'gray-background) - (eq modus-themes-org-blocks 'grayscale) - (eq modus-themes-org-blocks 'greyscale)) - (list :background bgblk :foreground (or fgblk fgdefault) :extend t) - (list :background 'unspecified :foreground fgdefault))) - -(defun modus-themes--org-block-delim (bgaccent fgaccent bg fg) - "Conditionally set the styles of Org block delimiters. -BG, FG, BGACCENT, FGACCENT apply a background and foreground -color respectively. - -The former pair is a grayscale combination that should be more -distinct than the background of the block. It is applied to the -default styles or when `modus-themes-org-blocks' is set -to `grayscale' (or `greyscale'). - -The latter pair should be more subtle than the background of the -block, as it is used when `modus-themes-org-blocks' is -set to `rainbow'." - (pcase modus-themes-org-blocks - ('gray-background (list :background bg :foreground fg :extend t)) - ('grayscale (list :background bg :foreground fg :extend t)) - ('greyscale (list :background bg :foreground fg :extend t)) - ('tinted-background (list :background bgaccent :foreground fgaccent :extend nil)) - ('rainbow (list :background bgaccent :foreground fgaccent :extend nil)) - (_ (list :foreground fg :extend nil)))) - -(defun modus-themes--mode-line-attrs - (fg bg fg-alt bg-alt fg-accent bg-accent border border-3d &optional alt-style fg-distant) - "Color combinations for `modus-themes-mode-line'. - -FG and BG are the default colors. FG-ALT and BG-ALT are meant to -accommodate the options for a 3D mode line or a `moody' compliant -one. FG-ACCENT and BG-ACCENT are used for all variants. BORDER -applies to all permutations of the mode line, except the -three-dimensional effect, where BORDER-3D is used instead. - -Optional ALT-STYLE applies an appropriate style to the mode -line's box property. - -Optional FG-DISTANT should be close to the main background -values. It is intended to be used as a distant-foreground -property." - (let* ((properties (modus-themes--list-or-warn 'modus-themes-mode-line)) - (padding (modus-themes--property-lookup properties 'padding #'natnump 1)) - (height (modus-themes--property-lookup properties 'height #'floatp 'unspecified)) - (padded (> padding 1)) - (base (cond ((memq 'accented properties) - (cons fg-accent bg-accent)) - ((and (or (memq 'moody properties) - (memq '3d properties)) - (not (memq 'borderless properties))) - (cons fg-alt bg-alt)) - ((cons fg bg)))) - (line (cond ((not (or (memq 'moody properties) padded)) - 'unspecified) - ((and (not (memq 'moody properties)) - padded - (memq 'borderless properties)) - 'unspecified) - ((and (memq 'borderless properties) - (memq 'accented properties)) - bg-accent) - ((memq 'borderless properties) - bg) - (border)))) - (list :foreground (car base) - :background (cdr base) - :height height - :box - (cond ((memq 'moody properties) - 'unspecified) - ((and (memq '3d properties) padded) - (list :line-width padding - :color - (cond ((and (memq 'accented properties) - (memq 'borderless properties)) - bg-accent) - ((or (memq 'accented properties) - (memq 'borderless properties)) - bg) - (bg-alt)) - :style (when alt-style 'released-button))) - ((and (memq 'accented properties) padded) - (list :line-width padding :color bg-accent)) - ((memq '3d properties) - (list :line-width padding - :color - (cond ((and (memq 'accented properties) - (memq 'borderless properties)) - bg-accent) - ((memq 'borderless properties) bg) - (border-3d)) - :style (when alt-style 'released-button))) - ((and (memq 'accented properties) - (memq 'borderless properties)) - (list :line-width padding :color bg-accent)) - ((or (memq 'borderless properties) padded) - (list :line-width padding :color bg)) - (border)) - :overline line - :underline line - :distant-foreground - (if (memq 'moody properties) - fg-distant - 'unspecified)))) - -;; Basically this is just for the keycast key indicator. -(defun modus-themes--mode-line-padded-box (color) - "Set padding of mode line box attribute with given COLOR." - (list :box (list :color color - :line-width - (or (cl-loop - for x in modus-themes-mode-line - if (natnump x) return x) - 1)))) - -(defun modus-themes--diff (mainbg mainfg altbg altfg &optional deubg deufg deualtbg deualtfg bg-only-fg) - "Color combinations for `modus-themes-diffs'. - -MAINBG must be one of the dedicated backgrounds for diffs while -MAINFG must be the same for the foreground. - -ALTBG needs to be a slightly accented background that is meant to -be combined with ALTFG. Both must be less intense than MAINBG -and MAINFG respectively. - -DEUBG and DEUFG must be combinations of colors that account for -red-green color defficiency (deuteranopia). They are the -equivalent of MAINBG and MAINFG. - -DEUALTBG and DEUALTFG are the equivalent of ALTBG and ALTFG for -deuteranopia. - -Optional non-nil BG-ONLY-FG applies ALTFG else leaves the -foreground unspecified." - (if modus-themes-deuteranopia - (pcase modus-themes-diffs - ('desaturated (list :background (or deualtbg altbg) :foreground (or deualtfg altfg))) - ('bg-only (list :background (or deualtbg altbg) :foreground (if bg-only-fg (or deualtfg altfg) 'unspecified))) - (_ (list :background (or deubg mainbg) :foreground (or deufg mainfg)))) - (pcase modus-themes-diffs - ('desaturated (list :background altbg :foreground altfg)) - ('bg-only (list :background altbg :foreground (if bg-only-fg altfg 'unspecified))) - (_ (list :background mainbg :foreground mainfg))))) - -(defun modus-themes--deuteran (deuteran main) - "Determine whether to color-code success as DEUTERAN or MAIN." - (if modus-themes-deuteranopia - (list deuteran) - (list main))) - -(defun modus-themes--completion-line (key bg fg bgintense fgintense &optional bgaccent bgaccentintense) - "Styles for `modus-themes-completions'. -KEY is the key of a cons cell. BG and FG are the main colors. -BGINTENSE works with the main foreground. FGINTENSE works on its -own. BGACCENT and BGACCENTINTENSE are colorful variants of the -other backgrounds." + :background (or bg 'unspecified) + :foreground fg + :overline (or ol 'unspecified) + :height (modus-themes--property-lookup properties 'height #'floatp 'unspecified) + :weight (or weight 'unspecified)))) + +(defun modus-themes--org-block (fg bg) + "Conditionally set the FG and BG of Org blocks." + (let ((gray (or (eq modus-themes-org-blocks 'gray-background) + (eq modus-themes-org-blocks 'grayscale) ; for backward compatibility + (eq modus-themes-org-blocks 'greyscale)))) + (list :inherit 'modus-themes-fixed-pitch + :background (if gray bg 'unspecified) + :foreground (if gray 'unspecified fg) + :extend (if gray t 'unspecified)))) + +(defun modus-themes--completion-line (bg) + "Styles for `modus-themes-completions' with BG as the background." (let* ((var (modus-themes--list-or-warn 'modus-themes-completions)) - (properties (or (alist-get key var) (alist-get t var))) - (popup (eq key 'popup)) - (selection (eq key 'selection)) - (line (or popup selection)) - (text (memq 'text-also properties)) - (accented (memq 'accented properties)) - (intense (memq 'intense properties)) + (properties (or (alist-get 'selection var) (alist-get t var))) (italic (memq 'italic properties)) (weight (modus-themes--weight properties)) (bold (when (and weight (eq weight 'bold)) 'bold))) @@ -3581,35 +1451,18 @@ other backgrounds." 'unspecified) (italic 'bold-italic) ('bold)) - :background - (cond - ((and accented intense line) - bgaccentintense) - ((and accented line) - bgaccent) - (intense bgintense) - (bg)) - :foreground - (cond - ((and line text intense) - fgintense) - ((and line text) - fg) - ('unspecified)) + :background bg + :foreground 'unspecified :underline (if (memq 'underline properties) t 'unspecified) :weight (if (and weight (null bold)) weight 'unspecified)))) -(defun modus-themes--completion-match (key bg fg bgintense fgintense) +(defun modus-themes--completion-match (fg bg) "Styles for `modus-themes-completions'. -KEY is the key of a cons cell. BG and FG are the main colors. -BGINTENSE works with the main foreground. FGINTENSE works on its -own." +FG and BG are the main colors." (let* ((var (modus-themes--list-or-warn 'modus-themes-completions)) - (properties (or (alist-get key var) (alist-get t var))) - (background (memq 'background properties)) - (intense (memq 'intense properties)) + (properties (or (alist-get 'matches var) (alist-get t var))) (italic (memq 'italic properties)) (weight (modus-themes--weight properties)) (bold (when (and weight (eq weight 'bold)) 'bold))) @@ -3622,443 +1475,13 @@ own." 'unspecified) (italic 'bold-italic) ('bold)) - :background - (cond - ((and background intense) - bgintense) - (background bg) - ('unspecified)) - :foreground - (cond - ((and background intense) - 'unspecified) - (background fg) - (intense fgintense) - (fg)) + :background bg + :foreground fg :underline (if (memq 'underline properties) t 'unspecified) :weight (if (and weight (null bold)) weight 'unspecified)))) -(defun modus-themes--link (fg fgfaint underline bg bgneutral) - "Conditional application of link styles. -FG is the link's default color for its text and underline -property. FGFAINT is a desaturated color for the text and -underline. UNDERLINE is a gray color only for the undeline. BG -is a background color and BGNEUTRAL is its fallback value." - (let ((properties (modus-themes--list-or-warn 'modus-themes-links))) - (list :inherit - (cond - ((and (memq 'bold properties) - (memq 'italic properties)) - 'bold-italic) - ((memq 'italic properties) - 'italic) - ((memq 'bold properties) - 'bold) - ('unspecified)) - :background - (cond - ((and (memq 'no-color properties) - (memq 'no-underline properties)) - bgneutral) - ((memq 'background properties) - bg) - ('unspecified)) - :foreground - (cond - ((memq 'no-color properties) - 'unspecified) - ((memq 'faint properties) - fgfaint) - (fg)) - :underline - (cond - ((memq 'no-underline properties) - 'unspecified) - ((memq 'neutral-underline properties) - underline) - (t))))) - -(defun modus-themes--link-color (fg fgfaint &optional neutralfg) - "Extend `modus-themes--link'. -FG is the main accented foreground. FGFAINT is also accented, -yet desaturated. Optional NEUTRALFG is a gray value." - (let ((properties (modus-themes--list-or-warn 'modus-themes-links))) - (list :foreground - (cond - ((memq 'no-color properties) - (or neutralfg 'unspecified)) - ((memq 'faint properties) - fgfaint) - (fg)) - :underline - (cond - ((memq 'no-underline properties) - 'unspecified) - ((memq 'neutral-underline properties) - (or neutralfg 'unspecified)) - (t))))) - -(defun modus-themes--region (bg fg bgsubtle bgaccent bgaccentsubtle) - "Apply `modus-themes-region' styles. - -BG and FG are the main values that are used by default. BGSUBTLE -is a subtle background value that can be combined with all colors -used to fontify text and code syntax. BGACCENT is a colored -background that combines well with FG. BGACCENTSUBTLE can be -combined with all colors used to fontify text." - (let ((properties (modus-themes--list-or-warn 'modus-themes-region))) - (list :background - (cond - ((and (memq 'accented properties) - (memq 'bg-only properties)) - bgaccentsubtle) - ((memq 'accented properties) - bgaccent) - ((memq 'bg-only properties) - bgsubtle) - (bg)) - :foreground - (cond - ((and (memq 'accented properties) - (memq 'bg-only properties)) - 'unspecified) - ((memq 'bg-only properties) - 'unspecified) - (fg)) - :extend - (cond - ((memq 'no-extend properties) - nil) - (t))))) - -(defun modus-themes--hl-line - (bgdefault bgintense bgaccent bgaccentsubtle lineneutral lineaccent lineneutralintense lineaccentintense) - "Apply `modus-themes-hl-line' styles. - -BGDEFAULT is a subtle neutral background. BGINTENSE is like the -default, but more prominent. BGACCENT is a prominent accented -background, while BGACCENTSUBTLE is more subtle. LINENEUTRAL and -LINEACCENT are color values that can remain distinct against the -buffer's possible backgrounds: the former is neutral, the latter -is accented. LINENEUTRALINTENSE and LINEACCENTINTENSE are their -more prominent alternatives." - (let ((properties (modus-themes--list-or-warn 'modus-themes-hl-line))) - (list :background - (cond - ((and (memq 'intense properties) - (memq 'accented properties)) - bgaccent) - ((memq 'accented properties) - bgaccentsubtle) - ((memq 'intense properties) - bgintense) - (bgdefault)) - :underline - (cond - ((and (memq 'intense properties) - (memq 'accented properties) - (memq 'underline properties)) - lineaccentintense) - ((and (memq 'accented properties) - (memq 'underline properties)) - lineaccent) - ((and (memq 'intense properties) - (memq 'underline properties)) - lineneutralintense) - ((or (memq 'no-background properties) - (memq 'underline properties)) - lineneutral) - ('unspecified))))) - -(defun modus-themes--mail-cite (mainfg intensefg subtlefg) - "Combinations for `modus-themes-mail-citations'. - -MAINFG is an accented foreground value. SUBTLEFG is its -desaturated counterpart. INTENSEFG is a more saturated variant." - (pcase modus-themes-mail-citations - ('monochrome (list :inherit 'shadow)) - ('intense (list :foreground intensefg)) - ('faint (list :foreground subtlefg)) - ('desaturated (list :foreground subtlefg)) - (_ (list :foreground mainfg)))) - -(defun modus-themes--tab (bg &optional bgaccent fg fgaccent box-p bold-p var-p) - "Helper function for tabs. -BG is the default background, while BGACCENT is its more colorful -alternative. Optional FG is a foreground color that combines -with BG. Same principle FGACCENT. - -BOX-P and BOLD-P determine the use of a box property and the -application of a bold weight, respectively. VAR-P controls the -application of a variable-pitch font." - (let ((background (if modus-themes-tabs-accented (or bgaccent bg) bg)) - (foreground (if modus-themes-tabs-accented (or fgaccent fg) fg))) - (list - :inherit (cond - ((and bold-p var-p) - (if modus-themes-variable-pitch-ui - '(variable-pitch bold) - '(bold))) - (bold-p 'bold) - (var-p (when modus-themes-variable-pitch-ui 'variable-pitch)) - ('unspecified)) - :background background - :foreground (or foreground 'unspecified) - :box (if box-p (list :line-width 2 :color background) 'unspecified)))) - -(defun modus-themes--button (bg bgfaint bgaccent bgaccentfaint border &optional pressed-button-p) - "Apply `modus-themes-box-buttons' styles. - -BG is the main background. BGFAINT is its subtle alternative. -BGACCENT is its accented variant and BGACCENTFAINT is the same -but less intense. BORDER is the color around the box. - -When optional PRESSED-BUTTON-P is non-nil, the box uses the -pressed button style, else the released button." - (let* ((properties modus-themes-box-buttons) - (weight (modus-themes--weight properties))) - (list :inherit - (cond - ((and (memq 'variable-pitch properties) - (eq weight 'bold)) - (list 'bold 'variable-pitch)) - ((memq 'variable-pitch properties) - 'variable-pitch) - ((eq weight 'bold) - 'bold) - ('unspecified)) - :background - (cond - ((and (memq 'accented properties) - (memq 'faint properties) - bgaccentfaint)) - ((memq 'faint properties) - bgfaint) - ((memq 'accented properties) - bgaccent) - (bg)) - :box - (cond - ((memq 'underline properties) - 'unspecified) - ((memq 'flat properties) - (list :line-width -1 :color border)) - ((list :line-width -1 - :style (if pressed-button-p - 'pressed-button - 'released-button) - :color border))) - :weight - (cond - ((eq weight 'bold) - 'unspecified) ; we :inherit the `bold' face above - (weight weight) - ('unspecified)) - :height - (modus-themes--property-lookup properties 'height #'floatp 'unspecified) - :underline - (if (memq 'underline properties) - t - 'unspecified)))) - - - -;;;; Utilities for DIY users - -;;;;; List colors (a variant of M-x list-colors-display) - -(defun modus-themes--list-colors-render (buffer theme &rest _) - "Render colors in BUFFER from THEME. -Routine for `modus-themes-list-colors'." - (let ((palette (seq-uniq (modus-themes--palette theme) - (lambda (x y) - (eq (car x) (car y))))) - (current-buffer buffer) - (current-theme theme)) - (with-help-window buffer - (with-current-buffer standard-output - (erase-buffer) - (when (<= (display-color-cells) 256) - (insert (concat "Your display terminal may not render all color previews!\n" - "It seems to only support <= 256 colors.\n\n")) - (put-text-property (point-min) (point) 'face 'warning)) - ;; We need this to properly render the first line. - (insert " ") - (dolist (cell palette) - (let* ((name (car cell)) - (color (cdr cell)) - (fg (readable-foreground-color color)) - (pad (make-string 5 ?\s))) - (let ((old-point (point))) - (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" color pad name)) - (put-text-property old-point (point) - '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))))))) - -(defvar modus-themes--list-colors-prompt-history '() - "Minibuffer history for `modus-themes--list-colors-prompt'.") - -(defun modus-themes--list-colors-prompt () - "Prompt for Modus theme. -Helper function for `modus-themes-list-colors'." - (let ((def (format "%s" (modus-themes--current-theme)))) - (completing-read - (format "Use palette from theme [%s]: " def) - '(modus-operandi modus-vivendi) nil t nil - 'modus-themes--list-colors-prompt-history def))) - -(defun modus-themes-list-colors (theme) - "Preview palette of the Modus THEME of choice." - (interactive (list (intern (modus-themes--list-colors-prompt)))) - (modus-themes--list-colors-render - (format "*%s-list-colors*" theme) - theme)) - -(defun modus-themes-list-colors-current () - "Call `modus-themes-list-colors' for the current Modus theme." - (interactive) - (modus-themes-list-colors (modus-themes--current-theme))) - -;;;;; Formula to measure relative luminance - -;; This is the WCAG formula: https://www.w3.org/TR/WCAG20-TECHS/G18.html -(defun modus-themes-wcag-formula (hex) - "Get WCAG value of color value HEX. -The value is defined in hexadecimal RGB notation, such as those in -`modus-themes-operandi-colors' and `modus-themes-vivendi-colors'." - (cl-loop for k in '(0.2126 0.7152 0.0722) - for x in (color-name-to-rgb hex) - sum (* k (if (<= x 0.03928) - (/ x 12.92) - (expt (/ (+ x 0.055) 1.055) 2.4))))) - -;;;###autoload -(defun modus-themes-contrast (c1 c2) - "Measure WCAG contrast ratio between C1 and C2. -C1 and C2 are color values written in hexadecimal RGB." - (let ((ct (/ (+ (modus-themes-wcag-formula c1) 0.05) - (+ (modus-themes-wcag-formula c2) 0.05)))) - (max ct (/ ct)))) - -;;;;; Retrieve colors from the themes - -(defun modus-themes-current-palette () - "Return current color palette." - (modus-themes--palette (modus-themes--current-theme))) - -;;;###autoload -(defun modus-themes-color (color) - "Return color value for COLOR from current palette. -COLOR is a key in `modus-themes-operandi-colors' or -`modus-themes-vivendi-colors'." - (alist-get color (modus-themes-current-palette))) - -;;;###autoload -(defun modus-themes-color-alts (light-color dark-color) - "Return color value from current palette. -When Modus Operandi is enabled, return color value for color -LIGHT-COLOR. When Modus Vivendi is enabled, return color value -for DARK-COLOR. LIGHT-COLOR and DARK-COLOR are keys in -`modus-themes-operandi-colors' or `modus-themes-vivendi-colors'." - (let* ((theme (modus-themes--current-theme)) - (color (pcase theme - ('modus-operandi light-color) - ('modus-vivendi dark-color) - (_theme - (error "'%s' is not a Modus theme" theme))))) - (alist-get color (modus-themes--palette theme)))) - -(defmacro modus-themes-with-colors (&rest body) - "Evaluate BODY with colors from current palette bound. -For colors bound, see `modus-themes-operandi-colors' or -`modus-themes-vivendi-colors'." - (declare (indent 0)) - (let ((palette-sym (gensym)) - (colors (mapcar #'car modus-themes-operandi-colors))) - `(let* ((class '((class color) (min-colors 89))) - (,palette-sym (modus-themes-current-palette)) - ,@(mapcar (lambda (color) - (list color `(alist-get ',color ,palette-sym))) - colors)) - (ignore class ,@colors) ; Silence unused variable warnings - ,@body))) - - - -;;;; Commands - -;;;###autoload -(defun modus-themes-load-themes () - "Ensure that the Modus themes are in `custom-enabled-themes'. - -This function is intended for use in package declarations such as -those defined with the help of `use-package'. The idea is to add -this function to the `:init' stage of the package's loading, so -that subsequent calls that assume the presence of a loaded theme, -like `modus-themes-toggle' or `modus-themes-load-operandi', will -continue to work as intended even if they are lazy-loaded (such -as when they are declared in the `:config' phase)." - (unless (or (custom-theme-p 'modus-operandi) - (custom-theme-p 'modus-vivendi)) - (load-theme 'modus-operandi t t) - (load-theme 'modus-vivendi t t))) - -(defvar modus-themes-after-load-theme-hook nil - "Hook that runs after the `modus-themes-toggle' routines.") - -;;;###autoload -(defun modus-themes-load-operandi () - "Load `modus-operandi' and disable `modus-vivendi'. -Also run `modus-themes-after-load-theme-hook'." - (interactive) - (disable-theme 'modus-vivendi) - (load-theme 'modus-operandi t) - (run-hooks 'modus-themes-after-load-theme-hook)) - -;;;###autoload -(defun modus-themes-load-vivendi () - "Load `modus-vivendi' and disable `modus-operandi'. -Also run `modus-themes-after-load-theme-hook'." - (interactive) - (disable-theme 'modus-operandi) - (load-theme 'modus-vivendi t) - (run-hooks 'modus-themes-after-load-theme-hook)) - -(defun modus-themes--load-prompt () - "Helper for `modus-themes-toggle'." - (let ((theme - (intern - (completing-read "Load Modus theme (will disable all others): " - '(modus-operandi modus-vivendi) nil t)))) - (mapc #'disable-theme custom-enabled-themes) - (pcase theme - ('modus-operandi (modus-themes-load-operandi)) - ('modus-vivendi (modus-themes-load-vivendi))))) - -;;;###autoload -(defun modus-themes-toggle () - "Toggle between `modus-operandi' and `modus-vivendi' themes. -Also runs `modus-themes-after-load-theme-hook' at its last stage -by virtue of calling either of `modus-themes-load-operandi' and -`modus-themes-load-vivendi' functions." - (interactive) - (modus-themes-load-themes) - (pcase (modus-themes--current-theme) - ('modus-operandi (modus-themes-load-vivendi)) - ('modus-vivendi (modus-themes-load-operandi)) - (_ (modus-themes--load-prompt)))) - ;;;; Face specifications @@ -4067,901 +1490,568 @@ by virtue of calling either of `modus-themes-load-operandi' and '( ;;;; custom faces ;; these bespoke faces are inherited by other constructs below +;;;;; just the foregrounds + `(modus-themes-fg-red ((,c :foreground ,red))) + `(modus-themes-fg-red-warmer ((,c :foreground ,red-warmer))) + `(modus-themes-fg-red-cooler ((,c :foreground ,red-cooler))) + `(modus-themes-fg-red-faint ((,c :foreground ,red-faint))) + `(modus-themes-fg-red-intense ((,c :foreground ,red-intense))) + `(modus-themes-fg-green ((,c :foreground ,green))) + `(modus-themes-fg-green-warmer ((,c :foreground ,green-warmer))) + `(modus-themes-fg-green-cooler ((,c :foreground ,green-cooler))) + `(modus-themes-fg-green-faint ((,c :foreground ,green-faint))) + `(modus-themes-fg-green-intense ((,c :foreground ,green-intense))) + `(modus-themes-fg-yellow ((,c :foreground ,yellow))) + `(modus-themes-fg-yellow-warmer ((,c :foreground ,yellow-warmer))) + `(modus-themes-fg-yellow-cooler ((,c :foreground ,yellow-cooler))) + `(modus-themes-fg-yellow-faint ((,c :foreground ,yellow-faint))) + `(modus-themes-fg-yellow-intense ((,c :foreground ,yellow-intense))) + `(modus-themes-fg-blue ((,c :foreground ,blue))) + `(modus-themes-fg-blue-warmer ((,c :foreground ,blue-warmer))) + `(modus-themes-fg-blue-cooler ((,c :foreground ,blue-cooler))) + `(modus-themes-fg-blue-faint ((,c :foreground ,blue-faint))) + `(modus-themes-fg-blue-intense ((,c :foreground ,blue-intense))) + `(modus-themes-fg-magenta ((,c :foreground ,magenta))) + `(modus-themes-fg-magenta-warmer ((,c :foreground ,magenta-warmer))) + `(modus-themes-fg-magenta-cooler ((,c :foreground ,magenta-cooler))) + `(modus-themes-fg-magenta-faint ((,c :foreground ,magenta-faint))) + `(modus-themes-fg-magenta-intense ((,c :foreground ,magenta-intense))) + `(modus-themes-fg-cyan ((,c :foreground ,cyan))) + `(modus-themes-fg-cyan-warmer ((,c :foreground ,cyan-warmer))) + `(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 ((,class :background ,red-subtle-bg :foreground ,fg-dim))) - `(modus-themes-subtle-green ((,class :background ,green-subtle-bg :foreground ,fg-dim))) - `(modus-themes-subtle-yellow ((,class :background ,yellow-subtle-bg :foreground ,fg-dim))) - `(modus-themes-subtle-blue ((,class :background ,blue-subtle-bg :foreground ,fg-dim))) - `(modus-themes-subtle-magenta ((,class :background ,magenta-subtle-bg :foreground ,fg-dim))) - `(modus-themes-subtle-cyan ((,class :background ,cyan-subtle-bg :foreground ,fg-dim))) - `(modus-themes-subtle-neutral ((,class :background ,bg-inactive :foreground ,fg-inactive))) + `(modus-themes-subtle-red ((,c :background ,bg-red-subtle :foreground ,fg-main))) + `(modus-themes-subtle-green ((,c :background ,bg-green-subtle :foreground ,fg-main))) + `(modus-themes-subtle-yellow ((,c :background ,bg-yellow-subtle :foreground ,fg-main))) + `(modus-themes-subtle-blue ((,c :background ,bg-blue-subtle :foreground ,fg-main))) + `(modus-themes-subtle-magenta ((,c :background ,bg-magenta-subtle :foreground ,fg-main))) + `(modus-themes-subtle-cyan ((,c :background ,bg-cyan-subtle :foreground ,fg-main))) ;;;;; intense colored backgrounds - `(modus-themes-intense-red ((,class :background ,red-intense-bg :foreground ,fg-main))) - `(modus-themes-intense-green ((,class :background ,green-intense-bg :foreground ,fg-main))) - `(modus-themes-intense-yellow ((,class :background ,yellow-intense-bg :foreground ,fg-main))) - `(modus-themes-intense-blue ((,class :background ,blue-intense-bg :foreground ,fg-main))) - `(modus-themes-intense-magenta ((,class :background ,magenta-intense-bg :foreground ,fg-main))) - `(modus-themes-intense-cyan ((,class :background ,cyan-intense-bg :foreground ,fg-main))) - `(modus-themes-intense-neutral ((,class :background ,bg-active :foreground ,fg-main))) -;;;;; refined background and foreground combinations - ;; general purpose styles that use an accented foreground against an - ;; accented background - `(modus-themes-refine-red ((,class :background ,red-refine-bg :foreground ,red-refine-fg))) - `(modus-themes-refine-green ((,class :background ,green-refine-bg :foreground ,green-refine-fg))) - `(modus-themes-refine-yellow ((,class :background ,yellow-refine-bg :foreground ,yellow-refine-fg))) - `(modus-themes-refine-blue ((,class :background ,blue-refine-bg :foreground ,blue-refine-fg))) - `(modus-themes-refine-magenta ((,class :background ,magenta-refine-bg :foreground ,magenta-refine-fg))) - `(modus-themes-refine-cyan ((,class :background ,cyan-refine-bg :foreground ,cyan-refine-fg))) -;;;;; "active" combinations, mostly for use on the mode line - `(modus-themes-active-red ((,class :background ,red-active :foreground ,bg-active))) - `(modus-themes-active-green ((,class :background ,green-active :foreground ,bg-active))) - `(modus-themes-active-yellow ((,class :background ,yellow-active :foreground ,bg-active))) - `(modus-themes-active-blue ((,class :background ,blue-active :foreground ,bg-active))) - `(modus-themes-active-magenta ((,class :background ,magenta-active :foreground ,bg-active))) - `(modus-themes-active-cyan ((,class :background ,cyan-active :foreground ,bg-active))) -;;;;; nuanced backgrounds - ;; useful for adding an accented background that is suitable for all - ;; main foreground colors (intended for use in Org source blocks) - `(modus-themes-nuanced-red ((,class :background ,red-nuanced-bg :extend t))) - `(modus-themes-nuanced-green ((,class :background ,green-nuanced-bg :extend t))) - `(modus-themes-nuanced-yellow ((,class :background ,yellow-nuanced-bg :extend t))) - `(modus-themes-nuanced-blue ((,class :background ,blue-nuanced-bg :extend t))) - `(modus-themes-nuanced-magenta ((,class :background ,magenta-nuanced-bg :extend t))) - `(modus-themes-nuanced-cyan ((,class :background ,cyan-nuanced-bg :extend t))) -;;;;; fringe-specific combinations - `(modus-themes-fringe-red ((,class :background ,red-fringe-bg :foreground ,fg-main))) - `(modus-themes-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-main))) - `(modus-themes-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-main))) - `(modus-themes-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-main))) - `(modus-themes-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-main))) - `(modus-themes-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-main))) -;;;;; special base values - ;; these are closer to the grayscale than the accents defined above - ;; and should only be used when the next closest alternative would be - ;; a grayscale value than an accented one - `(modus-themes-special-cold ((,class :background ,bg-special-cold :foreground ,fg-special-cold))) - `(modus-themes-special-mild ((,class :background ,bg-special-mild :foreground ,fg-special-mild))) - `(modus-themes-special-warm ((,class :background ,bg-special-warm :foreground ,fg-special-warm))) - `(modus-themes-special-calm ((,class :background ,bg-special-calm :foreground ,fg-special-calm))) -;;;;; diff-specific combinations - ;; intended for `diff-mode' or equivalent - `(modus-themes-diff-added - ((,class ,@(modus-themes--diff - bg-diff-focus-added fg-diff-focus-added - green-nuanced-bg fg-diff-added - bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran - blue-nuanced-bg fg-diff-added-deuteran)))) - `(modus-themes-diff-changed - ((,class ,@(modus-themes--diff - bg-diff-focus-changed fg-diff-focus-changed - yellow-nuanced-bg fg-diff-changed)))) - `(modus-themes-diff-removed - ((,class ,@(modus-themes--diff - bg-diff-focus-removed fg-diff-focus-removed - red-nuanced-bg fg-diff-removed)))) - `(modus-themes-diff-refine-added - ((,class ,@(modus-themes--diff - bg-diff-refine-added fg-diff-refine-added - bg-diff-focus-added fg-diff-focus-added - bg-diff-refine-added-deuteran fg-diff-refine-added-deuteran - bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran)))) - `(modus-themes-diff-refine-changed - ((,class ,@(modus-themes--diff - bg-diff-refine-changed fg-diff-refine-changed - bg-diff-focus-changed fg-diff-focus-changed)))) - `(modus-themes-diff-refine-removed - ((,class ,@(modus-themes--diff - bg-diff-refine-removed fg-diff-refine-removed - bg-diff-focus-removed fg-diff-focus-removed)))) - `(modus-themes-diff-focus-added - ((,class ,@(modus-themes--diff - bg-diff-focus-added fg-diff-focus-added - bg-diff-added fg-diff-added - bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran - bg-diff-added-deuteran fg-diff-added-deuteran)))) - `(modus-themes-diff-focus-changed - ((,class ,@(modus-themes--diff - bg-diff-focus-changed fg-diff-focus-changed - bg-diff-changed fg-diff-changed)))) - `(modus-themes-diff-focus-removed - ((,class ,@(modus-themes--diff - bg-diff-focus-removed fg-diff-focus-removed - bg-diff-removed fg-diff-removed)))) - `(modus-themes-diff-heading - ((,class ,@(modus-themes--diff - bg-diff-heading fg-diff-heading - cyan-nuanced-bg cyan-nuanced-fg - bg-header fg-main - bg-header fg-main - t)))) -;;;;; deuteranopia-specific - `(modus-themes-grue ((,class :foreground ,@(modus-themes--deuteran blue green)))) - `(modus-themes-grue-active ((,class :foreground ,@(modus-themes--deuteran blue-active green-active)))) - `(modus-themes-grue-nuanced ((,class :foreground ,@(modus-themes--deuteran blue-nuanced-fg green-nuanced-fg)))) - `(modus-themes-grue-background-active ((,class :inherit ,@(modus-themes--deuteran - 'modus-themes-fringe-blue - 'modus-themes-fringe-green)))) - `(modus-themes-grue-background-intense ((,class :inherit ,@(modus-themes--deuteran - 'modus-themes-intense-blue - 'modus-themes-intense-green)))) - `(modus-themes-grue-background-subtle ((,class :inherit ,@(modus-themes--deuteran - 'modus-themes-subtle-blue - 'modus-themes-subtle-green)))) - `(modus-themes-grue-background-subtle ((,class :inherit ,@(modus-themes--deuteran - 'modus-themes-refine-blue - 'modus-themes-refine-green)))) + `(modus-themes-intense-red ((,c :background ,bg-red-intense :foreground ,fg-main))) + `(modus-themes-intense-green ((,c :background ,bg-green-intense :foreground ,fg-main))) + `(modus-themes-intense-yellow ((,c :background ,bg-yellow-intense :foreground ,fg-main))) + `(modus-themes-intense-blue ((,c :background ,bg-blue-intense :foreground ,fg-main))) + `(modus-themes-intense-magenta ((,c :background ,bg-magenta-intense :foreground ,fg-main))) + `(modus-themes-intense-cyan ((,c :background ,bg-cyan-intense :foreground ,fg-main))) ;;;;; mark indicators ;; color combinations intended for Dired, Ibuffer, or equivalent - `(modus-themes-pseudo-header ((,class :inherit bold :foreground ,fg-main))) - `(modus-themes-mark-alt ((,class :inherit bold :background ,bg-mark-alt :foreground ,fg-mark-alt))) - `(modus-themes-mark-del ((,class :inherit bold :background ,bg-mark-del :foreground ,fg-mark-del))) - `(modus-themes-mark-sel ((,class :inherit bold - :background ,@(modus-themes--deuteran - cyan-refine-bg - bg-mark-sel) - :foreground ,fg-mark-sel))) - `(modus-themes-mark-symbol ((,class :inherit bold :foreground ,blue-alt))) + `(modus-themes-mark-alt ((,c :inherit bold :background ,bg-yellow-subtle :foreground ,yellow))) + `(modus-themes-mark-del ((,c :inherit bold :background ,bg-red-subtle :foreground ,red))) + `(modus-themes-mark-sel ((,c :inherit bold :background ,bg-cyan-subtle :foreground ,cyan))) ;;;;; heading levels ;; styles for regular headings used in Org, Markdown, Info, etc. - `(modus-themes-heading-0 - ((,class ,@(modus-themes--heading - 0 cyan-alt-other blue-alt - cyan-nuanced-bg bg-alt bg-region)))) - `(modus-themes-heading-1 - ((,class ,@(modus-themes--heading - 1 fg-main magenta-alt-other - magenta-nuanced-bg bg-alt bg-region)))) - `(modus-themes-heading-2 - ((,class ,@(modus-themes--heading - 2 fg-special-warm magenta-alt - red-nuanced-bg bg-alt bg-region)))) - `(modus-themes-heading-3 - ((,class ,@(modus-themes--heading - 3 fg-special-cold blue - blue-nuanced-bg bg-alt bg-region)))) - `(modus-themes-heading-4 - ((,class ,@(modus-themes--heading - 4 fg-special-mild cyan - cyan-nuanced-bg bg-alt bg-region)))) - `(modus-themes-heading-5 - ((,class ,@(modus-themes--heading - 5 fg-special-calm green-alt-other - green-nuanced-bg bg-alt bg-region)))) - `(modus-themes-heading-6 - ((,class ,@(modus-themes--heading - 6 yellow-nuanced-fg yellow-alt-other - yellow-nuanced-bg bg-alt bg-region)))) - `(modus-themes-heading-7 - ((,class ,@(modus-themes--heading - 7 red-nuanced-fg red-alt - red-nuanced-bg bg-alt bg-region)))) - `(modus-themes-heading-8 - ((,class ,@(modus-themes--heading - 8 magenta-nuanced-fg magenta - bg-alt bg-alt bg-region)))) + `(modus-themes-heading-0 ((,c ,@(modus-themes--heading 0 fg-heading-0 bg-heading-0 overline-heading-0)))) + `(modus-themes-heading-1 ((,c ,@(modus-themes--heading 1 fg-heading-1 bg-heading-1 overline-heading-1)))) + `(modus-themes-heading-2 ((,c ,@(modus-themes--heading 2 fg-heading-2 bg-heading-2 overline-heading-2)))) + `(modus-themes-heading-3 ((,c ,@(modus-themes--heading 3 fg-heading-3 bg-heading-3 overline-heading-3)))) + `(modus-themes-heading-4 ((,c ,@(modus-themes--heading 4 fg-heading-4 bg-heading-4 overline-heading-4)))) + `(modus-themes-heading-5 ((,c ,@(modus-themes--heading 5 fg-heading-5 bg-heading-5 overline-heading-5)))) + `(modus-themes-heading-6 ((,c ,@(modus-themes--heading 6 fg-heading-6 bg-heading-6 overline-heading-6)))) + `(modus-themes-heading-7 ((,c ,@(modus-themes--heading 7 fg-heading-7 bg-heading-7 overline-heading-7)))) + `(modus-themes-heading-8 ((,c ,@(modus-themes--heading 8 fg-heading-8 bg-heading-8 overline-heading-8)))) ;;;;; language checkers - `(modus-themes-lang-error ((,class ,@(modus-themes--lang-check - fg-lang-underline-error fg-lang-error - red red-refine-fg red-nuanced-bg red-refine-bg red-faint)))) - `(modus-themes-lang-note ((,class ,@(modus-themes--lang-check - fg-lang-underline-note fg-lang-note - blue-alt blue-refine-fg blue-nuanced-bg blue-refine-bg blue-faint)))) - `(modus-themes-lang-warning ((,class ,@(modus-themes--lang-check - fg-lang-underline-warning fg-lang-warning - yellow yellow-refine-fg yellow-nuanced-bg yellow-refine-bg yellow-faint)))) -;;;;; links - `(modus-themes-link-broken ((,class :inherit button ,@(modus-themes--link-color red red-faint)))) - `(modus-themes-link-symlink ((,class :inherit button ,@(modus-themes--link-color cyan cyan-faint)))) + `(modus-themes-lang-error ((,c :underline (:style wave :color ,underline-err)))) + `(modus-themes-lang-note ((,c :underline (:style wave :color ,underline-note)))) + `(modus-themes-lang-warning ((,c :underline (:style wave :color ,underline-warning)))) ;;;;; markup - `(modus-themes-markup-code - ((,class ,@(modus-themes--markup cyan-alt-other cyan-intense bg-alt - bg-special-faint-mild)))) - `(modus-themes-markup-macro - ((,class ,@(modus-themes--markup magenta-alt-other purple-intense bg-alt - bg-special-faint-cold)))) - `(modus-themes-markup-verbatim - ((,class ,@(modus-themes--markup magenta-alt magenta-intense bg-alt - bg-special-faint-calm)))) + `(modus-themes-prose-code ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-code))) + `(modus-themes-prose-macro ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-macro))) + `(modus-themes-prose-verbatim ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-verbatim))) ;;;;; search - `(modus-themes-search-success ((,class :inherit modus-themes-intense-yellow))) - `(modus-themes-search-success-lazy ((,class :inherit modus-themes-subtle-cyan))) - `(modus-themes-search-success-modeline ((,class :foreground ,@(modus-themes--deuteran - blue-active - green-active)))) -;;;;; tabs - `(modus-themes-tab-active ((,class ,@(modus-themes--tab bg-tab-active nil nil nil t t)))) - `(modus-themes-tab-backdrop ((,class ,@(modus-themes--tab bg-active bg-active-accent nil nil nil nil t)))) - `(modus-themes-tab-inactive ((,class ,@(modus-themes--tab bg-tab-inactive bg-tab-inactive-accent fg-dim nil t)))) + `(modus-themes-search-current ((,c :background ,bg-yellow-intense :foreground ,fg-main))) + `(modus-themes-search-lazy ((,c :background ,bg-cyan-intense :foreground ,fg-main))) ;;;;; completion frameworks - `(modus-themes-completion-match-0 - ((,class ,@(modus-themes--completion-match - 'matches bg-special-faint-calm magenta-alt - magenta-subtle-bg magenta-intense)))) - `(modus-themes-completion-match-1 - ((,class ,@(modus-themes--completion-match - 'matches bg-special-faint-cold blue - blue-subtle-bg blue-intense)))) - `(modus-themes-completion-match-2 - ((,class ,@(modus-themes--completion-match - 'matches bg-special-faint-mild green - green-subtle-bg green-intense)))) - `(modus-themes-completion-match-3 - ((,class ,@(modus-themes--completion-match - 'matches bg-special-faint-warm yellow - yellow-subtle-bg orange-intense)))) - `(modus-themes-completion-selected - ((,class ,@(modus-themes--completion-line - 'selection bg-inactive blue-alt - bg-active blue-active - bg-completion-subtle bg-completion)))) - `(modus-themes-completion-selected-popup - ((,class ,@(modus-themes--completion-line - 'popup bg-active blue-alt - bg-region blue-active - cyan-subtle-bg cyan-refine-bg)))) -;;;;; buttons - `(modus-themes-box-button - ((,class ,@(modus-themes--button bg-active bg-main bg-active-accent - bg-special-cold bg-region)))) - `(modus-themes-box-button-pressed - ((,class ,@(modus-themes--button bg-active bg-main bg-active-accent - bg-special-cold bg-region t)))) + `(modus-themes-completion-match-0 ((,c ,@(modus-themes--completion-match fg-completion-match-0 bg-completion-match-0)))) + `(modus-themes-completion-match-1 ((,c ,@(modus-themes--completion-match fg-completion-match-1 bg-completion-match-1)))) + `(modus-themes-completion-match-2 ((,c ,@(modus-themes--completion-match fg-completion-match-2 bg-completion-match-2)))) + `(modus-themes-completion-match-3 ((,c ,@(modus-themes--completion-match fg-completion-match-3 bg-completion-match-3)))) + `(modus-themes-completion-selected ((,c ,@(modus-themes--completion-line bg-completion)))) ;;;;; typography - `(modus-themes-bold ((,class ,@(modus-themes--bold-weight)))) - `(modus-themes-fixed-pitch ((,class ,@(modus-themes--fixed-pitch)))) - `(modus-themes-slant ((,class ,@(modus-themes--slant)))) - `(modus-themes-ui-variable-pitch ((,class ,@(modus-themes--variable-pitch-ui)))) + `(modus-themes-bold ((,c ,@(modus-themes--bold-weight)))) + `(modus-themes-fixed-pitch ((,c ,@(modus-themes--fixed-pitch)))) + `(modus-themes-slant ((,c ,@(modus-themes--slant)))) + `(modus-themes-ui-variable-pitch ((,c ,@(modus-themes--variable-pitch-ui)))) ;;;;; other custom faces - `(modus-themes-hl-line ((,class ,@(modus-themes--hl-line - bg-hl-line bg-hl-line-intense - bg-hl-line-intense-accent blue-nuanced-bg - bg-region blue-intense-bg - fg-alt blue-intense) - :extend t))) - `(modus-themes-key-binding ((,class :inherit (bold modus-themes-fixed-pitch) - :foreground ,blue-alt-other))) - `(modus-themes-prompt ((,class ,@(modus-themes--prompt - cyan-alt-other blue-alt-other fg-alt - cyan-nuanced-bg blue-refine-bg fg-main - bg-alt bg-active)))) - `(modus-themes-reset-hard ((,class :inherit (fixed-pitch modus-themes-reset-soft) - :family ,(face-attribute 'default :family)))) - `(modus-themes-reset-soft ((,class :background ,bg-main :foreground ,fg-main - :weight normal :slant normal :strike-through nil - :box nil :underline nil :overline nil :extend nil))) + `(modus-themes-button ((,c :inherit variable-pitch :box ,border :background ,bg-button-active :foreground ,fg-button-active))) + `(modus-themes-key-binding ((,c :inherit (bold modus-themes-fixed-pitch) :foreground ,keybind))) + `(modus-themes-prompt ((,c ,@(modus-themes--prompt fg-prompt bg-prompt)))) + `(modus-themes-reset-soft ((,c :background ,bg-main :foreground ,fg-main + :weight normal :slant normal :strike-through nil + :box nil :underline nil :overline nil :extend nil))) ;;;; standard faces ;;;;; absolute essentials - `(default ((,class :background ,bg-main :foreground ,fg-main))) - `(cursor ((,class :background ,fg-main))) - `(fringe ((,class ,@(modus-themes--fringe bg-main bg-inactive bg-active) - :foreground ,fg-main))) - `(vertical-border ((,class :foreground ,fg-window-divider-inner))) + `(default ((,c :background ,bg-main :foreground ,fg-main))) + `(cursor ((,c :background ,cursor))) + `(fringe ((,c :background ,fringe :foreground ,fg-main))) + `(menu ((,c :background ,bg-tab-bar :foreground ,fg-main))) + `(scroll-bar ((,c :background ,fringe :foreground ,fg-dim))) + `(tool-bar ((,c :background ,bg-tab-bar :foreground ,fg-main))) + `(vertical-border ((,c :foreground ,border))) ;;;;; basic and/or ungrouped styles - `(bold ((,class :weight bold))) - `(bold-italic ((,class :inherit (bold italic)))) - `(underline ((,class :underline ,fg-alt))) - `(buffer-menu-buffer ((,class :inherit bold))) - `(child-frame-border ((,class :background ,fg-window-divider-inner))) - `(comint-highlight-input ((,class :inherit bold))) - `(comint-highlight-prompt ((,class :inherit modus-themes-prompt))) - `(confusingly-reordered ((,class :inherit modus-themes-lang-error))) - `(edmacro-label ((,class :inherit bold :foreground ,cyan))) - `(elisp-shorthand-font-lock-face ((,class :inherit font-lock-variable-name-face))) - `(error ((,class :inherit bold :foreground ,red))) - `(escape-glyph ((,class :foreground ,fg-escape-char-construct))) - `(file-name-shadow ((,class :inherit shadow))) - `(header-line ((,class :inherit modus-themes-ui-variable-pitch - :background ,bg-header :foreground ,fg-header))) - `(header-line-highlight ((,class :inherit highlight))) - `(help-argument-name ((,class :inherit modus-themes-slant :foreground ,cyan))) - `(help-key-binding ((,class :inherit modus-themes-key-binding))) - `(homoglyph ((,class :foreground ,red-alt-faint))) - `(ibuffer-locked-buffer ((,class :foreground ,yellow-alt-other-faint))) - `(icon-button ((,class :inherit modus-themes-box-button))) - `(italic ((,class :slant italic))) - `(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct))) - `(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline t))) - `(menu ((,class :inverse-video unspecified :inherit modus-themes-intense-neutral))) - `(minibuffer-prompt ((,class :inherit modus-themes-prompt))) - `(mm-command-output ((,class :foreground ,red-alt-other))) - `(mm-uu-extract ((,class :background ,bg-dim :foreground ,fg-special-mild))) - `(next-error ((,class :inherit modus-themes-subtle-red :extend t))) - `(pgtk-im-0 ((,class :inherit modus-themes-refine-cyan))) - `(read-multiple-choice-face ((,class :inherit (bold modus-themes-mark-alt)))) - `(rectangle-preview ((,class :inherit modus-themes-special-warm))) - `(region ((,class ,@(modus-themes--region bg-region fg-main - bg-hl-alt-intense bg-region-accent - bg-region-accent-subtle)))) - `(secondary-selection ((,class :inherit modus-themes-special-cold))) - `(separator-line ((,class :underline ,bg-region))) - `(shadow ((,class :foreground ,fg-alt))) - `(success ((,class :inherit (bold modus-themes-grue)))) - `(trailing-whitespace ((,class :background ,red-intense-bg))) - `(warning ((,class :inherit bold :foreground ,yellow))) + `(bold ((,c :weight bold))) + `(bold-italic ((,c :inherit (bold italic)))) + `(underline ((,c :underline ,fg-dim))) + `(buffer-menu-buffer ((,c :inherit bold))) + `(child-frame-border ((,c :background ,border))) + `(comint-highlight-input ((,c :inherit bold))) + `(comint-highlight-prompt ((,c :inherit modus-themes-prompt))) + `(confusingly-reordered ((,c :inherit modus-themes-lang-error))) + `(edmacro-label ((,c :inherit bold :foreground ,accent-0))) + `(elisp-shorthand-font-lock-face ((,c :inherit font-lock-variable-name-face))) + `(error ((,c :inherit bold :foreground ,err))) + `(escape-glyph ((,c :foreground ,err))) + `(file-name-shadow ((,c :inherit shadow))) + `(header-line ((,c :inherit modus-themes-ui-variable-pitch :background ,bg-dim))) + `(header-line-highlight ((,c :inherit highlight))) + `(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))) + `(italic ((,c :slant italic))) + `(nobreak-hyphen ((,c :foreground ,err))) + `(nobreak-space ((,c :foreground ,err :underline t))) + `(menu ((,c :inverse-video unspecified :background ,bg-active :foreground ,fg-main))) + `(minibuffer-prompt ((,c :inherit modus-themes-prompt))) + `(mm-command-output ((,c :foreground ,mail-part))) + `(mm-uu-extract ((,c :foreground ,mail-part))) + `(next-error ((,c :inherit modus-themes-subtle-red :extend t))) + `(pgtk-im-0 ((,c :inherit modus-themes-intense-cyan))) + `(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 :foreground ,fg-main))) + `(separator-line ((,c :underline ,bg-active))) + `(shadow ((,c :foreground ,fg-dim))) + `(success ((,c :inherit bold :foreground ,info))) + `(trailing-whitespace ((,c :background ,bg-red-intense))) + `(warning ((,c :inherit bold :foreground ,warning))) ;;;;; buttons, links, widgets - `(button ((,class ,@(modus-themes--link - blue-alt-other blue-alt-other-faint - bg-region blue-nuanced-bg bg-alt)))) - `(link ((,class :inherit button))) - `(link-visited ((,class :inherit button - ,@(modus-themes--link-color - magenta-alt-other magenta-alt-other-faint fg-alt)))) - `(tooltip ((,class :background ,bg-special-cold :foreground ,fg-main))) - `(widget-button ((,class ,@(if (memq 'all-buttons modus-themes-box-buttons) - (list :inherit 'modus-themes-box-button) - (list :inherit 'bold :foreground blue-alt))))) - `(widget-button-pressed ((,class ,@(if (memq 'all-buttons modus-themes-box-buttons) - (list :inherit 'modus-themes-box-button-pressed) - (list :inherit 'bold :foreground magenta-alt))))) - `(widget-documentation ((,class :foreground ,green))) - `(widget-field ((,class :background ,bg-alt :foreground ,fg-main :extend nil))) - `(widget-inactive ((,class :inherit shadow :background ,bg-dim))) - `(widget-single-line-field ((,class :inherit widget-field))) -;;;;; alert - `(alert-high-face ((,class :inherit bold :foreground ,red-alt))) - `(alert-low-face ((,class :foreground ,fg-special-mild))) - `(alert-moderate-face ((,class :inherit bold :foreground ,yellow))) - `(alert-trivial-face ((,class :foreground ,fg-special-calm))) - `(alert-urgent-face ((,class :inherit bold :foreground ,red-intense))) + `(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 :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))) + `(agda2-highlight-coinductive-constructor-face ((,c :inherit font-lock-type-face))) + `(agda2-highlight-coverage-problem-face ((,c :inherit modus-themes-lang-error))) + `(agda2-highlight-datatype-face ((,c :inherit font-lock-type-face))) + `(agda2-highlight-deadcode-face ((,c :background ,bg-active))) + `(agda2-highlight-dotted-face ((,c :inherit font-lock-variable-name-face))) + `(agda2-highlight-error-face ((,c :inherit modus-themes-lang-error))) + `(agda2-highlight-field-face ((,c :inherit font-lock-type-face))) + `(agda2-highlight-function-face ((,c :inherit font-lock-function-name-face))) + `(agda2-highlight-generalizable-variable-face ((,c :inherit font-lock-variable-name-face))) + `(agda2-highlight-incomplete-pattern-face ((,c :inherit modus-themes-lang-warning))) + `(agda2-highlight-inductive-constructor-face ((,c :inherit font-lock-type-face))) + `(agda2-highlight-keyword-face ((,c :inherit font-lock-keyword-face))) + `(agda2-highlight-macro-face ((,c :inherit font-lock-keyword-face))) + `(agda2-highlight-module-face ((,c :inherit font-lock-variable-name-face))) + `(agda2-highlight-number-face ((,c :inherit shadow))) + `(agda2-highlight-operator-face ((,c :inherit font-lock-variable-name-face))) + `(agda2-highlight-positivity-problem-face ((,c :inherit modus-themes-lang-warning))) + `(agda2-highlight-postulate-face ((,c :inherit font-lock-type-face))) + `(agda2-highlight-pragma-face ((,c :inherit font-lock-preprocessor-face))) + `(agda2-highlight-primitive-face ((,c :inherit font-lock-type-face))) + `(agda2-highlight-primitive-type-face ((,c :inherit font-lock-type-face))) + `(agda2-highlight-record-face ((,c :inherit font-lock-type-face))) + `(agda2-highlight-string-face ((,c :inherit font-lock-string-face))) + `(agda2-highlight-symbol-face ((,c :inherit font-lock-constant-face))) + `(agda2-highlight-termination-problem-face ((,c :inherit modus-themes-lang-warning))) + `(agda2-highlight-typechecks-face ((,c :inherit font-lock-warning-face))) + `(agda2-highlight-unsolved-constraint-face ((,c :inherit modus-themes-lang-warning))) + `(agda2-highlight-unsolved-meta-face ((,c :inherit modus-themes-lang-warning))) ;;;;; all-the-icons - `(all-the-icons-blue ((,class :foreground ,blue-alt-other))) - `(all-the-icons-blue-alt ((,class :foreground ,blue-alt))) - `(all-the-icons-cyan ((,class :foreground ,cyan-intense))) - `(all-the-icons-cyan-alt ((,class :foreground ,cyan-alt))) - `(all-the-icons-dblue ((,class :foreground ,blue-faint))) - `(all-the-icons-dcyan ((,class :foreground ,cyan-faint))) - `(all-the-icons-dgreen ((,class :foreground ,green))) - `(all-the-icons-dmaroon ((,class :foreground ,magenta-alt-faint))) - `(all-the-icons-dorange ((,class :foreground ,red-alt-faint))) - `(all-the-icons-dpink ((,class :foreground ,magenta-faint))) - `(all-the-icons-dpurple ((,class :foreground ,magenta-alt-other-faint))) - `(all-the-icons-dred ((,class :foreground ,red-faint))) - `(all-the-icons-dsilver ((,class :foreground ,cyan-alt-faint))) - `(all-the-icons-dyellow ((,class :foreground ,yellow-alt-faint))) - `(all-the-icons-green ((,class :foreground ,green-intense))) - `(all-the-icons-lblue ((,class :foreground ,blue-alt-other))) - `(all-the-icons-lcyan ((,class :foreground ,cyan))) - `(all-the-icons-lgreen ((,class :foreground ,green-alt-other))) - `(all-the-icons-lmaroon ((,class :foreground ,magenta-alt))) - `(all-the-icons-lorange ((,class :foreground ,red-alt))) - `(all-the-icons-lpink ((,class :foreground ,magenta))) - `(all-the-icons-lpurple ((,class :foreground ,magenta-faint))) - `(all-the-icons-lred ((,class :foreground ,red))) - `(all-the-icons-lsilver ((,class :foreground ,fg-docstring))) - `(all-the-icons-lyellow ((,class :foreground ,yellow-alt))) - `(all-the-icons-maroon ((,class :foreground ,magenta-intense))) - `(all-the-icons-orange ((,class :foreground ,orange-intense))) - `(all-the-icons-pink ((,class :foreground ,fg-special-calm))) - `(all-the-icons-purple ((,class :foreground ,magenta-alt-other))) - `(all-the-icons-purple-alt ((,class :foreground ,purple-intense))) - `(all-the-icons-red ((,class :foreground ,red-intense))) - `(all-the-icons-red-alt ((,class :foreground ,red-alt-other))) - `(all-the-icons-silver ((,class :foreground ,fg-special-cold))) - `(all-the-icons-yellow ((,class :foreground ,yellow))) + `(all-the-icons-blue ((,c :foreground ,blue-cooler))) + `(all-the-icons-blue-warmer ((,c :foreground ,blue-warmer))) + `(all-the-icons-cyan ((,c :foreground ,cyan-intense))) + `(all-the-icons-cyan-warmer ((,c :foreground ,cyan-warmer))) + `(all-the-icons-dblue ((,c :foreground ,blue-faint))) + `(all-the-icons-dcyan ((,c :foreground ,cyan-faint))) + `(all-the-icons-dgreen ((,c :foreground ,green-faint))) + `(all-the-icons-dmaroon ((,c :foreground ,magenta-faint))) + `(all-the-icons-dorange ((,c :foreground ,red-faint))) + `(all-the-icons-dpink ((,c :foreground ,magenta-faint))) + `(all-the-icons-dpurple ((,c :foreground ,magenta-cooler))) + `(all-the-icons-dred ((,c :foreground ,red-faint))) + `(all-the-icons-dsilver ((,c :foreground ,cyan-faint))) + `(all-the-icons-dyellow ((,c :foreground ,yellow-faint))) + `(all-the-icons-green ((,c :foreground ,green))) + `(all-the-icons-lblue ((,c :foreground ,blue-cooler))) + `(all-the-icons-lcyan ((,c :foreground ,cyan))) + `(all-the-icons-lgreen ((,c :foreground ,green-warmer))) + `(all-the-icons-lmaroon ((,c :foreground ,magenta-warmer))) + `(all-the-icons-lorange ((,c :foreground ,red-warmer))) + `(all-the-icons-lpink ((,c :foreground ,magenta))) + `(all-the-icons-lpurple ((,c :foreground ,magenta-faint))) + `(all-the-icons-lred ((,c :foreground ,red))) + `(all-the-icons-lyellow ((,c :foreground ,yellow-warmer))) + `(all-the-icons-maroon ((,c :foreground ,yellow-cooler))) + `(all-the-icons-red ((,c :foreground ,red-intense))) + `(all-the-icons-red-warmer ((,c :foreground ,red-cooler))) + `(all-the-icons-yellow ((,c :foreground ,yellow-intense))) ;;;;; all-the-icons-dired - `(all-the-icons-dired-dir-face ((,class :foreground ,cyan-faint))) + `(all-the-icons-dired-dir-face ((,c :foreground ,cyan-faint))) ;;;;; all-the-icons-ibuffer - `(all-the-icons-ibuffer-dir-face ((,class :foreground ,cyan-faint))) - `(all-the-icons-ibuffer-file-face ((,class :foreground ,blue-faint))) - `(all-the-icons-ibuffer-mode-face ((,class :foreground ,cyan))) - `(all-the-icons-ibuffer-size-face ((,class :foreground ,cyan-alt-other))) + `(all-the-icons-ibuffer-dir-face ((,c :foreground ,cyan-faint))) + `(all-the-icons-ibuffer-file-face ((,c :foreground ,blue-faint))) + `(all-the-icons-ibuffer-mode-face ((,c :foreground ,cyan))) + `(all-the-icons-ibuffer-size-face ((,c :foreground ,cyan-cooler))) ;;;;; annotate - `(annotate-annotation ((,class :inherit modus-themes-subtle-blue))) - `(annotate-annotation-secondary ((,class :inherit modus-themes-subtle-green))) - `(annotate-highlight ((,class :background ,blue-nuanced-bg :underline ,blue-intense))) - `(annotate-highlight-secondary ((,class :background ,green-nuanced-bg :underline ,green-intense))) + `(annotate-annotation ((,c :inherit modus-themes-subtle-blue))) + `(annotate-annotation-secondary ((,c :inherit modus-themes-subtle-magenta))) + `(annotate-highlight ((,c :background ,bg-blue-subtle :underline ,blue-intense))) + `(annotate-highlight-secondary ((,c :background ,bg-magenta-subtle :underline ,magenta-intense))) ;;;;; ansi-color ;; Those are in Emacs28. - `(ansi-color-black ((,class :background "black" :foreground "black"))) - `(ansi-color-blue ((,class :background ,blue :foreground ,blue))) - `(ansi-color-bold ((,class :inherit bold))) - `(ansi-color-bright-black ((,class :background "gray35" :foreground "gray35"))) - `(ansi-color-bright-blue ((,class :background ,blue-alt :foreground ,blue-alt))) - `(ansi-color-bright-cyan ((,class :background ,cyan-alt-other :foreground ,cyan-alt-other))) - `(ansi-color-bright-green ((,class :background ,green-alt-other :foreground ,green-alt-other))) - `(ansi-color-bright-magenta ((,class :background ,magenta-alt-other :foreground ,magenta-alt-other))) - `(ansi-color-bright-red ((,class :background ,red-alt :foreground ,red-alt))) - `(ansi-color-bright-white ((,class :background "white" :foreground "white"))) - `(ansi-color-bright-yellow ((,class :background ,yellow-alt :foreground ,yellow-alt))) - `(ansi-color-cyan ((,class :background ,cyan :foreground ,cyan))) - `(ansi-color-green ((,class :background ,green :foreground ,green))) - `(ansi-color-magenta ((,class :background ,magenta :foreground ,magenta))) - `(ansi-color-red ((,class :background ,red :foreground ,red))) - `(ansi-color-white ((,class :background "gray65" :foreground "gray65"))) - `(ansi-color-yellow ((,class :background ,yellow :foreground ,yellow))) + `(ansi-color-black ((,c :background "black" :foreground "black"))) + `(ansi-color-blue ((,c :background ,blue :foreground ,blue))) + `(ansi-color-bold ((,c :inherit bold))) + `(ansi-color-bright-black ((,c :background "gray35" :foreground "gray35"))) + `(ansi-color-bright-blue ((,c :background ,blue-warmer :foreground ,blue-warmer))) + `(ansi-color-bright-cyan ((,c :background ,cyan-cooler :foreground ,cyan-cooler))) + `(ansi-color-bright-green ((,c :background ,green-cooler :foreground ,green-cooler))) + `(ansi-color-bright-magenta ((,c :background ,magenta-cooler :foreground ,magenta-cooler))) + `(ansi-color-bright-red ((,c :background ,red-warmer :foreground ,red-warmer))) + `(ansi-color-bright-white ((,c :background "white" :foreground "white"))) + `(ansi-color-bright-yellow ((,c :background ,yellow-warmer :foreground ,yellow-warmer))) + `(ansi-color-cyan ((,c :background ,cyan :foreground ,cyan))) + `(ansi-color-green ((,c :background ,green :foreground ,green))) + `(ansi-color-magenta ((,c :background ,magenta :foreground ,magenta))) + `(ansi-color-red ((,c :background ,red :foreground ,red))) + `(ansi-color-white ((,c :background "gray65" :foreground "gray65"))) + `(ansi-color-yellow ((,c :background ,yellow :foreground ,yellow))) ;;;;; anzu - `(anzu-match-1 ((,class :inherit modus-themes-subtle-cyan))) - `(anzu-match-2 ((,class :inherit modus-themes-search-success))) - `(anzu-match-3 ((,class :inherit modus-themes-subtle-yellow))) - `(anzu-mode-line ((,class :inherit (bold modus-themes-search-success-modeline)))) - `(anzu-mode-line-no-match ((,class :inherit bold :foreground ,red-active))) - `(anzu-replace-highlight ((,class :inherit modus-themes-refine-red :underline t))) - `(anzu-replace-to ((,class :inherit modus-themes-search-success))) -;;;;; apropos - `(apropos-button ((,class :foreground ,magenta-alt-other))) - `(apropos-function-button ((,class :foreground ,magenta))) - `(apropos-keybinding ((,class :inherit modus-themes-key-binding))) - `(apropos-misc-button ((,class :foreground ,green-alt-other))) - `(apropos-property ((,class :inherit modus-themes-bold :foreground ,magenta-alt))) - `(apropos-symbol ((,class :inherit modus-themes-pseudo-header))) - `(apropos-user-option-button ((,class :foreground ,cyan))) - `(apropos-variable-button ((,class :foreground ,blue-alt))) -;;;;; artbollocks-mode - `(artbollocks-face ((,class :inherit modus-themes-lang-note))) - `(artbollocks-lexical-illusions-face ((,class :background ,bg-alt :foreground ,red-alt :underline t))) - `(artbollocks-passive-voice-face ((,class :inherit modus-themes-lang-warning))) - `(artbollocks-weasel-words-face ((,class :inherit modus-themes-lang-error))) + `(anzu-match-1 ((,c :inherit modus-themes-subtle-cyan))) + `(anzu-match-2 ((,c :inherit modus-themes-search-current))) + `(anzu-match-3 ((,c :inherit modus-themes-subtle-yellow))) + `(anzu-mode-line ((,c :inherit bold))) + `(anzu-mode-line-no-match ((,c :inherit error))) + `(anzu-replace-highlight ((,c :inherit modus-themes-intense-red :underline t))) + `(anzu-replace-to ((,c :inherit modus-themes-search-current))) ;;;;; auctex and Tex - `(font-latex-bold-face ((,class :inherit bold))) - `(font-latex-doctex-documentation-face ((,class :inherit font-lock-doc-face))) - `(font-latex-doctex-preprocessor-face ((,class :inherit font-lock-preprocessor-face))) - `(font-latex-italic-face ((,class :inherit italic))) - `(font-latex-math-face ((,class :inherit font-lock-constant-face))) - `(font-latex-script-char-face ((,class :inherit font-lock-builtin-face))) - `(font-latex-sectioning-5-face ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,blue-nuanced-fg))) - `(font-latex-sedate-face ((,class :inherit font-lock-keyword-face))) - `(font-latex-slide-title-face ((,class :inherit modus-themes-heading-1))) - `(font-latex-string-face ((,class :inherit font-lock-string-face))) - `(font-latex-subscript-face ((,class :height 0.95))) - `(font-latex-superscript-face ((,class :height 0.95))) - `(font-latex-underline-face ((,class :inherit underline))) - `(font-latex-verbatim-face ((,class :inherit modus-themes-markup-verbatim))) - `(font-latex-warning-face ((,class :inherit font-lock-warning-face))) - `(tex-verbatim ((,class :inherit modus-themes-markup-verbatim))) - `(texinfo-heading ((,class :foreground ,magenta))) - `(TeX-error-description-error ((,class :inherit error))) - `(TeX-error-description-help ((,class :inherit success))) - `(TeX-error-description-tex-said ((,class :inherit success))) - `(TeX-error-description-warning ((,class :inherit warning))) + `(font-latex-bold-face ((,c :inherit bold))) + `(font-latex-doctex-documentation-face ((,c :inherit font-lock-doc-face))) + `(font-latex-doctex-preprocessor-face ((,c :inherit font-lock-preprocessor-face))) + `(font-latex-italic-face ((,c :inherit italic))) + `(font-latex-math-face ((,c :inherit font-lock-constant-face))) + `(font-latex-script-char-face ((,c :inherit font-lock-builtin-face))) + `(font-latex-sectioning-5-face ((,c :inherit (bold modus-themes-variable-pitch) :foreground ,fg-alt))) + `(font-latex-sedate-face ((,c :inherit font-lock-keyword-face))) + `(font-latex-slide-title-face ((,c :inherit modus-themes-heading-1))) + `(font-latex-string-face ((,c :inherit font-lock-string-face))) + `(font-latex-subscript-face ((,c :height 0.95))) + `(font-latex-superscript-face ((,c :height 0.95))) + `(font-latex-underline-face ((,c :inherit underline))) + `(font-latex-verbatim-face ((,c :inherit modus-themes-prose-verbatim))) + `(font-latex-warning-face ((,c :inherit font-lock-warning-face))) + `(tex-verbatim ((,c :inherit modus-themes-prose-verbatim))) + ;; `(texinfo-heading ((,c :foreground ,magenta))) + `(TeX-error-description-error ((,c :inherit error))) + `(TeX-error-description-help ((,c :inherit success))) + `(TeX-error-description-tex-said ((,c :inherit success))) + `(TeX-error-description-warning ((,c :inherit warning))) ;;;;; auto-dim-other-buffers - `(auto-dim-other-buffers-face ((,class :background ,bg-alt))) + `(auto-dim-other-buffers-face ((,c :background ,bg-inactive))) ;;;;; avy - `(avy-background-face ((,class :background ,bg-dim :foreground ,fg-dim :extend t))) - `(avy-goto-char-timer-face ((,class :inherit (modus-themes-intense-neutral bold)))) - `(avy-lead-face ((,class :inherit (bold modus-themes-reset-soft) :background ,bg-char-0))) - `(avy-lead-face-0 ((,class :inherit (bold modus-themes-reset-soft) :background ,bg-char-1))) - `(avy-lead-face-1 ((,class :inherit (modus-themes-special-warm modus-themes-reset-soft)))) - `(avy-lead-face-2 ((,class :inherit (bold modus-themes-reset-soft) :background ,bg-char-2))) + `(avy-background-face ((,c :background ,bg-dim :foreground ,fg-dim :extend t))) + `(avy-goto-char-timer-face ((,c :inherit bold :background ,bg-active))) + `(avy-lead-face ((,c :inherit (bold modus-themes-reset-soft) :background ,bg-char-0))) + `(avy-lead-face-0 ((,c :inherit (bold modus-themes-reset-soft) :background ,bg-char-1))) + `(avy-lead-face-1 ((,c :inherit modus-themes-reset-soft :background ,bg-inactive))) + `(avy-lead-face-2 ((,c :inherit (bold modus-themes-reset-soft) :background ,bg-char-2))) ;;;;; aw (ace-window) - `(aw-background-face ((,class :foreground ,fg-unfocused))) - `(aw-key-face ((,class :inherit modus-themes-key-binding))) - `(aw-leading-char-face ((,class :inherit (bold modus-themes-reset-soft) :height 1.5 - :foreground ,red-intense))) - `(aw-minibuffer-leading-char-face ((,class :inherit (modus-themes-intense-red bold)))) - `(aw-mode-line-face ((,class :inherit bold))) -;;;;; awesome-tray - `(awesome-tray-module-awesome-tab-face ((,class :inherit bold :foreground ,red-alt-other))) - `(awesome-tray-module-battery-face ((,class :inherit bold :foreground ,cyan-alt-other))) - `(awesome-tray-module-buffer-name-face ((,class :inherit bold :foreground ,yellow-alt-other))) - `(awesome-tray-module-circe-face ((,class :inherit bold :foreground ,blue-alt))) - `(awesome-tray-module-date-face ((,class :inherit bold :foreground ,fg-dim))) - `(awesome-tray-module-evil-face ((,class :inherit bold :foreground ,green-alt))) - `(awesome-tray-module-git-face ((,class :inherit bold :foreground ,magenta))) - `(awesome-tray-module-last-command-face ((,class :inherit bold :foreground ,blue-alt-other))) - `(awesome-tray-module-location-face ((,class :inherit bold :foreground ,yellow))) - `(awesome-tray-module-mode-name-face ((,class :inherit bold :foreground ,green))) - `(awesome-tray-module-parent-dir-face ((,class :inherit bold :foreground ,cyan))) - `(awesome-tray-module-rvm-face ((,class :inherit bold :foreground ,magenta-alt-other))) -;;;;; bbdb - `(bbdb-name ((,class :foreground ,magenta-alt-other))) - `(bbdb-organization ((,class :foreground ,red-alt-other))) - `(bbdb-field-name ((,class :foreground ,cyan-alt-other))) + `(aw-background-face ((,c :foreground "gray50"))) + `(aw-key-face ((,c :inherit modus-themes-key-binding))) + `(aw-leading-char-face ((,c :inherit (bold modus-themes-reset-soft) :height 1.5 :foreground ,red-intense))) + `(aw-minibuffer-leading-char-face ((,c :inherit (modus-themes-intense-red bold)))) + `(aw-mode-line-face ((,c :inherit bold))) ;;;;; binder - `(binder-sidebar-highlight ((,class :inherit modus-themes-subtle-cyan))) - `(binder-sidebar-marked ((,class :inherit modus-themes-mark-sel))) - `(binder-sidebar-missing ((,class :inherit modus-themes-subtle-red))) - `(binder-sidebar-tags ((,class :foreground ,cyan))) -;;;;; bm - `(bm-face ((,class :inherit modus-themes-subtle-yellow :extend t))) - `(bm-fringe-face ((,class :inherit modus-themes-fringe-yellow))) - `(bm-fringe-persistent-face ((,class :inherit modus-themes-fringe-blue))) - `(bm-persistent-face ((,class :inherit modus-themes-intense-blue :extend t))) + `(binder-sidebar-highlight ((,c :inherit modus-themes-subtle-cyan))) + `(binder-sidebar-marked ((,c :inherit modus-themes-mark-sel))) + `(binder-sidebar-missing ((,c :inherit modus-themes-subtle-red))) + `(binder-sidebar-tags ((,c :foreground ,variable))) ;;;;; bongo - `(bongo-album-title ((,class :foreground ,fg-active))) - `(bongo-artist ((,class :foreground ,magenta-active))) - `(bongo-currently-playing-track ((,class :inherit bold))) - `(bongo-elapsed-track-part ((,class :inherit modus-themes-subtle-magenta :underline t))) - `(bongo-filled-seek-bar ((,class :background ,blue-intense-bg :foreground ,fg-main))) - `(bongo-marked-track ((,class :foreground ,fg-mark-alt))) - `(bongo-marked-track-line ((,class :background ,bg-mark-alt))) - `(bongo-played-track ((,class :foreground ,fg-unfocused :strike-through t))) - `(bongo-track-length ((,class :inherit shadow))) - `(bongo-track-title ((,class :foreground ,blue-active))) - `(bongo-unfilled-seek-bar ((,class :background ,bg-special-cold :foreground ,fg-main))) + `(bongo-album-title (( ))) + `(bongo-artist ((,c :foreground ,accent-0))) + `(bongo-currently-playing-track ((,c :inherit bold))) + `(bongo-elapsed-track-part ((,c :background ,bg-inactive :underline t))) + `(bongo-filled-seek-bar ((,c :background ,bg-hover))) + `(bongo-marked-track ((,c :inherit modus-themes-mark-alt))) + `(bongo-marked-track-line ((,c :background ,bg-dim))) + `(bongo-played-track ((,c :inherit shadow :strike-through t))) + `(bongo-track-length ((,c :inherit shadow))) + `(bongo-track-title ((,c :foreground ,accent-1))) + `(bongo-unfilled-seek-bar ((,c :background ,bg-dim))) ;;;;; boon - `(boon-modeline-cmd ((,class :inherit modus-themes-active-blue))) - `(boon-modeline-ins ((,class :inherit modus-themes-active-red))) - `(boon-modeline-off ((,class :inherit modus-themes-active-yellow))) - `(boon-modeline-spc ((,class :inherit modus-themes-active-green))) + `(boon-modeline-cmd ((,c :inherit modus-themes-intense-blue))) + `(boon-modeline-ins ((,c :inherit modus-themes-intense-red))) + `(boon-modeline-off ((,c :inherit modus-themes-intense-yellow))) + `(boon-modeline-spc ((,c :inherit modus-themes-intense-green))) ;;;;; bookmark - `(bookmark-face ((,class :inherit modus-themes-fringe-cyan))) - `(bookmark-menu-bookmark ((,class :inherit bold))) -;;;;; breakpoint (built-in gdb-mi.el) - `(breakpoint-disabled ((,class :inherit shadow))) - `(breakpoint-enabled ((,class :inherit bold :foreground ,red))) + `(bookmark-face ((,c :inherit success))) + `(bookmark-menu-bookmark ((,c :inherit bold))) ;;;;; calendar and diary - `(calendar-month-header ((,class :inherit modus-themes-pseudo-header))) - `(calendar-today ((,class :inherit bold :underline t))) - `(calendar-weekday-header ((,class :foreground ,fg-unfocused))) - `(calendar-weekend-header ((,class :foreground ,red-faint))) - `(diary ((,class :background ,blue-nuanced-bg :foreground ,blue-alt-other))) - `(diary-anniversary ((,class :foreground ,red-alt-other))) - `(diary-time ((,class :foreground ,cyan))) - `(holiday ((,class :background ,magenta-nuanced-bg :foreground ,magenta-alt))) -;;;;; calfw - `(cfw:face-annotation ((,class :foreground ,fg-special-warm))) - `(cfw:face-day-title ((,class :foreground ,fg-main))) - `(cfw:face-default-content ((,class :foreground ,green-alt))) - `(cfw:face-default-day ((,class :inherit (cfw:face-day-title bold)))) - `(cfw:face-disable ((,class :foreground ,fg-unfocused))) - `(cfw:face-grid ((,class :foreground ,fg-window-divider-outer))) - `(cfw:face-header ((,class :inherit bold :foreground ,fg-main))) - `(cfw:face-holiday ((,class :foreground ,magenta-alt-other))) - `(cfw:face-periods ((,class :foreground ,cyan-alt-other))) - `(cfw:face-saturday ((,class :inherit bold :foreground ,cyan-alt-other))) - `(cfw:face-select ((,class :inherit modus-themes-intense-blue))) - `(cfw:face-sunday ((,class :inherit bold :foreground ,cyan-alt-other))) - `(cfw:face-title ((,class :inherit modus-themes-heading-1 :background ,bg-main :overline nil :foreground ,fg-special-cold))) - `(cfw:face-today ((,class :background ,bg-inactive))) - `(cfw:face-today-title ((,class :background ,bg-active))) - `(cfw:face-toolbar ((,class :background ,bg-alt :foreground ,bg-alt))) - `(cfw:face-toolbar-button-off ((,class :inherit shadow))) - `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,blue-nuanced-bg - :foreground ,blue-alt))) + `(calendar-month-header ((,c :inherit bold))) + `(calendar-today ((,c :inherit bold :underline t))) + `(calendar-weekday-header ((,c :foreground ,date-weekday))) + `(calendar-weekend-header ((,c :foreground ,date-weekend))) + `(diary ((,c :background ,bg-dim :foreground ,accent-0))) + `(diary-anniversary ((,c :foreground ,accent-1))) + `(diary-time ((,c :foreground ,date-common))) + `(holiday ((,c :foreground ,date-holiday))) ;;;;; calibredb - `(calibredb-archive-face ((,class :foreground ,magenta-alt-faint))) - `(calibredb-author-face ((,class :foreground ,blue-faint))) - `(calibredb-comment-face ((,class :inherit shadow))) - `(calibredb-date-face ((,class :foreground ,cyan))) - `(calibredb-edit-annotation-header-title-face ((,class :inherit bold))) - `(calibredb-favorite-face ((,class :foreground ,red-alt))) + ;; NOTE 2022-12-27: Calibredb needs to be reviewed. I had to + ;; change the applicable colours for the transition to + ;; modus-themes version 4, but I cannot test this currently (it + ;; depends on an external program). + `(calibredb-archive-face ((,c :foreground ,accent-3))) + `(calibredb-author-face ((,c :foreground ,name))) + `(calibredb-comment-face ((,c :inherit shadow))) + `(calibredb-date-face ((,c :foreground ,date-common))) + `(calibredb-edit-annotation-header-title-face ((,c :inherit bold))) + `(calibredb-favorite-face ((,c :foreground ,red-warmer))) `(calibredb-file-face (( ))) - `(calibredb-format-face ((,class :foreground ,cyan-faint))) - `(calibredb-highlight-face ((,class :inherit success))) + `(calibredb-format-face ((,c :foreground ,fg-alt))) + `(calibredb-highlight-face ((,c :inherit success))) `(calibredb-id-face (( ))) `(calibredb-ids-face (( ))) - `(calibredb-search-header-highlight-face ((,class :inherit modus-themes-hl-line))) - `(calibredb-search-header-library-name-face ((,class :foreground ,blue-active))) - `(calibredb-search-header-library-path-face ((,class :inherit bold))) - `(calibredb-search-header-sort-face ((,class :inherit bold :foreground ,magenta-active))) - `(calibredb-search-header-total-face ((,class :inherit bold :foreground ,cyan-active))) - `(calibredb-search-header-filter-face ((,class :inherit bold))) - `(calibredb-mark-face ((,class :inherit modus-themes-mark-sel))) + `(calibredb-search-header-highlight-face ((,c :background ,bg-hl-line :extend t))) + `(calibredb-search-header-library-name-face ((,c :foreground ,accent-2))) + `(calibredb-search-header-library-path-face ((,c :inherit bold))) + `(calibredb-search-header-sort-face ((,c :inherit bold :foreground ,accent-1))) + `(calibredb-search-header-total-face ((,c :inherit bold :foreground ,accent-0))) + `(calibredb-search-header-filter-face ((,c :inherit bold))) + `(calibredb-mark-face ((,c :inherit modus-themes-mark-sel))) `(calibredb-size-face (( ))) - `(calibredb-tag-face ((,class :foreground ,magenta-alt-faint))) + `(calibredb-tag-face ((,c :foreground ,fg-alt))) ;;;;; centaur-tabs - `(centaur-tabs-active-bar-face ((,class :background ,blue-active))) - `(centaur-tabs-close-mouse-face ((,class :inherit bold :foreground ,red-active :underline t))) - `(centaur-tabs-close-selected ((,class :inherit centaur-tabs-selected))) - `(centaur-tabs-close-unselected ((,class :inherit centaur-tabs-unselected))) - `(centaur-tabs-modified-marker-selected ((,class :inherit centaur-tabs-selected))) - `(centaur-tabs-modified-marker-unselected ((,class :inherit centaur-tabs-unselected))) - `(centaur-tabs-default ((,class :background ,bg-main))) - `(centaur-tabs-selected ((,class :inherit modus-themes-tab-active))) - `(centaur-tabs-selected-modified ((,class :inherit (italic centaur-tabs-selected)))) - `(centaur-tabs-unselected ((,class :inherit modus-themes-tab-inactive))) - `(centaur-tabs-unselected-modified ((,class :inherit (italic centaur-tabs-unselected)))) -;;;;; cfrs - `(cfrs-border-color ((,class :background ,fg-window-divider-inner))) + `(centaur-tabs-active-bar-face ((,c :background ,blue))) + `(centaur-tabs-close-mouse-face ((,c :inherit bold :foreground ,red :underline t))) + `(centaur-tabs-close-selected ((,c :inherit centaur-tabs-selected))) + `(centaur-tabs-close-unselected ((,c :inherit centaur-tabs-unselected))) + `(centaur-tabs-modified-marker-selected ((,c :inherit centaur-tabs-selected))) + `(centaur-tabs-modified-marker-unselected ((,c :inherit centaur-tabs-unselected))) + `(centaur-tabs-default ((,c :background ,bg-main))) + `(centaur-tabs-selected ((,c :inherit bold :box (:line-width -2 :color ,bg-tab-current) :background ,bg-tab-current))) + `(centaur-tabs-selected-modified ((,c :inherit (italic centaur-tabs-selected)))) + `(centaur-tabs-unselected ((,c :box (:line-width -2 :color ,bg-tab-other) :background ,bg-tab-other))) + `(centaur-tabs-unselected-modified ((,c :inherit (italic centaur-tabs-unselected)))) ;;;;; change-log and log-view (`vc-print-log' and `vc-print-root-log') - `(change-log-acknowledgment ((,class :inherit shadow))) - `(change-log-conditionals ((,class :foreground ,yellow))) - `(change-log-date ((,class :foreground ,cyan))) - `(change-log-email ((,class :foreground ,cyan-alt-other))) - `(change-log-file ((,class :inherit bold :foreground ,fg-special-cold))) - `(change-log-function ((,class :foreground ,green-alt-other))) - `(change-log-list ((,class :foreground ,magenta-alt))) - `(change-log-name ((,class :foreground ,magenta-alt-other))) - `(log-edit-header ((,class :foreground ,fg-special-warm))) - `(log-edit-headers-separator ((,class :height 1 :background ,fg-window-divider-inner :extend t))) - `(log-edit-summary ((,class :inherit bold :foreground ,blue))) - `(log-edit-unknown-header ((,class :inherit shadow))) - `(log-view-commit-body ((,class :foreground ,blue-nuanced-fg))) - `(log-view-file ((,class :inherit bold :foreground ,fg-special-cold))) - `(log-view-message ((,class :background ,bg-alt :foreground ,fg-alt))) + `(change-log-acknowledgment ((,c :foreground ,identifier))) + `(change-log-conditionals ((,c :inherit error))) + `(change-log-date ((,c :foreground ,date-common))) + `(change-log-email ((,c :foreground ,fg-alt))) + `(change-log-file ((,c :inherit bold))) + `(change-log-function ((,c :inherit warning))) + `(change-log-list ((,c :inherit bold))) + `(change-log-name ((,c :foreground ,name))) + `(log-edit-header ((,c :inherit bold))) + `(log-edit-headers-separator ((,c :height 1 :background ,border :extend t))) + `(log-edit-summary ((,c :inherit bold :foreground ,blue))) + `(log-edit-unknown-header ((,c :inherit shadow))) + `(log-view-commit-body (( ))) + `(log-view-file ((,c :inherit bold))) + `(log-view-message ((,c :foreground ,identifier))) ;;;;; cider - `(cider-debug-code-overlay-face ((,class :background ,bg-alt))) - `(cider-debug-prompt-face ((,class :foreground ,magenta-alt :underline t))) - `(cider-deprecated-face ((,class :inherit modus-themes-refine-yellow))) - `(cider-docview-emphasis-face ((,class :inherit italic :foreground ,fg-special-cold))) - `(cider-docview-literal-face ((,class :foreground ,blue-alt))) - `(cider-docview-strong-face ((,class :inherit bold :foreground ,fg-special-cold))) - `(cider-docview-table-border-face ((,class :inherit shadow))) - `(cider-enlightened-face ((,class :box (:line-width -1 :color ,yellow-alt :style nil) :background ,bg-dim))) - `(cider-enlightened-local-face ((,class :inherit bold :foreground ,yellow-alt-other))) - `(cider-error-highlight-face ((,class :foreground ,red :underline t))) - `(cider-fragile-button-face ((,class :box (:line-width 3 :color ,fg-alt :style released-button) :foreground ,yellow))) - `(cider-fringe-good-face ((,class :foreground ,green-active))) - `(cider-instrumented-face ((,class :box (:line-width -1 :color ,red :style nil) :background ,bg-dim))) - `(cider-reader-conditional-face ((,class :inherit italic :foreground ,fg-special-warm))) - `(cider-repl-input-face ((,class :inherit bold))) - `(cider-repl-prompt-face ((,class :inherit modus-themes-prompt))) - `(cider-repl-stderr-face ((,class :inherit bold :foreground ,red))) - `(cider-repl-stdout-face ((,class :foreground ,blue))) - `(cider-result-overlay-face ((,class :box (:line-width -1 :color ,blue :style nil) :background ,bg-dim))) - `(cider-stacktrace-error-class-face ((,class :inherit bold :foreground ,red))) - `(cider-stacktrace-error-message-face ((,class :inherit italic :foreground ,red-alt-other))) - `(cider-stacktrace-face ((,class :foreground ,fg-main))) - `(cider-stacktrace-filter-active-face ((,class :foreground ,cyan-alt :underline t))) - `(cider-stacktrace-filter-inactive-face ((,class :foreground ,cyan-alt))) - `(cider-stacktrace-fn-face ((,class :inherit bold :foreground ,fg-main))) - `(cider-stacktrace-ns-face ((,class :inherit (shadow italic)))) - `(cider-stacktrace-promoted-button-face ((,class :box (:line-width 3 :color ,fg-alt :style released-button) :foreground ,red))) - `(cider-stacktrace-suppressed-button-face ((,class :box (:line-width 3 :color ,fg-alt :style pressed-button) - :background ,bg-alt :foreground ,fg-alt))) - `(cider-test-error-face ((,class :inherit modus-themes-subtle-red))) - `(cider-test-failure-face ((,class :inherit (modus-themes-intense-red bold)))) - `(cider-test-success-face ((,class :inherit modus-themes-grue-background-intense))) - `(cider-traced-face ((,class :box (:line-width -1 :color ,cyan :style nil) :background ,bg-dim))) - `(cider-warning-highlight-face ((,class :foreground ,yellow :underline t))) + `(cider-deprecated-face ((,c :inherit warning))) + `(cider-enlightened-face ((,c :box ,warning))) + `(cider-enlightened-local-face ((,c :inherit warning))) + `(cider-error-highlight-face ((,c :inherit modus-themes-lang-error))) + `(cider-fringe-good-face ((,c :foreground ,info))) + `(cider-instrumented-face ((,c :box ,err))) + `(cider-reader-conditional-face ((,c :inherit font-lock-type-face))) + `(cider-repl-prompt-face ((,c :inherit minibuffer-prompt))) + `(cider-repl-stderr-face ((,c :foreground ,err))) + `(cider-repl-stdout-face (( ))) + `(cider-warning-highlight-face ((,c :inherit modus-themes-lang-warning))) ;;;;; circe (and lui) - `(circe-fool-face ((,class :inherit shadow))) - `(circe-highlight-nick-face ((,class :inherit bold :foreground ,blue))) - `(circe-prompt-face ((,class :inherit modus-themes-prompt))) - `(circe-server-face ((,class :foreground ,fg-unfocused))) - `(lui-button-face ((,class :inherit button))) - `(lui-highlight-face ((,class :foreground ,magenta-alt))) - `(lui-time-stamp-face ((,class :foreground ,blue-nuanced-fg))) + `(circe-fool-face ((,c :inherit shadow))) + `(circe-highlight-nick-face ((,c :inherit error))) + `(circe-prompt-face ((,c :inherit modus-themes-prompt))) + `(circe-server-face ((,c :inherit shadow))) + `(lui-button-face ((,c :inherit button))) + `(lui-highlight-face ((,c :inherit error))) + `(lui-time-stamp-face ((,c :foreground ,date-common))) ;;;;; citar - `(citar ((,class :inherit shadow))) + `(citar ((,c :inherit shadow))) `(citar-highlight (( ))) -;;;;; color-rg - `(color-rg-font-lock-column-number ((,class :foreground ,magenta-alt-other))) - `(color-rg-font-lock-command ((,class :inherit bold :foreground ,fg-main))) - `(color-rg-font-lock-file ((,class :inherit bold :foreground ,fg-special-cold))) - `(color-rg-font-lock-flash ((,class :inherit modus-themes-intense-blue))) - `(color-rg-font-lock-function-location ((,class :inherit modus-themes-special-calm))) - `(color-rg-font-lock-header-line-directory ((,class :foreground ,blue-active))) - `(color-rg-font-lock-header-line-edit-mode ((,class :foreground ,magenta-active))) - `(color-rg-font-lock-header-line-keyword ((,class :foreground ,green-active))) - `(color-rg-font-lock-header-line-text ((,class :foreground ,fg-active))) - `(color-rg-font-lock-line-number ((,class :foreground ,fg-special-warm))) - `(color-rg-font-lock-mark-changed ((,class :inherit bold :foreground ,blue))) - `(color-rg-font-lock-mark-deleted ((,class :inherit bold :foreground ,red))) - `(color-rg-font-lock-match ((,class :inherit modus-themes-special-calm))) - `(color-rg-font-lock-position-splitter ((,class :inherit shadow))) +;;;;; clojure-mode + `(clojure-keyword-face ((,c :inherit font-lock-builtin-face))) ;;;;; column-enforce-mode - `(column-enforce-face ((,class :inherit modus-themes-refine-yellow))) + `(column-enforce-face ((,c :inherit modus-themes-intense-yellow))) ;;;;; company-mode - `(company-echo-common ((,class :inherit modus-themes-completion-match-0))) - `(company-preview ((,class :background ,bg-dim :foreground ,fg-dim))) - `(company-preview-common ((,class :inherit company-echo-common))) - `(company-preview-search ((,class :inherit modus-themes-special-calm))) - `(company-template-field ((,class :inherit modus-themes-intense-magenta))) - `(company-scrollbar-bg ((,class :background ,bg-active))) - `(company-scrollbar-fg ((,class :background ,fg-active))) - `(company-tooltip ((,class :background ,bg-alt))) - `(company-tooltip-annotation ((,class :inherit completions-annotations))) - `(company-tooltip-common ((,class :inherit company-echo-common))) - `(company-tooltip-deprecated ((,class :inherit company-tooltip :strike-through t))) - `(company-tooltip-mouse ((,class :inherit highlight))) - `(company-tooltip-scrollbar-thumb ((,class :background ,fg-active))) - `(company-tooltip-scrollbar-track ((,class :background ,bg-active))) - `(company-tooltip-search ((,class :inherit (modus-themes-search-success-lazy bold)))) - `(company-tooltip-search-selection ((,class :inherit modus-themes-search-success :underline t))) - `(company-tooltip-selection ((,class :inherit modus-themes-completion-selected-popup))) -;;;;; company-posframe - `(company-posframe-active-backend-name ((,class :inherit bold :background ,bg-active :foreground ,blue-active))) - `(company-posframe-inactive-backend-name ((,class :background ,bg-active :foreground ,fg-active))) - `(company-posframe-metadata ((,class :background ,bg-inactive :foreground ,fg-inactive))) + `(company-echo-common ((,c :inherit modus-themes-completion-match-0))) + `(company-preview ((,c :background ,bg-dim :foreground ,fg-dim))) + `(company-preview-common ((,c :inherit company-echo-common))) + `(company-preview-search ((,c :background ,bg-yellow-intense))) + `(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-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))) + `(company-tooltip-mouse ((,c :inherit highlight))) + `(company-tooltip-scrollbar-thumb ((,c :background ,fg-alt))) + `(company-tooltip-scrollbar-track ((,c :background ,bg-inactive))) + `(company-tooltip-search ((,c :inherit secondary-selection))) + `(company-tooltip-search-selection ((,c :inherit secondary-selection :underline t))) + `(company-tooltip-selection ((,c :inherit modus-themes-completion-selected))) ;;;;; compilation - `(compilation-column-number ((,class :inherit compilation-line-number))) - `(compilation-error ((,class :inherit modus-themes-bold :foreground ,red))) - `(compilation-info ((,class :inherit modus-themes-bold :foreground ,fg-special-cold))) - `(compilation-line-number ((,class :foreground ,fg-special-warm))) - `(compilation-mode-line-exit ((,class :inherit bold))) - `(compilation-mode-line-fail ((,class :inherit modus-themes-bold :foreground ,red-active))) - `(compilation-mode-line-run ((,class :inherit modus-themes-bold :foreground ,cyan-active))) - `(compilation-warning ((,class :inherit modus-themes-bold :foreground ,yellow-alt))) + `(compilation-column-number ((,c :inherit compilation-line-number))) + `(compilation-error ((,c :inherit modus-themes-bold :foreground ,err))) + `(compilation-info ((,c :inherit modus-themes-bold :foreground ,info))) + `(compilation-line-number ((,c :inherit shadow))) + `(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 modus-themes-bold :foreground ,warning))) ;;;;; completions - `(completions-annotations ((,class :inherit modus-themes-slant :foreground ,cyan-faint))) - `(completions-common-part ((,class :inherit modus-themes-completion-match-0))) - `(completions-first-difference ((,class :inherit modus-themes-completion-match-1))) + `(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-running ((,class :inherit bold :foreground ,blue))) - `(consult-async-split ((,class :foreground ,magenta-alt))) - `(consult-bookmark ((,class :foreground ,blue))) - `(consult-file ((,class :foreground ,fg-special-cold))) - `(consult-imenu-prefix ((,class :inherit shadow))) - `(consult-key ((,class :inherit modus-themes-key-binding))) - `(consult-line-number ((,class :foreground ,fg-special-warm))) - `(consult-line-number-prefix ((,class :foreground ,fg-unfocused))) - `(consult-narrow-indicator ((,class :foreground ,magenta-alt))) - `(consult-preview-cursor ((,class :inherit modus-themes-intense-blue))) - `(consult-preview-insertion ((,class :inherit modus-themes-special-warm))) + `(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 ((,class :inherit modus-themes-completion-selected-popup))) - `(corfu-bar ((,class :background ,fg-alt))) - `(corfu-border ((,class :background ,bg-active))) - `(corfu-default ((,class :background ,bg-alt))) + `(corfu-current ((,c :inherit modus-themes-completion-selected))) + `(corfu-bar ((,c :background ,fg-dim))) + `(corfu-border ((,c :background ,bg-active))) + `(corfu-default ((,c :background ,bg-dim))) ;;;;; corfu-quick - `(corfu-quick1 ((,class :inherit bold :background ,bg-char-0))) - `(corfu-quick2 ((,class :inherit bold :background ,bg-char-1))) + `(corfu-quick1 ((,c :inherit bold :background ,bg-char-0))) + `(corfu-quick2 ((,c :inherit bold :background ,bg-char-1))) ;;;;; counsel - `(counsel-active-mode ((,class :foreground ,magenta-alt-other))) - `(counsel-application-name ((,class :foreground ,red-alt-other))) - `(counsel-key-binding ((,class :inherit modus-themes-key-binding))) - `(counsel-outline-1 ((,class :inherit org-level-1))) - `(counsel-outline-2 ((,class :inherit org-level-2))) - `(counsel-outline-3 ((,class :inherit org-level-3))) - `(counsel-outline-4 ((,class :inherit org-level-4))) - `(counsel-outline-5 ((,class :inherit org-level-5))) - `(counsel-outline-6 ((,class :inherit org-level-6))) - `(counsel-outline-7 ((,class :inherit org-level-7))) - `(counsel-outline-8 ((,class :inherit org-level-8))) - `(counsel-outline-default ((,class :foreground ,fg-main))) - `(counsel-variable-documentation ((,class :inherit modus-themes-slant :foreground ,yellow-alt-other))) -;;;;; counsel-css - `(counsel-css-selector-depth-face-1 ((,class :foreground ,blue))) - `(counsel-css-selector-depth-face-2 ((,class :foreground ,cyan))) - `(counsel-css-selector-depth-face-3 ((,class :foreground ,green))) - `(counsel-css-selector-depth-face-4 ((,class :foreground ,yellow))) - `(counsel-css-selector-depth-face-5 ((,class :foreground ,magenta))) - `(counsel-css-selector-depth-face-6 ((,class :foreground ,red))) -;;;;; cov - `(cov-coverage-not-run-face ((,class :foreground ,red-intense))) - `(cov-coverage-run-face ((,class :foreground ,green-intense))) - `(cov-heavy-face ((,class :foreground ,magenta-intense))) - `(cov-light-face ((,class :foreground ,blue-intense))) - `(cov-med-face ((,class :foreground ,yellow-intense))) - `(cov-none-face ((,class :foreground ,cyan-intense))) + `(counsel-active-mode ((,c :foreground ,keyword))) + `(counsel-application-name ((,c :foreground ,name))) + `(counsel-key-binding ((,c :inherit modus-themes-key-binding))) + `(counsel-outline-default ((,c :foreground ,fg-main))) + `(counsel-variable-documentation ((,c :inherit font-lock-doc-face))) ;;;;; cperl-mode - `(cperl-nonoverridable-face ((,class :foreground unspecified))) - `(cperl-array-face ((,class :inherit font-lock-keyword-face))) - `(cperl-hash-face ((,class :inherit font-lock-variable-name-face))) + `(cperl-nonoverridable-face ((,c :foreground unspecified))) + `(cperl-array-face ((,c :inherit font-lock-keyword-face))) + `(cperl-hash-face ((,c :inherit font-lock-variable-name-face))) ;;;;; crontab-mode - `(crontab-minute ((,class :foreground ,blue-alt))) - `(crontab-hour ((,class :foreground ,magenta-alt-other))) - `(crontab-month-day ((,class :foreground ,magenta-alt))) - `(crontab-month ((,class :foreground ,blue))) - `(crontab-week-day ((,class :foreground ,cyan))) - `(crontab-predefined ((,class :foreground ,blue-alt))) + `(crontab-minute ((,c :foreground ,string))) + `(crontab-hour ((,c :foreground ,keyword))) + `(crontab-month-day ((,c :foreground ,builtin))) + `(crontab-month ((,c :foreground ,constant))) + `(crontab-week-day ((,c :foreground ,variable))) + `(crontab-predefined ((,c :foreground ,string))) ;;;;; css-mode - `(css-property ((,class :inherit font-lock-type-face))) - `(css-selector ((,class :inherit font-lock-keyword-face))) + `(css-property ((,c :inherit font-lock-type-face))) + `(css-selector ((,c :inherit font-lock-keyword-face))) ;;;;; csv-mode - `(csv-separator-face ((,class :foreground ,red-intense))) + `(csv-separator-face ((,c :foreground ,red-intense))) ;;;;; ctrlf - `(ctrlf-highlight-active ((,class :inherit modus-themes-search-success))) - `(ctrlf-highlight-line ((,class :inherit modus-themes-hl-line))) - `(ctrlf-highlight-passive ((,class :inherit modus-themes-search-success-lazy))) + `(ctrlf-highlight-active ((,c :inherit modus-themes-search-current))) + `(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 ((,class :inherit modus-themes-box-button))) - `(custom-button-mouse ((,class :inherit (highlight custom-button)))) - `(custom-button-pressed ((,class :inherit modus-themes-box-button-pressed))) - `(custom-changed ((,class :inherit modus-themes-subtle-cyan))) - `(custom-comment ((,class :inherit shadow))) - `(custom-comment-tag ((,class :background ,bg-alt :foreground ,yellow-alt-other))) - `(custom-face-tag ((,class :inherit bold :foreground ,blue-intense))) - `(custom-group-tag ((,class :inherit modus-themes-pseudo-header :foreground ,magenta-alt))) - `(custom-group-tag-1 ((,class :inherit modus-themes-special-warm))) - `(custom-invalid ((,class :inherit (modus-themes-intense-red bold)))) - `(custom-modified ((,class :inherit modus-themes-subtle-cyan))) - `(custom-rogue ((,class :inherit modus-themes-refine-magenta))) - `(custom-set ((,class :foreground ,blue-alt))) - `(custom-state ((,class :foreground ,red-alt-faint))) - `(custom-themed ((,class :inherit modus-themes-subtle-blue))) - `(custom-variable-obsolete ((,class :inherit shadow))) - `(custom-variable-tag ((,class :foreground ,cyan))) -;;;;; dap-mode - `(dap-mouse-eval-thing-face ((,class :box (:line-width -1 :color ,blue-active :style nil) - :background ,bg-active :foreground ,fg-main))) - `(dap-result-overlay-face ((,class :box (:line-width -1 :color ,bg-active :style nil) - :background ,bg-active :foreground ,fg-main))) - `(dap-ui-breakpoint-verified-fringe ((,class :inherit bold :foreground ,green-active))) - `(dap-ui-compile-errline ((,class :inherit bold :foreground ,red-intense))) - `(dap-ui-locals-scope-face ((,class :inherit bold :foreground ,magenta :underline t))) - `(dap-ui-locals-variable-face ((,class :inherit bold :foreground ,cyan))) - `(dap-ui-locals-variable-leaf-face ((,class :inherit italic :foreground ,cyan-alt-other))) - `(dap-ui-marker-face ((,class :inherit modus-themes-subtle-blue))) - `(dap-ui-sessions-stack-frame-face ((,class :inherit bold :foreground ,magenta-alt))) - `(dap-ui-sessions-terminated-active-face ((,class :inherit bold :foreground ,fg-alt))) - `(dap-ui-sessions-terminated-face ((,class :inherit shadow))) + `(custom-button ((,c :inherit modus-themes-button))) + `(custom-button-mouse ((,c :inherit (highlight custom-button)))) + `(custom-button-pressed ((,c :inherit (secondary-selection custom-button)))) + `(custom-changed ((,c :background ,bg-changed))) + `(custom-comment ((,c :inherit shadow))) + `(custom-comment-tag ((,c :inherit (bold shadow)))) + `(custom-invalid ((,c :inherit error :strike-through t))) + `(custom-modified ((,c :inherit custom-changed))) + `(custom-rogue ((,c :inherit custom-invalid))) + `(custom-set ((,c :inherit success))) + `(custom-state ((,c :foreground ,warning))) + `(custom-themed ((,c :inherit custom-changed))) + `(custom-variable-obsolete ((,c :inherit shadow))) + `(custom-face-tag ((,c :inherit bold :foreground ,type))) + `(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 ((,class :inherit bold :foreground ,fg-special-cold))) - `(deadgrep-match-face ((,class :inherit modus-themes-special-calm))) - `(deadgrep-meta-face ((,class :inherit shadow))) - `(deadgrep-regexp-metachar-face ((,class :inherit bold :foreground ,yellow-intense))) - `(deadgrep-search-term-face ((,class :inherit bold :foreground ,green-intense))) -;;;;; debbugs - `(debbugs-gnu-archived ((,class :inverse-video t))) - `(debbugs-gnu-done ((,class :inherit shadow))) - `(debbugs-gnu-forwarded ((,class :foreground ,fg-special-warm))) - `(debbugs-gnu-handled ((,class :foreground ,blue))) - `(debbugs-gnu-new ((,class :foreground ,red))) - `(debbugs-gnu-pending ((,class :foreground ,cyan))) - `(debbugs-gnu-stale-1 ((,class :foreground ,yellow-nuanced-fg))) - `(debbugs-gnu-stale-2 ((,class :foreground ,yellow))) - `(debbugs-gnu-stale-3 ((,class :foreground ,yellow-alt))) - `(debbugs-gnu-stale-4 ((,class :foreground ,yellow-alt-other))) - `(debbugs-gnu-stale-5 ((,class :foreground ,red-alt))) - `(debbugs-gnu-tagged ((,class :foreground ,magenta-alt))) + `(deadgrep-filename-face ((,c :inherit bold :foreground ,name))) + `(deadgrep-match-face ((,c :inherit match))) + `(deadgrep-meta-face ((,c :inherit shadow))) + `(deadgrep-regexp-metachar-face ((,c :inherit font-lock-regexp-grouping-construct))) + `(deadgrep-search-term-face ((,c :inherit success))) ;;;;; deft - `(deft-filter-string-face ((,class :inherit bold :foreground ,blue))) - `(deft-header-face ((,class :foreground ,fg-special-warm))) - `(deft-separator-face ((,class :foreground "gray50"))) - `(deft-summary-face ((,class :inherit (shadow modus-themes-slant)))) - `(deft-time-face ((,class :foreground ,cyan))) - `(deft-title-face ((,class :inherit bold))) -;;;;; denote - `(denote-faces-date ((,class :foreground ,cyan))) - `(denote-faces-keywords ((,class :inherit modus-themes-bold :foreground ,magenta-alt))) + `(deft-filter-string-face ((,c :inherit success))) + `(deft-header-face ((,c :inherit shadow))) + `(deft-separator-face ((,c :foreground "gray50"))) + `(deft-summary-face ((,c :inherit (shadow modus-themes-slant)))) + `(deft-time-face ((,c :foreground ,date-common))) + `(deft-title-face ((,c :inherit bold))) ;;;;; devdocs - `(devdocs-code-block ((,class :inherit modus-themes-fixed-pitch :background ,bg-dim :extend t))) + `(devdocs-code-block ((,c :inherit modus-themes-fixed-pitch :background ,bg-dim :extend t))) ;;;;; dictionary - `(dictionary-button-face ((,class :inherit bold :foreground ,fg-special-cold))) - `(dictionary-reference-face ((,class :inherit button))) - `(dictionary-word-definition-face (())) - `(dictionary-word-entry-face ((,class :inherit font-lock-comment-face))) + `(dictionary-button-face ((,c :inherit bold))) + `(dictionary-reference-face ((,c :inherit link))) + `(dictionary-word-definition-face (( ))) + `(dictionary-word-entry-face ((,c :inherit font-lock-comment-face))) ;;;;; diff-hl - `(diff-hl-change ((,class :inherit modus-themes-fringe-yellow))) - `(diff-hl-delete ((,class :inherit modus-themes-fringe-red))) - `(diff-hl-insert ((,class :inherit modus-themes-grue-background-active))) - `(diff-hl-reverted-hunk-highlight ((,class :background ,fg-main :foreground ,bg-main))) + `(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 ((,class :inherit modus-themes-diff-added))) - `(diff-changed ((,class :inherit modus-themes-diff-changed :extend t))) - `(diff-changed-unspecified ((,class :inherit diff-changed))) - `(diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only) (list :foreground fg-unfocused))))) - `(diff-error ((,class :inherit modus-themes-intense-red))) - `(diff-file-header ((,class :inherit (bold diff-header)))) - `(diff-function ((,class :inherit modus-themes-diff-heading))) - `(diff-header ((,class :foreground ,fg-main))) - `(diff-hunk-header ((,class :inherit (bold modus-themes-diff-heading)))) - `(diff-index ((,class :inherit bold :foreground ,blue-alt))) - `(diff-indicator-added ((,class :inherit (modus-themes-grue diff-added bold)))) - `(diff-indicator-changed ((,class :inherit (diff-changed bold) :foreground ,yellow))) - `(diff-indicator-removed ((,class :inherit (diff-removed bold) :foreground ,red))) - `(diff-nonexistent ((,class :inherit (modus-themes-neutral bold)))) - `(diff-refine-added ((,class :inherit modus-themes-diff-refine-added))) - `(diff-refine-changed ((,class :inherit modus-themes-diff-refine-changed))) - `(diff-refine-removed ((,class :inherit modus-themes-diff-refine-removed))) - `(diff-removed ((,class :inherit modus-themes-diff-removed))) + `(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 :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))) + `(diff-context (( ))) + `(diff-error ((,c :inherit error))) + `(diff-file-header ((,c :inherit bold))) + `(diff-function ((,c :background ,bg-inactive))) + `(diff-header (( ))) + `(diff-hunk-header ((,c :inherit bold :background ,bg-inactive))) + `(diff-index ((,c :inherit italic))) + `(diff-nonexistent ((,c :inherit bold))) ;;;;; dim-autoload - `(dim-autoload-cookie-line ((,class :inherit font-lock-comment-face))) -;;;;; dir-treeview - `(dir-treeview-archive-face ((,class :foreground ,fg-special-warm))) - `(dir-treeview-archive-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,yellow))) - `(dir-treeview-audio-face ((,class :foreground ,magenta))) - `(dir-treeview-audio-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt))) - `(dir-treeview-control-face ((,class :inherit shadow))) - `(dir-treeview-control-mouse-face ((,class :inherit highlight))) - `(dir-treeview-default-icon-face ((,class :inherit (shadow bold) :family "Font Awesome"))) - `(dir-treeview-default-filename-face ((,class :foreground ,fg-main))) - `(dir-treeview-directory-face ((,class :foreground ,blue))) - `(dir-treeview-directory-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,blue-alt))) - `(dir-treeview-executable-face ((,class :foreground ,red-alt))) - `(dir-treeview-executable-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,red-alt-other))) - `(dir-treeview-image-face ((,class :foreground ,green-alt-other))) - `(dir-treeview-image-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,green-alt))) - `(dir-treeview-indent-face ((,class :inherit shadow))) - `(dir-treeview-label-mouse-face ((,class :inherit highlight))) - `(dir-treeview-start-dir-face ((,class :inherit modus-themes-pseudo-header))) - `(dir-treeview-symlink-face ((,class :inherit modus-themes-link-symlink))) - `(dir-treeview-video-face ((,class :foreground ,magenta-alt-other))) - `(dir-treeview-video-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt-other))) + `(dim-autoload-cookie-line ((,c :inherit font-lock-comment-face))) ;;;;; dired - `(dired-broken-symlink ((,class :inherit modus-themes-link-broken))) - `(dired-directory ((,class :foreground ,blue))) - `(dired-flagged ((,class :inherit modus-themes-mark-del))) - `(dired-header ((,class :inherit modus-themes-pseudo-header))) - `(dired-ignored ((,class :inherit shadow))) - `(dired-mark ((,class :inherit modus-themes-mark-symbol))) - `(dired-marked ((,class :inherit modus-themes-mark-sel))) - `(dired-perm-write ((,class :foreground ,fg-special-warm))) - `(dired-symlink ((,class :inherit modus-themes-link-symlink))) - `(dired-warning ((,class :inherit bold :foreground ,yellow))) + `(dired-broken-symlink ((,c :inherit button :foreground ,err))) + `(dired-directory ((,c :foreground ,accent-0))) + `(dired-flagged ((,c :inherit modus-themes-mark-del))) + `(dired-header ((,c :inherit bold))) + `(dired-ignored ((,c :inherit shadow))) + `(dired-mark ((,c :inherit bold))) + `(dired-marked ((,c :inherit modus-themes-mark-sel))) + `(dired-perm-write ((,c :inherit shadow))) + `(dired-symlink ((,c :inherit button :background ,bg-link-symbolic :foreground ,fg-link-symbolic :underline ,underline-link-symbolic))) + `(dired-warning ((,c :inherit warning))) ;;;;; dired-async - `(dired-async-failures ((,class :inherit bold :foreground ,red-active))) - `(dired-async-message ((,class :inherit bold :foreground ,blue-active))) - `(dired-async-mode-message ((,class :inherit bold :foreground ,cyan-active))) + `(dired-async-failures ((,c :inherit error))) + `(dired-async-message ((,c :inherit bold))) + `(dired-async-mode-message ((,c :inherit bold))) ;;;;; dired-git - `(dired-git-branch-else ((,class :inherit bold :foreground ,magenta-alt))) - `(dired-git-branch-master ((,class :inherit bold :foreground ,magenta-alt-other))) + `(dired-git-branch-else ((,c :inherit bold :foreground ,accent-0))) + `(dired-git-branch-master ((,c :inherit bold :foreground ,accent-1))) ;;;;; dired-git-info - `(dgi-commit-message-face ((,class :foreground ,cyan-alt-other))) + `(dgi-commit-message-face ((,c :foreground ,docstring))) ;;;;; dired-narrow - `(dired-narrow-blink ((,class :inherit (modus-themes-subtle-cyan bold)))) + `(dired-narrow-blink ((,c :inherit (modus-themes-subtle-cyan bold)))) ;;;;; dired-subtree ;; remove backgrounds from dired-subtree faces, else they break ;; dired-{flagged,marked} and any other face that sets a background @@ -4974,739 +2064,410 @@ by virtue of calling either of `modus-themes-load-operandi' and `(dired-subtree-depth-5-face (())) `(dired-subtree-depth-6-face (())) ;;;;; diredfl - `(diredfl-autofile-name ((,class :inherit modus-themes-special-cold))) - `(diredfl-compressed-file-name ((,class :foreground ,fg-special-warm))) - `(diredfl-compressed-file-suffix ((,class :foreground ,red-alt))) - `(diredfl-date-time ((,class :foreground ,cyan))) - `(diredfl-deletion ((,class :inherit modus-themes-mark-del))) - `(diredfl-deletion-file-name ((,class :inherit modus-themes-mark-del))) - `(diredfl-dir-heading ((,class :inherit modus-themes-pseudo-header))) - `(diredfl-dir-name ((,class :inherit dired-directory))) - `(diredfl-dir-priv ((,class :foreground ,blue-alt))) - `(diredfl-exec-priv ((,class :foreground ,magenta-alt))) - `(diredfl-executable-tag ((,class :foreground ,magenta-alt))) - `(diredfl-file-name ((,class :foreground ,fg-main))) - `(diredfl-file-suffix ((,class :foreground ,magenta-alt-other))) - `(diredfl-flag-mark ((,class :inherit modus-themes-mark-sel))) - `(diredfl-flag-mark-line ((,class :inherit modus-themes-mark-sel))) - `(diredfl-ignored-file-name ((,class :inherit shadow))) - `(diredfl-link-priv ((,class :foreground ,blue-alt-other))) - `(diredfl-no-priv ((,class :foreground "gray50"))) - `(diredfl-number ((,class :foreground ,cyan-alt-other-faint))) - `(diredfl-other-priv ((,class :foreground ,yellow))) - `(diredfl-rare-priv ((,class :foreground ,red))) - `(diredfl-read-priv ((,class :foreground ,fg-main))) - `(diredfl-symlink ((,class :inherit dired-symlink))) - `(diredfl-tagged-autofile-name ((,class :inherit modus-themes-refine-magenta))) - `(diredfl-write-priv ((,class :foreground ,cyan))) -;;;;; dired+ - `(diredp-autofile-name ((,class :inherit modus-themes-special-cold))) - `(diredp-compressed-file-name ((,class :foreground ,fg-special-warm))) - `(diredp-compressed-file-suffix ((,class :foreground ,red-alt))) - `(diredp-date-time ((,class :foreground ,cyan))) - `(diredp-deletion ((,class :inherit modus-themes-mark-del))) - `(diredp-deletion-file-name ((,class :inherit modus-themes-mark-del))) - `(diredp-dir-heading ((,class :inherit modus-themes-pseudo-header))) - `(diredp-dir-name ((,class :inherit dired-directory))) - `(diredp-dir-priv ((,class :foreground ,blue-alt))) - `(diredp-exec-priv ((,class :foreground ,magenta-alt))) - `(diredp-executable-tag ((,class :foreground ,magenta-alt))) - `(diredp-file-name ((,class :foreground ,fg-main))) - `(diredp-file-suffix ((,class :foreground ,magenta-alt-other))) - `(diredp-flag-mark ((,class :inherit modus-themes-mark-sel))) - `(diredp-flag-mark-line ((,class :inherit modus-themes-mark-sel))) - `(diredp-ignored-file-name ((,class :inherit shadow))) - `(diredp-link-priv ((,class :foreground ,blue-alt-other))) - `(diredp-mode-line-flagged ((,class :foreground ,red-active))) - `(diredp-mode-line-marked ((,class :foreground ,green-active))) - `(diredp-no-priv ((,class :foreground "gray50"))) - `(diredp-number ((,class :foreground ,cyan-alt-other-faint))) - `(diredp-omit-file-name ((,class :inherit shadow :strike-through t))) - `(diredp-other-priv ((,class :foreground ,yellow))) - `(diredp-rare-priv ((,class :foreground ,red))) - `(diredp-read-priv ((,class :foreground ,fg-main))) - `(diredp-symlink ((,class :inherit dired-symlink))) - `(diredp-tagged-autofile-name ((,class :inherit modus-themes-refine-magenta))) - `(diredp-write-priv ((,class :foreground ,cyan))) + `(diredfl-autofile-name ((,c :background ,bg-inactive))) + `(diredfl-compressed-file-name ((,c :foreground ,warning))) + `(diredfl-compressed-file-suffix ((,c :foreground ,err))) + `(diredfl-date-time ((,c :foreground ,date-common))) + `(diredfl-deletion ((,c :inherit dired-flagged))) + `(diredfl-deletion-file-name ((,c :inherit diredfl-deletion))) + `(diredfl-dir-heading ((,c :inherit bold))) + `(diredfl-dir-name ((,c :inherit dired-directory))) + `(diredfl-dir-priv ((,c :inherit dired-directory))) + `(diredfl-exec-priv ((,c :foreground ,accent-1))) + `(diredfl-executable-tag ((,c :inherit diredfl-exec-priv))) + `(diredfl-file-name ((,c :foreground ,fg-main))) + `(diredfl-file-suffix ((,c :foreground ,variable))) + `(diredfl-flag-mark ((,c :inherit dired-marked))) + `(diredfl-flag-mark-line ((,c :inherit dired-marked))) + `(diredfl-ignored-file-name ((,c :inherit shadow))) + `(diredfl-link-priv ((,c :foreground ,fg-link))) + `(diredfl-no-priv ((,c :inherit shadow))) + `(diredfl-number ((,c :inherit shadow))) + `(diredfl-other-priv ((,c :foreground ,accent-2))) + `(diredfl-rare-priv ((,c :foreground ,accent-3))) + `(diredfl-read-priv ((,c :foreground ,fg-main))) + `(diredfl-symlink ((,c :inherit dired-symlink))) + `(diredfl-tagged-autofile-name ((,c :inherit (diredfl-autofile-name dired-marked)))) + `(diredfl-write-priv ((,c :foreground ,accent-0))) ;;;;; display-fill-column-indicator-mode - `(fill-column-indicator ((,class :height 1 :background ,bg-region :foreground ,bg-region))) + `(fill-column-indicator ((,c :height 1 :background ,bg-active :foreground ,bg-active))) ;;;;; doom-modeline - `(doom-modeline-bar ((,class :inherit modus-themes-active-blue))) - `(doom-modeline-bar-inactive ((,class :background ,fg-inactive :foreground ,bg-main))) - `(doom-modeline-battery-charging ((,class :foreground ,green-active))) - `(doom-modeline-battery-critical ((,class :inherit bold :foreground ,red-active))) - `(doom-modeline-battery-error ((,class :inherit bold :box (:line-width -2) - :foreground ,red-active))) - `(doom-modeline-battery-full ((,class :foreground ,blue-active))) - `(doom-modeline-battery-normal ((,class :foreground ,fg-active))) - `(doom-modeline-battery-warning ((,class :inherit bold :foreground ,yellow-active))) - `(doom-modeline-buffer-file ((,class :inherit bold :foreground ,fg-active))) - `(doom-modeline-buffer-major-mode ((,class :inherit bold :foreground ,cyan-active))) - `(doom-modeline-buffer-minor-mode ((,class :foreground ,fg-inactive))) - `(doom-modeline-buffer-modified ((,class :inherit bold :foreground ,magenta-active))) - `(doom-modeline-buffer-path ((,class :inherit bold :foreground ,fg-active))) - `(doom-modeline-debug ((,class :inherit bold :foreground ,yellow-active))) - `(doom-modeline-debug-visual ((,class :inherit bold :foreground ,red-active))) - `(doom-modeline-evil-emacs-state ((,class :inherit bold :foreground ,magenta-active))) - `(doom-modeline-evil-insert-state ((,class :inherit bold :foreground ,green-active))) - `(doom-modeline-evil-motion-state ((,class :inherit bold :foreground ,fg-inactive))) - `(doom-modeline-evil-normal-state ((,class :inherit bold :foreground ,fg-active))) - `(doom-modeline-evil-operator-state ((,class :inherit bold :foreground ,blue-active))) - `(doom-modeline-evil-replace-state ((,class :inherit bold :foreground ,red-active))) - `(doom-modeline-evil-visual-state ((,class :inherit bold :foreground ,cyan-active))) - `(doom-modeline-highlight ((,class :inherit bold :foreground ,blue-active))) - `(doom-modeline-host ((,class :inherit italic))) - `(doom-modeline-info ((,class :foreground ,green-active))) - `(doom-modeline-lsp-error ((,class :inherit bold :foreground ,red-active))) - `(doom-modeline-lsp-success ((,class :inherit (bold modus-themes-grue-active)))) - `(doom-modeline-lsp-warning ((,class :inherit bold :foreground ,yellow-active))) - `(doom-modeline-panel ((,class :inherit modus-themes-active-blue))) - `(doom-modeline-persp-buffer-not-in-persp ((,class :inherit italic :foreground ,yellow-active))) - `(doom-modeline-persp-name ((,class :foreground ,fg-active))) - `(doom-modeline-project-dir ((,class :inherit bold :foreground ,blue-active))) - `(doom-modeline-project-parent-dir ((,class :foreground ,blue-active))) - `(doom-modeline-project-root-dir ((,class :foreground ,fg-active))) - `(doom-modeline-unread-number ((,class :inherit italic :foreground ,fg-active))) - `(doom-modeline-urgent ((,class :inherit bold :foreground ,red-active))) - `(doom-modeline-warning ((,class :inherit bold :foreground ,yellow-active))) -;;;;; easy-jekyll - `(easy-jekyll-help-face ((,class :background ,bg-dim :foreground ,blue-alt-other))) -;;;;; ebdb - `(ebdb-address-default ((,class :foreground ,fg-special-calm))) - `(ebdb-defunct ((,class :inherit shadow))) - `(ebdb-field-hidden ((,class :foreground ,magenta))) - `(ebdb-label ((,class :foreground ,cyan-alt-other))) - `(ebdb-mail-default ((,class :foreground ,fg-main))) - `(ebdb-mail-primary ((,class :foreground ,magenta-alt))) - `(ebdb-marked ((,class :background ,cyan-intense-bg))) - `(ebdb-organization-name ((,class :foreground ,red-alt-other))) - `(ebdb-person-name ((,class :foreground ,magenta-alt-other))) - `(ebdb-phone-default ((,class :foreground ,cyan))) - `(eieio-custom-slot-tag-face ((,class :foreground ,red-alt))) + `(doom-modeline-bar ((,c :background ,blue))) + `(doom-modeline-bar-inactive ((,c :background ,border))) + `(doom-modeline-battery-charging ((,c :foreground ,modeline-info))) + `(doom-modeline-battery-critical ((,c :underline t :foreground ,modeline-err))) + `(doom-modeline-battery-error ((,c :underline t :foreground ,modeline-err))) + `(doom-modeline-battery-full (( ))) + `(doom-modeline-battery-warning ((,c :inherit warning))) + `(doom-modeline-buffer-file ((,c :inherit bold))) + `(doom-modeline-buffer-major-mode (( ))) + `(doom-modeline-buffer-minor-mode (( ))) + `(doom-modeline-buffer-modified ((,c :foreground ,modeline-err))) + `(doom-modeline-buffer-path (( ))) + `(doom-modeline-evil-emacs-state ((,c :inherit italic))) + `(doom-modeline-evil-insert-state ((,c :foreground ,modeline-info))) + `(doom-modeline-evil-motion-state (( ))) + `(doom-modeline-evil-normal-state (( ))) + `(doom-modeline-evil-operator-state ((,c :inherit bold))) + `(doom-modeline-evil-replace-state ((,c :inherit error))) + `(doom-modeline-evil-visual-state ((,c :inherit warning))) + `(doom-modeline-info ((,c :inherit success))) + `(doom-modeline-input-method (( ))) + `(doom-modeline-lsp-error ((,c :inherit bold-italic))) + `(doom-modeline-lsp-running (( ))) + `(doom-modeline-lsp-success ((,c :inherit success))) + `(doom-modeline-lsp-warning ((,c :inherit warning))) + `(doom-modeline-notification ((,c :inherit error))) + `(doom-modeline-project-dir (( ))) + `(doom-modeline-project-parent-dir (( ))) + `(doom-modeline-project-root-dir (( ))) + `(doom-modeline-repl-success ((,c :inherit success))) + `(doom-modeline-repl-warning ((,c :inherit warning))) + `(doom-modeline-time (( ))) + `(doom-modeline-urgent ((,c :inherit bold-italic :foreground ,modeline-err))) + `(doom-modeline-warning ((,c :inherit warning))) ;;;;; ediff - `(ediff-current-diff-A ((,class :inherit modus-themes-diff-removed))) - `(ediff-current-diff-Ancestor ((,class ,@(modus-themes--diff - bg-special-cold fg-special-cold - blue-nuanced-bg blue)))) - `(ediff-current-diff-B ((,class :inherit modus-themes-diff-added))) - `(ediff-current-diff-C ((,class :inherit modus-themes-diff-changed))) - `(ediff-even-diff-A ((,class :background ,bg-alt))) - `(ediff-even-diff-Ancestor ((,class :background ,bg-alt))) - `(ediff-even-diff-B ((,class :background ,bg-alt))) - `(ediff-even-diff-C ((,class :background ,bg-alt))) - `(ediff-fine-diff-A ((,class :inherit modus-themes-diff-refine-removed))) - `(ediff-fine-diff-Ancestor ((,class :inherit modus-themes-refine-cyan))) - `(ediff-fine-diff-B ((,class :inherit modus-themes-diff-refine-added))) - `(ediff-fine-diff-C ((,class :inherit modus-themes-diff-refine-changed))) - `(ediff-odd-diff-A ((,class :inherit ediff-even-diff-A))) - `(ediff-odd-diff-Ancestor ((,class :inherit ediff-even-diff-Ancestor))) - `(ediff-odd-diff-B ((,class :inherit ediff-even-diff-B))) - `(ediff-odd-diff-C ((,class :inherit ediff-even-diff-C))) + `(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 :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))) + `(ediff-odd-diff-C ((,c :inherit ediff-even-diff-C))) ;;;;; ein (Emacs IPython Notebook) - `(ein:basecell-input-area-face ((,class :background ,bg-dim :extend t))) + `(ein:basecell-input-area-face ((,c :background ,bg-dim :extend t))) `(ein:cell-output-area (( ))) - `(ein:cell-output-area-error ((,class :background ,red-nuanced-bg :extend t))) - `(ein:cell-output-stderr ((,class :background ,red-nuanced-bg :extend t))) + `(ein:cell-output-area-error ((,c :background ,bg-removed :extend t))) + `(ein:cell-output-stderr ((,c :background ,bg-removed :extend t))) `(ein:markdowncell-input-area-face (( ))) - `(ein:notification-tab-normal ((,class :underline t))) + `(ein:notification-tab-normal ((,c :underline t))) ;;;;; eglot - `(eglot-mode-line ((,class :inherit modus-themes-bold :foreground ,magenta-active))) + `(eglot-mode-line ((,c :inherit modus-themes-bold :foreground ,modeline-info))) ;;;;; el-search - `(el-search-highlight-in-prompt-face ((,class :inherit bold :foreground ,magenta-alt))) - `(el-search-match ((,class :inherit modus-themes-search-success))) - `(el-search-other-match ((,class :inherit modus-themes-special-mild))) - `(el-search-occur-match ((,class :inherit modus-themes-special-calm))) + `(el-search-highlight-in-prompt-face ((,c :inherit italic))) + `(el-search-match ((,c :inherit modus-themes-search-current))) + `(el-search-other-match ((,c :inherit modus-themes-search-lazy))) + `(el-search-occur-match ((,c :inherit match))) ;;;;; eldoc ;; NOTE: see https://github.com/purcell/package-lint/issues/187 - (list 'eldoc-highlight-function-argument `((,class :inherit bold - :background ,yellow-nuanced-bg - :foreground ,yellow-alt-other))) + (list 'eldoc-highlight-function-argument `((,c :inherit modus-themes-mark-alt))) ;;;;; eldoc-box - `(eldoc-box-body ((,class :background ,bg-alt :foreground ,fg-main))) - `(eldoc-box-border ((,class :background ,fg-alt))) + `(eldoc-box-body ((,c :background ,bg-dim :foreground ,fg-main))) + `(eldoc-box-border ((,c :background ,border))) ;;;;; elfeed - `(elfeed-log-date-face ((,class :inherit elfeed-search-date-face))) - `(elfeed-log-debug-level-face ((,class :inherit elfeed-search-filter-face))) - `(elfeed-log-error-level-face ((,class :inherit error))) - `(elfeed-log-info-level-face ((,class :inherit success))) - `(elfeed-log-warn-level-face ((,class :inherit warning))) - `(elfeed-search-date-face ((,class :foreground ,cyan))) - `(elfeed-search-feed-face ((,class :foreground ,blue-faint))) - `(elfeed-search-filter-face ((,class :inherit bold :foreground ,magenta-active))) - `(elfeed-search-last-update-face ((,class :inherit bold :foreground ,cyan-active))) - `(elfeed-search-tag-face ((,class :foreground ,magenta-alt-faint))) - `(elfeed-search-title-face ((,class :foreground ,fg-dim))) - `(elfeed-search-unread-count-face ((,class :inherit bold :foreground ,fg-active))) - `(elfeed-search-unread-title-face ((,class :inherit bold :foreground ,fg-main))) + `(elfeed-log-date-face ((,c :inherit elfeed-search-date-face))) + `(elfeed-log-debug-level-face ((,c :inherit elfeed-search-filter-face))) + `(elfeed-log-error-level-face ((,c :inherit error))) + `(elfeed-log-info-level-face ((,c :inherit success))) + `(elfeed-log-warn-level-face ((,c :inherit warning))) + `(elfeed-search-date-face ((,c :foreground ,date-common))) + `(elfeed-search-feed-face ((,c :foreground ,accent-1))) + `(elfeed-search-filter-face ((,c :inherit bold))) + `(elfeed-search-last-update-face ((,c :inherit bold :foreground ,date-common))) + `(elfeed-search-tag-face ((,c :foreground ,accent-0))) + `(elfeed-search-title-face ((,c :foreground ,fg-dim))) + `(elfeed-search-unread-count-face (( ))) + `(elfeed-search-unread-title-face ((,c :inherit bold :foreground ,fg-main))) ;;;;; elfeed-score - `(elfeed-score-date-face ((,class :foreground ,blue))) - `(elfeed-score-debug-level-face ((,class :foreground ,magenta-alt-other))) - `(elfeed-score-error-level-face ((,class :foreground ,red))) - `(elfeed-score-info-level-face ((,class :foreground ,cyan))) - `(elfeed-score-warn-level-face ((,class :foreground ,yellow))) + `(elfeed-score-date-face ((,c :foreground ,date-common))) + `(elfeed-score-debug-level-face ((,c :inherit bold))) + `(elfeed-score-error-level-face ((,c :inherit error))) + `(elfeed-score-info-level-face ((,c :inherit success))) + `(elfeed-score-warn-level-face ((,c :inherit warning))) ;;;;; elpher - `(elpher-gemini-heading1 ((,class :inherit modus-themes-heading-1))) - `(elpher-gemini-heading2 ((,class :inherit modus-themes-heading-2))) - `(elpher-gemini-heading3 ((,class :inherit modus-themes-heading-3))) + `(elpher-gemini-heading1 ((,c :inherit modus-themes-heading-1))) + `(elpher-gemini-heading2 ((,c :inherit modus-themes-heading-2))) + `(elpher-gemini-heading3 ((,c :inherit modus-themes-heading-3))) ;;;;; embark - `(embark-keybinding ((,class :inherit modus-themes-key-binding))) - `(embark-collect-marked ((,class :inherit modus-themes-mark-sel))) + `(embark-keybinding ((,c :inherit modus-themes-key-binding))) + `(embark-collect-marked ((,c :inherit modus-themes-mark-sel))) ;;;;; ement (ement.el) - `(ement-room-fully-read-marker ((,class :background ,cyan-subtle-bg))) - `(ement-room-membership ((,class :inherit shadow))) - `(ement-room-mention ((,class :background ,bg-hl-alt-intense))) - `(ement-room-name ((,class :inherit bold))) - `(ement-room-reactions ((,class :inherit shadow))) - `(ement-room-read-receipt-marker ((,class :background ,yellow-subtle-bg))) - `(ement-room-self ((,class :inherit bold :foreground ,magenta))) - `(ement-room-self-message ((,class :foreground ,magenta-faint))) - `(ement-room-timestamp ((,class :inherit shadow))) - `(ement-room-timestamp-header ((,class :inherit bold :foreground ,cyan))) - `(ement-room-user ((,class :inherit bold :foreground ,blue))) + `(ement-room-fully-read-marker ((,c :inherit success))) + `(ement-room-membership ((,c :inherit shadow))) + `(ement-room-mention ((,c :inherit highlight))) + `(ement-room-name ((,c :inherit bold))) + `(ement-room-reactions ((,c :inherit shadow))) + `(ement-room-read-receipt-marker ((,c :inherit match))) + `(ement-room-self ((,c :inherit bold :foreground ,accent-1))) + `(ement-room-self-message ((,c :foreground ,fg-alt))) + `(ement-room-timestamp ((,c :inherit shadow))) + `(ement-room-timestamp-header ((,c :inherit bold :foreground ,date-common))) + `(ement-room-user ((,c :inherit bold :foreground ,accent-0))) ;;;;; emms - `(emms-browser-album-face ((,class :foreground ,magenta-alt-other))) - `(emms-browser-artist-face ((,class :foreground ,cyan))) - `(emms-browser-composer-face ((,class :foreground ,magenta-alt))) - `(emms-browser-performer-face ((,class :inherit emms-browser-artist-face))) - `(emms-browser-track-face ((,class :inherit emms-playlist-track-face))) - `(emms-browser-year/genre-face ((,class :foreground ,cyan-alt-other))) - `(emms-playlist-track-face ((,class :foreground ,blue-alt))) - `(emms-playlist-selected-face ((,class :inherit bold :foreground ,blue-alt-other))) - `(emms-metaplaylist-mode-current-face ((,class :inherit emms-playlist-selected-face))) - `(emms-metaplaylist-mode-face ((,class :foreground ,cyan))) + `(emms-browser-album-face ((,c :foreground ,keyword))) + `(emms-browser-artist-face ((,c :foreground ,variable))) + `(emms-browser-composer-face ((,c :foreground ,builtin))) + `(emms-browser-performer-face ((,c :inherit emms-browser-artist-face))) + `(emms-browser-track-face ((,c :inherit emms-playlist-track-face))) + `(emms-browser-year/genre-face ((,c :foreground ,type))) + `(emms-playlist-track-face ((,c :foreground ,string))) + `(emms-playlist-selected-face ((,c :inherit bold :foreground ,constant))) + `(emms-metaplaylist-mode-current-face ((,c :inherit emms-playlist-selected-face))) + `(emms-metaplaylist-mode-face ((,c :foreground ,variable))) ;;;;; enh-ruby-mode (enhanced-ruby-mode) - `(enh-ruby-heredoc-delimiter-face ((,class :inherit font-lock-constant-face))) - `(enh-ruby-op-face ((,class :foreground ,fg-main))) - `(enh-ruby-regexp-delimiter-face ((,class :inherit font-lock-regexp-grouping-construct))) - `(enh-ruby-regexp-face ((,class :inherit font-lock-string-face))) - `(enh-ruby-string-delimiter-face ((,class :inherit font-lock-string-face))) - `(erm-syn-errline ((,class :inherit modus-themes-lang-error))) - `(erm-syn-warnline ((,class :inherit modus-themes-lang-warning))) + `(enh-ruby-heredoc-delimiter-face ((,c :inherit font-lock-constant-face))) + `(enh-ruby-op-face ((,c :foreground ,fg-main))) + `(enh-ruby-regexp-delimiter-face ((,c :inherit font-lock-regexp-grouping-construct))) + `(enh-ruby-regexp-face ((,c :inherit font-lock-string-face))) + `(enh-ruby-string-delimiter-face ((,c :inherit font-lock-string-face))) + `(erm-syn-errline ((,c :inherit modus-themes-lang-error))) + `(erm-syn-warnline ((,c :inherit modus-themes-lang-warning))) ;;;;; epa - `(epa-field-body ((,class :foreground ,fg-main))) - `(epa-field-name ((,class :inherit bold :foreground ,fg-dim))) - `(epa-mark ((,class :inherit bold :foreground ,magenta))) - `(epa-string ((,class :foreground ,blue-alt))) - `(epa-validity-disabled ((,class :foreground ,red))) - `(epa-validity-high ((,class :inherit bold :foreground ,cyan))) - `(epa-validity-low ((,class :inherit shadow))) - `(epa-validity-medium ((,class :foreground ,green-alt))) -;;;;; equake - `(equake-buffer-face ((,class :background ,bg-main :foreground ,fg-main))) - `(equake-shell-type-eshell ((,class :background ,bg-inactive :foreground ,blue-active))) - `(equake-shell-type-rash ((,class :background ,bg-inactive :foreground ,red-active))) - `(equake-shell-type-shell ((,class :background ,bg-inactive :foreground ,cyan-active))) - `(equake-shell-type-term ((,class :background ,bg-inactive :foreground ,yellow-active))) - `(equake-shell-type-vterm ((,class :background ,bg-inactive :foreground ,magenta-active))) - `(equake-tab-active ((,class :background ,fg-alt :foreground ,bg-alt))) - `(equake-tab-inactive ((,class :foreground ,fg-inactive))) + `(epa-field-body (( ))) + `(epa-field-name ((,c :inherit bold :foreground ,fg-dim))) + `(epa-mark ((,c :inherit bold))) + `(epa-string ((,c :foreground ,string))) + `(epa-validity-disabled ((,c :foreground ,err))) + `(epa-validity-high ((,c :inherit success))) + `(epa-validity-low ((,c :inherit shadow))) + `(epa-validity-medium ((,c :foreground ,info))) ;;;;; erc - `(erc-action-face ((,class :foreground ,cyan-alt-other))) - `(erc-bold-face ((,class :inherit bold))) - `(erc-button ((,class :inherit button))) - `(erc-command-indicator-face ((,class :inherit bold :foreground ,cyan-alt))) - `(erc-current-nick-face ((,class :inherit bold :foreground ,red-alt))) - `(erc-dangerous-host-face ((,class :inherit modus-themes-intense-red))) - `(erc-direct-msg-face ((,class :foreground ,fg-special-warm))) - `(erc-error-face ((,class :inherit bold :foreground ,red))) - `(erc-fool-face ((,class :inherit shadow))) - `(erc-header-line ((,class :background ,bg-header :foreground ,fg-header))) - `(erc-input-face ((,class :foreground ,magenta))) - `(erc-inverse-face ((,class :inherit erc-default-face :inverse-video t))) - `(erc-keyword-face ((,class :inherit bold :foreground ,magenta-alt-other))) - `(erc-my-nick-face ((,class :inherit bold :foreground ,magenta))) - `(erc-my-nick-prefix-face ((,class :inherit erc-my-nick-face))) - `(erc-nick-default-face ((,class :inherit bold :foreground ,blue))) - `(erc-nick-msg-face ((,class :inherit warning))) - `(erc-nick-prefix-face ((,class :inherit erc-nick-default-face))) - `(erc-notice-face ((,class :inherit font-lock-comment-face))) - `(erc-pal-face ((,class :inherit bold :foreground ,magenta-alt))) - `(erc-prompt-face ((,class :inherit modus-themes-prompt))) - `(erc-timestamp-face ((,class :foreground ,cyan))) - `(erc-underline-face ((,class :underline t))) - `(bg:erc-color-face0 ((,class :background "white"))) - `(bg:erc-color-face1 ((,class :background "black"))) - `(bg:erc-color-face10 ((,class :background ,cyan-subtle-bg))) - `(bg:erc-color-face11 ((,class :background ,cyan-intense-bg))) - `(bg:erc-color-face12 ((,class :background ,blue-subtle-bg))) - `(bg:erc-color-face13 ((,class :background ,magenta-subtle-bg))) - `(bg:erc-color-face14 ((,class :background "gray60"))) - `(bg:erc-color-face15 ((,class :background "gray80"))) - `(bg:erc-color-face2 ((,class :background ,blue-intense-bg))) - `(bg:erc-color-face3 ((,class :background ,green-intense-bg))) - `(bg:erc-color-face4 ((,class :background ,red-subtle-bg))) - `(bg:erc-color-face5 ((,class :background ,red-intense-bg))) - `(bg:erc-color-face6 ((,class :background ,magenta-refine-bg))) - `(bg:erc-color-face7 ((,class :background ,yellow-subtle-bg))) - `(bg:erc-color-face8 ((,class :background ,yellow-refine-bg))) - `(bg:erc-color-face9 ((,class :background ,green-subtle-bg))) - `(fg:erc-color-face0 ((,class :foreground "white"))) - `(fg:erc-color-face1 ((,class :foreground "black"))) - `(fg:erc-color-face10 ((,class :foreground ,cyan))) - `(fg:erc-color-face11 ((,class :foreground ,cyan-alt-other))) - `(fg:erc-color-face12 ((,class :foreground ,blue))) - `(fg:erc-color-face13 ((,class :foreground ,magenta-alt))) - `(fg:erc-color-face14 ((,class :foreground "gray60"))) - `(fg:erc-color-face15 ((,class :foreground "gray80"))) - `(fg:erc-color-face2 ((,class :foreground ,blue-alt-other))) - `(fg:erc-color-face3 ((,class :foreground ,green))) - `(fg:erc-color-face4 ((,class :foreground ,red))) - `(fg:erc-color-face5 ((,class :foreground ,red-alt))) - `(fg:erc-color-face6 ((,class :foreground ,magenta-alt-other))) - `(fg:erc-color-face7 ((,class :foreground ,yellow-alt-other))) - `(fg:erc-color-face8 ((,class :foreground ,yellow-alt))) - `(fg:erc-color-face9 ((,class :foreground ,green-alt-other))) -;;;;; eros - `(eros-result-overlay-face ((,class :box (:line-width -1 :color ,blue) - :background ,bg-dim :foreground ,fg-dim))) + `(erc-action-face ((,c :foreground ,accent-2))) + `(erc-bold-face ((,c :inherit bold))) + `(erc-button ((,c :inherit button))) + `(erc-command-indicator-face ((,c :inherit bold :foreground ,accent-3))) + `(erc-current-nick-face ((,c :inherit match))) + `(erc-dangerous-host-face ((,c :inherit modus-themes-intense-red))) + `(erc-direct-msg-face ((,c :inherit shadow))) + `(erc-error-face ((,c :inherit error))) + `(erc-fool-face ((,c :inherit shadow))) + `(erc-input-face ((,c :foreground ,fnname))) + `(erc-inverse-face ((,c :inherit erc-default-face :inverse-video t))) + `(erc-keyword-face ((,c :inherit bold :foreground ,keyword))) + `(erc-my-nick-face ((,c :inherit bold :foreground ,name))) + `(erc-my-nick-prefix-face ((,c :inherit erc-my-nick-face))) + `(erc-nick-default-face ((,c :inherit bold :foreground ,accent-0))) + `(erc-nick-msg-face ((,c :inherit warning))) + `(erc-nick-prefix-face ((,c :inherit erc-nick-default-face))) + `(erc-notice-face ((,c :inherit font-lock-comment-face))) + `(erc-pal-face ((,c :inherit bold :foreground ,accent-1))) + `(erc-prompt-face ((,c :inherit modus-themes-prompt))) + `(erc-timestamp-face ((,c :foreground ,date-common))) + `(erc-underline-face ((,c :underline t))) ;;;;; ert - `(ert-test-result-expected ((,class :inherit modus-themes-intense-green))) - `(ert-test-result-unexpected ((,class :inherit modus-themes-intense-red))) + `(ert-test-result-expected ((,c :inherit modus-themes-intense-cyan))) + `(ert-test-result-unexpected ((,c :inherit modus-themes-intense-red))) ;;;;; eshell - `(eshell-ls-archive ((,class :foreground ,cyan-alt))) - `(eshell-ls-backup ((,class :inherit shadow))) - `(eshell-ls-clutter ((,class :foreground ,red-alt))) - `(eshell-ls-directory ((,class :foreground ,blue-alt))) - `(eshell-ls-executable ((,class :foreground ,magenta-alt))) - `(eshell-ls-missing ((,class :inherit modus-themes-intense-red))) - `(eshell-ls-product ((,class :inherit shadow))) - `(eshell-ls-readonly ((,class :foreground ,yellow-faint))) - `(eshell-ls-special ((,class :foreground ,magenta))) - `(eshell-ls-symlink ((,class :inherit modus-themes-link-symlink))) - `(eshell-ls-unreadable ((,class :background ,bg-inactive :foreground ,fg-inactive))) - `(eshell-prompt ((,class :inherit modus-themes-prompt))) + `(eshell-ls-archive ((,c :foreground ,accent-2))) + `(eshell-ls-backup ((,c :inherit shadow))) + `(eshell-ls-clutter ((,c :inherit shadow))) + `(eshell-ls-directory ((,c :foreground ,accent-0))) + `(eshell-ls-executable ((,c :foreground ,accent-1))) + `(eshell-ls-missing ((,c :inherit error))) + `(eshell-ls-product ((,c :inherit shadow))) + `(eshell-ls-readonly ((,c :foreground ,warning))) + `(eshell-ls-special ((,c :foreground ,accent-3))) + `(eshell-ls-symlink ((,c :inherit link))) + `(eshell-ls-unreadable ((,c :inherit shadow))) + `(eshell-prompt ((,c :inherit modus-themes-prompt))) ;;;;; eshell-fringe-status - `(eshell-fringe-status-failure ((,class :inherit error))) - `(eshell-fringe-status-success ((,class :inherit success))) -;;;;; eshell-git-prompt - `(eshell-git-prompt-add-face ((,class :foreground ,magenta-alt-other))) - `(eshell-git-prompt-branch-face ((,class :foreground ,magenta-alt))) - `(eshell-git-prompt-directory-face ((,class :inherit bold :foreground ,blue))) - `(eshell-git-prompt-exit-fail-face ((,class :inherit error))) - `(eshell-git-prompt-exit-success-face ((,class :inherit success))) - `(eshell-git-prompt-modified-face ((,class :foreground ,yellow))) - `(eshell-git-prompt-powerline-clean-face ((,class :background ,green-refine-bg))) - `(eshell-git-prompt-powerline-dir-face ((,class :background ,blue-refine-bg))) - `(eshell-git-prompt-powerline-not-clean-face ((,class :background ,yellow-fringe-bg))) - `(eshell-git-prompt-robyrussell-branch-face ((,class :foreground ,magenta-alt))) - `(eshell-git-prompt-robyrussell-git-dirty-face ((,class :foreground ,yellow))) - `(eshell-git-prompt-robyrussell-git-face ((,class :foreground ,magenta-alt-other))) -;;;;; eshell-prompt-extras (epe) - `(epe-dir-face ((,class :inherit bold :foreground ,blue))) - `(epe-git-dir-face ((,class :foreground ,red-alt-other))) - `(epe-git-face ((,class :foreground ,magenta-alt))) - `(epe-pipeline-delimiter-face ((,class :inherit shadow))) - `(epe-pipeline-host-face ((,class :foreground ,fg-main))) - `(epe-pipeline-time-face ((,class :foreground ,fg-main))) - `(epe-pipeline-user-face ((,class :foreground ,magenta-alt-other))) - `(epe-remote-face ((,class :inherit (shadow modus-themes-slant)))) - `(epe-status-face ((,class :foreground ,magenta-alt-other))) - `(epe-venv-face ((,class :inherit (shadow modus-themes-slant)))) -;;;;; eshell-syntax-highlighting - `(eshell-syntax-highlighting-directory-face ((,class :inherit eshell-ls-directory))) - `(eshell-syntax-highlighting-invalid-face ((,class :foreground ,red))) - `(eshell-syntax-highlighting-shell-command-face ((,class :foreground ,fg-main))) + `(eshell-fringe-status-failure ((,c :inherit error))) + `(eshell-fringe-status-success ((,c :inherit success))) ;;;;; evil-mode - `(evil-ex-commands ((,class :foreground ,magenta-alt-other))) - `(evil-ex-info ((,class :foreground ,cyan-alt-other))) - `(evil-ex-lazy-highlight ((,class :inherit modus-themes-search-success-lazy))) - `(evil-ex-search ((,class :inherit modus-themes-search-success))) - `(evil-ex-substitute-matches ((,class :inherit modus-themes-refine-yellow :underline t))) - `(evil-ex-substitute-replacement ((,class :inherit modus-themes-search-success))) -;;;;; evil-goggles - `(evil-goggles-change-face ((,class :inherit modus-themes-refine-yellow))) - `(evil-goggles-commentary-face ((,class :inherit (modus-themes-subtle-neutral modus-themes-slant)))) - `(evil-goggles-default-face ((,class :inherit modus-themes-subtle-neutral))) - `(evil-goggles-delete-face ((,class :inherit modus-themes-refine-red))) - `(evil-goggles-fill-and-move-face ((,class :inherit evil-goggles-default-face))) - `(evil-goggles-indent-face ((,class :inherit evil-goggles-default-face))) - `(evil-goggles-join-face ((,class :inherit modus-themes-subtle-green))) - `(evil-goggles-nerd-commenter-face ((,class :inherit evil-goggles-commentary-face))) - `(evil-goggles-paste-face ((,class :inherit modus-themes-subtle-cyan))) - `(evil-goggles-record-macro-face ((,class :inherit modus-themes-special-cold))) - `(evil-goggles-replace-with-register-face ((,class :inherit modus-themes-refine-magenta))) - `(evil-goggles-set-marker-face ((,class :inherit modus-themes-intense-magenta))) - `(evil-goggles-shift-face ((,class :inherit evil-goggles-default-face))) - `(evil-goggles-surround-face ((,class :inherit evil-goggles-default-face))) - `(evil-goggles-yank-face ((,class :inherit modus-themes-subtle-blue))) -;;;;; evil-snipe - `(evil-snipe-first-match-face ((,class :inherit (bold modus-themes-intense-blue)))) - `(evil-snipe-matches-face ((,class :inherit modus-themes-refine-magenta))) -;;;;; evil-visual-mark-mode - `(evil-visual-mark-face ((,class :inherit modus-themes-intense-magenta))) + `(evil-ex-commands ((,c :inherit font-lock-keyword-face))) + `(evil-ex-info ((,c :inherit font-lock-type-face))) + `(evil-ex-lazy-highlight ((,c :inherit modus-themes-search-lazy))) + `(evil-ex-search ((,c :inherit modus-themes-search-current))) + `(evil-ex-substitute-matches ((,c :inherit modus-themes-intense-yellow :underline t))) + `(evil-ex-substitute-replacement ((,c :inherit modus-themes-search-current))) ;;;;; eww - `(eww-invalid-certificate ((,class :foreground ,red-faint))) - `(eww-valid-certificate ((,class :foreground ,blue-faint))) - `(eww-form-checkbox ((,class :inherit eww-form-text))) - `(eww-form-file ((,class :inherit eww-form-submit))) - `(eww-form-select ((,class :inherit eww-form-submit))) - `(eww-form-submit ((,class :inherit modus-themes-box-button))) - `(eww-form-text ((,class :inherit widget-field))) - `(eww-form-textarea ((,class :inherit eww-form-text))) + `(eww-invalid-certificate ((,c :foreground ,err))) + `(eww-valid-certificate ((,c :foreground ,info))) + `(eww-form-checkbox ((,c :inherit eww-form-text))) + `(eww-form-file ((,c :inherit eww-form-submit))) + `(eww-form-select ((,c :inherit eww-form-submit))) + `(eww-form-submit ((,c :inherit modus-themes-button))) + `(eww-form-text ((,c :inherit widget-field))) + `(eww-form-textarea ((,c :inherit eww-form-text))) ;;;;; eyebrowse - `(eyebrowse-mode-line-active ((,class :inherit bold :foreground ,blue-active))) -;;;;; fancy-dabbrev - `(fancy-dabbrev-menu-face ((,class :background ,bg-alt :foreground ,fg-alt))) - `(fancy-dabbrev-preview-face ((,class :inherit shadow :underline t))) - `(fancy-dabbrev-selection-face ((,class :inherit (modus-themes-intense-cyan bold)))) + `(eyebrowse-mode-line-active ((,c :inherit mode-line-emphasis))) ;;;;; flycheck - `(flycheck-error ((,class :inherit modus-themes-lang-error))) - `(flycheck-error-list-checker-name ((,class :foreground ,magenta-active))) - `(flycheck-error-list-column-number ((,class :foreground ,fg-special-cold))) - `(flycheck-error-list-error ((,class :inherit modus-themes-bold :foreground ,red))) - `(flycheck-error-list-filename ((,class :foreground ,blue))) - `(flycheck-error-list-highlight ((,class :inherit modus-themes-hl-line))) - `(flycheck-error-list-id ((,class :foreground ,magenta-alt-other))) - `(flycheck-error-list-id-with-explainer ((,class :inherit flycheck-error-list-id :box t))) - `(flycheck-error-list-info ((,class :foreground ,cyan))) - `(flycheck-error-list-line-number ((,class :foreground ,fg-special-warm))) - `(flycheck-error-list-warning ((,class :foreground ,yellow))) - `(flycheck-fringe-error ((,class :inherit modus-themes-fringe-red))) - `(flycheck-fringe-info ((,class :inherit modus-themes-fringe-cyan))) - `(flycheck-fringe-warning ((,class :inherit modus-themes-fringe-yellow))) - `(flycheck-info ((,class :inherit modus-themes-lang-note))) - `(flycheck-verify-select-checker ((,class :box (:line-width 1 :color nil :style released-button)))) - `(flycheck-warning ((,class :inherit modus-themes-lang-warning))) + `(flycheck-error ((,c :inherit modus-themes-lang-error))) + `(flycheck-fringe-error ((,c :inherit modus-themes-intense-red))) + `(flycheck-fringe-info ((,c :inherit modus-themes-intense-cyan))) + `(flycheck-fringe-warning ((,c :inherit modus-themes-intense-yellow))) + `(flycheck-info ((,c :inherit modus-themes-lang-note))) + `(flycheck-warning ((,c :inherit modus-themes-lang-warning))) ;;;;; flycheck-color-mode-line - `(flycheck-color-mode-line-error-face ((,class :inherit flycheck-fringe-error))) - `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-info))) - `(flycheck-color-mode-line-running-face ((,class :inherit italic :foreground ,fg-inactive))) - `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-warning))) + `(flycheck-color-mode-line-error-face ((,c :inherit flycheck-fringe-error))) + `(flycheck-color-mode-line-info-face ((,c :inherit flycheck-fringe-info))) + `(flycheck-color-mode-line-running-face ((,c :inherit italic))) + `(flycheck-color-mode-line-info-face ((,c :inherit flycheck-fringe-warning))) ;;;;; flycheck-indicator - `(flycheck-indicator-disabled ((,class :inherit modus-themes-slant :foreground ,fg-inactive))) - `(flycheck-indicator-error ((,class :inherit modus-themes-bold :foreground ,red-active))) - `(flycheck-indicator-info ((,class :inherit modus-themes-bold :foreground ,blue-active))) - `(flycheck-indicator-running ((,class :inherit modus-themes-bold :foreground ,magenta-active))) - `(flycheck-indicator-success ((,class :inherit (modus-themes-bold modus-themes-grue-active)))) - `(flycheck-indicator-warning ((,class :inherit modus-themes-bold :foreground ,yellow-active))) -;;;;; flycheck-posframe - `(flycheck-posframe-background-face ((,class :background ,bg-alt))) - `(flycheck-posframe-border-face ((,class :inherit shadow))) - `(flycheck-posframe-error-face ((,class :inherit bold :foreground ,red))) - `(flycheck-posframe-face ((,class :inherit modus-themes-slant :foreground ,fg-main))) - `(flycheck-posframe-info-face ((,class :inherit bold :foreground ,cyan))) - `(flycheck-posframe-warning-face ((,class :inherit bold :foreground ,yellow))) + `(flycheck-indicator-disabled ((,c :inherit modus-themes-slant :foreground ,fg-dim))) + `(flycheck-indicator-error ((,c :inherit error))) + `(flycheck-indicator-info ((,c :inherit bold))) + `(flycheck-indicator-running ((,c :inherit modus-themes-slant))) + `(flycheck-indicator-success ((,c :inherit success))) + `(flycheck-indicator-warning ((,c :inherit warning))) ;;;;; flymake - `(flymake-error ((,class :inherit modus-themes-lang-error))) - `(flymake-note ((,class :inherit modus-themes-lang-note))) - `(flymake-warning ((,class :inherit modus-themes-lang-warning))) + `(flymake-error ((,c :inherit modus-themes-lang-error))) + `(flymake-note ((,c :inherit modus-themes-lang-note))) + `(flymake-warning ((,c :inherit modus-themes-lang-warning))) ;;;;; flyspell - `(flyspell-duplicate ((,class :inherit modus-themes-lang-warning))) - `(flyspell-incorrect ((,class :inherit modus-themes-lang-error))) + `(flyspell-duplicate ((,c :inherit modus-themes-lang-warning))) + `(flyspell-incorrect ((,c :inherit modus-themes-lang-error))) ;;;;; flx - `(flx-highlight-face ((,class :inherit modus-themes-completion-match-0))) -;;;;; freeze-it - `(freeze-it-show ((,class :background ,bg-dim :foreground ,fg-special-warm))) + `(flx-highlight-face ((,c :inherit modus-themes-completion-match-0))) ;;;;; focus - `(focus-unfocused ((,class :foreground ,fg-unfocused))) + `(focus-unfocused ((,c :foreground "gray50"))) ;;;;; fold-this - `(fold-this-overlay ((,class :inherit modus-themes-special-mild))) + `(fold-this-overlay ((,c :background ,bg-inactive))) ;;;;; font-lock - `(font-lock-builtin-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-extra - magenta-alt magenta-alt-faint - magenta magenta-faint)))) - `(font-lock-comment-delimiter-face ((,class :inherit font-lock-comment-face))) - `(font-lock-comment-face ((,class :inherit modus-themes-slant - ,@(modus-themes--syntax-comment - fg-alt fg-comment-yellow yellow-alt-other-faint)))) - `(font-lock-constant-face ((,class ,@(modus-themes--syntax-extra - blue-alt-other blue-alt-other-faint - magenta-alt-other magenta-alt-other-faint)))) - `(font-lock-doc-face ((,class :inherit modus-themes-slant - ,@(modus-themes--syntax-string - fg-docstring fg-special-cold - fg-special-mild fg-special-calm - fg-special-mild magenta-nuanced-fg)))) - `(font-lock-function-name-face ((,class ,@(modus-themes--syntax-extra - magenta magenta-faint - magenta-alt magenta-alt-faint)))) - `(font-lock-keyword-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-extra - magenta-alt-other magenta-alt-other-faint - cyan cyan-faint)))) - `(font-lock-negation-char-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-foreground - yellow yellow-faint)))) - `(font-lock-preprocessor-face ((,class ,@(modus-themes--syntax-extra - red-alt-other red-alt-other-faint - cyan-alt-other cyan-alt-faint)))) - `(font-lock-regexp-grouping-backslash ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-string - fg-escape-char-backslash yellow-alt-faint - yellow-alt magenta-alt - red-faint green-alt-other-faint)))) - `(font-lock-regexp-grouping-construct ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-string - fg-escape-char-construct red-alt-other-faint - red-alt-other blue-alt-other - blue-faint blue-alt-other-faint)))) - `(font-lock-string-face ((,class ,@(modus-themes--syntax-string - blue-alt blue-alt-faint - green-alt-other red-alt-other - green-alt-faint red-alt-faint)))) - `(font-lock-type-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-extra - cyan-alt-other cyan-alt-faint - magenta-alt-other magenta-alt-other-faint)))) - `(font-lock-variable-name-face ((,class ,@(modus-themes--syntax-extra - cyan cyan-faint - blue-alt blue-alt-faint)))) - `(font-lock-warning-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-comment - yellow red yellow-alt-faint red-faint)))) -;;;;; forge - `(forge-post-author ((,class :inherit bold :foreground ,fg-main))) - `(forge-post-date ((,class :foreground ,fg-special-cold))) - `(forge-topic-closed ((,class :inherit shadow))) - `(forge-topic-merged ((,class :inherit shadow))) - `(forge-topic-open ((,class :foreground ,fg-special-mild))) - `(forge-topic-unmerged ((,class :inherit modus-themes-slant :foreground ,magenta))) - `(forge-topic-unread ((,class :inherit bold :foreground ,fg-main))) -;;;;; fountain-mode - `(fountain-character ((,class :foreground ,blue-alt-other))) - `(fountain-comment ((,class :inherit font-lock-comment-face))) - `(fountain-dialog ((,class :foreground ,blue-alt))) - `(fountain-metadata-key ((,class :foreground ,green-alt-other))) - `(fountain-metadata-value ((,class :foreground ,blue))) - `(fountain-non-printing ((,class :inherit shadow))) - `(fountain-note ((,class :inherit modus-themes-slant :foreground ,yellow))) - `(fountain-page-break ((,class :inherit bold :foreground ,red-alt))) - `(fountain-page-number ((,class :inherit bold :foreground ,red-alt-other))) - `(fountain-paren ((,class :foreground ,cyan))) - `(fountain-scene-heading ((,class :inherit bold :foreground ,blue-nuanced-fg))) - `(fountain-section-heading ((,class :inherit modus-themes-heading-1))) - `(fountain-section-heading-1 ((,class :inherit modus-themes-heading-1))) - `(fountain-section-heading-2 ((,class :inherit modus-themes-heading-2))) - `(fountain-section-heading-3 ((,class :inherit modus-themes-heading-3))) - `(fountain-section-heading-4 ((,class :inherit modus-themes-heading-4))) - `(fountain-section-heading-5 ((,class :inherit modus-themes-heading-5))) - `(fountain-synopsis ((,class :foreground ,cyan-alt))) - `(fountain-trans ((,class :foreground ,yellow-alt-other))) + `(font-lock-builtin-face ((,c :inherit modus-themes-bold :foreground ,builtin))) + `(font-lock-comment-delimiter-face ((,c :inherit font-lock-comment-face))) + `(font-lock-comment-face ((,c :inherit modus-themes-slant :foreground ,comment))) + `(font-lock-constant-face ((,c :foreground ,constant))) + `(font-lock-doc-face ((,c :inherit modus-themes-slant :foreground ,docstring))) + `(font-lock-doc-markup-face ((,c :inherit modus-themes-slant :foreground ,docmarkup))) + `(font-lock-function-name-face ((,c :foreground ,fnname))) + `(font-lock-keyword-face ((,c :inherit modus-themes-bold :foreground ,keyword))) + `(font-lock-negation-char-face ((,c :inherit error))) + `(font-lock-preprocessor-face ((,c :foreground ,preprocessor))) + `(font-lock-regexp-grouping-backslash ((,c :inherit modus-themes-bold :foreground ,rx-backslash))) + `(font-lock-regexp-grouping-construct ((,c :inherit modus-themes-bold :foreground ,rx-construct))) + `(font-lock-string-face ((,c :foreground ,string))) + `(font-lock-type-face ((,c :inherit modus-themes-bold :foreground ,type))) + `(font-lock-variable-name-face ((,c :foreground ,variable))) + `(font-lock-warning-face ((,c :inherit modus-themes-bold :foreground ,warning))) ;;;;; geiser - `(geiser-font-lock-autodoc-current-arg ((,class :inherit bold - :background ,yellow-nuanced-bg - :foreground ,yellow-alt-other))) - `(geiser-font-lock-autodoc-identifier ((,class :foreground ,cyan))) - `(geiser-font-lock-doc-button ((,class :inherit button :foreground ,fg-docstring))) - `(geiser-font-lock-doc-link ((,class :inherit button))) - `(geiser-font-lock-error-link ((,class :inherit button :foreground ,red))) - `(geiser-font-lock-image-button ((,class :inherit button :foreground ,green-alt))) - `(geiser-font-lock-repl-input ((,class :inherit bold))) - `(geiser-font-lock-repl-output ((,class :inherit font-lock-keyword-face))) - `(geiser-font-lock-repl-prompt ((,class :inherit modus-themes-prompt))) - `(geiser-font-lock-xref-header ((,class :inherit bold))) - `(geiser-font-lock-xref-link ((,class :inherit button))) + `(geiser-font-lock-autodoc-current-arg ((,c :inherit modus-themes-mark-alt))) + `(geiser-font-lock-autodoc-identifier ((,c :foreground ,docstring))) + `(geiser-font-lock-doc-button ((,c :inherit button))) + `(geiser-font-lock-doc-link ((,c :inherit button))) + `(geiser-font-lock-error-link ((,c :inherit button :foreground ,err))) + `(geiser-font-lock-image-button ((,c :inherit button :foreground ,info))) + `(geiser-font-lock-repl-input ((,c :inherit bold))) + `(geiser-font-lock-repl-output ((,c :inherit font-lock-keyword-face))) + `(geiser-font-lock-repl-prompt ((,c :inherit modus-themes-prompt))) + `(geiser-font-lock-xref-header ((,c :inherit bold))) + `(geiser-font-lock-xref-link ((,c :inherit button))) ;;;;; git-commit - `(git-commit-comment-action ((,class :inherit font-lock-comment-face))) - `(git-commit-comment-branch-local ((,class :inherit font-lock-comment-face :foreground ,blue-alt))) - `(git-commit-comment-branch-remote ((,class :inherit font-lock-comment-face :foreground ,magenta-alt))) - `(git-commit-comment-detached ((,class :inherit font-lock-comment-face :foreground ,cyan-alt))) - `(git-commit-comment-file ((,class :inherit font-lock-comment-face :foreground ,cyan))) - `(git-commit-comment-heading ((,class :inherit (bold font-lock-comment-face)))) - `(git-commit-keyword ((,class :foreground ,magenta))) - `(git-commit-known-pseudo-header ((,class :foreground ,cyan-alt-other))) - `(git-commit-nonempty-second-line ((,class :inherit error))) - `(git-commit-overlong-summary ((,class :inherit warning))) - `(git-commit-pseudo-header ((,class :foreground ,blue))) - `(git-commit-summary ((,class :inherit bold :foreground ,blue))) + `(git-commit-comment-action ((,c :inherit font-lock-comment-face))) + `(git-commit-comment-branch-local ((,c :inherit font-lock-comment-face :foreground ,accent-0))) + `(git-commit-comment-branch-remote ((,c :inherit font-lock-comment-face :foreground ,accent-1))) + `(git-commit-comment-heading ((,c :inherit (bold font-lock-comment-face)))) + `(git-commit-comment-file ((,c :inherit font-lock-comment-face :foreground ,name))) + `(git-commit-keyword ((,c :foreground ,keyword))) + `(git-commit-nonempty-second-line ((,c :inherit error))) + `(git-commit-overlong-summary ((,c :inherit warning))) + `(git-commit-summary ((,c :inherit bold :foreground ,blue))) ;;;;; git-gutter - `(git-gutter:added ((,class :inherit modus-themes-grue-background-active))) - `(git-gutter:deleted ((,class :inherit modus-themes-fringe-red))) - `(git-gutter:modified ((,class :inherit modus-themes-fringe-yellow))) - `(git-gutter:separator ((,class :inherit modus-themes-fringe-cyan))) - `(git-gutter:unchanged ((,class :inherit modus-themes-fringe-magenta))) + `(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 ((,class :inherit modus-themes-grue-background-active))) - `(git-gutter-fr:deleted ((,class :inherit modus-themes-fringe-red))) - `(git-gutter-fr:modified ((,class :inherit modus-themes-fringe-yellow))) + `(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 ((,class :inherit font-lock-comment-face :foreground ,cyan))) - `(git-rebase-comment-heading ((,class :inherit (bold font-lock-comment-face)))) - `(git-rebase-description ((,class :foreground ,fg-main))) - `(git-rebase-hash ((,class :foreground ,cyan-alt-other))) + `(git-rebase-comment-hash ((,c :inherit (bold font-lock-comment-face) :foreground ,identifier))) + `(git-rebase-comment-heading ((,c :inherit (bold font-lock-comment-face)))) + `(git-rebase-description ((,c :foreground ,fg-main))) + `(git-rebase-hash ((,c :foreground ,identifier))) ;;;;; git-timemachine - `(git-timemachine-commit ((,class :inherit bold :foreground ,yellow-active))) - `(git-timemachine-minibuffer-author-face ((,class :foreground ,fg-special-warm))) - `(git-timemachine-minibuffer-detail-face ((,class :foreground ,red-alt))) + `(git-timemachine-commit ((,c :inherit warning))) + `(git-timemachine-minibuffer-author-face ((,c :foreground ,name))) + `(git-timemachine-minibuffer-detail-face ((,c :foreground ,fg-main))) ;;;;; gnus - `(gnus-button ((,class :inherit button))) - `(gnus-cite-1 ((,class :inherit message-cited-text-1))) - `(gnus-cite-2 ((,class :inherit message-cited-text-2))) - `(gnus-cite-3 ((,class :inherit message-cited-text-3))) - `(gnus-cite-4 ((,class :inherit message-cited-text-4))) - `(gnus-cite-5 ((,class :inherit gnus-cite-1))) - `(gnus-cite-6 ((,class :inherit gnus-cite-2))) - `(gnus-cite-7 ((,class :inherit gnus-cite-3))) - `(gnus-cite-8 ((,class :inherit gnus-cite-4))) - `(gnus-cite-9 ((,class :inherit gnus-cite-1))) - `(gnus-cite-10 ((,class :inherit gnus-cite-2))) - `(gnus-cite-11 ((,class :inherit gnus-cite-3))) - `(gnus-cite-attribution ((,class :inherit italic :foreground ,fg-main))) - `(gnus-emphasis-bold ((,class :inherit bold))) - `(gnus-emphasis-bold-italic ((,class :inherit bold-italic))) - `(gnus-emphasis-highlight-words ((,class :inherit modus-themes-refine-yellow))) - `(gnus-emphasis-italic ((,class :inherit italic))) - `(gnus-emphasis-underline-bold ((,class :inherit gnus-emphasis-bold :underline t))) - `(gnus-emphasis-underline-bold-italic ((,class :inherit gnus-emphasis-bold-italic :underline t))) - `(gnus-emphasis-underline-italic ((,class :inherit gnus-emphasis-italic :underline t))) - `(gnus-group-mail-1 ((,class :inherit bold :foreground ,magenta-alt))) - `(gnus-group-mail-1-empty ((,class :foreground ,magenta-alt))) - `(gnus-group-mail-2 ((,class :inherit bold :foreground ,magenta))) - `(gnus-group-mail-2-empty ((,class :foreground ,magenta))) - `(gnus-group-mail-3 ((,class :inherit bold :foreground ,magenta-alt-other))) - `(gnus-group-mail-3-empty ((,class :foreground ,magenta-alt-other))) - `(gnus-group-mail-low ((,class :inherit bold :foreground ,magenta-nuanced-fg))) - `(gnus-group-mail-low-empty ((,class :foreground ,magenta-nuanced-fg))) - `(gnus-group-news-1 ((,class :inherit bold :foreground ,green))) - `(gnus-group-news-1-empty ((,class :foreground ,green))) - `(gnus-group-news-2 ((,class :inherit bold :foreground ,cyan))) - `(gnus-group-news-2-empty ((,class :foreground ,cyan))) - `(gnus-group-news-3 ((,class :inherit bold :foreground ,yellow-nuanced-fg))) - `(gnus-group-news-3-empty ((,class :foreground ,yellow-nuanced-fg))) - `(gnus-group-news-4 ((,class :inherit bold :foreground ,cyan-nuanced-fg))) - `(gnus-group-news-4-empty ((,class :foreground ,cyan-nuanced-fg))) - `(gnus-group-news-5 ((,class :inherit bold :foreground ,red-nuanced-fg))) - `(gnus-group-news-5-empty ((,class :foreground ,red-nuanced-fg))) - `(gnus-group-news-6 ((,class :inherit bold :foreground ,fg-unfocused))) - `(gnus-group-news-6-empty ((,class :foreground ,fg-unfocused))) - `(gnus-group-news-low ((,class :inherit bold :foreground ,green-nuanced-fg))) - `(gnus-group-news-low-empty ((,class :foreground ,green-nuanced-fg))) - `(gnus-header-content ((,class :inherit message-header-other))) - `(gnus-header-from ((,class :inherit message-header-to :underline nil))) - `(gnus-header-name ((,class :inherit message-header-name))) - `(gnus-header-newsgroups ((,class :inherit message-header-newsgroups))) - `(gnus-header-subject ((,class :inherit message-header-subject))) - `(gnus-server-agent ((,class :inherit bold :foreground ,cyan))) - `(gnus-server-closed ((,class :inherit bold :foreground ,magenta))) - `(gnus-server-cloud ((,class :inherit bold :foreground ,cyan-alt))) - `(gnus-server-cloud-host ((,class :inherit modus-themes-refine-cyan))) - `(gnus-server-denied ((,class :inherit bold :foreground ,red))) - `(gnus-server-offline ((,class :inherit bold :foreground ,yellow))) - `(gnus-server-opened ((,class :inherit bold :foreground ,green))) - `(gnus-signature ((,class :inherit italic :foreground ,fg-special-cold))) - `(gnus-splash ((,class :inherit shadow))) - `(gnus-summary-cancelled ((,class :inherit modus-themes-mark-alt :extend t))) - `(gnus-summary-high-ancient ((,class :inherit bold :foreground ,fg-alt))) - `(gnus-summary-high-read ((,class :inherit bold :foreground ,fg-special-cold))) - `(gnus-summary-high-ticked ((,class :inherit bold :foreground ,red-alt-other))) - `(gnus-summary-high-undownloaded ((,class :inherit bold :foreground ,yellow))) - `(gnus-summary-high-unread ((,class :inherit bold :foreground ,fg-main))) - `(gnus-summary-low-ancient ((,class :inherit italic :foreground ,fg-alt))) - `(gnus-summary-low-read ((,class :inherit italic :foreground ,fg-alt))) - `(gnus-summary-low-ticked ((,class :inherit italic :foreground ,red-refine-fg))) - `(gnus-summary-low-undownloaded ((,class :inherit italic :foreground ,yellow-refine-fg))) - `(gnus-summary-low-unread ((,class :inherit italic :foreground ,fg-special-cold))) - `(gnus-summary-normal-ancient ((,class :foreground ,fg-special-calm))) - `(gnus-summary-normal-read ((,class :inherit shadow))) - `(gnus-summary-normal-ticked ((,class :foreground ,red-alt-other))) - `(gnus-summary-normal-undownloaded ((,class :foreground ,yellow))) - `(gnus-summary-normal-unread ((,class :foreground ,fg-main))) - `(gnus-summary-selected ((,class :inherit highlight :extend t))) + `(gnus-button ((,c :inherit button))) + `(gnus-cite-1 ((,c :inherit message-cited-text-1))) + `(gnus-cite-2 ((,c :inherit message-cited-text-2))) + `(gnus-cite-3 ((,c :inherit message-cited-text-3))) + `(gnus-cite-4 ((,c :inherit message-cited-text-4))) + `(gnus-cite-5 ((,c :inherit message-cited-text-1))) + `(gnus-cite-6 ((,c :inherit message-cited-text-2))) + `(gnus-cite-7 ((,c :inherit message-cited-text-3))) + `(gnus-cite-8 ((,c :inherit message-cited-text-4))) + `(gnus-cite-9 ((,c :inherit message-cited-text-1))) + `(gnus-cite-10 ((,c :inherit message-cited-text-2))) + `(gnus-cite-11 ((,c :inherit message-cited-text-3))) + `(gnus-cite-attribution ((,c :inherit italic))) + `(gnus-emphasis-bold ((,c :inherit bold))) + `(gnus-emphasis-bold-italic ((,c :inherit bold-italic))) + `(gnus-emphasis-highlight-words ((,c :inherit warning))) + `(gnus-emphasis-italic ((,c :inherit italic))) + `(gnus-emphasis-underline-bold ((,c :inherit gnus-emphasis-bold :underline t))) + `(gnus-emphasis-underline-bold-italic ((,c :inherit gnus-emphasis-bold-italic :underline t))) + `(gnus-emphasis-underline-italic ((,c :inherit gnus-emphasis-italic :underline t))) + `(gnus-group-mail-1 ((,c :inherit (bold gnus-group-mail-1-empty)))) + `(gnus-group-mail-1-empty ((,c :foreground ,magenta-warmer))) + `(gnus-group-mail-2 ((,c :inherit (bold gnus-group-mail-2-empty)))) + `(gnus-group-mail-2-empty ((,c :foreground ,magenta))) + `(gnus-group-mail-3 ((,c :inherit (bold gnus-group-mail-3-empty)))) + `(gnus-group-mail-3-empty ((,c :foreground ,magenta-cooler))) + `(gnus-group-mail-low ((,c :inherit (bold gnus-group-mail-low-empty)))) + `(gnus-group-mail-low-empty ((,c :foreground ,fg-dim))) + `(gnus-group-news-1 ((,c :inherit (bold gnus-group-news-1-empty)))) + `(gnus-group-news-1-empty ((,c :foreground ,green))) + `(gnus-group-news-2 ((,c :inherit (bold gnus-group-news-2-empty)))) + `(gnus-group-news-2-empty ((,c :foreground ,cyan))) + `(gnus-group-news-3 ((,c :inherit (bold gnus-group-news-3-empty)))) + `(gnus-group-news-3-empty ((,c :foreground ,yellow-faint))) + `(gnus-group-news-4 ((,c :inherit (bold gnus-group-news-4-empty)))) + `(gnus-group-news-4-empty ((,c :foreground ,magenta-faint))) + `(gnus-group-news-5 ((,c :inherit (bold gnus-group-news-5-empty)))) + `(gnus-group-news-5-empty ((,c :foreground ,fg-alt))) + `(gnus-group-news-6 ((,c :inherit (bold gnus-group-news-6-empty)))) + `(gnus-group-news-6-empty ((,c :foreground ,fg-dim))) + `(gnus-group-news-low ((,c :inherit (bold gnus-group-news-low-empty)))) + `(gnus-group-news-low-empty ((,c :foreground ,fg-dim))) + `(gnus-header-content ((,c :inherit message-header-other))) + `(gnus-header-from ((,c :inherit message-header-to :underline nil))) + `(gnus-header-name ((,c :inherit message-header-name))) + `(gnus-header-newsgroups ((,c :inherit message-header-newsgroups))) + `(gnus-header-subject ((,c :inherit message-header-subject))) + `(gnus-server-agent ((,c :inherit bold))) + `(gnus-server-closed ((,c :inherit italic))) + `(gnus-server-cloud ((,c :inherit bold :foreground ,fg-alt))) + `(gnus-server-cloud-host ((,c :inherit bold :foreground ,fg-alt :underline t))) + `(gnus-server-denied ((,c :inherit error))) + `(gnus-server-offline ((,c :inherit shadow))) + `(gnus-server-opened ((,c :inherit success))) + `(gnus-summary-cancelled ((,c :inherit italic :foreground ,warning))) + `(gnus-summary-high-ancient ((,c :inherit bold :foreground ,fg-alt))) + `(gnus-summary-high-read ((,c :inherit bold :foreground ,fg-dim))) + `(gnus-summary-high-ticked ((,c :inherit bold :foreground ,err))) + `(gnus-summary-high-undownloaded ((,c :inherit bold-italic :foreground ,warning))) + `(gnus-summary-high-unread ((,c :inherit bold))) + `(gnus-summary-low-ancient ((,c :inherit italic))) + `(gnus-summary-low-read ((,c :inherit (shadow italic)))) + `(gnus-summary-low-ticked ((,c :inherit italic :foreground ,err))) + `(gnus-summary-low-undownloaded ((,c :inherit italic :foreground ,warning))) + `(gnus-summary-low-unread ((,c :inherit italic))) + `(gnus-summary-normal-ancient (( ))) + `(gnus-summary-normal-read ((,c :inherit shadow))) + `(gnus-summary-normal-ticked ((,c :foreground ,err))) + `(gnus-summary-normal-undownloaded ((,c :foreground ,warning))) + `(gnus-summary-normal-unread (( ))) + `(gnus-summary-selected ((,c :inherit highlight))) ;;;;; gotest - `(go-test--ok-face ((,class :inherit success))) - `(go-test--error-face ((,class :inherit error))) - `(go-test--warning-face ((,class :inherit warning))) - `(go-test--pointer-face ((,class :foreground ,magenta-alt-other))) - `(go-test--standard-face ((,class :foreground ,fg-special-cold))) + `(go-test--ok-face ((,c :inherit success))) + `(go-test--error-face ((,c :inherit error))) + `(go-test--warning-face ((,c :inherit warning))) + `(go-test--pointer-face ((,c :foreground ,accent-0))) + `(go-test--standard-face (( ))) ;;;;; golden-ratio-scroll-screen - `(golden-ratio-scroll-highlight-line-face ((,class :background ,cyan-subtle-bg :foreground ,fg-main))) -;;;;; helm - `(helm-M-x-key ((,class :inherit modus-themes-key-binding))) - `(helm-action ((,class :underline t))) - `(helm-bookmark-addressbook ((,class :foreground ,green-alt))) - `(helm-bookmark-directory ((,class :inherit bold :foreground ,blue))) - `(helm-bookmark-file ((,class :foreground ,fg-main))) - `(helm-bookmark-file-not-found ((,class :background ,bg-alt :foreground ,fg-alt))) - `(helm-bookmark-gnus ((,class :foreground ,magenta))) - `(helm-bookmark-info ((,class :foreground ,cyan-alt))) - `(helm-bookmark-man ((,class :foreground ,yellow-alt))) - `(helm-bookmark-w3m ((,class :foreground ,blue-alt))) - `(helm-buffer-archive ((,class :inherit bold :foreground ,cyan))) - `(helm-buffer-directory ((,class :inherit bold :foreground ,blue))) - `(helm-buffer-file ((,class :foreground ,fg-main))) - `(helm-buffer-modified ((,class :foreground ,yellow-alt))) - `(helm-buffer-not-saved ((,class :foreground ,red-alt))) - `(helm-buffer-process ((,class :foreground ,magenta))) - `(helm-buffer-saved-out ((,class :inherit bold :background ,bg-alt :foreground ,red))) - `(helm-buffer-size ((,class :inherit shadow))) - `(helm-candidate-number ((,class :foreground ,cyan-active))) - `(helm-candidate-number-suspended ((,class :foreground ,yellow-active))) - `(helm-comint-prompts-buffer-name ((,class :foreground ,green-active))) - `(helm-comint-prompts-promptidx ((,class :foreground ,cyan-active))) - `(helm-delete-async-message ((,class :inherit bold :foreground ,magenta-active))) - `(helm-eob-line ((,class :background ,bg-main :foreground ,fg-main))) - `(helm-eshell-prompts-buffer-name ((,class :foreground ,green-active))) - `(helm-eshell-prompts-promptidx ((,class :foreground ,cyan-active))) - `(helm-etags-file ((,class :foreground ,fg-dim :underline t))) - `(helm-ff-backup-file ((,class :inherit shadow))) - `(helm-ff-denied ((,class :inherit modus-themes-intense-red))) - `(helm-ff-directory ((,class :inherit helm-buffer-directory))) - `(helm-ff-dirs ((,class :inherit bold :foreground ,blue-alt-other))) - `(helm-ff-dotted-directory ((,class :inherit bold :background ,bg-alt :foreground ,fg-alt))) - `(helm-ff-dotted-symlink-directory ((,class :inherit (button helm-ff-dotted-directory)))) - `(helm-ff-executable ((,class :foreground ,magenta-alt))) - `(helm-ff-file ((,class :foreground ,fg-main))) - `(helm-ff-file-extension ((,class :foreground ,fg-special-warm))) - `(helm-ff-invalid-symlink ((,class :inherit modus-themes-link-broken))) - `(helm-ff-pipe ((,class :inherit modus-themes-special-calm))) - `(helm-ff-prefix ((,class :inherit modus-themes-special-warm))) - `(helm-ff-socket ((,class :foreground ,red-alt-other))) - `(helm-ff-suid ((,class :inherit modus-themes-special-warm))) - `(helm-ff-symlink ((,class :inherit modus-themes-link-symlink))) - `(helm-ff-truename ((,class :foreground ,blue-alt-other))) - `(helm-fd-finish ((,class :inherit success))) - `(helm-grep-cmd-line ((,class :foreground ,yellow-alt-other))) - `(helm-grep-file ((,class :inherit bold :foreground ,fg-special-cold))) - `(helm-grep-finish ((,class :inherit bold))) - `(helm-grep-lineno ((,class :foreground ,fg-special-warm))) - `(helm-grep-match ((,class :inherit modus-themes-special-calm))) - `(helm-header ((,class :inherit bold :foreground ,fg-special-cold))) - `(helm-header-line-left-margin ((,class :inherit bold :foreground ,yellow-intense))) - `(helm-history-deleted ((,class :inherit modus-themes-special-warm))) - `(helm-history-remote ((,class :foreground ,red-alt-other))) - `(helm-lisp-completion-info ((,class :inherit modus-themes-bold :foreground ,fg-special-cold))) - `(helm-lisp-show-completion ((,class :inherit modus-themes-special-warm))) - `(helm-locate-finish ((,class :inherit success))) - `(helm-match ((,class :inherit modus-themes-completion-match-0))) - `(helm-match-item ((,class :inherit helm-match))) - `(helm-minibuffer-prompt ((,class :inherit modus-themes-prompt))) - `(helm-moccur-buffer ((,class :inherit button :foreground ,cyan-alt-other))) - `(helm-mode-prefix ((,class :inherit modus-themes-special-calm))) - `(helm-non-file-buffer ((,class :inherit shadow))) - `(helm-prefarg ((,class :foreground ,red-active))) - `(helm-resume-need-update ((,class :inherit modus-themes-special-calm))) - `(helm-selection ((,class :inherit modus-themes-completion-selected))) - `(helm-selection-line ((,class :background ,bg-hl-alt-intense))) - `(helm-separator ((,class :foreground ,fg-special-mild))) - `(helm-time-zone-current ((,class :foreground ,green))) - `(helm-time-zone-home ((,class :foreground ,magenta))) - `(helm-source-header ((,class :inherit modus-themes-pseudo-header :foreground ,fg-special-warm))) - `(helm-top-columns ((,class :inherit helm-header))) - `(helm-ucs-char ((,class :foreground ,yellow-alt-other))) - `(helm-visible-mark ((,class :inherit modus-themes-subtle-cyan))) -;;;;; helm-ls-git - `(helm-ls-git-added-copied-face ((,class :foreground ,green-intense))) - `(helm-ls-git-added-modified-face ((,class :foreground ,yellow-intense))) - `(helm-ls-git-conflict-face ((,class :inherit bold :foreground ,red-intense))) - `(helm-ls-git-deleted-and-staged-face ((,class :foreground ,red-nuanced-fg))) - `(helm-ls-git-deleted-not-staged-face ((,class :foreground ,red))) - `(helm-ls-git-modified-and-staged-face ((,class :foreground ,yellow-nuanced-fg))) - `(helm-ls-git-modified-not-staged-face ((,class :foreground ,yellow))) - `(helm-ls-git-renamed-modified-face ((,class :foreground ,magenta))) - `(helm-ls-git-untracked-face ((,class :foreground ,fg-special-cold))) -;;;;; helm-switch-shell - `(helm-switch-shell-new-shell-face ((,class :inherit modus-themes-completion-match-0))) -;;;;; helm-xref - `(helm-xref-file-name ((,class :inherit modus-themes-bold :foreground ,fg-special-cold))) + `(golden-ratio-scroll-highlight-line-face ((,c :background ,bg-cyan-subtle :foreground ,fg-main))) ;;;;; helpful - `(helpful-heading ((,class :inherit modus-themes-heading-1))) + `(helpful-heading ((,c :inherit modus-themes-heading-1))) ;;;;; highlight region or ad-hoc regexp ;; HACK 2022-06-23: The :inverse-video prevents hl-line-mode from ;; overriding the background. Such an override really defeats the ;; purpose of setting those highlights. ;; - ;; NOTE 2022-10-04: We do not use the ,class here but instead + ;; NOTE 2022-10-04: We do not use the ,c here but instead ;; hardcode color values. We have to do this as the themes lack ;; entries in their palette for such an edge case. Defining those ;; entries is not appropriate. @@ -5714,26 +2475,26 @@ by virtue of calling either of `modus-themes-load-operandi' and :background "white" :foreground "#227f9f" :inverse-video t) (((class color) (min-colors 88) (background dark)) :background "black" :foreground "#66cbdc" :inverse-video t))) - `(hi-black-b ((,class :inverse-video t))) - `(hi-black-hb ((,class :background ,bg-main :foreground ,fg-alt :inverse-video t))) + `(hi-black-b ((,c :inverse-video t))) + `(hi-black-hb ((,c :background ,bg-main :foreground ,fg-dim :inverse-video t))) `(hi-blue ((((class color) (min-colors 88) (background light)) :background "white" :foreground "#3366dd" :inverse-video t) (((class color) (min-colors 88) (background dark)) :background "black" :foreground "#aaccff" :inverse-video t))) - `(hi-blue-b ((,class :inherit (bold hi-blue)))) + `(hi-blue-b ((,c :inherit (bold hi-blue)))) `(hi-green ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#008a00" :inverse-video t) - (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#66dd66" :inverse-video t))) - `(hi-green-b ((,class :inherit (bold hi-green)))) + :background "white" :foreground "#008a00" :inverse-video t) + (((class color) (min-colors 88) (background dark)) + :background "black" :foreground "#66dd66" :inverse-video t))) + `(hi-green-b ((,c :inherit (bold hi-green)))) `(hi-pink ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#bd30aa" :inverse-video t) - (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#ff88ee" :inverse-video t))) + :background "white" :foreground "#bd30aa" :inverse-video t) + (((class color) (min-colors 88) (background dark)) + :background "black" :foreground "#ff88ee" :inverse-video t))) `(hi-red-b ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#dd0000" :inverse-video t) - (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#f06666" :inverse-video t))) + :background "white" :foreground "#dd0000" :inverse-video t) + (((class color) (min-colors 88) (background dark)) + :background "black" :foreground "#f06666" :inverse-video t))) `(hi-salmon ((((class color) (min-colors 88) (background light)) :background "white" :foreground "#bf555a" :inverse-video t) (((class color) (min-colors 88) (background dark)) @@ -5742,1734 +2503,1298 @@ by virtue of calling either of `modus-themes-load-operandi' and :background "white" :foreground "#af6400" :inverse-video t) (((class color) (min-colors 88) (background dark)) :background "black" :foreground "#faea00" :inverse-video t))) - `(highlight ((,class ,@(if modus-themes-intense-mouseovers - (list :background blue-intense-bg :foreground fg-main) - (list :background cyan-subtle-bg :foreground fg-main))))) - `(highlight-changes ((,class :foreground ,red-alt :underline nil))) - `(highlight-changes-delete ((,class :background ,red-nuanced-bg - :foreground ,red :underline t))) - `(hl-line ((,class :inherit modus-themes-hl-line))) -;;;;; highlight-indentation - `(highlight-indentation-face ((,class :inherit modus-themes-hl-line))) - `(highlight-indentation-current-column-face ((,class :background ,bg-active))) + `(highlight-changes ((,c :foreground ,warning :underline nil))) + `(highlight-changes-delete ((,c :foreground ,err :underline t))) + `(hl-line ((,c :background ,bg-hl-line :extend t))) ;;;;; highlight-numbers - `(highlight-numbers-number ((,class :foreground ,blue-alt-other))) + `(highlight-numbers-number ((,c :foreground ,constant))) ;;;;; highlight-thing - `(highlight-thing ((,class :inherit modus-themes-special-calm))) -;;;;; hl-defined - `(hdefd-functions ((,class :foreground ,blue))) - `(hdefd-undefined ((,class :foreground ,red-alt))) - `(hdefd-variables ((,class :foreground ,cyan-alt))) + `(highlight-thing ((,c :inherit match))) ;;;;; hl-fill-column - `(hl-fill-column-face ((,class :background ,bg-active :foreground ,fg-active))) + `(hl-fill-column-face ((,c :background ,bg-active))) ;;;;; hl-todo - `(hl-todo ((,class :inherit (bold modus-themes-slant) :foreground ,red-alt-other))) + `(hl-todo ((,c :inherit (bold font-lock-comment-face) :foreground ,err))) ;;;;; hydra - `(hydra-face-amaranth ((,class :inherit bold :foreground ,yellow-alt))) - `(hydra-face-blue ((,class :inherit bold :foreground ,blue))) - `(hydra-face-pink ((,class :inherit bold :foreground ,magenta-alt-faint))) - `(hydra-face-red ((,class :inherit bold :foreground ,red-faint))) - `(hydra-face-teal ((,class :inherit bold :foreground ,cyan-alt-other))) + `(hydra-face-amaranth ((,c :inherit bold :foreground ,yellow-warmer))) + `(hydra-face-blue ((,c :inherit bold :foreground ,blue))) + `(hydra-face-pink ((,c :inherit bold :foreground ,magenta))) + `(hydra-face-red ((,c :inherit bold :foreground ,red-faint))) + `(hydra-face-teal ((,c :inherit bold :foreground ,cyan-cooler))) ;;;;; icomplete - `(icomplete-first-match ((,class :inherit modus-themes-completion-match-0))) - `(icomplete-selected-match ((,class :inherit modus-themes-completion-selected))) -;;;;; icomplete-vertical - `(icomplete-vertical-separator ((,class :inherit shadow))) + `(icomplete-first-match ((,c :inherit modus-themes-completion-match-0))) + `(icomplete-selected-match ((,c :inherit modus-themes-completion-selected))) ;;;;; ido-mode - `(ido-first-match ((,class :inherit modus-themes-completion-match-0))) - `(ido-incomplete-regexp ((,class :inherit error))) - `(ido-indicator ((,class :inherit modus-themes-subtle-yellow))) - `(ido-only-match ((,class :inherit ido-first-match))) - `(ido-subdir ((,class :foreground ,blue))) - `(ido-virtual ((,class :foreground ,magenta-alt-other))) + `(ido-first-match ((,c :inherit modus-themes-completion-match-0))) + `(ido-incomplete-regexp ((,c :inherit error))) + `(ido-indicator ((,c :inherit bold))) + `(ido-only-match ((,c :inherit ido-first-match))) + `(ido-subdir ((,c :foreground ,accent-0))) + `(ido-virtual ((,c :foreground ,accent-1))) ;;;;; iedit - `(iedit-occurrence ((,class :inherit modus-themes-refine-blue))) - `(iedit-read-only-occurrence ((,class :inherit modus-themes-intense-yellow))) + `(iedit-occurrence ((,c :inherit modus-themes-intense-blue))) + `(iedit-read-only-occurrence ((,c :inherit modus-themes-intense-yellow))) ;;;;; iflipb - `(iflipb-current-buffer-face ((,class :inherit bold :foreground ,cyan-alt))) - `(iflipb-other-buffer-face ((,class :inherit shadow))) + `(iflipb-current-buffer-face ((,c :inherit bold :foreground ,name))) + `(iflipb-other-buffer-face ((,c :inherit shadow))) ;;;;; image-dired - `(image-dired-thumb-flagged ((,class :background ,red-intense-bg))) - `(image-dired-thumb-header-file-name ((,class :inherit bold))) - `(image-dired-thumb-header-file-size ((,class :foreground ,blue-active))) - `(image-dired-thumb-mark ((,class :inherit modus-themes-grue-background-intense))) + `(image-dired-thumb-flagged ((,c :inherit modus-themes-intense-red))) + `(image-dired-thumb-header-file-name ((,c :inherit bold))) + `(image-dired-thumb-header-file-size ((,c :foreground ,constant))) + `(image-dired-thumb-mark ((,c :inherit modus-themes-intense-cyan))) ;;;;; imenu-list - `(imenu-list-entry-face-0 ((,class :foreground ,cyan))) - `(imenu-list-entry-face-1 ((,class :foreground ,blue))) - `(imenu-list-entry-face-2 ((,class :foreground ,cyan-alt-other))) - `(imenu-list-entry-face-3 ((,class :foreground ,blue-alt))) - `(imenu-list-entry-subalist-face-0 ((,class :inherit bold :foreground ,magenta-alt-other :underline t))) - `(imenu-list-entry-subalist-face-1 ((,class :inherit bold :foreground ,magenta :underline t))) - `(imenu-list-entry-subalist-face-2 ((,class :inherit bold :foreground ,green-alt-other :underline t))) - `(imenu-list-entry-subalist-face-3 ((,class :inherit bold :foreground ,red-alt-other :underline t))) + `(imenu-list-entry-face-0 ((,c :foreground ,fg-heading-0))) + `(imenu-list-entry-face-1 ((,c :foreground ,fg-heading-1))) + `(imenu-list-entry-face-2 ((,c :foreground ,fg-heading-2))) + `(imenu-list-entry-face-3 ((,c :foreground ,fg-heading-3))) + `(imenu-list-entry-subalist-face-0 ((,c :inherit bold :foreground ,fg-heading-4 :underline t))) + `(imenu-list-entry-subalist-face-1 ((,c :inherit bold :foreground ,fg-heading-5 :underline t))) + `(imenu-list-entry-subalist-face-2 ((,c :inherit bold :foreground ,fg-heading-6 :underline t))) + `(imenu-list-entry-subalist-face-3 ((,c :inherit bold :foreground ,fg-heading-7 :underline t))) ;;;;; indium - `(indium-breakpoint-face ((,class :foreground ,red-active))) - `(indium-frame-url-face ((,class :inherit (shadow button)))) - `(indium-keyword-face ((,class :inherit font-lock-keyword-face))) - `(indium-litable-face ((,class :inherit modus-themes-slant :foreground ,fg-special-warm))) - `(indium-repl-error-face ((,class :inherit error))) - `(indium-repl-prompt-face ((,class :inherit modus-themes-prompt))) - `(indium-repl-stdout-face ((,class :foreground ,fg-main))) + `(indium-breakpoint-face ((,c :foreground ,err))) + `(indium-frame-url-face ((,c :inherit (shadow button)))) + `(indium-keyword-face ((,c :inherit font-lock-keyword-face))) + `(indium-litable-face ((,c :inherit modus-themes-slant))) + `(indium-repl-error-face ((,c :inherit error))) + `(indium-repl-prompt-face ((,c :inherit modus-themes-prompt))) + `(indium-repl-stdout-face (( ))) ;;;;; info - `(Info-quoted ((,class :inherit modus-themes-markup-verbatim))) ; the capitalization is canonical - `(info-header-node ((,class :inherit (shadow bold)))) - `(info-header-xref ((,class :foreground ,blue-active))) - `(info-index-match ((,class :inherit match))) - `(info-menu-header ((,class :inherit modus-themes-pseudo-header))) - `(info-menu-star ((,class :foreground ,red))) - `(info-node ((,class :inherit bold))) - `(info-title-1 ((,class :inherit modus-themes-heading-1))) - `(info-title-2 ((,class :inherit modus-themes-heading-2))) - `(info-title-3 ((,class :inherit modus-themes-heading-3))) - `(info-title-4 ((,class :inherit modus-themes-heading-4))) + `(Info-quoted ((,c :inherit modus-themes-prose-verbatim))) ; the capitalization is canonical + `(info-header-node ((,c :inherit (shadow bold)))) + `(info-header-xref ((,c :foreground ,fg-link))) + `(info-index-match ((,c :inherit match))) + `(info-menu-header ((,c :inherit bold))) + `(info-menu-star ((,c :foreground ,red-intense))) + `(info-node ((,c :inherit bold))) + `(info-title-1 ((,c :inherit modus-themes-heading-1))) + `(info-title-2 ((,c :inherit modus-themes-heading-2))) + `(info-title-3 ((,c :inherit modus-themes-heading-3))) + `(info-title-4 ((,c :inherit modus-themes-heading-4))) ;;;;; info+ (info-plus) - `(info-command-ref-item ((,class :inherit font-lock-function-name-face))) - `(info-constant-ref-item ((,class :inherit font-lock-constant-face))) - `(info-custom-delimited ((,class :inherit modus-themes-markup-verbatim))) - `(info-double-quoted-name ((,class :inherit font-lock-string-face))) + `(info-command-ref-item ((,c :inherit font-lock-function-name-face))) + `(info-constant-ref-item ((,c :inherit font-lock-constant-face))) + `(info-custom-delimited ((,c :inherit modus-themes-prose-verbatim))) + `(info-double-quoted-name ((,c :inherit font-lock-string-face))) `(info-file (( ))) - `(info-function-ref-item ((,class :inherit font-lock-function-name-face))) - `(info-glossary-word ((,class :inherit modus-themes-box-button))) + `(info-function-ref-item ((,c :inherit font-lock-function-name-face))) + `(info-glossary-word ((,c :inherit modus-themes-button))) `(info-indented-text (( ))) `(info-isolated-backquote (( ))) `(info-isolated-quote (( ))) - `(info-macro-ref-item ((,class :inherit font-lock-keyword-face))) - `(info-menu ((,class :inherit bold))) - `(info-quoted-name ((,class :inherit modus-themes-markup-verbatim))) - `(info-reference-item ((,class :inherit bold))) - `(info-special-form-ref-item ((,class :inherit warning))) - `(info-string ((,class :inherit font-lock-string-face))) - `(info-syntax-class-item ((,class :inherit modus-themes-markup-code))) - `(info-user-option-ref-item ((,class :inherit font-lock-variable-name-face))) - `(info-variable-ref-item ((,class :inherit font-lock-variable-name-face))) + `(info-macro-ref-item ((,c :inherit font-lock-keyword-face))) + `(info-menu ((,c :inherit bold))) + `(info-quoted-name ((,c :inherit modus-themes-prose-verbatim))) + `(info-reference-item ((,c :inherit bold))) + `(info-special-form-ref-item ((,c :inherit warning))) + `(info-string ((,c :inherit font-lock-string-face))) + `(info-syntax-class-item ((,c :inherit modus-themes-prose-code))) + `(info-user-option-ref-item ((,c :inherit font-lock-variable-name-face))) + `(info-variable-ref-item ((,c :inherit font-lock-variable-name-face))) ;;;;; info-colors - `(info-colors-lisp-code-block ((,class :inherit modus-themes-fixed-pitch))) - `(info-colors-ref-item-command ((,class :inherit font-lock-function-name-face))) - `(info-colors-ref-item-constant ((,class :inherit font-lock-constant-face))) - `(info-colors-ref-item-function ((,class :inherit font-lock-function-name-face))) - `(info-colors-ref-item-macro ((,class :inherit font-lock-keyword-face))) - `(info-colors-ref-item-other ((,class :inherit font-lock-doc-face))) - `(info-colors-ref-item-special-form ((,class :inherit font-lock-keyword-face))) - `(info-colors-ref-item-syntax-class ((,class :inherit font-lock-builtin-face))) - `(info-colors-ref-item-type ((,class :inherit font-lock-type-face))) - `(info-colors-ref-item-user-option ((,class :inherit font-lock-variable-name-face))) - `(info-colors-ref-item-variable ((,class :inherit font-lock-variable-name-face))) -;;;;; interaction-log - `(ilog-buffer-face ((,class :foreground ,magenta-alt-other))) - `(ilog-change-face ((,class :foreground ,magenta-alt))) - `(ilog-echo-face ((,class :foreground ,yellow-alt-other))) - `(ilog-load-face ((,class :foreground ,green))) - `(ilog-message-face ((,class :inherit shadow))) - `(ilog-non-change-face ((,class :foreground ,blue))) + `(info-colors-lisp-code-block ((,c :inherit modus-themes-fixed-pitch))) + `(info-colors-ref-item-command ((,c :inherit font-lock-function-name-face))) + `(info-colors-ref-item-constant ((,c :inherit font-lock-constant-face))) + `(info-colors-ref-item-function ((,c :inherit font-lock-function-name-face))) + `(info-colors-ref-item-macro ((,c :inherit font-lock-keyword-face))) + `(info-colors-ref-item-other ((,c :inherit font-lock-doc-face))) + `(info-colors-ref-item-special-form ((,c :inherit font-lock-keyword-face))) + `(info-colors-ref-item-syntax-class ((,c :inherit font-lock-builtin-face))) + `(info-colors-ref-item-type ((,c :inherit font-lock-type-face))) + `(info-colors-ref-item-user-option ((,c :inherit font-lock-variable-name-face))) + `(info-colors-ref-item-variable ((,c :inherit font-lock-variable-name-face))) ;;;;; ioccur - `(ioccur-cursor ((,class :foreground ,fg-main))) - `(ioccur-invalid-regexp ((,class :foreground ,red))) - `(ioccur-match-face ((,class :inherit modus-themes-special-calm))) - `(ioccur-match-overlay-face ((,class :inherit modus-themes-special-cold :extend t))) - `(ioccur-num-line-face ((,class :foreground ,fg-special-warm))) - `(ioccur-overlay-face ((,class :inherit modus-themes-refine-blue :extend t))) - `(ioccur-regexp-face ((,class :inherit (modus-themes-intense-magenta bold)))) - `(ioccur-title-face ((,class :inherit modus-themes-pseudo-header :foreground ,fg-special-cold))) + `(ioccur-cursor ((,c :foreground ,fg-main))) + `(ioccur-invalid-regexp ((,c :inherit error))) + `(ioccur-match-face ((,c :inherit match))) + `(ioccur-match-overlay-face ((,c :background ,bg-inactive :extend t))) + `(ioccur-num-line-face ((,c :inherit shadow))) + `(ioccur-overlay-face ((,c :background ,bg-hl-line :extend t))) + `(ioccur-regexp-face ((,c :inherit (modus-themes-search-current bold)))) + `(ioccur-title-face ((,c :inherit bold :foreground ,name))) ;;;;; isearch, occur, and the like - `(isearch ((,class :inherit modus-themes-search-success))) - `(isearch-fail ((,class :inherit modus-themes-refine-red))) - `(isearch-group-1 ((,class :inherit modus-themes-refine-blue))) - `(isearch-group-2 ((,class :inherit modus-themes-refine-magenta))) - `(lazy-highlight ((,class :inherit modus-themes-search-success-lazy))) - `(match ((,class :inherit modus-themes-special-calm))) - `(query-replace ((,class :inherit modus-themes-intense-red))) + `(isearch ((,c :inherit modus-themes-search-current))) + `(isearch-fail ((,c :inherit modus-themes-intense-red))) + `(isearch-group-1 ((,c :inherit modus-themes-intense-blue))) + `(isearch-group-2 ((,c :inherit modus-themes-intense-magenta))) + `(lazy-highlight ((,c :inherit modus-themes-search-lazy))) + `(match ((,c :background ,bg-magenta-subtle :foreground ,fg-main))) + `(query-replace ((,c :inherit modus-themes-intense-red))) ;;;;; ivy - `(ivy-action ((,class :inherit modus-themes-key-binding))) - `(ivy-confirm-face ((,class :inherit success))) - `(ivy-current-match ((,class :inherit modus-themes-completion-selected))) - `(ivy-cursor ((,class :background ,fg-main :foreground ,bg-main))) - `(ivy-highlight-face ((,class :foreground ,magenta))) - `(ivy-match-required-face ((,class :inherit error))) + `(ivy-action ((,c :inherit modus-themes-key-binding))) + `(ivy-confirm-face ((,c :inherit success))) + `(ivy-current-match ((,c :inherit modus-themes-completion-selected))) + `(ivy-match-required-face ((,c :inherit error))) `(ivy-minibuffer-match-face-1 (( ))) - `(ivy-minibuffer-match-face-2 ((,class :inherit modus-themes-completion-match-0))) - `(ivy-minibuffer-match-face-3 ((,class :inherit modus-themes-completion-match-1))) - `(ivy-minibuffer-match-face-4 ((,class :inherit modus-themes-completion-match-2))) - `(ivy-org ((,class :foreground ,cyan-alt-other))) - `(ivy-remote ((,class :foreground ,magenta))) - `(ivy-separator ((,class :inherit shadow))) - `(ivy-subdir ((,class :foreground ,blue))) - `(ivy-virtual ((,class :foreground ,magenta-alt-other))) + `(ivy-minibuffer-match-face-2 ((,c :inherit modus-themes-completion-match-0))) + `(ivy-minibuffer-match-face-3 ((,c :inherit modus-themes-completion-match-1))) + `(ivy-minibuffer-match-face-4 ((,c :inherit modus-themes-completion-match-2))) + `(ivy-remote ((,c :inherit italic))) + `(ivy-separator ((,c :inherit shadow))) + `(ivy-subdir ((,c :foreground ,accent-0))) + `(ivy-virtual ((,c :foreground ,accent-1))) ;;;;; ivy-posframe - `(ivy-posframe-border ((,class :background ,fg-window-divider-inner))) - `(ivy-posframe-cursor ((,class :background ,fg-main :foreground ,bg-main))) + `(ivy-posframe-border ((,c :background ,border))) + `(ivy-posframe-cursor ((,c :background ,fg-main :foreground ,bg-main))) ;;;;; jira (org-jira) - `(jiralib-comment-face ((,class :background ,bg-alt))) - `(jiralib-comment-header-face ((,class :inherit bold))) - `(jiralib-issue-info-face ((,class :inherit modus-themes-special-warm))) - `(jiralib-issue-info-header-face ((,class :inherit (modus-themes-special-warm bold)))) - `(jiralib-issue-summary-face ((,class :inherit bold))) - `(jiralib-link-filter-face ((,class :underline t))) - `(jiralib-link-issue-face ((,class :underline t))) - `(jiralib-link-project-face ((,class :underline t))) + `(jiralib-comment-face ((,c :background ,bg-inactive))) + `(jiralib-comment-header-face ((,c :inherit bold))) + `(jiralib-issue-info-face ((,c :background ,bg-inactive))) + `(jiralib-issue-info-header-face ((,c :inherit bold :background ,bg-inactive))) + `(jiralib-issue-summary-face ((,c :inherit bold))) + `(jiralib-link-filter-face ((,c :underline t))) + `(jiralib-link-issue-face ((,c :underline t))) + `(jiralib-link-project-face ((,c :underline t))) ;;;;; journalctl-mode - `(journalctl-error-face ((,class :inherit error))) - `(journalctl-finished-face ((,class :inherit success))) - `(journalctl-host-face ((,class :foreground ,blue))) - `(journalctl-process-face ((,class :foreground ,cyan-alt-other))) - `(journalctl-starting-face ((,class :foreground ,green))) - `(journalctl-timestamp-face ((,class :foreground ,fg-special-cold))) - `(journalctl-warning-face ((,class :inherit warning))) + `(journalctl-error-face ((,c :inherit error))) + `(journalctl-finished-face ((,c :inherit success))) + `(journalctl-host-face ((,c :foreground ,name))) + `(journalctl-process-face ((,c :foreground ,warning))) + `(journalctl-starting-face ((,c :foreground ,info))) + `(journalctl-timestamp-face ((,c :foreground ,date-common))) + `(journalctl-warning-face ((,c :inherit warning))) ;;;;; js2-mode - `(js2-error ((,class :inherit modus-themes-lang-error))) - `(js2-external-variable ((,class :inherit font-lock-variable-name-face))) - `(js2-function-call ((,class :inherit font-lock-function-name-face))) - `(js2-function-param ((,class :inherit font-lock-constant-face))) - `(js2-instance-member ((,class :inherit font-lock-keyword-face))) - `(js2-jsdoc-html-tag-delimiter ((,class :foreground ,fg-main))) - `(js2-jsdoc-html-tag-name ((,class :inherit font-lock-function-name-face))) - `(js2-jsdoc-tag ((,class :inherit (font-lock-builtin-face font-lock-comment-face) :weight normal))) - `(js2-jsdoc-type ((,class :inherit (font-lock-type-face font-lock-comment-face) :weight normal))) - `(js2-jsdoc-value ((,class :inherit (font-lock-constant-face font-lock-comment-face) :weight normal))) - `(js2-object-property ((,class :foreground ,fg-main))) - `(js2-object-property-access ((,class :foreground ,fg-main))) - `(js2-private-function-call ((,class :inherit font-lock-preprocessor-face))) - `(js2-private-member ((,class :inherit font-lock-warning-face))) - `(js2-warning ((,class :inherit modus-themes-lang-warning))) + `(js2-error ((,c :inherit modus-themes-lang-error))) + `(js2-external-variable ((,c :inherit font-lock-variable-name-face))) + `(js2-function-call ((,c :inherit font-lock-function-name-face))) + `(js2-function-param ((,c :inherit font-lock-constant-face))) + `(js2-instance-member ((,c :inherit font-lock-keyword-face))) + `(js2-jsdoc-html-tag-delimiter ((,c :foreground ,fg-main))) + `(js2-jsdoc-html-tag-name ((,c :inherit font-lock-function-name-face))) + `(js2-jsdoc-tag ((,c :inherit (font-lock-builtin-face font-lock-comment-face) :weight normal))) + `(js2-jsdoc-type ((,c :inherit (font-lock-type-face font-lock-comment-face) :weight normal))) + `(js2-jsdoc-value ((,c :inherit (font-lock-constant-face font-lock-comment-face) :weight normal))) + `(js2-object-property ((,c :foreground ,fg-main))) + `(js2-object-property-access ((,c :foreground ,fg-main))) + `(js2-private-function-call ((,c :inherit font-lock-preprocessor-face))) + `(js2-private-member ((,c :inherit font-lock-warning-face))) + `(js2-warning ((,c :inherit modus-themes-lang-warning))) ;;;;; julia - `(julia-macro-face ((,class :inherit font-lock-builtin-face))) - `(julia-quoted-symbol-face ((,class :inherit font-lock-constant-face))) -;;;;; jupyter - `(jupyter-eval-overlay ((,class :inherit bold :foreground ,blue))) - `(jupyter-repl-input-prompt ((,class :foreground ,cyan-alt-other))) - `(jupyter-repl-output-prompt ((,class :foreground ,magenta-alt-other))) - `(jupyter-repl-traceback ((,class :inherit modus-themes-intense-red))) + `(julia-macro-face ((,c :inherit font-lock-builtin-face))) + `(julia-quoted-symbol-face ((,c :inherit font-lock-constant-face))) ;;;;; kaocha-runner - `(kaocha-runner-error-face ((,class :inherit error))) - `(kaocha-runner-success-face ((,class :inherit success))) - `(kaocha-runner-warning-face ((,class :inherit warning))) + `(kaocha-runner-error-face ((,c :inherit error))) + `(kaocha-runner-success-face ((,c :inherit success))) + `(kaocha-runner-warning-face ((,c :inherit warning))) ;;;;; keycast - `(keycast-command ((,class :inherit bold :foreground ,blue-active))) - ;; FIXME 2022-05-03: The padding breaks `keycast-tab-bar-mode' - `(keycast-key ((,class ;; ,@(modus-themes--mode-line-padded-box blue-active) - :background ,blue-active :foreground ,bg-main))) + `(keycast-command ((,c :inherit bold))) + `(keycast-key ((,c :background ,keybind :foreground ,bg-main))) ;;;;; ledger-mode - `(ledger-font-auto-xact-face ((,class :foreground ,magenta))) - `(ledger-font-account-name-face ((,class :foreground ,fg-special-cold))) - `(ledger-font-directive-face ((,class :foreground ,magenta-alt-other))) - `(ledger-font-posting-date-face ((,class :inherit bold :foreground ,fg-main))) - `(ledger-font-periodic-xact-face ((,class :foreground ,cyan-alt-other))) - `(ledger-font-posting-amount-face ((,class :foreground ,fg-special-mild))) - `(ledger-font-payee-cleared-face ((,class :foreground ,blue-alt))) - `(ledger-font-payee-pending-face ((,class :foreground ,yellow))) - `(ledger-font-payee-uncleared-face ((,class :foreground ,red-alt-other))) - `(ledger-font-xact-highlight-face ((,class :background ,bg-hl-alt))) + `(ledger-font-auto-xact-face ((,c :inherit font-lock-builtin-face))) + `(ledger-font-account-name-face ((,c :foreground ,name))) + `(ledger-font-directive-face ((,c :inherit font-lock-keyword-face))) + `(ledger-font-posting-date-face ((,c :inherit modus-themes-bold :foreground ,date-common))) + `(ledger-font-periodic-xact-face ((,c :inherit font-lock-variable-name-face))) + `(ledger-font-posting-amount-face ((,c :inherit font-lock-constant-face))) + `(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 :background ,bg-hl-line :extend t))) ;;;;; leerzeichen - `(leerzeichen ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) + `(leerzeichen ((,c :background ,bg-inactive))) ;;;;; line numbers (display-line-numbers-mode and global variant) ;; Here we cannot inherit `modus-themes-fixed-pitch'. We need to ;; fall back to `default' otherwise line numbers do not scale when ;; using `text-scale-adjust'. - `(line-number - ((,class :inherit ,(if modus-themes-mixed-fonts '(fixed-pitch default) 'default) - ,@(modus-themes--line-numbers - fg-alt bg-dim - fg-unfocused)))) - `(line-number-current-line - ((,class :inherit (bold line-number) - ,@(modus-themes--line-numbers - fg-main bg-active - blue-alt-other)))) - `(line-number-major-tick - ((,class :inherit (bold line-number) - ,@(modus-themes--line-numbers - yellow-nuanced-fg yellow-nuanced-bg - red-alt)))) - `(line-number-minor-tick - ((,class :inherit (bold line-number) - ,@(modus-themes--line-numbers - fg-alt bg-inactive - fg-inactive)))) -;;;;; lsp-mode - `(lsp-face-highlight-read ((,class :inherit modus-themes-subtle-blue :underline t))) - `(lsp-face-highlight-textual ((,class :inherit modus-themes-subtle-blue))) - `(lsp-face-highlight-write ((,class :inherit (modus-themes-refine-blue bold)))) - `(lsp-face-semhl-constant ((,class :foreground ,blue-alt-other))) - `(lsp-face-semhl-deprecated ((,class :inherit modus-themes-lang-warning))) - `(lsp-face-semhl-enummember ((,class :foreground ,blue-alt-other))) - `(lsp-face-semhl-field ((,class :foreground ,cyan-alt))) - `(lsp-face-semhl-field-static ((,class :inherit modus-themes-slant :foreground ,cyan-alt))) - `(lsp-face-semhl-function ((,class :foreground ,magenta))) - `(lsp-face-semhl-method ((,class :foreground ,magenta))) - `(lsp-face-semhl-namespace ((,class :inherit modus-themes-bold :foreground ,magenta-alt))) - `(lsp-face-semhl-preprocessor ((,class :foreground ,red-alt-other))) - `(lsp-face-semhl-static-method ((,class :inherit modus-themes-slant :foreground ,magenta))) - `(lsp-face-semhl-type-class ((,class :foreground ,magenta-alt))) - `(lsp-face-semhl-type-enum ((,class :foreground ,magenta-alt))) - `(lsp-face-semhl-type-primitive ((,class :inherit modus-themes-slant :foreground ,magenta-alt))) - `(lsp-face-semhl-type-template ((,class :inherit modus-themes-slant :foreground ,magenta-alt))) - `(lsp-face-semhl-type-typedef ((,class :inherit modus-themes-slant :foreground ,magenta-alt))) - `(lsp-face-semhl-variable ((,class :foreground ,cyan))) - `(lsp-face-semhl-variable-local ((,class :foreground ,cyan))) - `(lsp-face-semhl-variable-parameter ((,class :foreground ,cyan-alt-other))) - `(lsp-lens-face ((,class :inherit shadow :height 0.8))) - `(lsp-lens-mouse-face ((,class :height 0.8 :foreground ,blue-alt-other :underline t))) - `(lsp-ui-doc-background ((,class :background ,bg-alt))) - `(lsp-ui-doc-header ((,class :background ,bg-header :foreground ,fg-header))) - `(lsp-ui-doc-url ((,class :inherit button))) - `(lsp-ui-peek-filename ((,class :foreground ,fg-special-warm))) - `(lsp-ui-peek-footer ((,class :background ,bg-header :foreground ,fg-header))) - `(lsp-ui-peek-header ((,class :background ,bg-header :foreground ,fg-header))) - `(lsp-ui-peek-highlight ((,class :inherit modus-themes-subtle-blue))) - `(lsp-ui-peek-line-number ((,class :inherit shadow))) - `(lsp-ui-peek-list ((,class :background ,bg-dim))) - `(lsp-ui-peek-peek ((,class :background ,bg-alt))) - `(lsp-ui-peek-selection ((,class :inherit modus-themes-subtle-cyan))) - `(lsp-ui-sideline-code-action ((,class :foreground ,yellow))) - `(lsp-ui-sideline-current-symbol ((,class :inherit bold :height 0.99 :box (:line-width -1 :style nil) :foreground ,fg-main))) - `(lsp-ui-sideline-symbol ((,class :inherit bold :height 0.99 :box (:line-width -1 :style nil) :foreground ,fg-alt))) - `(lsp-ui-sideline-symbol-info ((,class :inherit italic :height 0.99))) -;;;;; macrostep - `(macrostep-compiler-macro-face ((,class :inherit italic))) - `(macrostep-expansion-highlight-face ((,class :background ,blue-nuanced-bg))) - `(macrostep-gensym-1 ((,class :inherit bold :foreground ,blue :box t))) - `(macrostep-gensym-2 ((,class :inherit bold :foreground ,green :box t))) - `(macrostep-gensym-3 ((,class :inherit bold :foreground ,yellow :box t))) - `(macrostep-gensym-4 ((,class :inherit bold :foreground ,red :box t))) - `(macrostep-gensym-5 ((,class :inherit bold :foreground ,magenta :box t))) - `(macrostep-macro-face ((,class :inherit button :foreground ,green-alt))) + `(line-number ((,c :inherit ,(if modus-themes-mixed-fonts '(fixed-pitch default) 'default) :background ,bg-line-number-inactive :foreground ,fg-line-number-inactive))) + `(line-number-current-line ((,c :inherit (bold line-number) :background ,bg-line-number-active :foreground ,fg-line-number-active))) + `(line-number-major-tick ((,c :inherit line-number :foreground ,err))) + `(line-number-minor-tick ((,c :inherit line-number :foreground ,fg-alt))) ;;;;; magit - `(magit-bisect-bad ((,class :inherit error))) - `(magit-bisect-good ((,class :inherit success))) - `(magit-bisect-skip ((,class :inherit warning))) - `(magit-blame-date ((,class :foreground ,blue))) - `(magit-blame-dimmed ((,class :inherit (shadow modus-themes-reset-hard)))) - `(magit-blame-hash ((,class :foreground ,fg-special-warm))) - `(magit-blame-heading ((,class :inherit modus-themes-reset-hard :background ,bg-alt :extend t))) - `(magit-blame-highlight ((,class :inherit modus-themes-nuanced-cyan))) - `(magit-blame-margin ((,class :inherit (magit-blame-highlight modus-themes-reset-hard)))) - `(magit-blame-name ((,class :foreground ,magenta-alt-other))) - `(magit-blame-summary ((,class :foreground ,cyan-alt-other))) - ;; ;; NOTE 2021-11-23: we do not set the `magit-branch-current' - ;; ;; because its definition checks if the :box attribute can be set - ;; ;; and if not, it uses :inverse-video. Useful for terminal - ;; ;; emulators. - ;; - ;; `(magit-branch-current ((,class :foreground ,blue-alt-other :box t))) - `(magit-branch-local ((,class :foreground ,blue-alt))) - `(magit-branch-remote ((,class :foreground ,magenta-alt))) - `(magit-branch-remote-head ((,class :foreground ,magenta-alt-other :box t))) - `(magit-branch-upstream ((,class :inherit italic))) - `(magit-branch-warning ((,class :inherit warning))) - `(magit-cherry-equivalent ((,class :background ,bg-main :foreground ,magenta-intense))) - `(magit-cherry-unmatched ((,class :background ,bg-main :foreground ,cyan-intense))) - ;; NOTE: here we break from the pattern of inheriting from the - ;; modus-themes-diff-* faces, though only for the standard actions, - ;; not the highlighted ones. This is because Magit's interaction - ;; model relies on highlighting the current diff hunk. - `(magit-diff-added ((,class ,@(modus-themes--diff - bg-diff-added fg-diff-added - green-nuanced-bg fg-diff-added - bg-diff-added-deuteran fg-diff-added-deuteran - blue-nuanced-bg fg-diff-added-deuteran)))) - `(magit-diff-added-highlight ((,class :inherit modus-themes-diff-focus-added))) - `(magit-diff-base ((,class ,@(modus-themes--diff - bg-diff-changed fg-diff-changed - yellow-nuanced-bg fg-diff-changed)))) - `(magit-diff-base-highlight ((,class :inherit modus-themes-diff-focus-changed))) - `(magit-diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only) (list :foreground fg-unfocused))))) - `(magit-diff-context-highlight ((,class ,@(modus-themes--diff - bg-inactive fg-inactive - bg-dim fg-alt - bg-dim fg-alt)))) - `(magit-diff-file-heading ((,class :inherit bold :foreground ,fg-special-cold))) - `(magit-diff-file-heading-highlight ((,class :inherit (modus-themes-special-cold bold)))) - `(magit-diff-file-heading-selection ((,class :inherit modus-themes-refine-cyan))) - ;; NOTE: here we break from the pattern of inheriting from the - ;; modus-themes-diff-* faces. - `(magit-diff-hunk-heading ((,class :inherit bold - ,@(modus-themes--diff - bg-active fg-inactive - bg-inactive fg-inactive - bg-inactive fg-inactive - nil nil - t)))) - ;; NOTE: we do not follow the pattern of inheriting from - ;; modus-themes-grue-* faces, as this is a special case. - `(magit-diff-hunk-heading-highlight - ((,class :inherit bold - :background ,@(modus-themes--deuteran bg-active bg-diff-heading) - :foreground ,@(modus-themes--deuteran fg-main fg-diff-heading)))) - `(magit-diff-hunk-heading-selection ((,class :inherit modus-themes-refine-blue))) - `(magit-diff-hunk-region ((,class :inherit bold))) - `(magit-diff-lines-boundary ((,class :background ,fg-main))) - `(magit-diff-lines-heading ((,class :inherit modus-themes-refine-magenta))) - `(magit-diff-removed ((,class ,@(modus-themes--diff - bg-diff-removed fg-diff-removed - red-nuanced-bg fg-diff-removed)))) - `(magit-diff-removed-highlight ((,class :inherit modus-themes-diff-focus-removed))) - `(magit-diffstat-added ((,class :inherit modus-themes-grue))) - `(magit-diffstat-removed ((,class :foreground ,red))) - `(magit-dimmed ((,class :foreground ,fg-unfocused))) - `(magit-filename ((,class :foreground ,fg-special-cold))) - `(magit-hash ((,class :inherit shadow))) - `(magit-head ((,class :inherit magit-branch-local))) - `(magit-header-line ((,class :inherit bold :foreground ,magenta-active))) - `(magit-header-line-key ((,class :inherit modus-themes-key-binding))) - `(magit-header-line-log-select ((,class :inherit bold :foreground ,fg-main))) - `(magit-keyword ((,class :foreground ,magenta))) - `(magit-keyword-squash ((,class :inherit bold :foreground ,yellow-alt-other))) - `(magit-log-author ((,class :foreground ,cyan))) - `(magit-log-date ((,class :inherit shadow))) - `(magit-log-graph ((,class :foreground ,fg-dim))) - `(magit-mode-line-process ((,class :inherit bold :foreground ,cyan-active))) - `(magit-mode-line-process-error ((,class :inherit bold :foreground ,red-active))) - `(magit-process-ng ((,class :inherit error))) - `(magit-process-ok ((,class :inherit success))) - `(magit-reflog-amend ((,class :inherit warning))) - `(magit-reflog-checkout ((,class :inherit bold :foreground ,blue-alt))) - `(magit-reflog-cherry-pick ((,class :inherit success))) - `(magit-reflog-commit ((,class :inherit bold))) - `(magit-reflog-merge ((,class :inherit success))) - `(magit-reflog-other ((,class :inherit bold :foreground ,cyan))) - `(magit-reflog-rebase ((,class :inherit bold :foreground ,magenta))) - `(magit-reflog-remote ((,class :inherit bold :foreground ,magenta-alt-other))) - `(magit-reflog-reset ((,class :inherit error))) - `(magit-refname ((,class :inherit shadow))) - `(magit-refname-pullreq ((,class :inherit shadow))) - `(magit-refname-stash ((,class :inherit shadow))) - `(magit-refname-wip ((,class :inherit shadow))) - `(magit-section ((,class :background ,bg-dim :foreground ,fg-main))) - `(magit-section-heading ((,class :inherit bold :foreground ,cyan))) - `(magit-section-heading-selection ((,class :inherit (modus-themes-refine-cyan bold)))) - `(magit-section-highlight ((,class :background ,bg-alt))) - `(magit-sequence-done ((,class :inherit success))) - `(magit-sequence-drop ((,class :inherit error))) - `(magit-sequence-exec ((,class :inherit bold :foreground ,magenta-alt))) - `(magit-sequence-head ((,class :inherit bold :foreground ,cyan-alt))) - `(magit-sequence-onto ((,class :inherit (bold shadow)))) - `(magit-sequence-part ((,class :inherit warning))) - `(magit-sequence-pick ((,class :inherit bold))) - `(magit-sequence-stop ((,class :inherit error))) - `(magit-signature-bad ((,class :inherit error))) - `(magit-signature-error ((,class :inherit error))) - `(magit-signature-expired ((,class :inherit warning))) - `(magit-signature-expired-key ((,class :foreground ,yellow))) - `(magit-signature-good ((,class :inherit success))) - `(magit-signature-revoked ((,class :inherit bold :foreground ,magenta))) - `(magit-signature-untrusted ((,class :inherit (bold shadow)))) - `(magit-tag ((,class :foreground ,yellow-alt-other))) -;;;;; magit-imerge - `(magit-imerge-overriding-value ((,class :inherit bold :foreground ,red-alt))) + `(magit-bisect-bad ((,c :inherit error))) + `(magit-bisect-good ((,c :inherit success))) + `(magit-bisect-skip ((,c :inherit warning))) + `(magit-blame-date (( ))) + `(magit-blame-dimmed ((,c :inherit shadow))) + `(magit-blame-hash (( ))) + `(magit-blame-highlight ((,c :background ,bg-active :foreground ,fg-main))) + `(magit-blame-name (( ))) + `(magit-blame-summary (( ))) + `(magit-branch-local ((,c :foreground ,accent-0))) + `(magit-branch-remote ((,c :foreground ,accent-1))) + `(magit-branch-upstream ((,c :inherit italic))) + `(magit-branch-warning ((,c :inherit warning))) + `(magit-cherry-equivalent ((,c :foreground ,magenta))) + `(magit-cherry-unmatched ((,c :foreground ,cyan))) + `(magit-diff-added ((,c :background ,bg-added-faint :foreground ,fg-added))) + `(magit-diff-added-highlight ((,c :background ,bg-added :foreground ,fg-added))) + `(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-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))) + `(magit-diff-hunk-heading ((,c :background ,bg-inactive))) + `(magit-diff-hunk-heading-highlight ((,c :inherit bold :background ,bg-active))) + `(magit-diff-hunk-heading-selection ((,c :inherit bold :background ,bg-hover-secondary))) + `(magit-diff-hunk-region ((,c :inherit bold))) + `(magit-diff-lines-boundary ((,c :background ,fg-main))) + `(magit-diff-lines-heading ((,c :background ,fg-dim :foreground ,bg-main))) + `(magit-diff-removed ((,c :background ,bg-removed-faint :foreground ,fg-removed))) + `(magit-diff-removed-highlight ((,c :background ,bg-removed :foreground ,fg-removed))) + `(magit-diffstat-added ((,c :foreground ,fg-added-intense))) + `(magit-diffstat-removed ((,c :foreground ,fg-removed-intense))) + `(magit-dimmed ((,c :inherit shadow))) + `(magit-filename ((,c :foreground ,accent-2))) + `(magit-hash ((,c :foreground ,identifier))) + `(magit-head ((,c :inherit magit-branch-local))) + `(magit-header-line ((,c :inherit bold))) + `(magit-header-line-key ((,c :inherit modus-themes-key-binding))) + `(magit-header-line-log-select ((,c :inherit bold))) + `(magit-keyword ((,c :foreground ,keyword))) + `(magit-keyword-squash ((,c :inherit bold :foreground ,warning))) + `(magit-log-author ((,c :foreground ,name))) + `(magit-log-date ((,c :foreground ,date-common))) + `(magit-log-graph ((,c :inherit shadow))) + `(magit-mode-line-process ((,c :inherit bold :foreground ,modeline-info))) + `(magit-mode-line-process-error ((,c :inherit bold :foreground ,modeline-err))) + `(magit-process-ng ((,c :inherit error))) + `(magit-process-ok ((,c :inherit success))) + `(magit-reflog-amend ((,c :inherit warning))) + `(magit-reflog-checkout ((,c :inherit bold :foreground ,blue))) + `(magit-reflog-cherry-pick ((,c :inherit success))) + `(magit-reflog-commit ((,c :inherit bold))) + `(magit-reflog-merge ((,c :inherit success))) + `(magit-reflog-other ((,c :inherit bold :foreground ,cyan))) + `(magit-reflog-rebase ((,c :inherit bold :foreground ,magenta))) + `(magit-reflog-remote ((,c :inherit (bold magit-branch-remote)))) + `(magit-reflog-reset ((,c :inherit error))) + `(magit-refname ((,c :inherit shadow))) + `(magit-refname-pullreq ((,c :inherit shadow))) + `(magit-refname-stash ((,c :inherit shadow))) + `(magit-refname-wip ((,c :inherit shadow))) + `(magit-section ((,c :background ,bg-dim :foreground ,fg-main))) + `(magit-section-heading ((,c :inherit bold))) + `(magit-section-heading-selection ((,c :inherit bold :background ,bg-hover-secondary))) + `(magit-section-highlight ((,c :background ,bg-dim))) + `(magit-sequence-done ((,c :inherit success))) + `(magit-sequence-drop ((,c :inherit error))) + `(magit-sequence-exec ((,c :inherit bold :foreground ,magenta))) + `(magit-sequence-head ((,c :inherit bold :foreground ,cyan))) + `(magit-sequence-onto ((,c :inherit (bold shadow)))) + `(magit-sequence-part ((,c :inherit warning))) + `(magit-sequence-pick ((,c :inherit bold))) + `(magit-sequence-stop ((,c :inherit error))) + `(magit-signature-bad ((,c :inherit error))) + `(magit-signature-error ((,c :inherit error))) + `(magit-signature-expired ((,c :inherit warning))) + `(magit-signature-expired-key ((,c :foreground ,warning))) + `(magit-signature-good ((,c :inherit success))) + `(magit-signature-revoked ((,c :inherit bold :foreground ,warning))) + `(magit-signature-untrusted ((,c :inherit (bold shadow)))) + `(magit-tag ((,c :foreground ,accent-3))) ; compare with branches ;;;;; make-mode (makefiles) - `(makefile-makepp-perl ((,class :background ,cyan-nuanced-bg))) - `(makefile-space ((,class :background ,magenta-nuanced-bg))) + `(makefile-makepp-perl ((,c :background ,bg-dim))) + `(makefile-space ((,c :background ,bg-inactive))) ;;;;; man - `(Man-overstrike ((,class :inherit bold :foreground ,magenta-alt))) - `(Man-reverse ((,class :inherit modus-themes-subtle-magenta))) - `(Man-underline ((,class :foreground ,cyan-alt-other :underline t))) + `(Man-overstrike ((,c :inherit bold :foreground ,accent-0))) + `(Man-underline ((,c :foreground ,accent-1 :underline t))) ;;;;; marginalia - `(marginalia-archive ((,class :foreground ,cyan-alt-other))) - `(marginalia-char ((,class :foreground ,magenta))) - `(marginalia-date ((,class :foreground ,cyan))) - `(marginalia-documentation ((,class :inherit modus-themes-slant :foreground ,fg-docstring))) - `(marginalia-file-name ((,class :foreground ,blue-faint))) - `(marginalia-file-owner ((,class :foreground ,red-faint))) - `(marginalia-file-priv-dir ((,class :foreground ,blue-alt))) - `(marginalia-file-priv-exec ((,class :foreground ,magenta-alt))) - `(marginalia-file-priv-link ((,class :foreground ,blue-alt-other))) - `(marginalia-file-priv-no ((,class :foreground "gray50"))) - `(marginalia-file-priv-other ((,class :foreground ,yellow))) - `(marginalia-file-priv-rare ((,class :foreground ,red))) - `(marginalia-file-priv-read ((,class :foreground ,fg-main))) - `(marginalia-file-priv-write ((,class :foreground ,cyan))) - `(marginalia-function ((,class :foreground ,magenta-alt-faint))) - `(marginalia-key ((,class :inherit modus-themes-key-binding))) - `(marginalia-lighter ((,class :foreground ,blue-alt))) - `(marginalia-list ((,class :foreground ,magenta-alt-other-faint))) - `(marginalia-mode ((,class :foreground ,cyan))) - `(marginalia-modified ((,class :foreground ,magenta-alt-faint))) - `(marginalia-null ((,class :inherit shadow))) - `(marginalia-number ((,class :foreground ,cyan))) - `(marginalia-size ((,class :foreground ,cyan-alt-other-faint))) - `(marginalia-string ((,class :foreground ,blue-alt))) - `(marginalia-symbol ((,class :foreground ,blue-alt-other-faint))) - `(marginalia-true ((,class :foreground ,fg-main))) - `(marginalia-type ((,class :foreground ,cyan-alt-other))) - `(marginalia-value ((,class :foreground ,cyan))) - `(marginalia-version ((,class :foreground ,cyan))) + `(marginalia-archive ((,c :foreground ,accent-0))) + `(marginalia-char ((,c :foreground ,accent-2))) + `(marginalia-date ((,c :foreground ,date-common))) + `(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))) + `(marginalia-file-priv-exec ((,c :foreground ,accent-1))) + `(marginalia-file-priv-link ((,c :foreground ,fg-link))) + `(marginalia-file-priv-no ((,c :inherit shadow))) + `(marginalia-file-priv-other ((,c :foreground ,accent-2))) + `(marginalia-file-priv-rare ((,c :foreground ,accent-3))) + `(marginalia-file-priv-read ((,c :foreground ,fg-main))) + `(marginalia-file-priv-write ((,c :foreground ,accent-0))) + `(marginalia-function ((,c :foreground ,fnname))) + `(marginalia-key ((,c :inherit modus-themes-key-binding))) + `(marginalia-lighter ((,c :inherit shadow))) + `(marginalia-liqst ((,c :inherit shadow))) + `(marginalia-mode ((,c :foreground ,constant))) + `(marginalia-modified ((,c :inherit warning))) + `(marginalia-null ((,c :inherit shadow))) + `(marginalia-number ((,c :foreground ,constant))) + `(marginalia-size ((,c :foreground ,variable))) + `(marginalia-string ((,c :foreground ,string))) + `(marginalia-symbol ((,c :foreground ,builtin))) + `(marginalia-true (( ))) + `(marginalia-type ((,c :foreground ,type))) + `(marginalia-value ((,c :inherit shadow))) + `(marginalia-version ((,c :foreground ,date-common))) ;;;;; markdown-mode - `(markdown-blockquote-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold))) - `(markdown-bold-face ((,class :inherit bold))) - `(markdown-code-face ((,class :inherit modus-themes-fixed-pitch :background ,bg-dim :extend t))) - `(markdown-comment-face ((,class :inherit font-lock-comment-face))) - `(markdown-footnote-marker-face ((,class :inherit bold :foreground ,cyan-alt))) - `(markdown-footnote-text-face ((,class :inherit modus-themes-slant :foreground ,fg-main))) - `(markdown-gfm-checkbox-face ((,class :foreground ,yellow-alt-other))) - `(markdown-header-delimiter-face ((,class :inherit modus-themes-bold :foreground ,fg-dim))) - `(markdown-header-face ((t nil))) - `(markdown-header-face-1 ((,class :inherit modus-themes-heading-1))) - `(markdown-header-face-2 ((,class :inherit modus-themes-heading-2))) - `(markdown-header-face-3 ((,class :inherit modus-themes-heading-3))) - `(markdown-header-face-4 ((,class :inherit modus-themes-heading-4))) - `(markdown-header-face-5 ((,class :inherit modus-themes-heading-5))) - `(markdown-header-face-6 ((,class :inherit modus-themes-heading-6))) - `(markdown-header-rule-face ((,class :inherit bold :foreground ,fg-special-warm))) - `(markdown-highlighting-face ((,class :inherit modus-themes-refine-yellow))) - `(markdown-hr-face ((,class :inherit bold :foreground ,fg-special-warm))) - `(markdown-html-attr-name-face ((,class :inherit modus-themes-fixed-pitch - :foreground ,cyan))) - `(markdown-html-attr-value-face ((,class :inherit modus-themes-fixed-pitch - :foreground ,blue))) - `(markdown-html-entity-face ((,class :inherit modus-themes-fixed-pitch - :foreground ,cyan))) - `(markdown-html-tag-delimiter-face ((,class :inherit modus-themes-fixed-pitch - :foreground ,fg-special-mild))) - `(markdown-html-tag-name-face ((,class :inherit modus-themes-fixed-pitch - :foreground ,magenta-alt))) - `(markdown-inline-code-face ((,class :inherit modus-themes-markup-verbatim))) - `(markdown-italic-face ((,class :inherit italic))) - `(markdown-language-info-face ((,class :inherit modus-themes-fixed-pitch - :foreground ,fg-special-cold))) - `(markdown-language-keyword-face ((,class :inherit modus-themes-fixed-pitch - :background ,bg-alt - :foreground ,fg-alt))) - `(markdown-line-break-face ((,class :inherit modus-themes-refine-cyan :underline t))) - `(markdown-link-face ((,class :inherit button))) - `(markdown-link-title-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold))) - `(markdown-list-face ((,class :foreground ,fg-dim))) - `(markdown-markup-face ((,class :inherit shadow))) - `(markdown-math-face ((,class :foreground ,magenta-alt-other))) - `(markdown-metadata-key-face ((,class :foreground ,cyan-alt-other))) - `(markdown-metadata-value-face ((,class :foreground ,blue-alt))) - `(markdown-missing-link-face ((,class :inherit bold :foreground ,yellow))) - `(markdown-plain-url-face ((,class :inherit markdown-link-face))) - `(markdown-pre-face ((,class :inherit markdown-code-face :foreground ,fg-special-mild))) - `(markdown-reference-face ((,class :inherit markdown-markup-face))) - `(markdown-strike-through-face ((,class :strike-through t))) - `(markdown-table-face ((,class :inherit modus-themes-fixed-pitch - :foreground ,fg-special-cold))) - `(markdown-url-face ((,class :foreground ,blue-alt))) + `(markdown-blockquote-face ((,c :inherit font-lock-doc-face))) + `(markdown-bold-face ((,c :inherit bold))) + `(markdown-code-face ((,c :inherit modus-themes-fixed-pitch :background ,bg-dim :extend t))) + `(markdown-gfm-checkbox-face ((,c :foreground ,warning))) + `(markdown-header-face (( ))) + `(markdown-header-face-1 ((,c :inherit modus-themes-heading-1))) + `(markdown-header-face-2 ((,c :inherit modus-themes-heading-2))) + `(markdown-header-face-3 ((,c :inherit modus-themes-heading-3))) + `(markdown-header-face-4 ((,c :inherit modus-themes-heading-4))) + `(markdown-header-face-5 ((,c :inherit modus-themes-heading-5))) + `(markdown-header-face-6 ((,c :inherit modus-themes-heading-6))) + `(markdown-highlighting-face ((,c :inherit secondary-selection))) + `(markdown-inline-code-face ((,c :inherit modus-themes-prose-code))) + `(markdown-italic-face ((,c :inherit italic))) + `(markdown-language-keyword-face ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-block))) + `(markdown-line-break-face ((,c :inherit nobreak-space))) + `(markdown-link-face ((,c :inherit link))) + `(markdown-markup-face ((,c :inherit shadow))) + `(markdown-metadata-key-face ((,c :inherit bold))) + `(markdown-metadata-value-face ((,c :foreground ,string))) + `(markdown-missing-link-face ((,c :inherit warning))) + `(markdown-pre-face ((,c :inherit markdown-code-face))) + `(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 ((,class :inherit (italic markup-meta-face)))) - `(markup-bold-face ((,class :inherit bold :foreground ,red-nuanced-fg))) - `(markup-code-face ((,class :foreground ,magenta))) - `(markup-comment-face ((,class :inherit font-lock-comment-face))) - `(markup-complex-replacement-face ((,class :background ,magenta-nuanced-bg :foreground ,magenta-alt-other))) - `(markup-emphasis-face ((,class :inherit markup-italic-face))) - `(markup-error-face ((,class :inherit error))) - `(markup-gen-face ((,class :foreground ,magenta-alt))) - `(markup-internal-reference-face ((,class :inherit modus-themes-slant :foreground ,fg-alt))) - `(markup-italic-face ((,class :inherit italic))) - `(markup-list-face ((,class :inherit modus-themes-special-cold))) - `(markup-meta-face ((,class :inherit (modus-themes-fixed-pitch shadow)))) - `(markup-meta-hide-face ((,class :foreground "gray50"))) - `(markup-reference-face ((,class :inherit modus-themes-slant :foreground ,blue-alt))) - `(markup-replacement-face ((,class :inherit modus-themes-fixed-pitch :foreground ,red-alt))) - `(markup-secondary-text-face ((,class :height 0.9 :foreground ,cyan-alt-other))) - `(markup-small-face ((,class :inherit markup-gen-face :height 0.9))) - `(markup-strong-face ((,class :inherit markup-bold-face))) - `(markup-subscript-face ((,class :height 0.9 :foreground ,magenta-alt-other))) - `(markup-superscript-face ((,class :height 0.9 :foreground ,magenta-alt-other))) - `(markup-table-cell-face ((,class :inherit modus-themes-subtle-neutral))) - `(markup-table-face ((,class :inherit modus-themes-subtle-neutral))) - `(markup-table-row-face ((,class :inherit modus-themes-special-cold))) - `(markup-title-0-face ((,class :inherit modus-themes-heading-1))) - `(markup-title-1-face ((,class :inherit modus-themes-heading-2))) - `(markup-title-2-face ((,class :inherit modus-themes-heading-3))) - `(markup-title-3-face ((,class :inherit modus-themes-heading-4))) - `(markup-title-4-face ((,class :inherit modus-themes-heading-5))) - `(markup-title-5-face ((,class :inherit modus-themes-heading-6))) - `(markup-verbatim-face ((,class :inherit modus-themes-fixed-pitch :background ,bg-alt))) -;;;;; mentor - `(mentor-download-message ((,class :foreground ,fg-special-warm))) - `(mentor-download-name ((,class :foreground ,fg-special-cold))) - `(mentor-download-progress ((,class :foreground ,blue-alt-other))) - `(mentor-download-size ((,class :foreground ,magenta-alt-other))) - `(mentor-download-speed-down ((,class :foreground ,cyan-alt))) - `(mentor-download-speed-up ((,class :foreground ,red-alt))) - `(mentor-download-state ((,class :foreground ,yellow-alt))) - `(mentor-highlight-face ((,class :inherit modus-themes-subtle-blue))) - `(mentor-tracker-name ((,class :foreground ,magenta-alt))) + `(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))) + `(markup-complex-replacement-face ((,c :foreground ,prose-macro))) + `(markup-emphasis-face ((,c :inherit markup-italic-face))) + `(markup-error-face ((,c :inherit error))) + `(markup-gen-face ((,c :foreground ,prose-verbatim))) + `(markup-internal-reference-face ((,c :inherit (shadow modus-themes-slant)))) + `(markup-italic-face ((,c :inherit italic))) + `(markup-list-face ((,c :background ,bg-inactive))) + `(markup-meta-face ((,c :inherit (modus-themes-fixed-pitch shadow)))) + `(markup-meta-hide-face ((,c :foreground "gray50"))) + `(markup-reference-face ((,c :inherit modus-themes-slant :foreground ,fg-alt))) + `(markup-replacement-face ((,c :inherit modus-themes-fixed-pitch :foreground ,err))) + `(markup-secondary-text-face ((,c :height 0.9 :foreground ,fg-alt))) + `(markup-small-face ((,c :inherit markup-gen-face :height 0.9))) + `(markup-strong-face ((,c :inherit markup-bold-face))) + `(markup-subscript-face ((,c :height 0.9 :foreground ,fg-alt))) + `(markup-superscript-face ((,c :height 0.9 :foreground ,fg-alt))) + `(markup-table-cell-face (( ))) + `(markup-table-face ((,c :foreground ,prose-table))) + `(markup-table-row-face (( ))) + `(markup-title-0-face ((,c :inherit modus-themes-heading-1))) + `(markup-title-1-face ((,c :inherit modus-themes-heading-2))) + `(markup-title-2-face ((,c :inherit modus-themes-heading-3))) + `(markup-title-3-face ((,c :inherit modus-themes-heading-4))) + `(markup-title-4-face ((,c :inherit modus-themes-heading-5))) + `(markup-title-5-face ((,c :inherit modus-themes-heading-6))) + `(markup-verbatim-face ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-verbatim))) ;;;;; messages - `(message-cited-text-1 ((,class ,@(modus-themes--mail-cite blue-faint blue fg-special-cold)))) - `(message-cited-text-2 ((,class ,@(modus-themes--mail-cite yellow-faint yellow yellow-alt-faint)))) - `(message-cited-text-3 ((,class ,@(modus-themes--mail-cite magenta-alt-faint magenta-alt fg-special-calm)))) - `(message-cited-text-4 ((,class ,@(modus-themes--mail-cite cyan-alt-other-faint cyan-alt-other fg-special-mild)))) - `(message-header-cc ((,class :foreground ,blue-alt-other))) - `(message-header-name ((,class :inherit bold :foreground ,cyan))) - `(message-header-newsgroups ((,class :inherit message-header-other))) - `(message-header-other ((,class :foreground ,fg-special-calm))) - `(message-header-subject ((,class :inherit bold :foreground ,magenta-alt))) - `(message-header-to ((,class :inherit bold :foreground ,magenta-alt-other))) - `(message-header-xheader ((,class :foreground ,blue-alt))) - `(message-mml ((,class :foreground ,cyan-alt-other))) - `(message-separator ((,class :inherit modus-themes-intense-neutral))) -;;;;; mini-modeline - `(mini-modeline-mode-line ((,class :background ,blue-intense :height 0.14))) - `(mini-modeline-mode-line-inactive ((,class :background ,fg-window-divider-inner :height 0.1))) + `(message-cited-text-1 ((,c :foreground ,mail-cite-0))) + `(message-cited-text-2 ((,c :foreground ,mail-cite-1))) + `(message-cited-text-3 ((,c :foreground ,mail-cite-2))) + `(message-cited-text-4 ((,c :foreground ,mail-cite-3))) + `(message-header-name ((,c :inherit bold))) + `(message-header-newsgroups ((,c :inherit message-header-other))) + `(message-header-to ((,c :inherit bold :foreground ,mail-recipient))) + `(message-header-cc ((,c :foreground ,mail-recipient))) + `(message-header-subject ((,c :inherit bold :foreground ,mail-subject))) + `(message-header-xheader ((,c :inherit message-header-other))) + `(message-header-other ((,c :foreground ,mail-other))) + `(message-mml ((,c :foreground ,mail-part))) + `(message-separator ((,c :background ,bg-active))) ;;;;; minimap - `(minimap-active-region-background ((,class :background ,bg-active))) - `(minimap-current-line-face ((,class :background ,cyan-intense-bg :foreground ,fg-main))) -;;;;; mmm-mode - `(mmm-cleanup-submode-face ((,class :background ,yellow-nuanced-bg))) - `(mmm-code-submode-face ((,class :background ,bg-alt))) - `(mmm-comment-submode-face ((,class :background ,blue-nuanced-bg))) - `(mmm-declaration-submode-face ((,class :background ,cyan-nuanced-bg))) - `(mmm-default-submode-face ((,class :background ,bg-dim))) - `(mmm-init-submode-face ((,class :background ,magenta-nuanced-bg))) - `(mmm-output-submode-face ((,class :background ,red-nuanced-bg))) - `(mmm-special-submode-face ((,class :background ,green-nuanced-bg))) + `(minimap-active-region-background ((,c :background ,bg-active))) + `(minimap-current-line-face ((,c :background ,bg-cyan-intense :foreground ,fg-main))) ;;;;; mode-line - `(mode-line ((,class :inherit modus-themes-ui-variable-pitch - ,@(modus-themes--mode-line-attrs - fg-active bg-active - fg-dim bg-active - fg-main bg-active-accent - fg-alt bg-active - 'alt-style bg-main)))) - `(mode-line-active ((,class :inherit mode-line))) - `(mode-line-buffer-id ((,class :inherit bold))) - `(mode-line-emphasis ((,class :inherit bold :foreground ,magenta-active))) - `(mode-line-highlight ((,class ,@(if modus-themes-intense-mouseovers - (list :inherit 'modus-themes-active-blue) - (list :inherit 'highlight))))) - `(mode-line-inactive ((,class :inherit modus-themes-ui-variable-pitch - ,@(modus-themes--mode-line-attrs - fg-inactive bg-inactive - fg-alt bg-dim - fg-inactive bg-inactive - bg-region bg-active)))) + `(mode-line ((,c :inherit modus-themes-ui-variable-pitch + :box ,border-mode-line-active + :background ,bg-mode-line-active + :foreground ,fg-mode-line-active))) + `(mode-line-active ((,c :inherit mode-line))) + `(mode-line-buffer-id ((,c :inherit bold))) + `(mode-line-emphasis ((,c :inherit bold :foreground ,modeline-info))) + `(mode-line-highlight ((,c :background ,bg-hover :foreground ,fg-main :box ,fg-main))) + `(mode-line-inactive ((,c :inherit modus-themes-ui-variable-pitch + :box ,border-mode-line-inactive + :background ,bg-mode-line-inactive + :foreground ,fg-mode-line-inactive))) ;;;;; mood-line - `(mood-line-modified ((,class :foreground ,magenta-active))) - `(mood-line-status-error ((,class :inherit bold :foreground ,red-active))) - `(mood-line-status-info ((,class :foreground ,cyan-active))) - `(mood-line-status-neutral ((,class :foreground ,blue-active))) - `(mood-line-status-success ((,class :inherit modus-themes-grue-active))) - `(mood-line-status-warning ((,class :inherit bold :foreground ,yellow-active))) - `(mood-line-unimportant ((,class :foreground ,fg-inactive))) + `(mood-line-modified ((,c :inherit italic))) + `(mood-line-status-error ((,c :inherit error))) + `(mood-line-status-info ((,c :foreground ,info))) + `(mood-line-status-neutral (( ))) + `(mood-line-status-success ((,c :inherit success))) + `(mood-line-status-warning ((,c :inherit warning))) + `(mood-line-unimportant ((,c :inherit shadow))) ;;;;; mpdel - `(mpdel-browser-directory-face ((,class :foreground ,blue))) - `(mpdel-playlist-current-song-face ((,class :inherit bold :foreground ,blue-alt-other))) + `(mpdel-browser-directory-face ((,c :foreground ,accent-0))) + `(mpdel-playlist-current-song-face ((,c :inherit bold :foreground ,accent-0))) ;;;;; mu4e - `(mu4e-attach-number-face ((,class :inherit bold :foreground ,fg-dim))) - `(mu4e-cited-1-face ((,class :inherit message-cited-text-1))) - `(mu4e-cited-2-face ((,class :inherit message-cited-text-2))) - `(mu4e-cited-3-face ((,class :inherit message-cited-text-3))) - `(mu4e-cited-4-face ((,class :inherit message-cited-text-4))) - `(mu4e-cited-5-face ((,class :inherit message-cited-text-1))) - `(mu4e-cited-6-face ((,class :inherit message-cited-text-2))) - `(mu4e-cited-7-face ((,class :inherit message-cited-text-3))) - `(mu4e-compose-header-face ((,class :inherit mu4e-compose-separator-face))) - `(mu4e-compose-separator-face ((,class :inherit modus-themes-intense-neutral))) - `(mu4e-contact-face ((,class :inherit message-header-to))) - `(mu4e-context-face ((,class :foreground ,blue-active))) - `(mu4e-draft-face ((,class :foreground ,magenta-alt))) - `(mu4e-flagged-face ((,class :foreground ,red-alt-other))) - `(mu4e-footer-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold))) - `(mu4e-forwarded-face ((,class :foreground ,magenta-alt-other))) - `(mu4e-header-face ((,class :inherit shadow))) - `(mu4e-header-highlight-face ((,class :inherit modus-themes-hl-line))) - `(mu4e-header-key-face ((,class :inherit message-header-name))) - `(mu4e-header-marks-face ((,class :inherit mu4e-special-header-value-face))) - `(mu4e-header-title-face ((,class :foreground ,fg-special-mild))) - `(mu4e-header-value-face ((,class :inherit message-header-other))) - `(mu4e-highlight-face ((,class :inherit modus-themes-key-binding))) - `(mu4e-link-face ((,class :inherit button))) - `(mu4e-modeline-face ((,class :foreground ,magenta-active))) - `(mu4e-moved-face ((,class :inherit modus-themes-slant :foreground ,yellow))) - `(mu4e-ok-face ((,class :inherit bold :foreground ,green))) - `(mu4e-region-code ((,class :inherit modus-themes-special-calm))) - `(mu4e-related-face ((,class :inherit (italic shadow)))) - `(mu4e-replied-face ((,class :foreground ,blue))) - `(mu4e-special-header-value-face ((,class :inherit message-header-subject))) - `(mu4e-system-face ((,class :inherit modus-themes-slant :foreground ,fg-mark-del))) - `(mu4e-title-face ((,class :foreground ,fg-main))) - `(mu4e-trashed-face ((,class :foreground ,red))) - `(mu4e-unread-face ((,class :inherit bold))) - `(mu4e-url-number-face ((,class :inherit shadow))) - `(mu4e-view-body-face ((,class :foreground ,fg-main))) - `(mu4e-warning-face ((,class :inherit warning))) + `(mu4e-attach-number-face ((,c :inherit bold :foreground ,fg-dim))) + `(mu4e-cited-1-face ((,c :inherit message-cited-text-1))) + `(mu4e-cited-2-face ((,c :inherit message-cited-text-2))) + `(mu4e-cited-3-face ((,c :inherit message-cited-text-3))) + `(mu4e-cited-4-face ((,c :inherit message-cited-text-4))) + `(mu4e-cited-5-face ((,c :inherit message-cited-text-1))) + `(mu4e-cited-6-face ((,c :inherit message-cited-text-2))) + `(mu4e-cited-7-face ((,c :inherit message-cited-text-3))) + `(mu4e-compose-header-face ((,c :inherit mu4e-compose-separator-face))) + `(mu4e-compose-separator-face ((,c :inherit message-separator))) + `(mu4e-contact-face ((,c :inherit message-header-to))) + `(mu4e-context-face ((,c :inherit bold))) + `(mu4e-draft-face ((,c :foreground ,warning))) + `(mu4e-flagged-face ((,c :foreground ,err))) + `(mu4e-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 :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))) + `(mu4e-header-value-face ((,c :inherit message-header-other))) + `(mu4e-highlight-face ((,c :inherit modus-themes-key-binding))) + `(mu4e-link-face ((,c :inherit link))) + `(mu4e-modeline-face (( ))) + `(mu4e-moved-face ((,c :inherit italic :foreground ,warning))) + `(mu4e-ok-face ((,c :inherit success))) + `(mu4e-region-code ((,c :foreground ,builtin))) + `(mu4e-related-face ((,c :inherit (italic shadow)))) + `(mu4e-replied-face ((,c :foreground ,info))) + `(mu4e-special-header-value-face ((,c :inherit message-header-subject))) + `(mu4e-system-face ((,c :inherit italic))) + `(mu4e-title-face (( ))) + `(mu4e-trashed-face ((,c :foreground ,err))) + `(mu4e-unread-face ((,c :inherit bold))) + `(mu4e-url-number-face ((,c :inherit shadow))) + `(mu4e-view-body-face (( ))) + `(mu4e-warning-face ((,c :inherit warning))) ;;;;; multiple-cursors - `(mc/cursor-bar-face ((,class :height 1 :background ,fg-main))) - `(mc/cursor-face ((,class :inverse-video t))) - `(mc/region-face ((,class :inherit region))) -;;;;; nano-modeline - `(nano-modeline-active-primary ((,class :inherit mode-line :foreground ,fg-special-mild))) - `(nano-modeline-active-secondary ((,class :inherit mode-line :foreground ,fg-special-cold))) - `(nano-modeline-active-status-** ((,class :inherit mode-line :background ,yellow-subtle-bg))) - `(nano-modeline-active-status-RO ((,class :inherit mode-line :background ,red-subtle-bg))) - `(nano-modeline-active-status-RW ((,class :inherit mode-line :background ,cyan-subtle-bg))) - `(nano-modeline-inactive-primary ((,class :inherit mode-line-inactive :foreground ,fg-inactive))) - `(nano-modeline-inactive-secondary ((,class :inherit mode-line-inactive :foreground ,fg-inactive))) - `(nano-modeline-inactive-status-** ((,class :inherit mode-line-inactive :foreground ,yellow-active))) - `(nano-modeline-inactive-status-RO ((,class :inherit mode-line-inactive :foreground ,red-active))) - `(nano-modeline-inactive-status-RW ((,class :inherit mode-line-inactive :foreground ,cyan-active))) + `(mc/cursor-bar-face ((,c :height 1 :foreground ,fg-main :background ,bg-main))) + `(mc/cursor-face ((,c :inverse-video t))) + `(mc/region-face ((,c :inherit region))) ;;;;; neotree - `(neo-banner-face ((,class :foreground ,magenta))) - `(neo-button-face ((,class :inherit button))) - `(neo-dir-link-face ((,class :inherit bold :foreground ,blue))) - `(neo-expand-btn-face ((,class :foreground ,cyan))) - `(neo-file-link-face ((,class :foreground ,fg-main))) - `(neo-header-face ((,class :inherit bold :foreground ,fg-main))) - `(neo-root-dir-face ((,class :inherit bold :foreground ,cyan-alt))) - `(neo-vc-added-face ((,class :inherit modus-themes-grue))) - `(neo-vc-conflict-face ((,class :inherit error))) - `(neo-vc-default-face ((,class :foreground ,fg-main))) - `(neo-vc-edited-face ((,class :foreground ,yellow))) - `(neo-vc-ignored-face ((,class :foreground ,fg-inactive))) - `(neo-vc-missing-face ((,class :foreground ,red-alt))) - `(neo-vc-needs-merge-face ((,class :foreground ,magenta-alt))) - `(neo-vc-needs-update-face ((,class :underline t))) - `(neo-vc-removed-face ((,class :strike-through t))) - `(neo-vc-unlocked-changes-face ((,class :inherit modus-themes-refine-blue))) - `(neo-vc-up-to-date-face ((,class :inherit shadow))) - `(neo-vc-user-face ((,class :foreground ,magenta))) + `(neo-banner-face ((,c :foreground ,accent-0))) + `(neo-button-face ((,c :inherit button))) + `(neo-dir-link-face (( ))) + `(neo-expand-btn-face (( ))) + `(neo-file-link-face (( ))) + `(neo-header-face ((,c :inherit bold))) + `(neo-root-dir-face ((,c :inherit bold :foreground ,accent-0))) + `(neo-vc-added-face ((,c :inherit success))) + `(neo-vc-conflict-face ((,c :inherit error))) + `(neo-vc-default-face (( ))) + `(neo-vc-edited-face ((,c :inherit italic))) + `(neo-vc-ignored-face ((,c :inherit shadow))) + `(neo-vc-missing-face ((,c :inherit error))) + `(neo-vc-needs-merge-face ((,c :inherit italic))) + `(neo-vc-needs-update-face ((,c :underline t))) + `(neo-vc-removed-face ((,c :strike-through t))) + `(neo-vc-unlocked-changes-face ((,c :inherit success))) + `(neo-vc-up-to-date-face (( ))) + `(neo-vc-user-face ((,c :inherit warning))) ;;;;; notmuch - `(notmuch-crypto-decryption ((,class :inherit (shadow bold)))) - `(notmuch-crypto-part-header ((,class :foreground ,magenta-alt-other))) - `(notmuch-crypto-signature-bad ((,class :inherit error))) - `(notmuch-crypto-signature-good ((,class :inherit success))) - `(notmuch-crypto-signature-good-key ((,class :inherit bold :foreground ,cyan))) - `(notmuch-crypto-signature-unknown ((,class :inherit warning))) - `(notmuch-hello-logo-background ((,class :background "gray50"))) - `(notmuch-jump-key ((,class :inherit modus-themes-key-binding))) - `(notmuch-message-summary-face ((,class :inherit (bold modus-themes-nuanced-cyan)))) - `(notmuch-search-count ((,class :inherit shadow))) - `(notmuch-search-date ((,class :foreground ,cyan))) - `(notmuch-search-flagged-face ((,class :foreground ,red-alt-other))) - `(notmuch-search-matching-authors ((,class :foreground ,fg-special-cold))) - `(notmuch-search-non-matching-authors ((,class :inherit shadow))) - `(notmuch-search-subject ((,class :foreground ,fg-main))) - `(notmuch-search-unread-face ((,class :inherit bold))) - `(notmuch-tag-added ((,class :underline ,blue))) - `(notmuch-tag-deleted ((,class :strike-through ,red))) - `(notmuch-tag-face ((,class :foreground ,blue))) - `(notmuch-tag-flagged ((,class :foreground ,red-alt))) - `(notmuch-tag-unread ((,class :foreground ,magenta-alt))) - `(notmuch-tree-match-author-face ((,class :inherit notmuch-search-matching-authors))) - `(notmuch-tree-match-date-face ((,class :inherit notmuch-search-date))) - `(notmuch-tree-match-face ((,class :foreground ,fg-main))) - `(notmuch-tree-match-tag-face ((,class :inherit notmuch-tag-face))) - `(notmuch-tree-no-match-face ((,class :inherit shadow))) - `(notmuch-tree-no-match-date-face ((,class :inherit shadow))) - `(notmuch-wash-cited-text ((,class :inherit message-cited-text-1))) - `(notmuch-wash-toggle-button ((,class :background ,bg-alt :foreground ,fg-alt))) + `(notmuch-crypto-decryption ((,c :inherit bold))) + `(notmuch-crypto-part-header ((,c :foreground ,mail-part))) ; like `message-mml' + `(notmuch-crypto-signature-bad ((,c :inherit error))) + `(notmuch-crypto-signature-good ((,c :inherit success))) + `(notmuch-crypto-signature-good-key ((,c :inherit success))) + `(notmuch-crypto-signature-unknown ((,c :inherit warning))) + `(notmuch-jump-key ((,c :inherit modus-themes-key-binding))) + `(notmuch-message-summary-face ((,c :inherit bold :background ,bg-inactive))) + `(notmuch-search-count ((,c :foreground ,fg-dim))) + `(notmuch-search-date ((,c :foreground ,date-common))) + `(notmuch-search-flagged-face ((,c :foreground ,err))) + `(notmuch-search-matching-authors ((,c :foreground ,mail-recipient))) + `(notmuch-search-non-matching-authors ((,c :inherit shadow))) + `(notmuch-search-subject ((,c :foreground ,fg-main))) + `(notmuch-search-unread-face ((,c :inherit bold))) + `(notmuch-tag-added ((,c :underline ,info))) + `(notmuch-tag-deleted ((,c :strike-through ,err))) + `(notmuch-tag-face ((,c :foreground ,accent-0))) + `(notmuch-tag-flagged ((,c :foreground ,err))) + `(notmuch-tag-unread ((,c :foreground ,accent-1))) + `(notmuch-tree-match-author-face ((,c :inherit notmuch-search-matching-authors))) + `(notmuch-tree-match-date-face ((,c :inherit notmuch-search-date))) + `(notmuch-tree-match-face ((,c :foreground ,fg-main))) + `(notmuch-tree-match-tag-face ((,c :inherit notmuch-tag-face))) + `(notmuch-tree-no-match-face ((,c :inherit shadow))) + `(notmuch-tree-no-match-date-face ((,c :inherit shadow))) + `(notmuch-wash-cited-text ((,c :inherit message-cited-text-1))) + `(notmuch-wash-toggle-button ((,c :background ,bg-dim))) ;;;;; num3-mode - `(num3-face-even ((,class :inherit bold :background ,bg-alt))) + `(num3-face-even ((,c :inherit bold :background ,bg-inactive))) ;;;;; nxml-mode - `(nxml-attribute-colon ((,class :foreground ,fg-main))) - `(nxml-attribute-local-name ((,class :inherit font-lock-variable-name-face))) - `(nxml-attribute-prefix ((,class :inherit font-lock-type-face))) - `(nxml-attribute-value ((,class :inherit font-lock-constant-face))) - `(nxml-cdata-section-CDATA ((,class :inherit error))) - `(nxml-cdata-section-delimiter ((,class :inherit error))) - `(nxml-char-ref-delimiter ((,class :foreground ,fg-special-mild))) - `(nxml-char-ref-number ((,class :inherit modus-themes-bold :foreground ,fg-special-mild))) - `(nxml-delimited-data ((,class :inherit modus-themes-slant :foreground ,fg-special-cold))) - `(nxml-delimiter ((,class :foreground ,fg-dim))) - `(nxml-element-colon ((,class :foreground ,fg-main))) - `(nxml-element-local-name ((,class :inherit font-lock-function-name-face))) - `(nxml-element-prefix ((,class :inherit font-lock-builtin-face))) - `(nxml-entity-ref-delimiter ((,class :foreground ,fg-special-mild))) - `(nxml-entity-ref-name ((,class :inherit modus-themes-bold :foreground ,fg-special-mild))) - `(nxml-glyph ((,class :inherit modus-themes-intense-neutral))) - `(nxml-hash ((,class :inherit (bold font-lock-string-face)))) - `(nxml-heading ((,class :inherit bold))) - `(nxml-name ((,class :inherit font-lock-builtin-face))) - `(nxml-namespace-attribute-colon ((,class :foreground ,fg-main))) - `(nxml-namespace-attribute-prefix ((,class :inherit font-lock-variable-name-face))) - `(nxml-processing-instruction-target ((,class :inherit font-lock-keyword-face))) - `(nxml-prolog-keyword ((,class :inherit font-lock-keyword-face))) - `(nxml-ref ((,class :inherit modus-themes-bold :foreground ,fg-special-mild))) - `(rng-error ((,class :inherit error))) + `(nxml-attribute-colon ((,c :foreground ,fg-main))) + `(nxml-attribute-local-name ((,c :inherit font-lock-variable-name-face))) + `(nxml-attribute-prefix ((,c :inherit font-lock-type-face))) + `(nxml-attribute-value ((,c :inherit font-lock-constant-face))) + `(nxml-cdata-section-CDATA ((,c :inherit error))) + `(nxml-cdata-section-delimiter ((,c :inherit error))) + `(nxml-char-ref-delimiter ((,c :inherit shadow))) + `(nxml-char-ref-number ((,c :inherit (shadow modus-themes-bold)))) + `(nxml-delimited-data ((,c :inherit (shadow modus-themes-slant)))) + `(nxml-delimiter ((,c :foreground ,fg-dim))) + `(nxml-element-colon ((,c :foreground ,fg-main))) + `(nxml-element-local-name ((,c :inherit font-lock-function-name-face))) + `(nxml-element-prefix ((,c :inherit font-lock-builtin-face))) + `(nxml-entity-ref-delimiter ((,c :inherit shadow))) + `(nxml-entity-ref-name ((,c :inherit (shadow modus-themes-bold)))) + `(nxml-glyph ((,c :background ,bg-active :foreground ,fg-main))) + `(nxml-hash ((,c :inherit (bold font-lock-string-face)))) + `(nxml-heading ((,c :inherit bold))) + `(nxml-name ((,c :inherit font-lock-builtin-face))) + `(nxml-namespace-attribute-colon ((,c :foreground ,fg-main))) + `(nxml-namespace-attribute-prefix ((,c :inherit font-lock-variable-name-face))) + `(nxml-processing-instruction-target ((,c :inherit font-lock-keyword-face))) + `(nxml-prolog-keyword ((,c :inherit font-lock-keyword-face))) + `(nxml-ref ((,c :inherit (shadow modus-themes-bold)))) + `(rng-error ((,c :inherit error))) ;;;;; olivetti - `(olivetti-fringe ((,class :background ,bg-main))) + `(olivetti-fringe ((,c :background ,bg-main))) ;;;;; orderless - `(orderless-match-face-0 ((,class :inherit modus-themes-completion-match-0))) - `(orderless-match-face-1 ((,class :inherit modus-themes-completion-match-1))) - `(orderless-match-face-2 ((,class :inherit modus-themes-completion-match-2))) - `(orderless-match-face-3 ((,class :inherit modus-themes-completion-match-3))) + `(orderless-match-face-0 ((,c :inherit modus-themes-completion-match-0))) + `(orderless-match-face-1 ((,c :inherit modus-themes-completion-match-1))) + `(orderless-match-face-2 ((,c :inherit modus-themes-completion-match-2))) + `(orderless-match-face-3 ((,c :inherit modus-themes-completion-match-3))) ;;;;; org - `(org-agenda-calendar-event ((,class ,@(modus-themes--agenda-event blue-alt)))) - `(org-agenda-calendar-sexp ((,class ,@(modus-themes--agenda-event blue-alt t)))) - `(org-agenda-clocking ((,class :background ,yellow-nuanced-bg :foreground ,red-alt))) - `(org-agenda-column-dateline ((,class :background ,bg-alt))) - `(org-agenda-current-time ((,class :foreground ,blue-alt-other-faint))) - `(org-agenda-date ((,class ,@(modus-themes--agenda-date cyan fg-main)))) - `(org-agenda-date-today - ((,class ,@(modus-themes--agenda-date cyan fg-main nil nil bg-special-cold t t)))) - `(org-agenda-date-weekend - ((,class ,@(modus-themes--agenda-date cyan-alt-other-faint fg-alt cyan fg-main)))) - `(org-agenda-date-weekend-today - ((,class ,@(modus-themes--agenda-date cyan-alt-other-faint fg-alt cyan fg-main bg-special-cold t t)))) - `(org-agenda-diary ((,class :inherit org-agenda-calendar-sexp))) - `(org-agenda-dimmed-todo-face ((,class :inherit shadow))) - `(org-agenda-done ((,class :inherit modus-themes-grue-nuanced))) - `(org-agenda-filter-category ((,class :inherit bold :foreground ,cyan-active))) - `(org-agenda-filter-effort ((,class :inherit bold :foreground ,cyan-active))) - `(org-agenda-filter-regexp ((,class :inherit bold :foreground ,cyan-active))) - `(org-agenda-filter-tags ((,class :inherit bold :foreground ,cyan-active))) - `(org-agenda-restriction-lock ((,class :background ,bg-dim :foreground ,fg-dim))) - `(org-agenda-structure ((,class ,@(modus-themes--agenda-structure blue-alt)))) - `(org-agenda-structure-filter ((,class :inherit org-agenda-structure :foreground ,yellow))) - `(org-agenda-structure-secondary ((,class :foreground ,cyan))) - `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt))) - `(org-block ((,class :inherit modus-themes-fixed-pitch - ,@(modus-themes--org-block bg-dim fg-main)))) - `(org-block-begin-line ((,class :inherit modus-themes-fixed-pitch - ,@(modus-themes--org-block-delim - bg-dim fg-special-cold - bg-alt fg-alt)))) - `(org-block-end-line ((,class :inherit org-block-begin-line))) - `(org-checkbox ((,class :foreground ,yellow-alt-other))) - `(org-checkbox-statistics-done ((,class :inherit org-done))) - `(org-checkbox-statistics-todo ((,class :inherit org-todo))) - `(org-clock-overlay ((,class :background ,yellow-nuanced-bg :foreground ,red-alt-faint))) - `(org-code ((,class :inherit modus-themes-markup-code :extend t))) - `(org-column ((,class :inherit (modus-themes-fixed-pitch default) - :background ,bg-alt))) - `(org-column-title ((,class :inherit (bold modus-themes-fixed-pitch default) - :underline t :background ,bg-alt))) - `(org-date ((,class :inherit (modus-themes-link-symlink modus-themes-fixed-pitch)))) - `(org-date-selected ((,class :foreground ,blue-alt :inverse-video t))) - `(org-dispatcher-highlight ((,class :inherit (bold modus-themes-mark-alt)))) - `(org-document-info ((,class :foreground ,fg-special-cold))) - `(org-document-info-keyword ((,class :inherit (shadow modus-themes-fixed-pitch)))) - `(org-document-title ((,class :inherit modus-themes-heading-0))) - `(org-done ((,class :inherit modus-themes-grue))) - `(org-drawer ((,class :inherit (shadow modus-themes-fixed-pitch)))) - `(org-ellipsis (())) ; inherits from the heading's color - `(org-footnote ((,class :inherit button - ,@(modus-themes--link-color - blue-alt blue-alt-faint)))) - `(org-formula ((,class :inherit modus-themes-fixed-pitch :foreground ,red-alt))) - `(org-habit-alert-face ((,class ,@(modus-themes--agenda-habit - yellow-graph-0-bg - yellow-graph-0-bg - yellow-graph-1-bg) - :foreground "black"))) ; special case - `(org-habit-alert-future-face ((,class ,@(modus-themes--agenda-habit - yellow-graph-1-bg - yellow-graph-0-bg - yellow-graph-1-bg)))) - `(org-habit-clear-face ((,class ,@(modus-themes--agenda-habit - blue-graph-0-bg - green-graph-1-bg - blue-graph-1-bg - blue-graph-1-bg - blue-graph-1-bg) - :foreground "black"))) ; special case - `(org-habit-clear-future-face ((,class ,@(modus-themes--agenda-habit - blue-graph-1-bg - green-graph-1-bg - blue-graph-1-bg - blue-graph-1-bg - blue-graph-1-bg)))) - `(org-habit-overdue-face ((,class ,@(modus-themes--agenda-habit - red-graph-0-bg - red-graph-0-bg - red-graph-1-bg)))) - `(org-habit-overdue-future-face ((,class ,@(modus-themes--agenda-habit - red-graph-1-bg - red-graph-0-bg - red-graph-1-bg)))) - `(org-habit-ready-face ((,class ,@(modus-themes--agenda-habit - green-graph-0-bg - green-graph-0-bg - green-graph-1-bg - cyan-graph-0-bg - blue-graph-0-bg - cyan-graph-1-bg) - :foreground "black"))) ; special case - `(org-habit-ready-future-face ((,class ,@(modus-themes--agenda-habit - green-graph-1-bg - green-graph-0-bg - green-graph-1-bg - cyan-graph-1-bg - blue-graph-0-bg - cyan-graph-1-bg)))) - `(org-headline-done ((,class :inherit (modus-themes-variable-pitch modus-themes-grue-nuanced)))) - `(org-headline-todo ((,class :inherit modus-themes-variable-pitch :foreground ,red-nuanced-fg))) - `(org-hide ((,class :foreground ,bg-main))) - `(org-indent ((,class :inherit (fixed-pitch org-hide)))) - `(org-imminent-deadline ((,class :foreground ,red-intense))) - `(org-latex-and-related ((,class :foreground ,magenta-faint))) - `(org-level-1 ((,class :inherit modus-themes-heading-1))) - `(org-level-2 ((,class :inherit modus-themes-heading-2))) - `(org-level-3 ((,class :inherit modus-themes-heading-3))) - `(org-level-4 ((,class :inherit modus-themes-heading-4))) - `(org-level-5 ((,class :inherit modus-themes-heading-5))) - `(org-level-6 ((,class :inherit modus-themes-heading-6))) - `(org-level-7 ((,class :inherit modus-themes-heading-7))) - `(org-level-8 ((,class :inherit modus-themes-heading-8))) - `(org-link ((,class :inherit button))) - `(org-list-dt ((,class :inherit bold))) - `(org-macro ((,class :inherit modus-themes-markup-macro))) - `(org-meta-line ((,class :inherit (shadow modus-themes-fixed-pitch)))) - `(org-mode-line-clock ((,class :foreground ,fg-main))) - `(org-mode-line-clock-overrun ((,class :inherit bold :foreground ,red-active))) - `(org-priority ((,class :foreground ,magenta))) - `(org-property-value ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold))) - `(org-quote ((,class ,@(modus-themes--org-block bg-dim fg-special-cold fg-main)))) - `(org-scheduled ((,class ,@(modus-themes--agenda-scheduled yellow-faint fg-special-warm magenta-alt)))) - `(org-scheduled-previously ((,class ,@(modus-themes--agenda-scheduled yellow fg-special-warm yellow-alt-other)))) - `(org-scheduled-today ((,class ,@(modus-themes--agenda-scheduled yellow fg-special-warm magenta-alt-other)))) - `(org-sexp-date ((,class :foreground ,cyan-alt-other))) - `(org-special-keyword ((,class :inherit (shadow modus-themes-fixed-pitch)))) - `(org-table ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold))) - `(org-table-header ((,class :inherit (fixed-pitch modus-themes-special-cold)))) - `(org-tag ((,class :foreground ,magenta-nuanced-fg))) - `(org-tag-group ((,class :inherit bold :foreground ,cyan-nuanced-fg))) - `(org-target ((,class :underline t))) - `(org-time-grid ((,class :inherit shadow))) - `(org-todo ((,class :foreground ,red))) - `(org-upcoming-deadline ((,class :foreground ,red-alt-other))) - `(org-upcoming-distant-deadline ((,class :foreground ,red-faint))) - `(org-verbatim ((,class :inherit modus-themes-markup-verbatim))) - `(org-verse ((,class :inherit org-quote))) - `(org-warning ((,class :inherit bold :foreground ,red-alt-other))) + `(org-agenda-calendar-event ((,c :foreground ,date-event))) + `(org-agenda-calendar-sexp ((,c :inherit (modus-themes-slant org-agenda-calendar-event)))) + `(org-agenda-clocking ((,c :inherit modus-themes-mark-alt))) + `(org-agenda-column-dateline ((,c :background ,bg-inactive))) + `(org-agenda-current-time ((,c :foreground ,date-now))) + `(org-agenda-date ((,c ,@(modus-themes--heading 'agenda-date date-weekday)))) + `(org-agenda-date-today ((,c :inherit org-agenda-date :underline t))) + `(org-agenda-date-weekend ((,c :inherit org-agenda-date :foreground ,date-weekend))) + `(org-agenda-date-weekend-today ((,c :inherit org-agenda-date-today :foreground ,date-weekend))) + `(org-agenda-diary ((,c :inherit org-agenda-calendar-sexp))) + `(org-agenda-dimmed-todo-face ((,c :inherit shadow))) + `(org-agenda-done ((,c :inherit org-done))) + `(org-agenda-filter-category ((,c :inherit bold :foreground ,modeline-err))) + `(org-agenda-filter-effort ((,c :inherit bold :foreground ,modeline-err))) + `(org-agenda-filter-regexp ((,c :inherit bold :foreground ,modeline-err))) + `(org-agenda-filter-tags ((,c :inherit bold :foreground ,modeline-err))) + `(org-agenda-restriction-lock ((,c :background ,bg-dim :foreground ,fg-dim))) + `(org-agenda-structure ((,c ,@(modus-themes--heading 'agenda-structure fg-alt)))) + `(org-agenda-structure-filter ((,c :inherit org-agenda-structure :foreground ,warning))) + `(org-agenda-structure-secondary ((,c :inherit font-lock-doc-face))) + `(org-archived ((,c :background ,bg-inactive :foreground ,fg-main))) + `(org-block ((,c ,@(modus-themes--org-block fg-main bg-dim)))) + `(org-block-begin-line ((,c ,@(modus-themes--org-block prose-block bg-inactive)))) + `(org-block-end-line ((,c :inherit org-block-begin-line))) + `(org-checkbox ((,c :foreground ,warning))) + `(org-checkbox-statistics-done ((,c :inherit org-done))) + `(org-checkbox-statistics-todo ((,c :inherit org-todo))) + `(org-clock-overlay ((,c :inherit secondary-selection))) + `(org-code ((,c :inherit modus-themes-prose-code))) + `(org-column ((,c :inherit default :background ,bg-dim))) + `(org-column-title ((,c :inherit (bold default) :underline t :background ,bg-dim))) + `(org-date ((,c :inherit modus-themes-fixed-pitch :foreground ,date-common))) + `(org-date-selected ((,c :foreground ,date-common :inverse-video t))) + `(org-document-info ((,c :foreground ,prose-metadata-value))) + `(org-document-info-keyword ((,c :foreground ,prose-metadata))) + `(org-document-title ((,c :inherit modus-themes-heading-0))) + `(org-done ((,c :foreground ,prose-done))) + `(org-drawer ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata))) + `(org-ellipsis (( ))) ; inherits from the heading's color + `(org-footnote ((,c :inherit link))) + `(org-formula ((,c :inherit modus-themes-fixed-pitch :foreground ,fnname))) + `(org-headline-done ((,c :inherit org-done))) + `(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 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))) + `(org-level-3 ((,c :inherit modus-themes-heading-3))) + `(org-level-4 ((,c :inherit modus-themes-heading-4))) + `(org-level-5 ((,c :inherit modus-themes-heading-5))) + `(org-level-6 ((,c :inherit modus-themes-heading-6))) + `(org-level-7 ((,c :inherit modus-themes-heading-7))) + `(org-level-8 ((,c :inherit modus-themes-heading-8))) + `(org-link ((,c :inherit link))) + `(org-list-dt ((,c :inherit bold))) + `(org-macro ((,c :inherit modus-themes-prose-macro))) + `(org-meta-line ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata))) + `(org-mode-line-clock (( ))) + `(org-mode-line-clock-overrun ((,c :inherit bold :foreground ,modeline-err))) + `(org-priority ((,c :foreground ,prose-tag))) + `(org-property-value ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata-value))) + `(org-quote ((,c :inherit org-block))) + `(org-scheduled ((,c :foreground ,date-scheduled))) + `(org-scheduled-previously ((,c :inherit 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))) + `(org-table-header ((,c :inherit (bold org-table)))) + `(org-tag ((,c :foreground ,prose-tag))) + `(org-tag-group ((,c :inherit (bold org-tag)))) + `(org-target ((,c :underline t))) + `(org-time-grid ((,c :foreground ,fg-dim))) + `(org-todo ((,c :foreground ,prose-todo))) + `(org-upcoming-deadline ((,c :foreground ,date-deadline))) + `(org-upcoming-distant-deadline ((,c :inherit org-upcoming-deadline))) + `(org-verbatim ((,c :inherit modus-themes-prose-verbatim))) + `(org-verse ((,c :inherit org-block))) + `(org-warning ((,c :inherit warning))) +;;;;; org-habit + `(org-habit-alert-face ((,c :background ,bg-graph-yellow-0 :foreground "black"))) ; fg is special case + `(org-habit-alert-future-face ((,c :background ,bg-graph-yellow-1))) + `(org-habit-clear-face ((,c :background ,bg-graph-blue-0 :foreground "black"))) ; fg is special case + `(org-habit-clear-future-face ((,c :background ,bg-graph-blue-1))) + `(org-habit-overdue-face ((,c :background ,bg-graph-red-0))) + `(org-habit-overdue-future-face ((,c :background ,bg-graph-red-1))) + `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground "black"))) ; fg is special case + `(org-habit-ready-future-face ((,c :background ,bg-graph-green-1))) ;;;;; org-journal - `(org-journal-calendar-entry-face ((,class :inherit modus-themes-slant :foreground ,yellow-alt-other))) - `(org-journal-calendar-scheduled-face ((,class :inherit modus-themes-slant :foreground ,red-alt-other))) - `(org-journal-highlight ((,class :foreground ,magenta-alt))) + `(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)))) + `(org-journal-highlight ((,c :foreground ,err))) ;;;;; org-noter - `(org-noter-no-notes-exist-face ((,class :inherit error))) - `(org-noter-notes-exist-face ((,class :inherit success))) + `(org-noter-no-notes-exist-face ((,c :inherit error))) + `(org-noter-notes-exist-face ((,c :inherit success))) ;;;;; org-pomodoro - `(org-pomodoro-mode-line ((,class :foreground ,red-active))) - `(org-pomodoro-mode-line-break ((,class :foreground ,cyan-active))) - `(org-pomodoro-mode-line-overtime ((,class :inherit bold :foreground ,red-active))) + `(org-pomodoro-mode-line ((,c :foreground ,err))) + `(org-pomodoro-mode-line-break ((,c :foreground ,info))) + `(org-pomodoro-mode-line-overtime ((,c :inherit error))) ;;;;; org-recur - `(org-recur ((,class :foreground ,magenta-active))) + `(org-recur ((,c :foreground ,fg-alt))) ;;;;; org-roam - `(org-roam-dim ((,class :foreground "gray50"))) - `(org-roam-header-line ((,class :inherit bold :foreground ,magenta-active))) - `(org-roam-olp ((,class :inherit shadow))) - `(org-roam-preview-heading ((,class :inherit modus-themes-subtle-neutral))) - `(org-roam-preview-heading-highlight ((,class :inherit modus-themes-intense-neutral))) - `(org-roam-preview-heading-selection ((,class :inherit modus-themes-special-cold))) - `(org-roam-preview-region ((,class :inherit bold))) - `(org-roam-title ((,class :inherit modus-themes-pseudo-header))) + `(org-roam-dim ((,c :foreground "gray50"))) + `(org-roam-olp ((,c :inherit shadow))) + `(org-roam-preview-heading ((,c :background ,bg-inactive))) + `(org-roam-preview-heading-highlight ((,c :background ,bg-active :foreground ,fg-main))) + `(org-roam-preview-region ((,c :inherit bold))) + `(org-roam-title ((,c :inherit bold))) ;;;;; org-superstar - `(org-superstar-item ((,class :foreground ,fg-main))) - `(org-superstar-leading ((,class :foreground ,fg-whitespace))) -;;;;; org-table-sticky-header - `(org-table-sticky-header-face ((,class :inherit modus-themes-special-cold))) + `(org-superstar-item ((,c :foreground ,fg-main))) ;;;;; org-tree-slide - `(org-tree-slide-header-overlay-face ((,class :inherit org-document-title))) + `(org-tree-slide-header-overlay-face ((,c :inherit org-document-title))) ;;;;; origami - `(origami-fold-header-face ((,class :background ,bg-dim :foreground ,fg-dim :box t))) - `(origami-fold-replacement-face ((,class :background ,bg-alt :foreground ,fg-alt))) + `(origami-fold-header-face ((,c :background ,bg-dim :foreground ,fg-dim :box t))) + `(origami-fold-replacement-face ((,c :background ,bg-inactive :foreground ,fg-dim))) ;;;;; outline-mode - `(outline-1 ((,class :inherit modus-themes-heading-1))) - `(outline-2 ((,class :inherit modus-themes-heading-2))) - `(outline-3 ((,class :inherit modus-themes-heading-3))) - `(outline-4 ((,class :inherit modus-themes-heading-4))) - `(outline-5 ((,class :inherit modus-themes-heading-5))) - `(outline-6 ((,class :inherit modus-themes-heading-6))) - `(outline-7 ((,class :inherit modus-themes-heading-7))) - `(outline-8 ((,class :inherit modus-themes-heading-8))) + `(outline-1 ((,c :inherit modus-themes-heading-1))) + `(outline-2 ((,c :inherit modus-themes-heading-2))) + `(outline-3 ((,c :inherit modus-themes-heading-3))) + `(outline-4 ((,c :inherit modus-themes-heading-4))) + `(outline-5 ((,c :inherit modus-themes-heading-5))) + `(outline-6 ((,c :inherit modus-themes-heading-6))) + `(outline-7 ((,c :inherit modus-themes-heading-7))) + `(outline-8 ((,c :inherit modus-themes-heading-8))) ;;;;; outline-minor-faces `(outline-minor-0 (())) ;;;;; package (M-x list-packages) - `(package-description ((,class :foreground ,fg-special-cold))) - `(package-help-section-name ((,class :inherit bold :foreground ,cyan))) - `(package-name ((,class :inherit button))) - `(package-status-available ((,class :foreground ,cyan-alt-other))) - `(package-status-avail-obso ((,class :inherit error))) - `(package-status-built-in ((,class :foreground ,magenta))) - `(package-status-dependency ((,class :foreground ,magenta-alt-other))) - `(package-status-disabled ((,class :inherit modus-themes-subtle-red))) - `(package-status-external ((,class :foreground ,cyan-alt-other))) - `(package-status-held ((,class :foreground ,yellow-alt))) - `(package-status-incompat ((,class :inherit warning))) - `(package-status-installed ((,class :foreground ,fg-special-warm))) - `(package-status-new ((,class :inherit success))) - `(package-status-unsigned ((,class :inherit error))) + `(package-description ((,c :foreground ,docstring))) + `(package-help-section-name ((,c :inherit bold))) + `(package-name ((,c :inherit link))) + `(package-status-available ((,c :foreground ,date-common))) + `(package-status-avail-obso ((,c :inherit error))) + `(package-status-built-in ((,c :foreground ,builtin))) + `(package-status-dependency ((,c :foreground ,warning))) + `(package-status-disabled ((,c :inherit error :strike-through t))) + `(package-status-from-source ((,c :foreground ,type))) + `(package-status-held ((,c :foreground ,warning))) + `(package-status-incompat ((,c :inherit warning))) + `(package-status-installed ((,c :foreground ,fg-alt))) + `(package-status-new ((,c :inherit success))) + `(package-status-unsigned ((,c :inherit error))) ;;;;; page-break-lines - `(page-break-lines ((,class :inherit default :foreground ,fg-window-divider-outer))) + `(page-break-lines ((,c :inherit default :foreground "gray50"))) ;;;;; pandoc-mode - `(pandoc-citation-key-face ((,class :background ,bg-dim :foreground ,magenta-alt))) - `(pandoc-directive-@@-face ((,class :background ,bg-dim :foreground ,blue-alt-other))) - `(pandoc-directive-braces-face ((,class :foreground ,blue-alt-other))) - `(pandoc-directive-contents-face ((,class :foreground ,cyan-alt-other))) - `(pandoc-directive-type-face ((,class :foreground ,magenta))) + `(pandoc-citation-key-face ((,c :inherit font-lock-builtin-face))) + `(pandoc-directive-@@-face ((,c :inherit font-lock-keyword-face))) + `(pandoc-directive-braces-face ((,c :inherit font-lock-constant-face))) + `(pandoc-directive-contents-face ((,c :inherit font-lock-string-face))) + `(pandoc-directive-type-face ((,c :inherit font-lock-type-face))) ;;;;; paren-face - `(parenthesis ((,class :foreground ,fg-unfocused))) + `(parenthesis ((,c :inherit shadow))) ;;;;; pass - `(pass-mode-directory-face ((,class :inherit bold :foreground ,fg-special-cold))) - `(pass-mode-entry-face ((,class :background ,bg-main :foreground ,fg-main))) - `(pass-mode-header-face ((,class :foreground ,fg-special-warm))) + `(pass-mode-directory-face ((,c :inherit bold :foreground ,accent-0))) + `(pass-mode-entry-face ((,c :background ,bg-main :foreground ,fg-main))) + `(pass-mode-header-face ((,c :inherit shadow))) ;;;;; pdf-tools - `(pdf-links-read-link ((,class :background ,fg-main :foreground ,magenta-intense-bg :inherit bold))) ; Foreground is background and vice versa - `(pdf-occur-document-face ((,class :inherit shadow))) - `(pdf-occur-page-face ((,class :inherit shadow))) + `(pdf-links-read-link ((,c :background ,fg-main :foreground ,bg-magenta-intense :inherit bold))) ; Foreground is background and vice versa + `(pdf-occur-document-face ((,c :inherit shadow))) + `(pdf-occur-page-face ((,c :inherit shadow))) ;;;;; persp-mode - `(persp-face-lighter-buffer-not-in-persp ((,class :inherit modus-themes-intense-red))) - `(persp-face-lighter-default ((,class :inherit bold :foreground ,blue-active))) - `(persp-face-lighter-nil-persp ((,class :inherit bold :foreground ,fg-active))) + `(persp-face-lighter-buffer-not-in-persp ((,c :inherit error))) + `(persp-face-lighter-default ((,c :inherit bold :foreground ,name))) + `(persp-face-lighter-nil-persp ((,c :inherit bold))) ;;;;; perspective - `(persp-selected-face ((,class :inherit bold :foreground ,blue-active))) -;;;;; phi-grep - `(phi-grep-heading-face ((,class :inherit modus-themes-pseudo-header :foreground ,fg-special-cold))) - `(phi-grep-line-number-face ((,class :foreground ,fg-special-warm))) - `(phi-grep-match-face ((,class :inherit modus-themes-special-calm))) - `(phi-grep-modified-face ((,class :inherit modus-themes-refine-yellow))) - `(phi-grep-overlay-face ((,class :inherit modus-themes-refine-blue))) -;;;;; pomidor - `(pomidor-break-face ((,class :foreground ,blue-alt-other))) - `(pomidor-overwork-face ((,class :foreground ,red-alt-other))) - `(pomidor-skip-face ((,class :inherit (shadow modus-themes-slant)))) - `(pomidor-work-face ((,class :inherit modus-themes-grue))) + `(persp-selected-face ((,c :inherit bold :foreground ,name))) ;;;;; popup - `(popup-face ((,class :background ,bg-alt :foreground ,fg-main))) - `(popup-isearch-match ((,class :inherit modus-themes-search-success))) - `(popup-menu-mouse-face ((,class :inherit highlight))) - `(popup-menu-selection-face ((,class :inherit modus-themes-completion-selected-popup))) - `(popup-scroll-bar-background-face ((,class :background ,bg-active))) - `(popup-scroll-bar-foreground-face ((,class :foreground ,fg-active))) - `(popup-summary-face ((,class :background ,bg-active :foreground ,fg-inactive))) - `(popup-tip-face ((,class :inherit modus-themes-refine-yellow))) + `(popup-face ((,c :background ,bg-inactive :foreground ,fg-main))) + `(popup-isearch-match ((,c :inherit modus-themes-search-current))) + `(popup-menu-mouse-face ((,c :inherit highlight))) + `(popup-menu-selection-face ((,c :inherit modus-themes-completion-selected))) + `(popup-scroll-bar-background-face ((,c :background ,bg-active))) + `(popup-scroll-bar-foreground-face (( ))) + `(popup-summary-face ((,c :background ,bg-active :foreground ,fg-dim))) + `(popup-tip-face ((,c :inherit modus-themes-intense-yellow))) ;;;;; powerline - `(powerline-active0 ((,class :background ,fg-unfocused :foreground ,bg-main))) - `(powerline-active1 ((,class :inherit mode-line-active))) - `(powerline-active2 ((,class :inherit mode-line-inactive))) - `(powerline-inactive0 ((,class :background ,bg-active :foreground ,fg-alt))) - `(powerline-inactive1 ((,class :background ,bg-main :foreground ,fg-alt))) - `(powerline-inactive2 ((,class :inherit mode-line-inactive))) + `(powerline-active0 ((,c :background ,fg-dim :foreground ,bg-main))) + `(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))) + `(powerline-inactive2 ((,c :inherit mode-line-inactive))) ;;;;; powerline-evil - `(powerline-evil-base-face ((,class :background ,fg-main :foreground ,bg-main))) - `(powerline-evil-emacs-face ((,class :inherit modus-themes-active-magenta))) - `(powerline-evil-insert-face ((,class :inherit modus-themes-active-green))) - `(powerline-evil-motion-face ((,class :inherit modus-themes-active-blue))) - `(powerline-evil-normal-face ((,class :background ,fg-alt :foreground ,bg-main))) - `(powerline-evil-operator-face ((,class :inherit modus-themes-active-yellow))) - `(powerline-evil-replace-face ((,class :inherit modus-themes-active-red))) - `(powerline-evil-visual-face ((,class :inherit modus-themes-active-cyan))) + `(powerline-evil-base-face ((,c :background ,fg-main :foreground ,bg-main))) + `(powerline-evil-emacs-face ((,c :inherit modus-themes-intense-magenta))) + `(powerline-evil-insert-face ((,c :inherit modus-themes-intense-green))) + `(powerline-evil-motion-face ((,c :inherit modus-themes-intense-blue))) + `(powerline-evil-normal-face ((,c :background ,fg-alt :foreground ,bg-main))) + `(powerline-evil-operator-face ((,c :inherit modus-themes-intense-yellow))) + `(powerline-evil-replace-face ((,c :inherit modus-themes-intense-red))) + `(powerline-evil-visual-face ((,c :inherit modus-themes-intense-cyan))) ;;;;; prescient - `(prescient-primary-highlight ((,class :inherit modus-themes-completion-match-0))) - `(prescient-secondary-highlight ((,class :inherit modus-themes-completion-match-1))) + `(prescient-primary-highlight ((,c :inherit modus-themes-completion-match-0))) + `(prescient-secondary-highlight ((,c :inherit modus-themes-completion-match-1))) ;;;;; proced - `(proced-mark ((,class :inherit modus-themes-mark-symbol))) - `(proced-marked ((,class :inherit modus-themes-mark-alt))) - `(proced-sort-header ((,class :inherit bold :foreground ,fg-special-calm :underline t))) + `(proced-mark ((,c :inherit bold))) + `(proced-marked ((,c :inherit modus-themes-mark-alt))) + `(proced-sort-header ((,c :inherit bold :underline t))) ;;;;; prodigy - `(prodigy-green-face ((,class :inherit success))) - `(prodigy-red-face ((,class :inherit error))) - `(prodigy-yellow-face ((,class :inherit warning))) + `(prodigy-green-face ((,c :inherit success))) + `(prodigy-red-face ((,c :inherit error))) + `(prodigy-yellow-face ((,c :inherit warning))) ;;;;; pulse - `(pulse-highlight-start-face ((,class :background ,bg-active-accent :extend t))) + `(pulse-highlight-start-face ((,c :background ,bg-blue-intense :extend t))) ;;;;; pyim - `(pyim-page ((,class :background ,bg-active :foreground ,fg-active))) - `(pyim-page-selection ((,class :inherit bold :background ,bg-active :foreground ,blue-active))) - `(pyim-page-subword ((,class :background ,bg-inactive))) + `(pyim-page ((,c :background ,bg-active))) + `(pyim-page-selection ((,c :inherit bold :background ,bg-active :foreground ,info))) + `(pyim-page-subword ((,c :background ,bg-inactive))) ;;;;; quick-peek - `(quick-peek-background-face ((,class :background ,bg-alt))) - `(quick-peek-border-face ((,class :background ,fg-window-divider-inner :height 1))) - `(quick-peek-padding-face ((,class :background ,bg-alt :height 0.15))) -;;;;; racket-mode - `(racket-debug-break-face ((,class :inherit modus-themes-intense-red))) - `(racket-debug-locals-face ((,class :box (:line-width -1 :color nil) - :foreground ,green-alt-other))) - `(racket-debug-result-face ((,class :inherit bold :box (:line-width -1 :color nil) - :foreground ,green))) - `(racket-here-string-face ((,class :foreground ,blue-alt))) - `(racket-keyword-argument-face ((,class :foreground ,red-alt))) - `(racket-logger-config-face ((,class :inherit (shadow modus-themes-slant)))) - `(racket-logger-debug-face ((,class :foreground ,blue-alt-other))) - `(racket-logger-info-face ((,class :foreground ,fg-lang-note))) - `(racket-logger-topic-face ((,class :inherit modus-themes-slant :foreground ,magenta))) - `(racket-selfeval-face ((,class :foreground ,green-alt))) - `(racket-xp-error-face ((,class :inherit modus-themes-lang-error))) -;;;;; rainbow-blocks - `(rainbow-blocks-depth-1-face ((,class :foreground ,magenta-alt-other))) - `(rainbow-blocks-depth-2-face ((,class :foreground ,blue))) - `(rainbow-blocks-depth-3-face ((,class :foreground ,magenta-alt))) - `(rainbow-blocks-depth-4-face ((,class :foreground ,green))) - `(rainbow-blocks-depth-5-face ((,class :foreground ,magenta))) - `(rainbow-blocks-depth-6-face ((,class :foreground ,cyan))) - `(rainbow-blocks-depth-7-face ((,class :foreground ,yellow))) - `(rainbow-blocks-depth-8-face ((,class :foreground ,cyan-alt))) - `(rainbow-blocks-depth-9-face ((,class :foreground ,red-alt))) - `(rainbow-blocks-unmatched-face ((,class :foreground ,red))) + `(quick-peek-background-face ((,c :background ,bg-inactive))) + `(quick-peek-border-face ((,c :background ,border :height 1))) + `(quick-peek-padding-face ((,c :background ,bg-inactive :height 0.15))) ;;;;; rainbow-delimiters - `(rainbow-delimiters-base-error-face ((,class :background ,red-subtle-bg :foreground ,fg-main))) - `(rainbow-delimiters-base-face ((,class :foreground ,fg-main))) - `(rainbow-delimiters-depth-1-face ((,class :foreground ,fg-main))) - `(rainbow-delimiters-depth-2-face ((,class :foreground ,magenta-intense))) - `(rainbow-delimiters-depth-3-face ((,class :foreground ,cyan-intense))) - `(rainbow-delimiters-depth-4-face ((,class :foreground ,orange-intense))) - `(rainbow-delimiters-depth-5-face ((,class :foreground ,purple-intense))) - `(rainbow-delimiters-depth-6-face ((,class :foreground ,green-intense))) - `(rainbow-delimiters-depth-7-face ((,class :foreground ,red-intense))) - `(rainbow-delimiters-depth-8-face ((,class :foreground ,blue-intense))) - `(rainbow-delimiters-depth-9-face ((,class :foreground ,yellow-intense))) - `(rainbow-delimiters-mismatched-face ((,class :inherit (bold modus-themes-refine-yellow)))) - `(rainbow-delimiters-unmatched-face ((,class :inherit (bold modus-themes-refine-red)))) + `(rainbow-delimiters-base-error-face ((,c :inherit modus-themes-subtle-red))) + `(rainbow-delimiters-base-face ((,c :foreground ,fg-main))) + `(rainbow-delimiters-depth-1-face ((,c :foreground ,rainbow-0))) + `(rainbow-delimiters-depth-2-face ((,c :foreground ,rainbow-1))) + `(rainbow-delimiters-depth-3-face ((,c :foreground ,rainbow-2))) + `(rainbow-delimiters-depth-4-face ((,c :foreground ,rainbow-3))) + `(rainbow-delimiters-depth-5-face ((,c :foreground ,rainbow-4))) + `(rainbow-delimiters-depth-6-face ((,c :foreground ,rainbow-5))) + `(rainbow-delimiters-depth-7-face ((,c :foreground ,rainbow-6))) + `(rainbow-delimiters-depth-8-face ((,c :foreground ,rainbow-7))) + `(rainbow-delimiters-depth-9-face ((,c :foreground ,rainbow-8))) + `(rainbow-delimiters-mismatched-face ((,c :inherit (bold modus-themes-intense-yellow)))) + `(rainbow-delimiters-unmatched-face ((,c :inherit (bold modus-themes-intense-red)))) ;;;;; rcirc - `(rcirc-bright-nick ((,class :inherit bold :foreground ,magenta-intense))) - `(rcirc-dim-nick ((,class :inherit shadow))) - `(rcirc-monospace-text ((,class :inherit fixed-pitch))) - `(rcirc-my-nick ((,class :inherit bold :foreground ,magenta))) - `(rcirc-nick-in-message ((,class :inherit bold :foreground ,red-alt))) - `(rcirc-nick-in-message-full-line ((,class :inherit bold :foreground ,cyan-alt-other))) - `(rcirc-other-nick ((,class :inherit bold :foreground ,blue))) - `(rcirc-prompt ((,class :inherit modus-themes-prompt))) - `(rcirc-server ((,class :inherit shadow))) - `(rcirc-timestamp ((,class :foreground ,cyan))) - `(rcirc-track-keyword ((,class :inherit bold))) - `(rcirc-track-nick ((,class :inherit bold :foreground ,red-active))) - `(rcirc-url ((,class :inherit link))) + `(rcirc-bright-nick ((,c :inherit bold :foreground ,accent-2))) + `(rcirc-dim-nick ((,c :inherit shadow))) + `(rcirc-monospace-text ((,c :inherit fixed-pitch))) + `(rcirc-my-nick ((,c :inherit bold :foreground ,accent-1))) + `(rcirc-nick-in-message ((,c :inherit rcirc-my-nick))) + `(rcirc-nick-in-message-full-line ((,c :inherit rcirc-my-nick))) + `(rcirc-other-nick ((,c :inherit bold :foreground ,accent-0))) + `(rcirc-prompt ((,c :inherit minibuffer-prompt))) + `(rcirc-server ((,c :inherit font-lock-comment-face))) + `(rcirc-timestamp ((,c :foreground ,date-common))) + `(rcirc-track-keyword ((,c :inherit bold :foreground ,modeline-warning))) + `(rcirc-track-nick ((,c :inherit rcirc-my-nick))) + `(rcirc-url ((,c :inherit link))) ;;;;; recursion-indicator - `(recursion-indicator-general ((,class :foreground ,blue-active))) - `(recursion-indicator-minibuffer ((,class :foreground ,red-active))) + `(recursion-indicator-general ((,c :foreground ,modeline-err))) + `(recursion-indicator-minibuffer ((,c :foreground ,modeline-info))) ;;;;; regexp-builder (re-builder) - `(reb-match-0 ((,class :inherit modus-themes-refine-cyan))) - `(reb-match-1 ((,class :inherit modus-themes-subtle-magenta))) - `(reb-match-2 ((,class :inherit modus-themes-subtle-green))) - `(reb-match-3 ((,class :inherit modus-themes-refine-yellow))) - `(reb-regexp-grouping-backslash ((,class :inherit font-lock-regexp-grouping-backslash))) - `(reb-regexp-grouping-construct ((,class :inherit font-lock-regexp-grouping-construct))) + `(reb-match-0 ((,c :inherit modus-themes-intense-cyan))) + `(reb-match-1 ((,c :inherit modus-themes-subtle-magenta))) + `(reb-match-2 ((,c :inherit modus-themes-subtle-green))) + `(reb-match-3 ((,c :inherit modus-themes-intense-yellow))) + `(reb-regexp-grouping-backslash ((,c :inherit font-lock-regexp-grouping-backslash))) + `(reb-regexp-grouping-construct ((,c :inherit font-lock-regexp-grouping-construct))) ;;;;; rg (rg.el) - `(rg-column-number-face ((,class :foreground ,magenta-alt-other))) - `(rg-context-face ((,class :foreground ,fg-unfocused))) - `(rg-error-face ((,class :inherit bold :foreground ,red))) - `(rg-file-tag-face ((,class :foreground ,fg-special-cold))) - `(rg-filename-face ((,class :inherit bold :foreground ,fg-special-cold))) - `(rg-line-number-face ((,class :foreground ,fg-special-warm))) - `(rg-literal-face ((,class :foreground ,blue-alt))) - `(rg-match-face ((,class :inherit modus-themes-special-calm))) - `(rg-regexp-face ((,class :foreground ,magenta-active))) - `(rg-toggle-off-face ((,class :inherit bold :foreground ,fg-inactive))) - `(rg-toggle-on-face ((,class :inherit bold :foreground ,cyan-active))) - `(rg-warning-face ((,class :inherit bold :foreground ,yellow))) + `(rg-column-number-face ((,c :inherit shadow))) + `(rg-context-face ((,c :inherit shadow))) + `(rg-error-face ((,c :inherit error))) + `(rg-file-tag-face ((,c :inherit font-lock-builtin-face))) + `(rg-filename-face ((,c :inherit bold :foreground ,name))) + `(rg-line-number-face ((,c :inherit shadow))) + `(rg-literal-face ((,c :inherit font-lock-constant-face))) + `(rg-match-face ((,c :inherit match))) + `(rg-regexp-face ((,c :foreground ,name))) + `(rg-toggle-off-face ((,c :inherit (shadow bold)))) + `(rg-toggle-on-face ((,c :inherit success))) + `(rg-warning-face ((,c :inherit warning))) ;;;;; ripgrep - `(ripgrep-context-face ((,class :foreground ,fg-unfocused))) - `(ripgrep-error-face ((,class :inherit bold :foreground ,red))) - `(ripgrep-hit-face ((,class :foreground ,cyan))) - `(ripgrep-match-face ((,class :inherit modus-themes-special-calm))) + `(ripgrep-context-face ((,c :inherit shadow))) + `(ripgrep-error-face ((,c :inherit error))) + `(ripgrep-hit-face ((,c :inherit success))) + `(ripgrep-match-face ((,c :inherit match))) ;;;;; rmail - `(rmail-header-name ((,class :foreground ,cyan-alt-other))) - `(rmail-highlight ((,class :inherit bold :foreground ,magenta-alt))) + `(rmail-header-name ((,c :inherit bold))) + `(rmail-highlight ((,c :inherit bold :foreground ,mail-other))) ;;;;; ruler-mode - `(ruler-mode-column-number ((,class :inherit ruler-mode-default :foreground ,fg-main))) - `(ruler-mode-comment-column ((,class :inherit ruler-mode-default :foreground ,red))) - `(ruler-mode-current-column ((,class :inherit ruler-mode-default :background ,blue-subtle-bg :foreground ,fg-main))) - `(ruler-mode-default ((,class :inherit default :background ,bg-alt :foreground ,fg-unfocused))) - `(ruler-mode-fill-column ((,class :inherit ruler-mode-default :foreground ,green))) - `(ruler-mode-fringes ((,class :inherit ruler-mode-default :foreground ,cyan))) - `(ruler-mode-goal-column ((,class :inherit ruler-mode-default :foreground ,blue))) - `(ruler-mode-margins ((,class :inherit ruler-mode-default :foreground ,bg-main))) - `(ruler-mode-pad ((,class :inherit ruler-mode-default :background ,bg-active :foreground ,fg-inactive))) - `(ruler-mode-tab-stop ((,class :inherit ruler-mode-default :foreground ,fg-special-warm))) -;;;;; selectrum - `(selectrum-current-candidate ((,class :inherit modus-themes-completion-selected))) - `(selectrum-mouse-highlight ((,class :inherit highlight))) - `(selectrum-quick-keys-highlight ((,class :inherit bold :background ,bg-char-0))) - `(selectrum-quick-keys-match ((,class :inherit bold :background ,bg-char-1))) -;;;;; semantic - `(semantic-complete-inline-face ((,class :foreground ,fg-special-warm :underline t))) - `(semantic-decoration-on-fileless-includes ((,class :inherit modus-themes-refine-green))) - `(semantic-decoration-on-private-members-face ((,class :inherit modus-themes-refine-cyan))) - `(semantic-decoration-on-protected-members-face ((,class :background ,bg-dim))) - `(semantic-decoration-on-unknown-includes ((,class :inherit modus-themes-refine-red))) - `(semantic-decoration-on-unparsed-includes ((,class :inherit modus-themes-refine-yellow))) - `(semantic-highlight-edits-face ((,class :background ,bg-alt))) - `(semantic-highlight-func-current-tag-face ((,class :background ,bg-alt))) - `(semantic-idle-symbol-highlight ((,class :inherit modus-themes-special-mild))) - `(semantic-tag-boundary-face ((,class :overline ,blue-intense))) - `(semantic-unmatched-syntax-face ((,class :underline ,fg-lang-error))) + `(ruler-mode-column-number ((,c :inherit ruler-mode-default))) + `(ruler-mode-comment-column ((,c :inherit ruler-mode-default :foreground ,red))) + `(ruler-mode-current-column ((,c :inherit ruler-mode-default :background ,bg-active :foreground ,fg-main))) + `(ruler-mode-default ((,c :inherit default :background ,bg-dim :foreground ,fg-dim))) + `(ruler-mode-fill-column ((,c :inherit ruler-mode-default :foreground ,green))) + `(ruler-mode-fringes ((,c :inherit ruler-mode-default :foreground ,cyan))) + `(ruler-mode-goal-column ((,c :inherit ruler-mode-default :foreground ,blue))) + `(ruler-mode-margins ((,c :inherit ruler-mode-default :foreground ,bg-main))) + `(ruler-mode-pad ((,c :inherit ruler-mode-default :background ,bg-inactive :foreground ,fg-dim))) + `(ruler-mode-tab-stop ((,c :inherit ruler-mode-default :foreground ,yellow))) ;;;;; sesman - `(sesman-browser-button-face ((,class :inherit button))) - `(sesman-browser-highligh-face ((,class :inherit highlight))) - `(sesman-buffer-face ((,class :foreground ,magenta))) - `(sesman-directory-face ((,class :inherit bold :foreground ,blue))) - `(sesman-project-face ((,class :inherit bold :foreground ,magenta-alt-other))) + `(sesman-browser-button-face ((,c :inherit button))) + `(sesman-browser-highligh-face ((,c :inherit highlight))) + `(sesman-buffer-face ((,c :foreground ,accent-1))) + `(sesman-directory-face ((,c :inherit bold :foreground ,accent-0))) + `(sesman-project-face ((,c :inherit bold :foreground ,accent-2))) ;;;;; shell-script-mode - `(sh-heredoc ((,class :foreground ,blue-alt))) - `(sh-quoted-exec ((,class :inherit modus-themes-bold :foreground ,magenta-alt))) + `(sh-heredoc ((,c :inherit font-lock-string-face))) + `(sh-quoted-exec ((,c :inherit font-lock-builtin-face))) ;;;;; shortdoc - `(shortdoc-heading ((,class :inherit modus-themes-pseudo-header))) + `(shortdoc-heading ((,c :inherit bold))) `(shortdoc-section (())) ; remove the default's variable-pitch style ;;;;; show-paren-mode - `(show-paren-match ((,class ,@(modus-themes--paren bg-paren-match - bg-paren-match-intense) - :foreground ,fg-main))) - `(show-paren-match-expression ((,class :background ,bg-paren-expression))) - `(show-paren-mismatch ((,class :inherit modus-themes-intense-red))) + `(show-paren-match ((,c :background ,bg-paren-match :foreground ,fg-main :underline ,underline-paren-match))) + `(show-paren-match-expression ((,c :background ,bg-paren-expression))) + `(show-paren-mismatch ((,c :inherit modus-themes-intense-red))) ;;;;; shr - `(shr-abbreviation ((,class :inherit modus-themes-lang-note))) - `(shr-code ((,class :inherit modus-themes-markup-verbatim))) - `(shr-h1 ((,class :inherit modus-themes-heading-1))) - `(shr-h2 ((,class :inherit modus-themes-heading-2))) - `(shr-h3 ((,class :inherit modus-themes-heading-3))) - `(shr-h4 ((,class :inherit modus-themes-heading-4))) - `(shr-h5 ((,class :inherit modus-themes-heading-5))) - `(shr-h6 ((,class :inherit modus-themes-heading-6))) - `(shr-selected-link ((,class :inherit modus-themes-subtle-red))) + `(shr-abbreviation ((,c :inherit modus-themes-lang-note))) + `(shr-code ((,c :inherit modus-themes-prose-verbatim))) + `(shr-h1 ((,c :inherit modus-themes-heading-1))) + `(shr-h2 ((,c :inherit modus-themes-heading-2))) + `(shr-h3 ((,c :inherit modus-themes-heading-3))) + `(shr-h4 ((,c :inherit modus-themes-heading-4))) + `(shr-h5 ((,c :inherit modus-themes-heading-5))) + `(shr-h6 ((,c :inherit modus-themes-heading-6))) + `(shr-selected-link ((,c :inherit modus-themes-subtle-red))) ;;;;; side-notes - `(side-notes ((,class :background ,bg-dim :foreground ,fg-dim))) + `(side-notes ((,c :background ,bg-dim :foreground ,fg-dim))) ;;;;; sieve-mode - `(sieve-action-commands ((,class :inherit font-lock-builtin-face))) - `(sieve-control-commands ((,class :inherit font-lock-keyword-face))) - `(sieve-tagged-arguments ((,class :inherit font-lock-type-face))) - `(sieve-test-commands ((,class :inherit font-lock-function-name-face))) + `(sieve-action-commands ((,c :inherit font-lock-builtin-face))) + `(sieve-control-commands ((,c :inherit font-lock-keyword-face))) + `(sieve-tagged-arguments ((,c :inherit font-lock-type-face))) + `(sieve-test-commands ((,c :inherit font-lock-function-name-face))) ;;;;; skewer-mode - `(skewer-error-face ((,class :foreground ,red :underline t))) + `(skewer-error-face ((,c :inherit modus-themes-lang-error))) ;;;;; slime (sldb) - `(sldb-condition-face ((,class :inherit font-lock-preprocessor-face))) - `(sldb-restart-number-face ((,class :inherit bold))) - `(sldb-restart-type-face ((,class :inherit font-lock-type-face))) - `(sldb-restartable-frame-line-face ((,class :inherit success))) - `(sldb-section-face ((,class :inherit modus-themes-pseudo-header))) - `(slime-error-face ((,class :inherit modus-themes-lang-error))) - `(slime-note-face ((,class :underline t))) - `(slime-repl-input-face ((,class :inherit bold))) - `(slime-repl-inputed-output-face ((,class :inherit font-lock-string-face))) - `(slime-repl-output-mouseover-face ((,class :inherit highlight))) - `(slime-repl-prompt-face ((,class :inherit modus-themes-prompt))) - `(slime-style-warning-face ((,class :inherit modus-themes-lang-note))) - `(slime-warning-face ((,class :inherit modus-themes-lang-warning))) + `(sldb-condition-face ((,c :inherit font-lock-preprocessor-face))) + `(sldb-restart-number-face ((,c :inherit bold))) + `(sldb-restart-type-face ((,c :inherit font-lock-type-face))) + `(sldb-restartable-frame-line-face ((,c :inherit success))) + `(sldb-section-face ((,c :inherit bold))) + `(slime-error-face ((,c :inherit modus-themes-lang-error))) + `(slime-note-face ((,c :underline t))) + `(slime-repl-input-face ((,c :inherit bold))) + `(slime-repl-inputed-output-face ((,c :inherit font-lock-string-face))) + `(slime-repl-output-mouseover-face ((,c :inherit highlight))) + `(slime-repl-prompt-face ((,c :inherit modus-themes-prompt))) + `(slime-style-warning-face ((,c :inherit modus-themes-lang-note))) + `(slime-warning-face ((,c :inherit modus-themes-lang-warning))) ;;;;; sly - `(sly-action-face ((,class :inherit font-lock-type-face))) - `(sly-db-condition-face ((,class :inherit font-lock-preprocessor-face))) - `(sly-db-restartable-frame-line-face ((,class :inherit success))) - `(sly-error-face ((,class :inherit modus-themes-lang-error))) - `(sly-mode-line ((,class :inherit mode-line-emphasis))) - `(sly-mrepl-output-face ((,class :inherit font-lock-string-face))) - `(sly-mrepl-output-face ((,class :inherit font-lock-string-face))) - `(sly-mrepl-prompt-face ((,class :inherit modus-themes-prompt))) - `(sly-note-face ((,class :inherit modus-themes-lang-note))) - `(sly-stickers-placed-face ((,class :inherit modus-themes-subtle-neutral))) - `(sly-style-warning-face ((,class :inherit modus-themes-lang-note))) - `(sly-warning-face ((,class :inherit modus-themes-lang-warning))) + `(sly-action-face ((,c :inherit font-lock-type-face))) + `(sly-db-condition-face ((,c :inherit font-lock-preprocessor-face))) + `(sly-db-restartable-frame-line-face ((,c :inherit success))) + `(sly-error-face ((,c :inherit modus-themes-lang-error))) + `(sly-mode-line ((,c :inherit mode-line-emphasis))) + `(sly-mrepl-output-face ((,c :inherit font-lock-string-face))) + `(sly-mrepl-output-face ((,c :inherit font-lock-string-face))) + `(sly-mrepl-prompt-face ((,c :inherit modus-themes-prompt))) + `(sly-note-face ((,c :inherit modus-themes-lang-note))) + `(sly-stickers-placed-face ((,c :background ,bg-inactive))) + `(sly-style-warning-face ((,c :inherit modus-themes-lang-note))) + `(sly-warning-face ((,c :inherit modus-themes-lang-warning))) ;;;;; smart-mode-line - `(sml/charging ((,class :foreground ,green-active))) - `(sml/discharging ((,class :foreground ,red-active))) - `(sml/filename ((,class :inherit bold :foreground ,blue-active))) - `(sml/folder ((,class :foreground ,fg-active))) - `(sml/git ((,class :inherit bold :foreground ,green-active))) - `(sml/global ((,class :foreground ,fg-active))) - `(sml/line-number ((,class :inherit sml/global))) - `(sml/minor-modes ((,class :inherit sml/global))) - `(sml/modes ((,class :inherit bold :foreground ,fg-active))) - `(sml/modified ((,class :inherit bold :foreground ,magenta-active))) - `(sml/mule-info ((,class :inherit sml/global))) - `(sml/name-filling ((,class :foreground ,yellow-active))) - `(sml/not-modified ((,class :inherit sml/global))) - `(sml/numbers-separator ((,class :inherit sml/global))) - `(sml/outside-modified ((,class :inherit modus-themes-intense-red))) - `(sml/position-percentage ((,class :inherit sml/global))) - `(sml/prefix ((,class :foreground ,green-active))) - `(sml/process ((,class :inherit sml/prefix))) - `(sml/projectile ((,class :inherit sml/git))) - `(sml/read-only ((,class :inherit bold :foreground ,cyan-active))) - `(sml/remote ((,class :inherit sml/global))) - `(sml/sudo ((,class :inherit modus-themes-subtle-red))) - `(sml/time ((,class :inherit sml/global))) - `(sml/vc ((,class :inherit sml/git))) - `(sml/vc-edited ((,class :inherit bold :foreground ,yellow-active))) -;;;;; smartparens - `(sp-pair-overlay-face ((,class :inherit modus-themes-special-warm))) - `(sp-show-pair-enclosing ((,class :inherit modus-themes-special-mild))) - `(sp-show-pair-match-face ((,class ,@(modus-themes--paren bg-paren-match - bg-paren-match-intense) - :foreground ,fg-main))) - `(sp-show-pair-mismatch-face ((,class :inherit modus-themes-intense-red))) - `(sp-wrap-overlay-closing-pair ((,class :inherit sp-pair-overlay-face))) - `(sp-wrap-overlay-face ((,class :inherit sp-pair-overlay-face))) - `(sp-wrap-overlay-opening-pair ((,class :inherit sp-pair-overlay-face))) - `(sp-wrap-tag-overlay-face ((,class :inherit sp-pair-overlay-face))) + `(sml/charging ((,c :foreground ,info))) + `(sml/discharging ((,c :foreground ,err))) + `(sml/filename ((,c :inherit bold :foreground ,name))) + `(sml/folder (( ))) + `(sml/git ((,c :inherit success))) + `(sml/global (( ))) + `(sml/line-number ((,c :inherit sml/global))) + `(sml/minor-modes ((,c :inherit sml/global))) + `(sml/modes ((,c :inherit bold))) + `(sml/modified ((,c :inherit italic))) + `(sml/mule-info ((,c :inherit sml/global))) + `(sml/name-filling ((,c :inherit warning))) + `(sml/not-modified ((,c :inherit sml/global))) + `(sml/numbers-separator ((,c :inherit sml/global))) + `(sml/outside-modified ((,c :inherit modus-themes-intense-red))) + `(sml/position-percentage ((,c :inherit sml/global))) + `(sml/prefix ((,c :foreground ,fg-alt))) + `(sml/process ((,c :inherit sml/prefix))) + `(sml/projectile ((,c :inherit sml/git))) + `(sml/read-only (( ))) + `(sml/remote ((,c :inherit sml/global))) + `(sml/sudo ((,c :inherit warning))) + `(sml/time ((,c :inherit sml/global))) + `(sml/vc ((,c :inherit sml/git))) + `(sml/vc-edited ((,c :inherit italic))) ;;;;; smerge - `(smerge-base ((,class :inherit modus-themes-diff-changed))) - `(smerge-lower ((,class :inherit modus-themes-diff-added))) - `(smerge-markers ((,class :inherit modus-themes-diff-heading))) - `(smerge-refined-added ((,class :inherit modus-themes-diff-refine-added))) + `(smerge-base ((,c :inherit diff-changed))) + `(smerge-lower ((,c :inherit diff-added))) + `(smerge-markers ((,c :inherit diff-heading))) + `(smerge-refined-added ((,c :inherit diff-refine-added))) `(smerge-refined-changed (())) - `(smerge-refined-removed ((,class :inherit modus-themes-diff-refine-removed))) - `(smerge-upper ((,class :inherit modus-themes-diff-removed))) -;;;;; spaceline - `(spaceline-evil-emacs ((,class :inherit modus-themes-active-magenta))) - `(spaceline-evil-insert ((,class :inherit modus-themes-active-green))) - `(spaceline-evil-motion ((,class :inherit modus-themes-active-blue))) - `(spaceline-evil-normal ((,class :background ,fg-alt :foreground ,bg-alt))) - `(spaceline-evil-replace ((,class :inherit modus-themes-active-red))) - `(spaceline-evil-visual ((,class :inherit modus-themes-active-cyan))) - `(spaceline-flycheck-error ((,class :foreground ,red-active))) - `(spaceline-flycheck-info ((,class :foreground ,cyan-active))) - `(spaceline-flycheck-warning ((,class :foreground ,yellow-active))) - `(spaceline-highlight-face ((,class :inherit modus-themes-fringe-blue))) - `(spaceline-modified ((,class :inherit modus-themes-fringe-magenta))) - `(spaceline-python-venv ((,class :foreground ,magenta-active))) - `(spaceline-read-only ((,class :inherit modus-themes-fringe-red))) - `(spaceline-unmodified ((,class :inherit modus-themes-fringe-cyan))) + `(smerge-refined-removed ((,c :inherit diff-refine-removed))) + `(smerge-upper ((,c :inherit diff-removed))) ;;;;; speedbar - `(speedbar-button-face ((,class :inherit button))) - `(speedbar-directory-face ((,class :inherit bold :foreground ,blue))) - `(speedbar-file-face ((,class :foreground ,fg-main))) - `(speedbar-highlight-face ((,class :inherit highlight))) - `(speedbar-selected-face ((,class :inherit bold :foreground ,cyan))) - `(speedbar-separator-face ((,class :inherit modus-themes-intense-neutral))) - `(speedbar-tag-face ((,class :foreground ,yellow-alt-other))) + `(speedbar-button-face ((,c :inherit button))) + `(speedbar-directory-face ((,c :inherit bold :foreground ,accent-0))) + `(speedbar-file-face ((,c :foreground ,fg-main))) + `(speedbar-highlight-face ((,c :inherit highlight))) + `(speedbar-selected-face ((,c :inherit modus-themes-mark-sel))) + `(speedbar-separator-face ((,c :background ,bg-active :foreground ,fg-main))) + `(speedbar-tag-face ((,c :foreground ,accent-1))) ;;;;; spell-fu - `(spell-fu-incorrect-face ((,class :inherit modus-themes-lang-error))) + `(spell-fu-incorrect-face ((,c :inherit modus-themes-lang-error))) ;;;;; stripes - `(stripes ((,class :background ,bg-alt))) + `(stripes ((,c :background ,bg-inactive))) ;;;;; suggest - `(suggest-heading ((,class :inherit bold :foreground ,yellow-alt-other))) + `(suggest-heading ((,c :inherit warning))) ;;;;; switch-window - `(switch-window-background ((,class :background ,bg-dim))) - `(switch-window-label ((,class :height 3.0 :foreground ,blue-intense))) + `(switch-window-background ((,c :background ,bg-inactive))) + `(switch-window-label ((,c :height 3.0 :foreground ,red-intense))) ;;;;; swiper `(swiper-background-match-face-1 (( ))) - `(swiper-background-match-face-2 ((,class :inherit modus-themes-completion-match-0))) - `(swiper-background-match-face-3 ((,class :inherit modus-themes-completion-match-1))) - `(swiper-background-match-face-4 ((,class :inherit modus-themes-completion-match-2))) - `(swiper-line-face ((,class :background ,bg-hl-alt-intense))) + `(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 :background ,bg-hl-line :extend t))) `(swiper-match-face-1 (( ))) - `(swiper-match-face-2 ((,class :inherit modus-themes-completion-match-0))) - `(swiper-match-face-3 ((,class :inherit modus-themes-completion-match-1))) - `(swiper-match-face-4 ((,class :inherit modus-themes-completion-match-2))) -;;;;; sx - `(sx-inbox-item-type ((,class :foreground ,magenta-alt-other))) - `(sx-inbox-item-type-unread ((,class :inherit (sx-inbox-item-type bold)))) - `(sx-question-list-answers ((,class :foreground ,green))) - `(sx-question-list-answers-accepted ((,class :box t :foreground ,green))) - `(sx-question-list-bounty ((,class :inherit bold :background ,bg-alt :foreground ,yellow))) - `(sx-question-list-date ((,class :foreground ,fg-special-cold))) - `(sx-question-list-favorite ((,class :inherit bold :foreground ,fg-special-warm))) - `(sx-question-list-parent ((,class :foreground ,fg-main))) - `(sx-question-list-read-question ((,class :inherit shadow))) - `(sx-question-list-score ((,class :foreground ,fg-special-mild))) - `(sx-question-list-score-upvoted ((,class :inherit (sx-question-list-score bold)))) - `(sx-question-list-unread-question ((,class :inherit bold :foreground ,fg-main))) - `(sx-question-mode-accepted ((,class :inherit bold :height 1.3 :foreground ,green))) - `(sx-question-mode-closed ((,class :inherit modus-themes-active-yellow :box (:line-width 2 :color nil)))) - `(sx-question-mode-closed-reason ((,class :box (:line-width 2 :color nil) :foreground ,fg-main))) - `(sx-question-mode-content-face ((,class :background ,bg-dim))) - `(sx-question-mode-date ((,class :foreground ,blue))) - `(sx-question-mode-header ((,class :inherit bold :foreground ,cyan))) - `(sx-question-mode-kbd-tag ((,class :inherit bold :height 0.9 :box (:line-width 3 :color ,fg-main :style released-button) :foreground ,fg-main))) - `(sx-question-mode-score ((,class :foreground ,fg-dim))) - `(sx-question-mode-score-downvoted ((,class :foreground ,yellow))) - `(sx-question-mode-score-upvoted ((,class :inherit bold :foreground ,magenta))) - `(sx-question-mode-title ((,class :inherit bold :foreground ,fg-main))) - `(sx-question-mode-title-comments ((,class :inherit (shadow bold)))) - `(sx-tag ((,class :foreground ,magenta-alt))) - `(sx-user-name ((,class :foreground ,blue-alt))) - `(sx-user-reputation ((,class :inherit shadow))) + `(swiper-match-face-2 ((,c :inherit modus-themes-completion-match-0))) + `(swiper-match-face-3 ((,c :inherit modus-themes-completion-match-1))) + `(swiper-match-face-4 ((,c :inherit modus-themes-completion-match-2))) ;;;;; symbol-overlay - `(symbol-overlay-default-face ((,class :inherit modus-themes-special-warm))) - `(symbol-overlay-face-1 ((,class :inherit modus-themes-intense-blue))) - `(symbol-overlay-face-2 ((,class :inherit modus-themes-refine-magenta))) - `(symbol-overlay-face-3 ((,class :inherit modus-themes-intense-yellow))) - `(symbol-overlay-face-4 ((,class :inherit modus-themes-intense-magenta))) - `(symbol-overlay-face-5 ((,class :inherit modus-themes-intense-red))) - `(symbol-overlay-face-6 ((,class :inherit modus-themes-refine-red))) - `(symbol-overlay-face-7 ((,class :inherit modus-themes-intense-cyan))) - `(symbol-overlay-face-8 ((,class :inherit modus-themes-refine-cyan))) + `(symbol-overlay-default-face ((,c :background ,bg-inactive))) + `(symbol-overlay-face-1 ((,c :inherit modus-themes-intense-blue))) + `(symbol-overlay-face-2 ((,c :inherit modus-themes-intense-magenta))) + `(symbol-overlay-face-3 ((,c :inherit modus-themes-intense-yellow))) + `(symbol-overlay-face-4 ((,c :inherit modus-themes-intense-magenta))) + `(symbol-overlay-face-5 ((,c :inherit modus-themes-intense-red))) + `(symbol-overlay-face-6 ((,c :inherit modus-themes-intense-red))) + `(symbol-overlay-face-7 ((,c :inherit modus-themes-intense-cyan))) + `(symbol-overlay-face-8 ((,c :inherit modus-themes-intense-cyan))) ;;;;; syslog-mode - `(syslog-debug ((,class :inherit bold :foreground ,cyan-alt-other))) - `(syslog-error ((,class :inherit error))) - `(syslog-file ((,class :inherit bold :foreground ,fg-special-cold))) - `(syslog-hide ((,class :background ,bg-main :foreground ,fg-main))) - `(syslog-hour ((,class :inherit bold :foreground ,magenta-alt-other))) - `(syslog-info ((,class :inherit success))) - `(syslog-ip ((,class :inherit bold :foreground ,fg-special-mild :underline t))) - `(syslog-su ((,class :inherit bold :foreground ,red-alt))) - `(syslog-warn ((,class :inherit warning))) -;;;;; tab-bar-groups - `(tab-bar-groups-tab-1 ((,class :inherit modus-themes-ui-variable-pitch :foreground ,blue-tab))) - `(tab-bar-groups-tab-2 ((,class :inherit modus-themes-ui-variable-pitch :foreground ,red-tab))) - `(tab-bar-groups-tab-3 ((,class :inherit modus-themes-ui-variable-pitch :foreground ,green-tab))) - `(tab-bar-groups-tab-4 ((,class :inherit modus-themes-ui-variable-pitch :foreground ,orange-tab))) - `(tab-bar-groups-tab-5 ((,class :inherit modus-themes-ui-variable-pitch :foreground ,purple-tab))) - `(tab-bar-groups-tab-6 ((,class :inherit modus-themes-ui-variable-pitch :foreground ,cyan-tab))) - `(tab-bar-groups-tab-7 ((,class :inherit modus-themes-ui-variable-pitch :foreground ,yellow-tab))) - `(tab-bar-groups-tab-8 ((,class :inherit modus-themes-ui-variable-pitch :foreground ,magenta-tab))) + `(syslog-debug ((,c :inherit italic))) + `(syslog-error ((,c :inherit error))) + `(syslog-file ((,c :inherit bold :foreground ,name))) + `(syslog-hide ((,c :background ,bg-main :foreground ,fg-main))) + `(syslog-hour ((,c :inherit bold :foreground ,date-common))) + `(syslog-info ((,c :inherit success))) + `(syslog-ip ((,c :inherit bold :foreground ,name :underline t))) + `(syslog-su ((,c :inherit error :underline t))) + `(syslog-warn ((,c :inherit warning))) ;;;;; tab-bar-mode - `(tab-bar ((,class :inherit modus-themes-tab-backdrop))) - `(tab-bar-tab-group-current ((,class ,@(modus-themes--tab bg-tab-active) - :box (:line-width (2 . -2) :color "gray50")))) - `(tab-bar-tab-group-inactive ((,class ,@(modus-themes--tab bg-tab-inactive bg-tab-inactive-accent fg-dim) - :box (:line-width (2 . -2) :color "gray50")))) - `(tab-bar-tab ((,class :inherit modus-themes-tab-active))) - `(tab-bar-tab-inactive ((,class :inherit modus-themes-tab-inactive))) + `(tab-bar ((,c :inherit modus-themes-ui-variable-pitch :background ,bg-tab-bar))) + `(tab-bar-tab-group-current ((,c :inherit bold :background ,bg-tab-current :box (:line-width -2 :color ,bg-tab-current) :foreground ,fg-alt))) + `(tab-bar-tab-group-inactive ((,c :background ,bg-tab-bar :box (:line-width -2 :color ,bg-tab-bar) :foreground ,fg-alt))) + `(tab-bar-tab ((,c :inherit bold :box (:line-width -2 :color ,bg-tab-current) :background ,bg-tab-current))) + `(tab-bar-tab-inactive ((,c :box (:line-width -2 :color ,bg-tab-other) :background ,bg-tab-other))) + `(tab-bar-tab-ungrouped ((,c :inherit tab-bar-tab-inactive))) ;;;;; tab-line-mode - `(tab-line ((,class :inherit modus-themes-tab-backdrop :height 0.95))) - `(tab-line-close-highlight ((,class :foreground ,red))) - `(tab-line-highlight ((,class :inherit modus-themes-active-blue))) - `(tab-line-tab ((,class :inherit modus-themes-tab-active))) - `(tab-line-tab-current ((,class :inherit tab-line-tab))) - `(tab-line-tab-inactive ((,class :inherit modus-themes-tab-inactive))) - `(tab-line-tab-inactive-alternate ((,class ,@(modus-themes--tab bg-tab-inactive-alt - bg-tab-inactive-alt-accent fg-main nil t)))) - `(tab-line-tab-modified ((,class :foreground ,red-alt-other-faint))) + `(tab-line ((,c :inherit modus-themes-ui-variable-pitch :background ,bg-tab-bar :height 0.95))) + `(tab-line-close-highlight ((,c :foreground ,err))) + `(tab-line-highlight ((,c :inherit highlight))) + `(tab-line-tab (( ))) + `(tab-line-tab-current ((,c :inherit bold :box (:line-width -2 :color ,bg-tab-current) :background ,bg-tab-current))) + `(tab-line-tab-inactive ((,c :box (:line-width -2 :color ,bg-tab-other) :background ,bg-tab-other))) + `(tab-line-tab-inactive-alternate ((,c :inherit tab-line-tab-inactive :foreground ,fg-alt))) + `(tab-line-tab-modified ((,c :foreground ,warning))) ;;;;; table (built-in table.el) - `(table-cell ((,class :background ,blue-nuanced-bg))) + `(table-cell ((,c :background ,bg-dim))) ;;;;; telega - `(telega-button ((,class :box t :foreground ,blue))) - `(telega-button-active ((,class :box ,blue-intense-bg :background ,blue-intense-bg :foreground ,fg-main))) - `(telega-button-highlight ((,class :inherit modus-themes-subtle-magenta))) - `(telega-chat-prompt ((,class :inherit bold))) - `(telega-entity-type-code ((,class :inherit modus-themes-markup-verbatim))) - `(telega-entity-type-mention ((,class :foreground ,cyan))) - `(telega-entity-type-pre ((,class :inherit modus-themes-markup-code))) - `(telega-entity-type-spoiler ((,class :background ,fg-main :foreground ,fg-main))) - `(telega-msg-heading ((,class :background ,bg-alt))) - `(telega-msg-self-title ((,class :inherit bold))) - `(telega-root-heading ((,class :inherit modus-themes-subtle-neutral))) - `(telega-secret-title ((,class :foreground ,magenta-alt))) - `(telega-unmuted-count ((,class :foreground ,blue-alt-other))) - `(telega-user-online-status ((,class :foreground ,cyan-active))) - `(telega-username ((,class :foreground ,cyan-alt-other))) - `(telega-webpage-chat-link ((,class :background ,bg-alt))) - `(telega-webpage-fixed ((,class :inherit modus-themes-fixed-pitch :height 0.85))) - `(telega-webpage-header ((,class :inherit modus-themes-variable-pitch :height 1.3))) - `(telega-webpage-preformatted ((,class :inherit modus-themes-fixed-pitch :background ,bg-alt))) - `(telega-webpage-subheader ((,class :inherit modus-themes-variable-pitch :height 1.15))) -;;;;; telephone-line - `(telephone-line-accent-active ((,class :background ,fg-inactive :foreground ,bg-inactive))) - `(telephone-line-accent-inactive ((,class :background ,bg-active :foreground ,fg-active))) - `(telephone-line-error ((,class :inherit bold :foreground ,red-active))) - `(telephone-line-evil ((,class :foreground ,fg-main))) - `(telephone-line-evil-emacs ((,class :inherit telephone-line-evil :background ,magenta-intense-bg))) - `(telephone-line-evil-insert ((,class :inherit telephone-line-evil :background ,green-intense-bg))) - `(telephone-line-evil-motion ((,class :inherit telephone-line-evil :background ,yellow-intense-bg))) - `(telephone-line-evil-normal ((,class :inherit telephone-line-evil :background ,bg-alt))) - `(telephone-line-evil-operator ((,class :inherit telephone-line-evil :background ,yellow-subtle-bg))) - `(telephone-line-evil-replace ((,class :inherit telephone-line-evil :background ,red-intense-bg))) - `(telephone-line-evil-visual ((,class :inherit telephone-line-evil :background ,cyan-intense-bg))) - `(telephone-line-projectile ((,class :foreground ,cyan-active))) - `(telephone-line-unimportant ((,class :foreground ,fg-inactive))) - `(telephone-line-warning ((,class :inherit bold :foreground ,yellow-active))) + `(telega-button ((,c :box t :foreground ,fg-link))) + `(telega-button-active ((,c :box ,fg-link :background ,fg-link :foreground ,bg-main))) + `(telega-button-highlight ((,c :inherit secondary-selection))) + `(telega-chat-prompt ((,c :inherit modus-themes-prompt))) + `(telega-entity-type-code ((,c :inherit modus-themes-prose-verbatim))) + `(telega-entity-type-mention ((,c :foreground ,cyan))) + `(telega-entity-type-pre ((,c :inherit modus-themes-prose-code))) + `(telega-entity-type-spoiler ((,c :background ,fg-main :foreground ,fg-main))) + `(telega-msg-heading ((,c :background ,bg-inactive))) + `(telega-msg-self-title ((,c :inherit bold))) + `(telega-root-heading ((,c :background ,bg-inactive))) + `(telega-secret-title ((,c :foreground ,magenta-warmer))) + `(telega-unmuted-count ((,c :foreground ,blue-cooler))) + `(telega-user-online-status ((,c :foreground ,cyan))) + `(telega-username ((,c :foreground ,cyan-cooler))) + `(telega-webpage-chat-link ((,c :background ,bg-inactive))) + `(telega-webpage-fixed ((,c :inherit modus-themes-fixed-pitch :height 0.85))) + `(telega-webpage-header ((,c :inherit modus-themes-variable-pitch :height 1.3))) + `(telega-webpage-preformatted ((,c :inherit modus-themes-fixed-pitch :background ,bg-inactive))) + `(telega-webpage-subheader ((,c :inherit modus-themes-variable-pitch :height 1.15))) ;;;;; terraform-mode - `(terraform--resource-name-face ((,class ,@(modus-themes--syntax-string - magenta-alt-other magenta-alt-other-faint - red-alt red-alt)))) - `(terraform--resource-type-face ((,class ,@(modus-themes--syntax-string - green green-faint - blue-alt magenta-alt)))) + `(terraform--resource-name-face ((,c :foreground ,keyword))) + `(terraform--resource-type-face ((,c :foreground ,type))) ;;;;; term - `(term ((,class :background ,bg-main :foreground ,fg-main))) - `(term-bold ((,class :inherit bold))) - `(term-color-black ((,class :background "gray35" :foreground "gray35"))) - `(term-color-blue ((,class :background ,blue :foreground ,blue))) - `(term-color-cyan ((,class :background ,cyan :foreground ,cyan))) - `(term-color-green ((,class :background ,green :foreground ,green))) - `(term-color-magenta ((,class :background ,magenta :foreground ,magenta))) - `(term-color-red ((,class :background ,red :foreground ,red))) - `(term-color-white ((,class :background "gray65" :foreground "gray65"))) - `(term-color-yellow ((,class :background ,yellow :foreground ,yellow))) - `(term-underline ((,class :underline t))) + `(term ((,c :background ,bg-main :foreground ,fg-main))) + `(term-bold ((,c :inherit bold))) + `(term-color-black ((,c :background "gray35" :foreground "gray35"))) + `(term-color-blue ((,c :background ,blue :foreground ,blue))) + `(term-color-cyan ((,c :background ,cyan :foreground ,cyan))) + `(term-color-green ((,c :background ,green :foreground ,green))) + `(term-color-magenta ((,c :background ,magenta :foreground ,magenta))) + `(term-color-red ((,c :background ,red :foreground ,red))) + `(term-color-white ((,c :background "gray65" :foreground "gray65"))) + `(term-color-yellow ((,c :background ,yellow :foreground ,yellow))) + `(term-underline ((,c :underline t))) ;;;;; textsec - `(textsec-suspicious (())) -;;;;; tomatinho - `(tomatinho-ok-face ((,class :foreground ,blue-intense))) - `(tomatinho-pause-face ((,class :foreground ,yellow-intense))) - `(tomatinho-reset-face ((,class :inherit shadow))) + `(textsec-suspicious (( ))) ;;;;; transient - `(transient-active-infix ((,class :inherit modus-themes-special-mild))) - `(transient-amaranth ((,class :inherit bold :foreground ,yellow-alt))) + `(transient-active-infix ((,c :inherit highlight))) + `(transient-amaranth ((,c :inherit bold :foreground ,yellow-warmer))) ;; Placate the compiler for what is a spurious warning. We also ;; have to do this with `eldoc-highlight-function-argument'. - (list 'transient-argument `((,class :inherit bold :background ,cyan-nuanced-bg :foreground ,cyan))) - `(transient-blue ((,class :inherit bold :foreground ,blue))) - `(transient-disabled-suffix ((,class :inherit modus-themes-intense-red))) - `(transient-enabled-suffix ((,class :inherit modus-themes-grue-background-subtle))) - `(transient-heading ((,class :inherit bold :foreground ,fg-main))) - `(transient-inactive-argument ((,class :inherit shadow))) - `(transient-inactive-value ((,class :inherit shadow))) - `(transient-key ((,class :inherit modus-themes-key-binding))) - `(transient-mismatched-key ((,class :underline t))) - `(transient-nonstandard-key ((,class :underline t))) - `(transient-pink ((,class :inherit bold :foreground ,magenta-alt-faint))) - `(transient-purple ((,class :inherit bold :foreground ,magenta-alt-other))) - `(transient-red ((,class :inherit bold :foreground ,red-faint))) - `(transient-teal ((,class :inherit bold :foreground ,cyan-alt-other))) - `(transient-unreachable ((,class :inherit shadow))) - `(transient-unreachable-key ((,class :inherit shadow))) - `(transient-value ((,class :inherit bold :background ,yellow-nuanced-bg :foreground ,yellow-alt-other))) + (list 'transient-argument `((,c :inherit (bold modus-themes-mark-alt)))) + `(transient-blue ((,c :inherit bold :foreground ,blue))) + `(transient-disabled-suffix ((,c :inherit modus-themes-intense-red))) + `(transient-enabled-suffix ((,c :inherit modus-themes-subtle-cyan))) + `(transient-heading ((,c :inherit bold :foreground ,fg-main))) + `(transient-inactive-argument ((,c :inherit shadow))) + `(transient-inactive-value ((,c :inherit shadow))) + `(transient-key ((,c :inherit modus-themes-key-binding))) + `(transient-mismatched-key ((,c :underline t))) + `(transient-nonstandard-key ((,c :underline t))) + `(transient-pink ((,c :inherit bold :foreground ,magenta))) + `(transient-purple ((,c :inherit bold :foreground ,magenta-cooler))) + `(transient-red ((,c :inherit bold :foreground ,red-faint))) + `(transient-teal ((,c :inherit bold :foreground ,cyan-cooler))) + `(transient-unreachable ((,c :inherit shadow))) + `(transient-unreachable-key ((,c :inherit shadow))) + `(transient-value ((,c :inherit (bold modus-themes-mark-sel)))) ;;;;; trashed - `(trashed-deleted ((,class :inherit modus-themes-mark-del))) - `(trashed-directory ((,class :foreground ,blue))) - `(trashed-mark ((,class :inherit modus-themes-mark-symbol))) - `(trashed-marked ((,class :inherit modus-themes-mark-alt))) - `(trashed-restored ((,class :inherit modus-themes-mark-sel))) - `(trashed-symlink ((,class :inherit modus-themes-link-symlink))) + `(trashed-deleted ((,c :inherit modus-themes-mark-del))) + `(trashed-directory ((,c :foreground ,accent-0))) + `(trashed-mark ((,c :inherit bold))) + `(trashed-marked ((,c :inherit modus-themes-mark-alt))) + `(trashed-restored ((,c :inherit modus-themes-mark-sel))) ;;;;; tree-sitter - `(tree-sitter-hl-face:attribute ((,class :inherit font-lock-variable-name-face))) - `(tree-sitter-hl-face:constant.builtin ((,class :inherit tree-sitter-hl-face:constant))) - `(tree-sitter-hl-face:escape ((,class :inherit font-lock-regexp-grouping-backslash))) - `(tree-sitter-hl-face:function ((,class :inherit font-lock-function-name-face))) - `(tree-sitter-hl-face:function.call ((,class :inherit tree-sitter-hl-face:function))) + `(tree-sitter-hl-face:attribute ((,c :inherit font-lock-variable-name-face))) + `(tree-sitter-hl-face:constant.builtin ((,c :inherit tree-sitter-hl-face:constant))) + `(tree-sitter-hl-face:escape ((,c :inherit font-lock-regexp-grouping-backslash))) + `(tree-sitter-hl-face:function ((,c :inherit font-lock-function-name-face))) + `(tree-sitter-hl-face:function.call ((,c :inherit tree-sitter-hl-face:function))) `(tree-sitter-hl-face:label (( ))) `(tree-sitter-hl-face:method.call (( ))) - `(tree-sitter-hl-face:operator ((,class :inherit modus-themes-bold))) + `(tree-sitter-hl-face:operator ((,c :inherit modus-themes-bold))) `(tree-sitter-hl-face:property (( ))) - `(tree-sitter-hl-face:property.definition ((,class :inherit font-lock-variable-name-face))) + `(tree-sitter-hl-face:property.definition ((,c :inherit font-lock-variable-name-face))) `(tree-sitter-hl-face:punctuation (( ))) `(tree-sitter-hl-face:punctuation.bracket (( ))) `(tree-sitter-hl-face:punctuation.delimiter (( ))) - `(tree-sitter-hl-face:punctuation.special ((,class :inherit font-lock-regexp-grouping-construct))) - `(tree-sitter-hl-face:string.special ((,class :inherit tree-sitter-hl-face:string))) - `(tree-sitter-hl-face:tag ((,class :inherit font-lock-function-name-face))) + `(tree-sitter-hl-face:punctuation.special ((,c :inherit font-lock-regexp-grouping-construct))) + `(tree-sitter-hl-face:string.special ((,c :inherit tree-sitter-hl-face:string))) + `(tree-sitter-hl-face:tag ((,c :inherit font-lock-function-name-face))) `(tree-sitter-hl-face:type.argument (( ))) -;;;;; treemacs - `(treemacs-directory-collapsed-face ((,class :foreground ,magenta-alt))) - `(treemacs-directory-face ((,class :inherit dired-directory))) - `(treemacs-file-face ((,class :foreground ,fg-main))) - `(treemacs-fringe-indicator-face ((,class :foreground ,fg-main))) - `(treemacs-git-added-face ((,class :inherit success))) - `(treemacs-git-conflict-face ((,class :inherit error))) - `(treemacs-git-ignored-face ((,class :inherit shadow))) - `(treemacs-git-modified-face ((,class :inherit warning))) - `(treemacs-git-renamed-face ((,class :inherit italic))) - `(treemacs-git-unmodified-face ((,class :foreground ,fg-main))) - `(treemacs-git-untracked-face ((,class :inherit shadow))) - `(treemacs-help-column-face ((,class :inherit modus-themes-bold :foreground ,magenta-alt-other :underline t))) - `(treemacs-help-title-face ((,class :foreground ,blue-alt-other))) - `(treemacs-on-failure-pulse-face ((,class :inherit modus-themes-intense-red))) - `(treemacs-on-success-pulse-face ((,class :inherit modus-themes-grue-background-intense))) - `(treemacs-root-face ((,class :inherit bold :foreground ,blue-alt-other :height 1.2 :underline t))) - `(treemacs-root-remote-disconnected-face ((,class :inherit treemacs-root-remote-face :foreground ,yellow))) - `(treemacs-root-remote-face ((,class :inherit treemacs-root-face :foreground ,magenta))) - `(treemacs-root-remote-unreadable-face ((,class :inherit treemacs-root-unreadable-face))) - `(treemacs-root-unreadable-face ((,class :inherit treemacs-root-face :strike-through t))) - `(treemacs-tags-face ((,class :foreground ,blue-alt))) ;;;;; tty-menu - `(tty-menu-disabled-face ((,class :background ,bg-alt :foreground ,fg-alt))) - `(tty-menu-enabled-face ((,class :inherit bold :background ,bg-alt :foreground ,fg-main))) - `(tty-menu-selected-face ((,class :inherit modus-themes-intense-blue))) + `(tty-menu-disabled-face ((,c :background ,bg-inactive :foreground ,fg-dim))) + `(tty-menu-enabled-face ((,c :inherit bold :background ,bg-inactive :foreground ,fg-main))) + `(tty-menu-selected-face ((,c :inherit modus-themes-intense-blue))) ;;;;; tuareg - `(caml-types-def-face ((,class :inherit modus-themes-subtle-red))) - `(caml-types-expr-face ((,class :inherit modus-themes-subtle-green))) - `(caml-types-occ-face ((,class :inherit modus-themes-subtle-green))) - `(caml-types-scope-face ((,class :inherit modus-themes-subtle-blue))) - `(caml-types-typed-face ((,class :inherit modus-themes-subtle-magenta))) - `(tuareg-font-double-semicolon-face ((,class :inherit font-lock-preprocessor-face))) - `(tuareg-font-lock-attribute-face ((,class :inherit font-lock-function-name-face))) - `(tuareg-font-lock-constructor-face ((,class :foreground ,fg-main))) - `(tuareg-font-lock-error-face ((,class :inherit (modus-themes-intense-red bold)))) - `(tuareg-font-lock-extension-node-face ((,class :background ,bg-alt :foreground ,magenta))) - `(tuareg-font-lock-governing-face ((,class :inherit bold :foreground ,fg-main))) - `(tuareg-font-lock-infix-extension-node-face ((,class :inherit font-lock-function-name-face))) - `(tuareg-font-lock-interactive-directive-face ((,class :foreground ,fg-special-cold))) - `(tuareg-font-lock-interactive-error-face ((,class :inherit error))) - `(tuareg-font-lock-interactive-output-face ((,class :inherit font-lock-constant-face))) - `(tuareg-font-lock-label-face ((,class :inherit font-lock-type-face))) - `(tuareg-font-lock-line-number-face ((,class :foreground ,fg-special-warm))) - `(tuareg-font-lock-module-face ((,class :inherit font-lock-builtin-face))) - `(tuareg-font-lock-multistage-face ((,class :inherit bold :background ,bg-alt :foreground ,blue))) - `(tuareg-font-lock-operator-face ((,class :inherit font-lock-preprocessor-face))) - `(tuareg-opam-error-face ((,class :inherit error))) - `(tuareg-opam-pkg-variable-name-face ((,class :inherit font-lock-variable-name-face))) + `(caml-types-def-face ((,c :inherit modus-themes-subtle-red))) + `(caml-types-expr-face ((,c :inherit modus-themes-subtle-green))) + `(caml-types-occ-face ((,c :inherit modus-themes-subtle-green))) + `(caml-types-scope-face ((,c :inherit modus-themes-subtle-blue))) + `(caml-types-typed-face ((,c :inherit modus-themes-subtle-magenta))) + `(tuareg-font-double-semicolon-face ((,c :inherit font-lock-preprocessor-face))) + `(tuareg-font-lock-attribute-face ((,c :inherit font-lock-function-name-face))) + `(tuareg-font-lock-constructor-face ((,c :foreground ,fg-main))) + `(tuareg-font-lock-error-face ((,c :inherit (modus-themes-intense-red bold)))) + ;; `(tuareg-font-lock-extension-node-face ((,c :background ,bg-inactive :foreground ,magenta))) + `(tuareg-font-lock-governing-face ((,c :inherit bold :foreground ,fg-main))) + `(tuareg-font-lock-infix-extension-node-face ((,c :inherit font-lock-function-name-face))) + `(tuareg-font-lock-interactive-directive-face ((,c :inherit font-lock-preprocessor-face))) + `(tuareg-font-lock-interactive-error-face ((,c :inherit error))) + `(tuareg-font-lock-interactive-output-face ((,c :inherit font-lock-constant-face))) + `(tuareg-font-lock-label-face ((,c :inherit font-lock-type-face))) + `(tuareg-font-lock-line-number-face ((,c :inherit shadow))) + `(tuareg-font-lock-module-face ((,c :inherit font-lock-builtin-face))) + ;; `(tuareg-font-lock-multistage-face ((,c :inherit bold :background ,bg-inactive :foreground ,blue))) + `(tuareg-font-lock-operator-face ((,c :inherit font-lock-preprocessor-face))) + `(tuareg-opam-error-face ((,c :inherit error))) + `(tuareg-opam-pkg-variable-name-face ((,c :inherit font-lock-variable-name-face))) ;;;;; typescript - `(typescript-jsdoc-tag ((,class :inherit (font-lock-builtin-face font-lock-comment-face) :weight normal))) - `(typescript-jsdoc-type ((,class :inherit (font-lock-type-face font-lock-comment-face) :weight normal))) - `(typescript-jsdoc-value ((,class :inherit (font-lock-constant-face font-lock-comment-face) :weight normal))) + `(typescript-jsdoc-tag ((,c :inherit (font-lock-builtin-face font-lock-comment-face) :weight normal))) + `(typescript-jsdoc-type ((,c :inherit (font-lock-type-face font-lock-comment-face) :weight normal))) + `(typescript-jsdoc-value ((,c :inherit (font-lock-constant-face font-lock-comment-face) :weight normal))) ;;;;; undo-tree - `(undo-tree-visualizer-active-branch-face ((,class :inherit bold :foreground ,fg-main))) - `(undo-tree-visualizer-current-face ((,class :foreground ,blue-intense))) - `(undo-tree-visualizer-default-face ((,class :inherit shadow))) - `(undo-tree-visualizer-register-face ((,class :foreground ,magenta-intense))) - `(undo-tree-visualizer-unmodified-face ((,class :foreground ,green-intense))) + `(undo-tree-visualizer-active-branch-face ((,c :inherit bold :foreground ,fg-main))) + `(undo-tree-visualizer-current-face ((,c :foreground ,blue-intense))) + `(undo-tree-visualizer-default-face ((,c :inherit shadow))) + `(undo-tree-visualizer-register-face ((,c :foreground ,magenta-intense))) + `(undo-tree-visualizer-unmodified-face ((,c :foreground ,green-intense))) ;;;;; vc (vc-dir.el, vc-hooks.el) - `(vc-dir-directory ((,class :foreground ,blue))) - `(vc-dir-file ((,class :foreground ,fg-main))) - `(vc-dir-header ((,class :foreground ,cyan-alt-other))) - `(vc-dir-header-value ((,class :foreground ,magenta-alt-other))) - `(vc-dir-mark-indicator ((,class :foreground ,blue-alt-other))) - `(vc-dir-status-edited ((,class :foreground ,yellow))) - `(vc-dir-status-ignored ((,class :inherit shadow))) - `(vc-dir-status-up-to-date ((,class :foreground ,cyan))) - `(vc-dir-status-warning ((,class :inherit error))) - `(vc-conflict-state ((,class :inherit bold :foreground ,red-active))) - `(vc-edited-state ((,class :foreground ,yellow-active))) - `(vc-locally-added-state ((,class :foreground ,cyan-active))) - `(vc-locked-state ((,class :foreground ,blue-active))) - `(vc-missing-state ((,class :inherit modus-themes-slant :foreground ,magenta-active))) - `(vc-needs-update-state ((,class :inherit modus-themes-slant :foreground ,green-active))) - `(vc-removed-state ((,class :foreground ,red-active))) - `(vc-state-base ((,class :foreground ,fg-active))) - `(vc-up-to-date-state ((,class :foreground ,fg-special-cold))) + `(vc-dir-directory (( ))) + `(vc-dir-file ((,c :foreground ,name))) + `(vc-dir-header ((,c :inherit bold))) + `(vc-dir-header-value ((,c :foreground ,string))) + `(vc-dir-mark-indicator (( ))) + `(vc-dir-status-edited ((,c :inherit italic))) + `(vc-dir-status-ignored ((,c :inherit shadow))) + `(vc-dir-status-up-to-date ((,c :foreground ,info))) + `(vc-dir-status-warning ((,c :inherit error))) + `(vc-conflict-state ((,c :inherit error))) + `(vc-edited-state ((,c :inherit italic))) + `(vc-git-log-edit-summary-max-warning ((,c :inherit error))) + `(vc-git-log-edit-summary-target-warning ((,c :inherit warning))) + `(vc-locally-added-state ((,c :inherit italic))) + `(vc-locked-state ((,c :inherit success))) + `(vc-missing-state ((,c :inherit error))) + `(vc-needs-update-state ((,c :inherit error))) + `(vc-removed-state ((,c :inherit error))) + `(vc-state-base (( ))) + `(vc-up-to-date-state (( ))) ;;;;; vertico - `(vertico-current ((,class :inherit modus-themes-completion-selected))) + `(vertico-current ((,c :inherit modus-themes-completion-selected))) ;;;;; vertico-quick - `(vertico-quick1 ((,class :inherit bold :background ,bg-char-0))) - `(vertico-quick2 ((,class :inherit bold :background ,bg-char-1))) + `(vertico-quick1 ((,c :inherit bold :background ,bg-char-0))) + `(vertico-quick2 ((,c :inherit bold :background ,bg-char-1))) ;;;;; vimish-fold - `(vimish-fold-fringe ((,class :foreground ,cyan-active))) - `(vimish-fold-mouse-face ((,class :inherit modus-themes-intense-blue))) - `(vimish-fold-overlay ((,class :background ,bg-alt :foreground ,fg-special-cold))) + `(vimish-fold-fringe ((,c :foreground ,cyan))) + `(vimish-fold-mouse-face ((,c :inherit modus-themes-intense-blue))) + `(vimish-fold-overlay ((,c :background ,bg-inactive))) ;;;;; visible-mark - `(visible-mark-active ((,class :background ,blue-intense-bg))) - `(visible-mark-face1 ((,class :background ,cyan-intense-bg))) - `(visible-mark-face2 ((,class :background ,yellow-intense-bg))) - `(visible-mark-forward-face1 ((,class :background ,magenta-intense-bg))) - `(visible-mark-forward-face2 ((,class :background ,green-intense-bg))) + `(visible-mark-active ((,c :background ,bg-blue-intense))) + `(visible-mark-face1 ((,c :background ,bg-cyan-intense))) + `(visible-mark-face2 ((,c :background ,bg-yellow-intense))) + `(visible-mark-forward-face1 ((,c :background ,bg-magenta-intense))) + `(visible-mark-forward-face2 ((,c :background ,bg-green-intense))) ;;;;; visual-regexp - `(vr/group-0 ((,class :inherit modus-themes-intense-blue))) - `(vr/group-1 ((,class :inherit modus-themes-intense-magenta))) - `(vr/group-2 ((,class :inherit modus-themes-intense-green))) - `(vr/match-0 ((,class :inherit modus-themes-refine-yellow))) - `(vr/match-1 ((,class :inherit modus-themes-refine-yellow))) - `(vr/match-separator-face ((,class :inherit (modus-themes-intense-neutral bold)))) + `(vr/group-0 ((,c :inherit modus-themes-intense-blue))) + `(vr/group-1 ((,c :inherit modus-themes-intense-magenta))) + `(vr/group-2 ((,c :inherit modus-themes-intense-green))) + `(vr/match-0 ((,c :inherit modus-themes-intense-yellow))) + `(vr/match-1 ((,c :inherit modus-themes-intense-yellow))) + `(vr/match-separator-face ((,c :inherit bold :background ,bg-active))) ;;;;; vterm - `(vterm-color-black ((,class :background "gray35" :foreground "gray35"))) - `(vterm-color-blue ((,class :background ,blue :foreground ,blue))) - `(vterm-color-cyan ((,class :background ,cyan :foreground ,cyan))) - `(vterm-color-default ((,class :background ,bg-main :foreground ,fg-main))) - `(vterm-color-green ((,class :background ,green :foreground ,green))) - `(vterm-color-inverse-video ((,class :background ,bg-main :inverse-video t))) - `(vterm-color-magenta ((,class :background ,magenta :foreground ,magenta))) - `(vterm-color-red ((,class :background ,red :foreground ,red))) - `(vterm-color-underline ((,class :foreground ,fg-special-warm :underline t))) - `(vterm-color-white ((,class :background "gray65" :foreground "gray65"))) - `(vterm-color-yellow ((,class :background ,yellow :foreground ,yellow))) + `(vterm-color-black ((,c :background "gray35" :foreground "gray35"))) + `(vterm-color-blue ((,c :background ,blue :foreground ,blue))) + `(vterm-color-cyan ((,c :background ,cyan :foreground ,cyan))) + `(vterm-color-default ((,c :background ,bg-main :foreground ,fg-main))) + `(vterm-color-green ((,c :background ,green :foreground ,green))) + `(vterm-color-inverse-video ((,c :background ,bg-main :inverse-video t))) + `(vterm-color-magenta ((,c :background ,magenta :foreground ,magenta))) + `(vterm-color-red ((,c :background ,red :foreground ,red))) + `(vterm-color-underline ((,c :underline t))) + `(vterm-color-white ((,c :background "gray65" :foreground "gray65"))) + `(vterm-color-yellow ((,c :background ,yellow :foreground ,yellow))) ;;;;; vundo - `(vundo-highlight ((,class :inherit (bold vundo-node) :foreground ,red-intense))) + `(vundo-highlight ((,c :inherit (bold vundo-node) :foreground ,red-intense))) ;;;;; wcheck-mode - `(wcheck-default-face ((,class :foreground ,red :underline t))) + `(wcheck-default-face ((,c :foreground ,red :underline t))) ;;;;; web-mode - `(web-mode-annotation-face ((,class :inherit web-mode-comment-face))) - `(web-mode-annotation-html-face ((,class :inherit web-mode-comment-face))) - `(web-mode-annotation-tag-face ((,class :inherit web-mode-comment-face :underline t))) - `(web-mode-block-attr-name-face ((,class :inherit font-lock-constant-face))) - `(web-mode-block-attr-value-face ((,class :inherit font-lock-type-face))) - `(web-mode-block-comment-face ((,class :inherit web-mode-comment-face))) - `(web-mode-block-control-face ((,class :inherit font-lock-builtin-face))) - `(web-mode-block-delimiter-face ((,class :foreground ,fg-main))) - `(web-mode-block-face ((,class :background ,bg-dim))) - `(web-mode-block-string-face ((,class :inherit web-mode-string-face))) - `(web-mode-bold-face ((,class :inherit bold))) - `(web-mode-builtin-face ((,class :inherit font-lock-builtin-face))) - `(web-mode-comment-face ((,class :inherit font-lock-comment-face))) - `(web-mode-comment-keyword-face ((,class :inherit font-lock-warning-face))) - `(web-mode-constant-face ((,class :inherit font-lock-constant-face))) - `(web-mode-css-at-rule-face ((,class :inherit font-lock-constant-face))) - `(web-mode-css-color-face ((,class :inherit font-lock-builtin-face))) - `(web-mode-css-comment-face ((,class :inherit web-mode-comment-face))) - `(web-mode-css-function-face ((,class :inherit font-lock-builtin-face))) - `(web-mode-css-priority-face ((,class :inherit font-lock-warning-face))) - `(web-mode-css-property-name-face ((,class :inherit font-lock-keyword-face))) - `(web-mode-css-pseudo-class-face ((,class :inherit font-lock-doc-face))) - `(web-mode-css-selector-face ((,class :inherit font-lock-keyword-face))) - `(web-mode-css-string-face ((,class :inherit web-mode-string-face))) - `(web-mode-css-variable-face ((,class :foreground ,fg-special-warm))) - `(web-mode-current-column-highlight-face ((,class :background ,bg-alt))) - `(web-mode-current-element-highlight-face ((,class :inherit modus-themes-special-mild))) - `(web-mode-doctype-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold))) - `(web-mode-error-face ((,class :inherit modus-themes-intense-red))) - `(web-mode-filter-face ((,class :inherit font-lock-function-name-face))) - `(web-mode-folded-face ((,class :underline t))) - `(web-mode-function-call-face ((,class :inherit font-lock-function-name-face))) - `(web-mode-function-name-face ((,class :inherit font-lock-function-name-face))) - `(web-mode-html-attr-custom-face ((,class :inherit font-lock-variable-name-face))) - `(web-mode-html-attr-engine-face ((,class :foreground ,fg-main))) - `(web-mode-html-attr-equal-face ((,class :foreground ,fg-main))) - `(web-mode-html-attr-name-face ((,class :inherit font-lock-variable-name-face))) - `(web-mode-html-attr-value-face ((,class :inherit font-lock-constant-face))) - `(web-mode-html-entity-face ((,class :inherit font-lock-negation-char-face))) - `(web-mode-html-tag-bracket-face ((,class :foreground ,fg-dim))) - `(web-mode-html-tag-custom-face ((,class :inherit font-lock-function-name-face))) - `(web-mode-html-tag-face ((,class :inherit font-lock-function-name-face))) - `(web-mode-html-tag-namespaced-face ((,class :inherit font-lock-builtin-face))) - `(web-mode-html-tag-unclosed-face ((,class :inherit error :underline t))) - `(web-mode-inlay-face ((,class :background ,bg-alt))) - `(web-mode-italic-face ((,class :inherit italic))) - `(web-mode-javascript-comment-face ((,class :inherit web-mode-comment-face))) - `(web-mode-javascript-string-face ((,class :inherit web-mode-string-face))) - `(web-mode-json-comment-face ((,class :inherit web-mode-comment-face))) - `(web-mode-json-context-face ((,class :inherit font-lock-builtin-face))) - `(web-mode-json-key-face ((,class :foreground ,blue-nuanced-fg))) - `(web-mode-json-string-face ((,class :inherit web-mode-string-face))) - `(web-mode-jsx-depth-1-face ((,class :background ,blue-intense-bg :foreground ,fg-main))) - `(web-mode-jsx-depth-2-face ((,class :background ,blue-subtle-bg :foreground ,fg-main))) - `(web-mode-jsx-depth-3-face ((,class :background ,bg-special-cold :foreground ,fg-special-cold))) - `(web-mode-jsx-depth-4-face ((,class :background ,bg-alt :foreground ,blue-refine-fg))) - `(web-mode-jsx-depth-5-face ((,class :background ,bg-alt :foreground ,blue-nuanced-fg))) - `(web-mode-keyword-face ((,class :inherit font-lock-keyword-face))) - `(web-mode-param-name-face ((,class :inherit font-lock-function-name-face))) - `(web-mode-part-comment-face ((,class :inherit web-mode-comment-face))) - `(web-mode-part-face ((,class :inherit web-mode-block-face))) - `(web-mode-part-string-face ((,class :inherit web-mode-string-face))) - `(web-mode-preprocessor-face ((,class :inherit font-lock-preprocessor-face))) - `(web-mode-script-face ((,class :inherit web-mode-part-face))) - `(web-mode-sql-keyword-face ((,class :inherit font-lock-negation-char-face))) - `(web-mode-string-face ((,class :inherit font-lock-string-face))) - `(web-mode-style-face ((,class :inherit web-mode-part-face))) - `(web-mode-symbol-face ((,class :inherit font-lock-constant-face))) - `(web-mode-type-face ((,class :inherit font-lock-builtin-face))) - `(web-mode-underline-face ((,class :underline t))) - `(web-mode-variable-name-face ((,class :inherit font-lock-variable-name-face))) - `(web-mode-warning-face ((,class :inherit font-lock-warning-face))) - `(web-mode-whitespace-face ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) + `(web-mode-annotation-face ((,c :inherit web-mode-comment-face))) + `(web-mode-annotation-html-face ((,c :inherit web-mode-comment-face))) + `(web-mode-annotation-tag-face ((,c :inherit web-mode-comment-face :underline t))) + `(web-mode-block-attr-name-face ((,c :inherit font-lock-constant-face))) + `(web-mode-block-attr-value-face ((,c :inherit font-lock-type-face))) + `(web-mode-block-comment-face ((,c :inherit web-mode-comment-face))) + `(web-mode-block-control-face ((,c :inherit font-lock-builtin-face))) + `(web-mode-block-delimiter-face ((,c :foreground ,fg-main))) + `(web-mode-block-face ((,c :background ,bg-dim))) + `(web-mode-block-string-face ((,c :inherit web-mode-string-face))) + `(web-mode-bold-face ((,c :inherit bold))) + `(web-mode-builtin-face ((,c :inherit font-lock-builtin-face))) + `(web-mode-comment-face ((,c :inherit font-lock-comment-face))) + `(web-mode-comment-keyword-face ((,c :inherit font-lock-warning-face))) + `(web-mode-constant-face ((,c :inherit font-lock-constant-face))) + `(web-mode-css-at-rule-face ((,c :inherit font-lock-constant-face))) + `(web-mode-css-color-face ((,c :inherit font-lock-builtin-face))) + `(web-mode-css-comment-face ((,c :inherit web-mode-comment-face))) + `(web-mode-css-function-face ((,c :inherit font-lock-builtin-face))) + `(web-mode-css-priority-face ((,c :inherit font-lock-warning-face))) + `(web-mode-css-property-name-face ((,c :inherit font-lock-keyword-face))) + `(web-mode-css-pseudo-class-face ((,c :inherit font-lock-doc-face))) + `(web-mode-css-selector-face ((,c :inherit font-lock-keyword-face))) + `(web-mode-css-string-face ((,c :inherit web-mode-string-face))) + `(web-mode-css-variable-face ((,c :inherit font-lock-variable-name-face))) + `(web-mode-current-column-highlight-face ((,c :background ,bg-inactive))) + `(web-mode-current-element-highlight-face ((,c :inherit modus-themes-cyan-subtle))) + `(web-mode-doctype-face ((,c :inherit font-lock-doc-face))) + `(web-mode-error-face ((,c :inherit modus-themes-intense-red))) + `(web-mode-filter-face ((,c :inherit font-lock-function-name-face))) + `(web-mode-folded-face ((,c :underline t))) + `(web-mode-function-call-face ((,c :inherit font-lock-function-name-face))) + `(web-mode-function-name-face ((,c :inherit font-lock-function-name-face))) + `(web-mode-html-attr-custom-face ((,c :inherit font-lock-variable-name-face))) + `(web-mode-html-attr-engine-face ((,c :foreground ,fg-main))) + `(web-mode-html-attr-equal-face ((,c :foreground ,fg-main))) + `(web-mode-html-attr-name-face ((,c :inherit font-lock-variable-name-face))) + `(web-mode-html-attr-value-face ((,c :inherit font-lock-constant-face))) + `(web-mode-html-entity-face ((,c :inherit font-lock-negation-char-face))) + `(web-mode-html-tag-bracket-face ((,c :foreground ,fg-dim))) + `(web-mode-html-tag-custom-face ((,c :inherit font-lock-function-name-face))) + `(web-mode-html-tag-face ((,c :inherit font-lock-function-name-face))) + `(web-mode-html-tag-namespaced-face ((,c :inherit font-lock-builtin-face))) + `(web-mode-html-tag-unclosed-face ((,c :inherit error :underline t))) + `(web-mode-inlay-face ((,c :background ,bg-inactive))) + `(web-mode-italic-face ((,c :inherit italic))) + `(web-mode-javascript-comment-face ((,c :inherit web-mode-comment-face))) + `(web-mode-javascript-string-face ((,c :inherit web-mode-string-face))) + `(web-mode-json-comment-face ((,c :inherit web-mode-comment-face))) + `(web-mode-json-context-face ((,c :inherit font-lock-builtin-face))) + `(web-mode-json-key-face ((,c :foreground ,blue-faint))) + `(web-mode-json-string-face ((,c :inherit web-mode-string-face))) + `(web-mode-keyword-face ((,c :inherit font-lock-keyword-face))) + `(web-mode-param-name-face ((,c :inherit font-lock-function-name-face))) + `(web-mode-part-comment-face ((,c :inherit web-mode-comment-face))) + `(web-mode-part-face ((,c :inherit web-mode-block-face))) + `(web-mode-part-string-face ((,c :inherit web-mode-string-face))) + `(web-mode-preprocessor-face ((,c :inherit font-lock-preprocessor-face))) + `(web-mode-script-face ((,c :inherit web-mode-part-face))) + `(web-mode-sql-keyword-face ((,c :inherit font-lock-negation-char-face))) + `(web-mode-string-face ((,c :inherit font-lock-string-face))) + `(web-mode-style-face ((,c :inherit web-mode-part-face))) + `(web-mode-symbol-face ((,c :inherit font-lock-constant-face))) + `(web-mode-type-face ((,c :inherit font-lock-builtin-face))) + `(web-mode-underline-face ((,c :underline t))) + `(web-mode-variable-name-face ((,c :inherit font-lock-variable-name-face))) + `(web-mode-warning-face ((,c :inherit font-lock-warning-face))) + `(web-mode-whitespace-face ((,c :background ,bg-inactive))) ;;;;; wgrep - `(wgrep-delete-face ((,class :inherit warning))) - `(wgrep-done-face ((,class :inherit success))) - `(wgrep-face ((,class :inherit bold))) - `(wgrep-file-face ((,class :foreground ,fg-special-warm))) - `(wgrep-reject-face ((,class :inherit error))) + `(wgrep-delete-face ((,c :inherit warning))) + `(wgrep-done-face ((,c :inherit success))) + `(wgrep-face ((,c :inherit bold))) + `(wgrep-file-face ((,c :foreground ,fg-alt))) + `(wgrep-reject-face ((,c :inherit error))) ;;;;; which-function-mode - `(which-func ((,class :foreground ,magenta-active))) + `(which-func ((,c :inherit bold :foreground ,modeline-info))) ;;;;; which-key - `(which-key-command-description-face ((,class :foreground ,fg-main))) - `(which-key-group-description-face ((,class :foreground ,magenta-alt))) - `(which-key-highlighted-command-face ((,class :foreground ,yellow :underline t))) - `(which-key-key-face ((,class :inherit modus-themes-key-binding))) - `(which-key-local-map-description-face ((,class :foreground ,fg-main))) - `(which-key-note-face ((,class :foreground ,fg-special-warm))) - `(which-key-separator-face ((,class :inherit shadow))) - `(which-key-special-key-face ((,class :inherit bold :foreground ,red-alt))) + `(which-key-command-description-face ((,c :foreground ,fg-main))) + `(which-key-group-description-face ((,c :foreground ,err))) + `(which-key-highlighted-command-face ((,c :foreground ,warning :underline t))) + `(which-key-key-face ((,c :inherit modus-themes-key-binding))) + `(which-key-local-map-description-face ((,c :foreground ,fg-main))) + `(which-key-note-face ((,c :inherit shadow))) + `(which-key-separator-face ((,c :inherit shadow))) + `(which-key-special-key-face ((,c :inherit error))) ;;;;; whitespace-mode - `(whitespace-big-indent ((,class :inherit modus-themes-subtle-red))) - `(whitespace-empty ((,class :inherit modus-themes-intense-magenta))) - `(whitespace-hspace ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) - `(whitespace-indentation ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) - `(whitespace-line ((,class :inherit modus-themes-subtle-yellow))) - `(whitespace-newline ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) - `(whitespace-space ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) - `(whitespace-space-after-tab ((,class :inherit modus-themes-subtle-magenta))) - `(whitespace-space-before-tab ((,class :inherit modus-themes-subtle-cyan))) - `(whitespace-tab ((,class :background ,bg-whitespace :foreground ,fg-whitespace))) - `(whitespace-trailing ((,class :inherit modus-themes-intense-red))) + `(whitespace-big-indent ((,c :inherit modus-themes-subtle-red))) + `(whitespace-empty ((,c :inherit modus-themes-intense-magenta))) + `(whitespace-hspace ((,c :background ,bg-dim :foreground ,fg-dim))) + `(whitespace-indentation ((,c :background ,bg-dim :foreground ,fg-dim))) + `(whitespace-line ((,c :inherit modus-themes-subtle-yellow))) + `(whitespace-newline ((,c :background ,bg-dim :foreground ,fg-dim))) + `(whitespace-space ((,c :background ,bg-dim :foreground ,fg-dim))) + `(whitespace-space-after-tab ((,c :inherit modus-themes-subtle-magenta))) + `(whitespace-space-before-tab ((,c :inherit modus-themes-subtle-cyan))) + `(whitespace-tab ((,c :background ,bg-dim :foreground ,fg-dim))) + `(whitespace-trailing ((,c :inherit modus-themes-intense-red))) ;;;;; window-divider-mode - `(window-divider ((,class :foreground ,fg-window-divider-inner))) - `(window-divider-first-pixel ((,class :foreground ,fg-window-divider-outer))) - `(window-divider-last-pixel ((,class :foreground ,fg-window-divider-outer))) -;;;;; winum - `(winum-face ((,class :inherit modus-themes-bold :foreground ,cyan-active))) + `(window-divider ((,c :foreground ,border))) + `(window-divider-first-pixel ((,c :foreground ,bg-inactive))) + `(window-divider-last-pixel ((,c :foreground ,bg-inactive))) +;;;;; widget + `(widget-button ((,c :inherit bold :foreground ,fg-link))) + `(widget-button-pressed ((,c :inherit widget-buton :foreground ,fg-link-visited))) + `(widget-documentation ((,c :inherit font-lock-doc-face))) + `(widget-field ((,c :background ,bg-inactive :foreground ,fg-main :extend nil))) + `(widget-inactive ((,c :background ,bg-button-inactive :foreground ,fg-button-inactive))) + `(widget-single-line-field ((,c :inherit widget-field))) ;;;;; writegood-mode - `(writegood-duplicates-face ((,class :background ,bg-alt :foreground ,red-alt :underline t))) - `(writegood-passive-voice-face ((,class :inherit modus-themes-lang-warning))) - `(writegood-weasels-face ((,class :inherit modus-themes-lang-error))) + `(writegood-duplicates-face ((,c :inherit modus-themes-lang-error))) + `(writegood-passive-voice-face ((,c :inherit modus-themes-lang-warning))) + `(writegood-weasels-face ((,c :inherit modus-themes-lang-warning))) ;;;;; woman - `(woman-addition ((,class :foreground ,magenta-alt-other))) - `(woman-bold ((,class :inherit bold :foreground ,magenta-alt))) - `(woman-italic ((,class :inherit italic :foreground ,cyan))) - `(woman-unknown ((,class :foreground ,green-alt))) + `(woman-addition ((,c :foreground ,accent-2))) + `(woman-bold ((,c :inherit bold :foreground ,accent-0))) + `(woman-italic ((,c :inherit italic :foreground ,accent-1))) + `(woman-unknown ((,c :foreground ,accent-3))) ;;;;; xah-elisp-mode - `(xah-elisp-at-symbol ((,class :inherit font-lock-warning-face))) - `(xah-elisp-cap-variable ((,class :inherit font-lock-preprocessor-face))) - `(xah-elisp-command-face ((,class :inherit font-lock-type-face))) - `(xah-elisp-dollar-symbol ((,class :inherit font-lock-variable-name-face))) -;;;;; xref - `(xref-file-header ((,class :inherit bold :foreground ,fg-special-cold))) - `(xref-line-number ((,class :inherit shadow))) - `(xref-match ((,class :inherit match))) + `(xah-elisp-at-symbol ((,c :inherit font-lock-warning-face))) + `(xah-elisp-cap-variable ((,c :inherit font-lock-preprocessor-face))) + `(xah-elisp-command-face ((,c :inherit font-lock-type-face))) + `(xah-elisp-dollar-symbol ((,c :inherit font-lock-variable-name-face))) ;;;;; yaml-mode - `(yaml-tab-face ((,class :inherit modus-themes-intense-red))) + `(yaml-tab-face ((,c :inherit modus-themes-intense-red))) ;;;;; yasnippet - `(yas-field-highlight-face ((,class :background ,bg-hl-alt-intense))) -;;;;; ztree - `(ztreep-arrow-face ((,class :foreground ,fg-inactive))) - `(ztreep-diff-header-face ((,class :inherit bold :height 1.2 :foreground ,fg-special-cold))) - `(ztreep-diff-header-small-face ((,class :foreground ,fg-main))) - `(ztreep-diff-model-add-face ((,class :inherit modus-themes-grue))) - `(ztreep-diff-model-diff-face ((,class :foreground ,red))) - `(ztreep-diff-model-ignored-face ((,class :inherit shadow :strike-through t))) - `(ztreep-diff-model-normal-face ((,class :inherit shadow))) - `(ztreep-expand-sign-face ((,class :inherit ztreep-arrow-face))) - `(ztreep-header-face ((,class :inherit bold :height 1.2 :foreground ,fg-special-cold))) - `(ztreep-leaf-face ((,class :foreground ,cyan))) - `(ztreep-node-count-children-face ((,class :foreground ,fg-special-warm))) - `(ztreep-node-face ((,class :foreground ,fg-main)))) + `(yas-field-highlight-face ((,c :inherit highlight)))) "Face specs for use with `modus-themes-theme'.") (defconst modus-themes-custom-variables @@ -7477,69 +3802,79 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;; ansi-colors `(ansi-color-faces-vector [default bold shadow italic underline success warning error]) `(ansi-color-names-vector ["gray35" ,red ,green ,yellow ,blue ,magenta ,cyan "gray65"]) -;;;; awesome-tray - `(awesome-tray-mode-line-active-color ,blue) - `(awesome-tray-mode-line-inactive-color ,bg-active) ;;;; chart `(chart-face-color-list - '( ,red-graph-0-bg ,green-graph-0-bg ,yellow-graph-0-bg ,blue-graph-0-bg ,magenta-graph-0-bg ,cyan-graph-0-bg - ,red-graph-1-bg ,green-graph-1-bg ,yellow-graph-1-bg ,blue-graph-1-bg ,magenta-graph-1-bg ,cyan-graph-1-bg)) + '( ,bg-graph-red-0 ,bg-graph-green-0 ,bg-graph-yellow-0 ,bg-graph-blue-0 ,bg-graph-magenta-0 ,bg-graph-cyan-0 + ,bg-graph-red-1 ,bg-graph-green-1 ,bg-graph-yellow-1 ,bg-graph-blue-1 ,bg-graph-magenta-1 ,bg-graph-cyan-1)) ;;;; exwm - `(exwm-floating-border-color ,fg-window-divider-inner) + `(exwm-floating-border-color ,border) ;;;; flymake fringe indicators - `(flymake-error-bitmap '(flymake-double-exclamation-mark modus-themes-fringe-red)) - `(flymake-warning-bitmap '(exclamation-mark modus-themes-fringe-yellow)) - `(flymake-note-bitmap '(exclamation-mark modus-themes-fringe-cyan)) + `(flymake-error-bitmap '(flymake-double-exclamation-mark modus-themes-intense-red)) + `(flymake-warning-bitmap '(exclamation-mark modus-themes-intense-yellow)) + `(flymake-note-bitmap '(exclamation-mark modus-themes-intense-cyan)) ;;;; highlight-changes `(highlight-changes-colors nil) `(highlight-changes-face-list '(success warning error bold bold-italic)) ;;;; ibuffer `(ibuffer-deletion-face 'modus-themes-mark-del) - `(ibuffer-filter-group-name-face 'modus-themes-pseudo-header) + `(ibuffer-filter-group-name-face 'bold) `(ibuffer-marked-face 'modus-themes-mark-sel) `(ibuffer-title-face 'default) ;;;; hl-todo `(hl-todo-keyword-faces - '(("HOLD" . ,yellow-alt) - ("TODO" . ,magenta) - ("NEXT" . ,magenta-alt-other) - ("THEM" . ,magenta-alt) - ("PROG" . ,cyan) - ("OKAY" . ,cyan-alt) - ("DONT" . ,green-alt) - ("FAIL" . ,red) - ("BUG" . ,red) - ("DONE" . ,green) - ("NOTE" . ,yellow-alt-other) - ("KLUDGE" . ,yellow) - ("HACK" . ,yellow) - ("TEMP" . ,red-nuanced-fg) - ("FIXME" . ,red-alt-other) - ("XXX+" . ,red-alt) - ("REVIEW" . ,cyan-alt-other) - ("DEPRECATED" . ,blue-nuanced-fg))) -;;;; mini-modeline - `(mini-modeline-face-attr '(:background unspecified)) + '(("HOLD" . ,warning) + ("TODO" . ,err) + ("NEXT" . ,fg-alt) + ("THEM" . ,fg-alt) + ("PROG" . ,info) + ("OKAY" . ,info) + ("DONT" . ,warning) + ("FAIL" . ,err) + ("BUG" . ,err) + ("DONE" . ,info) + ("NOTE" . ,warning) + ("KLUDGE" . ,warning) + ("HACK" . ,warning) + ("TEMP" . ,warning) + ("FIXME" . ,err) + ("XXX+" . ,err) + ("REVIEW" . ,info) + ("DEPRECATED" . ,info))) ;;;; pdf-tools - `(pdf-view-midnight-colors - '(,fg-main . ,bg-dim)) -;;;; wid-edit - `(widget-link-prefix ,(if (memq 'all-buttons modus-themes-box-buttons) - " " - "[")) - `(widget-link-suffix ,(if (memq 'all-buttons modus-themes-box-buttons) - " " - "]")) - `(widget-mouse-face '(highlight widget-button)) - `(widget-push-button-prefix ,(if (memq 'all-buttons modus-themes-box-buttons) - " " - "[")) - `(widget-push-button-suffix ,(if (memq 'all-buttons modus-themes-box-buttons) - " " - "]")) -;;;; xterm-color - `(xterm-color-names ["black" ,red ,green ,yellow ,blue ,magenta ,cyan "gray65"]) - `(xterm-color-names-bright ["gray35" ,red-alt ,green-alt ,yellow-alt ,blue-alt ,magenta-alt ,cyan-alt "white"]) + `(pdf-view-midnight-colors '(,fg-main . ,bg-dim)) +;;;; rcirc-color + `(rcirc-colors + '(modus-themes-fg-red + modus-themes-fg-green + modus-themes-fg-blue + modus-themes-fg-yellow + modus-themes-fg-magenta + modus-themes-fg-cyan + modus-themes-fg-red-warmer + modus-themes-fg-green-warmer + modus-themes-fg-blue-warmer + modus-themes-fg-yellow-warmer + modus-themes-fg-magenta-warmer + modus-themes-fg-cyan-warmer + modus-themes-fg-red-cooler + modus-themes-fg-green-cooler + modus-themes-fg-blue-cooler + modus-themes-fg-yellow-cooler + modus-themes-fg-magenta-cooler + modus-themes-fg-cyan-cooler + modus-themes-fg-red-faint + modus-themes-fg-green-faint + modus-themes-fg-blue-faint + modus-themes-fg-yellow-faint + modus-themes-fg-magenta-faint + modus-themes-fg-cyan-faint + modus-themes-fg-red-intense + modus-themes-fg-green-intense + modus-themes-fg-blue-intense + modus-themes-fg-yellow-intense + modus-themes-fg-magenta-intense + modus-themes-fg-cyan-intense)) +;;;; org-src-block-faces (if (or (eq modus-themes-org-blocks 'tinted-background) (eq modus-themes-org-blocks 'rainbow)) `(org-src-block-faces @@ -7564,6 +3899,56 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-src-block-faces '()))) "Custom variables for `modus-themes-theme'.") +;;; Theme macros + +;;;; Instantiate a Modus theme + +;;;###autoload +(defmacro modus-themes-theme (name palette &optional overrides) + "Bind NAME's color PALETTE around face specs and variables. +Face specifications are passed to `custom-theme-set-faces'. +While variables are handled by `custom-theme-set-variables'. +Those are stored in `modus-themes-faces' and +`modus-themes-custom-variables' respectively. + +Optional OVERRIDES are appended to PALETTE, overriding +corresponding entries." + (declare (indent 0)) + (let ((sym (gensym)) + (colors (mapcar #'car (symbol-value palette)))) + `(let* ((c '((class color) (min-colors 256))) + (,sym (modus-themes--palette-value ',name ',overrides)) + ,@(mapcar (lambda (color) + (list color + `(modus-themes--retrieve-palette-value ',color ,sym))) + colors)) + (ignore c ,@colors) ; Silence unused variable warnings + (custom-theme-set-faces ',name ,@modus-themes-faces) + (custom-theme-set-variables ',name ,@modus-themes-custom-variables)))) + +;;;; Use theme colors + +(defmacro modus-themes-with-colors (&rest body) + "Evaluate BODY with colors from current palette bound." + (declare (indent 0)) + (let* ((sym (gensym)) + ;; NOTE 2022-08-23: We just give it a sample palette at this + ;; stage. It only needs to collect each car. Then we + ;; instantiate the actual theme's palette. We have to do this + ;; otherwise the macro does not work properly when called from + ;; inside a function. + (colors (mapcar #'car (modus-themes--current-theme-palette)))) + `(let* ((c '((class color) (min-colors 256))) + (,sym (modus-themes--current-theme-palette :overrides)) + ,@(mapcar (lambda (color) + (list color + `(modus-themes--retrieve-palette-value ',color ,sym))) + colors)) + (ignore c ,@colors) ; Silence unused variable warnings + ,@body))) + +;;;; Add themes from package to path + ;;;###autoload (when load-file-name (let ((dir (file-name-directory load-file-name))) diff --git a/etc/themes/modus-vivendi-deuteranopia-theme.el b/etc/themes/modus-vivendi-deuteranopia-theme.el new file mode 100644 index 00000000000..57241c59b96 --- /dev/null +++ b/etc/themes/modus-vivendi-deuteranopia-theme.el @@ -0,0 +1,418 @@ +;;; modus-vivendi-deuteranopia-theme.el --- Elegant, highly legible and customizable dark theme -*- lexical-binding:t -*- + +;; Copyright (C) 2019-2023 Free Software Foundation, Inc. + +;; Author: Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> +;; URL: https://git.sr.ht/~protesilaos/modus-themes +;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes + +;; 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: +;; +;; The Modus themes conform with the highest standard for +;; color-contrast accessibility between background and foreground +;; values (WCAG AAA). Please refer to the official Info manual for +;; further documentation (distributed with the themes, or available +;; at: <https://protesilaos.com/emacs/modus-themes>). + +;;; Code: + + + +(eval-and-compile + (unless (and (fboundp 'require-theme) + load-file-name + (equal (file-name-directory load-file-name) + (expand-file-name "themes/" data-directory)) + (require-theme 'modus-themes t)) + (require 'modus-themes)) + + (deftheme modus-vivendi-deuteranopia + "Elegant, highly legible and customizable dark theme. +This variant is optimized for users with red-green color +deficiency (deuteranopia). It conforms with the highest +legibility standard for color contrast between background and +foreground in any given piece of text, which corresponds to a +minimum contrast in relative luminance of 7:1 (WCAG AAA +standard).") + + (defconst modus-vivendi-deuteranopia-palette + '( +;;; Basic values + + (bg-main "#000000") + (bg-dim "#1e1e1e") + (fg-main "#ffffff") + (fg-dim "#989898") + (fg-alt "#c6daff") + (bg-active "#535353") + (bg-inactive "#303030") + (border "#646464") + +;;; Common accent foregrounds + + (red "#ff5f59") + (red-warmer "#ff6b55") + (red-cooler "#ff7f9f") + (red-faint "#ff9580") + (red-intense "#ff5f5f") + (green "#44bc44") + (green-warmer "#70b900") + (green-cooler "#00c06f") + (green-faint "#88ca9f") + (green-intense "#44df44") + (yellow "#d0bc00") + (yellow-warmer "#fec43f") + (yellow-cooler "#dfaf7a") + (yellow-faint "#d2b580") + (yellow-intense "#efef00") + (blue "#2fafff") + (blue-warmer "#79a8ff") + (blue-cooler "#00bcff") + (blue-faint "#82b0ec") + (blue-intense "#338fff") + (magenta "#feacd0") + (magenta-warmer "#f78fe7") + (magenta-cooler "#b6a0ff") + (magenta-faint "#caa6df") + (magenta-intense "#ff66ff") + (cyan "#00d3d0") + (cyan-warmer "#4ae2f0") + (cyan-cooler "#6ae4b9") + (cyan-faint "#9ac8e0") + (cyan-intense "#00eff0") + +;;; Uncommon accent foregrounds + + (rust "#db7b5f") + (gold "#c0965b") + (olive "#9cbd6f") + (slate "#76afbf") + (indigo "#9099d9") + (maroon "#cf7fa7") + (pink "#d09dc0") + +;;; Common accent backgrounds + + (bg-red-intense "#9d1f1f") + (bg-green-intense "#2f822f") + (bg-yellow-intense "#7a6100") + (bg-blue-intense "#1640b0") + (bg-magenta-intense "#7030af") + (bg-cyan-intense "#2266ae") + + (bg-red-subtle "#620f2a") + (bg-green-subtle "#00422a") + (bg-yellow-subtle "#4a4000") + (bg-blue-subtle "#242679") + (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") + +;;; Uncommon accent backgrounds + + (bg-ochre "#442c2f") + (bg-lavender "#38325c") + (bg-sage "#0f3d30") + +;;; Graphs + + (bg-graph-red-0 "#705c3c") + (bg-graph-red-1 "#504420") + (bg-graph-green-0 "#4f666f") + (bg-graph-green-1 "#204840") + (bg-graph-yellow-0 "#c1c00a") + (bg-graph-yellow-1 "#6f6f00") + (bg-graph-blue-0 "#2fafef") + (bg-graph-blue-1 "#1f2f8f") + (bg-graph-magenta-0 "#7f7f8e") + (bg-graph-magenta-1 "#4f4f5f") + (bg-graph-cyan-0 "#376f9a") + (bg-graph-cyan-1 "#00404f") + +;;; Special purpose + + (bg-completion "#2f447f") + (bg-hover "#004f70") + (bg-hover-secondary "#654a39") + (bg-hl-line "#2f3849") + (bg-region "#5a5a5a") + (fg-region "#ffffff") + + (bg-char-0 "#0050af") + (bg-char-1 "#7f1f7f") + (bg-char-2 "#625a00") + + (bg-mode-line-active "#2a2a6a") + (fg-mode-line-active "#f0f0f0") + (border-mode-line-active "#8080a7") + (bg-mode-line-inactive "#2d2d2d") + (fg-mode-line-inactive "#969696") + (border-mode-line-inactive "#606060") + + (modeline-err "#e5bf00") + (modeline-warning "#c0cf35") + (modeline-info "#abeadf") + + (bg-tab-bar "#313131") + (bg-tab-current "#000000") + (bg-tab-other "#545454") + +;;; Diffs + + (bg-added "#003066") + (bg-added-faint "#001a4f") + (bg-added-refine "#0f4a77") + (bg-added-fringe "#006fff") + (fg-added "#c4d5ff") + (fg-added-intense "#8080ff") + + (bg-changed "#2f123f") + (bg-changed-faint "#1f022f") + (bg-changed-refine "#3f325f") + (bg-changed-fringe "#7f55a0") + (fg-changed "#e3cfff") + (fg-changed-intense "#cf9fe2") + + (bg-removed "#3d3d00") + (bg-removed-faint "#281f00") + (bg-removed-refine "#515100") + (bg-removed-fringe "#d0c03f") + (fg-removed "#d4d48f") + (fg-removed-intense "#d0b05f") + + (bg-diff-context "#1a1a1a") + +;;; Paren match + + (bg-paren-match "#2f7f9f") + (bg-paren-expression "#453040") + (underline-paren-match unspecified) + +;;; Mappings + +;;;; General mappings + + (fringe bg-dim) + (cursor yellow-intense) + + (keybind blue-cooler) + (name blue-cooler) + (identifier yellow-faint) + + (err yellow-warmer) + (warning yellow-cooler) + (info blue) + + (underline-err yellow-intense) + (underline-warning magenta-faint) + (underline-note cyan) + +;;;; Code mappings + + (builtin magenta-warmer) + (comment yellow-cooler) + (constant blue-cooler) + (docstring cyan-faint) + (docmarkup magenta-faint) + (fnname magenta) + (keyword magenta-cooler) + (preprocessor red-cooler) + (string blue-warmer) + (type cyan-cooler) + (variable cyan) + (rx-construct yellow-cooler) + (rx-backslash blue-cooler) + +;;;; Accent mappings + + (accent-0 blue-cooler) + (accent-1 yellow) + (accent-2 cyan-cooler) + (accent-3 magenta-warmer) + +;;;; Button mappings + + (fg-button-active fg-main) + (fg-button-inactive fg-dim) + (bg-button-active bg-active) + (bg-button-inactive bg-dim) + +;;;; Completion mappings + + (fg-completion-match-0 blue-cooler) + (fg-completion-match-1 yellow) + (fg-completion-match-2 cyan-cooler) + (fg-completion-match-3 magenta-warmer) + (bg-completion-match-0 unspecified) + (bg-completion-match-1 unspecified) + (bg-completion-match-2 unspecified) + (bg-completion-match-3 unspecified) + +;;;; Date mappings + + (date-common cyan) + (date-deadline yellow-warmer) + (date-event fg-alt) + (date-holiday yellow-warmer) + (date-now blue-faint) + (date-scheduled yellow-cooler) + (date-weekday cyan) + (date-weekend yellow-faint) + +;;;; Line number mappings + + (fg-line-number-inactive fg-dim) + (fg-line-number-active fg-main) + (bg-line-number-inactive bg-dim) + (bg-line-number-active bg-active) + +;;;; Link mappings + + (fg-link blue-warmer) + (bg-link unspecified) + (underline-link blue-warmer) + + (fg-link-symbolic cyan) + (bg-link-symbolic unspecified) + (underline-link-symbolic cyan) + + (fg-link-visited yellow-faint) + (bg-link-visited unspecified) + (underline-link-visited yellow-faint) + +;;;; Mail mappings + + (mail-cite-0 blue-warmer) + (mail-cite-1 yellow-cooler) + (mail-cite-2 blue-cooler) + (mail-cite-3 yellow) + (mail-part blue) + (mail-recipient blue) + (mail-subject yellow-warmer) + (mail-other cyan-faint) + +;;;; Prompt mappings + + (fg-prompt blue) + (bg-prompt unspecified) + +;;;; Prose mappings + + (prose-block fg-dim) + (prose-code cyan-cooler) + (prose-done blue) + (prose-macro magenta-cooler) + (prose-metadata fg-dim) + (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-tag magenta-faint) + (prose-todo yellow-warmer) + (prose-verbatim magenta-warmer) + +;;;; Rainbow mappings + + (rainbow-0 yellow-warmer) + (rainbow-1 blue) + (rainbow-2 yellow-cooler) + (rainbow-3 blue-warmer) + (rainbow-4 yellow) + (rainbow-5 cyan-warmer) + (rainbow-6 yellow-faint) + (rainbow-7 blue-faint) + (rainbow-8 magenta-faint) + +;;;; Heading mappings + + (fg-heading-0 cyan-cooler) + (fg-heading-1 fg-main) + (fg-heading-2 yellow-faint) + (fg-heading-3 blue-faint) + (fg-heading-4 magenta) + (fg-heading-5 green-faint) + (fg-heading-6 red-faint) + (fg-heading-7 cyan-faint) + (fg-heading-8 fg-dim) + + (bg-heading-0 unspecified) + (bg-heading-1 unspecified) + (bg-heading-2 unspecified) + (bg-heading-3 unspecified) + (bg-heading-4 unspecified) + (bg-heading-5 unspecified) + (bg-heading-6 unspecified) + (bg-heading-7 unspecified) + (bg-heading-8 unspecified) + + (overline-heading-0 unspecified) + (overline-heading-1 unspecified) + (overline-heading-2 unspecified) + (overline-heading-3 unspecified) + (overline-heading-4 unspecified) + (overline-heading-5 unspecified) + (overline-heading-6 unspecified) + (overline-heading-7 unspecified) + (overline-heading-8 unspecified)) + "The entire palette of the `modus-vivendi-deuteranopia' theme. + +Named colors have the form (COLOR-NAME HEX-VALUE) with the former +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.") + + (defcustom modus-vivendi-deuteranopia-palette-overrides nil + "Overrides for `modus-vivendi-deuteranopia-palette'. + +Mirror the elements of the aforementioned palette, overriding +their value. + +For overrides that are shared across all of the Modus themes, +refer to `modus-themes-common-palette-overrides'. + +Theme-specific overrides take precedence over shared overrides. +The idea of common overrides is to change semantic color +mappings, such as to make the cursor red. Wherea theme-specific +overrides can also be used to change the value of a named color, +such as what hexadecimal RGB value the red-warmer symbol +represents." + :group 'modus-themes + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :type '(repeat (list symbol (choice symbol string))) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Palette overrides")) + + (modus-themes-theme modus-vivendi-deuteranopia + modus-vivendi-deuteranopia-palette + modus-vivendi-deuteranopia-palette-overrides) + + (provide-theme 'modus-vivendi-deuteranopia)) + +;;;###theme-autoload +(put 'modus-vivendi-deuteranopia 'theme-properties '(:background-mode dark :kind color-scheme :family modus)) + +;;; modus-vivendi-deuteranopia-theme.el ends here diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 6b365f421cc..5012f8fb7f8 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -1,14 +1,11 @@ ;;; modus-vivendi-theme.el --- Elegant, highly legible and customizable dark theme -*- lexical-binding:t -*- -;; Copyright (C) 2019-2023 Free Software Foundation, Inc. +;; Copyright (C) 2019-2023 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> ;; URL: https://git.sr.ht/~protesilaos/modus-themes ;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes -;; Version: 3.0.0 -;; Package-Requires: ((emacs "27.1")) -;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -27,26 +24,11 @@ ;;; Commentary: ;; -;; Modus Vivendi is the dark variant of the Modus themes (Modus Operandi -;; is the light one). The themes are designed for color-contrast -;; accessibility. More specifically: -;; -;; 1. Provide a consistent minimum contrast ratio between background -;; and foreground values of 7:1 or higher. This meets the highest -;; such accessibility criterion per the guidelines of the Worldwide -;; Web Consortium's Working Group on Accessibility (WCAG AAA -;; standard). -;; -;; 2. Offer as close to full face coverage as possible. The list is -;; already quite long, with more additions to follow as part of the -;; ongoing development process. -;; -;; For a complete view of the project, also refer to the following files -;; (should be distributed in the same repository/directory as the -;; current item): -;; -;; - modus-themes.el (Main code shared between the themes) -;; - modus-operandi-theme.el (Light theme) +;; The Modus themes conform with the highest standard for +;; color-contrast accessibility between background and foreground +;; values (WCAG AAA). Please refer to the official Info manual for +;; further documentation (distributed with the themes, or available +;; at: <https://protesilaos.com/emacs/modus-themes>). ;;; Code: @@ -67,7 +49,365 @@ between background and foreground in any given piece of text, which corresponds to a minimum contrast in relative luminance of 7:1 (WCAG AAA standard).") - (modus-themes-theme modus-vivendi) + (defconst modus-vivendi-palette + '( +;;; Basic values + + (bg-main "#000000") + (bg-dim "#1e1e1e") + (fg-main "#ffffff") + (fg-dim "#989898") + (fg-alt "#c6daff") + (bg-active "#535353") + (bg-inactive "#303030") + (border "#646464") + +;;; Common accent foregrounds + + (red "#ff5f59") + (red-warmer "#ff6b55") + (red-cooler "#ff7f9f") + (red-faint "#ff9580") + (red-intense "#ff5f5f") + (green "#44bc44") + (green-warmer "#70b900") + (green-cooler "#00c06f") + (green-faint "#88ca9f") + (green-intense "#44df44") + (yellow "#d0bc00") + (yellow-warmer "#fec43f") + (yellow-cooler "#dfaf7a") + (yellow-faint "#d2b580") + (yellow-intense "#efef00") + (blue "#2fafff") + (blue-warmer "#79a8ff") + (blue-cooler "#00bcff") + (blue-faint "#82b0ec") + (blue-intense "#338fff") + (magenta "#feacd0") + (magenta-warmer "#f78fe7") + (magenta-cooler "#b6a0ff") + (magenta-faint "#caa6df") + (magenta-intense "#ff66ff") + (cyan "#00d3d0") + (cyan-warmer "#4ae2f0") + (cyan-cooler "#6ae4b9") + (cyan-faint "#9ac8e0") + (cyan-intense "#00eff0") + +;;; Uncommon accent foregrounds + + (rust "#db7b5f") + (gold "#c0965b") + (olive "#9cbd6f") + (slate "#76afbf") + (indigo "#9099d9") + (maroon "#cf7fa7") + (pink "#d09dc0") + +;;; Common accent backgrounds + + (bg-red-intense "#9d1f1f") + (bg-green-intense "#2f822f") + (bg-yellow-intense "#7a6100") + (bg-blue-intense "#1640b0") + (bg-magenta-intense "#7030af") + (bg-cyan-intense "#2266ae") + + (bg-red-subtle "#620f2a") + (bg-green-subtle "#00422a") + (bg-yellow-subtle "#4a4000") + (bg-blue-subtle "#242679") + (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") + +;;; Uncommon accent backgrounds + + (bg-ochre "#442c2f") + (bg-lavender "#38325c") + (bg-sage "#0f3d30") + +;;; Graphs + + (bg-graph-red-0 "#b52c2c") + (bg-graph-red-1 "#702020") + (bg-graph-green-0 "#4fd100") + (bg-graph-green-1 "#007800") + (bg-graph-yellow-0 "#f1e00a") + (bg-graph-yellow-1 "#b08600") + (bg-graph-blue-0 "#2fafef") + (bg-graph-blue-1 "#1f2f8f") + (bg-graph-magenta-0 "#bf94fe") + (bg-graph-magenta-1 "#5f509f") + (bg-graph-cyan-0 "#47dfea") + (bg-graph-cyan-1 "#00808f") + +;;; Special purpose + + (bg-completion "#2f447f") + (bg-hover "#004f70") + (bg-hover-secondary "#654a39") + (bg-hl-line "#2f3849") + (bg-region "#5a5a5a") + (fg-region "#ffffff") + + (bg-char-0 "#0050af") + (bg-char-1 "#7f1f7f") + (bg-char-2 "#625a00") + + (bg-mode-line-active "#505050") + (fg-mode-line-active "#ffffff") + (border-mode-line-active "#959595") + (bg-mode-line-inactive "#2d2d2d") + (fg-mode-line-inactive "#969696") + (border-mode-line-inactive "#606060") + + (modeline-err "#ffa9bf") + (modeline-warning "#dfcf43") + (modeline-info "#9fefff") + + (bg-tab-bar "#313131") + (bg-tab-current "#000000") + (bg-tab-other "#545454") + +;;; Diffs + + (bg-added "#00381f") + (bg-added-faint "#002910") + (bg-added-refine "#034f2f") + (bg-added-fringe "#237f3f") + (fg-added "#a0e0a0") + (fg-added-intense "#80e080") + + (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") + + (bg-diff-context "#1a1a1a") + +;;; Paren match + + (bg-paren-match "#2f7f9f") + (bg-paren-expression "#453040") + (underline-paren-match unspecified) + +;;; Mappings + +;;;; General mappings + + (fringe bg-dim) + (cursor fg-main) + + (keybind blue-cooler) + (name magenta) + (identifier yellow-faint) + + (err red) + (warning yellow-warmer) + (info cyan-cooler) + + (underline-err red-intense) + (underline-warning yellow) + (underline-note cyan) + +;;;; Code mappings + + (builtin magenta-warmer) + (comment fg-dim) + (constant blue-cooler) + (docstring cyan-faint) + (docmarkup magenta-faint) + (fnname magenta) + (keyword magenta-cooler) + (preprocessor red-cooler) + (string blue-warmer) + (type cyan-cooler) + (variable cyan) + (rx-construct green-cooler) + (rx-backslash magenta) + +;;;; Accent mappings + + (accent-0 blue-cooler) + (accent-1 magenta-warmer) + (accent-2 cyan-cooler) + (accent-3 yellow) + +;;;; Button mappings + + (fg-button-active fg-main) + (fg-button-inactive fg-dim) + (bg-button-active bg-active) + (bg-button-inactive bg-dim) + +;;;; Completion mappings + + (fg-completion-match-0 blue-cooler) + (fg-completion-match-1 magenta-warmer) + (fg-completion-match-2 cyan-cooler) + (fg-completion-match-3 yellow) + (bg-completion-match-0 unspecified) + (bg-completion-match-1 unspecified) + (bg-completion-match-2 unspecified) + (bg-completion-match-3 unspecified) + +;;;; Date mappings + + (date-common cyan) + (date-deadline red) + (date-event fg-alt) + (date-holiday magenta) + (date-now fg-main) + (date-scheduled yellow-warmer) + (date-weekday cyan) + (date-weekend red-faint) + +;;;; Line number mappings + + (fg-line-number-inactive fg-dim) + (fg-line-number-active fg-main) + (bg-line-number-inactive bg-dim) + (bg-line-number-active bg-active) + +;;;; Link mappings + + (fg-link blue-warmer) + (bg-link unspecified) + (underline-link blue-warmer) + + (fg-link-symbolic cyan) + (bg-link-symbolic unspecified) + (underline-link-symbolic cyan) + + (fg-link-visited magenta) + (bg-link-visited unspecified) + (underline-link-visited magenta) + +;;;; Mail mappings + + (mail-cite-0 blue-warmer) + (mail-cite-1 yellow-cooler) + (mail-cite-2 cyan-cooler) + (mail-cite-3 red-cooler) + (mail-part blue) + (mail-recipient magenta-cooler) + (mail-subject magenta-warmer) + (mail-other magenta-faint) + +;;;; Prompt mappings + + (fg-prompt cyan-cooler) + (bg-prompt unspecified) + +;;;; Prose mappings + + (prose-block fg-dim) + (prose-code cyan-cooler) + (prose-done green) + (prose-macro magenta-cooler) + (prose-metadata fg-dim) + (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-tag magenta-faint) + (prose-todo red) + (prose-verbatim magenta-warmer) + +;;;; Rainbow mappings + + (rainbow-0 fg-main) + (rainbow-1 magenta-intense) + (rainbow-2 cyan-intense) + (rainbow-3 red-warmer) + (rainbow-4 yellow-intense) + (rainbow-5 magenta-cooler) + (rainbow-6 green-intense) + (rainbow-7 blue-warmer) + (rainbow-8 magenta-warmer) + +;;;; Heading mappings + + (fg-heading-0 cyan-cooler) + (fg-heading-1 fg-main) + (fg-heading-2 yellow-faint) + (fg-heading-3 blue-faint) + (fg-heading-4 magenta) + (fg-heading-5 green-faint) + (fg-heading-6 red-faint) + (fg-heading-7 cyan-faint) + (fg-heading-8 fg-dim) + + (bg-heading-0 unspecified) + (bg-heading-1 unspecified) + (bg-heading-2 unspecified) + (bg-heading-3 unspecified) + (bg-heading-4 unspecified) + (bg-heading-5 unspecified) + (bg-heading-6 unspecified) + (bg-heading-7 unspecified) + (bg-heading-8 unspecified) + + (overline-heading-0 unspecified) + (overline-heading-1 unspecified) + (overline-heading-2 unspecified) + (overline-heading-3 unspecified) + (overline-heading-4 unspecified) + (overline-heading-5 unspecified) + (overline-heading-6 unspecified) + (overline-heading-7 unspecified) + (overline-heading-8 unspecified)) + "The entire palette of the `modus-vivendi' theme. + +Named colors have the form (COLOR-NAME HEX-VALUE) with the former +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.") + + + (defcustom modus-vivendi-palette-overrides nil + "Overrides for `modus-vivendi-palette'. + +Mirror the elements of the aforementioned palette, overriding +their value. + +For overrides that are shared across all of the Modus themes, +refer to `modus-themes-common-palette-overrides'. + +Theme-specific overrides take precedence over shared overrides. +The idea of common overrides is to change semantic color +mappings, such as to make the cursor red. Wherea theme-specific +overrides can also be used to change the value of a named color, +such as what hexadecimal RGB value the red-warmer symbol +represents." + :group 'modus-themes + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :type '(repeat (list symbol (choice symbol string))) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Palette overrides")) + + (modus-themes-theme modus-vivendi + modus-vivendi-palette + modus-vivendi-palette-overrides) (provide-theme 'modus-vivendi)) diff --git a/etc/themes/modus-vivendi-tinted-theme.el b/etc/themes/modus-vivendi-tinted-theme.el new file mode 100644 index 00000000000..79e7fc9e3d8 --- /dev/null +++ b/etc/themes/modus-vivendi-tinted-theme.el @@ -0,0 +1,416 @@ +;;; modus-vivendi-tinted-theme.el --- Elegant, highly legible and customizable dark theme -*- lexical-binding:t -*- + +;; Copyright (C) 2019-2023 Free Software Foundation, Inc. + +;; Author: Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> +;; URL: https://git.sr.ht/~protesilaos/modus-themes +;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes + +;; 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: +;; +;; The Modus themes conform with the highest standard for +;; color-contrast accessibility between background and foreground +;; values (WCAG AAA). Please refer to the official Info manual for +;; further documentation (distributed with the themes, or available +;; at: <https://protesilaos.com/emacs/modus-themes>). + +;;; Code: + + + +(eval-and-compile + (unless (and (fboundp 'require-theme) + load-file-name + (equal (file-name-directory load-file-name) + (expand-file-name "themes/" data-directory)) + (require-theme 'modus-themes t)) + (require 'modus-themes)) + + (deftheme modus-vivendi-tinted + "Elegant, highly legible and customizable dark theme. +Conforms with the highest legibility standard for color contrast +between background and foreground in any given piece of text, +which corresponds to a minimum contrast in relative luminance of +7:1 (WCAG AAA standard).") + + (defconst modus-vivendi-tinted-palette + '( +;;; Basic values + + (bg-main "#0d0e1c") + (bg-dim "#1d2235") + (fg-main "#ffffff") + (fg-dim "#989898") + (fg-alt "#c6daff") + (bg-active "#4a4f69") + (bg-inactive "#2b3045") + (border "#61647a") + +;;; Common accent foregrounds + + (red "#ff5f59") + (red-warmer "#ff6b55") + (red-cooler "#ff7f9f") + (red-faint "#ff9f80") + (red-intense "#ff5f5f") + (green "#44bc44") + (green-warmer "#70b900") + (green-cooler "#00c06f") + (green-faint "#88ca9f") + (green-intense "#44df44") + (yellow "#d0bc00") + (yellow-warmer "#fec43f") + (yellow-cooler "#dfaf7a") + (yellow-faint "#d2b580") + (yellow-intense "#efef00") + (blue "#2fafff") + (blue-warmer "#79a8ff") + (blue-cooler "#00bcff") + (blue-faint "#82b0ec") + (blue-intense "#338fff") + (magenta "#feacd0") + (magenta-warmer "#f78fe7") + (magenta-cooler "#b6a0ff") + (magenta-faint "#caa6df") + (magenta-intense "#ff66ff") + (cyan "#00d3d0") + (cyan-warmer "#4ae2f0") + (cyan-cooler "#6ae4b9") + (cyan-faint "#9ac8e0") + (cyan-intense "#00eff0") + +;;; Uncommon accent foregrounds + + (rust "#db7b5f") + (gold "#c0965b") + (olive "#9cbd6f") + (slate "#76afbf") + (indigo "#9099d9") + (maroon "#cf7fa7") + (pink "#d09dc0") + +;;; Common accent backgrounds + + (bg-red-intense "#9d1f1f") + (bg-green-intense "#2f822f") + (bg-yellow-intense "#7a6100") + (bg-blue-intense "#1640b0") + (bg-magenta-intense "#7030af") + (bg-cyan-intense "#2266ae") + + (bg-red-subtle "#620f2a") + (bg-green-subtle "#00422a") + (bg-yellow-subtle "#4a4000") + (bg-blue-subtle "#242679") + (bg-magenta-subtle "#552f5f") + (bg-cyan-subtle "#004065") + + (bg-red-nuanced "#350f14") + (bg-green-nuanced "#002718") + (bg-yellow-nuanced "#2c1f00") + (bg-blue-nuanced "#131c4d") + (bg-magenta-nuanced "#2f133f") + (bg-cyan-nuanced "#04253f") + +;;; Graphs + + (bg-graph-red-0 "#b52c2c") + (bg-graph-red-1 "#702020") + (bg-graph-green-0 "#4fd100") + (bg-graph-green-1 "#007800") + (bg-graph-yellow-0 "#f1e00a") + (bg-graph-yellow-1 "#b08600") + (bg-graph-blue-0 "#2fafef") + (bg-graph-blue-1 "#1f2f8f") + (bg-graph-magenta-0 "#bf94fe") + (bg-graph-magenta-1 "#5f509f") + (bg-graph-cyan-0 "#47dfea") + (bg-graph-cyan-1 "#00808f") + +;;; Special purpose + + (bg-completion "#483d8a") + (bg-hover "#004f70") + (bg-hover-secondary "#654a39") + (bg-hl-line "#303a6f") + (bg-region "#555a66") + (fg-region "#ffffff") + + (bg-char-0 "#0050af") + (bg-char-1 "#7f1f7f") + (bg-char-2 "#625a00") + + (bg-mode-line-active "#484d67") + (fg-mode-line-active "#ffffff") + (border-mode-line-active "#979797") + (bg-mode-line-inactive "#292d48") + (fg-mode-line-inactive "#969696") + (border-mode-line-inactive "#606270") + + (modeline-err "#ffa9bf") + (modeline-warning "#dfcf43") + (modeline-info "#9fefff") + + (bg-tab-bar "#2c3045") + (bg-tab-current "#0d0e1c") + (bg-tab-other "#4a4f6a") + +;;; Diffs + + (bg-added "#003a2f") + (bg-added-faint "#002922") + (bg-added-refine "#035542") + (bg-added-fringe "#23884f") + (fg-added "#a0e0a0") + (fg-added-intense "#80e080") + + (bg-changed "#363300") + (bg-changed-faint "#2a1f00") + (bg-changed-refine "#4a4a00") + (bg-changed-fringe "#8f7a30") + (fg-changed "#efef80") + (fg-changed-intense "#c0b05f") + + (bg-removed "#4f1127") + (bg-removed-faint "#380a19") + (bg-removed-refine "#781a3a") + (bg-removed-fringe "#b81a26") + (fg-removed "#ffbfbf") + (fg-removed-intense "#ff9095") + + (bg-diff-context "#1a1f30") + +;;; Uncommon accent backgrounds + + (bg-ochre "#442c2f") + (bg-lavender "#38325c") + (bg-sage "#0f3d30") + +;;; Paren match + + (bg-paren-match "#2f7f9f") + (bg-paren-expression "#453040") + (underline-paren-match unspecified) + +;;; Mappings + +;;;; General mappings + + (fringe bg-dim) + (cursor magenta-warmer) + + (keybind blue-cooler) + (name magenta) + (identifier yellow-faint) + + (err red) + (warning yellow-warmer) + (info cyan-cooler) + + (underline-err red-intense) + (underline-warning yellow) + (underline-note cyan) + +;;;; Code mappings + + (builtin magenta-warmer) + (comment red-faint) + (constant blue-cooler) + (docstring cyan-faint) + (docmarkup magenta-faint) + (fnname magenta) + (keyword magenta-cooler) + (preprocessor red-cooler) + (string blue-warmer) + (type cyan-cooler) + (variable cyan) + (rx-construct green-cooler) + (rx-backslash magenta) + +;;;; Accent mappings + + (accent-0 blue-cooler) + (accent-1 magenta-warmer) + (accent-2 cyan-cooler) + (accent-3 yellow) + +;;;; Button mappings + + (fg-button-active fg-main) + (fg-button-inactive fg-dim) + (bg-button-active bg-active) + (bg-button-inactive bg-dim) + +;;;; Completion mappings + + (fg-completion-match-0 blue-cooler) + (fg-completion-match-1 magenta-warmer) + (fg-completion-match-2 cyan-cooler) + (fg-completion-match-3 yellow) + (bg-completion-match-0 unspecified) + (bg-completion-match-1 unspecified) + (bg-completion-match-2 unspecified) + (bg-completion-match-3 unspecified) + +;;;; Date mappings + + (date-common cyan) + (date-deadline red) + (date-event fg-alt) + (date-holiday magenta) + (date-now fg-main) + (date-scheduled yellow-warmer) + (date-weekday cyan) + (date-weekend red-faint) + +;;;; Line number mappings + + (fg-line-number-inactive fg-dim) + (fg-line-number-active fg-main) + (bg-line-number-inactive bg-dim) + (bg-line-number-active bg-active) + +;;;; Link mappings + + (fg-link blue-warmer) + (bg-link unspecified) + (underline-link blue-warmer) + + (fg-link-symbolic cyan) + (bg-link-symbolic unspecified) + (underline-link-symbolic cyan) + + (fg-link-visited magenta) + (bg-link-visited unspecified) + (underline-link-visited magenta) + +;;;; Mail mappings + + (mail-cite-0 blue-warmer) + (mail-cite-1 yellow-cooler) + (mail-cite-2 cyan-cooler) + (mail-cite-3 red-cooler) + (mail-part blue) + (mail-recipient magenta-cooler) + (mail-subject magenta-warmer) + (mail-other magenta-faint) + +;;;; Prompt mappings + + (fg-prompt cyan-cooler) + (bg-prompt unspecified) + +;;;; Prose mappings + + (prose-block fg-dim) + (prose-code cyan-cooler) + (prose-done green) + (prose-macro magenta-cooler) + (prose-metadata fg-dim) + (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-tag magenta-faint) + (prose-todo red) + (prose-verbatim magenta-warmer) + +;;;; Rainbow mappings + + (rainbow-0 fg-main) + (rainbow-1 magenta-intense) + (rainbow-2 cyan-intense) + (rainbow-3 red-warmer) + (rainbow-4 yellow-intense) + (rainbow-5 magenta-cooler) + (rainbow-6 green-intense) + (rainbow-7 blue-warmer) + (rainbow-8 magenta-warmer) + +;;;; Heading mappings + + (fg-heading-0 cyan-cooler) + (fg-heading-1 fg-main) + (fg-heading-2 yellow-faint) + (fg-heading-3 blue-faint) + (fg-heading-4 magenta) + (fg-heading-5 green-faint) + (fg-heading-6 red-faint) + (fg-heading-7 cyan-faint) + (fg-heading-8 fg-dim) + + (bg-heading-0 unspecified) + (bg-heading-1 unspecified) + (bg-heading-2 unspecified) + (bg-heading-3 unspecified) + (bg-heading-4 unspecified) + (bg-heading-5 unspecified) + (bg-heading-6 unspecified) + (bg-heading-7 unspecified) + (bg-heading-8 unspecified) + + (overline-heading-0 unspecified) + (overline-heading-1 unspecified) + (overline-heading-2 unspecified) + (overline-heading-3 unspecified) + (overline-heading-4 unspecified) + (overline-heading-5 unspecified) + (overline-heading-6 unspecified) + (overline-heading-7 unspecified) + (overline-heading-8 unspecified)) + "The entire palette of the `modus-vivendi-tinted' theme. + +Named colors have the form (COLOR-NAME HEX-VALUE) with the former +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.") + + (defcustom modus-vivendi-tinted-palette-overrides nil + "Overrides for `modus-vivendi-tinted-palette'. + +Mirror the elements of the aforementioned palette, overriding +their value. + +For overrides that are shared across all of the Modus themes, +refer to `modus-themes-common-palette-overrides'. + +Theme-specific overrides take precedence over shared overrides. +The idea of common overrides is to change semantic color +mappings, such as to make the cursor red. Wherea theme-specific +overrides can also be used to change the value of a named color, +such as what hexadecimal RGB value the red-warmer symbol +represents." + :group 'modus-themes + :package-version '(modus-themes . "4.0.0") + :version "30.1" + :type '(repeat (list symbol (choice symbol string))) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Palette overrides")) + + (modus-themes-theme modus-vivendi-tinted + modus-vivendi-tinted-palette + modus-vivendi-tinted-palette-overrides) + + (provide-theme 'modus-vivendi-tinted)) + +;;;###theme-autoload +(put 'modus-vivendi-tinted 'theme-properties '(:background-mode dark :kind color-scheme :family modus)) + +;;; modus-vivendi-tinted-theme.el ends here 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/Makefile.in b/lib-src/Makefile.in index b246d832943..5b82cf1151c 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -193,18 +193,18 @@ LIBRESOLV=@LIBRESOLV@ ## -llockfile if HAVE_LIBLOCKFILE or -lmail if HAVE_LIBMAIL LIBS_MAIL=@LIBS_MAIL@ ## empty or -lrt or -lposix4 if HAVE_CLOCK_GETTIME -LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ +CLOCK_TIME_LIB = @CLOCK_TIME_LIB@ ## empty or -lbcrypt or -ladvapi32 -LIB_GETRANDOM = @LIB_GETRANDOM@ +GETRANDOM_LIB = @GETRANDOM_LIB@ ## Whatever libraries are needed for euidaccess -LIB_EACCESS=@LIB_EACCESS@ +EUIDACCESS_LIBGEN=@EUIDACCESS_LIBGEN@ ## Libraries needed for file_has_acl -LIB_HAS_ACL=@LIB_HAS_ACL@ +FILE_HAS_ACL_LIB=@FILE_HAS_ACL_LIB@ ## empty or -lwsock2 for MinGW LIB_WSOCK32=@LIB_WSOCK32@ ## Extra libraries for etags -LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM) +LIBS_ETAGS = $(CLOCK_TIME_LIB) $(GETRANDOM_LIB) HAVE_SECCOMP=@HAVE_SECCOMP@ HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@ @@ -426,12 +426,14 @@ pop.o: ${srcdir}/pop.c ${srcdir}/pop.h ${srcdir}/../lib/min-max.h $(config_h) emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(config_h) $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $< \ $(NTLIB) $(LOADLIBES) \ - $(LIB_WSOCK32) $(LIB_EACCESS) $(LIB_HAS_ACL) $(LIBS_ECLIENT) -o $@ + $(LIB_WSOCK32) $(EUIDACCESS_LIBGEN) \ + $(FILE_HAS_ACL_LIB) $(LIBS_ECLIENT) \ + -o $@ emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES) $(config_h) $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows $< \ $(LOADLIBES) \ - $(LIB_WSOCK32) $(LIB_EACCESS) $(LIBS_ECLIENT) -o $@ + $(LIB_WSOCK32) $(EUIDACCESS_LIBGEN) $(LIBS_ECLIENT) -o $@ be-resources: ${srcdir}/be_resources.cc ${config_h} $(AM_V_CXXLD)$(CXX) ${ALL_CXXFLAGS} ${HAIKU_LIBS} $< -o $@ 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 9fb9e312a66..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 @@ -7772,7 +7774,7 @@ escape_shell_arg_string (char *str) #endif static void -do_move_file(const char *src_file, const char *dst_file) +do_move_file (const char *src_file, const char *dst_file) { if (rename (src_file, dst_file) == 0) return; diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h index fa15b1b25e8..6ecea98b54a 100644 --- a/lib/_Noreturn.h +++ b/lib/_Noreturn.h @@ -26,6 +26,11 @@ AIX system header files and several gnulib header files use precisely this syntax with 'extern'. */ # define _Noreturn [[noreturn]] +# elif (defined __clang__ && __clang_major__ < 16 \ + && defined _GL_WORK_AROUND_LLVM_BUG_59792) + /* Compile with -D_GL_WORK_AROUND_LLVM_BUG_59792 to work around + that rare LLVM bug, though you may get many false-alarm warnings. */ +# define _Noreturn # elif ((!defined __cplusplus || defined __clang__) \ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ || (!defined __STRICT_ANSI__ \ diff --git a/lib/alloca.in.h b/lib/alloca.in.h index b9ce9ef5603..a1bb3d758dc 100644 --- a/lib/alloca.in.h +++ b/lib/alloca.in.h @@ -1,7 +1,7 @@ /* Memory allocation on the stack. - Copyright (C) 1995, 1999, 2001-2004, 2006-2023 Free Software - Foundation, Inc. + Copyright (C) 1995, 1999, 2001-2004, 2006-2023 Free Software Foundation, + Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/attribute.h b/lib/attribute.h index 36b2978bb2c..130644d8798 100644 --- a/lib/attribute.h +++ b/lib/attribute.h @@ -32,7 +32,7 @@ /* This file defines two types of attributes: - * C2x standard attributes. These have macro names that do not begin with + * C23 standard attributes. These have macro names that do not begin with 'ATTRIBUTE_'. * Selected GCC attributes; see: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html diff --git a/lib/binary-io.h b/lib/binary-io.h index dd9829aa88d..6f4db253354 100644 --- a/lib/binary-io.h +++ b/lib/binary-io.h @@ -1,6 +1,5 @@ /* Binary mode I/O. - Copyright (C) 2001, 2003, 2005, 2008-2023 Free Software Foundation, - Inc. + Copyright (C) 2001, 2003, 2005, 2008-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/c-ctype.h b/lib/c-ctype.h index 9d093f7f722..35ca83d7d43 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h @@ -5,8 +5,7 @@ <ctype.h> functions' behaviour depends on the current locale set via setlocale. - Copyright (C) 2000-2003, 2006, 2008-2023 Free Software Foundation, - Inc. + Copyright (C) 2000-2003, 2006, 2008-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c index c90c6d6a09c..8a958dc4fd9 100644 --- a/lib/c-strcasecmp.c +++ b/lib/c-strcasecmp.c @@ -1,6 +1,5 @@ /* c-strcasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c index bc30ce0ffc4..4ca8c5f4001 100644 --- a/lib/c-strncasecmp.c +++ b/lib/c-strncasecmp.c @@ -1,6 +1,5 @@ /* c-strncasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c index 1d7db893731..359d497396c 100644 --- a/lib/careadlinkat.c +++ b/lib/careadlinkat.c @@ -1,7 +1,7 @@ /* Read symbolic links into a buffer without size limitation, relative to fd. - Copyright (C) 2001, 2003-2004, 2007, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 2001, 2003-2004, 2007, 2009-2023 Free Software Foundation, + Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/cdefs.h b/lib/cdefs.h index 09a3d19b23b..412f036ce35 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -140,32 +140,37 @@ #endif +/* Gnulib avoids these definitions, as they don't work on non-glibc platforms. + In particular, __bos and __bos0 are defined differently in the Android libc. + */ +#ifndef __GNULIB_CDEFS + /* Fortify support. */ -#define __bos(ptr) __builtin_object_size (ptr, __USE_FORTIFY_LEVEL > 1) -#define __bos0(ptr) __builtin_object_size (ptr, 0) +# define __bos(ptr) __builtin_object_size (ptr, __USE_FORTIFY_LEVEL > 1) +# define __bos0(ptr) __builtin_object_size (ptr, 0) /* Use __builtin_dynamic_object_size at _FORTIFY_SOURCE=3 when available. */ -#if __USE_FORTIFY_LEVEL == 3 && (__glibc_clang_prereq (9, 0) \ - || __GNUC_PREREQ (12, 0)) -# define __glibc_objsize0(__o) __builtin_dynamic_object_size (__o, 0) -# define __glibc_objsize(__o) __builtin_dynamic_object_size (__o, 1) -#else -# define __glibc_objsize0(__o) __bos0 (__o) -# define __glibc_objsize(__o) __bos (__o) -#endif +# if __USE_FORTIFY_LEVEL == 3 && (__glibc_clang_prereq (9, 0) \ + || __GNUC_PREREQ (12, 0)) +# define __glibc_objsize0(__o) __builtin_dynamic_object_size (__o, 0) +# define __glibc_objsize(__o) __builtin_dynamic_object_size (__o, 1) +# else +# define __glibc_objsize0(__o) __bos0 (__o) +# define __glibc_objsize(__o) __bos (__o) +# endif /* Compile time conditions to choose between the regular, _chk and _chk_warn variants. These conditions should get evaluated to constant and optimized away. */ -#define __glibc_safe_len_cond(__l, __s, __osz) ((__l) <= (__osz) / (__s)) -#define __glibc_unsigned_or_positive(__l) \ +# define __glibc_safe_len_cond(__l, __s, __osz) ((__l) <= (__osz) / (__s)) +# define __glibc_unsigned_or_positive(__l) \ ((__typeof (__l)) 0 < (__typeof (__l)) -1 \ || (__builtin_constant_p (__l) && (__l) > 0)) /* Length is known to be safe at compile time if the __L * __S <= __OBJSZ condition can be folded to a constant and if it is true, or unknown (-1) */ -#define __glibc_safe_or_unknown_len(__l, __s, __osz) \ +# define __glibc_safe_or_unknown_len(__l, __s, __osz) \ ((__osz) == (__SIZE_TYPE__) -1 \ || (__glibc_unsigned_or_positive (__l) \ && __builtin_constant_p (__glibc_safe_len_cond ((__SIZE_TYPE__) (__l), \ @@ -175,7 +180,7 @@ /* Conversely, we know at compile time that the length is unsafe if the __L * __S <= __OBJSZ condition can be folded to a constant and if it is false. */ -#define __glibc_unsafe_len(__l, __s, __osz) \ +# define __glibc_unsafe_len(__l, __s, __osz) \ (__glibc_unsigned_or_positive (__l) \ && __builtin_constant_p (__glibc_safe_len_cond ((__SIZE_TYPE__) (__l), \ __s, __osz)) \ @@ -184,7 +189,7 @@ /* Fortify function f. __f_alias, __f_chk and __f_chk_warn must be declared. */ -#define __glibc_fortify(f, __l, __s, __osz, ...) \ +# define __glibc_fortify(f, __l, __s, __osz, ...) \ (__glibc_safe_or_unknown_len (__l, __s, __osz) \ ? __ ## f ## _alias (__VA_ARGS__) \ : (__glibc_unsafe_len (__l, __s, __osz) \ @@ -194,13 +199,16 @@ /* Fortify function f, where object size argument passed to f is the number of elements and not total size. */ -#define __glibc_fortify_n(f, __l, __s, __osz, ...) \ +# define __glibc_fortify_n(f, __l, __s, __osz, ...) \ (__glibc_safe_or_unknown_len (__l, __s, __osz) \ ? __ ## f ## _alias (__VA_ARGS__) \ : (__glibc_unsafe_len (__l, __s, __osz) \ ? __ ## f ## _chk_warn (__VA_ARGS__, (__osz) / (__s)) \ : __ ## f ## _chk (__VA_ARGS__, (__osz) / (__s)))) \ +#endif + + #if __GNUC_PREREQ (4,3) # define __warnattr(msg) __attribute__((__warning__ (msg))) # define __errordecl(name, msg) \ diff --git a/lib/cloexec.c b/lib/cloexec.c index ba53d0020b1..e4cecbd2e8a 100644 --- a/lib/cloexec.c +++ b/lib/cloexec.c @@ -1,7 +1,6 @@ /* cloexec.c - set or clear the close-on-exec descriptor flag - Copyright (C) 1991, 2004-2006, 2009-2023 Free Software Foundation, - Inc. + Copyright (C) 1991, 2004-2006, 2009-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/close-stream.c b/lib/close-stream.c index b68b30e6ff0..ab686bac2ae 100644 --- a/lib/close-stream.c +++ b/lib/close-stream.c @@ -1,7 +1,6 @@ /* Close a stream, with nicer error checking than fclose's. - Copyright (C) 1998-2002, 2004, 2006-2023 Free Software Foundation, - Inc. + Copyright (C) 1998-2002, 2004, 2006-2023 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/diffseq.h b/lib/diffseq.h index ad3f258ab6b..dfaf4f295e8 100644 --- a/lib/diffseq.h +++ b/lib/diffseq.h @@ -1,7 +1,7 @@ /* Analyze differences between two vectors. - Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2023 Free - Software Foundation, Inc. + Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2023 Free Software + Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/dup2.c b/lib/dup2.c index 1597d9d1e6e..7d197ca3123 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -1,7 +1,6 @@ /* Duplicate an open file descriptor to a specified file descriptor. - Copyright (C) 1999, 2004-2007, 2009-2023 Free Software Foundation, - Inc. + Copyright (C) 1999, 2004-2007, 2009-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c index 8c1d26ec7d4..b31a2ea2523 100644 --- a/lib/file-has-acl.c +++ b/lib/file-has-acl.c @@ -29,9 +29,98 @@ #include "acl-internal.h" -#if GETXATTR_WITH_POSIX_ACLS +#if USE_ACL && GETXATTR_WITH_POSIX_ACLS +# include <string.h> +# include <arpa/inet.h> # include <sys/xattr.h> # include <linux/xattr.h> +# ifndef XATTR_NAME_NFSV4_ACL +# define XATTR_NAME_NFSV4_ACL "system.nfs4_acl" +# endif + +enum { + /* ACE4_ACCESS_ALLOWED_ACE_TYPE = 0x00000000, */ + ACE4_ACCESS_DENIED_ACE_TYPE = 0x00000001, + ACE4_IDENTIFIER_GROUP = 0x00000040 +}; + +/* Return 1 if given ACL in XDR format is non-trivial, 0 if it is trivial. + -1 upon failure to determine it. Possibly change errno. Assume that + the ACL is valid, except avoid undefined behavior even if invalid. + + See <https://linux.die.net/man/5/nfs4_acl>. The NFSv4 acls are + defined in Internet RFC 7530 and as such, every NFSv4 server + supporting ACLs should support NFSv4 ACLs (they differ from from + POSIX draft ACLs). The ACLs can be obtained via the + nfsv4-acl-tools, e.g., the nfs4_getfacl command. Gnulib provides + only basic support of NFSv4 ACLs, i.e., recognize trivial vs + nontrivial ACLs. */ + +static int +acl_nfs4_nontrivial (uint32_t *xattr, ssize_t nbytes) +{ + enum { BYTES_PER_NETWORK_UINT = 4}; + + /* Grab the number of aces in the acl. */ + nbytes -= BYTES_PER_NETWORK_UINT; + if (nbytes < 0) + return -1; + uint32_t num_aces = ntohl (*xattr++); + if (6 < num_aces) + return 1; + int ace_found = 0; + + for (int ace_n = 0; ace_n < num_aces; ace_n++) + { + /* Get the acl type and flag. Skip the mask; it's too risky to + test it and it does not seem to be needed. Get the wholen. */ + nbytes -= 4 * BYTES_PER_NETWORK_UINT; + if (nbytes < 0) + return -1; + uint32_t type = ntohl (xattr[0]); + uint32_t flag = ntohl (xattr[1]); + uint32_t wholen = ntohl (xattr[3]); + xattr += 4; + int whowords = (wholen / BYTES_PER_NETWORK_UINT + + (wholen % BYTES_PER_NETWORK_UINT != 0)); + int64_t wholen4 = whowords; + wholen4 *= BYTES_PER_NETWORK_UINT; + + /* Trivial ACLs have only ACE4_ACCESS_ALLOWED_ACE_TYPE or + ACE4_ACCESS_DENIED_ACE_TYPE. */ + if (ACE4_ACCESS_DENIED_ACE_TYPE < type) + return 1; + + /* RFC 7530 says FLAG should be 0, but be generous to NetApp and + also accept the group flag. */ + if (flag & ~ACE4_IDENTIFIER_GROUP) + return 1; + + /* Get the who string. Check NBYTES - WHOLEN4 before storing + into NBYTES, to avoid truncation on conversion. */ + if (nbytes - wholen4 < 0) + return -1; + nbytes -= wholen4; + + /* For a trivial ACL, max 6 (typically 3) ACEs, 3 allow, 3 deny. + Check that there is at most one ACE of each TYPE and WHO. */ + int who2 + = (wholen == 6 && memcmp (xattr, "OWNER@", 6) == 0 ? 0 + : wholen == 6 && memcmp (xattr, "GROUP@", 6) == 0 ? 2 + : wholen == 9 && memcmp (xattr, "EVERYONE@", 9) == 0 ? 4 + : -1); + if (who2 < 0) + return 1; + int ace_found_bit = 1 << (who2 | type); + if (ace_found & ace_found_bit) + return 1; + ace_found |= ace_found_bit; + + xattr += whowords; + } + + return 0; +} #endif /* Return 1 if NAME has a nontrivial access control list, @@ -51,6 +140,7 @@ file_has_acl (char const *name, struct stat const *sb) # if GETXATTR_WITH_POSIX_ACLS ssize_t ret; + int initial_errno = errno; ret = getxattr (name, XATTR_NAME_POSIX_ACL_ACCESS, NULL, 0); if (ret < 0 && errno == ENODATA) @@ -68,6 +158,35 @@ file_has_acl (char const *name, struct stat const *sb) } if (ret < 0) + { + /* Check for NFSv4 ACLs. The max length of a trivial + ACL is 6 words for owner, 6 for group, 7 for everyone, + all times 2 because there are both allow and deny ACEs. + There are 6 words for owner because of type, flag, mask, + wholen, "OWNER@"+pad and similarly for group; everyone is + another word to hold "EVERYONE@". */ + uint32_t xattr[2 * (6 + 6 + 7)]; + + ret = getxattr (name, XATTR_NAME_NFSV4_ACL, xattr, sizeof xattr); + if (ret < 0) + switch (errno) + { + case ENODATA: return 0; + case ERANGE : return 1; /* ACL must be nontrivial. */ + } + else + { + /* It looks like a trivial ACL, but investigate further. */ + ret = acl_nfs4_nontrivial (xattr, ret); + if (ret < 0) + { + errno = EINVAL; + return ret; + } + errno = initial_errno; + } + } + if (ret < 0) return - acl_errno_valid (errno); return ret; diff --git a/lib/filemode.h b/lib/filemode.h index d456cc585b3..15a8dcc3760 100644 --- a/lib/filemode.h +++ b/lib/filemode.h @@ -1,7 +1,7 @@ /* Make a string describing file modes. - Copyright (C) 1998-1999, 2003, 2006, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2003, 2006, 2009-2023 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/fpending.c b/lib/fpending.c index df3cd85f3a6..e57155e586e 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -1,6 +1,6 @@ /* fpending.c -- return the number of pending output bytes on a stream - Copyright (C) 2000, 2004, 2006-2007, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 2000, 2004, 2006-2007, 2009-2023 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -41,7 +41,7 @@ __fpending (FILE *fp) return fp->_IO_write_ptr - fp->_IO_write_base; #elif defined __sferror || defined __DragonFly__ || defined __ANDROID__ /* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin < 1.7.34, Minix 3, Android */ - return fp->_p - fp->_bf._base; + return fp_->_p - fp_->_bf._base; #elif defined __EMX__ /* emx+gcc */ return fp->_ptr - fp->_buffer; #elif defined __minix /* Minix */ diff --git a/lib/fpending.h b/lib/fpending.h index fe310384f7e..5e860db6810 100644 --- a/lib/fpending.h +++ b/lib/fpending.h @@ -1,7 +1,7 @@ /* Declare __fpending. - Copyright (C) 2000, 2003, 2005-2006, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 2000, 2003, 2005-2006, 2009-2023 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/fsusage.c b/lib/fsusage.c index 2be120a06de..f6f4b1c35fd 100644 --- a/lib/fsusage.c +++ b/lib/fsusage.c @@ -1,7 +1,7 @@ /* fsusage.c -- return space usage of mounted file systems - Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2023 Free - Software Foundation, Inc. + Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2023 Free Software + Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/getgroups.c b/lib/getgroups.c index 6a2bda8d71e..93829d3b15e 100644 --- a/lib/getgroups.c +++ b/lib/getgroups.c @@ -1,7 +1,6 @@ /* provide consistent interface to getgroups for systems that don't allow N==0 - Copyright (C) 1996, 1999, 2003, 2006-2023 Free Software Foundation, - Inc. + Copyright (C) 1996, 1999, 2003, 2006-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 37fcea0a76b..59b53e79980 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -1,7 +1,7 @@ /* Get the system load averages. - Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2023 Free - Software Foundation, Inc. + Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2023 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with gnulib. Bugs can be reported to bug-gnulib@gnu.org. 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/gettext.h b/lib/gettext.h index 582886f9f51..d0462c47e17 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -1,6 +1,6 @@ /* Convenience header for conditional use of GNU <libintl.h>. - Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2023 Free - Software Foundation, Inc. + Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2023 Free Software + Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/gettime.c b/lib/gettime.c index cfba830478e..f86cc4efbff 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -1,7 +1,6 @@ /* gettime -- get the system clock - Copyright (C) 2002, 2004-2007, 2009-2023 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004-2007, 2009-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c index 7207c851272..d896ec132b9 100644 --- a/lib/gettimeofday.c +++ b/lib/gettimeofday.c @@ -1,7 +1,6 @@ /* Provide gettimeofday for systems that don't have it or for which it's broken. - Copyright (C) 2001-2003, 2005-2007, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 2001-2003, 2005-2007, 2009-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 9ab4b741595..47d08a5e27f 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -68,6 +68,7 @@ # --avoid=wchar \ # --avoid=wcrtomb \ # --avoid=wctype-h \ +# alignasof \ # alloca-opt \ # binary-io \ # byteswap \ @@ -93,7 +94,6 @@ # dup2 \ # environ \ # execinfo \ -# explicit_bzero \ # faccessat \ # fchmodat \ # fcntl \ @@ -126,6 +126,7 @@ # memmem-simple \ # mempcpy \ # memrchr \ +# memset_explicit \ # minmax \ # mkostemp \ # mktime \ @@ -145,7 +146,6 @@ # socklen \ # stat-time \ # std-gnu11 \ -# stdalign \ # stdbool \ # stddef \ # stdio \ @@ -156,7 +156,7 @@ # sys_stat \ # sys_time \ # tempname \ -# time \ +# time-h \ # time_r \ # time_rz \ # timegm \ @@ -204,6 +204,7 @@ CFLAGS_SOUND = @CFLAGS_SOUND@ CHECK_STRUCTS = @CHECK_STRUCTS@ CLIENTRES = @CLIENTRES@ CLIENTW = @CLIENTW@ +CLOCK_TIME_LIB = @CLOCK_TIME_LIB@ CM_OBJ = @CM_OBJ@ COM_ERRLIB = @COM_ERRLIB@ CPP = @CPP@ @@ -238,8 +239,10 @@ ENOLINK_VALUE = @ENOLINK_VALUE@ EOVERFLOW_HIDDEN = @EOVERFLOW_HIDDEN@ EOVERFLOW_VALUE = @EOVERFLOW_VALUE@ ERRNO_H = @ERRNO_H@ +EUIDACCESS_LIBGEN = @EUIDACCESS_LIBGEN@ EXECINFO_H = @EXECINFO_H@ EXEEXT = @EXEEXT@ +FILE_HAS_ACL_LIB = @FILE_HAS_ACL_LIB@ FIND_DELETE = @FIND_DELETE@ FIRSTFILE_OBJ = @FIRSTFILE_OBJ@ FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@ @@ -253,6 +256,7 @@ GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@ GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ GETOPT_CDEFS_H = @GETOPT_CDEFS_H@ GETOPT_H = @GETOPT_H@ +GETRANDOM_LIB = @GETRANDOM_LIB@ GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@ GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@ GL_CFLAG_ALLOW_WARNINGS = @GL_CFLAG_ALLOW_WARNINGS@ @@ -264,7 +268,6 @@ GL_COND_OBJ_DIRFD_CONDITION = @GL_COND_OBJ_DIRFD_CONDITION@ GL_COND_OBJ_DUP2_CONDITION = @GL_COND_OBJ_DUP2_CONDITION@ GL_COND_OBJ_EUIDACCESS_CONDITION = @GL_COND_OBJ_EUIDACCESS_CONDITION@ GL_COND_OBJ_EXECINFO_CONDITION = @GL_COND_OBJ_EXECINFO_CONDITION@ -GL_COND_OBJ_EXPLICIT_BZERO_CONDITION = @GL_COND_OBJ_EXPLICIT_BZERO_CONDITION@ GL_COND_OBJ_FACCESSAT_CONDITION = @GL_COND_OBJ_FACCESSAT_CONDITION@ GL_COND_OBJ_FCHMODAT_CONDITION = @GL_COND_OBJ_FCHMODAT_CONDITION@ GL_COND_OBJ_FCNTL_CONDITION = @GL_COND_OBJ_FCNTL_CONDITION@ @@ -286,6 +289,7 @@ GL_COND_OBJ_LCHMOD_CONDITION = @GL_COND_OBJ_LCHMOD_CONDITION@ GL_COND_OBJ_LSTAT_CONDITION = @GL_COND_OBJ_LSTAT_CONDITION@ GL_COND_OBJ_MEMPCPY_CONDITION = @GL_COND_OBJ_MEMPCPY_CONDITION@ GL_COND_OBJ_MEMRCHR_CONDITION = @GL_COND_OBJ_MEMRCHR_CONDITION@ +GL_COND_OBJ_MEMSET_EXPLICIT_CONDITION = @GL_COND_OBJ_MEMSET_EXPLICIT_CONDITION@ GL_COND_OBJ_MINI_GMP_GNULIB_CONDITION = @GL_COND_OBJ_MINI_GMP_GNULIB_CONDITION@ GL_COND_OBJ_MKOSTEMP_CONDITION = @GL_COND_OBJ_MKOSTEMP_CONDITION@ GL_COND_OBJ_NANOSLEEP_CONDITION = @GL_COND_OBJ_NANOSLEEP_CONDITION@ @@ -321,7 +325,6 @@ GL_GENERATE_GMP_H_CONDITION = @GL_GENERATE_GMP_H_CONDITION@ GL_GENERATE_IEEE754_H_CONDITION = @GL_GENERATE_IEEE754_H_CONDITION@ GL_GENERATE_LIMITS_H_CONDITION = @GL_GENERATE_LIMITS_H_CONDITION@ GL_GENERATE_MINI_GMP_H_CONDITION = @GL_GENERATE_MINI_GMP_H_CONDITION@ -GL_GENERATE_STDALIGN_H_CONDITION = @GL_GENERATE_STDALIGN_H_CONDITION@ GL_GENERATE_STDCKDINT_H_CONDITION = @GL_GENERATE_STDCKDINT_H_CONDITION@ GL_GENERATE_STDDEF_H_CONDITION = @GL_GENERATE_STDDEF_H_CONDITION@ GL_GENERATE_STDINT_H_CONDITION = @GL_GENERATE_STDINT_H_CONDITION@ @@ -407,6 +410,7 @@ GL_GNULIB_GETOPT_POSIX = @GL_GNULIB_GETOPT_POSIX@ GL_GNULIB_GETPAGESIZE = @GL_GNULIB_GETPAGESIZE@ GL_GNULIB_GETPASS = @GL_GNULIB_GETPASS@ GL_GNULIB_GETPASS_GNU = @GL_GNULIB_GETPASS_GNU@ +GL_GNULIB_GETPROGNAME = @GL_GNULIB_GETPROGNAME@ GL_GNULIB_GETRANDOM = @GL_GNULIB_GETRANDOM@ GL_GNULIB_GETSUBOPT = @GL_GNULIB_GETSUBOPT@ GL_GNULIB_GETTIMEOFDAY = @GL_GNULIB_GETTIMEOFDAY@ @@ -485,6 +489,7 @@ GL_GNULIB_MEMCHR = @GL_GNULIB_MEMCHR@ GL_GNULIB_MEMMEM = @GL_GNULIB_MEMMEM@ GL_GNULIB_MEMPCPY = @GL_GNULIB_MEMPCPY@ GL_GNULIB_MEMRCHR = @GL_GNULIB_MEMRCHR@ +GL_GNULIB_MEMSET_EXPLICIT = @GL_GNULIB_MEMSET_EXPLICIT@ GL_GNULIB_MKDIR = @GL_GNULIB_MKDIR@ GL_GNULIB_MKDIRAT = @GL_GNULIB_MKDIRAT@ GL_GNULIB_MKDTEMP = @GL_GNULIB_MKDTEMP@ @@ -590,6 +595,7 @@ GL_GNULIB_STRVERSCMP = @GL_GNULIB_STRVERSCMP@ GL_GNULIB_SYMLINK = @GL_GNULIB_SYMLINK@ GL_GNULIB_SYMLINKAT = @GL_GNULIB_SYMLINKAT@ GL_GNULIB_SYSTEM_POSIX = @GL_GNULIB_SYSTEM_POSIX@ +GL_GNULIB_TIME = @GL_GNULIB_TIME@ GL_GNULIB_TIMEGM = @GL_GNULIB_TIMEGM@ GL_GNULIB_TIMESPEC_GET = @GL_GNULIB_TIMESPEC_GET@ GL_GNULIB_TIMESPEC_GETRES = @GL_GNULIB_TIMESPEC_GETRES@ @@ -674,6 +680,7 @@ HAVE_DECL_GETLOGIN = @HAVE_DECL_GETLOGIN@ HAVE_DECL_GETLOGIN_R = @HAVE_DECL_GETLOGIN_R@ HAVE_DECL_GETPAGESIZE = @HAVE_DECL_GETPAGESIZE@ HAVE_DECL_GETUSERSHELL = @HAVE_DECL_GETUSERSHELL@ +HAVE_DECL_GETW = @HAVE_DECL_GETW@ HAVE_DECL_IMAXABS = @HAVE_DECL_IMAXABS@ HAVE_DECL_IMAXDIV = @HAVE_DECL_IMAXDIV@ HAVE_DECL_INITSTATE = @HAVE_DECL_INITSTATE@ @@ -682,6 +689,7 @@ HAVE_DECL_MEMMEM = @HAVE_DECL_MEMMEM@ HAVE_DECL_MEMRCHR = @HAVE_DECL_MEMRCHR@ HAVE_DECL_OBSTACK_PRINTF = @HAVE_DECL_OBSTACK_PRINTF@ HAVE_DECL_POSIX_SPAWN_SETSID = @HAVE_DECL_POSIX_SPAWN_SETSID@ +HAVE_DECL_PUTW = @HAVE_DECL_PUTW@ HAVE_DECL_SETENV = @HAVE_DECL_SETENV@ HAVE_DECL_SETHOSTNAME = @HAVE_DECL_SETHOSTNAME@ HAVE_DECL_SETSTATE = @HAVE_DECL_SETSTATE@ @@ -727,6 +735,7 @@ HAVE_GETLOGIN = @HAVE_GETLOGIN@ HAVE_GETOPT_H = @HAVE_GETOPT_H@ HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@ HAVE_GETPASS = @HAVE_GETPASS@ +HAVE_GETPROGNAME = @HAVE_GETPROGNAME@ HAVE_GETRANDOM = @HAVE_GETRANDOM@ HAVE_GETSUBOPT = @HAVE_GETSUBOPT@ HAVE_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@ @@ -734,6 +743,8 @@ HAVE_GETUMASK = @HAVE_GETUMASK@ HAVE_GRANTPT = @HAVE_GRANTPT@ HAVE_GROUP_MEMBER = @HAVE_GROUP_MEMBER@ HAVE_GSETTINGS = @HAVE_GSETTINGS@ +HAVE_IMAXABS = @HAVE_IMAXABS@ +HAVE_IMAXDIV = @HAVE_IMAXDIV@ HAVE_IMAXDIV_T = @HAVE_IMAXDIV_T@ HAVE_INITSTATE = @HAVE_INITSTATE@ HAVE_INTTYPES_H = @HAVE_INTTYPES_H@ @@ -749,6 +760,7 @@ HAVE_MAX_ALIGN_T = @HAVE_MAX_ALIGN_T@ HAVE_MBSLEN = @HAVE_MBSLEN@ HAVE_MBTOWC = @HAVE_MBTOWC@ HAVE_MEMPCPY = @HAVE_MEMPCPY@ +HAVE_MEMSET_EXPLICIT = @HAVE_MEMSET_EXPLICIT@ HAVE_MKDIRAT = @HAVE_MKDIRAT@ HAVE_MKDTEMP = @HAVE_MKDTEMP@ HAVE_MKFIFO = @HAVE_MKFIFO@ @@ -935,13 +947,13 @@ LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ LIB_EACCESS = @LIB_EACCESS@ LIB_EXECINFO = @LIB_EXECINFO@ LIB_GETRANDOM = @LIB_GETRANDOM@ -LIB_HAS_ACL = @LIB_HAS_ACL@ LIB_MATH = @LIB_MATH@ LIB_NANOSLEEP = @LIB_NANOSLEEP@ LIB_PTHREAD = @LIB_PTHREAD@ LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@ LIB_TIMER_TIME = @LIB_TIMER_TIME@ LIB_WSOCK32 = @LIB_WSOCK32@ +LIB_XATTR = @LIB_XATTR@ LIMITS_H = @LIMITS_H@ LN_S_FILEONLY = @LN_S_FILEONLY@ LTLIBGMP = @LTLIBGMP@ @@ -955,6 +967,7 @@ MKDIR_P = @MKDIR_P@ MODULES_OBJ = @MODULES_OBJ@ MODULES_SECONDARY_SUFFIX = @MODULES_SECONDARY_SUFFIX@ MODULES_SUFFIX = @MODULES_SUFFIX@ +NANOSLEEP_LIB = @NANOSLEEP_LIB@ NATIVE_COMPILATION_AOT = @NATIVE_COMPILATION_AOT@ NEXT_ASSERT_H = @NEXT_ASSERT_H@ NEXT_AS_FIRST_DIRECTIVE_ASSERT_H = @NEXT_AS_FIRST_DIRECTIVE_ASSERT_H@ @@ -1031,7 +1044,9 @@ PRE_ALLOC_OBJ = @PRE_ALLOC_OBJ@ PRIPTR_PREFIX = @PRIPTR_PREFIX@ PROFILING_CFLAGS = @PROFILING_CFLAGS@ PTHREAD_H_DEFINES_STRUCT_TIMESPEC = @PTHREAD_H_DEFINES_STRUCT_TIMESPEC@ +PTHREAD_SIGMASK_LIB = @PTHREAD_SIGMASK_LIB@ PTRDIFF_T_SUFFIX = @PTRDIFF_T_SUFFIX@ +QCOPY_ACL_LIB = @QCOPY_ACL_LIB@ RALLOC_OBJ = @RALLOC_OBJ@ RANLIB = @RANLIB@ REPLACE_ACCESS = @REPLACE_ACCESS@ @@ -1050,6 +1065,7 @@ REPLACE_DIRFD = @REPLACE_DIRFD@ REPLACE_DPRINTF = @REPLACE_DPRINTF@ REPLACE_DUP = @REPLACE_DUP@ REPLACE_DUP2 = @REPLACE_DUP2@ +REPLACE_DUP3 = @REPLACE_DUP3@ REPLACE_EXECL = @REPLACE_EXECL@ REPLACE_EXECLE = @REPLACE_EXECLE@ REPLACE_EXECLP = @REPLACE_EXECLP@ @@ -1062,6 +1078,7 @@ REPLACE_FCHMODAT = @REPLACE_FCHMODAT@ REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@ REPLACE_FCLOSE = @REPLACE_FCLOSE@ REPLACE_FCNTL = @REPLACE_FCNTL@ +REPLACE_FDATASYNC = @REPLACE_FDATASYNC@ REPLACE_FDOPEN = @REPLACE_FDOPEN@ REPLACE_FDOPENDIR = @REPLACE_FDOPENDIR@ REPLACE_FFLUSH = @REPLACE_FFLUSH@ @@ -1084,15 +1101,21 @@ REPLACE_GETCWD = @REPLACE_GETCWD@ REPLACE_GETDELIM = @REPLACE_GETDELIM@ REPLACE_GETDOMAINNAME = @REPLACE_GETDOMAINNAME@ REPLACE_GETDTABLESIZE = @REPLACE_GETDTABLESIZE@ +REPLACE_GETENTROPY = @REPLACE_GETENTROPY@ REPLACE_GETGROUPS = @REPLACE_GETGROUPS@ REPLACE_GETLINE = @REPLACE_GETLINE@ +REPLACE_GETLOADAVG = @REPLACE_GETLOADAVG@ REPLACE_GETLOGIN_R = @REPLACE_GETLOGIN_R@ REPLACE_GETPAGESIZE = @REPLACE_GETPAGESIZE@ REPLACE_GETPASS = @REPLACE_GETPASS@ REPLACE_GETPASS_FOR_GETPASS_GNU = @REPLACE_GETPASS_FOR_GETPASS_GNU@ +REPLACE_GETPROGNAME = @REPLACE_GETPROGNAME@ REPLACE_GETRANDOM = @REPLACE_GETRANDOM@ +REPLACE_GETSUBOPT = @REPLACE_GETSUBOPT@ REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@ REPLACE_GMTIME = @REPLACE_GMTIME@ +REPLACE_IMAXABS = @REPLACE_IMAXABS@ +REPLACE_IMAXDIV = @REPLACE_IMAXDIV@ REPLACE_INITSTATE = @REPLACE_INITSTATE@ REPLACE_ISATTY = @REPLACE_ISATTY@ REPLACE_LCHOWN = @REPLACE_LCHOWN@ @@ -1107,11 +1130,14 @@ REPLACE_MALLOC_FOR_MALLOC_POSIX = @REPLACE_MALLOC_FOR_MALLOC_POSIX@ REPLACE_MBTOWC = @REPLACE_MBTOWC@ REPLACE_MEMCHR = @REPLACE_MEMCHR@ REPLACE_MEMMEM = @REPLACE_MEMMEM@ +REPLACE_MEMPCPY = @REPLACE_MEMPCPY@ REPLACE_MKDIR = @REPLACE_MKDIR@ REPLACE_MKFIFO = @REPLACE_MKFIFO@ REPLACE_MKFIFOAT = @REPLACE_MKFIFOAT@ REPLACE_MKNOD = @REPLACE_MKNOD@ REPLACE_MKNODAT = @REPLACE_MKNODAT@ +REPLACE_MKOSTEMP = @REPLACE_MKOSTEMP@ +REPLACE_MKOSTEMPS = @REPLACE_MKOSTEMPS@ REPLACE_MKSTEMP = @REPLACE_MKSTEMP@ REPLACE_MKTIME = @REPLACE_MKTIME@ REPLACE_NANOSLEEP = @REPLACE_NANOSLEEP@ @@ -1121,8 +1147,10 @@ REPLACE_OPEN = @REPLACE_OPEN@ REPLACE_OPENAT = @REPLACE_OPENAT@ REPLACE_OPENDIR = @REPLACE_OPENDIR@ REPLACE_PERROR = @REPLACE_PERROR@ +REPLACE_PIPE2 = @REPLACE_PIPE2@ REPLACE_POPEN = @REPLACE_POPEN@ REPLACE_POSIX_MEMALIGN = @REPLACE_POSIX_MEMALIGN@ +REPLACE_POSIX_OPENPT = @REPLACE_POSIX_OPENPT@ REPLACE_PREAD = @REPLACE_PREAD@ REPLACE_PRINTF = @REPLACE_PRINTF@ REPLACE_PSELECT = @REPLACE_PSELECT@ @@ -1148,6 +1176,7 @@ REPLACE_RENAMEAT = @REPLACE_RENAMEAT@ REPLACE_RMDIR = @REPLACE_RMDIR@ REPLACE_SELECT = @REPLACE_SELECT@ REPLACE_SETENV = @REPLACE_SETENV@ +REPLACE_SETHOSTNAME = @REPLACE_SETHOSTNAME@ REPLACE_SETSTATE = @REPLACE_SETSTATE@ REPLACE_SLEEP = @REPLACE_SLEEP@ REPLACE_SNPRINTF = @REPLACE_SNPRINTF@ @@ -1155,6 +1184,7 @@ REPLACE_SPRINTF = @REPLACE_SPRINTF@ REPLACE_STAT = @REPLACE_STAT@ REPLACE_STDIO_READ_FUNCS = @REPLACE_STDIO_READ_FUNCS@ REPLACE_STDIO_WRITE_FUNCS = @REPLACE_STDIO_WRITE_FUNCS@ +REPLACE_STPCPY = @REPLACE_STPCPY@ REPLACE_STPNCPY = @REPLACE_STPNCPY@ REPLACE_STRCASESTR = @REPLACE_STRCASESTR@ REPLACE_STRCHRNUL = @REPLACE_STRCHRNUL@ @@ -1180,7 +1210,9 @@ REPLACE_STRTOUMAX = @REPLACE_STRTOUMAX@ REPLACE_STRUCT_TIMEVAL = @REPLACE_STRUCT_TIMEVAL@ REPLACE_SYMLINK = @REPLACE_SYMLINK@ REPLACE_SYMLINKAT = @REPLACE_SYMLINKAT@ +REPLACE_TIME = @REPLACE_TIME@ REPLACE_TIMEGM = @REPLACE_TIMEGM@ +REPLACE_TIMESPEC_GET = @REPLACE_TIMESPEC_GET@ REPLACE_TMPFILE = @REPLACE_TMPFILE@ REPLACE_TRUNCATE = @REPLACE_TRUNCATE@ REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@ @@ -1198,6 +1230,7 @@ REPLACE_VSNPRINTF = @REPLACE_VSNPRINTF@ REPLACE_VSPRINTF = @REPLACE_VSPRINTF@ REPLACE_WCTOMB = @REPLACE_WCTOMB@ REPLACE_WRITE = @REPLACE_WRITE@ +REPLACE__EXIT = @REPLACE__EXIT@ RSVG_CFLAGS = @RSVG_CFLAGS@ RSVG_LIBS = @RSVG_LIBS@ SEPCHAR = @SEPCHAR@ @@ -1210,7 +1243,6 @@ SIZEOF_LONG = @SIZEOF_LONG@ SIZE_T_SUFFIX = @SIZE_T_SUFFIX@ SMALL_JA_DIC = @SMALL_JA_DIC@ SQLITE3_LIBS = @SQLITE3_LIBS@ -STDALIGN_H = @STDALIGN_H@ STDCKDINT_H = @STDCKDINT_H@ STDDEF_H = @STDDEF_H@ STDINT_H = @STDINT_H@ @@ -1218,6 +1250,7 @@ SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@ SYSTEM_TYPE = @SYSTEM_TYPE@ SYS_TIME_H_DEFINES_STRUCT_TIMESPEC = @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@ TERMCAP_OBJ = @TERMCAP_OBJ@ +TIMER_TIME_LIB = @TIMER_TIME_LIB@ TIME_H_DEFINES_STRUCT_TIMESPEC = @TIME_H_DEFINES_STRUCT_TIMESPEC@ TIME_H_DEFINES_TIME_UTC = @TIME_H_DEFINES_TIME_UTC@ TOOLKIT_LIBW = @TOOLKIT_LIBW@ @@ -1857,16 +1890,6 @@ EXTRA_DIST += execinfo.in.h endif ## end gnulib module execinfo -## begin gnulib module explicit_bzero -ifeq (,$(OMIT_GNULIB_MODULE_explicit_bzero)) - -ifneq (,$(GL_COND_OBJ_EXPLICIT_BZERO_CONDITION)) -libgnu_a_SOURCES += explicit_bzero.c -endif - -endif -## end gnulib module explicit_bzero - ## begin gnulib module faccessat ifeq (,$(OMIT_GNULIB_MODULE_faccessat)) @@ -2367,6 +2390,8 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_U -e 's/@''HAVE_DECL_STRTOIMAX''@/$(HAVE_DECL_STRTOIMAX)/g' \ -e 's/@''HAVE_DECL_STRTOUMAX''@/$(HAVE_DECL_STRTOUMAX)/g' \ -e 's/@''HAVE_IMAXDIV_T''@/$(HAVE_IMAXDIV_T)/g' \ + -e 's/@''REPLACE_IMAXABS''@/$(REPLACE_IMAXABS)/g' \ + -e 's/@''REPLACE_IMAXDIV''@/$(REPLACE_IMAXDIV)/g' \ -e 's/@''REPLACE_STRTOIMAX''@/$(REPLACE_STRTOIMAX)/g' \ -e 's/@''REPLACE_STRTOUMAX''@/$(REPLACE_STRTOUMAX)/g' \ -e 's/@''INT32_MAX_LT_INTMAX_MAX''@/$(INT32_MAX_LT_INTMAX_MAX)/g' \ @@ -2536,6 +2561,16 @@ endif endif ## end gnulib module memrchr +## begin gnulib module memset_explicit +ifeq (,$(OMIT_GNULIB_MODULE_memset_explicit)) + +ifneq (,$(GL_COND_OBJ_MEMSET_EXPLICIT_CONDITION)) +libgnu_a_SOURCES += memset_explicit.c +endif + +endif +## end gnulib module memset_explicit + ## begin gnulib module minmax ifeq (,$(OMIT_GNULIB_MODULE_minmax)) @@ -2895,28 +2930,6 @@ EXTRA_DIST += stat-time.h endif ## end gnulib module stat-time -## begin gnulib module stdalign -ifeq (,$(OMIT_GNULIB_MODULE_stdalign)) - -BUILT_SOURCES += $(STDALIGN_H) - -# We need the following in order to create <stdalign.h> when the system -# doesn't have one that works. -ifneq (,$(GL_GENERATE_STDALIGN_H_CONDITION)) -stdalign.h: stdalign.in.h $(top_builddir)/config.status - $(gl_V_at)$(SED_HEADER_TO_AT_t) $(srcdir)/stdalign.in.h - $(AM_V_at)mv $@-t $@ -else -stdalign.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += stdalign.h stdalign.h-t - -EXTRA_DIST += stdalign.in.h - -endif -## end gnulib module stdalign - ## begin gnulib module stdckdint ifeq (,$(OMIT_GNULIB_MODULE_stdckdint)) @@ -3102,7 +3115,9 @@ stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) -e 's|@''HAVE_DECL_FTELLO''@|$(HAVE_DECL_FTELLO)|g' \ -e 's|@''HAVE_DECL_GETDELIM''@|$(HAVE_DECL_GETDELIM)|g' \ -e 's|@''HAVE_DECL_GETLINE''@|$(HAVE_DECL_GETLINE)|g' \ + -e 's|@''HAVE_DECL_GETW''@|$(HAVE_DECL_GETW)|g' \ -e 's|@''HAVE_DECL_OBSTACK_PRINTF''@|$(HAVE_DECL_OBSTACK_PRINTF)|g' \ + -e 's|@''HAVE_DECL_PUTW''@|$(HAVE_DECL_PUTW)|g' \ -e 's|@''HAVE_DECL_SNPRINTF''@|$(HAVE_DECL_SNPRINTF)|g' \ -e 's|@''HAVE_DECL_VSNPRINTF''@|$(HAVE_DECL_VSNPRINTF)|g' \ -e 's|@''HAVE_DPRINTF''@|$(HAVE_DPRINTF)|g' \ @@ -3189,6 +3204,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's/@''GNULIB_CANONICALIZE_FILE_NAME''@/$(GL_GNULIB_CANONICALIZE_FILE_NAME)/g' \ -e 's/@''GNULIB_FREE_POSIX''@/$(GL_GNULIB_FREE_POSIX)/g' \ -e 's/@''GNULIB_GETLOADAVG''@/$(GL_GNULIB_GETLOADAVG)/g' \ + -e 's/@''GNULIB_GETPROGNAME''@/$(GL_GNULIB_GETPROGNAME)/g' \ -e 's/@''GNULIB_GETSUBOPT''@/$(GL_GNULIB_GETSUBOPT)/g' \ -e 's/@''GNULIB_GRANTPT''@/$(GL_GNULIB_GRANTPT)/g' \ -e 's/@''GNULIB_MALLOC_GNU''@/$(GL_GNULIB_MALLOC_GNU)/g' \ @@ -3238,6 +3254,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''HAVE_DECL_FCVT''@|$(HAVE_DECL_FCVT)|g' \ -e 's|@''HAVE_DECL_GCVT''@|$(HAVE_DECL_GCVT)|g' \ -e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \ + -e 's|@''HAVE_GETPROGNAME''@|$(HAVE_GETPROGNAME)|g' \ -e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \ -e 's|@''HAVE_GRANTPT''@|$(HAVE_GRANTPT)|g' \ -e 's|@''HAVE_INITSTATE''@|$(HAVE_INITSTATE)|g' \ @@ -3273,17 +3290,24 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''HAVE_SYS_LOADAVG_H''@|$(HAVE_SYS_LOADAVG_H)|g' \ -e 's|@''HAVE_UNLOCKPT''@|$(HAVE_UNLOCKPT)|g' \ -e 's|@''HAVE_DECL_UNSETENV''@|$(HAVE_DECL_UNSETENV)|g' \ + -e 's|@''REPLACE__EXIT''@|$(REPLACE__EXIT)|g' \ -e 's|@''REPLACE_ALIGNED_ALLOC''@|$(REPLACE_ALIGNED_ALLOC)|g' \ -e 's|@''REPLACE_CALLOC_FOR_CALLOC_GNU''@|$(REPLACE_CALLOC_FOR_CALLOC_GNU)|g' \ -e 's|@''REPLACE_CALLOC_FOR_CALLOC_POSIX''@|$(REPLACE_CALLOC_FOR_CALLOC_POSIX)|g' \ -e 's|@''REPLACE_CANONICALIZE_FILE_NAME''@|$(REPLACE_CANONICALIZE_FILE_NAME)|g' \ -e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \ + -e 's|@''REPLACE_GETLOADAVG''@|$(REPLACE_GETLOADAVG)|g' \ + -e 's|@''REPLACE_GETPROGNAME''@|$(REPLACE_GETPROGNAME)|g' \ + -e 's|@''REPLACE_GETSUBOPT''@|$(REPLACE_GETSUBOPT)|g' \ -e 's|@''REPLACE_INITSTATE''@|$(REPLACE_INITSTATE)|g' \ -e 's|@''REPLACE_MALLOC_FOR_MALLOC_GNU''@|$(REPLACE_MALLOC_FOR_MALLOC_GNU)|g' \ -e 's|@''REPLACE_MALLOC_FOR_MALLOC_POSIX''@|$(REPLACE_MALLOC_FOR_MALLOC_POSIX)|g' \ -e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \ + -e 's|@''REPLACE_MKOSTEMP''@|$(REPLACE_MKOSTEMP)|g' \ + -e 's|@''REPLACE_MKOSTEMPS''@|$(REPLACE_MKOSTEMPS)|g' \ -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ -e 's|@''REPLACE_POSIX_MEMALIGN''@|$(REPLACE_POSIX_MEMALIGN)|g' \ + -e 's|@''REPLACE_POSIX_OPENPT''@|$(REPLACE_POSIX_OPENPT)|g' \ -e 's|@''REPLACE_PTSNAME''@|$(REPLACE_PTSNAME)|g' \ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \ -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ @@ -3362,6 +3386,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's/@''GNULIB_MEMMEM''@/$(GL_GNULIB_MEMMEM)/g' \ -e 's/@''GNULIB_MEMPCPY''@/$(GL_GNULIB_MEMPCPY)/g' \ -e 's/@''GNULIB_MEMRCHR''@/$(GL_GNULIB_MEMRCHR)/g' \ + -e 's/@''GNULIB_MEMSET_EXPLICIT''@/$(GL_GNULIB_MEMSET_EXPLICIT)/g' \ -e 's/@''GNULIB_RAWMEMCHR''@/$(GL_GNULIB_RAWMEMCHR)/g' \ -e 's/@''GNULIB_STPCPY''@/$(GL_GNULIB_STPCPY)/g' \ -e 's/@''GNULIB_STPNCPY''@/$(GL_GNULIB_STPNCPY)/g' \ @@ -3393,6 +3418,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \ -e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \ -e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \ + -e 's|@''HAVE_MEMSET_EXPLICIT''@|$(HAVE_MEMSET_EXPLICIT)|g' \ -e 's|@''HAVE_RAWMEMCHR''@|$(HAVE_RAWMEMCHR)|g' \ -e 's|@''HAVE_STPCPY''@|$(HAVE_STPCPY)|g' \ -e 's|@''HAVE_STPNCPY''@|$(HAVE_STPNCPY)|g' \ @@ -3413,7 +3439,9 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_FFSLL''@|$(REPLACE_FFSLL)|g' \ -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ + -e 's|@''REPLACE_MEMPCPY''@|$(REPLACE_MEMPCPY)|g' \ -e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \ + -e 's|@''REPLACE_STPCPY''@|$(REPLACE_STPCPY)|g' \ -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ -e 's|@''REPLACE_STRCHRNUL''@|$(REPLACE_STRCHRNUL)|g' \ -e 's|@''REPLACE_STRDUP''@|$(REPLACE_STRDUP)|g' \ @@ -3697,8 +3725,8 @@ EXTRA_DIST += tempname.h endif ## end gnulib module tempname -## begin gnulib module time -ifeq (,$(OMIT_GNULIB_MODULE_time)) +## begin gnulib module time-h +ifeq (,$(OMIT_GNULIB_MODULE_time-h)) BUILT_SOURCES += time.h @@ -3717,6 +3745,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $( -e 's/@''GNULIB_NANOSLEEP''@/$(GL_GNULIB_NANOSLEEP)/g' \ -e 's/@''GNULIB_STRFTIME''@/$(GL_GNULIB_STRFTIME)/g' \ -e 's/@''GNULIB_STRPTIME''@/$(GL_GNULIB_STRPTIME)/g' \ + -e 's/@''GNULIB_TIME''@/$(GL_GNULIB_TIME)/g' \ -e 's/@''GNULIB_TIMEGM''@/$(GL_GNULIB_TIMEGM)/g' \ -e 's/@''GNULIB_TIMESPEC_GET''@/$(GL_GNULIB_TIMESPEC_GET)/g' \ -e 's/@''GNULIB_TIMESPEC_GETRES''@/$(GL_GNULIB_TIMESPEC_GETRES)/g' \ @@ -3738,7 +3767,9 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $( -e 's|@''REPLACE_MKTIME''@|$(REPLACE_MKTIME)|g' \ -e 's|@''REPLACE_NANOSLEEP''@|$(REPLACE_NANOSLEEP)|g' \ -e 's|@''REPLACE_STRFTIME''@|$(REPLACE_STRFTIME)|g' \ + -e 's|@''REPLACE_TIME''@|$(REPLACE_TIME)|g' \ -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ + -e 's|@''REPLACE_TIMESPEC_GET''@|$(REPLACE_TIMESPEC_GET)|g' \ -e 's|@''REPLACE_TZSET''@|$(REPLACE_TZSET)|g' \ -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ @@ -3755,7 +3786,7 @@ MOSTLYCLEANFILES += time.h time.h-t EXTRA_DIST += time.in.h endif -## end gnulib module time +## end gnulib module time-h ## begin gnulib module time_r ifeq (,$(OMIT_GNULIB_MODULE_time_r)) @@ -3983,6 +4014,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_COPY_FILE_RANGE''@|$(REPLACE_COPY_FILE_RANGE)|g' \ -e 's|@''REPLACE_DUP''@|$(REPLACE_DUP)|g' \ -e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \ + -e 's|@''REPLACE_DUP3''@|$(REPLACE_DUP3)|g' \ -e 's|@''REPLACE_EXECL''@|$(REPLACE_EXECL)|g' \ -e 's|@''REPLACE_EXECLE''@|$(REPLACE_EXECLE)|g' \ -e 's|@''REPLACE_EXECLP''@|$(REPLACE_EXECLP)|g' \ @@ -3992,10 +4024,12 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_EXECVPE''@|$(REPLACE_EXECVPE)|g' \ -e 's|@''REPLACE_FACCESSAT''@|$(REPLACE_FACCESSAT)|g' \ -e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \ + -e 's|@''REPLACE_FDATASYNC''@|$(REPLACE_FDATASYNC)|g' \ -e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \ -e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \ -e 's|@''REPLACE_GETDOMAINNAME''@|$(REPLACE_GETDOMAINNAME)|g' \ -e 's|@''REPLACE_GETDTABLESIZE''@|$(REPLACE_GETDTABLESIZE)|g' \ + -e 's|@''REPLACE_GETENTROPY''@|$(REPLACE_GETENTROPY)|g' \ -e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \ -e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \ -e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \ @@ -4006,12 +4040,14 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_LINK''@|$(REPLACE_LINK)|g' \ -e 's|@''REPLACE_LINKAT''@|$(REPLACE_LINKAT)|g' \ -e 's|@''REPLACE_LSEEK''@|$(REPLACE_LSEEK)|g' \ + -e 's|@''REPLACE_PIPE2''@|$(REPLACE_PIPE2)|g' \ -e 's|@''REPLACE_PREAD''@|$(REPLACE_PREAD)|g' \ -e 's|@''REPLACE_PWRITE''@|$(REPLACE_PWRITE)|g' \ -e 's|@''REPLACE_READ''@|$(REPLACE_READ)|g' \ -e 's|@''REPLACE_READLINK''@|$(REPLACE_READLINK)|g' \ -e 's|@''REPLACE_READLINKAT''@|$(REPLACE_READLINKAT)|g' \ -e 's|@''REPLACE_RMDIR''@|$(REPLACE_RMDIR)|g' \ + -e 's|@''REPLACE_SETHOSTNAME''@|$(REPLACE_SETHOSTNAME)|g' \ -e 's|@''REPLACE_SLEEP''@|$(REPLACE_SLEEP)|g' \ -e 's|@''REPLACE_SYMLINK''@|$(REPLACE_SYMLINK)|g' \ -e 's|@''REPLACE_SYMLINKAT''@|$(REPLACE_SYMLINKAT)|g' \ diff --git a/lib/group-member.c b/lib/group-member.c index 6e3f640dcf0..96a09f94a8f 100644 --- a/lib/group-member.c +++ b/lib/group-member.c @@ -1,7 +1,7 @@ /* group-member.c -- determine whether group id is in calling user's group list - Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2023 Free - Software Foundation, Inc. + Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2023 Free Software + Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/inttypes.in.h b/lib/inttypes.in.h index 50a2bbfcda2..5b7ef12dc7e 100644 --- a/lib/inttypes.in.h +++ b/lib/inttypes.in.h @@ -903,8 +903,21 @@ extern "C" { #endif #if @GNULIB_IMAXABS@ -# if !@HAVE_DECL_IMAXABS@ -extern intmax_t imaxabs (intmax_t); +# if @REPLACE_IMAXABS@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef imaxabs +# define imaxabs rpl_imaxabs +# endif +_GL_FUNCDECL_RPL (imaxabs, intmax_t, (intmax_t x)); +_GL_CXXALIAS_RPL (imaxabs, intmax_t, (intmax_t x)); +# else +# if !@HAVE_DECL_IMAXABS@ +_GL_FUNCDECL_SYS (imaxabs, intmax_t, (intmax_t x)); +# endif +_GL_CXXALIAS_SYS (imaxabs, intmax_t, (intmax_t x)); +# endif +# if __GLIBC__ >= 2 +_GL_CXXALIASWARN (imaxabs); # endif #elif defined GNULIB_POSIXCHECK # undef imaxabs @@ -921,8 +934,21 @@ typedef struct { intmax_t quot; intmax_t rem; } imaxdiv_t; # define GNULIB_defined_imaxdiv_t 1 # endif # endif -# if !@HAVE_DECL_IMAXDIV@ -extern imaxdiv_t imaxdiv (intmax_t, intmax_t); +# if @REPLACE_IMAXDIV@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef imaxdiv +# define imaxdiv rpl_imaxdiv +# endif +_GL_FUNCDECL_RPL (imaxdiv, imaxdiv_t, (intmax_t numer, intmax_t denom)); +_GL_CXXALIAS_RPL (imaxdiv, imaxdiv_t, (intmax_t numer, intmax_t denom)); +# else +# if !@HAVE_DECL_IMAXDIV@ +_GL_FUNCDECL_SYS (imaxdiv, imaxdiv_t, (intmax_t numer, intmax_t denom)); +# endif +_GL_CXXALIAS_SYS (imaxdiv, imaxdiv_t, (intmax_t numer, intmax_t denom)); +# endif +# if __GLIBC__ >= 2 +_GL_CXXALIASWARN (imaxdiv); # endif #elif defined GNULIB_POSIXCHECK # undef imaxdiv diff --git a/lib/libc-config.h b/lib/libc-config.h index 1d28e58c971..5f5ad010377 100644 --- a/lib/libc-config.h +++ b/lib/libc-config.h @@ -137,8 +137,6 @@ # undef __attribute_returns_twice__ # undef __attribute_used__ # undef __attribute_warn_unused_result__ -# undef __bos -# undef __bos0 # undef __errordecl # undef __extension__ # undef __extern_always_inline @@ -147,21 +145,13 @@ # undef __fortified_attr_access # undef __fortify_function # undef __glibc_c99_flexarr_available -# undef __glibc_fortify -# undef __glibc_fortify_n # undef __glibc_has_attribute # undef __glibc_has_builtin # undef __glibc_has_extension # undef __glibc_likely # undef __glibc_macro_warning # undef __glibc_macro_warning1 -# undef __glibc_objsize -# undef __glibc_objsize0 -# undef __glibc_safe_len_cond -# undef __glibc_safe_or_unknown_len # undef __glibc_unlikely -# undef __glibc_unsafe_len -# undef __glibc_unsigned_or_positive # undef __inline # undef __ptr_t # undef __restrict @@ -170,6 +160,18 @@ # undef __va_arg_pack_len # undef __warnattr # undef __wur +# ifndef __GNULIB_CDEFS +# undef __bos +# undef __bos0 +# undef __glibc_fortify +# undef __glibc_fortify_n +# undef __glibc_objsize +# undef __glibc_objsize0 +# undef __glibc_safe_len_cond +# undef __glibc_safe_or_unknown_len +# undef __glibc_unsafe_len +# undef __glibc_unsigned_or_positive +# endif /* Include our copy of glibc <sys/cdefs.h>. */ # include <cdefs.h> diff --git a/lib/limits.in.h b/lib/limits.in.h index ae46a5aa25f..a01b4c6a280 100644 --- a/lib/limits.in.h +++ b/lib/limits.in.h @@ -99,7 +99,7 @@ # endif #endif -/* Macros specified by C2x and by ISO/IEC TS 18661-1:2014. */ +/* Macros specified by C23 and by ISO/IEC TS 18661-1:2014. */ #if (! defined ULLONG_WIDTH \ && (defined _GNU_SOURCE || defined __STDC_WANT_IEC_60559_BFP_EXT__ \ @@ -117,13 +117,16 @@ # define ULLONG_WIDTH _GL_INTEGER_WIDTH (0, ULLONG_MAX) #endif -/* Macros specified by C2x. */ +/* 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/malloc.c b/lib/malloc.c index 92f8c841cd7..3ade35cb63f 100644 --- a/lib/malloc.c +++ b/lib/malloc.c @@ -1,7 +1,6 @@ /* malloc() function that is glibc compatible. - Copyright (C) 1997-1998, 2006-2007, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 1997-1998, 2006-2007, 2009-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/md5-stream.c b/lib/md5-stream.c index ab48fe3261a..ba76792cbbe 100644 --- a/lib/md5-stream.c +++ b/lib/md5-stream.c @@ -1,7 +1,7 @@ /* Functions to compute MD5 message digest of files or memory blocks. according to the definition of MD5 in RFC 1321 from April 1992. - Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2023 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2023 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/md5.c b/lib/md5.c index b1e139339f4..4a6accf28ff 100644 --- a/lib/md5.c +++ b/lib/md5.c @@ -1,7 +1,7 @@ /* Functions to compute MD5 message digest of files or memory blocks. according to the definition of MD5 in RFC 1321 from April 1992. - Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2023 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2023 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/md5.h b/lib/md5.h index 3b0b4ff730f..f34e7cb8dfa 100644 --- a/lib/md5.h +++ b/lib/md5.h @@ -1,7 +1,7 @@ /* Declaration of functions and data types used for MD5 sum computing library functions. - Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2023 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2023 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/memmem.c b/lib/memmem.c index 665815efb1a..c0b48c1b25d 100644 --- a/lib/memmem.c +++ b/lib/memmem.c @@ -1,5 +1,5 @@ -/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2023 Free - Software Foundation, Inc. +/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2023 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/memrchr.c b/lib/memrchr.c index a34fc71f7da..c5b1fe8b2e3 100644 --- a/lib/memrchr.c +++ b/lib/memrchr.c @@ -1,7 +1,7 @@ /* memrchr -- find the last occurrence of a byte in a memory block - Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2023 Free - Software Foundation, Inc. + Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2023 Free Software + Foundation, Inc. Based on strlen implementation by Torbjorn Granlund (tege@sics.se), with help from Dan Sahlin (dan@sics.se) and diff --git a/lib/memset_explicit.c b/lib/memset_explicit.c new file mode 100644 index 00000000000..6d21a5e8797 --- /dev/null +++ b/lib/memset_explicit.c @@ -0,0 +1,55 @@ +/* Erase sensitive data from memory. + Copyright 2022-2023 Free Software Foundation, Inc. + + This file is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as + published by the Free Software Foundation; either version 2.1 of the + License, or (at your option) any later version. + + This file 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 Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +/* memset_s need this define */ +#if HAVE_MEMSET_S +# define __STDC_WANT_LIB_EXT1__ 1 +#endif + +#include <string.h> + +/* Set S's bytes to C, where S has LEN bytes. The compiler will not + optimize effects away, even if S is dead after the call. */ +void * +memset_explicit (void *s, int c, size_t len) +{ +#if HAVE_EXPLICIT_MEMSET + return explicit_memset (s, c, len); +#elif HAVE_MEMSET_S + (void) memset_s (s, len, c, len); + return s; +#elif defined __GNUC__ && !defined __clang__ + memset (s, c, len); + /* Compiler barrier. */ + __asm__ volatile ("" ::: "memory"); + return s; +#elif defined __clang__ + memset (s, c, len); + /* Compiler barrier. */ + /* With asm ("" ::: "memory") LLVM analyzes uses of 's' and finds that the + whole thing is dead and eliminates it. Use 'g' to work around this + problem. See <https://bugs.llvm.org/show_bug.cgi?id=15495#c11>. */ + __asm__ volatile ("" : : "g"(s) : "memory"); + return s; +#else + /* Invoke memset through a volatile function pointer. This defeats compiler + optimizations. */ + void * (* const volatile volatile_memset) (void *, int, size_t) = memset; + return volatile_memset (s, c, len); +#endif +} diff --git a/lib/nanosleep.c b/lib/nanosleep.c index 6383115c0f1..3f295f49b5d 100644 --- a/lib/nanosleep.c +++ b/lib/nanosleep.c @@ -1,7 +1,6 @@ /* Provide a replacement for the POSIX nanosleep function. - Copyright (C) 1999-2000, 2002, 2004-2023 Free Software Foundation, - Inc. + Copyright (C) 1999-2000, 2002, 2004-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/openat-proc.c b/lib/openat-proc.c index 2a6a85f0696..88f70be4f59 100644 --- a/lib/openat-proc.c +++ b/lib/openat-proc.c @@ -30,9 +30,12 @@ #include <string.h> #include <unistd.h> -#ifdef __KLIBC__ +#ifdef __KLIBC__ /* OS/2 */ # include <InnoTekLIBC/backend.h> #endif +#ifdef __MVS__ /* z/OS */ +# include <termios.h> +#endif #include "intprops.h" @@ -53,7 +56,8 @@ openat_proc_name (char buf[OPENAT_BUFFER_SIZE], int fd, char const *file) return buf; } -#ifndef __KLIBC__ +#if !(defined __KLIBC__ || defined __MVS__) + /* Generic code for Linux, Solaris, and similar platforms. */ # define PROC_SELF_FD_FORMAT "/proc/self/fd/%d/" { enum { @@ -107,14 +111,29 @@ openat_proc_name (char buf[OPENAT_BUFFER_SIZE], int fd, char const *file) dirlen = sprintf (result, PROC_SELF_FD_FORMAT, fd); } } -#else +#else /* (defined __KLIBC__ || defined __MVS__), i.e. OS/2 or z/OS */ /* OS/2 kLIBC provides a function to retrieve a path from a fd. */ { - char dir[_MAX_PATH]; size_t bufsize; +# ifdef __KLIBC__ + char dir[_MAX_PATH]; if (__libc_Back_ioFHToPath (fd, dir, sizeof dir)) return NULL; +# endif +# ifdef __MVS__ + char dir[_XOPEN_PATH_MAX]; + /* Documentation: + https://www.ibm.com/docs/en/zos/2.2.0?topic=functions-w-ioctl-w-pioctl-control-devices */ + if (w_ioctl (fd, _IOCC_GPN, sizeof dir, dir) < 0) + return NULL; + /* Documentation: + https://www.ibm.com/docs/en/zos/2.2.0?topic=functions-e2a-l-convert-characters-from-ebcdic-ascii */ + dirlen = __e2a_l (dir, strlen (dir)); + if (dirlen < 0 || dirlen >= sizeof dir) + return NULL; + dir[dirlen] = '\0'; +# endif dirlen = strlen (dir); bufsize = dirlen + 1 + strlen (file) + 1; /* 1 for '/', 1 for null */ diff --git a/lib/qcopy-acl.c b/lib/qcopy-acl.c index 883bcf7d588..0f4159b7fd9 100644 --- a/lib/qcopy-acl.c +++ b/lib/qcopy-acl.c @@ -23,6 +23,20 @@ #include "acl-internal.h" +#if USE_XATTR + +# include <attr/libattr.h> + +/* Returns 1 if NAME is the name of an extended attribute that is related + to permissions, i.e. ACLs. Returns 0 otherwise. */ + +static int +is_attr_permissions (const char *name, struct error_context *ctx) +{ + return attr_copy_action (name, ctx) == ATTR_ACTION_PERMISSIONS; +} + +#endif /* USE_XATTR */ /* Copy access control lists from one file to another. If SOURCE_DESC is a valid file descriptor, use file descriptor operations, else use @@ -39,13 +53,33 @@ int qcopy_acl (const char *src_name, int source_desc, const char *dst_name, int dest_desc, mode_t mode) { - struct permission_context ctx; int ret; +#ifdef USE_XATTR + /* in case no ACLs present and also to set higher mode bits + we chmod before setting ACLs as doing it after could overwrite them + (especially true for NFSv4, posix ACL has that ugly "mask" hack that + nobody understands) */ + ret = chmod_or_fchmod (dst_name, dest_desc, mode); + /* Rather than fiddling with acls one by one, we just copy the whole ACL xattrs + (Posix or NFSv4). Of course, that won't address ACLs conversion + (i.e. posix <-> nfs4) but we can't do it anyway, so for now, we don't care + Functions attr_copy_* return 0 in case we copied something OR nothing + to copy */ + if (ret == 0) + ret = source_desc <= 0 || dest_desc <= 0 + ? attr_copy_file (src_name, dst_name, is_attr_permissions, NULL) + : attr_copy_fd (src_name, source_desc, dst_name, dest_desc, + is_attr_permissions, NULL); +#else + /* no XATTR, so we proceed the old dusty way */ + struct permission_context ctx; + ret = get_permissions (src_name, source_desc, mode, &ctx); if (ret != 0) return -2; ret = set_permissions (&ctx, dst_name, dest_desc); free_permission_context (&ctx); +#endif return ret; } diff --git a/lib/save-cwd.h b/lib/save-cwd.h index f26319389c2..d089b0e2145 100644 --- a/lib/save-cwd.h +++ b/lib/save-cwd.h @@ -1,7 +1,7 @@ /* Save and restore current working directory. - Copyright (C) 1995, 1997-1998, 2003, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 1995, 1997-1998, 2003, 2009-2023 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/sha1.c b/lib/sha1.c index 3f6d86a285c..80f0b7a3314 100644 --- a/lib/sha1.c +++ b/lib/sha1.c @@ -1,8 +1,7 @@ /* sha1.c - Functions to compute SHA1 message digest of files or memory blocks according to the NIST specification FIPS-180-1. - Copyright (C) 2000-2001, 2003-2006, 2008-2023 Free Software - Foundation, Inc. + Copyright (C) 2000-2001, 2003-2006, 2008-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/sig2str.c b/lib/sig2str.c index 4f68cb7ca8a..c5219caaaed 100644 --- a/lib/sig2str.c +++ b/lib/sig2str.c @@ -1,7 +1,6 @@ /* sig2str.c -- convert between signal names and numbers - Copyright (C) 2002, 2004, 2006, 2009-2023 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004, 2006, 2009-2023 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h deleted file mode 100644 index 17357810c7c..00000000000 --- a/lib/stdalign.in.h +++ /dev/null @@ -1,133 +0,0 @@ -/* A substitute for ISO C11 <stdalign.h>. - - Copyright 2011-2023 Free Software Foundation, Inc. - - This file is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 2.1 of the - License, or (at your option) any later version. - - This file 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 Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see <https://www.gnu.org/licenses/>. */ - -/* Written by Paul Eggert and Bruno Haible. */ - -#ifndef _GL_STDALIGN_H -#define _GL_STDALIGN_H - -/* ISO C11 <stdalign.h> for platforms that lack it. - - References: - ISO C11 (latest free draft - <http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1570.pdf>) - sections 6.5.3.4, 6.7.5, 7.15. - C++11 (latest free draft - <http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2011/n3242.pdf>) - section 18.10. */ - -/* alignof (TYPE), also known as _Alignof (TYPE), yields the alignment - requirement of a structure member (i.e., slot or field) that is of - type TYPE, as an integer constant expression. - - This differs from GCC's and clang's __alignof__ operator, which can - yield a better-performing alignment for an object of that type. For - example, on x86 with GCC and on Linux/x86 with clang, - __alignof__ (double) and __alignof__ (long long) are 8, whereas - alignof (double) and alignof (long long) are 4 unless the option - '-malign-double' is used. - - The result cannot be used as a value for an 'enum' constant, if you - want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */ - -/* FreeBSD 9.1 <sys/cdefs.h>, included by <stddef.h> and lots of other - standard headers, defines conflicting implementations of _Alignas - and _Alignof that are no better than ours; override them. */ -#undef _Alignas -#undef _Alignof - -/* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023 - <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. - clang versions < 8.0.0 have the same bug. */ -#if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ - || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ - && !defined __clang__) \ - || (defined __clang__ && __clang_major__ < 8)) -# ifdef __cplusplus -# if (201103 <= __cplusplus || defined _MSC_VER) -# define _Alignof(type) alignof (type) -# else - template <class __t> struct __alignof_helper { char __a; __t __b; }; -# define _Alignof(type) offsetof (__alignof_helper<type>, __b) -# define _GL_STDALIGN_NEEDS_STDDEF 1 -# endif -# else -# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) -# define _GL_STDALIGN_NEEDS_STDDEF 1 -# endif -#endif -#if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)) -# define alignof _Alignof -#endif -#define __alignof_is_defined 1 - -/* alignas (A), also known as _Alignas (A), aligns a variable or type - to the alignment A, where A is an integer constant expression. For - example: - - int alignas (8) foo; - struct s { int a; int alignas (8) bar; }; - - aligns the address of FOO and the offset of BAR to be multiples of 8. - - A should be a power of two that is at least the type's alignment - and at most the implementation's alignment limit. This limit is - 2**28 on typical GNUish hosts, and 2**13 on MSVC. To be portable - to MSVC through at least version 10.0, A should be an integer - constant, as MSVC does not support expressions such as 1 << 3. - To be portable to Sun C 5.11, do not align auto variables to - anything stricter than their default alignment. - - The following C11 requirements are not supported here: - - - If A is zero, alignas has no effect. - - alignas can be used multiple times; the strictest one wins. - - alignas (TYPE) is equivalent to alignas (alignof (TYPE)). - - */ - -#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 -# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER) -# define _Alignas(a) alignas (a) -# elif (!defined __attribute__ \ - && ((defined __APPLE__ && defined __MACH__ \ - ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \ - : __GNUC__ && !defined __ibmxl__) \ - || (4 <= __clang_major__) \ - || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ - || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__)) -# define _Alignas(a) __attribute__ ((__aligned__ (a))) -# elif 1300 <= _MSC_VER -# define _Alignas(a) __declspec (align (a)) -# endif -#endif -#if ((defined _Alignas \ - && !(defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) \ - || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) -# define alignas _Alignas -#endif -#if (defined alignas \ - || (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) -# define __alignas_is_defined 1 -#endif - -/* Include <stddef.h> if needed for offsetof. */ -#if _GL_STDALIGN_NEEDS_STDDEF -# include <stddef.h> -#endif - -#endif /* _GL_STDALIGN_H */ diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h index 81e7f838372..46608bed198 100644 --- a/lib/stdio-impl.h +++ b/lib/stdio-impl.h @@ -71,6 +71,12 @@ # else # define _gl_flags_file_t short # endif +# ifdef __LP64__ +# define _gl_file_offset_t int64_t +# else + /* see https://android.googlesource.com/platform/bionic/+/master/docs/32-bit-abi.md */ +# define _gl_file_offset_t __kernel_off_t +# endif /* Up to this commit from 2015-10-12 <https://android.googlesource.com/platform/bionic.git/+/f0141dfab10a4b332769d52fa76631a64741297a> the innards of FILE were public, and fp_ub could be defined like for OpenBSD, @@ -96,7 +102,7 @@ unsigned char _nbuf[1]; \ struct { unsigned char *_base; size_t _size; } _lb; \ int _blksize; \ - fpos_t _offset; \ + _gl_file_offset_t _offset; \ /* More fields, not relevant here. */ \ } *) fp) # else diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 59cbea3d47d..098f841738c 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -36,6 +36,12 @@ #ifndef _@GUARD_PREFIX@_STDIO_H +/* Suppress macOS deprecation warnings for sprintf and vsprintf. */ +#if (defined __APPLE__ && defined __MACH__) && !defined _POSIX_C_SOURCE +# define _POSIX_C_SOURCE 200809L +# define _GL_DEFINED__POSIX_C_SOURCE +#endif + #define _GL_ALREADY_INCLUDING_STDIO_H /* The include_next requires a split double-inclusion guard. */ @@ -43,6 +49,11 @@ #undef _GL_ALREADY_INCLUDING_STDIO_H +#ifdef _GL_DEFINED__POSIX_C_SOURCE +# undef _GL_DEFINED__POSIX_C_SOURCE +# undef _POSIX_C_SOURCE +#endif + #ifndef _@GUARD_PREFIX@_STDIO_H #define _@GUARD_PREFIX@_STDIO_H @@ -210,7 +221,9 @@ _GL_FUNCDECL_SYS (dprintf, int, (int fd, const char *restrict format, ...) # endif _GL_CXXALIAS_SYS (dprintf, int, (int fd, const char *restrict format, ...)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (dprintf); +# endif #elif defined GNULIB_POSIXCHECK # undef dprintf # if HAVE_RAW_DECL_DPRINTF @@ -882,7 +895,9 @@ _GL_CXXALIAS_SYS (getdelim, ssize_t, int delimiter, FILE *restrict stream)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getdelim); +# endif #elif defined GNULIB_POSIXCHECK # undef getdelim # if HAVE_RAW_DECL_GETDELIM @@ -921,7 +936,7 @@ _GL_CXXALIAS_SYS (getline, ssize_t, (char **restrict lineptr, size_t *restrict linesize, FILE *restrict stream)); # endif -# if @HAVE_DECL_GETLINE@ +# if __GLIBC__ >= 2 && @HAVE_DECL_GETLINE@ _GL_CXXALIASWARN (getline); # endif #elif defined GNULIB_POSIXCHECK @@ -951,9 +966,13 @@ _GL_WARN_ON_USE (gets, "gets is a security hole - use fgets instead"); # endif _GL_CXXALIAS_MDA (getw, int, (FILE *restrict stream)); # else +# if @HAVE_DECL_GETW@ _GL_CXXALIAS_SYS (getw, int, (FILE *restrict stream)); +# endif # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getw); +# endif #endif #if @GNULIB_OBSTACK_PRINTF@ || @GNULIB_OBSTACK_PRINTF_POSIX@ @@ -1190,9 +1209,13 @@ _GL_CXXALIASWARN (puts); # endif _GL_CXXALIAS_MDA (putw, int, (int w, FILE *restrict stream)); # else +# if @HAVE_DECL_PUTW@ _GL_CXXALIAS_SYS (putw, int, (int w, FILE *restrict stream)); +# endif # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (putw); +# endif #endif #if @GNULIB_REMOVE@ diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 4c8aad76124..a91f4e23d67 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -1,7 +1,6 @@ /* A GNU-like <stdlib.h>. - Copyright (C) 1995, 2001-2004, 2006-2023 Free Software Foundation, - Inc. + Copyright (C) 1995, 2001-2004, 2006-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as @@ -165,11 +164,22 @@ struct random_data #if @GNULIB__EXIT@ /* Terminate the current process with the given return code, without running the 'atexit' handlers. */ -# if !@HAVE__EXIT@ +# if @REPLACE__EXIT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef _Exit +# define _Exit rpl__Exit +# endif +_GL_FUNCDECL_RPL (_Exit, _Noreturn void, (int status)); +_GL_CXXALIAS_RPL (_Exit, void, (int status)); +# else +# if !@HAVE__EXIT@ _GL_FUNCDECL_SYS (_Exit, _Noreturn void, (int status)); -# endif +# endif _GL_CXXALIAS_SYS (_Exit, void, (int status)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (_Exit); +# endif #elif defined GNULIB_POSIXCHECK # undef _Exit # if HAVE_RAW_DECL__EXIT @@ -417,12 +427,24 @@ _GL_CXXALIASWARN (gcvt); The three numbers are the load average of the last 1 minute, the last 5 minutes, and the last 15 minutes, respectively. LOADAVG is an array of NELEM numbers. */ -# if !@HAVE_DECL_GETLOADAVG@ +# if @REPLACE_GETLOADAVG@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getloadavg +# define getloadavg rpl_getloadavg +# endif +_GL_FUNCDECL_RPL (getloadavg, int, (double loadavg[], int nelem) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (getloadavg, int, (double loadavg[], int nelem)); +# else +# if !@HAVE_DECL_GETLOADAVG@ _GL_FUNCDECL_SYS (getloadavg, int, (double loadavg[], int nelem) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (getloadavg, int, (double loadavg[], int nelem)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getloadavg); +# endif #elif defined GNULIB_POSIXCHECK # undef getloadavg # if HAVE_RAW_DECL_GETLOADAVG @@ -431,6 +453,41 @@ _GL_WARN_ON_USE (getloadavg, "getloadavg is not portable - " # endif #endif +#if @GNULIB_GETPROGNAME@ +/* Return the base name of the executing program. + On native Windows this will usually end in ".exe" or ".EXE". */ +# if @REPLACE_GETPROGNAME@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getprogname +# define getprogname rpl_getprogname +# endif +# ifdef HAVE_DECL_PROGRAM_INVOCATION_NAME +_GL_FUNCDECL_RPL (getprogname, const char *, (void) _GL_ATTRIBUTE_PURE); +# else +_GL_FUNCDECL_RPL (getprogname, const char *, (void)); +# endif +_GL_CXXALIAS_RPL (getprogname, const char *, (void)); +# else +# if !@HAVE_GETPROGNAME@ +# ifdef HAVE_DECL_PROGRAM_INVOCATION_NAME +_GL_FUNCDECL_SYS (getprogname, const char *, (void) _GL_ATTRIBUTE_PURE); +# else +_GL_FUNCDECL_SYS (getprogname, const char *, (void)); +# endif +# endif +_GL_CXXALIAS_SYS (getprogname, const char *, (void)); +# endif +# if __GLIBC__ >= 2 +_GL_CXXALIASWARN (getprogname); +# endif +#elif defined GNULIB_POSIXCHECK +# undef getprogname +# if HAVE_RAW_DECL_GETPROGNAME +_GL_WARN_ON_USE (getprogname, "getprogname is unportable - " + "use gnulib module getprogname for portability"); +# endif +#endif + #if @GNULIB_GETSUBOPT@ /* Assuming *OPTIONP is a comma separated list of elements of the form "token" or "token=value", getsubopt parses the first of these elements. @@ -443,14 +500,28 @@ _GL_WARN_ON_USE (getloadavg, "getloadavg is not portable - " Otherwise it returns -1, and *OPTIONP and *VALUEP are undefined. For more details see the POSIX specification. https://pubs.opengroup.org/onlinepubs/9699919799/functions/getsubopt.html */ -# if !@HAVE_GETSUBOPT@ +# if @REPLACE_GETSUBOPT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getsubopt +# define getsubopt rpl_getsubopt +# endif +_GL_FUNCDECL_RPL (getsubopt, int, + (char **optionp, char *const *tokens, char **valuep) + _GL_ARG_NONNULL ((1, 2, 3))); +_GL_CXXALIAS_RPL (getsubopt, int, + (char **optionp, char *const *tokens, char **valuep)); +# else +# if !@HAVE_GETSUBOPT@ _GL_FUNCDECL_SYS (getsubopt, int, (char **optionp, char *const *tokens, char **valuep) _GL_ARG_NONNULL ((1, 2, 3))); -# endif +# endif _GL_CXXALIAS_SYS (getsubopt, int, (char **optionp, char *const *tokens, char **valuep)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getsubopt); +# endif #elif defined GNULIB_POSIXCHECK # undef getsubopt # if HAVE_RAW_DECL_GETSUBOPT @@ -580,12 +651,24 @@ _GL_WARN_ON_USE (mkdtemp, "mkdtemp is unportable - " implementation. Returns the open file descriptor if successful, otherwise -1 and errno set. */ -# if !@HAVE_MKOSTEMP@ +# if @REPLACE_MKOSTEMP@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mkostemp +# define mkostemp rpl_mkostemp +# endif +_GL_FUNCDECL_RPL (mkostemp, int, (char * /*template*/, int /*flags*/) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (mkostemp, int, (char * /*template*/, int /*flags*/)); +# else +# if !@HAVE_MKOSTEMP@ _GL_FUNCDECL_SYS (mkostemp, int, (char * /*template*/, int /*flags*/) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (mkostemp, int, (char * /*template*/, int /*flags*/)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mkostemp); +# endif #elif defined GNULIB_POSIXCHECK # undef mkostemp # if HAVE_RAW_DECL_MKOSTEMP @@ -608,14 +691,28 @@ _GL_WARN_ON_USE (mkostemp, "mkostemp is unportable - " implementation. Returns the open file descriptor if successful, otherwise -1 and errno set. */ -# if !@HAVE_MKOSTEMPS@ +# if @REPLACE_MKOSTEMPS@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mkostemps +# define mkostemps rpl_mkostemps +# endif +_GL_FUNCDECL_RPL (mkostemps, int, + (char * /*template*/, int /*suffixlen*/, int /*flags*/) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (mkostemps, int, + (char * /*template*/, int /*suffixlen*/, int /*flags*/)); +# else +# if !@HAVE_MKOSTEMPS@ _GL_FUNCDECL_SYS (mkostemps, int, (char * /*template*/, int /*suffixlen*/, int /*flags*/) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (mkostemps, int, (char * /*template*/, int /*suffixlen*/, int /*flags*/)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mkostemps); +# endif #elif defined GNULIB_POSIXCHECK # undef mkostemps # if HAVE_RAW_DECL_MKOSTEMPS @@ -714,7 +811,7 @@ _GL_CXXALIAS_SYS (posix_memalign, int, (void **memptr, size_t alignment, size_t size)); # endif # endif -# if @HAVE_POSIX_MEMALIGN@ +# if __GLIBC__ >= 2 && @HAVE_POSIX_MEMALIGN@ _GL_CXXALIASWARN (posix_memalign); # endif #elif defined GNULIB_POSIXCHECK @@ -728,11 +825,22 @@ _GL_WARN_ON_USE (posix_memalign, "posix_memalign is not portable - " #if @GNULIB_POSIX_OPENPT@ /* Return an FD open to the master side of a pseudo-terminal. Flags should include O_RDWR, and may also include O_NOCTTY. */ -# if !@HAVE_POSIX_OPENPT@ +# if @REPLACE_POSIX_OPENPT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef posix_openpt +# define posix_openpt rpl_posix_openpt +# endif +_GL_FUNCDECL_RPL (posix_openpt, int, (int flags)); +_GL_CXXALIAS_RPL (posix_openpt, int, (int flags)); +# else +# if !@HAVE_POSIX_OPENPT@ _GL_FUNCDECL_SYS (posix_openpt, int, (int flags)); -# endif +# endif _GL_CXXALIAS_SYS (posix_openpt, int, (int flags)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (posix_openpt); +# endif #elif defined GNULIB_POSIXCHECK # undef posix_openpt # if HAVE_RAW_DECL_POSIX_OPENPT @@ -957,7 +1065,9 @@ _GL_FUNCDECL_SYS (initstate, char *, _GL_CXXALIAS_SYS_CAST (initstate, char *, (unsigned int seed, char *buf, size_t buf_size)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (initstate); +# endif #elif defined GNULIB_POSIXCHECK # undef initstate # if HAVE_RAW_DECL_INITSTATE @@ -982,7 +1092,9 @@ _GL_FUNCDECL_SYS (setstate, char *, (char *arg_state) _GL_ARG_NONNULL ((1))); is const char *arg_state. */ _GL_CXXALIAS_SYS_CAST (setstate, char *, (char *arg_state)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (setstate); +# endif #elif defined GNULIB_POSIXCHECK # undef setstate # if HAVE_RAW_DECL_SETSTATE @@ -1168,7 +1280,9 @@ _GL_FUNCDECL_SYS (reallocarray, void *, _GL_CXXALIAS_SYS (reallocarray, void *, (void *ptr, size_t nmemb, size_t size)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (reallocarray); +# endif #elif defined GNULIB_POSIXCHECK # undef reallocarray # if HAVE_RAW_DECL_REALLOCARRAY diff --git a/lib/string.in.h b/lib/string.in.h index 459dd063cbe..b6bf432e1f1 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -59,10 +59,11 @@ # include <unistd.h> #endif -/* AIX 7.2 declares ffsl and ffsll in <strings.h>, not in <string.h>. */ +/* AIX 7.2 and Android 13 declare ffsl and ffsll in <strings.h>, not in + <string.h>. */ /* But in any case avoid namespace pollution on glibc systems. */ #if ((@GNULIB_FFSL@ || @GNULIB_FFSLL@ || defined GNULIB_POSIXCHECK) \ - && defined _AIX) \ + && (defined _AIX || defined __ANDROID__)) \ && ! defined __GLIBC__ # include <strings.h> #endif @@ -82,7 +83,14 @@ can be freed via 'free'; it can be used only after declaring 'free'. */ /* Applies to: functions. Cannot be used on inline functions. */ #ifndef _GL_ATTRIBUTE_DEALLOC_FREE -# define _GL_ATTRIBUTE_DEALLOC_FREE _GL_ATTRIBUTE_DEALLOC (free, 1) +# if defined __cplusplus && defined __GNUC__ && !defined __clang__ +/* Work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=108231> */ +# define _GL_ATTRIBUTE_DEALLOC_FREE \ + _GL_ATTRIBUTE_DEALLOC ((void (*) (void *)) free, 1) +# else +# define _GL_ATTRIBUTE_DEALLOC_FREE \ + _GL_ATTRIBUTE_DEALLOC (free, 1) +# endif #endif /* _GL_ATTRIBUTE_MALLOC declares that the function returns a pointer to freshly @@ -118,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 @@ -300,16 +312,32 @@ _GL_WARN_ON_USE (memmem, "memmem is unportable and often quadratic - " /* Copy N bytes of SRC to DEST, return pointer to bytes after the last written byte. */ #if @GNULIB_MEMPCPY@ -# if ! @HAVE_MEMPCPY@ +# if @REPLACE_MEMPCPY@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mempcpy +# define mempcpy rpl_mempcpy +# endif +_GL_FUNCDECL_RPL (mempcpy, void *, + (void *restrict __dest, void const *restrict __src, + size_t __n) + _GL_ARG_NONNULL ((1, 2))); +_GL_CXXALIAS_RPL (mempcpy, void *, + (void *restrict __dest, void const *restrict __src, + size_t __n)); +# else +# if !@HAVE_MEMPCPY@ _GL_FUNCDECL_SYS (mempcpy, void *, (void *restrict __dest, void const *restrict __src, size_t __n) _GL_ARG_NONNULL ((1, 2))); -# endif +# endif _GL_CXXALIAS_SYS (mempcpy, void *, (void *restrict __dest, void const *restrict __src, size_t __n)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mempcpy); +# endif #elif defined GNULIB_POSIXCHECK # undef mempcpy # if HAVE_RAW_DECL_MEMPCPY @@ -336,7 +364,7 @@ _GL_CXXALIAS_SYS_CAST2 (memrchr, || defined __clang__) _GL_CXXALIASWARN1 (memrchr, void *, (void *, int, size_t) throw ()); _GL_CXXALIASWARN1 (memrchr, void const *, (void const *, int, size_t) throw ()); -# else +# elif __GLIBC__ >= 2 _GL_CXXALIASWARN (memrchr); # endif #elif defined GNULIB_POSIXCHECK @@ -347,6 +375,23 @@ _GL_WARN_ON_USE (memrchr, "memrchr is unportable - " # endif #endif +/* Overwrite a block of memory. The compiler will not optimize + effects away, even if the block is dead after the call. */ +#if @GNULIB_MEMSET_EXPLICIT@ +# if ! @HAVE_MEMSET_EXPLICIT@ +_GL_FUNCDECL_SYS (memset_explicit, void *, + (void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (memset_explicit, void *, (void *__dest, int __c, size_t __n)); +_GL_CXXALIASWARN (memset_explicit); +#elif defined GNULIB_POSIXCHECK +# undef memset_explicit +# if HAVE_RAW_DECL_MEMSET_EXPLICIT +_GL_WARN_ON_USE (memset_explicit, "memset_explicit is unportable - " + "use gnulib module memset_explicit for portability"); +# endif +#endif + /* Find the first occurrence of C in S. More efficient than memchr(S,C,N), at the expense of undefined behavior if C does not occur within N bytes. */ @@ -381,14 +426,28 @@ _GL_WARN_ON_USE (rawmemchr, "rawmemchr is unportable - " /* Copy SRC to DST, returning the address of the terminating '\0' in DST. */ #if @GNULIB_STPCPY@ -# if ! @HAVE_STPCPY@ +# if @REPLACE_STPCPY@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef stpcpy +# define stpcpy rpl_stpcpy +# endif +_GL_FUNCDECL_RPL (stpcpy, char *, + (char *restrict __dst, char const *restrict __src) + _GL_ARG_NONNULL ((1, 2))); +_GL_CXXALIAS_RPL (stpcpy, char *, + (char *restrict __dst, char const *restrict __src)); +# else +# if !@HAVE_STPCPY@ _GL_FUNCDECL_SYS (stpcpy, char *, (char *restrict __dst, char const *restrict __src) _GL_ARG_NONNULL ((1, 2))); -# endif +# endif _GL_CXXALIAS_SYS (stpcpy, char *, (char *restrict __dst, char const *restrict __src)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (stpcpy); +# endif #elif defined GNULIB_POSIXCHECK # undef stpcpy # if HAVE_RAW_DECL_STPCPY @@ -423,7 +482,9 @@ _GL_CXXALIAS_SYS (stpncpy, char *, (char *restrict __dst, char const *restrict __src, size_t __n)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (stpncpy); +# endif #elif defined GNULIB_POSIXCHECK # undef stpncpy # if HAVE_RAW_DECL_STPNCPY @@ -474,7 +535,7 @@ _GL_CXXALIAS_SYS_CAST2 (strchrnul, _GL_CXXALIASWARN1 (strchrnul, char *, (char *__s, int __c_in) throw ()); _GL_CXXALIASWARN1 (strchrnul, char const *, (char const *__s, int __c_in) throw ()); -# else +# elif __GLIBC__ >= 2 _GL_CXXALIASWARN (strchrnul); # endif #elif defined GNULIB_POSIXCHECK @@ -839,7 +900,7 @@ _GL_CXXALIASWARN1 (strcasestr, char *, (char *haystack, const char *needle) throw ()); _GL_CXXALIASWARN1 (strcasestr, const char *, (const char *haystack, const char *needle) throw ()); -# else +# elif __GLIBC__ >= 2 _GL_CXXALIASWARN (strcasestr); # endif #elif defined GNULIB_POSIXCHECK @@ -1187,7 +1248,7 @@ _GL_FUNCDECL_SYS (strerror_r, int, (int errnum, char *buf, size_t buflen) # endif _GL_CXXALIAS_SYS (strerror_r, int, (int errnum, char *buf, size_t buflen)); # endif -# if @HAVE_DECL_STRERROR_R@ +# if __GLIBC__ >= 2 && @HAVE_DECL_STRERROR_R@ _GL_CXXALIASWARN (strerror_r); # endif #elif defined GNULIB_POSIXCHECK diff --git a/lib/strtoimax.c b/lib/strtoimax.c index d8d74e8c699..f7977e28e64 100644 --- a/lib/strtoimax.c +++ b/lib/strtoimax.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an intmax_t value. - Copyright (C) 1999, 2001-2004, 2006, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 1999, 2001-2004, 2006, 2009-2023 Free Software Foundation, + Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/strtol.c b/lib/strtol.c index 6bc1f061877..d11269b2622 100644 --- a/lib/strtol.c +++ b/lib/strtol.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an integer value. - Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2023 Free - Software Foundation, Inc. + Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2023 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@gnu.org. diff --git a/lib/strtoll.c b/lib/strtoll.c index 919b453984c..9fdfa19b220 100644 --- a/lib/strtoll.c +++ b/lib/strtoll.c @@ -1,6 +1,6 @@ /* Function to parse a 'long long int' from text. - Copyright (C) 1995-1997, 1999, 2001, 2009-2023 Free Software - Foundation, Inc. + Copyright (C) 1995-1997, 1999, 2001, 2009-2023 Free Software Foundation, + Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index 096887c0162..0c2f39c12bf 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -549,7 +549,7 @@ _GL_FUNCDECL_SYS (futimens, int, (int fd, struct timespec const times[2])); # endif _GL_CXXALIAS_SYS (futimens, int, (int fd, struct timespec const times[2])); # endif -# if @HAVE_FUTIMENS@ +# if __GLIBC__ >= 2 && @HAVE_FUTIMENS@ _GL_CXXALIASWARN (futimens); # endif #elif defined GNULIB_POSIXCHECK @@ -716,7 +716,9 @@ _GL_FUNCDECL_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode) # endif _GL_CXXALIAS_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mkfifoat); +# endif #elif defined GNULIB_POSIXCHECK # undef mkfifoat # if HAVE_RAW_DECL_MKFIFOAT @@ -773,7 +775,9 @@ _GL_FUNCDECL_SYS (mknodat, int, _GL_CXXALIAS_SYS (mknodat, int, (int fd, char const *file, mode_t mode, dev_t dev)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mknodat); +# endif #elif defined GNULIB_POSIXCHECK # undef mknodat # if HAVE_RAW_DECL_MKNODAT @@ -937,7 +941,7 @@ _GL_FUNCDECL_SYS (utimensat, int, (int fd, char const *name, _GL_CXXALIAS_SYS (utimensat, int, (int fd, char const *name, struct timespec const times[2], int flag)); # endif -# if @HAVE_UTIMENSAT@ +# if __GLIBC__ >= 2 && @HAVE_UTIMENSAT@ _GL_CXXALIASWARN (utimensat); # endif #elif defined GNULIB_POSIXCHECK diff --git a/lib/time.in.h b/lib/time.in.h index a0e67f76b29..3f9af920e34 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -112,12 +112,24 @@ struct __time_t_must_be_integral { /* Set *TS to the current time, and return BASE. Upon failure, return 0. */ # if @GNULIB_TIMESPEC_GET@ -# if ! @HAVE_TIMESPEC_GET@ +# if @REPLACE_TIMESPEC_GET@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef timespec_get +# define timespec_get rpl_timespec_get +# endif +_GL_FUNCDECL_RPL (timespec_get, int, (struct timespec *ts, int base) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (timespec_get, int, (struct timespec *ts, int base)); +# else +# if !@HAVE_TIMESPEC_GET@ _GL_FUNCDECL_SYS (timespec_get, int, (struct timespec *ts, int base) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (timespec_get, int, (struct timespec *ts, int base)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (timespec_get); +# endif # endif /* Set *TS to the current time resolution, and return BASE. @@ -131,6 +143,20 @@ _GL_CXXALIAS_SYS (timespec_getres, int, (struct timespec *ts, int base)); _GL_CXXALIASWARN (timespec_getres); # endif +/* Return the number of seconds that have elapsed since the Epoch. */ +# if @GNULIB_TIME@ +# if @REPLACE_TIME@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define time rpl_time +# endif +_GL_FUNCDECL_RPL (time, time_t, (time_t *__tp)); +_GL_CXXALIAS_RPL (time, time_t, (time_t *__tp)); +# else +_GL_CXXALIAS_SYS (time, time_t, (time_t *__tp)); +# endif +_GL_CXXALIASWARN (time); +# endif + /* Sleep for at least RQTP seconds unless interrupted, If interrupted, return -1 and store the remaining time into RMTP. See <https://pubs.opengroup.org/onlinepubs/9699919799/functions/nanosleep.html>. */ @@ -315,6 +341,7 @@ _GL_CXXALIASWARN (strptime); # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # define ctime rpl_ctime # endif +_GL_ATTRIBUTE_DEPRECATED _GL_FUNCDECL_RPL (ctime, char *, (time_t const *__tp) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (ctime, char *, (time_t const *__tp)); @@ -422,7 +449,9 @@ _GL_FUNCDECL_SYS (timegm, time_t, (struct tm *__tm) _GL_ARG_NONNULL ((1))); # endif _GL_CXXALIAS_SYS (timegm, time_t, (struct tm *__tm)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (timegm); +# endif # endif /* Encourage applications to avoid unsafe functions that can overrun diff --git a/lib/time_r.c b/lib/time_r.c index c8143a6900a..97be4fd0544 100644 --- a/lib/time_r.c +++ b/lib/time_r.c @@ -1,7 +1,6 @@ /* Reentrant time functions like localtime_r. - Copyright (C) 2003, 2006-2007, 2010-2023 Free Software Foundation, - Inc. + Copyright (C) 2003, 2006-2007, 2010-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 4812fdb1120..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 @@ -541,17 +559,22 @@ _GL_CXXALIASWARN (dup2); Return newfd if successful, otherwise -1 and errno set. See the Linux man page at <https://www.kernel.org/doc/man-pages/online/pages/man2/dup3.2.html>. */ -# if @HAVE_DUP3@ +# if @REPLACE_DUP3@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef dup3 # define dup3 rpl_dup3 # endif _GL_FUNCDECL_RPL (dup3, int, (int oldfd, int newfd, int flags)); _GL_CXXALIAS_RPL (dup3, int, (int oldfd, int newfd, int flags)); # else +# if !@HAVE_DUP3@ _GL_FUNCDECL_SYS (dup3, int, (int oldfd, int newfd, int flags)); +# endif _GL_CXXALIAS_SYS (dup3, int, (int oldfd, int newfd, int flags)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (dup3); +# endif #elif defined GNULIB_POSIXCHECK # undef dup3 # if HAVE_RAW_DECL_DUP3 @@ -870,7 +893,9 @@ _GL_FUNCDECL_SYS (execvpe, int, _GL_CXXALIAS_SYS (execvpe, int, (const char *program, char * const *argv, char * const *env)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (execvpe); +# endif #elif defined GNULIB_POSIXCHECK # undef execvpe # if HAVE_RAW_DECL_EXECVPE @@ -925,7 +950,9 @@ _GL_FUNCDECL_SYS (faccessat, int, _GL_CXXALIAS_SYS (faccessat, int, (int fd, char const *file, int mode, int flag)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (faccessat); +# endif #elif defined GNULIB_POSIXCHECK # undef faccessat # if HAVE_RAW_DECL_FACCESSAT @@ -1002,11 +1029,22 @@ _GL_WARN_ON_USE (fchownat, "fchownat is not portable - " Return 0 if successful, otherwise -1 and errno set. See POSIX:2008 specification <https://pubs.opengroup.org/onlinepubs/9699919799/functions/fdatasync.html>. */ -# if !@HAVE_FDATASYNC@ || !@HAVE_DECL_FDATASYNC@ +# if @REPLACE_FDATASYNC@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef fdatasync +# define fdatasync rpl_fdatasync +# endif +_GL_FUNCDECL_RPL (fdatasync, int, (int fd)); +_GL_CXXALIAS_RPL (fdatasync, int, (int fd)); +# else +# if !@HAVE_FDATASYNC@|| !@HAVE_DECL_FDATASYNC@ _GL_FUNCDECL_SYS (fdatasync, int, (int fd)); -# endif +# endif _GL_CXXALIAS_SYS (fdatasync, int, (int fd)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (fdatasync); +# endif #elif defined GNULIB_POSIXCHECK # undef fdatasync # if HAVE_RAW_DECL_FDATASYNC @@ -1053,7 +1091,9 @@ _GL_FUNCDECL_SYS (ftruncate, int, (int fd, off_t length)); # endif _GL_CXXALIAS_SYS (ftruncate, int, (int fd, off_t length)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (ftruncate); +# endif #elif defined GNULIB_POSIXCHECK # undef ftruncate # if HAVE_RAW_DECL_FTRUNCATE @@ -1185,11 +1225,22 @@ _GL_WARN_ON_USE (getdtablesize, "getdtablesize is unportable - " #if @GNULIB_GETENTROPY@ /* Fill a buffer with random bytes. */ -# if !@HAVE_GETENTROPY@ +# if @REPLACE_GETENTROPY@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getentropy +# define getentropy rpl_getentropy +# endif +_GL_FUNCDECL_RPL (getentropy, int, (void *buffer, size_t length)); +_GL_CXXALIAS_RPL (getentropy, int, (void *buffer, size_t length)); +# else +# if !@HAVE_GETENTROPY@ _GL_FUNCDECL_SYS (getentropy, int, (void *buffer, size_t length)); -# endif +# endif _GL_CXXALIAS_SYS (getentropy, int, (void *buffer, size_t length)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getentropy); +# endif #elif defined GNULIB_POSIXCHECK # undef getentropy # if HAVE_RAW_DECL_GETENTROPY @@ -1323,7 +1374,9 @@ _GL_FUNCDECL_SYS (getlogin_r, int, (char *name, size_t size) int size. */ _GL_CXXALIAS_SYS_CAST (getlogin_r, int, (char *name, size_t size)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getlogin_r); +# endif #elif defined GNULIB_POSIXCHECK # undef getlogin_r # if HAVE_RAW_DECL_GETLOGIN_R @@ -1661,7 +1714,9 @@ _GL_CXXALIAS_SYS (linkat, int, (int fd1, const char *path1, int fd2, const char *path2, int flag)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (linkat); +# endif #elif defined GNULIB_POSIXCHECK # undef linkat # if HAVE_RAW_DECL_LINKAT @@ -1742,8 +1797,9 @@ _GL_WARN_ON_USE (pipe, "pipe is unportable - " Return 0 upon success, or -1 with errno set upon failure. See also the Linux man page at <https://www.kernel.org/doc/man-pages/online/pages/man2/pipe2.2.html>. */ -# if @HAVE_PIPE2@ +# if @REPLACE_PIPE2@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef pipe2 # define pipe2 rpl_pipe2 # endif _GL_FUNCDECL_RPL (pipe2, int, (int fd[2], int flags) _GL_ARG_NONNULL ((1))); @@ -1752,7 +1808,9 @@ _GL_CXXALIAS_RPL (pipe2, int, (int fd[2], int flags)); _GL_FUNCDECL_SYS (pipe2, int, (int fd[2], int flags) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_SYS (pipe2, int, (int fd[2], int flags)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (pipe2); +# endif #elif defined GNULIB_POSIXCHECK # undef pipe2 # if HAVE_RAW_DECL_PIPE2 @@ -1787,7 +1845,9 @@ _GL_FUNCDECL_SYS (pread, ssize_t, _GL_CXXALIAS_SYS (pread, ssize_t, (int fd, void *buf, size_t bufsize, off_t offset)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (pread); +# endif #elif defined GNULIB_POSIXCHECK # undef pread # if HAVE_RAW_DECL_PREAD @@ -1822,7 +1882,9 @@ _GL_FUNCDECL_SYS (pwrite, ssize_t, _GL_CXXALIAS_SYS (pwrite, ssize_t, (int fd, const void *buf, size_t bufsize, off_t offset)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (pwrite); +# endif #elif defined GNULIB_POSIXCHECK # undef pwrite # if HAVE_RAW_DECL_PWRITE @@ -1936,7 +1998,9 @@ _GL_CXXALIAS_SYS (readlinkat, ssize_t, (int fd, char const *restrict file, char *restrict buf, size_t len)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (readlinkat); +# endif #elif defined GNULIB_POSIXCHECK # undef readlinkat # if HAVE_RAW_DECL_READLINKAT @@ -1996,15 +2060,27 @@ _GL_CXXALIASWARN (rmdir); Platforms with no ability to set the hostname return -1 and set errno = ENOSYS. */ -# if !@HAVE_SETHOSTNAME@ || !@HAVE_DECL_SETHOSTNAME@ +# if @REPLACE_SETHOSTNAME@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef sethostname +# define sethostname rpl_sethostname +# endif +_GL_FUNCDECL_RPL (sethostname, int, (const char *name, size_t len) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (sethostname, int, (const char *name, size_t len)); +# else +# if !@HAVE_SETHOSTNAME@ || !@HAVE_DECL_SETHOSTNAME@ _GL_FUNCDECL_SYS (sethostname, int, (const char *name, size_t len) _GL_ARG_NONNULL ((1))); -# endif +# endif /* Need to cast, because on Solaris 11 2011-10, Mac OS X 10.5, IRIX 6.5 and FreeBSD 6.4 the second parameter is int. On Solaris 11 2011-10, the first parameter is not const. */ _GL_CXXALIAS_SYS_CAST (sethostname, int, (const char *name, size_t len)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (sethostname); +# endif #elif defined GNULIB_POSIXCHECK # undef sethostname # if HAVE_RAW_DECL_SETHOSTNAME @@ -2113,7 +2189,9 @@ _GL_FUNCDECL_SYS (symlinkat, int, _GL_CXXALIAS_SYS (symlinkat, int, (char const *contents, int fd, char const *file)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (symlinkat); +# endif #elif defined GNULIB_POSIXCHECK # undef symlinkat # if HAVE_RAW_DECL_SYMLINKAT @@ -2143,7 +2221,9 @@ _GL_FUNCDECL_SYS (truncate, int, (const char *filename, off_t length) # endif _GL_CXXALIAS_SYS (truncate, int, (const char *filename, off_t length)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (truncate); +# endif #elif defined GNULIB_POSIXCHECK # undef truncate # if HAVE_RAW_DECL_TRUNCATE @@ -2173,7 +2253,9 @@ _GL_FUNCDECL_SYS (ttyname_r, int, _GL_CXXALIAS_SYS (ttyname_r, int, (int fd, char *buf, size_t buflen)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (ttyname_r); +# endif #elif defined GNULIB_POSIXCHECK # undef ttyname_r # if HAVE_RAW_DECL_TTYNAME_R diff --git a/lib/verify.h b/lib/verify.h index d4beccad96a..f0b3fc5851b 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -37,7 +37,7 @@ && (4 < __GNUC__ + (6 <= __GNUC_MINOR__) || 5 <= __clang_major__))) # define _GL_HAVE__STATIC_ASSERT 1 # endif -# if (202000 <= __STDC_VERSION__ \ +# if (202311 <= __STDC_VERSION__ \ || (!defined __STRICT_ANSI__ && 9 <= __GNUC__)) # define _GL_HAVE__STATIC_ASSERT1 1 # endif @@ -222,10 +222,32 @@ template <int w> /* _GL_STATIC_ASSERT_H is defined if this code is copied into assert.h. */ #ifdef _GL_STATIC_ASSERT_H -# if !defined _GL_HAVE__STATIC_ASSERT1 && !defined _Static_assert -# define _Static_assert(R, ...) \ - _GL_VERIFY ((R), "static assertion failed", -) +/* Define _Static_assert if needed. */ +/* With clang ≥ 3.8.0 in C++ mode, _Static_assert already works and accepts + 1 or 2 arguments. We better don't override it, because clang's standard + C++ library uses static_assert inside classes in several places, and our + replacement via _GL_VERIFY does not work in these contexts. */ +# if (defined __cplusplus && defined __clang__ \ + && (4 <= __clang_major__ + (8 <= __clang_minor__))) +# if 5 <= __clang_major__ +/* Avoid "warning: 'static_assert' with no message is a C++17 extension". */ +# pragma clang diagnostic ignored "-Wc++17-extensions" +# else +/* Avoid "warning: static_assert with no message is a C++1z extension". */ +# pragma clang diagnostic ignored "-Wc++1z-extensions" +# endif +# elif !defined _GL_HAVE__STATIC_ASSERT1 && !defined _Static_assert +# if !defined _MSC_VER || defined __clang__ +# define _Static_assert(...) \ + _GL_VERIFY (__VA_ARGS__, "static assertion failed", -) +# else + /* Work around MSVC preprocessor incompatibility with ISO C; see + <https://stackoverflow.com/questions/5134523/>. */ +# define _Static_assert(R, ...) \ + _GL_VERIFY ((R), "static assertion failed", -) +# endif # endif +/* Define static_assert if needed. */ # if (!defined static_assert \ && __STDC_VERSION__ < 202311 \ && (!defined __cplusplus \ @@ -235,15 +257,16 @@ template <int w> /* MSVC 14 in C++ mode supports the two-arguments static_assert but not the one-argument static_assert, and it does not support _Static_assert. We have to play preprocessor tricks to distinguish the two cases. - Since the MSVC preprocessor is not ISO C compliant (cf. - <https://stackoverflow.com/questions/5134523/>), the solution is specific - to MSVC. */ + Since the MSVC preprocessor is not ISO C compliant (see above),. + the solution is specific to MSVC. */ # define _GL_EXPAND(x) x # define _GL_SA1(a1) static_assert ((a1), "static assertion failed") # define _GL_SA2 static_assert # 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 @@ -252,7 +275,9 @@ template <int w> /* @assert.h omit start@ */ -#if 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__)) +#if defined __clang_major__ && __clang_major__ < 5 +# define _GL_HAS_BUILTIN_TRAP 0 +#elif 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__)) # define _GL_HAS_BUILTIN_TRAP 1 #elif defined __has_builtin # define _GL_HAS_BUILTIN_TRAP __has_builtin (__builtin_trap) @@ -260,7 +285,9 @@ template <int w> # define _GL_HAS_BUILTIN_TRAP 0 #endif -#if 4 < __GNUC__ + (5 <= __GNUC_MINOR__) +#if defined __clang_major__ && __clang_major__ < 5 +# define _GL_HAS_BUILTIN_UNREACHABLE 0 +#elif 4 < __GNUC__ + (5 <= __GNUC_MINOR__) # define _GL_HAS_BUILTIN_UNREACHABLE 1 #elif defined __has_builtin # define _GL_HAS_BUILTIN_UNREACHABLE __has_builtin (__builtin_unreachable) diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index 05ef7028137..5dbdfb5506a 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -1,7 +1,6 @@ /* xalloc-oversized.h -- memory allocation size checking - Copyright (C) 1990-2000, 2003-2004, 2006-2023 Free Software - Foundation, Inc. + Copyright (C) 1990-2000, 2003-2004, 2006-2023 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 550d956fb7b..1a665efb0a5 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -501,7 +501,7 @@ PROPS is a list of properties." (defun abbrev-table-p (object) "Return non-nil if OBJECT is an abbrev table." (and (obarrayp object) - (numberp (ignore-error 'wrong-type-argument + (numberp (ignore-error wrong-type-argument (abbrev-table-get object :abbrev-table-modiff))))) (defun abbrev-table-empty-p (object &optional ignore-system) @@ -1250,17 +1250,17 @@ which see." ;; asked to. (and save-abbrevs abbrevs-changed - (progn - (if (or arg - (eq save-abbrevs 'silently) - (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) - (progn - (write-abbrev-file nil) - nil) - ;; Don't keep bothering user if they say no. - (setq abbrevs-changed nil) - ;; Inhibit message in `save-some-buffers'. - t))))) + (prog1 + (if (or arg + (eq save-abbrevs 'silently) + (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) + (progn + (write-abbrev-file nil) + nil) + ;; Inhibit message in `save-some-buffers'. + t) + ;; Don't ask again whether saved or user said no. + (setq abbrevs-changed nil))))) (add-hook 'save-some-buffers-functions #'abbrev--possibly-save) diff --git a/lisp/apropos.el b/lisp/apropos.el index 5d7fe6962a5..e95f45f1804 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -54,6 +54,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup apropos nil "Apropos commands for users and programmers." :group 'help @@ -193,9 +195,6 @@ property list, WIDGET-DOC is the widget docstring, FACE-DOC is the face docstring, and CUS-GROUP-DOC is the custom group docstring. Each docstring is either nil or a string.") -(defvar apropos-item () - "Current item in or for `apropos-accumulator'.") - (defvar apropos-synonyms '( ("find" "open" "edit") ("kill" "cut") @@ -906,6 +905,18 @@ Optional arg BUFFER (default: current buffer) is the buffer to check." ((symbolp def) (funcall f def)) ((eq 'defun (car-safe def)) (funcall f (cdr def))))))))) +(defun apropos--documentation-add (symbol doc pos) + (when (setq doc (apropos-documentation-internal doc)) + (let ((score (apropos-score-doc doc)) + (item (cdr (assq symbol apropos-accumulator)))) + (unless item + (push (cons symbol + (setq item (list (apropos-score-symbol symbol 2) + nil nil))) + apropos-accumulator)) + (setf (nth pos item) doc) + (setcar item (+ (car item) score))))) + ;;;###autoload (defun apropos-documentation (pattern &optional do-all) "Show symbols whose documentation contains matches for PATTERN. @@ -928,40 +939,28 @@ Returns list of symbols and documentation found." (setq apropos--current (list #'apropos-documentation pattern do-all)) (apropos-parse-pattern pattern t) (or do-all (setq do-all apropos-do-all)) - (setq apropos-accumulator () apropos-files-scanned ()) - (with-temp-buffer - (let ((standard-input (current-buffer)) - (apropos-sort-by-scores apropos-documentation-sort-by-scores) - f v sf sv) - (apropos-documentation-check-doc-file) - (funcall - (if do-all #'mapatoms #'apropos--map-preloaded-atoms) - (lambda (symbol) - (setq f (apropos-safe-documentation symbol) - v (get symbol 'variable-documentation)) - (if (integerp v) (setq v nil)) - (setq f (apropos-documentation-internal f) - v (apropos-documentation-internal v)) - (setq sf (apropos-score-doc f) - sv (apropos-score-doc v)) - (if (or f v) - (if (setq apropos-item - (cdr (assq symbol apropos-accumulator))) - (progn - (if f - (progn - (setcar (nthcdr 1 apropos-item) f) - (setcar apropos-item (+ (car apropos-item) sf)))) - (if v - (progn - (setcar (nthcdr 2 apropos-item) v) - (setcar apropos-item (+ (car apropos-item) sv))))) - (setq apropos-accumulator - (cons (list symbol - (+ (apropos-score-symbol symbol 2) sf sv) - f v) - apropos-accumulator)))))) - (apropos-print nil "\n----------------\n" nil t)))) + (let ((apropos-accumulator ()) + (apropos-files-scanned ()) + (delayed (make-hash-table :test #'equal))) + (with-temp-buffer + (let ((standard-input (current-buffer)) + (apropos-sort-by-scores apropos-documentation-sort-by-scores) + f v) + (apropos-documentation-check-doc-file) + (funcall + (if do-all #'mapatoms #'apropos--map-preloaded-atoms) + (lambda (symbol) + (setq f (apropos-safe-documentation symbol) + v (get symbol 'variable-documentation)) + (if (integerp v) (setq v nil)) + (if (consp f) + (push (list symbol (cdr f) 1) (gethash (car f) delayed)) + (apropos--documentation-add symbol f 1)) + (if (consp v) + (push (list symbol (cdr v) 2) (gethash (car v) delayed)) + (apropos--documentation-add symbol v 2)))) + (maphash #'apropos--documentation-add-from-elc delayed) + (apropos-print nil "\n----------------\n" nil t))))) (defun apropos-value-internal (predicate symbol function) @@ -982,11 +981,11 @@ Returns list of symbols and documentation found." symbol))) (defun apropos-documentation-internal (doc) + ;; By the time we get here, refs to DOC or to .elc files should have + ;; been converted into actual strings. + (cl-assert (not (or (consp doc) (integerp doc)))) (cond - ((consp doc) - (apropos-documentation-check-elc-file (car doc))) - ((and doc - ;; Sanity check in case bad data sneaked into the + ((and ;; Sanity check in case bad data sneaked into the ;; documentation slot. (stringp doc) (string-match apropos-all-words-regexp doc) @@ -1053,110 +1052,62 @@ non-nil." ;; So we exclude them. (cond ((= 3 type) (boundp symbol)) ((= 2 type) (fboundp symbol)))) - (or (and (setq apropos-item (assq symbol apropos-accumulator)) - (setcar (cdr apropos-item) - (apropos-score-doc doc))) - (setq apropos-item (list symbol - (+ (apropos-score-symbol symbol 2) - (apropos-score-doc doc)) - nil nil) - apropos-accumulator (cons apropos-item - apropos-accumulator))) - (when apropos-match-face - (setq doc (substitute-command-keys doc)) - (if (or (string-match apropos-pattern-quoted doc) - (string-match apropos-all-words-regexp doc)) - (put-text-property (match-beginning 0) - (match-end 0) - 'face apropos-match-face doc))) - (setcar (nthcdr type apropos-item) doc)))) + (let ((apropos-item (assq symbol apropos-accumulator))) + (or (and apropos-item + (setcar (cdr apropos-item) + (apropos-score-doc doc))) + (setq apropos-item (list symbol + (+ (apropos-score-symbol symbol 2) + (apropos-score-doc doc)) + nil nil) + apropos-accumulator (cons apropos-item + apropos-accumulator))) + (when apropos-match-face + (setq doc (substitute-command-keys doc)) + (if (or (string-match apropos-pattern-quoted doc) + (string-match apropos-all-words-regexp doc)) + (put-text-property (match-beginning 0) + (match-end 0) + 'face apropos-match-face doc))) + (setcar (nthcdr type apropos-item) doc))))) (setq sepa (goto-char sepb))))) -(defun apropos-documentation-check-elc-file (file) - ;; .elc files have the location of the file specified as #$, but for - ;; built-in files, that's a relative name (while for the rest, it's - ;; absolute). So expand the name in the former case. - (unless (file-name-absolute-p file) - (setq file (expand-file-name file lisp-directory))) - (if (or (member file apropos-files-scanned) - (not (file-exists-p file))) - nil - (let (symbol doc beg end this-is-a-variable) - (setq apropos-files-scanned (cons file apropos-files-scanned)) - (erase-buffer) - (insert-file-contents file) - (while (search-forward "#@" nil t) - ;; Read the comment length, and advance over it. - ;; This #@ may be a false positive, so don't get upset if - ;; it's not followed by the expected number of bytes to skip. - (when (and (setq end (ignore-errors (read))) (natnump end)) - (setq beg (1+ (point)) - end (+ (point) end -1)) - (forward-char) - (if (save-restriction - ;; match ^ and $ relative to doc string - (narrow-to-region beg end) - (re-search-forward apropos-all-words-regexp nil t)) - (progn - (goto-char (+ end 2)) - (setq doc (buffer-substring beg end) - end (- (match-end 0) beg) - beg (- (match-beginning 0) beg)) - (when (apropos-true-hit-doc doc) - (setq this-is-a-variable (looking-at "(def\\(var\\|const\\) ") - symbol (progn - (skip-chars-forward "(a-z") - (forward-char) - (read)) - symbol (if (consp symbol) - (nth 1 symbol) - symbol)) - (if (if this-is-a-variable - (get symbol 'variable-documentation) - (and (fboundp symbol) (apropos-safe-documentation symbol))) - (progn - (or (and (setq apropos-item (assq symbol apropos-accumulator)) - (setcar (cdr apropos-item) - (+ (cadr apropos-item) (apropos-score-doc doc)))) - (setq apropos-item (list symbol - (+ (apropos-score-symbol symbol 2) - (apropos-score-doc doc)) - nil nil) - apropos-accumulator (cons apropos-item - apropos-accumulator))) - (when apropos-match-face - (setq doc (substitute-command-keys doc)) - (if (or (string-match apropos-pattern-quoted doc) - (string-match apropos-all-words-regexp doc)) - (put-text-property (match-beginning 0) - (match-end 0) - 'face apropos-match-face doc))) - (setcar (nthcdr (if this-is-a-variable 3 2) - apropos-item) - doc))))))))))) - - +(defun apropos--documentation-add-from-elc (file defs) + (erase-buffer) + (insert-file-contents + (if (file-name-absolute-p file) file + (expand-file-name file lisp-directory))) + (pcase-dolist (`(,symbol ,begbyte ,pos) defs) + ;; We presume the file-bytes are the same as the buffer bytes, + ;; which should indeed be the case because .elc files use the + ;; `emacs-internal' encoding. + (let* ((beg (byte-to-position (+ (point-min) begbyte))) + (sizeend (1- beg)) + (size (save-excursion + (goto-char beg) + (skip-chars-backward " 0-9") + (cl-assert (looking-back "#@" (- (point) 2))) + (string-to-number (buffer-substring (point) sizeend)))) + (end (byte-to-position (+ begbyte size -1)))) + (when (save-restriction + ;; match ^ and $ relative to doc string + (narrow-to-region beg end) + (goto-char (point-min)) + (re-search-forward apropos-all-words-regexp nil t)) + (let ((doc (buffer-substring beg end))) + (when (apropos-true-hit-doc doc) + (apropos--documentation-add symbol doc pos))))))) (defun apropos-safe-documentation (function) "Like `documentation', except it avoids calling `get_doc_string'. Will return nil instead." - (while (and function (symbolp function)) - (setq function (symbol-function function))) - (if (eq (car-safe function) 'macro) - (setq function (cdr function))) - (setq function (if (byte-code-function-p function) - (if (> (length function) 4) - (aref function 4)) - (if (autoloadp function) - (nth 2 function) - (if (eq (car-safe function) 'lambda) - (if (stringp (nth 2 function)) - (nth 2 function) - (if (stringp (nth 3 function)) - (nth 3 function))))))) - (if (integerp function) - nil - function)) + (when (setq function (indirect-function function)) + ;; FIXME: `function-documentation' says not to call it, but `documentation' + ;; would turn (FILE . POS) references into strings too eagerly, so + ;; we do want to use the lower-level function. + (let ((doc (function-documentation function))) + ;; Docstrings from the DOC file are handled elsewhere. + (if (integerp doc) nil doc)))) (defcustom apropos-compact-layout nil "If non-nil, use a single line per binding." @@ -1262,14 +1213,16 @@ as a heading." (put-text-property (- (point) 3) (point) 'face 'apropos-keybinding))) (terpri)) - (apropos-print-doc 2 + (apropos-print-doc apropos-item + 2 (if (commandp symbol) 'apropos-command (if (macrop symbol) 'apropos-macro 'apropos-function)) (not nosubst)) - (apropos-print-doc 3 + (apropos-print-doc apropos-item + 3 (if (custom-variable-p symbol) 'apropos-user-option 'apropos-variable) @@ -1287,10 +1240,10 @@ as a heading." (lambda (_) (message "Value: %s" value)))) (insert "\n"))) - (apropos-print-doc 7 'apropos-group t) - (apropos-print-doc 6 'apropos-face t) - (apropos-print-doc 5 'apropos-widget t) - (apropos-print-doc 4 'apropos-plist nil)) + (apropos-print-doc apropos-item 7 'apropos-group t) + (apropos-print-doc apropos-item 6 'apropos-face t) + (apropos-print-doc apropos-item 5 'apropos-widget t) + (apropos-print-doc apropos-item 4 'apropos-plist nil)) (setq-local truncate-partial-width-windows t) (setq-local truncate-lines t))) (when help-window-select @@ -1298,7 +1251,7 @@ as a heading." (prog1 apropos-accumulator (setq apropos-accumulator ()))) ; permit gc -(defun apropos-print-doc (i type do-keys) +(defun apropos-print-doc (apropos-item i type do-keys) (let ((doc (nth i apropos-item))) (when (stringp doc) (if apropos-compact-layout diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 6f3e922880d..5e696c091b2 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1093,7 +1093,9 @@ NEW-NAME." (with-temp-buffer (set-buffer-multibyte nil) (archive--extract-file extractor copy ename) - (write-region (point-min) (point-max) write-to)) + (let ((coding-system-for-write + (or coding-system-for-write 'no-conversion))) + (write-region (point-min) (point-max) write-to))) (unless (equal copy archive) (delete-file copy)))))))) @@ -1954,10 +1956,21 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: Zip Archives +(declare-function w32-get-console-codepage "w32proc.c") (defun archive-zip-summarize () (goto-char (- (point-max) (- 22 18))) (search-backward-regexp "[P]K\005\006") (let ((p (archive-l-e (+ (point) 16) 4)) + (w32-fname-encoding + ;; On MS-Windows, both InfoZip's Zip and the system's + ;; built-in File Explorer use the console codepage for + ;; encoding file names. Problem: the codepage of the system + ;; where the zip file was created cannot be known; we assume + ;; it is the same as the one of the current system. Also, + ;; the zip file doesn't tell us the OS where the file was + ;; created, it only tells the filesystem. + (if (eq system-type 'windows-nt) + (intern (format "cp%d" (w32-get-console-codepage))))) files) (when (or (= p #xffffffff) (= p -1)) ;; If the offset of end-of-central-directory is 0xFFFFFFFF, this @@ -1987,7 +2000,15 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; (lheader (archive-l-e (+ p 42) 4)) (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen)))) (decode-coding-string - str archive-file-name-coding-system))) + str + (or (if (and w32-fname-encoding + (memq creator + ;; This should be just 10 and + ;; 14, but InfoZip uses 0 and + ;; File Explorer uses 11(??). + '(0 10 11 14))) + w32-fname-encoding) + archive-file-name-coding-system)))) (ucsize (if (and (or (= ucsize #xffffffff) (= ucsize -1)) (> exlen 0)) ;; APPNOTE.TXT, para 4.5.3: the Extra Field diff --git a/lisp/bindings.el b/lisp/bindings.el index 34aa8399a96..c77b64c05da 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -670,6 +670,8 @@ or not." "Return the value of symbol VAR if it is bound, else nil. Note that if `lexical-binding' is in effect, this function isn't meaningful if it refers to a lexically bound variable." + (unless (symbolp var) + (signal 'wrong-type-argument (list 'symbolp var))) `(and (boundp (quote ,var)) ,var)) ;; Use mode-line-mode-menu for local minor-modes only. @@ -1009,7 +1011,7 @@ if `inhibit-field-text-motion' is non-nil." ;; no idea whereas to bind it. Any suggestion welcome. -stef ;; (define-key ctl-x-map "U" 'undo-only) (defvar-keymap undo-repeat-map - :doc "Keymap to repeat undo key sequences \\`C-x u u'. Used in `repeat-mode'." + :doc "Keymap to repeat `undo' commands. Used in `repeat-mode'." :repeat t "u" #'undo) @@ -1106,7 +1108,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "`" 'next-error) (defvar-keymap next-error-repeat-map - :doc "Keymap to repeat `next-error' key sequences. Used in `repeat-mode'." + :doc "Keymap to repeat `next-error' and `previous-error'. Used in `repeat-mode'." :repeat t "n" #'next-error "M-n" #'next-error @@ -1468,7 +1470,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "]" 'forward-page) (defvar-keymap page-navigation-repeat-map - :doc "Keymap to repeat page navigation key sequences. Used in `repeat-mode'." + :doc "Keymap to repeat `forward-page' and `backward-page'. Used in `repeat-mode'." :repeat t "]" #'forward-page "[" #'backward-page) diff --git a/lisp/bs.el b/lisp/bs.el index 60dc74fbfce..70868591196 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -420,9 +420,6 @@ naming a sort behavior. Default is \"by nothing\" which means no sorting." Non-nil means to show all buffers. Otherwise show buffers defined by current configuration `bs-current-configuration'.") -(defvar bs--window-config-coming-from nil - "Window configuration before starting Buffer Selection Menu.") - (defvar bs--intern-show-never "^ \\|\\*buffer-selection\\*" "Regular expression specifying which buffers never to show. A buffer whose name matches this regular expression will never be @@ -491,6 +488,23 @@ Used internally, only.") "<mouse-2>" #'bs-mouse-select "<mouse-3>" #'bs-mouse-select-other-frame) +(defcustom bs-default-action-list '((display-buffer-reuse-window + display-buffer-below-selected) + (reusable-frames . nil) + (window-height . window-min-height)) + "Default action list for showing the '*bs-selection*' buffer. + +This list will be passed to `pop-to-buffer' as its ACTION argument. +It should be a cons cell (FUNCTIONS . ALIST), where FUNCTIONS is +an action function or a list of action functions and ALIST is an +action alist. Each such action function should accept two +arguments: a buffer to display and an alist of the same form as +ALIST. See `display-buffer' for details." + :type display-buffer--action-custom-type + :risky t + :version "30.1" + :group 'bs) + ;; ---------------------------------------------------------------------- ;; Functions ;; ---------------------------------------------------------------------- @@ -590,21 +604,6 @@ in `bs-string-current' or `bs-string-current-marked'." (format "Show buffer by configuration %S" bs-current-configuration))) -(defun bs--track-window-changes (frame) - "Track window changes to refresh the buffer list. -Used from `window-size-change-functions'." - (let ((win (get-buffer-window "*buffer-selection*" frame))) - (when win - (with-selected-window win - (bs--set-window-height))))) - -(defun bs--remove-hooks () - "Remove `bs--track-window-changes' and auxiliary hooks." - (remove-hook 'window-size-change-functions 'bs--track-window-changes) - ;; Remove itself - (remove-hook 'kill-buffer-hook 'bs--remove-hooks t) - (remove-hook 'change-major-mode-hook 'bs--remove-hooks t)) - (put 'bs-mode 'mode-class 'special) (define-derived-mode bs-mode nil "Buffer-Selection-Menu" @@ -663,25 +662,13 @@ apply it. (setq-local font-lock-defaults '(bs-mode-font-lock-keywords t)) (setq-local font-lock-verbose nil) (setq-local font-lock-global-modes '(not bs-mode)) - (setq-local revert-buffer-function 'bs-refresh) - (add-hook 'window-size-change-functions 'bs--track-window-changes) - (add-hook 'kill-buffer-hook 'bs--remove-hooks nil t) - (add-hook 'change-major-mode-hook 'bs--remove-hooks nil t)) - -(defun bs--restore-window-config () - "Restore window configuration on the current frame." - (when bs--window-config-coming-from - (let ((frame (selected-frame))) - (unwind-protect - (set-window-configuration bs--window-config-coming-from) - (select-frame frame))) - (setq bs--window-config-coming-from nil))) + (setq-local revert-buffer-function 'bs-refresh)) (defun bs-kill () "Let buffer disappear and reset window configuration." (interactive) (bury-buffer (current-buffer)) - (bs--restore-window-config)) + (quit-window)) (defun bs-abort () "Ding and leave Buffer Selection Menu without a selection." @@ -705,7 +692,9 @@ Arguments are IGNORED (for `revert-buffer')." (defun bs--set-window-height () "Change the height of the selected window to suit the current buffer list." (unless (one-window-p t) - (fit-window-to-buffer (selected-window) bs-max-window-height))) + (fit-window-to-buffer (selected-window) bs-max-window-height nil nil nil + ;; preserve-size + t))) (defun bs--current-buffer () "Return buffer on current line. @@ -742,7 +731,7 @@ Leave Buffer Selection Menu." (interactive) (let ((buffer (bs--current-buffer))) (bury-buffer (current-buffer)) - (bs--restore-window-config) + (quit-window) (switch-to-buffer buffer) (when bs--marked-buffers ;; Some marked buffers for selection @@ -765,7 +754,7 @@ Leave Buffer Selection Menu." (interactive) (let ((buffer (bs--current-buffer))) (bury-buffer (current-buffer)) - (bs--restore-window-config) + (quit-window) (switch-to-buffer-other-window buffer))) (defun bs-tmp-select-other-window () @@ -781,7 +770,7 @@ Leave Buffer Selection Menu." (interactive) (let ((buffer (bs--current-buffer))) (bury-buffer (current-buffer)) - (bs--restore-window-config) + (quit-window) (switch-to-buffer-other-frame buffer))) (defun bs-mouse-select-other-frame (event) @@ -944,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))) @@ -1165,7 +1154,18 @@ Select buffer *buffer-selection* and display buffers according to current configuration `bs-current-configuration'. Set window height, fontify buffer and move point to current buffer." (setq bs-current-list list) - (switch-to-buffer (get-buffer-create "*buffer-selection*")) + (let* ((window-combination-limit 'window-size) + (bs-buf (get-buffer-create "*buffer-selection*")) + (bs-win (progn + (pop-to-buffer bs-buf bs-default-action-list) + (selected-window)))) + ;; Delete other windows showing *buffer-selection*. + ;; Done after pop-to-buffer, instead of just calling delete-windows-on, + ;; to allow display-buffer-reuse(-mode)?-window to be used in ALIST. + (dolist (w (get-buffer-window-list bs-buf 'not t)) + (unless (eq w bs-win) + (with-demoted-errors "Error deleting window: %S" + (delete-window w))))) (bs-mode) (let* ((inhibit-read-only t) (map-fun (lambda (entry) @@ -1346,11 +1346,11 @@ ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu." 'help-echo "mouse-2: select this buffer, mouse-3: select in other frame" 'mouse-face 'highlight)) -(defun bs--get-mode-name (start-buffer _all-buffers) +(defun bs--get-mode-name (_start-buffer _all-buffers) "Return the name of mode of current buffer for Buffer Selection Menu. START-BUFFER is the buffer where we started buffer selection. ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu." - (format-mode-line mode-name nil nil start-buffer)) + (format-mode-line mode-name nil nil nil)) (defun bs--get-file-name (_start-buffer _all-buffers) "Return string for column `File' in Buffer Selection Menu. @@ -1435,21 +1435,8 @@ for buffer selection." ;; Only when not in buffer *buffer-selection* ;; we have to set the buffer we started the command (setq bs--buffer-coming-from (current-buffer))) - (let ((liste (bs-buffer-list)) - (active-window (get-window-with-predicate - (lambda (w) - (string= (buffer-name (window-buffer w)) - "*buffer-selection*")) - nil (selected-frame)))) - (if active-window - (select-window active-window) - (bs--restore-window-config) - (setq bs--window-config-coming-from (current-window-configuration)) - (when (> (window-height) 7) - ;; Errors would mess with the window configuration (bug#10882). - (ignore-errors (select-window (split-window-below))))) - (bs-show-in-buffer liste) - (bs-message-without-log "%s" (bs--current-config-message))))) + (bs-show-in-buffer (bs-buffer-list)) + (bs-message-without-log "%s" (bs--current-config-message)))) (defun bs--configuration-name-for-prefix-arg (prefix) "Convert prefix argument PREFIX to a name of a buffer configuration. 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-units.el b/lisp/calc/calc-units.el index 5e21d506d74..988fef2fcd2 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -319,28 +319,28 @@ that the combined units table will be rebuilt.") (defvar math-unit-prefixes '( ( ?Q (^ 10 30) "quetta" ) ( ?R (^ 10 27) "ronna" ) - ( ?Y (^ 10 24) "Yotta" ) - ( ?Z (^ 10 21) "Zetta" ) - ( ?E (^ 10 18) "Exa" ) - ( ?P (^ 10 15) "Peta" ) - ( ?T (^ 10 12) "Tera" ) - ( ?G (^ 10 9) "Giga" ) - ( ?M (^ 10 6) "Mega" ) - ( ?k (^ 10 3) "Kilo" ) - ( ?K (^ 10 3) "Kilo" ) - ( ?h (^ 10 2) "Hecto" ) - ( ?H (^ 10 2) "Hecto" ) - ( ?D (^ 10 1) "Deka" ) + ( ?Y (^ 10 24) "yotta" ) + ( ?Z (^ 10 21) "zetta" ) + ( ?E (^ 10 18) "exa" ) + ( ?P (^ 10 15) "peta" ) + ( ?T (^ 10 12) "tera" ) + ( ?G (^ 10 9) "giga" ) + ( ?M (^ 10 6) "mega" ) + ( ?k (^ 10 3) "kilo" ) + ( ?K (^ 10 3) "kilo" ) + ( ?h (^ 10 2) "hecto" ) + ( ?H (^ 10 2) "hecto" ) + ( ?D (^ 10 1) "deka" ) ( 0 (^ 10 0) nil ) - ( ?d (^ 10 -1) "Deci" ) - ( ?c (^ 10 -2) "Centi" ) - ( ?m (^ 10 -3) "Milli" ) - ( ?u (^ 10 -6) "Micro" ) - ( ?μ (^ 10 -6) "Micro" ) - ( ?n (^ 10 -9) "Nano" ) - ( ?p (^ 10 -12) "Pico" ) - ( ?f (^ 10 -15) "Femto" ) - ( ?a (^ 10 -18) "Atto" ) + ( ?d (^ 10 -1) "deci" ) + ( ?c (^ 10 -2) "centi" ) + ( ?m (^ 10 -3) "milli" ) + ( ?u (^ 10 -6) "micro" ) + ( ?μ (^ 10 -6) "micro" ) + ( ?n (^ 10 -9) "nano" ) + ( ?p (^ 10 -12) "pico" ) + ( ?f (^ 10 -15) "femto" ) + ( ?a (^ 10 -18) "atto" ) ( ?z (^ 10 -21) "zepto" ) ( ?y (^ 10 -24) "yocto" ) ( ?r (^ 10 -27) "ronto" ) 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/appt.el b/lisp/calendar/appt.el index a209623b65e..49597739446 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -409,7 +409,7 @@ displayed in a window: 'face 'mode-line-emphasis) " "))) ;; Reset count to 0 in case we display another appt on the next cycle. - (setq appt-display-count (if (eq '(0) min-list) 0 + (setq appt-display-count (if (equal '(0) min-list) 0 (1+ prev-appt-display-count)))) ;; If we have changed the mode line string, redisplay all mode lines. (and appt-display-mode-line diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 75c29a38352..a96fb0adf7c 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -354,10 +354,10 @@ If the locale never uses daylight saving time, set this to 0." (if calendar-current-time-zone-cache (format-time-string "%z" 0 (* 60 (car calendar-current-time-zone-cache))) - "+0000") - (or (nth 2 calendar-current-time-zone-cache) "EST")) + "-0000") + (or (nth 2 calendar-current-time-zone-cache) "UTC")) "Abbreviated name of standard time zone at `calendar-location-name'. -For example, \"EST\" in New York City, \"PST\" for Los Angeles." +For example, \"-0500\" or \"EST\" in New York City." :type 'string :version "28.1" :set-after '(calendar-time-zone-style) @@ -368,10 +368,10 @@ For example, \"EST\" in New York City, \"PST\" for Los Angeles." (if calendar-current-time-zone-cache (format-time-string "%z" 0 (* 60 (cadr calendar-current-time-zone-cache))) - "+0000") - (or (nth 3 calendar-current-time-zone-cache) "EDT")) + "-0000") + (or (nth 3 calendar-current-time-zone-cache) "UTC")) "Abbreviated name of daylight saving time zone at `calendar-location-name'. -For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." +For example, \"-0400\" or \"EDT\" in New York City." :type 'string :version "28.1" :set-after '(calendar-time-zone-style) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 44fb5eb5a86..946cf0e7236 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -339,7 +339,7 @@ Returns a string using match elements 1-5, where: (t "\\1 \\2 \\3"))) ; MDY "\n \\4 %s, \\5"))) ;; TODO Sometimes the time is in a different time-zone to the one you -;; are in. Eg in PST, you might still get an email referring to: +;; are in. E.g., in Los Angeles, you might still get an email referring to: ;; "7:00 PM-8:00 PM. Greenwich Standard Time". ;; Note that it doesn't use a standard abbreviation for the timezone, ;; or anything helpful like that. diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el index cd3de62afdb..d7d064d9c2a 100644 --- a/lisp/calendar/iso8601.el +++ b/lisp/calendar/iso8601.el @@ -129,7 +129,7 @@ well as variants like \"2008W32\" (week number) and See `decode-time' for the meaning of FORM." (if (not (iso8601-valid-p string)) - (signal 'wrong-type-argument string) + (signal 'wrong-type-argument (list string)) (let* ((date-string (match-string 1 string)) (time-string (match-string 2 string)) (zone-string (match-string 3 string)) @@ -217,7 +217,7 @@ See `decode-time' for the meaning of FORM." ((iso8601--match "---\\([0-9][0-9]\\)" string) (iso8601--decoded-time :day (string-to-number (match-string 1 string)))) (t - (signal 'wrong-type-argument string)))) + (signal 'wrong-type-argument (list string))))) (defun iso8601-parse-time (string &optional form) "Parse STRING, which should be an ISO 8601 time string. @@ -226,11 +226,11 @@ hour/minute/seconds/zone fields filled in. See `decode-time' for the meaning of FORM." (if (not (iso8601--match iso8601--full-time-match string)) - (signal 'wrong-type-argument string) + (signal 'wrong-type-argument (list string)) (let ((time (match-string 1 string)) (zone (match-string 2 string))) (if (not (iso8601--match iso8601--time-match time)) - (signal 'wrong-type-argument string) + (signal 'wrong-type-argument (list string)) (let ((hour (string-to-number (match-string 1 time))) (minute (and (match-string 2 time) (string-to-number (match-string 2 time)))) @@ -274,7 +274,7 @@ See `decode-time' for the meaning of FORM." "Parse STRING, which should be an ISO 8601 time zone. Return the number of minutes." (if (not (iso8601--match iso8601--zone-match string)) - (signal 'wrong-type-argument string) + (signal 'wrong-type-argument (list string)) (if (match-string 2 string) ;; HH:MM-ish. (let ((hour (string-to-number (match-string 3 string))) @@ -314,14 +314,14 @@ Return the number of minutes." ((iso8601--match iso8601--duration-combined-match string) (iso8601-parse (substring string 1))) (t - (signal 'wrong-type-argument string)))) + (signal 'wrong-type-argument (list string))))) (defun iso8601-parse-interval (string) "Parse ISO 8601 intervals." (let ((bits (split-string string "/")) start end duration) (if (not (= (length bits) 2)) - (signal 'wrong-type-argument string) + (signal 'wrong-type-argument (list string)) ;; The intervals may be an explicit start/end times, or either a ;; start or an end, and an accompanying duration. (cond @@ -338,7 +338,7 @@ Return the number of minutes." (setq start (iso8601-parse (car bits)) end (iso8601-parse (cadr bits)))) (t - (signal 'wrong-type-argument string)))) + (signal 'wrong-type-argument (list string))))) (unless end (setq end (decoded-time-add start duration))) (unless start 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/calendar/solar.el b/lisp/calendar/solar.el index 582a2b91ff6..d82215a6d35 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -839,12 +839,10 @@ This function is suitable for execution in an init file." "E" "W")))))) (calendar-standard-time-zone-name (if (< arg 16) calendar-standard-time-zone-name - (cond ((zerop calendar-time-zone) - (if (eq calendar-time-zone-style 'numeric) - "+0000" "UTC")) - ((< calendar-time-zone 0) - (format "UTC%dmin" calendar-time-zone)) - (t (format "UTC+%dmin" calendar-time-zone))))) + (if (and (zerop calendar-time-zone) + (not (eq calendar-time-zone-style 'numeric))) + "UTC" + (format-time-string "%z" 0 (* 60 calendar-time-zone))))) (calendar-daylight-savings-starts (if (< arg 16) calendar-daylight-savings-starts)) (calendar-daylight-savings-ends diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 6f84b83ab75..84040b572bc 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -1731,7 +1731,7 @@ Display mechanism using tooltip for a list of possible completions.") ;; Add any tail info. (setq msg (concat msg msg-tail)) ;; Display tooltip. - (when (not (eq msg "")) + (when (not (equal msg "")) (semantic-displayer-tooltip-show msg))))) ;;; Compatibility diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index 156eac46659..c83de66ef0c 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -790,9 +790,7 @@ any decorated referring includes.") ;; This is a hack. Add in something better? (semanticdb-notify-references table (lambda (tab _me) - (semantic-decoration-unparsed-include-refrence-reset tab) - )) - )) + (semantic-decoration-unparsed-include-reference-reset tab))))) (cl-defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache) new-tags) @@ -805,7 +803,7 @@ any decorated referring includes.") "Synchronize a CACHE with some NEW-TAGS." (semantic-reset cache)) -(defun semantic-decoration-unparsed-include-refrence-reset (table) +(defun semantic-decoration-unparsed-include-reference-reset (table) "Refresh any highlighting in buffers referred to by TABLE. If TABLE is not in a buffer, do nothing." ;; This cache removal may seem odd in that we are "creating one", but @@ -835,6 +833,8 @@ If TABLE is not in a buffer, do nothing." (semantic-decorate-add-decorations allinc) )))) +(define-obsolete-function-alias 'semantic-decoration-unparsed-include-refrence-reset + #'semantic-decoration-unparsed-include-reference-reset "30.1") (provide 'semantic/decorate/include) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index b932cb999ba..6a16845ecf2 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -1243,7 +1243,7 @@ Finds the header file belonging to NAME, gets the macros from that file, and then merge the macros with our current symbol table." (when semantic-lex-spp-use-headers-flag - ;; @todo - do this someday, ok? + nil ; @todo - do this someday, ok? )) (defmacro define-lex-spp-include-analyzer (name doc regexp tokidx diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index c2d2e5e1668..5fd1fd45400 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -1108,7 +1108,7 @@ This can be done by using `semantic-lex-push-token'." (semantic-lex-analysis-bounds (cons (point) (point-max))) (semantic-lex-current-depth 0) (semantic-lex-maximum-depth semantic-lex-depth)) - (when ,condition ,@forms) + (when ,condition nil ,@forms) ; `nil' avoids an empty-body warning. semantic-lex-token-stream)))) (defmacro define-lex-regex-analyzer (name doc regexp &rest forms) diff --git a/lisp/comint.el b/lisp/comint.el index 682b555a33c..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) *\\'" @@ -4119,9 +4120,15 @@ function called, or nil, if no function was called (if BEG = END)." (save-restriction (let ((beg2 beg1) (end2 end1)) - (when (= beg2 beg) + (when (and (= beg2 beg) + (> beg2 (point-min)) + (eq is-output + (eq (get-text-property (1- beg2) 'field) 'output))) (setq beg2 (field-beginning beg2))) - (when (= end2 end) + (when (and (= end2 end) + (< end2 (point-max)) + (eq is-output + (eq (get-text-property (1+ end2) 'field) 'output))) (setq end2 (field-end end2))) ;; Narrow to the whole field surrounding the region (narrow-to-region beg2 end2)) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 0373842de09..dbef5f47cd6 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -903,9 +903,9 @@ This also shows the saved values in the buffer." (defun custom-reset-standard-save-and-update () "Save settings and redraw after erasing customizations." (when (or (and custom-reset-standard-variables-list - (not (eq custom-reset-standard-variables-list '(t)))) + (not (equal custom-reset-standard-variables-list '(t)))) (and custom-reset-standard-faces-list - (not (eq custom-reset-standard-faces-list '(t))))) + (not (equal custom-reset-standard-faces-list '(t))))) ;; Save settings to file. (custom-save-all) ;; Set state of and redraw variables. @@ -1238,7 +1238,7 @@ Show the buffer in another window, but don't select it." (unless (eq symbol basevar) (message "`%s' is an alias for `%s'" symbol basevar)))) -(defvar customize-changed-options-previous-release "28.2" +(defvar customize-changed-options-previous-release "29.1" "Version for `customize-changed' to refer back to by default.") ;; Packages will update this variable, so make it available. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 054683d7cf6..6ca7d7fcafd 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -310,6 +310,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "Off" :value nil) (const :tag "On" :value t) (const :tag "Auto-raise" :value auto-raise)) "26.1") + (yes-or-no-prompt menu string "30.1") ;; fontset.c ;; FIXME nil is the initial value, fontset.el setqs it. (vertical-centering-font-regexp display 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/descr-text.el b/lisp/descr-text.el index aea6b3e15b7..4834c2eb7ba 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -366,7 +366,7 @@ This function is semi-obsolete. Use `get-char-code-property'." ;; description is added to the category name as a tooltip (defsubst describe-char-categories (category-set) (let ((mnemonics (category-set-mnemonics category-set))) - (unless (eq mnemonics "") + (unless (equal mnemonics "") (list (mapconcat (lambda (x) (let* ((c (category-docstring x)) diff --git a/lisp/desktop.el b/lisp/desktop.el index 3d78c4cb6f8..6aacb85c12c 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -828,7 +828,7 @@ is nil, ask the user where to save the desktop." ;; If we own it, we don't anymore. (when (eq (emacs-pid) (desktop-owner)) ;; Allow exiting Emacs even if we can't delete the desktop file. - (ignore-error 'file-error + (ignore-error file-error (desktop-release-lock)))) ;; ---------------------------------------------------------------------------- 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-x.el b/lisp/dired-x.el index 560eefae024..5780f1353ad 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -816,7 +816,7 @@ otherwise." (defun dired-x--string-to-number (str) "Like `string-to-number' but recognize a trailing unit prefix. For example, 2K is expanded to 2048.0. The caller should make -sure that a trailing letter in STR is one of BKkMGTPEZY." +sure that a trailing letter in STR is one of BKkMGTPEZYRQ." (let* ((val (string-to-number str)) (u (unless (zerop val) (aref str (1- (length str)))))) @@ -831,7 +831,7 @@ sure that a trailing letter in STR is one of BKkMGTPEZY." (when (and u (> u ?9)) (when (= u ?k) (setq u ?K)) - (let ((units '(?B ?K ?M ?G ?T ?P ?E ?Z ?Y))) + (let ((units '(?B ?K ?M ?G ?T ?P ?E ?Z ?Y ?R ?Q))) (while (and units (/= (pop units) u)) (setq val (* 1024.0 val))))) val))) @@ -904,7 +904,7 @@ only in the active region if `dired-mark-region' is non-nil." ;; GNU ls -hs suffixes the block count with a unit and ;; prints it as a float, FreeBSD does neither. (dired-re-inode-size "\\=\\s *\\([0-9]+\\s +\\)?\ -\\(?:\\([0-9]+\\(?:\\.[0-9]*\\)?[BkKMGTPEZY]?\\)? ?\\)")) +\\(?:\\([0-9]+\\(?:\\.[0-9]*\\)?[BkKMGTPEZYRQ]?\\)? ?\\)")) (beginning-of-line) (forward-char 2) (search-forward-regexp dired-re-inode-size nil t) diff --git a/lisp/dired.el b/lisp/dired.el index 42d15f27a54..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 @@ -530,7 +535,7 @@ The directory name must be absolute, but need not be fully expanded.") (put 'dired-actual-switches 'safe-local-variable 'dired-safe-switches-p) -(defvar dired-re-inode-size "[0-9 \t]*[.,0-9]*[BkKMGTPEZY]?[ \t]*" +(defvar dired-re-inode-size "[0-9 \t]*[.,0-9]*[BkKMGTPEZYRQ]?[ \t]*" "Regexp for optional initial inode and file size as made by `ls -i -s'.") ;; These regexps must be tested at beginning-of-line, but are also @@ -789,7 +794,7 @@ Subexpression 2 must end right before the \\n.") '(dired-move-to-filename) nil '(1 dired-symlink-face) - '(2 '(face dired-directory-face dired-symlink-filename t)))) + '(2 `(face ,dired-directory-face dired-symlink-filename t)))) ;; ;; Symbolic link to a non-directory. (list dired-re-sym @@ -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/doc-view.el b/lisp/doc-view.el index 427da557d23..b14655fb274 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -209,10 +209,10 @@ are available (see Info node `(emacs)Document View')." function) :version "24.4") -(defcustom doc-view-mupdf-use-svg nil - "Whether to use SVG images for PDF files." +(defcustom doc-view-mupdf-use-svg (image-type-available-p 'svg) + "Whether to use svg images for PDF files." :type 'boolean - :version "29.1") + :version "30.1") (defcustom doc-view-imenu-enabled (and (executable-find "mutool") t) "Whether to generate an imenu outline when \"mutool\" is available." @@ -236,17 +236,14 @@ showing only titles and no page number." :type 'boolean :version "29.1") -(defcustom doc-view-svg-background "white" - "Background color for svg images. +(defface doc-view-svg-face '((t :inherit default)) + "Face used for SVG images. Only background and foreground colors +are used. See `doc-view-mupdf-use-svg'." - :type 'color - :version "29.1") + :version "30.1") -(defcustom doc-view-svg-foreground "black" - "Foreground color for svg images. -See `doc-view-mupdf-use-svg'." - :type 'color - :version "29.1") +(make-obsolete 'doc-view-svg-background 'doc-view-svg-face "30.1") +(make-obsolete 'doc-view-svg-foreground 'doc-view-svg-face "30.1") (defcustom doc-view-ghostscript-options '("-dSAFER" ;; Avoid security problems when rendering files from untrusted @@ -1602,8 +1599,8 @@ ARGS is a list of image descriptors." (unless (member :transform-smoothing args) (setq args `(,@args :transform-smoothing t))) (when (eq doc-view--image-type 'svg) - (setq args `(,@args :background ,doc-view-svg-background - :foreground ,doc-view-svg-foreground))) + (setq args `(,@args :background ,(face-background 'doc-view-svg-face) + :foreground ,(face-foreground 'doc-view-svg-face)))) (apply #'create-image file doc-view--image-type nil args)))) (slice (doc-view-current-slice)) (img-width (and image (car (image-size image)))) 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/elide-head.el b/lisp/elide-head.el index 11953299da9..f74c85fdfee 100644 --- a/lisp/elide-head.el +++ b/lisp/elide-head.el @@ -50,24 +50,41 @@ :group 'tools) (defcustom elide-head-headers-to-hide - `(;; GNU GPL - ("is free software[:;] you can redistribute it" . - ,(rx (or (seq "If not, see " (? "<") - "http" (? "s") "://www.gnu.org/licenses" - (? "/") (? ">") (? " ")) - (seq "Boston, MA " (? " ") - "0211" (or "1-1307" "0-1301") - (or " " ", ") "USA") - "675 Mass Ave, Cambridge, MA 02139, USA") - (? "."))) - ;; FreeBSD license / Modified BSD license (3-clause) - (,(rx (or "The Regents of the University of California. All rights reserved." - "Redistribution and use in source and binary")) - . "POSSIBILITY OF SUCH DAMAGE\\.") - ;; X11 and Expat - ("Permission is hereby granted, free of charge" . - ,(rx (or "authorization from the X Consortium." ; X11 - "THE USE OR OTHER DEALINGS IN THE SOFTWARE.")))) ; Expat + (rx-let ((delim + ;; A line break could be in a non-standard place, and the + ;; license could be in a comment. + (or + ;; Either just some spaces: + (+ " ") + ;; Or a newline and some comment starter: + (: (* (in " \t")) + "\n" + (* (in " \t")) + (* (or (syntax comment-start) (in ";#*-"))) + (* (in " \t")))))) + `(;; GNU GPL + ("is free software[:;] you can redistribute it" . + ,(rx (or (seq "If not, see " (? "<") + "http" (? "s") "://www.gnu.org/licenses" + (? "/") (? ">") (? " ")) + (seq "Boston," delim "MA" delim + (or "02111-1307" "02110-1301" "02111-1301") + (? ",") delim + "USA") + "675 Mass Ave, Cambridge, MA 02139, USA") + (? "."))) + ;; FreeBSD license / Modified BSD license (3-clause) + (,(rx (or "The Regents of the University of California. All rights reserved." + "Redistribution and use in source and binary")) + . "POSSIBILITY OF SUCH DAMAGE\\.") + ;; X11 and Expat + ("Permission is hereby granted, free of charge" . + ,(rx (or "authorization from the X Consortium." ; X11 + "THE USE OR OTHER DEALINGS IN THE SOFTWARE."))) ; Expat + ;; Apache + ("Licensed under the Apache License, Version 2.0" . + "limitations under the License.") + )) "Alist of regexps defining start and end of text to elide. The cars of elements of the list are searched for in order. Text is @@ -78,7 +95,7 @@ cdr. This affects `elide-head-mode'." :type '(alist :key-type (regexp :tag "Start regexp") :value-type (regexp :tag "End regexp")) - :version "29.1") + :version "30.1") (defvar-local elide-head-overlay nil) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 937300cf0c0..3c7aeb89525 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -72,34 +72,40 @@ (require 'macroexp) (eval-when-compile (require 'subr-x)) +(defun bytecomp--log-lap-arg (arg) + ;; Convert an argument that may be a LAP operation to something printable. + (cond + ;; Symbols are just stripped of their -byte prefix if any. + ((symbolp arg) + (intern (string-remove-prefix "byte-" (symbol-name arg)))) + ;; Conses are assumed to be LAP ops or tags. + ((and (consp arg) (symbolp (car arg))) + (let* ((head (car arg)) + (tail (cdr arg)) + (op (intern (string-remove-prefix "byte-" (symbol-name head))))) + (cond + ((eq head 'TAG) + (format "%d:" (car tail))) + ((memq head byte-goto-ops) + (format "(%s %d)" op (cadr tail))) + ((memq head byte-constref-ops) + (format "(%s %s)" + (if (eq op 'constant) 'const op) + (if (numberp tail) + (format "<V%d>" tail) ; closure var reference + (format "%S" (car tail))))) ; actual constant + ;; Ops with an immediate argument. + ((memq op '( stack-ref stack-set call unbind + listN concatN insertN discardN discardN-preserve-tos)) + (format "(%s %S)" op tail)) + ;; Without immediate, print just the symbol. + (t op)))) + ;; Anything else is printed as-is. + (t arg))) + (defun byte-compile-log-lap-1 (format &rest args) (byte-compile-log-1 - (apply #'format-message format - (let (c a) - (mapcar (lambda (arg) - (if (not (consp arg)) - (if (and (symbolp arg) - (string-match "^byte-" (symbol-name arg))) - (intern (substring (symbol-name arg) 5)) - arg) - (if (integerp (setq c (car arg))) - (error "Non-symbolic byte-op %s" c)) - (if (eq c 'TAG) - (setq c arg) - (setq a (cond ((memq c byte-goto-ops) - (car (cdr (cdr arg)))) - ((memq c byte-constref-ops) - (car (cdr arg))) - (t (cdr arg)))) - (setq c (symbol-name c)) - (if (string-match "^byte-." c) - (setq c (intern (substring c 5))))) - (if (eq c 'constant) (setq c 'const)) - (if (and (eq (cdr arg) 0) - (not (memq c '(unbind call const)))) - c - (format "(%s %s)" c a)))) - args))))) + (apply #'format-message format (mapcar #'bytecomp--log-lap-arg args)))) (defmacro byte-compile-log-lap (format-string &rest args) `(and (memq byte-optimize-log '(t byte)) @@ -266,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 @@ -410,7 +424,10 @@ for speeding up processing.") (`(condition-case ,var ,exp . ,clauses) `(,fn ,var ;Not evaluated. - ,(byte-optimize-form exp for-effect) + ,(byte-optimize-form exp + (if (assq :success clauses) + (null var) + for-effect)) ,@(mapcar (lambda (clause) (let ((byte-optimize--lexvars (and lexical-binding @@ -422,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) @@ -488,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 @@ -498,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)))))) @@ -529,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))) @@ -755,7 +769,8 @@ for speeding up processing.") ((eq head 'list) (cdr form)) ((memq head ;; FIXME: Replace this list with a function property? - '( length safe-length cons lambda + '( lambda internal-make-closure + length safe-length cons string unibyte-string make-string concat format format-message substring substring-no-properties string-replace @@ -971,17 +986,52 @@ for speeding up processing.") (t ;; Moving the constant to the end can enable some lapcode optimizations. (list (car form) (nth 2 form) (nth 1 form))))) +(defun byte-opt--nary-comparison (form) + "Optimise n-ary comparisons such as `=', `<' etc." + (let ((nargs (length (cdr form)))) + (cond + ((= nargs 1) + `(progn (cadr form) t)) + ((>= nargs 3) + ;; At least 3 arguments: transform to N-1 binary comparisons, + ;; since those have their own byte-ops which are particularly + ;; fast for fixnums. + (let* ((op (car form)) + (bindings nil) + (rev-args nil)) + (if (memq nil (mapcar #'macroexp-copyable-p (cddr form))) + ;; At least one arg beyond the first is non-constant non-variable: + ;; create temporaries for all args to guard against side-effects. + ;; The optimiser will eliminate trivial bindings later. + (let ((i 1)) + (dolist (arg (cdr form)) + (let ((var (make-symbol (format "arg%d" i)))) + (push var rev-args) + (push (list var arg) bindings) + (setq i (1+ i))))) + ;; All args beyond the first are copyable: no temporary variables + ;; required. + (setq rev-args (reverse (cdr form)))) + (let ((prev (car rev-args)) + (exprs nil)) + (dolist (arg (cdr rev-args)) + (push (list op arg prev) exprs) + (setq prev arg)) + (let ((and-expr (cons 'and exprs))) + (if bindings + (list 'let (nreverse bindings) and-expr) + and-expr))))) + (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)))) @@ -989,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. @@ -1027,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) @@ -1076,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))) @@ -1126,13 +1197,18 @@ See Info node `(elisp) Integer Basics'." (put 'max 'byte-optimizer #'byte-optimize-min-max) (put 'min 'byte-optimizer #'byte-optimize-min-max) -(put '= 'byte-optimizer #'byte-optimize-binary-predicate) (put 'eq 'byte-optimizer #'byte-optimize-eq) (put 'eql 'byte-optimizer #'byte-optimize-equal) (put 'equal 'byte-optimizer #'byte-optimize-equal) (put 'string= 'byte-optimizer #'byte-optimize-binary-predicate) (put 'string-equal 'byte-optimizer #'byte-optimize-binary-predicate) +(put '= 'byte-optimizer #'byte-opt--nary-comparison) +(put '< 'byte-optimizer #'byte-opt--nary-comparison) +(put '<= 'byte-optimizer #'byte-opt--nary-comparison) +(put '> 'byte-optimizer #'byte-opt--nary-comparison) +(put '>= 'byte-optimizer #'byte-opt--nary-comparison) + (put 'string-greaterp 'byte-optimizer #'byte-optimize-string-greaterp) (put 'string> 'byte-optimizer #'byte-optimize-string-greaterp) @@ -1297,11 +1373,8 @@ See Info node `(elisp) Integer Basics'." (if else `(progn ,condition ,@else) condition)) - ;; (if X nil t) -> (not X) - ((and (eq then nil) (eq else '(t))) - `(not ,condition)) - ;; (if X t [nil]) -> (not (not X)) - ((and (eq then t) (or (null else) (eq else '(nil)))) + ;; (if X t) -> (not (not X)) + ((and (eq then t) (null else)) `(not ,(byte-opt--negate condition))) ;; (if VAR VAR X...) -> (or VAR (progn X...)) ((and (symbolp condition) (eq condition then)) @@ -1379,6 +1452,9 @@ See Info node `(elisp) Integer Basics'." ;; (apply F ... (list X Y ...)) -> (funcall F ... X Y ...) ((eq (car-safe last) 'list) `(funcall ,fn ,@(butlast (cddr form)) ,@(cdr last))) + ;; (apply F ... (cons X Y)) -> (apply F ... X Y) + ((eq (car-safe last) 'cons) + (append (butlast form) (cdr last))) (t form))) form))) @@ -1476,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)) @@ -1486,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)))))) @@ -1576,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 @@ -1585,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 @@ -1690,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 @@ -1699,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 @@ -1904,6 +1970,7 @@ See Info node `(elisp) Integer Basics'." (defconst byte-after-unbind-ops '(byte-constant byte-dup byte-stack-ref byte-stack-set byte-discard + byte-discardN byte-discardN-preserve-tos byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp byte-eq byte-not byte-cons byte-list1 byte-list2 byte-list3 byte-list4 byte-listN @@ -1967,574 +2034,798 @@ See Info node `(elisp) Integer Basics'." (defun byte-optimize-lapcode (lap &optional _for-effect) "Simple peephole optimizer. LAP is both modified and returned. If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." - (let (lap0 - lap1 - lap2 - (keep-going 'first-time) - (add-depth 0) - rest tmp tmp2 tmp3 - (side-effect-free (if byte-compile-delete-errors + (let ((side-effect-free (if byte-compile-delete-errors byte-compile-side-effect-free-ops - byte-compile-side-effect-and-error-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 + ;; element does not need special-casing: `setcdr' always works. + (lap-head (cons nil lap))) (while keep-going - (or (eq keep-going 'first-time) - (byte-compile-log-lap " ---- next pass")) - (setq rest lap - keep-going nil) - (while rest - (setq lap0 (car rest) - lap1 (nth 1 rest) - lap2 (nth 2 rest)) - - ;; You may notice that sequences like "dup varset discard" are - ;; optimized but sequences like "dup varset TAG1: discard" are not. - ;; You may be tempted to change this; resist that temptation. - (cond - ;; <side-effect-free> pop --> <deleted> - ;; ...including: - ;; const-X pop --> <deleted> - ;; varref-X pop --> <deleted> - ;; dup pop --> <deleted> - ;; - ((and (eq 'byte-discard (car lap1)) - (memq (car lap0) side-effect-free)) - (setq keep-going t) - (setq tmp (aref byte-stack+-info (symbol-value (car lap0)))) - (setq rest (cdr rest)) - (cond ((eql tmp 1) - (byte-compile-log-lap - " %s discard\t-->\t<deleted>" lap0) - (setq lap (delq lap0 (delq lap1 lap)))) - ((eql tmp 0) - (byte-compile-log-lap - " %s discard\t-->\t<deleted> discard" lap0) - (setq lap (delq lap0 lap))) - ((eql tmp -1) - (byte-compile-log-lap - " %s discard\t-->\tdiscard discard" lap0) - (setcar lap0 'byte-discard) - (setcdr lap0 0)) - (t (error "Optimizer error: too much on the stack")))) - ;; - ;; goto*-X X: --> X: - ;; - ((and (memq (car lap0) byte-goto-ops) - (eq (cdr lap0) lap1)) - (cond ((eq (car lap0) 'byte-goto) - (setq lap (delq lap0 lap)) - (setq tmp "<deleted>")) - ((memq (car lap0) byte-goto-always-pop-ops) - (setcar lap0 (setq tmp 'byte-discard)) - (setcdr lap0 0)) - ((error "Depth conflict at tag %d" (nth 2 lap0)))) - (and (memq byte-optimize-log '(t byte)) - (byte-compile-log " (goto %s) %s:\t-->\t%s %s:" - (nth 1 lap1) (nth 1 lap1) - tmp (nth 1 lap1))) - (setq keep-going t)) - ;; - ;; varset-X varref-X --> dup varset-X - ;; varbind-X varref-X --> dup varbind-X - ;; const/dup varset-X varref-X --> const/dup varset-X const/dup - ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup - ;; The latter two can enable other optimizations. - ;; - ;; For lexical variables, we could do the same - ;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2 - ;; but this is a very minor gain, since dup is stack-ref-0, - ;; i.e. it's only better if X>5, and even then it comes - ;; at the cost of an extra stack slot. Let's not bother. - ((and (eq 'byte-varref (car lap2)) - (eq (cdr lap1) (cdr lap2)) - (memq (car lap1) '(byte-varset byte-varbind))) - (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars)) - (not (eq (car lap0) 'byte-constant))) - nil - (setq keep-going t) - (if (memq (car lap0) '(byte-constant byte-dup)) - (progn - (setq tmp (if (or (not tmp) - (macroexp--const-symbol-p - (car (cdr lap0)))) - (cdr lap0) - (byte-compile-get-constant t))) - (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" - lap0 lap1 lap2 lap0 lap1 - (cons (car lap0) tmp)) - (setcar lap2 (car lap0)) - (setcdr lap2 tmp)) - (byte-compile-log-lap " %s %s\t-->\tdup %s" lap1 lap2 lap1) - (setcar lap2 (car lap1)) - (setcar lap1 'byte-dup) - (setcdr lap1 0) - ;; The stack depth gets locally increased, so we will - ;; increase maxdepth in case depth = maxdepth here. - ;; This can cause the third argument to byte-code to - ;; be larger than necessary. - (setq add-depth 1)))) - ;; - ;; 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))) - (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) - (setq keep-going t - rest (cdr rest)) - (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1))) - (setq lap (delq lap0 (delq lap2 lap)))) - ;; - ;; not goto-X-if-nil --> goto-X-if-non-nil - ;; not goto-X-if-non-nil --> goto-X-if-nil - ;; - ;; it is wrong to do the same thing for the -else-pop variants. - ;; - ((and (eq 'byte-not (car lap0)) - (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil))) - (byte-compile-log-lap " not %s\t-->\t%s" - lap1 - (cons - (if (eq (car lap1) 'byte-goto-if-nil) - 'byte-goto-if-not-nil - 'byte-goto-if-nil) - (cdr lap1))) - (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil) - 'byte-goto-if-not-nil - 'byte-goto-if-nil)) - (setq lap (delq lap0 lap)) - (setq keep-going t)) - ;; - ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X: - ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X: - ;; - ;; it is wrong to do the same thing for the -else-pop variants. - ;; - ((and (memq (car lap0) - '(byte-goto-if-nil byte-goto-if-not-nil)) ; gotoX - (eq 'byte-goto (car lap1)) ; gotoY - (eq (cdr lap0) lap2)) ; TAG X - (let ((inverse (if (eq 'byte-goto-if-nil (car lap0)) - 'byte-goto-if-not-nil 'byte-goto-if-nil))) - (byte-compile-log-lap " %s %s %s:\t-->\t%s %s:" - lap0 lap1 lap2 - (cons inverse (cdr lap1)) lap2) - (setq lap (delq lap0 lap)) - (setcar lap1 inverse) - (setq keep-going t))) - ;; - ;; const goto-if-* --> whatever - ;; - ((and (eq 'byte-constant (car lap0)) - (memq (car lap1) byte-conditional-ops) - ;; If the `byte-constant's cdr is not a cons cell, it has - ;; to be an index into the constant pool); even though - ;; it'll be a constant, that constant is not known yet - ;; (it's typically a free variable of a closure, so will - ;; only be known when the closure will be built at - ;; run-time). - (consp (cdr lap0))) - (cond ((if (memq (car lap1) '(byte-goto-if-nil - byte-goto-if-nil-else-pop)) - (car (cdr lap0)) - (not (car (cdr lap0)))) - (byte-compile-log-lap " %s %s\t-->\t<deleted>" - lap0 lap1) - (setq rest (cdr rest) - lap (delq lap0 (delq lap1 lap)))) - (t - (byte-compile-log-lap " %s %s\t-->\t%s" - lap0 lap1 - (cons 'byte-goto (cdr lap1))) - (when (memq (car lap1) byte-goto-always-pop-ops) - (setq lap (delq lap0 lap))) - (setcar lap1 'byte-goto))) - (setq keep-going t)) - ;; - ;; varref-X varref-X --> varref-X dup - ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup - ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup - ;; We don't optimize the const-X variations on this here, - ;; because that would inhibit some goto optimizations; we - ;; optimize the const-X case after all other optimizations. - ;; - ((and (memq (car lap0) '(byte-varref byte-stack-ref)) - (progn - (setq tmp (cdr rest)) - (setq tmp2 0) - (while (eq (car (car tmp)) 'byte-dup) - (setq tmp2 (1+ tmp2)) - (setq tmp (cdr tmp))) - t) - (eq (if (eq 'byte-stack-ref (car lap0)) - (+ tmp2 1 (cdr lap0)) - (cdr lap0)) - (cdr (car tmp))) - (eq (car lap0) (car (car tmp)))) - (if (memq byte-optimize-log '(t byte)) - (let ((str "")) - (setq tmp2 (cdr rest)) - (while (not (eq tmp tmp2)) - (setq tmp2 (cdr tmp2) - str (concat str " dup"))) - (byte-compile-log-lap " %s%s %s\t-->\t%s%s dup" - lap0 str lap0 lap0 str))) - (setq keep-going t) - (setcar (car tmp) 'byte-dup) - (setcdr (car tmp) 0) - (setq rest tmp)) - ;; - ;; TAG1: TAG2: --> TAG1: <deleted> - ;; (and other references to TAG2 are replaced with TAG1) - ;; - ((and (eq (car lap0) 'TAG) - (eq (car lap1) 'TAG)) - (and (memq byte-optimize-log '(t byte)) - (byte-compile-log " adjacent tags %d and %d merged" - (nth 1 lap1) (nth 1 lap0))) - (setq tmp3 lap) - (while (setq tmp2 (rassq lap0 tmp3)) - (setcdr tmp2 lap1) - (setq tmp3 (cdr (memq tmp2 tmp3)))) - (setq lap (delq lap0 lap) - keep-going t) - ;; replace references to tag in jump tables, if any - (dolist (table byte-compile-jump-tables) - (maphash #'(lambda (value tag) - (when (equal tag lap0) - (puthash value lap1 table))) - table))) - ;; - ;; unused-TAG: --> <deleted> - ;; - ((and (eq 'TAG (car lap0)) - (not (rassq lap0 lap)) - ;; make sure this tag isn't used in a jump-table - (cl-loop for table in byte-compile-jump-tables - when (member lap0 (hash-table-values table)) - return nil finally return t)) - (and (memq byte-optimize-log '(t byte)) - (byte-compile-log " unused tag %d removed" (nth 1 lap0))) - (setq lap (delq lap0 lap) - keep-going t)) - ;; - ;; goto ... --> goto <delete until TAG or end> - ;; return ... --> return <delete until TAG or end> - ;; (unless a jump-table is being used, where deleting may affect - ;; other valid case bodies) - ;; - ((and (memq (car lap0) '(byte-goto byte-return)) - (not (memq (car lap1) '(TAG nil))) - ;; FIXME: Instead of deferring simply when jump-tables are - ;; being used, keep a list of tags used for switch tags and - ;; use them instead (see `byte-compile-inline-lapcode'). - (not byte-compile-jump-tables)) - (setq tmp rest) - (let ((i 0) - (opt-p (memq byte-optimize-log '(t lap))) - str deleted) - (while (and (setq tmp (cdr tmp)) - (not (eq 'TAG (car (car tmp))))) - (if opt-p (setq deleted (cons (car tmp) deleted) - str (concat str " %s") - i (1+ i)))) - (if opt-p - (let ((tagstr - (if (eq 'TAG (car (car tmp))) - (format "%d:" (car (cdr (car tmp)))) - (or (car tmp) "")))) - (if (< i 6) - (apply 'byte-compile-log-lap-1 - (concat " %s" str - " %s\t-->\t%s <deleted> %s") - lap0 - (nconc (nreverse deleted) - (list tagstr lap0 tagstr))) - (byte-compile-log-lap - " %s <%d unreachable op%s> %s\t-->\t%s <deleted> %s" - lap0 i (if (= i 1) "" "s") - tagstr lap0 tagstr)))) - (rplacd rest tmp)) - (setq keep-going t)) - ;; - ;; <safe-op> unbind --> unbind <safe-op> - ;; (this may enable other optimizations.) - ;; - ((and (eq 'byte-unbind (car lap1)) - (memq (car lap0) byte-after-unbind-ops)) - (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0) - (setcar rest lap1) - (setcar (cdr rest) lap0) - (setq keep-going t)) - ;; - ;; varbind-X unbind-N --> discard unbind-(N-1) - ;; save-excursion unbind-N --> unbind-(N-1) - ;; save-restriction unbind-N --> unbind-(N-1) - ;; save-current-buffer unbind-N --> unbind-(N-1) - ;; - ((and (eq 'byte-unbind (car lap1)) - (memq (car lap0) '(byte-varbind byte-save-excursion - byte-save-restriction - byte-save-current-buffer)) - (< 0 (cdr lap1))) - (if (zerop (setcdr lap1 (1- (cdr lap1)))) - (delq lap1 rest)) - (if (eq (car lap0) 'byte-varbind) - (setcar rest (cons 'byte-discard 0)) - (setq lap (delq lap0 lap))) - (byte-compile-log-lap " %s %s\t-->\t%s %s" - lap0 (cons (car lap1) (1+ (cdr lap1))) - (if (eq (car lap0) 'byte-varbind) - (car rest) - (car (cdr rest))) - (if (and (/= 0 (cdr lap1)) - (eq (car lap0) 'byte-varbind)) - (car (cdr rest)) - "")) - (setq keep-going t)) - ;; - ;; goto*-X ... X: goto-Y --> goto*-Y - ;; goto-X ... X: return --> return - ;; - ((and (memq (car lap0) byte-goto-ops) - (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap)))) - '(byte-goto byte-return))) - (cond ((and (or (eq (car lap0) 'byte-goto) - (eq (car tmp) 'byte-goto)) - (not (eq (cdr tmp) (cdr lap0)))) - (byte-compile-log-lap " %s [%s]\t-->\t%s" - (car lap0) tmp tmp) - (if (eq (car tmp) 'byte-return) - (setcar lap0 'byte-return)) - (setcdr lap0 (cdr tmp)) - (setq keep-going t)))) - ;; - ;; goto-*-else-pop X ... X: goto-if-* --> whatever - ;; goto-*-else-pop X ... X: discard --> whatever - ;; - ((and (memq (car lap0) '(byte-goto-if-nil-else-pop - byte-goto-if-not-nil-else-pop)) - (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap))))) - (eval-when-compile - (cons 'byte-discard byte-conditional-ops))) - (not (eq lap0 (car tmp)))) - (setq tmp2 (car tmp)) - (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop - byte-goto-if-nil) - (byte-goto-if-not-nil-else-pop - byte-goto-if-not-nil)))) - (if (memq (car tmp2) tmp3) - (progn (setcar lap0 (car tmp2)) - (setcdr lap0 (cdr tmp2)) - (byte-compile-log-lap " %s-else-pop [%s]\t-->\t%s" - (car lap0) tmp2 lap0)) - ;; Get rid of the -else-pop's and jump one step further. - (or (eq 'TAG (car (nth 1 tmp))) - (setcdr tmp (cons (byte-compile-make-tag) - (cdr tmp)))) - (byte-compile-log-lap " %s [%s]\t-->\t%s <skip>" - (car lap0) tmp2 (nth 1 tmp3)) - (setcar lap0 (nth 1 tmp3)) - (setcdr lap0 (nth 1 tmp))) - (setq keep-going t)) - ;; - ;; const goto-X ... X: goto-if-* --> whatever - ;; const goto-X ... X: discard --> whatever - ;; - ((and (eq (car lap0) 'byte-constant) - (eq (car lap1) 'byte-goto) - (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap))))) - (eval-when-compile - (cons 'byte-discard byte-conditional-ops))) - (not (eq lap1 (car tmp)))) - (setq tmp2 (car tmp)) - (cond ((when (consp (cdr lap0)) - (memq (car tmp2) - (if (null (car (cdr lap0))) - '(byte-goto-if-nil byte-goto-if-nil-else-pop) - '(byte-goto-if-not-nil - byte-goto-if-not-nil-else-pop)))) - (byte-compile-log-lap " %s goto [%s]\t-->\t%s %s" - lap0 tmp2 lap0 tmp2) - (setcar lap1 (car tmp2)) - (setcdr lap1 (cdr tmp2)) - ;; Let next step fix the (const,goto-if*) sequence. - (setq rest (cons nil rest)) - (setq keep-going t)) - ((or (consp (cdr lap0)) - (eq (car tmp2) 'byte-discard)) - ;; Jump one step further - (byte-compile-log-lap - " %s goto [%s]\t-->\t<deleted> goto <skip>" - lap0 tmp2) - (or (eq 'TAG (car (nth 1 tmp))) - (setcdr tmp (cons (byte-compile-make-tag) - (cdr tmp)))) - (setcdr lap1 (car (cdr tmp))) - (setq lap (delq lap0 lap)) - (setq keep-going t)))) - ;; - ;; X: varref-Y ... varset-Y goto-X --> - ;; X: varref-Y Z: ... dup varset-Y goto-Z - ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.) - ;; (This is so usual for while loops that it is worth handling). - ;; - ;; Here again, we could do it for stack-ref/stack-set, but - ;; that's replacing a stack-ref-Y with a stack-ref-0, which - ;; is a very minor improvement (if any), at the cost of - ;; more stack use and more byte-code. Let's not do it. - ;; - ((and (eq (car lap1) 'byte-varset) - (eq (car lap2) 'byte-goto) - (not (memq (cdr lap2) rest)) ;Backwards jump - (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap))))) - 'byte-varref) - (eq (cdr (car tmp)) (cdr lap1)) - (not (memq (car (cdr lap1)) byte-boolean-vars))) - ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp)) - (let ((newtag (byte-compile-make-tag))) - (byte-compile-log-lap - " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s" - (nth 1 (cdr lap2)) (car tmp) - lap1 lap2 - (nth 1 (cdr lap2)) (car tmp) - (nth 1 newtag) 'byte-dup lap1 - (cons 'byte-goto newtag) - ) - (setcdr rest (cons (cons 'byte-dup 0) (cdr rest))) - (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp)))) - (setq add-depth 1) - (setq keep-going t)) - ;; - ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y: - ;; (This can pull the loop test to the end of the loop) - ;; - ((and (eq (car lap0) 'byte-goto) - (eq (car lap1) 'TAG) - (eq lap1 - (cdr (car (setq tmp (cdr (memq (cdr lap0) lap)))))) - (memq (car (car tmp)) - '(byte-goto byte-goto-if-nil byte-goto-if-not-nil - byte-goto-if-nil-else-pop))) - ;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional" - ;; lap0 lap1 (cdr lap0) (car tmp)) - (let ((newtag (byte-compile-make-tag))) - (byte-compile-log-lap - "%s %s: ... %s: %s\t-->\t%s ... %s:" - lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp) - (cons (cdr (assq (car (car tmp)) - '((byte-goto-if-nil . byte-goto-if-not-nil) - (byte-goto-if-not-nil . byte-goto-if-nil) - (byte-goto-if-nil-else-pop . - byte-goto-if-not-nil-else-pop) - (byte-goto-if-not-nil-else-pop . - byte-goto-if-nil-else-pop)))) - newtag) - - (nth 1 newtag) - ) - (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp))) - (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop) - ;; We can handle this case but not the -if-not-nil case, - ;; because we won't know which non-nil constant to push. - (setcdr rest (cons (cons 'byte-constant - (byte-compile-get-constant nil)) - (cdr rest)))) - (setcar lap0 (nth 1 (memq (car (car tmp)) - '(byte-goto-if-nil-else-pop - byte-goto-if-not-nil - byte-goto-if-nil - byte-goto-if-not-nil - byte-goto byte-goto)))) - ) - (setq keep-going t)) - - ;; - ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos - ;; stack-set-M [discard/discardN ...] --> discardN - ;; - ((and (eq (car lap0) 'byte-stack-set) - (memq (car lap1) '(byte-discard byte-discardN)) - (progn - ;; See if enough discard operations follow to expose or - ;; destroy the value stored by the stack-set. - (setq tmp (cdr rest)) - (setq tmp2 (1- (cdr lap0))) - (setq tmp3 0) - (while (memq (car (car tmp)) '(byte-discard byte-discardN)) - (setq tmp3 - (+ tmp3 (if (eq (car (car tmp)) 'byte-discard) - 1 - (cdr (car tmp))))) - (setq tmp (cdr tmp))) - (>= tmp3 tmp2))) - ;; Do the optimization. - (setq lap (delq lap0 lap)) - (setcar lap1 - (if (= tmp2 tmp3) - ;; The value stored is the new TOS, so pop one more - ;; value (to get rid of the old value) using the - ;; TOS-preserving discard operator. - 'byte-discardN-preserve-tos - ;; Otherwise, the value stored is lost, so just use a - ;; normal discard. - 'byte-discardN)) - (setcdr lap1 (1+ tmp3)) - (setcdr (cdr rest) tmp) - (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s" - lap0 lap1)) - - ;; - ;; discardN-preserve-tos return --> return - ;; dup return --> return - ;; stack-set-N return --> return ; where N is TOS-1 - ;; - ((and (eq (car lap1) 'byte-return) - (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup)) - (and (eq (car lap0) 'byte-stack-set) - (= (cdr lap0) 1)))) - (setq keep-going t) - ;; The byte-code interpreter will pop the stack for us, so - ;; we can just leave stuff on it. - (setq lap (delq lap0 lap)) - (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1)) - - ;; - ;; goto-X ... X: discard ==> discard goto-Y ... X: discard Y: - ;; - ((and (eq (car lap0) 'byte-goto) - (setq tmp (cdr (memq (cdr lap0) lap))) - (memq (caar tmp) '(byte-discard byte-discardN - byte-discardN-preserve-tos))) - (byte-compile-log-lap - " goto-X .. X: \t-->\t%s goto-X.. X: %s Y:" - (car tmp) (car tmp)) - (setq keep-going t) - (let* ((newtag (byte-compile-make-tag)) - ;; Make a copy, since we sometimes modify insts in-place! - (newdiscard (cons (caar tmp) (cdar tmp))) - (newjmp (cons (car lap0) newtag))) - (push newtag (cdr tmp)) ;Push new tag after the discard. - (setcar rest newdiscard) - (push newjmp (cdr rest)))) - - ;; - ;; const discardN-preserve-tos ==> discardN const - ;; - ((and (eq (car lap0) 'byte-constant) - (eq (car lap1) 'byte-discardN-preserve-tos)) - (setq keep-going t) - (let ((newdiscard (cons 'byte-discardN (cdr lap1)))) - (byte-compile-log-lap - " %s %s\t-->\t%s %s" lap0 lap1 newdiscard lap0) - (setf (car rest) newdiscard) - (setf (cadr rest) lap0))) - ) - (setq rest (cdr rest))) - ) + (byte-compile-log-lap " ---- %s pass" + (if (eq keep-going 'first-time) "first" "next")) + (setq keep-going nil) + (let ((prev lap-head)) + (while (cdr prev) + (let* ((rest (cdr prev)) + (lap0 (car rest)) + (lap1 (nth 1 rest)) + (lap2 (nth 2 rest))) + + ;; You may notice that sequences like "dup varset discard" are + ;; optimized but sequences like "dup varset TAG1: discard" are not. + ;; You may be tempted to change this; resist that temptation. + + ;; Each clause in this `cond' statement must keep `prev' the + ;; predecessor of the remainder of the list for inspection. + (cond + ;; + ;; PUSH(K) discard(N) --> <deleted> discard(N-K), N>K + ;; PUSH(K) discard(N) --> <deleted>, N=K + ;; where PUSH(K) is a side-effect-free op such as + ;; const, varref, dup + ;; + ((and (memq (car lap1) '(byte-discard byte-discardN)) + (memq (car lap0) side-effect-free)) + (setq keep-going t) + (let* ((pushes (aref byte-stack+-info (symbol-value (car lap0)))) + (pops (if (eq (car lap1) 'byte-discardN) (cdr lap1) 1)) + (net-pops (- pops pushes))) + (cond ((= net-pops 0) + (byte-compile-log-lap " %s %s\t-->\t<deleted>" + lap0 lap1) + (setcdr prev (cddr rest))) + ((> net-pops 0) + (byte-compile-log-lap + " %s %s\t-->\t<deleted> discard(%d)" + lap0 lap1 net-pops) + (setcar rest (if (eql net-pops 1) + (cons 'byte-discard nil) + (cons 'byte-discardN net-pops))) + (setcdr rest (cddr rest))) + (t (error "Optimizer error: too much on the stack"))))) + ;; + ;; goto(X) X: --> X: + ;; goto-if-[not-]nil(X) X: --> discard X: + ;; + ((and (memq (car lap0) byte-goto-ops) + (eq (cdr lap0) lap1)) + (cond ((eq (car lap0) 'byte-goto) + (byte-compile-log-lap " %s %s\t-->\t<deleted> %s" + lap0 lap1 lap1) + (setcdr prev (cdr rest))) + ((memq (car lap0) byte-goto-always-pop-ops) + (byte-compile-log-lap " %s %s\t-->\tdiscard %s" + lap0 lap1 lap1) + (setcar lap0 'byte-discard) + (setcdr lap0 0)) + ;; goto-*-else-pop(X) cannot occur here because it would + ;; be a depth conflict. + (t (error "Depth conflict at tag %d" (nth 2 lap0)))) + (setq keep-going t)) + ;; + ;; varset-X varref-X --> dup varset-X + ;; varbind-X varref-X --> dup varbind-X + ;; const/dup varset-X varref-X --> const/dup varset-X const/dup + ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup + ;; The latter two can enable other optimizations. + ;; + ;; For lexical variables, we could do the same + ;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2 + ;; but this is a very minor gain, since dup is stack-ref-0, + ;; i.e. it's only better if X>5, and even then it comes + ;; at the cost of an extra stack slot. Let's not bother. + ((and (eq 'byte-varref (car lap2)) + (eq (cdr lap1) (cdr lap2)) + (memq (car lap1) '(byte-varset byte-varbind)) + (let ((tmp (memq (car (cdr lap2)) byte-boolean-vars))) + (and + (not (and tmp (not (eq (car lap0) 'byte-constant)))) + (progn + (setq keep-going t) + (if (memq (car lap0) '(byte-constant byte-dup)) + (let ((tmp (if (or (not tmp) + (macroexp--const-symbol-p + (car (cdr lap0)))) + (cdr lap0) + (byte-compile-get-constant t)))) + (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" + lap0 lap1 lap2 lap0 lap1 + (cons (car lap0) tmp)) + (setcar lap2 (car lap0)) + (setcdr lap2 tmp)) + (byte-compile-log-lap " %s %s\t-->\tdup %s" + lap1 lap2 lap1) + (setcar lap2 (car lap1)) + (setcar lap1 'byte-dup) + (setcdr lap1 0) + ;; The stack depth gets locally increased, so we will + ;; increase maxdepth in case depth = maxdepth here. + ;; This can cause the third argument to byte-code to + ;; be larger than necessary. + (setq add-depth 1)) + 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 + (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 + ;; + ;; it is wrong to do the same thing for the -else-pop variants. + ;; + ((and (eq 'byte-not (car lap0)) + (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil))) + (let ((not-goto (if (eq (car lap1) 'byte-goto-if-nil) + 'byte-goto-if-not-nil + 'byte-goto-if-nil))) + (byte-compile-log-lap " not %s\t-->\t%s" + lap1 (cons not-goto (cdr lap1))) + (setcar lap1 not-goto) + (setcdr prev (cdr rest)) ; delete not + (setq keep-going t))) + ;; + ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X: + ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X: + ;; + ;; it is wrong to do the same thing for the -else-pop variants. + ;; + ((and (memq (car lap0) + '(byte-goto-if-nil byte-goto-if-not-nil)) ; gotoX + (eq 'byte-goto (car lap1)) ; gotoY + (eq (cdr lap0) lap2)) ; TAG X + (let ((inverse (if (eq 'byte-goto-if-nil (car lap0)) + 'byte-goto-if-not-nil 'byte-goto-if-nil))) + (byte-compile-log-lap " %s %s %s\t-->\t%s %s" + lap0 lap1 lap2 + (cons inverse (cdr lap1)) lap2) + (setcdr prev (cdr rest)) + (setcar lap1 inverse) + (setq keep-going t))) + ;; + ;; const goto-if-* --> whatever + ;; + ((and (eq 'byte-constant (car lap0)) + (memq (car lap1) byte-conditional-ops) + ;; Must be an actual constant, not a closure variable. + (consp (cdr lap0))) + (cond ((if (memq (car lap1) '(byte-goto-if-nil + byte-goto-if-nil-else-pop)) + (car (cdr lap0)) + (not (car (cdr lap0)))) + ;; Branch not taken. + (byte-compile-log-lap " %s %s\t-->\t<deleted>" + lap0 lap1) + (setcdr prev (cddr rest))) ; delete both + ((memq (car lap1) byte-goto-always-pop-ops) + ;; Always-pop branch taken. + (byte-compile-log-lap " %s %s\t-->\t%s" + lap0 lap1 + (cons 'byte-goto (cdr lap1))) + (setcdr prev (cdr rest)) ; delete const + (setcar lap1 'byte-goto)) + (t ; -else-pop branch taken: keep const + (byte-compile-log-lap " %s %s\t-->\t%s %s" + lap0 lap1 + lap0 (cons 'byte-goto (cdr lap1))) + (setcar lap1 'byte-goto))) + (setq keep-going t)) + ;; + ;; varref-X varref-X --> varref-X dup + ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup + ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup + ;; We don't optimize the const-X variations on this here, + ;; because that would inhibit some goto optimizations; we + ;; optimize the const-X case after all other optimizations. + ;; + ((and (memq (car lap0) '(byte-varref byte-stack-ref)) + (let ((tmp (cdr rest)) + (tmp2 0)) + (while (eq (car (car tmp)) 'byte-dup) + (setq tmp2 (1+ tmp2)) + (setq tmp (cdr tmp))) + (and (eq (if (eq 'byte-stack-ref (car lap0)) + (+ tmp2 1 (cdr lap0)) + (cdr lap0)) + (cdr (car tmp))) + (eq (car lap0) (car (car tmp))) + (progn + (when (memq byte-optimize-log '(t byte)) + (let ((str "") + (tmp2 (cdr rest))) + (while (not (eq tmp tmp2)) + (setq tmp2 (cdr tmp2)) + (setq str (concat str " dup"))) + (byte-compile-log-lap " %s%s %s\t-->\t%s%s dup" + lap0 str lap0 lap0 str))) + (setq keep-going t) + (setcar (car tmp) 'byte-dup) + (setcdr (car tmp) 0) + t))))) + ;; + ;; TAG1: TAG2: --> <deleted> TAG2: + ;; (and other references to TAG1 are replaced with TAG2) + ;; + ((and (eq (car lap0) 'TAG) + (eq (car lap1) 'TAG)) + (byte-compile-log-lap " adjacent tags %d and %d merged" + (nth 1 lap1) (nth 1 lap0)) + (let ((tmp3 (cdr lap-head))) + (while (let ((tmp2 (rassq lap0 tmp3))) + (and tmp2 + (progn + (setcdr tmp2 lap1) + (setq tmp3 (cdr (memq tmp2 tmp3))) + t)))) + (setcdr prev (cdr rest)) + (setq keep-going t) + ;; replace references to tag in jump tables, if any + (dolist (table byte-compile-jump-tables) + (maphash #'(lambda (value tag) + (when (equal tag lap0) + (puthash value lap1 table))) + table)))) + ;; + ;; unused-TAG: --> <deleted> + ;; + ((and (eq 'TAG (car lap0)) + (not (rassq lap0 (cdr lap-head))) + ;; make sure this tag isn't used in a jump-table + (cl-loop for table in byte-compile-jump-tables + when (member lap0 (hash-table-values table)) + return nil finally return t)) + (byte-compile-log-lap " unused tag %d removed" (nth 1 lap0)) + (setcdr prev (cdr rest)) + (setq keep-going t)) + ;; + ;; goto ... --> goto <delete until TAG or end> + ;; return ... --> return <delete until TAG or end> + ;; + ((and (memq (car lap0) '(byte-goto byte-return)) + (not (memq (car lap1) '(TAG nil)))) + (let ((i 0) + (tmp rest) + (opt-p (memq byte-optimize-log '(t byte))) + str deleted) + (while (and (setq tmp (cdr tmp)) + (not (eq 'TAG (car (car tmp))))) + (if opt-p (setq deleted (cons (car tmp) deleted) + str (concat str " %s") + i (1+ i)))) + (if opt-p + (let ((tagstr + (if (eq 'TAG (car (car tmp))) + (format "%d:" (car (cdr (car tmp)))) + (or (car tmp) "")))) + (if (< i 6) + (apply 'byte-compile-log-lap-1 + (concat " %s" str + " %s\t-->\t%s <deleted> %s") + lap0 + (nconc (nreverse deleted) + (list tagstr lap0 tagstr))) + (byte-compile-log-lap + " %s <%d unreachable op%s> %s\t-->\t%s <deleted> %s" + lap0 i (if (= i 1) "" "s") + tagstr lap0 tagstr)))) + (setcdr rest tmp) + (setq keep-going t))) + ;; + ;; <safe-op> unbind --> unbind <safe-op> + ;; (this may enable other optimizations.) + ;; + ((and (eq 'byte-unbind (car lap1)) + (memq (car lap0) byte-after-unbind-ops)) + (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0) + (setcar rest lap1) + (setcar (cdr rest) lap0) + (setq keep-going t)) + ;; + ;; varbind-X unbind-N --> discard unbind-(N-1) + ;; save-excursion unbind-N --> unbind-(N-1) + ;; save-restriction unbind-N --> unbind-(N-1) + ;; save-current-buffer unbind-N --> unbind-(N-1) + ;; + ((and (eq 'byte-unbind (car lap1)) + (memq (car lap0) '(byte-varbind byte-save-excursion + byte-save-restriction + byte-save-current-buffer)) + (< 0 (cdr lap1))) + (setcdr lap1 (1- (cdr lap1))) + (when (zerop (cdr lap1)) + (setcdr rest (cddr rest))) + (if (eq (car lap0) 'byte-varbind) + (setcar rest (cons 'byte-discard 0)) + (setcdr prev (cddr prev))) + (byte-compile-log-lap " %s %s\t-->\t%s %s" + lap0 (cons (car lap1) (1+ (cdr lap1))) + (if (eq (car lap0) 'byte-varbind) + (car rest) + (car (cdr rest))) + (if (and (/= 0 (cdr lap1)) + (eq (car lap0) 'byte-varbind)) + (car (cdr rest)) + "")) + (setq keep-going t)) + ;; + ;; goto*-X ... X: goto-Y --> goto*-Y + ;; goto-X ... X: return --> return + ;; + ((and (memq (car lap0) byte-goto-ops) + (let ((tmp (nth 1 (memq (cdr lap0) (cdr lap-head))))) + (and + (memq (car tmp) '(byte-goto byte-return)) + (or (eq (car lap0) 'byte-goto) + (eq (car tmp) 'byte-goto)) + (not (eq (cdr tmp) (cdr lap0))) + (progn + (byte-compile-log-lap " %s [%s]\t-->\t%s" + (car lap0) tmp + (if (eq (car tmp) 'byte-return) + tmp + (cons (car lap0) (cdr tmp)))) + (when (eq (car tmp) 'byte-return) + (setcar lap0 'byte-return)) + (setcdr lap0 (cdr tmp)) + (setq keep-going t) + t))))) + + ;; + ;; OP goto(X) Y: OP X: -> Y: OP X: + ;; + ((and (eq (car lap1) 'byte-goto) + (eq (car lap2) 'TAG) + (let ((lap3 (nth 3 rest))) + (and (eq (car lap0) (car lap3)) + (eq (cdr lap0) (cdr lap3)) + (eq (cdr lap1) (nth 4 rest))))) + (byte-compile-log-lap " %s %s %s %s %s\t-->\t%s %s %s" + lap0 lap1 lap2 + (nth 3 rest) (nth 4 rest) + lap2 (nth 3 rest) (nth 4 rest)) + (setcdr prev (cddr rest)) + (setq keep-going t)) + + ;; + ;; 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 (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)) + (memq (car lap0) side-effect-free))) + (setq keep-going t) + (setq add-depth 1) + (setcdr prev (cdr rest)) + (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 + ;; + ((and (memq (car lap0) '(byte-goto-if-nil-else-pop + byte-goto-if-not-nil-else-pop)) + (let ((tmp (cdr (memq (cdr lap0) (cdr lap-head))))) + (and + (memq (caar tmp) + (eval-when-compile + (cons 'byte-discard byte-conditional-ops))) + (not (eq lap0 (car tmp))) + (let ((tmp2 (car tmp)) + (tmp3 (assq (car lap0) + '((byte-goto-if-nil-else-pop + byte-goto-if-nil) + (byte-goto-if-not-nil-else-pop + byte-goto-if-not-nil))))) + (if (memq (car tmp2) tmp3) + (progn (setcar lap0 (car tmp2)) + (setcdr lap0 (cdr tmp2)) + (byte-compile-log-lap + " %s-else-pop [%s]\t-->\t%s" + (car lap0) tmp2 lap0)) + ;; Get rid of the -else-pop's and jump one + ;; step further. + (or (eq 'TAG (car (nth 1 tmp))) + (setcdr tmp (cons (byte-compile-make-tag) + (cdr tmp)))) + (byte-compile-log-lap " %s [%s]\t-->\t%s <skip>" + (car lap0) tmp2 (nth 1 tmp3)) + (setcar lap0 (nth 1 tmp3)) + (setcdr lap0 (nth 1 tmp))) + (setq keep-going t) + t))))) + ;; + ;; const goto-X ... X: goto-if-* --> whatever + ;; const goto-X ... X: discard --> whatever + ;; + ((and (eq (car lap0) 'byte-constant) + (eq (car lap1) 'byte-goto) + (let ((tmp (cdr (memq (cdr lap1) (cdr lap-head))))) + (and + (memq (caar tmp) + (eval-when-compile + (cons 'byte-discard byte-conditional-ops))) + (not (eq lap1 (car tmp))) + (let ((tmp2 (car tmp))) + (cond ((and (consp (cdr lap0)) + (memq (car tmp2) + (if (null (car (cdr lap0))) + '(byte-goto-if-nil + byte-goto-if-nil-else-pop) + '(byte-goto-if-not-nil + byte-goto-if-not-nil-else-pop)))) + (byte-compile-log-lap + " %s goto [%s]\t-->\t%s %s" + lap0 tmp2 lap0 tmp2) + (setcar lap1 (car tmp2)) + (setcdr lap1 (cdr tmp2)) + ;; Let next step fix the (const,goto-if*) seq. + (setq keep-going t)) + ((or (consp (cdr lap0)) + (eq (car tmp2) 'byte-discard)) + ;; Jump one step further + (byte-compile-log-lap + " %s goto [%s]\t-->\t<deleted> goto <skip>" + lap0 tmp2) + (or (eq 'TAG (car (nth 1 tmp))) + (setcdr tmp (cons (byte-compile-make-tag) + (cdr tmp)))) + (setcdr lap1 (car (cdr tmp))) + (setcdr prev (cdr rest)) + (setq keep-going t)) + (t + (setq prev (cdr prev)))) + t))))) + ;; + ;; X: varref-Y ... varset-Y goto-X --> + ;; X: varref-Y Z: ... dup varset-Y goto-Z + ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.) + ;; (This is so usual for while loops that it is worth handling). + ;; + ;; Here again, we could do it for stack-ref/stack-set, but + ;; that's replacing a stack-ref-Y with a stack-ref-0, which + ;; is a very minor improvement (if any), at the cost of + ;; more stack use and more byte-code. Let's not do it. + ;; + ((and (eq (car lap1) 'byte-varset) + (eq (car lap2) 'byte-goto) + (not (memq (cdr lap2) rest)) ;Backwards jump + (let ((tmp (cdr (memq (cdr lap2) (cdr lap-head))))) + (and + (eq (car (car tmp)) 'byte-varref) + (eq (cdr (car tmp)) (cdr lap1)) + (not (memq (car (cdr lap1)) byte-boolean-vars)) + (let ((newtag (byte-compile-make-tag))) + (byte-compile-log-lap + " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s" + (nth 1 (cdr lap2)) (car tmp) + lap1 lap2 + (nth 1 (cdr lap2)) (car tmp) + (nth 1 newtag) 'byte-dup lap1 + (cons 'byte-goto newtag) + ) + (setcdr rest (cons (cons 'byte-dup 0) (cdr rest))) + (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp))) + (setq add-depth 1) + (setq keep-going t) + t))))) + ;; + ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y: + ;; (This can pull the loop test to the end of the loop) + ;; + ((and (eq (car lap0) 'byte-goto) + (eq (car lap1) 'TAG) + (let ((tmp (cdr (memq (cdr lap0) (cdr lap-head))))) + (and + (eq lap1 (cdar tmp)) + (memq (car (car tmp)) + '( byte-goto byte-goto-if-nil byte-goto-if-not-nil + byte-goto-if-nil-else-pop)) + (let ((newtag (byte-compile-make-tag))) + (byte-compile-log-lap + " %s %s ... %s %s\t-->\t%s ... %s" + lap0 lap1 (cdr lap0) (car tmp) + (cons (cdr (assq (car (car tmp)) + '((byte-goto-if-nil + . byte-goto-if-not-nil) + (byte-goto-if-not-nil + . byte-goto-if-nil) + (byte-goto-if-nil-else-pop + . byte-goto-if-not-nil-else-pop) + (byte-goto-if-not-nil-else-pop + . byte-goto-if-nil-else-pop)))) + newtag) + newtag) + (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp))) + (when (eq (car (car tmp)) 'byte-goto-if-nil-else-pop) + ;; We can handle this case but not the + ;; -if-not-nil case, because we won't know + ;; which non-nil constant to push. + (setcdr rest + (cons (cons 'byte-constant + (byte-compile-get-constant nil)) + (cdr rest)))) + (setcar lap0 (nth 1 (memq (car (car tmp)) + '(byte-goto-if-nil-else-pop + byte-goto-if-not-nil + byte-goto-if-nil + byte-goto-if-not-nil + byte-goto byte-goto)))) + (setq keep-going t) + t))))) + + ;; + ;; discardN-preserve-tos(X) discardN-preserve-tos(Y) + ;; --> discardN-preserve-tos(X+Y) + ;; where stack-set(1) is accepted as discardN-preserve-tos(1) + ;; + ((and (or (eq (car lap0) 'byte-discardN-preserve-tos) + (and (eq (car lap0) 'byte-stack-set) + (eql (cdr lap0) 1))) + (or (eq (car lap1) 'byte-discardN-preserve-tos) + (and (eq (car lap1) 'byte-stack-set) + (eql (cdr lap1) 1)))) + (setq keep-going t) + (let ((new-op (cons 'byte-discardN-preserve-tos + ;; This happens to work even when either + ;; op is stack-set(1). + (+ (cdr lap0) (cdr lap1))))) + (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 new-op) + (setcar rest new-op) + (setcdr rest (cddr rest)))) + + ;; + ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos + ;; stack-set-M [discard/discardN ...] --> discardN + ;; + ((and (eq (car lap0) 'byte-stack-set) + (memq (car lap1) '(byte-discard byte-discardN)) + (let ((tmp2 (1- (cdr lap0))) + (tmp3 0) + (tmp (cdr rest))) + ;; See if enough discard operations follow to expose or + ;; destroy the value stored by the stack-set. + (while (memq (car (car tmp)) '(byte-discard byte-discardN)) + (setq tmp3 + (+ tmp3 (if (eq (car (car tmp)) 'byte-discard) + 1 + (cdr (car tmp))))) + (setq tmp (cdr tmp))) + (and + (>= tmp3 tmp2) + (progn + ;; Do the optimization. + (setcdr prev (cdr rest)) + (setcar lap1 + (if (= tmp2 tmp3) + ;; The value stored is the new TOS, so pop + ;; one more value (to get rid of the old + ;; value) using TOS-preserving discard. + 'byte-discardN-preserve-tos + ;; Otherwise, the value stored is lost, + ;; so just use a normal discard. + 'byte-discardN)) + (setcdr lap1 (1+ tmp3)) + (setcdr (cdr rest) tmp) + (byte-compile-log-lap + " %s [discard/discardN]...\t-->\t%s" lap0 lap1) + (setq keep-going t) + t + ))))) + + ;; + ;; discardN-preserve-tos return --> return + ;; dup return --> return + ;; stack-set(1) return --> return + ;; + ((and (eq (car lap1) 'byte-return) + (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup)) + (and (eq (car lap0) 'byte-stack-set) + (= (cdr lap0) 1)))) + (setq keep-going t) + ;; The byte-code interpreter will pop the stack for us, so + ;; we can just leave stuff on it. + (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: + ;; + ((and (eq (car lap0) 'byte-goto) + (let ((tmp (cdr (memq (cdr lap0) (cdr lap-head))))) + (and + tmp + (or (memq (caar tmp) '(byte-discard byte-discardN)) + ;; Make sure we don't hoist a discardN-preserve-tos + ;; that really should be merged or deleted instead. + (and (eq (caar tmp) 'byte-discardN-preserve-tos) + (let ((next (cadr tmp))) + (not (or (memq (car next) + '(byte-discardN-preserve-tos + byte-return)) + (and (eq (car next) 'byte-stack-set) + (eql (cdr next) 1))))))) + (progn + (byte-compile-log-lap + " goto-X .. X: \t-->\t%s goto-X.. X: %s Y:" + (car tmp) (car tmp)) + (setq keep-going t) + (let* ((newtag (byte-compile-make-tag)) + ;; Make a copy, since we sometimes modify + ;; insts in-place! + (newdiscard (cons (caar tmp) (cdar tmp))) + (newjmp (cons (car lap0) newtag))) + ;; Push new tag after the discard. + (push newtag (cdr tmp)) + (setcar rest newdiscard) + (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)) + + ;; + ;; PRODUCER discardN-preserve-tos(X) --> discard(X) PRODUCER + ;; where PRODUCER pushes a result without looking at the stack: + ;; const, varref, point etc. + ;; + ((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))) + ;; 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) + (cons 'byte-discardN (cdr lap1))))) + (byte-compile-log-lap + " %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)))))))) ;; Cleanup stage: ;; Rebuild byte-compile-constants / byte-compile-variables. ;; Simple optimizations that would inhibit other optimizations if they @@ -2542,90 +2833,84 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; need to do more than once. (setq byte-compile-constants nil byte-compile-variables nil) - (setq rest lap) (byte-compile-log-lap " ---- final pass") - (while rest - (setq lap0 (car rest) - lap1 (nth 1 rest)) - (if (memq (car lap0) byte-constref-ops) - (if (memq (car lap0) '(byte-constant byte-constant2)) - (unless (memq (cdr lap0) byte-compile-constants) - (setq byte-compile-constants (cons (cdr lap0) - byte-compile-constants))) - (unless (memq (cdr lap0) byte-compile-variables) - (setq byte-compile-variables (cons (cdr lap0) - byte-compile-variables))))) - (cond (;; - ;; const-C varset-X const-C --> const-C dup varset-X - ;; const-C varbind-X const-C --> const-C dup varbind-X - ;; - (and (eq (car lap0) 'byte-constant) - (eq (car (nth 2 rest)) 'byte-constant) - (eq (cdr lap0) (cdr (nth 2 rest))) - (memq (car lap1) '(byte-varbind byte-varset))) - (byte-compile-log-lap " %s %s %s\t-->\t%s dup %s" - lap0 lap1 lap0 lap0 lap1) - (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1))) - (setcar (cdr rest) (cons 'byte-dup 0)) - (setq add-depth 1)) - ;; - ;; const-X [dup/const-X ...] --> const-X [dup ...] dup - ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup - ;; - ((memq (car lap0) '(byte-constant byte-varref)) - (setq tmp rest - tmp2 nil) - (while (progn - (while (eq 'byte-dup (car (car (setq tmp (cdr tmp)))))) - (and (eq (cdr lap0) (cdr (car tmp))) - (eq (car lap0) (car (car tmp))))) - (setcar tmp (cons 'byte-dup 0)) - (setq tmp2 t)) - (if tmp2 - (byte-compile-log-lap - " %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0))) - ;; - ;; unbind-N unbind-M --> unbind-(N+M) - ;; - ((and (eq 'byte-unbind (car lap0)) - (eq 'byte-unbind (car lap1))) - (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 - (cons 'byte-unbind - (+ (cdr lap0) (cdr lap1)))) - (setq lap (delq lap0 lap)) - (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) - - ;; - ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y --> - ;; discardN-(X+Y) - ;; - ((and (memq (car lap0) - '(byte-discard byte-discardN - byte-discardN-preserve-tos)) - (memq (car lap1) '(byte-discard byte-discardN))) - (setq lap (delq lap0 lap)) - (byte-compile-log-lap - " %s %s\t-->\t(discardN %s)" - lap0 lap1 - (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) - (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) - (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) - (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) - (setcar lap1 'byte-discardN)) - - ;; - ;; discardN-preserve-tos-X discardN-preserve-tos-Y --> - ;; discardN-preserve-tos-(X+Y) - ;; - ((and (eq (car lap0) 'byte-discardN-preserve-tos) - (eq (car lap1) 'byte-discardN-preserve-tos)) - (setq lap (delq lap0 lap)) - (setcdr lap1 (+ (cdr lap0) (cdr lap1))) - (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (car rest))) - ) - (setq rest (cdr rest))) - (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth))) - lap) + (let ((prev lap-head)) + (while (cdr prev) + (let* ((rest (cdr prev)) + (lap0 (car rest)) + (lap1 (nth 1 rest))) + ;; FIXME: Would there ever be a `byte-constant2' op here? + (if (memq (car lap0) byte-constref-ops) + (if (memq (car lap0) '(byte-constant byte-constant2)) + (unless (memq (cdr lap0) byte-compile-constants) + (setq byte-compile-constants (cons (cdr lap0) + byte-compile-constants))) + (unless (memq (cdr lap0) byte-compile-variables) + (setq byte-compile-variables (cons (cdr lap0) + byte-compile-variables))))) + (cond + ;; + ;; const-C varset-X const-C --> const-C dup varset-X + ;; const-C varbind-X const-C --> const-C dup varbind-X + ;; + ((and (eq (car lap0) 'byte-constant) + (eq (car (nth 2 rest)) 'byte-constant) + (eq (cdr lap0) (cdr (nth 2 rest))) + (memq (car lap1) '(byte-varbind byte-varset))) + (byte-compile-log-lap " %s %s %s\t-->\t%s dup %s" + lap0 lap1 lap0 lap0 lap1) + (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1))) + (setcar (cdr rest) (cons 'byte-dup 0)) + (setq add-depth 1)) + ;; + ;; const-X [dup/const-X ...] --> const-X [dup ...] dup + ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup + ;; + ((memq (car lap0) '(byte-constant byte-varref)) + (let ((tmp rest) + (tmp2 nil)) + (while (progn + (while (eq 'byte-dup (car (car (setq tmp (cdr tmp)))))) + (and (eq (cdr lap0) (cdr (car tmp))) + (eq (car lap0) (car (car tmp))))) + (setcar tmp (cons 'byte-dup 0)) + (setq tmp2 t)) + (if tmp2 + (byte-compile-log-lap + " %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0) + (setq prev (cdr prev))))) + ;; + ;; unbind-N unbind-M --> unbind-(N+M) + ;; + ((and (eq 'byte-unbind (car lap0)) + (eq 'byte-unbind (car lap1))) + (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 + (cons 'byte-unbind + (+ (cdr lap0) (cdr lap1)))) + (setcdr prev (cdr rest)) + (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) + + ;; + ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y --> + ;; discardN-(X+Y) + ;; + ((and (memq (car lap0) + '(byte-discard byte-discardN + byte-discardN-preserve-tos)) + (memq (car lap1) '(byte-discard byte-discardN))) + (setcdr prev (cdr rest)) + (byte-compile-log-lap + " %s %s\t-->\t(discardN %s)" + lap0 lap1 + (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) + (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) + (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) + (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) + (setcar lap1 'byte-discardN)) + (t + (setq prev (cdr prev))))))) + (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)) + (cdr lap-head))) (provide 'byte-opt) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index eb7d026b146..9345665eea8 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -262,7 +262,8 @@ This is used by `declare'.") (interactive-form nil) (warnings nil) (warn #'(lambda (msg form) - (push (macroexp-warn-and-return msg nil nil t form) + (push (macroexp-warn-and-return + (format-message msg) nil nil t form) warnings)))) (while (and body @@ -649,11 +650,11 @@ in `byte-compile-warning-types'; see the variable `byte-compile-warnings' for a fuller explanation of the warning types. The types that can be suppressed with this macro are `free-vars', `callargs', `redefine', `obsolete', -`interactive-only', `lexical', `mapcar', `constants' and -`suspicious'. +`interactive-only', `lexical', `mapcar', `constants', +`suspicious' and `empty-body'. For the `mapcar' case, only the `mapcar' function can be used in -the symbol list. For `suspicious', only `set-buffer' and `lsh' can be used." +the symbol list." ;; Note: during compilation, this definition is overridden by the one in ;; byte-compile-initial-macro-environment. (declare (debug (sexp body)) (indent 1)) @@ -679,11 +680,11 @@ Otherwise, return nil. For internal use only." ;; This is called from lread.c and therefore needs to be preloaded. (if lread--unescaped-character-literals (let ((sorted (sort lread--unescaped-character-literals #'<))) - (format-message "unescaped character literals %s detected, %s expected!" - (mapconcat (lambda (char) (format "`?%c'" char)) - sorted ", ") - (mapconcat (lambda (char) (format "`?\\%c'" char)) - sorted ", "))))) + (format "unescaped character literals %s detected, %s expected!" + (mapconcat (lambda (char) (format-message "`?%c'" char)) + sorted ", ") + (mapconcat (lambda (char) (format-message "`?\\%c'" char)) + sorted ", "))))) (defun byte-compile-info (string &optional message type) "Format STRING in a way that looks pleasing in the compilation output. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5df1205869c..a122e81ba3c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -295,7 +295,8 @@ The information is logged to `byte-compile-log-buffer'." '(redefine callargs free-vars unresolved obsolete noruntime interactive-only make-local mapcar constants suspicious lexical lexical-dynamic - docstrings docstrings-non-ascii-quotes not-unused) + docstrings docstrings-non-ascii-quotes not-unused + empty-body) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t "List of warnings that the byte-compiler should issue (t for almost all). @@ -326,6 +327,7 @@ Elements of the list may be: docstrings-non-ascii-quotes docstrings that have non-ASCII quotes. This depends on the `docstrings' warning type. suspicious constructs that usually don't do what the coder wanted. + empty-body body argument to a special form or macro is empty. If the list begins with `not', then the remaining elements specify warnings to suppress. For example, (not mapcar) will suppress warnings about mapcar. @@ -493,6 +495,42 @@ Return the compile-time value of FORM." (cdr form))) (funcall non-toplevel-case form))) + +(defvar bytecomp--copy-tree-seen) + +(defun bytecomp--copy-tree-1 (tree) + ;; TREE must be a cons. + (or (gethash tree bytecomp--copy-tree-seen) + (let* ((next (cdr tree)) + (result (cons nil next)) + (copy result)) + (while (progn + (puthash tree copy bytecomp--copy-tree-seen) + (let ((a (car tree))) + (setcar copy (if (consp a) + (bytecomp--copy-tree-1 a) + a))) + (and (consp next) + (let ((tail (gethash next bytecomp--copy-tree-seen))) + (if tail + (progn (setcdr copy tail) + nil) + (setq tree next) + (setq next (cdr next)) + (let ((prev copy)) + (setq copy (cons nil next)) + (setcdr prev copy) + t)))))) + result))) + +(defun bytecomp--copy-tree (tree) + "Make a copy of TREE, preserving any circular structure therein. +Only conses are traversed and duplicated, not arrays or any other structure." + (if (consp tree) + (let ((bytecomp--copy-tree-seen (make-hash-table :test #'eq))) + (bytecomp--copy-tree-1 tree)) + tree)) + (defconst byte-compile-initial-macro-environment `( ;; (byte-compiler-options . (lambda (&rest forms) @@ -528,11 +566,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 + (bytecomp--copy-tree expanded)) + lexical-binding) expanded))))) (with-suppressed-warnings . ,(lambda (warnings &rest body) @@ -541,15 +580,19 @@ Return the compile-time value of FORM." ;; Later `internal--with-suppressed-warnings' binds it again, this ;; time in order to affect warnings emitted during the ;; compilation itself. - (let ((byte-compile--suppressed-warnings - (append warnings byte-compile--suppressed-warnings))) - ;; This function doesn't exist, but is just a placeholder - ;; symbol to hook up with the - ;; `byte-hunk-handler'/`byte-defop-compiler-1' machinery. - `(internal--with-suppressed-warnings - ',warnings - ,(macroexpand-all `(progn ,@body) - macroexpand-all-environment)))))) + (if body + (let ((byte-compile--suppressed-warnings + (append warnings byte-compile--suppressed-warnings))) + ;; This function doesn't exist, but is just a placeholder + ;; symbol to hook up with the + ;; `byte-hunk-handler'/`byte-defop-compiler-1' machinery. + `(internal--with-suppressed-warnings + ',warnings + ,(macroexpand-all `(progn ,@body) + macroexpand-all-environment))) + (macroexp-warn-and-return + (format-message "`with-suppressed-warnings' with empty body") + nil '(empty-body with-suppressed-warnings) t warnings))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") @@ -1569,7 +1612,7 @@ extra args." "`%s' called with %d args to fill %d format field(s)" (car form) nargs nfields))))) -(dolist (elt '(format message error)) +(dolist (elt '(format message format-message error)) (put elt 'byte-compile-format-like t)) (defun byte-compile--suspicious-defcustom-choice (type) @@ -1766,10 +1809,16 @@ It is too wide if it has any lines longer than the largest of kind name col)) ;; There's a "naked" ' character before a symbol/list, so it ;; should probably be quoted with \=. - (when (string-match-p "\\( [\"#]\\|[ \t]\\|^\\)'[a-z(]" docs) + (when (string-match-p (rx (| (in " \t") bol) + (? (in "\"#")) + "'" + (in "A-Za-z" "(")) + docs) (byte-compile-warn-x - name "%s%sdocstring has wrong usage of unescaped single quotes (use \\= or different quoting)" - kind name)) + name + (concat "%s%sdocstring has wrong usage of unescaped single quotes" + " (use \\=%c or different quoting such as %c...%c)") + kind name ?' ?` ?')) ;; There's a "Unicode quote" in the string -- it should probably ;; be an ASCII one instead. (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) @@ -3405,7 +3454,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 @@ -3432,14 +3481,14 @@ 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)) (t ".")))) (if (eq (car-safe (symbol-function (car form))) 'macro) (byte-compile-report-error - (format "`%s' defined after use in %S (missing `require' of a library file?)" + (format-message "`%s' defined after use in %S (missing `require' of a library file?)" (car form) form))) (if (and handler ;; Make sure that function exists. @@ -3736,7 +3785,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" '((0 . byte-compile-no-args) (1 . byte-compile-one-arg) (2 . byte-compile-two-args) - (2-and . byte-compile-and-folded) + (2-cmp . byte-compile-cmp) (3 . byte-compile-three-args) (0-1 . byte-compile-zero-or-one-arg) (1-2 . byte-compile-one-or-two-args) @@ -3815,11 +3864,11 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler cons 2) (byte-defop-compiler aref 2) (byte-defop-compiler set 2) -(byte-defop-compiler (= byte-eqlsign) 2-and) -(byte-defop-compiler (< byte-lss) 2-and) -(byte-defop-compiler (> byte-gtr) 2-and) -(byte-defop-compiler (<= byte-leq) 2-and) -(byte-defop-compiler (>= byte-geq) 2-and) +(byte-defop-compiler (= byte-eqlsign) 2-cmp) +(byte-defop-compiler (< byte-lss) 2-cmp) +(byte-defop-compiler (> byte-gtr) 2-cmp) +(byte-defop-compiler (<= byte-leq) 2-cmp) +(byte-defop-compiler (>= byte-geq) 2-cmp) (byte-defop-compiler get 2) (byte-defop-compiler nth 2) (byte-defop-compiler substring 1-3) @@ -3883,18 +3932,20 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-compile-form (nth 2 form)) (byte-compile-out (get (car form) 'byte-opcode) 0))) -(defun byte-compile-and-folded (form) - "Compile calls to functions like `<='. -These implicitly `and' together a bunch of two-arg bytecodes." - (let ((l (length form))) - (cond - ((< l 3) (byte-compile-form `(progn ,(nth 1 form) t))) - ((= l 3) (byte-compile-two-args form)) - ;; Don't use `cl-every' here (see comment where we require cl-lib). - ((not (memq nil (mapcar #'macroexp-copyable-p (nthcdr 2 form)))) - (byte-compile-form `(and (,(car form) ,(nth 1 form) ,(nth 2 form)) - (,(car form) ,@(nthcdr 2 form))))) - (t (byte-compile-normal-call form))))) +(defun byte-compile-cmp (form) + "Compile calls to numeric comparisons such as `<', `=' etc." + ;; Lisp-level transforms should already have reduced valid calls to 2 args. + (if (not (= (length form) 3)) + (byte-compile-subr-wrong-args form "1 or more") + (byte-compile-two-args + (if (macroexp-const-p (nth 1 form)) + ;; First argument is constant: flip it so that the constant + ;; is last, which may allow more lapcode optimisations. + (let* ((op (car form)) + (flipped-op (cdr (assq op '((< . >) (<= . >=) + (> . <) (>= . <=) (= . =)))))) + (list flipped-op (nth 2 form) (nth 1 form))) + form)))) (defun byte-compile-three-args (form) (if (not (= (length form) 4)) @@ -4049,9 +4100,15 @@ This function is never called when `lexical-binding' is nil." (byte-compile-constant 1) (byte-compile-out (get '* 'byte-opcode) 0)) (3 - (byte-compile-form (nth 1 form)) - (byte-compile-form (nth 2 form)) - (byte-compile-out (get (car form) 'byte-opcode) 0)) + (let ((arg1 (nth 1 form)) + (arg2 (nth 2 form))) + (when (and (memq (car form) '(+ *)) + (macroexp-const-p arg1)) + ;; Put constant argument last for better LAP optimisation. + (cl-rotatef arg1 arg2)) + (byte-compile-form arg1) + (byte-compile-form arg2) + (byte-compile-out (get (car form) 'byte-opcode) 0))) (_ ;; >2 args: compile as a single function call. (byte-compile-normal-call form)))) @@ -4571,6 +4628,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) @@ -4835,6 +4893,11 @@ binding slots have been popped." (dolist (clause (reverse clauses)) (let ((condition (nth 1 clause))) + (when (and (eq (car-safe condition) 'quote) + (cdr condition) (null (cddr condition))) + (byte-compile-warn-x + condition "`condition-case' condition should not be quoted: %S" + condition)) (unless (consp condition) (setq condition (list condition))) (dolist (c condition) (unless (and c (symbolp c)) @@ -5055,7 +5118,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 @@ -5487,6 +5553,83 @@ and corresponding effects." (eval form) form))) +;; Check for (in)comparable constant values in calls to `eq', `memq' etc. + +(defun bytecomp--dodgy-eq-arg-p (x number-ok) + "Whether X is a bad argument to `eq' (or `eql' if NUMBER-OK is non-nil)." + (pcase x + ((or `(quote ,(pred consp)) `(function (lambda . ,_))) t) + ((or (pred consp) (pred symbolp)) nil) + ((pred integerp) + (not (or (<= -536870912 x 536870911) number-ok))) + ((pred floatp) (not number-ok)) + (_ t))) + +(defun bytecomp--value-type-description (x) + (cond + ((proper-list-p x) "list") + ((recordp x) "record") + (t (symbol-name (type-of x))))) + +(defun bytecomp--arg-type-description (x) + (pcase x + (`(function (lambda . ,_)) "function") + (`(quote . ,val) (bytecomp--value-type-description val)) + (_ (bytecomp--value-type-description x)))) + +(defun bytecomp--warn-dodgy-eq-arg (form type parenthesis) + (macroexp-warn-and-return + (format-message "`%s' called with literal %s that may never match (%s)" + (car form) type parenthesis) + form (list 'suspicious (car form)) t)) + +(defun bytecomp--check-eq-args (form &optional a b &rest _ignore) + (let* ((number-ok (eq (car form) 'eql)) + (bad-arg (cond ((bytecomp--dodgy-eq-arg-p a number-ok) 1) + ((bytecomp--dodgy-eq-arg-p b number-ok) 2)))) + (if bad-arg + (bytecomp--warn-dodgy-eq-arg + form + (bytecomp--arg-type-description (nth bad-arg form)) + (format "arg %d" bad-arg)) + form))) + +(put 'eq 'compiler-macro #'bytecomp--check-eq-args) +(put 'eql 'compiler-macro #'bytecomp--check-eq-args) + +(defun bytecomp--check-memq-args (form &optional elem list &rest _ignore) + (let* ((fn (car form)) + (number-ok (eq fn 'memql))) + (cond + ((bytecomp--dodgy-eq-arg-p elem number-ok) + (bytecomp--warn-dodgy-eq-arg + form (bytecomp--arg-type-description elem) "arg 1")) + ((and (consp list) (eq (car list) 'quote) + (proper-list-p (cadr list))) + (named-let loop ((elts (cadr list)) (i 1)) + (if elts + (let* ((elt (car elts)) + (x (cond ((eq fn 'assq) (car-safe elt)) + ((eq fn 'rassq) (cdr-safe elt)) + (t elt)))) + (if (or (symbolp x) + (and (integerp x) + (or (<= -536870912 x 536870911) number-ok)) + (and (floatp x) number-ok)) + (loop (cdr elts) (1+ i)) + (bytecomp--warn-dodgy-eq-arg + form (bytecomp--value-type-description x) + (format "element %d of arg 2" i)))) + form))) + (t form)))) + +(put 'memq 'compiler-macro #'bytecomp--check-memq-args) +(put 'memql 'compiler-macro #'bytecomp--check-memq-args) +(put 'assq 'compiler-macro #'bytecomp--check-memq-args) +(put 'rassq 'compiler-macro #'bytecomp--check-memq-args) +(put 'remq 'compiler-macro #'bytecomp--check-memq-args) +(put 'delq 'compiler-macro #'bytecomp--check-memq-args) + (provide 'byte-compile) (provide 'bytecomp) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 0154716627f..601e2c13d61 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -236,9 +236,9 @@ Returns a form where all lambdas don't have any free variables." (not (intern-soft var)) (eq ?_ (aref (symbol-name var) 0))) (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) - (format "Unused lexical %s `%S'%s" - varkind (bare-symbol var) - (if suggestions (concat "\n " suggestions) ""))))) + (format-message "Unused lexical %s `%S'%s" + varkind (bare-symbol var) + (if suggestions (concat "\n " suggestions) ""))))) (define-inline cconv--var-classification (binder form) (inline-quote @@ -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,24 +477,45 @@ 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 (&rest _cconv--dummy) .,_) t) (_ nil))) (cif (when if (cconv-convert if env extend))) - (_ (pcase cif - (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil)) - ('nil 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 - `(cconv--interactive-helper ,cf ,cif)))) + `(cconv--interactive-helper + ,cf ,(if wrapped cif `(list 'quote ,cif)))))) (`(internal-make-closure . ,_) (byte-compile-report-error @@ -742,7 +763,8 @@ This function does not return anything but instead fills the (when (eq 'interactive (car-safe (car bf))) (let ((if (cadr (car bf)))) (unless (macroexp-const-p if) ;Optimize this common case. - (let ((f `#'(lambda () ,if))) + (let ((f (if (eq 'function (car-safe if)) 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)) @@ -829,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. @@ -870,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. @@ -891,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/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 152a1fe9434..95a51a4bdde 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -201,7 +201,7 @@ should return. Note that Emacs Lisp doesn't really support multiple values, so all this function does is return LIST." (unless (listp list) - (signal 'wrong-type-argument list)) + (signal 'wrong-type-argument (list list))) list) (defsubst cl-multiple-value-list (expression) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 43207ce7026..cffe8b09f53 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2052,7 +2052,8 @@ info node `(cl) Function Bindings' for details. (dolist (binding bindings) (let ((var (make-symbol (format "--cl-%s--" (car binding)))) (args-and-body (cdr binding))) - (if (and (= (length args-and-body) 1) (symbolp (car args-and-body))) + (if (and (= (length args-and-body) 1) + (macroexp-copyable-p (car args-and-body))) ;; Optimize (cl-flet ((fun var)) body). (setq var (car args-and-body)) (push (list var (if (= (length args-and-body) 1) @@ -3175,8 +3176,9 @@ To see the documentation for a defined struct type, use (when (cl-oddp (length desc)) (push (macroexp-warn-and-return - (format "Missing value for option `%S' of slot `%s' in struct %s!" - (car (last desc)) slot name) + (format-message + "Missing value for option `%S' of slot `%s' in struct %s!" + (car (last desc)) slot name) nil nil nil (car (last desc))) forms) (when (and (keywordp (car defaults)) @@ -3184,8 +3186,9 @@ To see the documentation for a defined struct type, use (let ((kw (car defaults))) (push (macroexp-warn-and-return - (format " I'll take `%s' to be an option rather than a default value." - kw) + (format-message + " I'll take `%s' to be an option rather than a default value." + kw) nil nil nil kw) forms) (push kw desc) 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 49e3cdb8de7..9f4118dfc86 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -85,13 +85,17 @@ This is intended for debugging the compiler itself. :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. @@ -105,7 +109,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") @@ -690,12 +698,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))) @@ -1118,10 +1137,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. @@ -1220,7 +1241,7 @@ clashes." (defun comp-decrypt-arg-list (x function-name) "Decrypt argument list X for FUNCTION-NAME." (unless (fixnump x) - (signal 'native-compiler-error-dyn-func function-name)) + (signal 'native-compiler-error-dyn-func (list function-name))) (let ((rest (not (= (logand x 128) 0))) (mandatory (logand x 127)) (nonrest (ash x -8))) @@ -1264,7 +1285,7 @@ clashes." 'pure)))) (when (byte-code-function-p f) (signal 'native-compiler-error - "can't native compile an already byte-compiled function")) + '("can't native compile an already byte-compiled function"))) (setf (comp-func-byte-func func) (byte-compile (comp-func-name func))) (let ((lap (byte-to-native-lambda-lap @@ -1288,7 +1309,7 @@ clashes." "Byte-compile FORM, spilling data from the byte compiler." (unless (eq (car-safe form) 'lambda) (signal 'native-compiler-error - "Cannot native-compile, form is not a lambda")) + '("Cannot native-compile, form is not a lambda"))) (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) (make-temp-file "comp-lambda-" nil ".eln"))) @@ -1369,7 +1390,7 @@ clashes." (alist-get 'no-native-compile byte-native-qualities)) (throw 'no-native-compile nil)) (unless byte-to-native-top-level-forms - (signal 'native-compiler-error-empty-byte filename)) + (signal 'native-compiler-error-empty-byte (list filename))) (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) (comp-el-to-eln-filename filename @@ -1740,7 +1761,7 @@ Return value is the fall-through block name." do (puthash ff-bb-name ff-bb (comp-func-blocks comp-func)) (setf (comp-limplify-curr-block comp-pass) ff-bb)))) (_ (signal 'native-ice - "missing previous setimm while creating a switch")))) + '("missing previous setimm while creating a switch"))))) (defun comp-emit-set-call-subr (subr-name sp-delta) "Emit a call for SUBR-NAME. @@ -2823,7 +2844,7 @@ blocks." (first-processed (l) (if-let ((p (cl-find-if (lambda (p) (comp-block-idom p)) l))) p - (signal 'native-ice "can't find first preprocessed")))) + (signal 'native-ice '("can't find first preprocessed"))))) (when-let ((blocks (comp-func-blocks comp-func)) (entry (gethash 'entry blocks)) @@ -3705,7 +3726,8 @@ Prepare every function for final compilation and drive the C back-end." (temp-file (make-temp-file (concat "emacs-int-comp-" (file-name-base output) "-") - nil ".el"))) + nil ".el")) + (default-directory invocation-directory)) (with-temp-file temp-file (insert ";; -*-coding: utf-8-emacs-unix; -*-\n") (mapc (lambda (e) @@ -3721,7 +3743,7 @@ Prepare every function for final compilation and drive the C back-end." (progn (delete-file temp-file) output) - (signal 'native-compiler-error (buffer-string))) + (signal 'native-compiler-error (list (buffer-string)))) (comp-log-to-buffer (buffer-string)))))))) @@ -3782,6 +3804,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 @@ -3803,25 +3850,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). - (and (not 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. @@ -3995,6 +4024,7 @@ display a message." (comp-log "\n") (mapc #'comp-log expr-strings))) (load1 load) + (default-directory invocation-directory) (process (make-process :name (concat "Compiling: " source-file) :buffer (with-current-buffer @@ -4110,15 +4140,16 @@ 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. (when (and (not (stringp function-or-file)) (not output) comp-ctxt (comp-ctxt-output comp-ctxt) (file-exists-p (comp-ctxt-output comp-ctxt))) - (delete-file (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)))) + (t (delete-file (comp-ctxt-output comp-ctxt)))))))))) (defun native-compile-async-skip-p (file load selector) "Return non-nil if FILE's compilation should be skipped. @@ -4134,11 +4165,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/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 5721470ad0d..77f4b26d9bb 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -250,7 +250,8 @@ INIT-VALUE LIGHTER KEYMAP. (warnwrap (if (or (null body) (keywordp (car body))) #'identity (lambda (exp) (macroexp-warn-and-return - "Use keywords rather than deprecated positional arguments to `define-minor-mode'" + (format-message + "Use keywords rather than deprecated positional arguments to `define-minor-mode'") exp)))) keyw keymap-sym tmp) @@ -417,6 +418,8 @@ No problems result if this variable is not bound. `(defvar ,keymap-sym (let ((m ,keymap)) (cond ((keymapp m) m) + ;; FIXME: `easy-mmode-define-keymap' is obsolete, + ;; so this form should also be obsolete somehow. ((listp m) (with-suppressed-warnings ((obsolete easy-mmode-define-keymap)) @@ -682,6 +685,7 @@ Valid keywords and arguments are: :group Ignored. :suppress Non-nil to call `suppress-keymap' on keymap, `nodigits' to suppress digits as prefix arguments." + (declare (obsolete define-keymap "29.1")) (let (inherit dense suppress) (while args (let ((key (pop args)) @@ -722,9 +726,7 @@ The M, BS, and ARGS arguments are as per that function. DOC is the constant's documentation. This macro is deprecated; use `defvar-keymap' instead." - ;; FIXME: Declare obsolete in favor of `defvar-keymap'. It is still - ;; used for `gud-menu-map' and `gud-minor-mode-map', so fix that first. - (declare (doc-string 3) (indent 1)) + (declare (doc-string 3) (indent 1) (obsolete defvar-keymap "29.1")) `(defconst ,m (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args)) ,doc)) 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/eieio.el b/lisp/emacs-lisp/eieio.el index 064a55f2727..9a1f5b9db0f 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -184,8 +184,9 @@ and reference them using the function `class-option'." (when (and initarg (eq alloc :class)) (push (cons sname - (format "Meaningless :initarg for class allocated slot '%S'" - sname)) + (format-message + "Meaningless :initarg for class allocated slot `%S'" + sname)) warnings)) (let ((init (plist-get soptions :initform))) 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/gv.el b/lisp/emacs-lisp/gv.el index e307776252a..dad91e92a45 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -417,9 +417,9 @@ The return value is the last VAL in the list. (lambda (do key alist &optional default remove testfn) (macroexp-let2 macroexp-copyable-p k key (gv-letplace (getter setter) alist - (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq))) - (assoc ,k ,getter ,testfn) - (assq ,k ,getter)) + (macroexp-let2 nil p (if (member testfn '(nil 'eq #'eq)) + `(assq ,k ,getter) + `(assoc ,k ,getter ,testfn)) (funcall do (if (null default) `(cdr ,p) `(if ,p (cdr ,p) ,default)) (lambda (v) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index bacc105a214..d44c9d6e23d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -181,7 +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 168de1bf180..8cb67c3b8b5 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -291,10 +291,11 @@ It should normally be a symbol with position and it defaults to FORM." (setq arglist (cdr arglist))) (if values (macroexp-warn-and-return - (format (if (eq values 'too-few) - "attempt to open-code `%s' with too few arguments" - "attempt to open-code `%s' with too many arguments") - name) + (format-message + (if (eq values 'too-few) + "attempt to open-code `%s' with too few arguments" + "attempt to open-code `%s' with too many arguments") + name) form nil nil arglist) ;; The following leads to infinite recursion when loading a @@ -338,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)) @@ -367,14 +373,14 @@ Assumes the caller has bound `macroexpand-all-environment'." (if (null body) (macroexp-unprogn (macroexp-warn-and-return - (format "Empty %s body" fun) - nil nil 'compile-only fun)) + (format-message "`%s' with empty body" fun) + nil (list 'empty-body fun) 'compile-only fun)) (macroexp--all-forms body)) (cdr form)) form))) (`(while) (macroexp-warn-and-return - "missing `while' condition" + (format-message "missing `while' condition") `(signal 'wrong-number-of-arguments '(while 0)) nil 'compile-only form)) (`(setq ,(and var (pred symbolp) @@ -392,7 +398,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (let ((nargs (length args))) (if (/= (logand nargs 1) 0) (macroexp-warn-and-return - "odd number of arguments in `setq' form" + (format-message "odd number of arguments in `setq' form") `(signal 'wrong-number-of-arguments '(setq ,nargs)) nil 'compile-only fn) (let ((assignments nil)) @@ -457,12 +463,13 @@ Assumes the caller has bound `macroexpand-all-environment'." (let ((arg (nth funarg form))) (when (and (eq 'quote (car-safe arg)) (eq 'lambda (car-safe (cadr arg)))) - (setcar (nthcdr funarg form) - (macroexp-warn-and-return - (format "%S quoted with ' rather than with #'" - (let ((f (cadr arg))) - (if (symbolp f) f `(lambda ,(nth 1 f) ...)))) - arg nil nil (cadr arg)))))) + (setcar + (nthcdr funarg form) + (macroexp-warn-and-return + (format + "(lambda %s ...) quoted with ' rather than with #'" + (or (nth 1 (cadr arg)) "()")) + arg nil nil (cadr arg)))))) ;; Macro expand compiler macros. This cannot be delayed to ;; byte-optimize-form because the output of the compiler-macro can ;; use macros. @@ -486,7 +493,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (setq form (macroexp--compiler-macro handler newform)) (if (eq newform form) newform - (macroexp--expand-all newform))) + (macroexp--expand-all form))) (macroexp--expand-all newform)))))) (_ form)))) (pop byte-compile-form-stack))) @@ -494,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/nadvice.el b/lisp/emacs-lisp/nadvice.el index 85934d9ed0a..e457387acc9 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -178,20 +178,38 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") ;; ((functionp spec) (funcall spec)) (t (eval spec)))) +(defun advice--interactive-form-1 (function) + "Like `interactive-form' but preserves the static context if needed." + (let ((if (interactive-form function))) + (if (or (null if) (not (eq 'closure (car-safe function)))) + if + (cl-assert (eq 'interactive (car if))) + (let ((form (cadr if))) + (if (macroexp-const-p form) + if + ;; The interactive is expected to be run in the static context + ;; that the function captured. + (let ((ctx (nth 1 function))) + `(interactive + ,(let* ((f (if (eq 'function (car-safe form)) (cadr form) form))) + ;; If the form jut returns a function, preserve the fact that + ;; it just returns a function, which is an info we use in + ;; `advice--make-interactive-form'. + (if (eq 'lambda (car-safe f)) + `',(eval form ctx) + `(eval ',form ',ctx)))))))))) + (defun advice--interactive-form (function) "Like `interactive-form' but tries to avoid autoloading functions." (if (not (and (symbolp function) (autoloadp (indirect-function function)))) - (interactive-form function) + (advice--interactive-form-1 function) (when (commandp function) `(interactive (advice-eval-interactive-spec - (cadr (interactive-form ',function))))))) + (cadr (advice--interactive-form-1 ',function))))))) (defun advice--make-interactive-form (iff ifm) - ;; TODO: make it so that interactive spec can be a constant which - ;; dynamically checks the advice--car/cdr to do its job. - ;; For that, advice-eval-interactive-spec needs to be more faithful. (let* ((fspec (cadr iff))) - (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? + (when (memq (car-safe fspec) '(function quote)) ;; Macroexpanded lambda? (setq fspec (eval fspec t))) (if (functionp fspec) `(funcall ',fspec ',(cadr ifm)) diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index f5a150ac4ae..40f1f54eed0 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -568,7 +568,7 @@ This has 2 uses: (defun cconv--interactive-helper (fun if) "Add interactive \"form\" IF to FUN. Returns a new command that otherwise behaves like FUN. -IF should actually not be a form but a function of no arguments." +IF can be an ELisp form to be interpreted or a function of no arguments." (oclosure-lambda (cconv--interactive-helper (fun fun) (if if)) (&rest args) (apply (if (called-interactively-p 'any) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 33bd0bfd5cd..253b35f1f1a 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -48,7 +48,6 @@ ;;; Code: (eval-when-compile (require 'rx)) -(eval-when-compile (require 'inline)) (eval-when-compile (require 'map)) (eval-when-compile (require 'cl-lib)) (require 'package) @@ -134,9 +133,11 @@ 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 '() "List of packages that must be installed. Each member of the list is of the form (NAME . SPEC), where NAME @@ -171,13 +172,9 @@ is a symbol designating the package and SPEC is one of: All other keys are ignored. -This user option differs from `package-selected-packages' in that -it is meant to be specified manually. If you want to install all -the packages in the list, you cal also use -`package-vc-install-selected-packages'. - -Note that this option will not override an existing source -package installation or revert the checked out revision." +This user option will be automatically updated to store package +specifications for packages that are not specified in any +archive." :type '(alist :tag "List of packages you want to be installed" :key-type (symbol :tag "Package") :value-type @@ -188,10 +185,6 @@ package installation or revert the checked out revision." (:lisp-dir string) (:main-file string) (:vc-backend symbol))))) - :initialize #'custom-initialize-default - :set (lambda (sym val) - (custom-set-default sym val) - (package-vc-install-selected-packages)) :version "29.1") (defvar package-vc--archive-spec-alist nil @@ -221,19 +214,17 @@ All other values are ignored.") The optional argument NAME can be used to override the default name for PKG-DESC." (alist-get - (or name (package-desc-name pkg-desc)) - (if (package-desc-archive pkg-desc) + (setq name (or name (package-desc-name pkg-desc))) + (if (and (package-desc-archive pkg-desc) + (not (alist-get name package-vc-selected-packages + nil nil #'string=))) (alist-get (intern (package-desc-archive pkg-desc)) package-vc--archive-spec-alist) - (apply #'append (mapcar #'cdr package-vc--archive-spec-alist))) - nil nil #'string=)) - -(define-inline package-vc--query-spec (pkg-desc prop) - "Query the property PROP for the package specification of PKG-DESC. -If no package specification can be determined, the function will -return nil." - (inline-letevals (pkg-desc prop) - (inline-quote (plist-get (package-vc--desc->spec ,pkg-desc) ,prop)))) + ;; Consult both our local list of package specifications, as well + ;; as the lists provided by the archives. + (apply #'append (cons package-vc-selected-packages + (mapcar #'cdr package-vc--archive-spec-alist)))) + '() nil #'string=)) (defun package-vc--read-archive-data (archive) "Update `package-vc--archive-spec-alist' for ARCHIVE. @@ -269,9 +260,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,13 +297,11 @@ 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) - (expand-file-name - (concat name ".el") - directory)))) + (plist-get pkg-spec :lisp-dir))) + (file (expand-file-name + (or (plist-get pkg-spec :main-file) + (concat name ".el")) + directory))) (if (file-exists-p file) file ;; The following heuristic is only necessary when fetching a ;; repository with URL that would break the above assumptions. @@ -426,27 +415,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) @@ -488,12 +482,12 @@ documentation and marking the package as installed." missing))) (let ((default-directory (file-name-as-directory pkg-dir)) - (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) + (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir)) + (pkg-spec (package-vc--desc->spec pkg-desc))) ;; Generate autoloads (let* ((name (package-desc-name pkg-desc)) (auto-name (format "%s-autoloads.el" name)) - (extras (package-desc-extras pkg-desc)) - (lisp-dir (alist-get :lisp-dir extras))) + (lisp-dir (plist-get pkg-spec :lisp-dir))) (package-generate-autoloads name (file-name-concat pkg-dir lisp-dir)) (when lisp-dir @@ -513,8 +507,7 @@ documentation and marking the package as installed." (package-vc--generate-description-file pkg-desc pkg-file) ;; Detect a manual - (when-let ((pkg-spec (package-vc--desc->spec pkg-desc)) - ((executable-find "install-info"))) + (when (executable-find "install-info") (dolist (doc-file (ensure-list (plist-get pkg-spec :doc))) (package-vc--build-documentation pkg-desc doc-file)))) @@ -577,7 +570,6 @@ attribute in PKG-SPEC." (unless (file-exists-p dir) (make-directory (file-name-directory dir) t) (let ((backend (or (plist-get pkg-spec :vc-backend) - (package-vc--query-spec pkg-desc :vc-backend) (package-vc--guess-backend url) (plist-get (alist-get (package-desc-archive pkg-desc) package-vc--archive-data-alist @@ -594,18 +586,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 +615,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 @@ -632,9 +644,14 @@ checkout. This overrides the `:branch' attribute in PKG-SPEC." ;; file system or between installations. (throw 'done (setq lisp-dir name))))) - (when lisp-dir - (push (cons :lisp-dir lisp-dir) - (package-desc-extras pkg-desc))) + ;; Ensure we have a copy of the package specification + (unless (equal (alist-get name (mapcar #'cdr package-vc--archive-spec-alist)) pkg-spec) + (customize-save-variable + 'package-vc-selected-packages + (cons (cons name pkg-spec) + (seq-remove (lambda (spec) (string= name (car spec))) + package-vc-selected-packages)))) + (package-vc--unpack-1 pkg-desc pkg-dir))) (defun package-vc--read-package-name (prompt &optional allow-url installed) @@ -802,9 +819,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 a96d6f22aae..3d2fcc55683 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -379,10 +379,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 @@ -959,7 +957,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)) "/")) @@ -3087,8 +3084,7 @@ The most useful commands here are: `[("Package" ,package-name-column-width package-menu--name-predicate) ("Version" ,package-version-column-width package-menu--version-predicate) ("Status" ,package-status-column-width package-menu--status-predicate) - ,@(if (cdr package-archives) - `(("Archive" ,package-archive-column-width package-menu--archive-predicate))) + ("Archive" ,package-archive-column-width package-menu--archive-predicate) ("Description" 0 package-menu--description-predicate)]) (setq tabulated-list-padding 2) (setq tabulated-list-sort-key (cons "Status" nil)) @@ -3516,9 +3512,8 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." (package-desc-version pkg))) 'font-lock-face face) ,(propertize status 'font-lock-face face) - ,@(if (cdr package-archives) - (list (propertize (or (package-desc-archive pkg) "") - 'font-lock-face face))) + ,(propertize (or (package-desc-archive pkg) "") + 'font-lock-face face) ,(propertize (package-desc-summary pkg) 'font-lock-face 'package-description)]))) @@ -4563,6 +4558,7 @@ will be signaled in that case." (package--print-email-button maint) (string-trim (substring-no-properties (buffer-string)))))))) +;;;###autoload (defun package-report-bug (desc) "Prepare a message to send to the maintainers of a package. DESC must be a `package-desc' object." diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 810b13f61d6..1c5ce5169ab 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -947,7 +947,7 @@ Otherwise, it defers to REST which is a list of branches of the form (let ((code (pcase--u1 matches code vars rest))) (if (eq upat '_) code (macroexp-warn-and-return - "Pattern t is deprecated. Use `_' instead" + (format-message "Pattern t is deprecated. Use `_' instead") code nil nil upat)))) ((eq upat 'pcase--dontcare) :pcase--dontcare) ((memq (car-safe upat) '(guard pred)) diff --git a/lisp/emacs-lisp/range.el b/lisp/emacs-lisp/range.el index 1165fcbbd7d..f441c240a27 100644 --- a/lisp/emacs-lisp/range.el +++ b/lisp/emacs-lisp/range.el @@ -194,7 +194,7 @@ these ranges." (nreverse result))))) (defun range-add-list (ranges list) - "Return a list of ranges that has all articles from both RANGES and LIST. + "Return a list of ranges that has all numbers from both RANGES and LIST. Note: LIST has to be sorted over `<'." (if (not ranges) (range-compress-list list) @@ -249,9 +249,9 @@ Note: LIST has to be sorted over `<'." out))) (defun range-remove (range1 range2) - "Return a range that has all articles from RANGE2 removed from RANGE1. + "Return a range that has all numbers from RANGE2 removed from RANGE1. The returned range is always a list. RANGE2 can also be a unsorted -list of articles. RANGE1 is modified by side effects, RANGE2 is not +list of numbers. RANGE1 is modified by side effects, RANGE2 is not modified." (if (or (null range1) (null range2)) range1 @@ -345,7 +345,7 @@ modified." (defun range-list-intersection (list ranges) "Return a list of numbers in LIST that are members of RANGES. -oLIST is a sorted list." +LIST is a sorted list." (setq ranges (range-normalize ranges)) (let (number result) (while (setq number (pop list)) 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..9a6f5dd12ce 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 @@ -1440,45 +1443,52 @@ If SAME-WINDOW, don't pop to a new window." (setq group (intern group))) (unless (assq group shortdoc--groups) (error "No such documentation group %s" group)) - (funcall (if same-window - #'pop-to-buffer-same-window - #'pop-to-buffer) - (format "*Shortdoc %s*" group)) - (let ((inhibit-read-only t) - (prev nil)) - (erase-buffer) - (shortdoc-mode) - (button-mode) - (mapc - (lambda (data) - (cond - ((stringp data) - (setq prev nil) - (unless (bobp) - (insert "\n")) - (insert (propertize - (substitute-command-keys data) - 'face 'shortdoc-heading - 'shortdoc-section t - 'outline-level 1)) - (insert (propertize - "\n\n" - 'face 'shortdoc-heading - 'shortdoc-section t))) - ;; There may be functions not yet defined in the data. - ((fboundp (car data)) - (when prev - (insert (make-separator-line) - ;; This helps with hidden outlines (bug#53981) - (propertize "\n" 'face '(:height 0)))) - (setq prev t) - (shortdoc--display-function data)))) - (cdr (assq group shortdoc--groups)))) + (let ((buf (get-buffer-create (format "*Shortdoc %s*" group)))) + (shortdoc--insert-group-in-buffer group buf) + (funcall (if same-window + #'pop-to-buffer-same-window + #'pop-to-buffer) + buf)) (goto-char (point-min)) (when function (text-property-search-forward 'shortdoc-function function t) (beginning-of-line))) +(defun shortdoc--insert-group-in-buffer (group &optional buf) + "Insert a short documentation summary for functions in GROUP in buffer BUF. +BUF defaults to the current buffer if nil or omitted." + (with-current-buffer (or buf (current-buffer)) + (let ((inhibit-read-only t) + (prev nil)) + (erase-buffer) + (shortdoc-mode) + (button-mode) + (mapc + (lambda (data) + (cond + ((stringp data) + (setq prev nil) + (unless (bobp) + (insert "\n")) + (insert (propertize + (substitute-command-keys data) + 'face 'shortdoc-heading + 'shortdoc-section t + 'outline-level 1)) + (insert (propertize + "\n\n" + 'face 'shortdoc-heading + 'shortdoc-section t))) + ;; There may be functions not yet defined in the data. + ((fboundp (car data)) + (when prev + (insert (make-separator-line) + ;; This helps with hidden outlines (bug#53981) + (propertize "\n" 'face '(:height 0)))) + (setq prev t) + (shortdoc--display-function data)))) + (cdr (assq group shortdoc--groups)))))) + ;;;###autoload (defalias 'shortdoc #'shortdoc-display-group) @@ -1518,7 +1528,8 @@ function's documentation in the Info manual")) "=>")) (single-arrow (if (char-displayable-p ?→) "→" - "->"))) + "->")) + (start-example (point))) (cl-loop for (type value) on data by #'cddr do (cl-case type @@ -1569,7 +1580,8 @@ function's documentation in the Info manual")) (:eg-result-string (insert " e.g. " double-arrow " ") (princ value (current-buffer)) - (insert "\n"))))) + (insert "\n")))) + (add-text-properties start-example (point) `(shortdoc-example ,function))) ;; Insert the arglist after doing the evals, in case that's pulled ;; in the function definition. (save-excursion @@ -1579,6 +1591,73 @@ function's documentation in the Info manual")) (insert " " (symbol-name param))) (add-face-text-property arglist-start (point) 'shortdoc-section t)))) +(defun shortdoc-function-examples (function) + "Return all shortdoc examples for FUNCTION. +The result is an alist with items of the form (GROUP . EXAMPLES), +where GROUP is a shortdoc group where FUNCTION appears, and +EXAMPLES is a string with the usage examples of FUNCTION defined +in GROUP. Return nil if FUNCTION is not a function or if it +doesn't has any shortdoc information." + (let ((groups (and (symbolp function) + (shortdoc-function-groups function))) + (examples nil)) + (mapc + (lambda (group) + (with-temp-buffer + (shortdoc--insert-group-in-buffer group) + (goto-char (point-min)) + (let ((match (text-property-search-forward + 'shortdoc-example function t))) + (push `(,group . ,(string-trim + (buffer-substring-no-properties + (prop-match-beginning match) + (prop-match-end match)))) + examples)))) + groups) + examples)) + +(defun shortdoc-help-fns-examples-function (function) + "Insert Emacs Lisp examples for FUNCTION into the current buffer. +You can add this function to the `help-fns-describe-function-functions' +hook to show examples of using FUNCTION in *Help* buffers produced +by \\[describe-function]." + (let* ((examples (shortdoc-function-examples function)) + (num-examples (length examples)) + (times 0)) + (dolist (example examples) + (when (zerop times) + (if (> num-examples 1) + (insert "\n Examples:\n\n") + ;; Some functions have more than one example per group. + ;; Count the number of arrows to know if we need to + ;; pluralize "Example". + (let* ((text (cdr example)) + (count 0) + (pos 0) + (end (length text)) + (double-arrow (if (char-displayable-p ?⇒) + " ⇒" + " =>")) + (double-arrow-example (if (char-displayable-p ?⇒) + " e.g. ⇒" + " e.g. =>")) + (single-arrow (if (char-displayable-p ?→) + " →" + " ->"))) + (while (and (< pos end) + (or (string-match double-arrow text pos) + (string-match double-arrow-example text pos) + (string-match single-arrow text pos))) + (setq count (1+ count) + pos (match-end 0))) + (if (> count 1) + (insert "\n Examples:\n\n") + (insert "\n Example:\n\n"))))) + (setq times (1+ times)) + (insert " ") + (insert (cdr example)) + (insert "\n\n")))) + (defun shortdoc-function-groups (function) "Return all shortdoc groups FUNCTION appears in." (cl-loop for group in shortdoc--groups 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 abadefb7105..2a37c383f81 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -194,9 +194,9 @@ viper-delete-backward-char viper-join-lines viper-delete-char)) - (memq (viper-event-key last-command-event) - '(up down left right (meta f) (meta b) - (control n) (control p) (control f) (control b))))) + (member (viper-event-key last-command-event) + '(up down left right (meta f) (meta b) + (control n) (control p) (control f) (control b))))) (defsubst viper-insert-state-pre-command-sentinel () (or (viper-preserve-cursor-color) @@ -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/epa-ks.el b/lisp/epa-ks.el index 77d896fa438..015bf910ac6 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -140,8 +140,8 @@ Keys are marked using `epa-ks-mark-key-to-fetch'." (epa-ks--fetch-key id))))) (tabulated-list-clear-all-tags)) -(defun epa-ks--query-url (query exact) - "Return URL for QUERY. +(defun epa-ks--query-url (query exact &optional operation) + "Return URL for QUERY and OPERATION (defaults to \"index\"). If EXACT is non-nil, don't accept approximate matches." (format "https://%s/pks/lookup?%s" (cond ((null epa-keyserver) @@ -154,13 +154,13 @@ If EXACT is non-nil, don't accept approximate matches." (url-build-query-string (append `(("search" ,query) ("options" "mr") - ("op" "index")) + ("op" ,(or operation "index"))) (and exact '(("exact" "on"))))))) (defun epa-ks--fetch-key (id) "Send request to import key with specified ID." (url-retrieve - (epa-ks--query-url (concat "0x" (url-hexify-string id)) t) + (epa-ks--query-url (concat "0x" (url-hexify-string id)) t "get") (lambda (status) (when (plist-get status :error) (error "Request failed: %s" @@ -236,7 +236,7 @@ enough, since keyservers have strict timeout settings." (erase-buffer)) (epa-ks-search-mode)) (url-retrieve - (epa-ks--query-url query exact) + (epa-ks--query-url query exact "index") (lambda (status) (when (plist-get status :error) (when buf 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-alias.el b/lisp/eshell/em-alias.el index 1be070480b3..841982c3425 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -183,7 +183,9 @@ file named by `eshell-aliases-file'.") (pcomplete-here (eshell-alias-completions pcomplete-stub))) (defun eshell-read-aliases-list () - "Read in an aliases list from `eshell-aliases-file'." + "Read in an aliases list from `eshell-aliases-file'. +This is useful after manually editing the contents of the file." + (interactive) (let ((file eshell-aliases-file)) (when (file-readable-p file) (setq eshell-command-aliases-list 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 ca51cee2558..b65652019d4 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 @@ -306,15 +304,20 @@ to writing a completion function." (insert-and-inherit "\t") (throw 'pcompleted t))) +(defun eshell-complete--eval-argument-form (arg) + "Evaluate a single Eshell argument form ARG for the purposes of completion." + (let ((result (eshell-do-eval `(eshell-commands ,arg) t))) + (cl-assert (eq (car result) 'quote)) + (cadr result))) + (defun eshell-complete-parse-arguments () "Parse the command line arguments for `pcomplete-argument'." (when (and eshell-no-completion-during-jobs (eshell-interactive-process-p)) (eshell--pcomplete-insert-tab)) (let ((end (point-marker)) - (begin (save-excursion (eshell-bol) (point))) - (posns (list t)) - args delim) + (begin (save-excursion (beginning-of-line) (point))) + args posns delim incomplete-arg) (when (and pcomplete-allow-modifications (memq this-command '(pcomplete-expand pcomplete-expand-and-complete))) @@ -326,83 +329,82 @@ 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))) + incomplete-arg t) + (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) - l) + (let ((a args) (i 0) new-start) (while a - (if (and (consp (car a)) - (eq (caar a) 'eshell-operator)) - (setq l i)) - (setq a (cdr a) i (1+ i))) - (and l - (setq args (nthcdr (1+ l) args) - posns (nthcdr (1+ l) posns)))) + ;; If there's an unreplaced `eshell-operator' sigil, consider + ;; the token after it the new start of our arguments. + (when (and (consp (car a)) + (eq (caar a) 'eshell-operator)) + (setq new-start i)) + (setq a (cdr a) + i (1+ i))) + (when new-start + (setq args (nthcdr (1+ new-start) args) + posns (nthcdr (1+ new-start) posns)))) (cl-assert (= (length args) (length posns))) - (when (and args (eq (char-syntax (char-before end)) ? ) + (when (and args (not incomplete-arg) + (eq (char-syntax (char-before end)) ? ) (not (eq (char-before (1- end)) ?\\))) (nconc args (list "")) (nconc posns (list (point)))) + ;; Evaluate and expand Eshell forms. + (let (evaled-args evaled-posns) + (cl-mapc + (lambda (arg posn) + (pcase arg + (`(eshell-splice-args ,val) + (dolist (subarg (eshell-complete--eval-argument-form val)) + (push subarg evaled-args) + (push posn evaled-posns))) + ((pred listp) + (push (eshell-complete--eval-argument-form arg) evaled-args) + (push posn evaled-posns)) + (_ + (push arg evaled-args) + (push posn evaled-posns)))) + args posns) + (setq args (nreverse evaled-args) + posns (nreverse evaled-posns))) + ;; Convert arguments to forms that Pcomplete can understand. (cons (mapcar (lambda (arg) - (let ((val - (if (listp arg) - (let ((result - (eshell-do-eval - (list 'eshell-commands arg) t))) - (cl-assert (eq (car result) 'quote)) - (cadr result)) - arg))) - (cond ((numberp val) - (setq val (number-to-string val))) - ;; expand .../ etc that only eshell understands to - ;; standard ../../ - ((and (stringp val)) (string-match "\\.\\.\\.+/" val) - (setq val (eshell-expand-multiple-dots val)))) - (or val ""))) + (pcase arg + ;; Expand ".../" etc that only Eshell understands to + ;; the standard "../../". + ((rx ".." (+ ".") "/") + (propertize (eshell-expand-multiple-dots arg) + 'pcomplete-arg-value arg)) + ((pred stringp) + arg) + ('nil + (propertize "" 'pcomplete-arg-value arg)) + (_ + (propertize (eshell-stringify arg) + 'pcomplete-arg-value arg)))) args) posns))) -(defun eshell--pcomplete-executables () - "Complete amongst a list of directories and executables. - -Wrapper for `pcomplete-executables' or `pcomplete-dirs-or-entries', -depending on the value of `eshell-force-execution'. - -Adds path prefix to candidates independent of `action' value." - ;; `pcomplete-entries' returns filenames without path on `action' to - ;; use current string directory as done in `completion-file-name-table' - ;; when `action' is nil to construct executable candidates. - (let ((table (if eshell-force-execution - (pcomplete-dirs-or-entries nil #'file-readable-p) - (pcomplete-executables)))) - (lambda (string pred action) - (let ((cands (funcall table string pred action))) - (if (eq action t) - (let ((specdir (file-name-directory string))) - (mapcar - (lambda (cand) - (if (stringp cand) - (file-name-concat specdir cand) - cand)) - cands)) - cands))))) - (defun eshell--complete-commands-list () "Generate list of applicable, visible commands." ;; Building the commands list can take quite a while, especially over Tramp @@ -413,11 +415,19 @@ Adds path prefix to candidates independent of `action' value." ;; we complete. Adjust `pcomplete-stub' accordingly! (if (and (> (length pcomplete-stub) 0) (eq (aref pcomplete-stub 0) eshell-explicit-command-char)) - (setq pcomplete-stub (substring pcomplete-stub 1))))) - (completion-table-dynamic - (lambda (filename) - (if (file-name-directory filename) - (eshell--pcomplete-executables) + (setq pcomplete-stub (substring pcomplete-stub 1)))) + (filename (pcomplete-arg))) + ;; Do not use `completion-table-dynamic' when completing a command file + ;; name since it doesn't know about boundaries and would end up doing silly + ;; things like adding a SPC char when completing to "/usr/sbin/". + ;; + ;; If you work on this function, be careful not to reintroduce bug#48995. + (if (file-name-directory filename) + (if eshell-force-execution + (pcomplete-dirs-or-entries nil #'file-readable-p) + (pcomplete-executables)) + (completion-table-dynamic + (lambda (filename) (let* ((paths (eshell-get-path)) (cwd (file-name-as-directory (expand-file-name default-directory))) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 0d02b64b084..4bc6342d422 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -253,11 +253,17 @@ Thus, this does not include the current directory.") (throw 'eshell-replace-command (eshell-parse-command "cd" (flatten-tree args))))) +(defun eshell-expand-user-reference (file) + "Expand a user reference in FILE to its real directory name." + (replace-regexp-in-string + (rx bos (group "~" (*? anychar)) (or "/" eos)) + #'expand-file-name file)) + (defun eshell-parse-user-reference () "An argument beginning with ~ is a filename to be expanded." (when (and (not eshell-current-argument) - (eq (char-after) ?~)) - (add-to-list 'eshell-current-modifiers 'expand-file-name) + (eq (char-after) ?~)) + (add-to-list 'eshell-current-modifiers #'eshell-expand-user-reference) (forward-char) (char-to-string (char-before)))) @@ -281,15 +287,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-elecslash.el b/lisp/eshell/em-elecslash.el index 80bc0f031ef..2b003f58dc7 100644 --- a/lisp/eshell/em-elecslash.el +++ b/lisp/eshell/em-elecslash.el @@ -72,7 +72,7 @@ insertion." (delete-char -1) (let ((tilde-before (eq ?~ (char-before))) (command (save-excursion - (eshell-bol) + (beginning-of-line) (skip-syntax-forward " ") (thing-at-point 'sexp))) (prefix (file-remote-p default-directory))) 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 05e9598f530..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) @@ -555,7 +554,7 @@ See also `eshell-read-history'." (defun eshell-hist-parse-arguments (&optional b e) "Parse current command arguments in a history-code-friendly way." (let ((end (or e (point))) - (begin (or b (save-excursion (eshell-bol) (point)))) + (begin (or b (save-excursion (beginning-of-line) (point)))) (posb (list t)) (pose (list t)) (textargs (list t)) @@ -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 @@ -913,7 +914,7 @@ If N is negative, search forwards for the -Nth following match." eshell-next-matching-input-from-input))) ;; Starting a new search (setq eshell-matching-input-from-input-string - (buffer-substring (save-excursion (eshell-bol) (point)) + (buffer-substring (save-excursion (beginning-of-line) (point)) (point)) eshell-history-index nil)) (eshell-previous-matching-input @@ -933,7 +934,7 @@ If N is negative, search backwards for the -Nth previous match." (if (get-text-property (point) 'history) (progn (beginning-of-line) t) (let ((before (point))) - (eshell-bol) + (beginning-of-line) (if (and (not (bolp)) (<= (point) before)) t @@ -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 575b5a595f1..9f9e58e83d7 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -27,7 +27,7 @@ ;;; Code: (require 'esh-mode) -(eval-when-compile (require 'eshell)) +(require 'text-property-search) ;;;###autoload (progn @@ -50,7 +50,7 @@ as is common with most shells." (defcustom eshell-prompt-function (lambda () (concat (abbreviate-file-name (eshell/pwd)) - (if (= (user-uid) 0) " # " " $ "))) + (if (= (file-user-uid) 0) " # " " $ "))) "A function that returns the Eshell prompt string. Make sure to update `eshell-prompt-regexp' so that it will match your prompt." @@ -58,11 +58,12 @@ prompt." :group 'eshell-prompt) (defcustom eshell-prompt-regexp "^[^#$\n]* [#$] " - "A regexp which fully matches your eshell prompt. -This setting is important, since it affects how eshell will interpret -the lines that are passed to it. -If this variable is changed, all Eshell buffers must be exited and -re-entered for it to take effect." + "A regexp which fully matches your Eshell prompt. +This is useful for navigating by paragraph using \ +\\[forward-paragraph] and \\[backward-paragraph]. + +If this variable is changed, all Eshell buffers must be exited +and re-entered for it to take effect." :type 'regexp :group 'eshell-prompt) @@ -123,7 +124,6 @@ arriving, or after." (if eshell-prompt-regexp (setq-local paragraph-start eshell-prompt-regexp)) - (setq-local eshell-skip-prompt-function #'eshell-skip-prompt) (eshell-prompt-mode))) (defun eshell-emit-prompt () @@ -134,72 +134,83 @@ arriving, or after." (if (not eshell-prompt-function) (set-marker eshell-last-output-end (point)) (let ((prompt (funcall eshell-prompt-function))) - (and eshell-highlight-prompt - (add-text-properties 0 (length prompt) - '(read-only t - font-lock-face eshell-prompt - front-sticky (font-lock-face read-only) - rear-nonsticky (font-lock-face read-only)) - prompt)) - (eshell-interactive-print prompt))) + (add-text-properties + 0 (length prompt) + (if eshell-highlight-prompt + '( read-only t + field prompt + font-lock-face eshell-prompt + front-sticky (read-only field font-lock-face) + rear-nonsticky (read-only field font-lock-face)) + '( field prompt + front-sticky (field) + rear-nonsticky (field))) + prompt) + (eshell-interactive-filter nil prompt))) (run-hooks 'eshell-after-prompt-hook)) -(defun eshell-backward-matching-input (regexp arg) - "Search backward through buffer for match for REGEXP. -Matches are searched for on lines that match `eshell-prompt-regexp'. -With prefix argument N, search for Nth previous match. -If N is negative, find the next or Nth next match." - (interactive (eshell-regexp-arg "Backward input matching (regexp): ")) - (let* ((re (concat eshell-prompt-regexp ".*" regexp)) - (pos (save-excursion (end-of-line (if (> arg 0) 0 1)) - (if (re-search-backward re nil t arg) - (point))))) - (if (null pos) - (progn (message "Not found") - (ding)) - (goto-char pos) - (eshell-bol)))) - (defun eshell-forward-matching-input (regexp arg) - "Search forward through buffer for match for REGEXP. -Matches are searched for on lines that match `eshell-prompt-regexp'. -With prefix argument N, search for Nth following match. -If N is negative, find the previous or Nth previous match." + "Search forward through buffer for command input that matches REGEXP. +With prefix argument N, search for Nth next match. If N is +negative, find the Nth previous match." (interactive (eshell-regexp-arg "Forward input matching (regexp): ")) - (eshell-backward-matching-input regexp (- arg))) + (let ((direction (if (> arg 0) 1 -1)) + (count (abs arg))) + (unless (catch 'found + (while (> count 0) + (eshell-next-prompt direction) + (when (and (string-match regexp (field-string)) + (= (setq count (1- count)) 0)) + (throw 'found t)))) + (message "Not found") + (ding)))) + +(defun eshell-backward-matching-input (regexp arg) + "Search backward through buffer for command input that matches REGEXP. +With prefix argument N, search for Nth previous match. If N is +negative, find the Nth next match." + (interactive (eshell-regexp-arg "Backward input matching (regexp): ")) + (eshell-forward-matching-input regexp (- arg))) (defun eshell-next-prompt (n) - "Move to end of Nth next prompt in the buffer. -See `eshell-prompt-regexp'." + "Move to end of Nth next prompt in the buffer." (interactive "p") - (if eshell-highlight-prompt - (progn - (while (< n 0) - (while (and (re-search-backward eshell-prompt-regexp nil t) - (not (get-text-property (match-beginning 0) 'read-only)))) - (setq n (1+ n))) - (while (> n 0) - (while (and (re-search-forward eshell-prompt-regexp nil t) - (not (get-text-property (match-beginning 0) 'read-only)))) - (setq n (1- n)))) - (re-search-forward eshell-prompt-regexp nil t n)) - (eshell-skip-prompt)) + (if (natnump n) + (while (and (> n 0) + (text-property-search-forward 'field 'prompt t)) + (setq n (1- n))) + (let (match this-match) + (forward-line 0) ; Don't count prompt on current line. + (while (and (< n 0) + (setq this-match (text-property-search-backward + 'field 'prompt t))) + (setq match this-match + n (1+ n))) + (when match + (goto-char (prop-match-end match)))))) (defun eshell-previous-prompt (n) - "Move to end of Nth previous prompt in the buffer. -See `eshell-prompt-regexp'." + "Move to end of Nth previous prompt in the buffer." (interactive "p") - (forward-line 0) ; Don't count prompt on current line. (eshell-next-prompt (- n))) (defun eshell-skip-prompt () "Skip past the text matching regexp `eshell-prompt-regexp'. If this takes us past the end of the current line, don't skip at all." + (declare (obsolete nil "30.1")) (let ((eol (line-end-position))) (if (and (looking-at eshell-prompt-regexp) (<= (match-end 0) eol)) (goto-char (match-end 0))))) +(defun eshell-bol-ignoring-prompt (arg) + "Move point to the beginning of the current line, past the prompt (if any). +With argument ARG not nil or 1, move forward ARG - 1 lines +first (see `move-beginning-of-line' for more information)." + (interactive "^p") + (let ((inhibit-field-text-motion t)) + (move-beginning-of-line arg))) + (provide 'em-prompt) ;; Local Variables: diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index 2c95d4fdffb..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 @@ -50,9 +49,7 @@ the behavior of normal shells while the user editing new input text." :group 'eshell-rebind) (defcustom eshell-rebind-keys-alist - '(([(control ?a)] . eshell-bol) - ([home] . eshell-bol) - ([(control ?d)] . eshell-delchar-or-maybe-eof) + '(([(control ?d)] . eshell-delchar-or-maybe-eof) ([backspace] . eshell-delete-backward-char) ([delete] . eshell-delete-backward-char) ([(control ?w)] . backward-kill-word) @@ -190,7 +187,7 @@ lock it at that." (and eshell-remap-previous-input (setq begin (save-excursion - (eshell-bol) + (beginning-of-line) (and (not (bolp)) (point)))) (>= pos begin) (<= pos (line-end-position)) 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-unix.el b/lisp/eshell/em-unix.el index f88a06d2e95..d550910f4f0 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -786,10 +786,14 @@ external command." (defun eshell-complete-host-reference () "If there is a host reference, complete it." - (let ((arg (pcomplete-actual-arg)) - index) - (when (setq index (string-match "@[a-z.]*\\'" arg)) - (setq pcomplete-stub (substring arg (1+ index)) + (let ((arg (pcomplete-actual-arg))) + (when (string-match + (rx ;; Match an "@", but not immediately following a "$". + (or string-start (not "$")) "@" + (group (* (any "a-z."))) + string-end) + arg) + (setq pcomplete-stub (substring arg (match-beginning 1)) pcomplete-last-completion-raw t) (throw 'pcomplete-completions (pcomplete-read-host-names))))) 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 9aab3af9b47..aa1e8f77ea5 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -28,6 +28,9 @@ ;;; Code: (require 'esh-util) +(require 'esh-module) + +(require 'pcomplete) (eval-when-compile (require 'cl-lib)) @@ -175,7 +178,11 @@ treated as a literal character." "Initialize the argument parsing code." (eshell-arg-mode) (setq-local eshell-inside-quote-regexp nil) - (setq-local eshell-outside-quote-regexp nil)) + (setq-local eshell-outside-quote-regexp nil) + + (when (eshell-using-module 'eshell-cmpl) + (add-hook 'pcomplete-try-first-hook + #'eshell-complete-special-reference nil t))) (defun eshell-insert-buffer-name (buffer-name) "Insert BUFFER-NAME into the current buffer at point." @@ -238,13 +245,53 @@ convert the result to a number as well." (eshell-convert-to-number result) result))) +(defun eshell-concat-groups (quoted &rest args) + "Concatenate groups of arguments in ARGS and return the result. +QUOTED is passed to `eshell-concat' (which see) and, if non-nil, +allows values to be converted to numbers where appropriate. + +ARGS should be a list of lists of arguments, such as that +produced by `eshell-prepare-slice'. \"Adjacent\" values of +consecutive arguments will be passed to `eshell-concat'. For +example, if ARGS is + + ((list a) (list b) (list c d e) (list f g)), + +then the result will be: + + ((eshell-concat QUOTED a b c) + d + (eshell-concat QUOTED e f) + g)." + (let (result current-arg) + (dolist (arg args) + (when arg + (push (car arg) current-arg) + (when (length> arg 1) + (push (apply #'eshell-concat quoted (nreverse current-arg)) + result) + (dolist (inner (butlast (cdr arg))) + (push inner result)) + (setq current-arg (list (car (last arg))))))) + (when current-arg + (push (apply #'eshell-concat quoted (nreverse current-arg)) + result)) + (nreverse result))) + (defun eshell-resolve-current-argument () "If there are pending modifications to be made, make them now." (when eshell-current-argument (when eshell-arg-listified - (setq eshell-current-argument - (append (list 'eshell-concat eshell-current-quoted) - eshell-current-argument)) + (if-let ((grouped-terms (eshell-prepare-splice + eshell-current-argument))) + (setq eshell-current-argument + `(eshell-splice-args + (eshell-concat-groups ,eshell-current-quoted + ,@grouped-terms))) + ;; If no terms are spliced, use a simpler command form. + (setq eshell-current-argument + (append (list 'eshell-concat eshell-current-quoted) + eshell-current-argument))) (setq eshell-arg-listified nil)) (while eshell-current-modifiers (setq eshell-current-argument @@ -261,7 +308,8 @@ argument list in place of the value of the current argument." (setq eshell-current-argument (car arguments)) (cl-assert (and (not eshell-arg-listified) (not eshell-current-modifiers))) - (setq eshell-current-argument (cons 'eshell-flatten-args arguments)))) + (setq eshell-current-argument + (cons 'eshell-splice-immediately arguments)))) (throw 'eshell-arg-done t)) (defun eshell-quote-argument (string) @@ -302,7 +350,8 @@ Point is left at the end of the arguments." (buffer-substring here (point-max)))) (when arg (nconc args - (if (eq (car-safe arg) 'eshell-flatten-args) + (if (eq (car-safe arg) + 'eshell-splice-immediately) (cdr arg) (list arg)))))))) (throw 'eshell-incomplete (if (listp delim) @@ -348,6 +397,10 @@ Point is left at the end of the arguments." "A stub function that generates an error if a floating operator is found." (error "Unhandled operator in input text")) +(defsubst eshell-splice-args (&rest _args) + "A stub function that generates an error if a floating splice is found." + (error "Splice operator is not permitted in this context")) + (defsubst eshell-looking-at-backslash-return (pos) "Test whether a backslash-return sequence occurs at POS." (and (eq (char-after pos) ?\\) @@ -375,29 +428,33 @@ 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. - (if (eq (char-before) ?\n) - ;; Escaped newlines are extra-special: they expand to an empty - ;; token to allow for continuing Eshell commands across - ;; multiple lines. - 'eshell-empty-token - ;; If the char is in a quote, backslash only has special meaning - ;; if it is escaping a special char. - (if eshell-current-quoted - (if (memq (char-before) eshell-special-chars-inside-quoting) - (list 'eshell-escape-arg (char-to-string (char-before))) - (concat "\\" (char-to-string (char-before)))) - (if (memq (char-before) eshell-special-chars-outside-quoting) - (list 'eshell-escape-arg (char-to-string (char-before))) - (char-to-string (char-before))))))) + (let ((special-chars (if eshell-current-quoted + eshell-special-chars-inside-quoting + eshell-special-chars-outside-quoting))) + (cond + ;; Escaped newlines are extra-special: they expand to an empty + ;; token to allow for continuing Eshell commands across + ;; multiple lines. + ((eq (char-before) ?\n) + 'eshell-empty-token) + ((memq (char-before) special-chars) + (list 'eshell-escape-arg (char-to-string (char-before)))) + ;; If the char is in a quote, backslash only has special + ;; meaning if it is escaping a special char. Otherwise, the + ;; result is the literal string "\c". + (eshell-current-quoted + (concat "\\" (char-to-string (char-before)))) + (t + (char-to-string (char-before))))))) (defun eshell-parse-literal-quote () "Parse a literally quoted string. Nothing has special meaning!" (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) @@ -410,7 +467,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) @@ -456,21 +513,28 @@ If the form has no `type', the syntax is parsed as if `type' were \"buffer\"." (when (and (not eshell-current-argument) (not eshell-current-quoted) - (looking-at "#<\\(\\(buffer\\|process\\)\\s-\\)?")) + (looking-at (rx "#<" (? (group (or "buffer" "process")) + space)))) (let ((here (point))) (goto-char (match-end 0)) ;; Go to the end of the match. - (let ((buffer-p (if (match-string 1) - (string= (match-string 2) "buffer") - t)) ;; buffer-p is non-nil by default. + (let ((buffer-p (if (match-beginning 1) + (equal (match-string 1) "buffer") + t)) ; With no type keyword, assume we want a buffer. (end (eshell-find-delimiter ?\< ?\>))) (when (not end) - (throw 'eshell-incomplete ?\<)) + (when (match-beginning 1) + (goto-char (match-beginning 1))) + (throw 'eshell-incomplete "#<")) (if (eshell-arg-delimiter (1+ end)) (prog1 - (list (if buffer-p 'get-buffer-create 'get-process) - (replace-regexp-in-string - (rx "\\" (group (or "\\" "<" ">"))) "\\1" - (buffer-substring-no-properties (point) end))) + (list (if buffer-p #'get-buffer-create #'get-process) + ;; FIXME: We should probably parse this as a + ;; real Eshell argument so that we get the + ;; benefits of quoting, variable-expansion, etc. + (string-trim-right + (replace-regexp-in-string + (rx "\\" (group anychar)) "\\1" + (buffer-substring-no-properties (point) end)))) (goto-char (1+ end))) (ignore (goto-char here))))))) @@ -496,5 +560,69 @@ If the form has no `type', the syntax is parsed as if `type' were (char-to-string (char-after))))) (goto-char end))))))) +(defun eshell-prepare-splice (args) + "Prepare a list of ARGS for splicing, if any arg requested a splice. +This looks for `eshell-splice-args' as the CAR of each argument, +and if found, returns a grouped list like: + + ((list arg-1) (list arg-2) spliced-arg-3 ...) + +This allows callers of this function to build the final spliced +list by concatenating each element together, e.g. with + + (apply #\\='append grouped-list) + +If no argument requested a splice, return nil." + (let* ((splicep nil) + ;; Group each arg like ((list arg-1) (list arg-2) ...), + ;; splicing in `eshell-splice-args' args. This lets us + ;; apply spliced args correctly elsewhere. + (grouped-args + (mapcar (lambda (i) + (if (eq (car-safe i) 'eshell-splice-args) + (progn + (setq splicep t) + (cadr i)) + `(list ,i))) + args))) + (when splicep + grouped-args))) + +;;;_* Special ref completion + +(defun eshell-complete-special-reference () + "If there is a special reference, complete it." + (let ((arg (pcomplete-actual-arg))) + (when (string-match + (rx string-start + "#<" (? (group (or "buffer" "process")) space) + (group (* anychar)) + string-end) + arg) + (let ((all-results (if (equal (match-string 1 arg) "process") + (mapcar #'process-name (process-list)) + (mapcar #'buffer-name (buffer-list)))) + (saw-type (match-beginning 1))) + (unless saw-type + ;; Include the special reference types as completion options. + (setq all-results (append '("buffer" "process") all-results))) + (setq pcomplete-stub (replace-regexp-in-string + (rx "\\" (group anychar)) "\\1" + (substring arg (match-beginning 2)))) + ;; When finished with completion, add a trailing ">" (unless + ;; we just completed the initial "buffer" or "process" + ;; keyword). + (add-function + :before (var pcomplete-exit-function) + (lambda (value status) + (when (and (eq status 'finished) + (or saw-type + (not (member value '("buffer" "process"))))) + (if (looking-at ">") + (goto-char (match-end 0)) + (insert ">"))))) + (throw 'pcomplete-completions + (all-completions pcomplete-stub all-results)))))) + (provide 'esh-arg) ;;; esh-arg.el ends here diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index f4ac384ccc5..93f2616020c 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -343,7 +343,7 @@ This only returns external (non-Lisp) processes." #'eshell-complete-lisp-symbols nil t))) (defun eshell-complete-lisp-symbols () - "If there is a user reference, complete it." + "If there is a Lisp symbol, complete it." (let ((arg (pcomplete-actual-arg))) (when (string-match (concat "\\`" eshell-lisp-regexp) arg) (setq pcomplete-stub (substring arg (match-end 0)) @@ -418,8 +418,11 @@ hooks should be run before and after the command." (eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms)))) (let ((cmd commands)) (while cmd - (if (cdr cmd) - (setcar cmd `(eshell-commands ,(car cmd)))) + ;; Copy I/O handles so each full statement can manipulate them + ;; if they like. Steal the handles for the last command in + ;; the list; we won't use the originals again anyway. + (setcar cmd `(eshell-with-copied-handles + ,(car cmd) ,(not (cdr cmd)))) (setq cmd (cdr cmd)))) (if toplevel `(eshell-commands (progn @@ -480,14 +483,19 @@ hooks should be run before and after the command." (let ((sym (if eshell-in-pipeline-p 'eshell-named-command* 'eshell-named-command)) - (cmd (car terms)) - (args (cdr terms))) - (if args - (list sym cmd `(list ,@(cdr terms))) - (list sym cmd)))) - -(defvar eshell-command-body) -(defvar eshell-test-body) + (grouped-terms (eshell-prepare-splice terms))) + (cond + (grouped-terms + `(let ((terms (nconc ,@grouped-terms))) + (,sym (car terms) (cdr terms)))) + ;; If no terms are spliced, use a simpler command form. + ((cdr terms) + (list sym (car terms) `(list ,@(cdr terms)))) + (t + (list sym (car terms)))))) + +(defvar eshell--command-body) +(defvar eshell--test-body) (defsubst eshell-invokify-arg (arg &optional share-output silent) "Change ARG so it can be invoked from a structured command. @@ -525,25 +533,21 @@ implemented via rewriting, rather than as a function." (equal (nth 2 terms) "in")) (let ((body (car (last terms)))) (setcdr (last terms 2) nil) - `(let ((for-items - (copy-tree - (append - ,@(mapcar - (lambda (elem) - (if (listp elem) - elem - `(list ,elem))) - (cdr (cddr terms)))))) - (eshell-command-body '(nil)) - (eshell-test-body '(nil))) - (while (car for-items) - (let ((,(intern (cadr terms)) (car for-items)) + `(let ((for-items + (append + ,@(mapcar + (lambda (elem) + (if (listp elem) + elem + `(list ,elem))) + (nthcdr 3 terms))))) + (while for-items + (let ((,(intern (cadr terms)) (car for-items)) (eshell--local-vars (cons ',(intern (cadr terms)) - eshell--local-vars))) + eshell--local-vars))) (eshell-protect ,(eshell-invokify-arg body t))) - (setcar for-items (cadr for-items)) - (setcdr for-items (cddr for-items))) + (setq for-items (cdr for-items))) (eshell-close-handles))))) (defun eshell-structure-basic-command (func names keyword test body @@ -573,8 +577,7 @@ function." ;; finally, create the form that represents this structured ;; command - `(let ((eshell-command-body '(nil)) - (eshell-test-body '(nil))) + `(progn (,func ,test ,body ,else) (eshell-close-handles))) @@ -673,7 +676,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 @@ -690,7 +693,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))) @@ -733,18 +736,20 @@ 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'. -;; -;; @ The main body of a `let' can contain only one form. Use `progn' -;; if necessary. +;; @ 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 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. @@ -783,16 +788,17 @@ this grossness will be made to disappear by using `call/cc'..." (defvar eshell-output-handle) ;Defined in esh-io.el. (defvar eshell-error-handle) ;Defined in esh-io.el. -(defmacro eshell-copy-handles (object) - "Duplicate current I/O handles, so OBJECT works with its own copy." +(defmacro eshell-with-copied-handles (object &optional steal-p) + "Duplicate current I/O handles, so OBJECT works with its own copy. +If STEAL-P is non-nil, these new handles will be stolen from the +current ones (see `eshell-duplicate-handles')." `(let ((eshell-current-handles - (eshell-create-handles - (car (aref eshell-current-handles - eshell-output-handle)) nil - (car (aref eshell-current-handles - eshell-error-handle)) nil))) + (eshell-duplicate-handles eshell-current-handles ,steal-p))) ,object)) +(define-obsolete-function-alias 'eshell-copy-handles + #'eshell-with-copied-handles "30.1") + (defmacro eshell-protect (object) "Protect I/O handles, so they aren't get closed after eval'ing OBJECT." `(progn @@ -803,7 +809,7 @@ this grossness will be made to disappear by using `call/cc'..." "Execute the commands in PIPELINE, connecting each to one another. This macro calls itself recursively, with NOTFIRST non-nil." (when (setq pipeline (cadr pipeline)) - `(eshell-copy-handles + `(eshell-with-copied-handles (progn ,(when (cdr pipeline) `(let ((nextproc @@ -828,7 +834,9 @@ This macro calls itself recursively, with NOTFIRST non-nil." (let ((proc ,(car pipeline))) (set headproc (or proc (symbol-value headproc))) (set tailproc (or (symbol-value tailproc) proc)) - proc)))))) + proc))) + ;; Steal handles if this is the last item in the pipeline. + ,(null (cdr pipeline))))) (defmacro eshell-do-pipelines-synchronously (pipeline) "Execute the commands in PIPELINE in sequence synchronously. @@ -875,11 +883,8 @@ This is used on systems where async subprocesses are not supported." (progn ,(if (fboundp 'make-process) `(eshell-do-pipelines ,pipeline) - `(let ((tail-handles (eshell-create-handles - (car (aref eshell-current-handles - ,eshell-output-handle)) nil - (car (aref eshell-current-handles - ,eshell-error-handle)) nil))) + `(let ((tail-handles (eshell-duplicate-handles + eshell-current-handles))) (eshell-do-pipelines-synchronously ,pipeline))) (eshell-process-identity (cons (symbol-value headproc) (symbol-value tailproc)))))) @@ -1085,9 +1090,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))) @@ -1108,42 +1121,46 @@ be finished later after the completion of an asynchronous subprocess." (let ((args (cdr form))) (cond ((eq (car form) 'while) + ;; Wrap the `while' form with let-bindings for the command and + ;; test bodies. This helps us resume evaluation midway + ;; through the loop. + (let ((new-form (copy-tree `(let ((eshell--command-body nil) + (eshell--test-body nil)) + (eshell--wrapped-while ,@args))))) + (eshell-manipulate "modifying while form" + (setcar form (car new-form)) + (setcdr form (cdr new-form))) + (eshell-do-eval form synchronous-p))) + ((eq (car form) 'eshell--wrapped-while) + (when eshell--command-body + (cl-assert (not synchronous-p)) + (eshell-do-eval eshell--command-body) + (setq eshell--command-body nil + eshell--test-body nil)) ;; `copy-tree' is needed here so that the test argument - ;; doesn't get modified and thus always yield the same result. - (when (car eshell-command-body) - (cl-assert (not synchronous-p)) - (eshell-do-eval (car eshell-command-body)) - (setcar eshell-command-body nil) - (setcar eshell-test-body nil)) - (unless (car eshell-test-body) - (setcar eshell-test-body (copy-tree (car args)))) - (while (cadr (eshell-do-eval (car eshell-test-body) synchronous-p)) - (setcar eshell-command-body - (if (cddr args) - `(progn ,@(copy-tree (cdr args))) - (copy-tree (cadr args)))) - (eshell-do-eval (car eshell-command-body) synchronous-p) - (setcar eshell-command-body nil) - (setcar eshell-test-body (copy-tree (car args)))) - (setcar eshell-command-body nil)) + ;; doesn't get modified and thus always yield the same result. + (unless eshell--test-body + (setq eshell--test-body (copy-tree (car args)))) + (while (cadr (eshell-do-eval eshell--test-body synchronous-p)) + (setq eshell--command-body + (if (cddr args) + `(progn ,@(copy-tree (cdr args))) + (copy-tree (cadr args)))) + (eshell-do-eval eshell--command-body synchronous-p) + (setq eshell--command-body nil + eshell--test-body (copy-tree (car args))))) ((eq (car form) 'if) - ;; `copy-tree' is needed here so that the test argument - ;; doesn't get modified and thus always yield the same result. - (if (car eshell-command-body) - (progn - (cl-assert (not synchronous-p)) - (eshell-do-eval (car eshell-command-body))) - (unless (car eshell-test-body) - (setcar eshell-test-body (copy-tree (car args)))) - (setcar eshell-command-body - (copy-tree - (if (cadr (eshell-do-eval (car eshell-test-body) - synchronous-p)) - (cadr args) - (car (cddr args))))) - (eshell-do-eval (car eshell-command-body) synchronous-p)) - (setcar eshell-command-body nil) - (setcar eshell-test-body nil)) + (eshell-manipulate "evaluating if condition" + (setcar args (eshell-do-eval (car args) synchronous-p))) + (eshell-do-eval + (cond + ((eval (car args)) ; COND is non-nil + (cadr args)) + ((cdddr args) ; Multiple ELSE forms + `(progn ,@(cddr args))) + (t ; Zero or one ELSE forms + (caddr args))) + synchronous-p)) ((eq (car form) 'setcar) (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p)) (eval form)) @@ -1151,21 +1168,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-io.el b/lisp/eshell/esh-io.el index 26a8530fe54..cccdb49ce2a 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -74,6 +74,8 @@ (eval-when-compile (require 'cl-lib)) +(declare-function eshell-interactive-print "esh-mode" (string)) + (defgroup eshell-io nil "Eshell's I/O management code provides a scheme for treating many different kinds of objects -- symbols, files, buffers, etc. -- as @@ -116,16 +118,22 @@ from executing while Emacs is redisplaying." :group 'eshell-io) (defcustom eshell-virtual-targets - '(("/dev/eshell" eshell-interactive-print nil) + '(;; The literal string "/dev/null" is intentional here. It just + ;; provides compatibility so that users can redirect to + ;; "/dev/null" no matter the actual value of `null-device'. + ("/dev/null" (lambda (_mode) (throw 'eshell-null-device t)) t) + ("/dev/eshell" eshell-interactive-print nil) ("/dev/kill" (lambda (mode) - (if (eq mode 'overwrite) - (kill-new "")) - 'eshell-kill-append) t) + (when (eq mode 'overwrite) + (kill-new "")) + #'eshell-kill-append) + t) ("/dev/clip" (lambda (mode) - (if (eq mode 'overwrite) - (let ((select-enable-clipboard t)) - (kill-new ""))) - 'eshell-clipboard-append) t)) + (when (eq mode 'overwrite) + (let ((select-enable-clipboard t)) + (kill-new ""))) + #'eshell-clipboard-append) + t)) "Map virtual devices name to Emacs Lisp functions. If the user specifies any of the filenames above as a redirection target, the function in the second element will be called. @@ -138,10 +146,8 @@ function. The output function is then called repeatedly with single strings, which represents successive pieces of the output of the command, until nil -is passed, meaning EOF. - -NOTE: /dev/null is handled specially as a virtual target, and should -not be added to this variable." +is passed, meaning EOF." + :version "30.1" :type '(repeat (list (string :tag "Target") function @@ -291,25 +297,58 @@ describing the mode, e.g. for using with `eshell-get-target'.") (defun eshell-create-handles (stdout output-mode &optional stderr error-mode) "Create a new set of file handles for a command. -The default location for standard output and standard error will go to -STDOUT and STDERR, respectively. -OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert'; -a nil value of mode defaults to `insert'." +The default target for standard output and standard error will +go to STDOUT and STDERR, respectively. OUTPUT-MODE and +ERROR-MODE are either `overwrite', `append' or `insert'; a nil +value of mode defaults to `insert'. + +The result is a vector of file handles. Each handle is of the form: + + ((TARGETS . REF-COUNT) DEFAULT) + +TARGETS is a list of destinations for output. REF-COUNT is the +number of references to this handle (initially 1); see +`eshell-protect-handles' and `eshell-close-handles'. DEFAULT is +non-nil if handle has its initial default value (always t after +calling this function)." (let* ((handles (make-vector eshell-number-of-handles nil)) - (output-target (eshell-get-target stdout output-mode)) - (error-target (if stderr - (eshell-get-target stderr error-mode) - output-target))) - (aset handles eshell-output-handle (cons output-target 1)) - (aset handles eshell-error-handle (cons error-target 1)) + (output-target + (let ((target (eshell-get-target stdout output-mode))) + (cons (when target (list target)) 1))) + (error-target + (if stderr + (let ((target (eshell-get-target stderr error-mode))) + (cons (when target (list target)) 1)) + (cl-incf (cdr output-target)) + output-target))) + (aset handles eshell-output-handle (list output-target t)) + (aset handles eshell-error-handle (list error-target t)) handles)) +(defun eshell-duplicate-handles (handles &optional steal-p) + "Create a duplicate of the file handles in HANDLES. +This uses the targets of each handle in HANDLES, incrementing its +reference count by one (unless STEAL-P is non-nil). These +targets are shared between the original set of handles and the +new one, so the targets are only closed when the reference count +drops to 0 (see `eshell-close-handles'). + +This function also sets the DEFAULT field for each handle to +t (see `eshell-create-handles'). Unlike the targets, this value +is not shared with the original handles." + (let ((dup-handles (make-vector eshell-number-of-handles nil))) + (dotimes (idx eshell-number-of-handles) + (when-let ((handle (aref handles idx))) + (unless steal-p + (cl-incf (cdar handle))) + (aset dup-handles idx (list (car handle) t)))) + dup-handles)) + (defun eshell-protect-handles (handles) "Protect the handles in HANDLES from a being closed." (dotimes (idx eshell-number-of-handles) - (when (aref handles idx) - (setcdr (aref handles idx) - (1+ (cdr (aref handles idx)))))) + (when-let ((handle (aref handles idx))) + (cl-incf (cdar handle)))) handles) (defun eshell-close-handles (&optional exit-code result handles) @@ -327,46 +366,56 @@ the value already set in `eshell-last-command-result'." (when result (cl-assert (eq (car result) 'quote)) (setq eshell-last-command-result (cadr result))) - (let ((handles (or handles eshell-current-handles))) + (let ((handles (or handles eshell-current-handles)) + (succeeded (= eshell-last-command-status 0))) (dotimes (idx eshell-number-of-handles) - (when-let ((handle (aref handles idx))) - (setcdr handle (1- (cdr handle))) - (when (= (cdr handle) 0) - (dolist (target (ensure-list (car (aref handles idx)))) - (eshell-close-target target (= eshell-last-command-status 0))) - (setcar handle nil)))))) + (eshell-close-handle (aref handles idx) succeeded)))) + +(defun eshell-close-handle (handle status) + "Close a single HANDLE, taking refcounts into account. +This will pass STATUS to each target for the handle, which should +be a non-nil value on successful termination." + (when handle + (cl-assert (> (cdar handle) 0) + "Attempted to close a handle with 0 references") + (when (and (> (cdar handle) 0) + (= (cl-decf (cdar handle)) 0)) + (dolist (target (caar handle)) + (eshell-close-target target status)) + (setcar (car handle) nil)))) (defun eshell-set-output-handle (index mode &optional target handles) "Set handle INDEX for the current HANDLES to point to TARGET using MODE. -If HANDLES is nil, use `eshell-current-handles'." +If HANDLES is nil, use `eshell-current-handles'. + +If the handle is currently set to its default value (see +`eshell-create-handles'), this will overwrite the targets with +the new target. Otherwise, it will append the new target to the +current list of targets." (when target - (let ((handles (or handles eshell-current-handles))) - (if (and (stringp target) - ;; The literal string "/dev/null" is intentional here. - ;; It just provides compatibility so that users can - ;; redirect to "/dev/null" no matter the actual value - ;; of `null-device'. - (string= target "/dev/null")) - (aset handles index nil) - (let ((where (eshell-get-target target mode)) - (current (car (aref handles index)))) - (if (listp current) - (unless (member where current) - (setq current (append current (list where)))) - (setq current (list where))) - (if (not (aref handles index)) - (aset handles index (cons nil 1))) - (setcar (aref handles index) current)))))) + (let* ((handles (or handles eshell-current-handles)) + (handle (or (aref handles index) + (aset handles index (list (cons nil 1) nil)))) + (defaultp (cadr handle))) + (when defaultp + (cl-decf (cdar handle)) + (setcar handle (cons nil 1))) + (catch 'eshell-null-device + (let ((current (caar handle)) + (where (eshell-get-target target mode))) + (unless (member where current) + (setcar (car handle) (append current (list where)))))) + (setcar (cdr handle) nil)))) (defun eshell-copy-output-handle (index index-to-copy &optional handles) "Copy the handle INDEX-TO-COPY to INDEX for the current HANDLES. If HANDLES is nil, use `eshell-current-handles'." (let* ((handles (or handles eshell-current-handles)) (handle-to-copy (car (aref handles index-to-copy)))) - (setcar (aref handles index) - (if (listp handle-to-copy) - (copy-sequence handle-to-copy) - handle-to-copy)))) + (when handle-to-copy + (cl-incf (cdr handle-to-copy))) + (eshell-close-handle (aref handles index) nil) + (setcar (aref handles index) handle-to-copy))) (defun eshell-set-all-output-handles (mode &optional target handles) "Set output and error HANDLES to point to TARGET using MODE. @@ -497,9 +546,9 @@ INDEX is the handle index to check. If nil, check (let ((handles (or handles eshell-current-handles)) (index (or index eshell-output-handle))) (if (eq index 'all) - (and (eq (car (aref handles eshell-output-handle)) t) - (eq (car (aref handles eshell-error-handle)) t)) - (eq (car (aref handles index)) t)))) + (and (equal (caar (aref handles eshell-output-handle)) '(t)) + (equal (caar (aref handles eshell-error-handle)) '(t))) + (equal (caar (aref handles index)) '(t))))) (defvar eshell-print-queue nil) (defvar eshell-print-queue-count -1) @@ -550,8 +599,6 @@ after all printing is over with no argument." (eshell-print object) (eshell-print "\n")) -(autoload 'eshell-output-filter "esh-mode") - (defun eshell-output-object-to-target (object target) "Insert OBJECT into TARGET. Returns what was actually sent, or nil if nothing was sent." @@ -561,7 +608,7 @@ Returns what was actually sent, or nil if nothing was sent." ((symbolp target) (if (eq target t) ; means "print to display" - (eshell-output-filter nil (eshell-stringify object)) + (eshell-interactive-print (eshell-stringify object)) (if (not (symbol-value target)) (set target object) (setq object (eshell-stringify object)) @@ -606,15 +653,10 @@ Returns what was actually sent, or nil if nothing was sent." If HANDLE-INDEX is nil, output to `eshell-output-handle'. HANDLES is the set of file handles to use; if nil, use `eshell-current-handles'." - (let ((target (car (aref (or handles eshell-current-handles) - (or handle-index eshell-output-handle))))) - (if (listp target) - (while target - (eshell-output-object-to-target object (car target)) - (setq target (cdr target))) - (eshell-output-object-to-target object target) - ;; Explicitly return nil to match the list case above. - nil))) + (let ((targets (caar (aref (or handles eshell-current-handles) + (or handle-index eshell-output-handle))))) + (dolist (target targets) + (eshell-output-object-to-target object target)))) (provide 'esh-io) ;;; esh-io.el ends here diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index d80f1d1f390..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." @@ -155,7 +162,8 @@ number, if the function `eshell-truncate-buffer' is on eshell-watch-for-password-prompt) "Functions to call before output is displayed. These functions are only called for output that is displayed -interactively, and not for output which is redirected." +interactively (see `eshell-interactive-filter'), and not for +output which is redirected." :type 'hook) (defcustom eshell-preoutput-filter-functions nil @@ -165,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 @@ -175,6 +186,8 @@ This is used by `eshell-watch-for-password-prompt'." "A function called from beginning of line to skip the prompt." :type '(choice (const nil) function)) +(make-obsolete-variable 'eshell-skip-prompt-function nil "30.1") + (defcustom eshell-status-in-mode-line t "If non-nil, let the user know a command is running in the mode line." :type 'boolean) @@ -188,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 @@ -261,14 +279,13 @@ This is used by `eshell-watch-for-password-prompt'." "C-c" 'eshell-command-map "RET" #'eshell-send-input "M-RET" #'eshell-queue-input - "C-M-l" #'eshell-show-output - "C-a" #'eshell-bol) + "C-M-l" #'eshell-show-output) (defvar-keymap eshell-command-map :prefix 'eshell-command-map "M-o" #'eshell-mark-output "M-d" #'eshell-toggle-direct-send - "C-a" #'eshell-bol + "C-a" #'move-beginning-of-line "C-b" #'eshell-backward-argument "C-e" #'eshell-show-maximum-output "C-f" #'eshell-forward-argument @@ -471,7 +488,7 @@ and the hook `eshell-exit-hook'." (defun eshell-move-argument (limit func property arg) "Move forward ARG arguments." (catch 'eshell-incomplete - (eshell-parse-arguments (save-excursion (eshell-bol) (point)) + (eshell-parse-arguments (save-excursion (beginning-of-line) (point)) (line-end-position))) (let ((pos (save-excursion (funcall func 1) @@ -504,12 +521,7 @@ and the hook `eshell-exit-hook'." (kill-ring-save begin (point)) (yank))) -(defun eshell-bol () - "Go to the beginning of line, then skip past the prompt, if any." - (interactive) - (beginning-of-line) - (and eshell-skip-prompt-function - (funcall eshell-skip-prompt-function))) +(define-obsolete-function-alias 'eshell-bol #'beginning-of-line "30.1") (defsubst eshell-push-command-mark () "Push a mark at the end of the last input text." @@ -525,9 +537,11 @@ Putting this function on `eshell-pre-command-hook' will mimic Plan 9's (custom-add-option 'eshell-pre-command-hook #'eshell-goto-input-start) -(defsubst eshell-interactive-print (string) +(defun eshell-interactive-print (string) "Print STRING to the eshell display buffer." - (eshell-output-filter nil string)) + (when string + (eshell--mark-as-output 0 (length string) string) + (eshell-interactive-filter nil string))) (defsubst eshell-begin-on-new-line () "This function outputs a newline if not at beginning of line." @@ -566,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))) @@ -687,14 +701,14 @@ newline." (custom-add-option 'eshell-input-filter-functions 'eshell-kill-new) -(defun eshell-output-filter (process string) - "Send the output from PROCESS (STRING) to the interactive display. +(defun eshell-interactive-filter (buffer string) + "Send output (STRING) to the interactive display, using BUFFER. This is done after all necessary filtering has been done." - (let ((oprocbuf (if process (process-buffer process) - (current-buffer))) - (inhibit-modification-hooks t)) - (when (and string oprocbuf (buffer-name oprocbuf)) - (with-current-buffer oprocbuf + (unless buffer + (setq buffer (current-buffer))) + (when (and string (buffer-live-p buffer)) + (let ((inhibit-modification-hooks t)) + (with-current-buffer buffer (let ((functions eshell-preoutput-filter-functions)) (while (and functions string) (setq string (funcall (car functions) string)) @@ -851,7 +865,7 @@ With a prefix argument, narrows region to last command output." (if (> (point) eshell-last-output-end) (kill-region eshell-last-output-end (point)) (let ((here (point))) - (eshell-bol) + (beginning-of-line) (kill-region (point) here)))) (defun eshell-show-maximum-output (&optional interactive) @@ -879,17 +893,18 @@ If SCROLLBACK is non-nil, clear the scrollback contents." (erase-buffer))) (defun eshell-get-old-input (&optional use-current-region) - "Return the command input on the current line." + "Return the command input on the current line. +If USE-CURRENT-REGION is non-nil, return the current region." (if use-current-region (buffer-substring (min (point) (mark)) (max (point) (mark))) (save-excursion - (beginning-of-line) - (and eshell-skip-prompt-function - (funcall eshell-skip-prompt-function)) - (let ((beg (point))) - (end-of-line) - (buffer-substring beg (point)))))) + (let ((inhibit-field-text-motion t)) + (end-of-line)) + (let ((inhibit-field-text-motion) + (end (point))) + (beginning-of-line) + (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 e8da847e184..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; @@ -132,7 +137,7 @@ This code doesn't really need to be macro expanded everywhere." (setq args (eshell--process-args name args options)) nil)))) (when usage-msg - (error "%s" usage-msg)))))) + (user-error "%s" usage-msg)))))) (if ext-command (throw 'eshell-external (eshell-external-command ext-command orig-args)) @@ -237,7 +242,7 @@ remaining characters in SWITCH to be processed later as further short options. If no matching handler is found, and an :external command is defined -(and available), it will be called; otherwise, an error will be +\(and available), it will be called; otherwise, an error will be triggered to say that the switch is unrecognized." (let ((switch (eshell--split-switch switch kind)) (opts options) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index f1ec3a905b6..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 @@ -296,15 +297,20 @@ Used only on systems which do not support async subprocesses.") 'unix)))) (cond ((fboundp 'make-process) - (unless (equal (car (aref eshell-current-handles eshell-output-handle)) - (car (aref eshell-current-handles eshell-error-handle))) + (unless (or ;; FIXME: It's not currently possible to use a + ;; stderr process for remote files. + (file-remote-p default-directory) + (equal (car (aref eshell-current-handles + eshell-output-handle)) + (car (aref eshell-current-handles + eshell-error-handle)))) (eshell-protect-handles eshell-current-handles) (setq stderr-proc (make-pipe-process :name (concat (file-name-nondirectory command) "-stderr") :buffer (current-buffer) :filter (if (eshell-interactive-output-p eshell-error-handle) - #'eshell-output-filter + #'eshell-interactive-process-filter #'eshell-insertion-filter) :sentinel #'eshell-sentinel)) (eshell-record-process-properties stderr-proc eshell-error-handle)) @@ -320,7 +326,7 @@ Used only on systems which do not support async subprocesses.") :buffer (current-buffer) :command (cons command args) :filter (if (eshell-interactive-output-p) - #'eshell-output-filter + #'eshell-interactive-process-filter #'eshell-insertion-filter) :sentinel #'eshell-sentinel :connection-type conn-type @@ -381,7 +387,7 @@ Used only on systems which do not support async subprocesses.") line (buffer-substring-no-properties lbeg lend)) (set-buffer oldbuf) (if interact-p - (eshell-output-filter nil line) + (eshell-interactive-process-filter nil line) (eshell-output-object line)) (setq lbeg lend) (set-buffer proc-buf)) @@ -402,6 +408,20 @@ Used only on systems which do not support async subprocesses.") (setq proc t)))) proc)) +(defun eshell-interactive-process-filter (process string) + "Send the output from PROCESS (STRING) to the interactive display. +This is done after all necessary filtering has been done." + (when 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) + (current-buffer)) + string))) + +(define-obsolete-function-alias 'eshell-output-filter + #'eshell-interactive-process-filter "30.1") + (defun eshell-insertion-filter (proc string) "Insert a string into the eshell buffer, or a process/file/buffer. PROC is the process for which we're inserting output. STRING is the @@ -467,7 +487,7 @@ PROC is the process that's exiting. STRING is the exit message." (if (process-get proc :eshell-busy) (run-at-time 0 nil finish-io) (when data - (ignore-error 'eshell-pipe-broken + (ignore-error eshell-pipe-broken (eshell-output-object data index handles))) (eshell-close-handles diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index d003148dc96..c0685757789 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -94,13 +94,6 @@ a non-nil value, will be passed strings, not numbers, even when an argument matches `eshell-number-regexp'." :type 'boolean) -(defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?" - "Regular expression used to match numeric arguments. -If `eshell-convert-numeric-arguments' is non-nil, and an argument -matches this regexp, it will be converted to a Lisp number, using the -function `string-to-number'." - :type 'regexp) - (defcustom eshell-ange-ls-uids nil "List of user/host/id strings, used to determine remote ownership." :type '(repeat (cons :tag "Host for User/UID map" @@ -111,6 +104,22 @@ function `string-to-number'." ;;; Internal Variables: +(defvar eshell-number-regexp + (rx (? "-") + (or (seq (+ digit) (? "." (* digit))) + (seq (* digit) "." (+ digit))) + ;; Optional exponent + (? (or "e" "E") + (or "+INF" "+NaN" + (seq (? (or "+" "-")) (+ digit))))) + "Regular expression used to match numeric arguments. +If `eshell-convert-numeric-arguments' is non-nil, and an argument +matches this regexp, it will be converted to a Lisp number, using the +function `string-to-number'.") + +(defvar eshell-integer-regexp (rx (? "-") (+ digit)) + "Regular expression used to match integer arguments.") + (defvar eshell-group-names nil "A cache to hold the names of groups.") @@ -123,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 @@ -148,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. @@ -362,9 +405,13 @@ Prepend remote identification of `default-directory', if any." "Convert each element of ARGS into a string value." (mapcar #'eshell-stringify args)) +(defsubst eshell-list-to-string (list) + "Convert LIST into a single string separated by spaces." + (mapconcat #'eshell-stringify list " ")) + (defsubst eshell-flatten-and-stringify (&rest args) "Flatten and stringify all of the ARGS into a single string." - (mapconcat #'eshell-stringify (flatten-tree args) " ")) + (eshell-list-to-string (flatten-tree args))) (defsubst eshell-directory-files (regexp &optional directory) "Return a list of files in the given DIRECTORY matching REGEXP." diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index dfc52083acb..5d6299af564 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -86,6 +86,13 @@ ;; Returns the length of the value of $EXPR. This could also be ;; done using the `length' Lisp function. ;; +;; $@EXPR +;; +;; Splices the value of $EXPR in-place into the current list of +;; arguments. This is analogous to the `,@' token in Elisp +;; backquotes, and works as if the user typed '$EXPR[0] $EXPR[1] +;; ... $EXPR[N]'. +;; ;; There are also a few special variables defined by Eshell. '$$' is ;; the value of the last command (t or nil, in the case of an external ;; command). This makes it possible to chain results: @@ -155,6 +162,7 @@ if they are quoted with a backslash." ("COLUMNS" ,(lambda () (window-body-width nil 'remap)) t t) ("LINES" ,(lambda () (window-body-height nil 'remap)) t t) ("INSIDE_EMACS" eshell-inside-emacs t) + ("UID" ,(lambda () (file-user-uid)) nil t) ;; for esh-ext.el ("PATH" (,(lambda () (string-join (eshell-get-path t) (path-separator))) @@ -320,10 +328,9 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." "Parse a variable interpolation. This function is explicit for adding to `eshell-parse-argument-hook'." (when (and (eq (char-after) ?$) - (/= (1+ (point)) (point-max))) + (/= (1+ (point)) (point-max))) (forward-char) - (list 'eshell-escape-arg - (eshell-parse-variable)))) + (eshell-parse-variable))) (defun eshell/define (var-alias definition) "Define a VAR-ALIAS using DEFINITION." @@ -427,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. @@ -453,18 +465,24 @@ Its purpose is to call `eshell-parse-variable-ref', and then to process any indices that come after the variable reference." (let* ((get-len (when (eq (char-after) ?#) (forward-char) t)) + (splice (when (eq (char-after) ?@) + (forward-char) t)) value indices) (setq value (eshell-parse-variable-ref get-len) indices (and (not (eobp)) (eq (char-after) ?\[) (eshell-parse-indices)) - ;; This is an expression that will be evaluated by `eshell-do-eval', - ;; which only support let-binding of dynamically-scoped vars - value `(let ((indices (eshell-eval-indices ',indices))) ,value)) + value `(let ((indices ,(eshell-prepare-indices indices))) ,value)) (when get-len (setq value `(length ,value))) (when eshell-current-quoted - (setq value `(eshell-stringify ,value))) + (if splice + (setq value `(eshell-list-to-string ,value) + splice nil) + (setq value `(eshell-stringify ,value)))) + (setq value `(eshell-escape-arg ,value)) + (when splice + (setq value `(eshell-splice-args ,value))) value)) (defun eshell-parse-variable-ref (&optional modifier-p) @@ -481,7 +499,7 @@ Possible variable references are: NAME an environment or Lisp variable value \"LONG-NAME\" disambiguates the length of the name - `LONG-NAME' as above + \\='LONG-NAME\\=' as above {COMMAND} result of command is variable's value (LISP-FORM) result of Lisp form is variable's value <COMMAND> write the output of command to a temporary file; @@ -490,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 @@ -514,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))) @@ -547,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)) @@ -574,14 +596,17 @@ Possible variable references are: (defun eshell-parse-indices () "Parse and return a list of index-lists. +This produces a series of Lisp forms to be processed by +`eshell-prepare-indices' and ultimately evaluated by +`eshell-do-eval'. For example, \"[0 1][2]\" becomes: - ((\"0\" \"1\") (\"2\")." + ((\"0\" \"1\") (\"2\"))." (let (indices) (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)) @@ -592,10 +617,46 @@ For example, \"[0 1][2]\" becomes: (goto-char (1+ end))))) (nreverse indices))) +(defun eshell-parse-index (index) + "Parse a single INDEX in string form. +If INDEX looks like a number, return that number. + +If INDEX looks like \"[BEGIN]..[END]\", where BEGIN and END look +like integers, return a cons cell of BEGIN and END as numbers; +BEGIN and/or END can be omitted here, in which case their value +in the cons is nil. + +Otherwise (including if INDEX is not a string), return +the original value of INDEX." + (save-match-data + (cond + ((and (stringp index) (get-text-property 0 'number index)) + (string-to-number index)) + ((and (stringp index) + (not (text-property-any 0 (length index) 'escaped t index)) + (string-match (rx string-start + (group-n 1 (? (regexp eshell-integer-regexp))) + ".." + (group-n 2 (? (regexp eshell-integer-regexp))) + string-end) + index)) + (let ((begin (match-string 1 index)) + (end (match-string 2 index))) + (cons (unless (string-empty-p begin) (string-to-number begin)) + (unless (string-empty-p end) (string-to-number end))))) + (t + index)))) + (defun eshell-eval-indices (indices) "Evaluate INDICES, a list of index-lists generated by `eshell-parse-indices'." + (declare (obsolete eshell-prepare-indices "30.1")) (mapcar (lambda (i) (mapcar #'eval i)) indices)) +(defun eshell-prepare-indices (indices) + "Prepare INDICES to be evaluated by Eshell. +INDICES is a list of index-lists generated by `eshell-parse-indices'." + `(list ,@(mapcar (lambda (idx-list) (cons 'list idx-list)) indices))) + (defun eshell-get-variable (name &optional indices quoted) "Get the value for the variable NAME. INDICES is a list of index-lists (see `eshell-parse-indices'). @@ -697,98 +758,123 @@ For example, to retrieve the second element of a user's record in '/etc/passwd', the variable reference would look like: ${grep johnw /etc/passwd}[: 2]" - (while indices - (let ((refs (car indices))) - (when (stringp value) - (let (separator (index (caar indices))) - (when (and (stringp index) - (not (get-text-property 0 'number index))) - (setq separator index - refs (cdr refs))) - (setq value (split-string value separator)) - (unless quoted - (setq value (mapcar #'eshell-convert-to-number value))))) - (cond - ((< (length refs) 0) - (error "Invalid array variable index: %s" - (eshell-stringify refs))) - ((= (length refs) 1) - (setq value (eshell-index-value value (car refs)))) - (t - (let ((new-value (list t))) - (while refs - (nconc new-value - (list (eshell-index-value value - (car refs)))) - (setq refs (cdr refs))) - (setq value (cdr new-value)))))) - (setq indices (cdr indices))) - value) + (dolist (refs indices value) + ;; For string values, check if the first index looks like a + ;; regexp, and if so, use that to split the string. + (when (stringp value) + (let (separator (first (car refs))) + (when (stringp (eshell-parse-index first)) + (setq separator first + refs (cdr refs))) + (setq value (split-string value separator)) + (unless quoted + (setq value (mapcar #'eshell-convert-to-number value))))) + (cond + ((< (length refs) 0) + (error "Invalid array variable index: %s" + (eshell-stringify refs))) + ((= (length refs) 1) + (setq value (eshell-index-value value (car refs)))) + (t + (let (new-value) + (dolist (ref refs) + (push (eshell-index-value value ref) new-value)) + (setq value (nreverse new-value))))))) + +(pcase-defmacro eshell-index-range (start end) + "A pattern that matches an Eshell index range. +EXPVAL should be a cons cell, with each slot containing either an +integer or nil. If this matches, bind the values of the sltos to +START and END." + (list '\` (cons (list '\, `(and (or (pred integerp) (pred null)) ,start)) + (list '\, `(and (or (pred integerp) (pred null)) ,end))))) (defun eshell-index-value (value index) "Reference VALUE using the given INDEX." - (when (and (stringp index) (get-text-property 0 'number index)) - (setq index (string-to-number index))) - (if (integerp index) - (cond - ((ring-p value) - (if (> index (ring-length value)) - (error "Index exceeds length of ring") - (ring-ref value index))) - ((listp value) - (if (> index (length value)) - (error "Index exceeds length of list") - (nth index value))) - ((vectorp value) - (if (> index (length value)) - (error "Index exceeds length of vector") - (aref value index))) - (t - (error "Invalid data type for indexing"))) - ;; INDEX is some non-integer value, so treat VALUE as an alist. - (cdr (assoc index value)))) + (let ((parsed-index (eshell-parse-index index))) + (if (ring-p value) + (pcase parsed-index + ((pred integerp) + (ring-ref value parsed-index)) + ((eshell-index-range start end) + (let* ((len (ring-length value)) + (real-start (mod (or start 0) len)) + (real-end (mod (or end len) len))) + (when (and (eq real-end 0) + (not (eq end 0))) + (setq real-end len)) + (ring-convert-sequence-to-ring + (seq-subseq (ring-elements value) real-start real-end)))) + (_ + (error "Invalid index for ring: %s" index))) + (pcase parsed-index + ((pred integerp) + (when (< parsed-index 0) + (setq parsed-index (+ parsed-index (length value)))) + (seq-elt value parsed-index)) + ((eshell-index-range start end) + (seq-subseq value (or start 0) end)) + (_ + ;; INDEX is some non-integer value, so treat VALUE as an alist. + (cdr (assoc parsed-index value))))))) ;;;_* Variable name completion (defun eshell-complete-variable-reference () "If there is a variable reference, complete it." - (let ((arg (pcomplete-actual-arg)) index) - (when (setq index - (string-match - (concat "\\$\\(" eshell-variable-name-regexp - "\\)?\\'") arg)) - (setq pcomplete-stub (substring arg (1+ index))) + (let ((arg (pcomplete-actual-arg))) + (when (string-match + (rx "$" (? (or "#" "@")) + (? (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 3323eab205a..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. @@ -304,7 +304,16 @@ If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." (let ((attrs - (delq :inherit (mapcar 'car face-attribute-name-alist))) + ;; The _value_ of :inherit teaches us nothing about how FACE + ;; looks compared to the default face. Instead, we will ask + ;; `face-attribute' to take inheritance into account when + ;; examining other attributes. + (delq :inherit + ;; A difference in extension past EOL only matters when + ;; relevant attributes (such as :background) also + ;; differ from the default; otherwise this difference + ;; is a false positive. + (delq :extend (mapcar 'car face-attribute-name-alist)))) (differs nil)) (while (and attrs (not differs)) (let* ((attr (pop attrs)) @@ -2217,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-x.el b/lisp/files-x.el index 5fa0129e9d0..548d9efc193 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -681,8 +681,8 @@ variables for a connection profile are defined using (setq connection-local-criteria-alist (cons (cons criteria (delete-dups profiles)) connection-local-criteria-alist)))) - (customize-set-variable - 'connection-local-criteria-alist connection-local-criteria-alist)) + (custom-set-variables + `(connection-local-criteria-alist ',connection-local-criteria-alist now))) (defsubst connection-local-get-profile-variables (profile) "Return the connection-local variable list for PROFILE." @@ -702,8 +702,8 @@ variables are set in the server's process buffer according to the VARIABLES list of the connection profile. The list is processed in order." (setf (alist-get profile connection-local-profile-alist) variables) - (customize-set-variable - 'connection-local-profile-alist connection-local-profile-alist)) + (custom-set-variables + `(connection-local-profile-alist ',connection-local-profile-alist now))) ;;;###autoload (defun connection-local-update-profile-variables (profile variables) diff --git a/lisp/files.el b/lisp/files.el index 0d24852358e..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) @@ -6199,11 +6209,11 @@ instance of such commands." (rename-buffer (generate-new-buffer-name base-name)) (force-mode-line-update)))) -(defun files--ensure-directory (mkdir dir) - "Use function MKDIR to make directory DIR if it is not already a directory. +(defun files--ensure-directory (dir) + "Make directory DIR if it is not already a directory. Return non-nil if DIR is already a directory." (condition-case err - (funcall mkdir dir) + (make-directory-internal dir) (error (or (file-directory-p dir) (signal (car err) (cdr err)))))) @@ -6229,32 +6239,27 @@ Signal an error if unsuccessful." ;; If default-directory is a remote directory, ;; make sure we find its make-directory handler. (setq dir (expand-file-name dir)) - (let ((mkdir (if-let ((handler (find-file-name-handler dir 'make-directory))) - #'(lambda (dir) - ;; Use 'ignore' since the handler might be designed for - ;; Emacs 28-, so it might return an (undocumented) - ;; non-nil value, whereas the Emacs 29+ convention is - ;; to return nil here. - (ignore (funcall handler 'make-directory dir))) - #'make-directory-internal))) - (if (not parents) - (funcall mkdir dir) - (let ((dir (directory-file-name (expand-file-name dir))) - already-dir create-list parent) - (while (progn - (setq parent (directory-file-name - (file-name-directory dir))) - (condition-case () - (ignore (setq already-dir - (files--ensure-directory mkdir dir))) - (error - ;; Do not loop if root does not exist (Bug#2309). - (not (string= dir parent))))) - (setq create-list (cons dir create-list) - dir parent)) - (dolist (dir create-list) - (setq already-dir (files--ensure-directory mkdir dir))) - already-dir)))) + (let ((handler (find-file-name-handler dir 'make-directory))) + (if handler + (funcall handler 'make-directory dir parents) + (if (not parents) + (make-directory-internal dir) + (let ((dir (directory-file-name (expand-file-name dir))) + already-dir create-list parent) + (while (progn + (setq parent (directory-file-name + (file-name-directory dir))) + (condition-case () + (ignore (setq already-dir + (files--ensure-directory dir))) + (error + ;; Do not loop if root does not exist (Bug#2309). + (not (string= dir parent))))) + (setq create-list (cons dir create-list) + dir parent)) + (dolist (dir create-list) + (setq already-dir (files--ensure-directory dir))) + already-dir))))) (defun make-empty-file (filename &optional parents) "Create an empty file FILENAME. @@ -6347,6 +6352,12 @@ RECURSIVE if DIRECTORY is nonempty." directory-exists)) (files--force recursive #'delete-directory-internal directory)))))) +(defcustom remote-file-name-inhibit-delete-by-moving-to-trash nil + "Whether remote files shall be moved to the Trash. +This overrules any setting of `delete-by-moving-to-trash'." + :version "30.1" + :type 'boolean) + (defun file-equal-p (file1 file2) "Return non-nil if files FILE1 and FILE2 name the same file. If FILE1 or FILE2 does not exist, the return value is unspecified." @@ -6357,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. @@ -7099,10 +7121,11 @@ specifies the list of buffers to kill, asking for approval for each one." (setq list (cdr list)))) (defun kill-matching-buffers (regexp &optional internal-too no-ask) - "Kill buffers whose name matches the specified REGEXP. -Ignores buffers whose name starts with a space, unless optional -prefix argument INTERNAL-TOO is non-nil. Asks before killing -each buffer, unless NO-ASK is non-nil." + "Kill buffers whose names match the regular expression REGEXP. +Interactively, prompt for REGEXP. +Ignores buffers whose names start with a space, unless optional +prefix argument INTERNAL-TOO(interactively, the prefix argument) +is non-nil. Asks before killing each buffer, unless NO-ASK is non-nil." (interactive "sKill buffers matching this regular expression: \nP") (dolist (buffer (buffer-list)) (let ((name (buffer-name buffer))) @@ -7111,6 +7134,17 @@ each buffer, unless NO-ASK is non-nil." (string-match regexp name)) (funcall (if no-ask 'kill-buffer 'kill-buffer-ask) buffer))))) +(defun kill-matching-buffers-no-ask (regexp &optional internal-too) + "Kill buffers whose names match the regular expression REGEXP. +Interactively, prompt for REGEXP. +Like `kill-matching-buffers', but doesn't ask for confirmation +before killing each buffer. +Ignores buffers whose names start with a space, unless the +optional argument INTERNAL-TOO (interactively, the prefix argument) +is non-nil." + (interactive "sKill buffers matching this regular expression: \nP") + (kill-matching-buffers regexp internal-too t)) + (defun rename-auto-save-file () "Adjust current buffer's auto save file name for current conditions. @@ -7656,7 +7690,7 @@ If DIR's free space cannot be obtained, this function returns nil." ;; This avoids recognizing `1 may 1997' as a date in the line: ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README - ;; The "[BkKMGTPEZY]?" below supports "ls -alh" output. + ;; The "[BkKMGTPEZYRQ]?" below supports "ls -alh" output. ;; For non-iso date formats, we add the ".*" in order to find ;; the last possible match. This avoids recognizing @@ -7668,8 +7702,8 @@ If DIR's free space cannot be obtained, this function returns nil." ;; parentheses: ;; -rw-r--r-- (modified) 2005-10-22 21:25 files.el ;; This is not supported yet. - (purecopy (concat "\\([0-9][BkKMGTPEZY]? " iso - "\\|.*[0-9][BkKMGTPEZY]? " + (purecopy (concat "\\([0-9][BkKMGTPEZYRQ]? " iso + "\\|.*[0-9][BkKMGTPEZYRQ]? " "\\(" western "\\|" western-comma "\\|" DD-MMM-YYYY "\\|" east-asian "\\)" "\\) +"))) @@ -8380,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/find-dired.el b/lisp/find-dired.el index 33376ee4ed9..db2f5e7d026 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -50,8 +50,13 @@ than the latter." :group 'find-dired :type 'string) +(defvar find-gnu-find-p + (eq 0 (ignore-errors + (process-file find-program nil nil nil null-device "--version"))) + "Non-nil if `find-program' is a GNU Find, nil otherwise.") + (defvar find-ls-option-default-ls - (cons "-ls" (if (eq system-type 'berkeley-unix) "-gilsb" "-dilsb"))) + (cons "-ls" (if find-gnu-find-p "-dilsb" "-dgils"))) (defvar find-ls-option-default-exec (cons (format "-exec ls -ld {} %s" find-exec-terminator) "-ld")) 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 af95a047c38..39e8a4c88b8 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -239,7 +239,8 @@ that's not the whole story: see `after-focus-change-function'." This function runs the abnormal hook `move-frame-functions'." (interactive "e") (let ((frame (posn-window (event-start event)))) - (run-hook-with-args 'move-frame-functions frame))) + (when (frame-live-p frame) ;Experience shows it can die in the meantime. + (run-hook-with-args 'move-frame-functions frame)))) ;;;; Arrangement of frames at startup @@ -873,6 +874,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))))) @@ -1188,7 +1194,7 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))." (defvar inhibit-frame-set-background-mode nil) -(defun frame--current-backround-mode (frame) +(defun frame--current-background-mode (frame) (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame)) (bg-color (frame-parameter frame 'background-color)) (tty-type (tty-type frame)) @@ -1218,7 +1224,7 @@ If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate face specs for the new background mode." (unless inhibit-frame-set-background-mode (let* ((bg-mode - (frame--current-backround-mode frame)) + (frame--current-background-mode frame)) (display-type (cond ((null (window-system frame)) (if (tty-display-color-p frame) 'color 'mono)) @@ -1297,7 +1303,7 @@ the `background-mode' terminal parameter." ;; :global t ;; :group 'faces ;; (when (eq dark-mode -;; (eq 'light (frame--current-backround-mode (selected-frame)))) +;; (eq 'light (frame--current-background-mode (selected-frame)))) ;; ;; FIXME: Change the face's SPEC instead? ;; (set-face-attribute 'default nil ;; :foreground (face-attribute 'default :background) @@ -2120,8 +2126,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. @@ -3105,6 +3112,9 @@ If FRAME isn't maximized, show the title bar." frame 'undecorated (eq (alist-get 'fullscreen (frame-parameters frame)) 'maximized))) +(define-obsolete-function-alias 'frame--current-backround-mode + #'frame--current-background-mode "30.1") + (provide 'frame) ;;; frame.el ends here diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 45771e7a204..d9834031b80 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -394,7 +394,7 @@ This is not required after changing `gnus-registry-cache-file'." (with-no-warnings (eieio-persistent-read file 'registry-db)) ;; Older EIEIO versions do not check the class name. - ('wrong-number-of-arguments + (wrong-number-of-arguments (eieio-persistent-read file))))) (gnus-message 5 "Reading Gnus registry from %s...done" file)) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 27c71fa6c6a..22c84bc39cf 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1330,9 +1330,10 @@ elements are present." (1- nyear) nyear)) (setq dmonth 1)))) - (format-time-string - "%e-%b-%Y" - (encode-time 0 0 0 dday dmonth dyear)))) + (with-locale-environment "C" + (format-time-string + "%e-%b-%Y" + (encode-time 0 0 0 dday dmonth dyear))))) (cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap) (str string)) 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/gnus/mml.el b/lisp/gnus/mml.el index 60ee5d82e18..6025ca7e72a 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1484,10 +1484,12 @@ Ask for type, description or disposition according to (setq disposition (mml-minibuffer-read-disposition type nil file))) (mml-attach-file file type description disposition))))) -(defun mml-attach-buffer (buffer &optional type description disposition) +(defun mml-attach-buffer (buffer &optional type description disposition filename) "Attach a buffer to the outgoing MIME message. BUFFER is the name of the buffer to attach. See -`mml-attach-file' for details of operation." +`mml-attach-file' regarding TYPE, DESCRIPTION and DISPOSITION. +FILENAME is a suggested file name for the attachment should a +recipient wish to save a copy separate from the message." (interactive (let* ((buffer (read-buffer "Attach buffer: ")) (type (mml-minibuffer-read-type buffer "text/plain")) @@ -1497,9 +1499,10 @@ BUFFER is the name of the buffer to attach. See ;; If in the message header, attach at the end and leave point unchanged. (let ((head (unless (message-in-body-p) (point)))) (if head (goto-char (point-max))) - (mml-insert-empty-tag 'part 'type type 'buffer buffer - 'disposition disposition - 'description description) + (apply #'mml-insert-empty-tag + 'part 'type type 'buffer buffer + 'disposition disposition 'description description + (and filename `(filename ,filename))) ;; When using Mail mode, make sure it does the mime encoding ;; when you send the message. (or (eq mail-user-agent 'message-user-agent) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index c7a75105c08..be2bdc9bb15 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -339,8 +339,15 @@ all. This may very well take some time.") ;; for this header) or one list (specifying all the possible values for this ;; header). In the latter case, the list does NOT include the unspecified ;; spec (*). + ;; For time zone values, we have symbolic time zone names associated with ;; the (relative) number of seconds ahead GMT. + ;; The list of time zone values is obsolescent, and new code should + ;; not rely on it. Many of the time zone abbreviations are wrong; + ;; in particular, all single-letter abbreviations other than "Z" have + ;; been wrong since Internet RFC 2822 (2001). However, the + ;; abbreviations have not been changed due to backward compatibility + ;; concerns. ) (defsubst nndiary-schedule () diff --git a/lisp/help-fns.el b/lisp/help-fns.el index a81051cee03..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)))) @@ -2004,8 +2004,8 @@ variable with value KEYMAP." (mapatoms (lambda (symb) (when (and (boundp symb) (eq (symbol-value symb) keymap) - (not (eq symb 'keymap)) - (throw 'found-keymap symb))))) + (not (eq symb 'keymap))) + (throw 'found-keymap symb)))) nil))) ;; Follow aliasing. (or (ignore-errors (indirect-variable name)) name)))) 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/htmlfontify.el b/lisp/htmlfontify.el index 1ab33cc6411..f0e38242e48 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -757,7 +757,9 @@ may happen." 255)) '(0 1 2)))))) -(defun hfy-family (family) (list (cons "font-family" family))) +(defun hfy-family (family) + (list (cons "font-family" + (format "\"%s\"" (string-replace "\"" "\\\\\"" family))))) (defun hfy-bgcol (color) (list (cons "background" (hfy-triplet color)))) (defun hfy-color (color) (list (cons "color" (hfy-triplet color)))) (define-obsolete-function-alias 'hfy-colour #'hfy-color "27.1") 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-mode.el b/lisp/image-mode.el index 1820defa195..fa28c1bf7a5 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -1086,7 +1086,7 @@ Otherwise, display the image by calling `image-mode'." (unwind-protect (progn (setq-local image-fit-to-window-lock t) - (ignore-error 'remote-file-error + (ignore-error remote-file-error (image-toggle-display-image))) (setq image-fit-to-window-lock nil))))))))))) diff --git a/lisp/image.el b/lisp/image.el index 29c39c5dd55..2372fd1ce09 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -444,7 +444,7 @@ type if we can't otherwise guess it." (require 'image-converter) (image-convert-p source)))))) (unless type - (signal 'unknown-image-type "Cannot determine image type"))) + (signal 'unknown-image-type '("Cannot determine image type")))) (when (and (not (eq type 'image-convert)) (not (memq type (and (boundp 'image-types) image-types)))) (error "Invalid image type `%s'" type)) diff --git a/lisp/image/exif.el b/lisp/image/exif.el index c561ea729af..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,24 +134,24 @@ 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)))) (defun exif--parse-jpeg () (unless (= (exif--read-number-be 2) #xffd8) ; SOI (start of image) - (signal 'exif-error "Not a valid JPEG file")) + (signal 'exif-error '("Not a valid JPEG file"))) (cl-loop for segment = (exif--read-number-be 2) for size = (exif--read-number-be 2) ;; Stop parsing when we get to SOS (start of stream); @@ -168,7 +168,7 @@ If the orientation isn't present in the data, return nil." ;; The Exif data is in the APP1 JPEG chunk and starts with ;; "Exif\0\0". (unless (equal (exif--read-chunk 6) (string ?E ?x ?i ?f ?\0 ?\0)) - (signal 'exif-error "Not a valid Exif chunk")) + (signal 'exif-error '("Not a valid Exif chunk"))) (delete-region (point-min) (point)) (let* ((endian-marker (exif--read-chunk 2)) (le (cond @@ -180,14 +180,15 @@ If the orientation isn't present in the data, return nil." t) (t (signal 'exif-error - (format "Invalid endian-ness %s" endian-marker)))))) + (list (format "Invalid endian-ness %s" + endian-marker))))))) ;; Another magical number. (unless (= (exif--read-number 2 le) #x002a) - (signal 'exif-error "Invalid TIFF header length")) + (signal 'exif-error '("Invalid TIFF header length"))) (let ((offset (exif--read-number 4 le))) ;; Jump to where the IFD (directory) starts and parse it. (when (> (1+ offset) (point-max)) - (signal 'exif-error "Invalid IFD (directory) offset")) + (signal 'exif-error '("Invalid IFD (directory) offset"))) (goto-char (1+ offset)) (exif--parse-directory le))))) @@ -230,7 +231,7 @@ If the orientation isn't present in the data, return nil." (when (> (+ (1+ value) length) (point-max)) (signal 'exif-error - "Premature end of file")) + '("Premature end of file"))) (buffer-substring (1+ value) (+ (1+ value) length))) @@ -248,27 +249,30 @@ If the orientation isn't present in the data, return nil." ;; keep parsing. (progn (when (> (1+ next) (point-max)) - (signal 'exif-error "Invalid IFD (directory) next-offset")) + (signal 'exif-error '("Invalid IFD (directory) next-offset"))) (goto-char (1+ next)) (nconc dir (exif--parse-directory le))) ;; 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)))) @@ -281,18 +285,20 @@ 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")) + (signal 'exif-error '("Premature end of file"))) (prog1 (buffer-substring (point) (+ (point) bytes)) (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")) + (signal 'exif-error '("Premature end of file"))) (let ((sum 0)) (dotimes (_ bytes) (setq sum (+ (* sum 256) (following-char))) @@ -300,20 +306,22 @@ 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")) + (signal 'exif-error '("Premature end of file"))) (let ((sum 0)) (dotimes (i bytes) (setq sum (+ (* (following-char) (expt 256 i)) sum)) (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..b13b3e08ce2 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 @@ -424,11 +424,10 @@ This affects the following commands: (file-name-nondirectory thumb-file))) thumb-file)) -(defun image-dired-insert-thumbnail ( file original-file-name - associated-dired-buffer image-number) +(defun image-dired-insert-thumbnail (file original-file-name + associated-dired-buffer) "Insert thumbnail image FILE. -Add text properties ORIGINAL-FILE-NAME, ASSOCIATED-DIRED-BUFFER -and IMAGE-NUMBER." +Add text properties ORIGINAL-FILE-NAME, ASSOCIATED-DIRED-BUFFER." (let (beg end) (setq beg (point)) (image-dired-insert-image @@ -452,7 +451,6 @@ and IMAGE-NUMBER." 'keymap nil 'original-file-name original-file-name 'associated-dired-buffer associated-dired-buffer - 'image-number image-number 'tags (image-dired-list-tags original-file-name) 'mouse-face 'highlight 'comment (image-dired-get-comment original-file-name))))) @@ -495,9 +493,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 +523,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 +544,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 +583,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 - (cl-incf image-dired--number-of-thumbnails))))) - (if do-not-pop - (display-buffer buf) - (pop-to-buffer buf)) - (image-dired--line-up-with-method)))) + (image-dired--get-create-thumbnail-file file) file dired-buf) + (cl-incf image-dired--number-of-thumbnails)))) + (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 +633,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 +647,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 +752,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 @@ -784,7 +787,10 @@ comment." (let ((file-name (image-dired-original-file-name)) (dired-buf (buffer-name (image-dired-associated-dired-buffer))) (image-count (format "%s/%s" - (get-text-property (point) 'image-number) + ;; Line-up adds one space between two + ;; images: this formula takes this into + ;; account. + (1+ (/ (point) 2)) image-dired--number-of-thumbnails)) (props (string-join (get-text-property (point) 'tags) ", ")) (comment (get-text-property (point) 'comment)) @@ -816,7 +822,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))) @@ -1122,10 +1128,12 @@ With a negative prefix argument, prompt user for the delay." "Remove current thumbnail from thumbnail buffer and line up." (interactive nil image-dired-thumbnail-mode) (let ((inhibit-read-only t)) - (delete-char 1)) + (delete-char 1) + (cl-decf image-dired--number-of-thumbnails)) (let ((pos (point))) (image-dired--line-up-with-method) - (goto-char pos))) + (goto-char pos) + (image-dired--update-header-line))) (defun image-dired-line-up () "Line up thumbnails according to `image-dired-thumbs-per-row'. @@ -1192,7 +1200,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 +1214,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 +1302,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/international/textsec.el b/lisp/international/textsec.el index 1540f806e3b..e69e7c19842 100644 --- a/lisp/international/textsec.el +++ b/lisp/international/textsec.el @@ -320,7 +320,8 @@ affected by bidi controls in STRING." ;; state at end of STRING which could then affect the following ;; text. (insert string "a1א:!") - (let ((pos (bidi-find-overridden-directionality 1 (point-max) nil))) + (let ((pos (bidi-find-overridden-directionality + (point-min) (point-max) nil))) (and (fixnump pos) (1- pos))))) diff --git a/lisp/isearch.el b/lisp/isearch.el index bb46c89ae20..094e02d605e 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2774,18 +2774,22 @@ With argument, add COUNT copies of the character." (mapconcat 'isearch-text-char-description string "")))))))) +(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 - (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/jsonrpc.el b/lisp/jsonrpc.el index f583d116d20..3965d38bc3e 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora <joaotavora@gmail.com> ;; Keywords: processes, languages, extensions -;; Version: 1.0.16 +;; Version: 1.0.17 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -43,7 +43,6 @@ (eval-when-compile (require 'subr-x)) (require 'warnings) (require 'pcase) -(require 'ert) ; to escape a `condition-case-unless-debug' ;;; Public API @@ -154,6 +153,14 @@ immediately." "Stop waiting for responses from the current JSONRPC CONNECTION." (clrhash (jsonrpc--request-continuations connection))) +(defvar jsonrpc-inhibit-debug-on-error nil + "Inhibit `debug-on-error' when answering requests. +Some extensions, notably ert.el, set `debug-on-error' to non-nil, +which makes it hard to test the behaviour of catching the Elisp +error and replying to the endpoint with an JSONRPC-error. This +variable can be set around calls like `jsonrpc-request' to +circumvent that.") + (defun jsonrpc-connection-receive (connection message) "Process MESSAGE just received from CONNECTION. This function will destructure MESSAGE and call the appropriate @@ -166,7 +173,8 @@ dispatcher in CONNECTION." (cond (;; A remote request (and method id) - (let* ((debug-on-error (and debug-on-error (not (ert-running-test)))) + (let* ((debug-on-error (and debug-on-error + (not jsonrpc-inhibit-debug-on-error))) (reply (condition-case-unless-debug _ignore (condition-case oops diff --git a/lisp/keymap.el b/lisp/keymap.el index 791221f2459..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,16 +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 - (let* ((menu-prompting nil) - (key (read-key-sequence "Set key globally: " nil t))) - (list key - (read-command (format "Set key %s to command: " - (key-description 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. @@ -93,11 +91,14 @@ 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)))) + (when interactive + (setq key (key-description key))) (keymap-set map key command))) (defun keymap-global-unset (key &optional remove) @@ -108,7 +109,7 @@ If REMOVE (interactively, the prefix arg), remove the binding instead of unsetting it. See `keymap-unset' for details." (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (interactive - (list (key-description (read-key-sequence "Set key locally: ")) + (list (key-description (read-key-sequence "Unset key globally: ")) current-prefix-arg)) (keymap-unset (current-global-map) key remove)) @@ -291,26 +292,26 @@ See `kbd' for a descripion of KEYS." res))) (defun key-valid-p (keys) - "Say whether KEYS is a valid key. -A key is a string consisting of one or more key strokes. -The key strokes are separated by single space characters. + "Return non-nil if KEYS, a string, is a valid key sequence. +KEYS should be a string consisting of one or more key strokes, +with a single space character separating one key stroke from another. Each key stroke is either a single character, or the name of an -event, surrounded by angle brackets. In addition, any key stroke -may be preceded by one or more modifier keys. Finally, a limited -number of characters have a special shorthand syntax. +event, surrounded by angle brackets <like-this>. In addition, any +key stroke may be preceded by one or more modifier keys. Finally, +a limited number of characters have a special shorthand syntax. -Here's some example key sequences. +Here are some example of valid key sequences. \"f\" (the key `f') - \"S o m\" (a three key sequence of the keys `S', `o' and `m') - \"C-c o\" (a two key sequence of the keys `c' with the control modifier - and then the key `o') - \"H-<left>\" (the key named \"left\" with the hyper modifier) + \"S o m\" (a three-key sequence of the keys `S', `o' and `m') + \"C-c o\" (a two-key sequence: the key `c' with the control modifier + followed by the key `o') + \"H-<left>\" (the function key named \"left\" with the hyper modifier) \"M-RET\" (the \"return\" key with a meta modifier) \"C-M-<space>\" (the \"space\" key with both the control and meta modifiers) -These are the characters that have shorthand syntax: +These are the characters that have special shorthand syntax: NUL, RET, TAB, LFD, ESC, SPC, DEL. Modifiers have to be specified in this order: @@ -359,7 +360,7 @@ which is This function creates a `keyboard-translate-table' if necessary and then modifies one entry in it. -Both KEY and TO are strings that satisfy `key-valid-p'." +Both KEY and TO should be specified by strings that satisfy `key-valid-p'." (declare (compiler-macro (lambda (form) (keymap--compile-check from to) form))) (keymap--check from) @@ -370,7 +371,7 @@ Both KEY and TO are strings that satisfy `key-valid-p'." (aset keyboard-translate-table (key-parse from) (key-parse to))) (defun keymap-lookup (keymap key &optional accept-default no-remap position) - "Return the binding for command KEY. + "Return the binding for command KEY in KEYMAP. KEY is a string that satisfies `key-valid-p'. If KEYMAP is nil, look up in the current keymaps. If non-nil, it @@ -392,15 +393,15 @@ in the current keymaps. However, if the optional third argument NO-REMAP is non-nil, `keymap-lookup' returns the unmapped command. -If KEY is a key sequence initiated with the mouse, the used keymaps -will depend on the clicked mouse position with regard to the buffer -and possible local keymaps on strings. +If KEY is a mouse gesture, the keymaps used depend on the clicked +mouse position with regards to the buffer, and local keymaps, if any, +on display and overlay strings. If the optional argument POSITION is non-nil, it specifies a mouse position as returned by `event-start' and `event-end', and the lookup occurs in the keymaps associated with it instead of KEY. It can also be a number or marker, in which case the keymap properties at the -specified buffer position instead of point are used." +specified buffer position are used instead of point." (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (keymap--check key) (when (and keymap position) @@ -476,7 +477,7 @@ If MESSAGE (and interactively), message the result." (defun define-keymap (&rest definitions) "Create a new keymap and define KEY/DEFINITION pairs as key bindings. -The new keymap is returned. +Return the new keymap. Options can be given as keywords before the KEY/DEFINITION pairs. Available keywords are: 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 a463a7da67e..fe46b220da5 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -2021,7 +2021,7 @@ other modes. See `override-global-mode'. (fn &rest ARGS)" nil t) (autoload 'describe-personal-keybindings "bind-key" "\ Display all the personal keybindings defined by `bind-key'." t) -(register-definition-prefixes "bind-key" '("bind-key" "compare-keybindings" "get-binding-description" "override-global-m" "personal-keybindings")) +(register-definition-prefixes "bind-key" '("bind-key" "override-global-m" "personal-keybindings")) ;;; Generated autoloads from emacs-lisp/bindat.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 @@ -2919,12 +2919,17 @@ and corresponding effects. (register-definition-prefixes "semantic/bovine/c" '("semantic")) +;;; Generated autoloads from progmodes/c-ts-common.el + +(register-definition-prefixes "c-ts-common" '("c-ts-common-")) + + ;;; Generated autoloads from progmodes/c-ts-mode.el (autoload 'c-ts-base-mode "c-ts-mode" "\ Major mode for editing C, powered by tree-sitter. -\\{c-ts-mode-map} +\\{c-ts-base-mode-map} (fn)" t) (autoload 'c-ts-mode "c-ts-mode" "\ @@ -2932,7 +2937,16 @@ Major mode for editing C, powered by tree-sitter. This mode is independent from the classic cc-mode.el based `c-mode', so configuration variables of that mode, like -`c-basic-offset', don't affect this mode. +`c-basic-offset', doesn't affect this mode. + +To use tree-sitter C/C++ modes by default, evaluate + + (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode)) + (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode)) + (add-to-list \\='major-mode-remap-alist + \\='(c-or-c++-mode . c-or-c++-ts-mode)) + +in your configuration. (fn)" t) (autoload 'c++-ts-mode "c-ts-mode" "\ @@ -2942,8 +2956,28 @@ This mode is independent from the classic cc-mode.el based `c++-mode', so configuration variables of that mode, like `c-basic-offset', don't affect this mode. +To use tree-sitter C/C++ modes by default, evaluate + + (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode)) + (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode)) + (add-to-list \\='major-mode-remap-alist + \\='(c-or-c++-mode . c-or-c++-ts-mode)) + +in your configuration. + (fn)" t) -(register-definition-prefixes "c-ts-mode" '("c-ts-mode-")) +(autoload 'c-or-c++-ts-mode "c-ts-mode" "\ +Analyze buffer and enable either C or C++ mode. + +Some people and projects use .h extension for C++ header files +which is also the one used for C header files. This makes +matching on file name insufficient for detecting major mode that +should be used. + +This function attempts to use file contents to determine whether +the code is C or C++ and based on that chooses whether to enable +`c-ts-mode' or `c++-ts-mode'." t) +(register-definition-prefixes "c-ts-mode" '("c-ts-")) ;;; Generated autoloads from calendar/cal-bahai.el @@ -3747,6 +3781,12 @@ and exists only for compatibility reasons. (put 'c-basic-offset 'safe-local-variable 'integerp) (put 'c-backslash-column 'safe-local-variable 'integerp) + (put 'c-font-lock-extra-types 'safe-local-variable #'c-list-of-strings) + (put 'c++-font-lock-extra-types 'safe-local-variable #'c-list-of-strings) + (put 'objc-font-lock-extra-types 'safe-local-variable #'c-list-of-strings) + (put 'java-font-lock-extra-types 'safe-local-variable #'c-list-of-strings) + (put 'idl-font-lock-extra-types 'safe-local-variable #'c-list-of-strings) + (put 'pike-font-lock-extra-types 'safe-local-variable #'c-list-of-strings) (put 'c-file-style 'safe-local-variable 'string-or-null-p) (register-definition-prefixes "cc-vars" '("awk-mode-hook" "c++-" "c-" "defcustom-c-stylevar" "idl-" "java-" "objc-" "pike-")) @@ -4656,7 +4696,6 @@ For use inside Lisp programs, see also `c-macro-expansion'. ;;; Generated autoloads from progmodes/cmake-ts-mode.el -(add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode)) (autoload 'cmake-ts-mode "cmake-ts-mode" "\ Major mode for editing CMake files, powered by tree-sitter. @@ -5640,7 +5679,6 @@ with empty strings removed. ;;; Generated autoloads from progmodes/csharp-mode.el (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) -(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) (autoload 'csharp-mode "csharp-mode" "\ Major mode for editing Csharp code. @@ -7733,6 +7771,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 @@ -7849,36 +7890,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 @@ -8015,7 +8073,6 @@ it is disabled. ;;; Generated autoloads from progmodes/dockerfile-ts-mode.el -(add-to-list 'auto-mode-alist '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . dockerfile-ts-mode)) (autoload 'dockerfile-ts-mode "dockerfile-ts-mode" "\ Major mode for editing Dockerfiles, powered by tree-sitter. @@ -8222,6 +8279,7 @@ Valid keywords and arguments are: `nodigits' to suppress digits as prefix arguments. (fn BS &optional NAME M ARGS)") +(make-obsolete 'easy-mmode-define-keymap 'define-keymap "29.1") (autoload 'easy-mmode-defmap "easy-mmode" "\ Define a constant M whose value is the result of `easy-mmode-define-keymap'. The M, BS, and ARGS arguments are as per that function. DOC is @@ -8232,6 +8290,7 @@ This macro is deprecated; use `defvar-keymap' instead. (fn M BS DOC &rest ARGS)" nil t) (function-put 'easy-mmode-defmap 'doc-string-elt 3) (function-put 'easy-mmode-defmap 'lisp-indent-function 1) +(make-obsolete 'easy-mmode-defmap 'defvar-keymap "29.1") (autoload 'easy-mmode-defsyntax "easy-mmode" "\ Define variable ST as a syntax-table. CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). @@ -9159,7 +9218,7 @@ Turn on EDT Emulation." t) ;;; Generated autoloads from progmodes/eglot.el -(push (purecopy '(eglot 1 10)) package--builtin-versions) +(push (purecopy '(eglot 1 12)) package--builtin-versions) (autoload 'eglot "eglot" "\ Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE. @@ -9197,12 +9256,14 @@ described in `eglot-server-programs', which see. LANGUAGE-ID is the language ID string to send to the server for MANAGED-MAJOR-MODE, which matters to a minority of servers. -INTERACTIVE is t if called interactively. +INTERACTIVE is ignored and provided for backward compatibility. (fn MANAGED-MAJOR-MODE PROJECT CLASS CONTACT LANGUAGE-ID &optional INTERACTIVE)" t) (autoload 'eglot-ensure "eglot" "\ Start Eglot session for current buffer if there isn't one.") (put 'eglot-workspace-configuration 'safe-local-variable 'listp) +(put 'eglot--debbugs-or-github-bug-uri 'bug-reference-url-format t) +(defun eglot--debbugs-or-github-bug-uri nil (format (if (string= (match-string 2) "github") "https://github.com/joaotavora/eglot/issues/%s" "https://debbugs.gnu.org/%s") (match-string 3))) (register-definition-prefixes "eglot" '("eglot-")) @@ -9454,6 +9515,15 @@ optional prefix argument REINIT is non-nil. (register-definition-prefixes "elint" '("elint-")) +;;; Generated autoloads from progmodes/elixir-ts-mode.el + +(autoload 'elixir-ts-mode "elixir-ts-mode" "\ +Major mode for editing Elixir, powered by tree-sitter. + +(fn)" t) +(register-definition-prefixes "elixir-ts-mode" '("elixir-ts-")) + + ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -9520,6 +9590,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-")) @@ -9530,12 +9610,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 @@ -9560,7 +9640,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 @@ -9708,15 +9788,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. @@ -9732,6 +9806,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. @@ -10116,7 +10195,7 @@ Look at CONFIG and try to expand GROUP. ;;; Generated autoloads from erc/erc.el -(push (purecopy '(erc 5 4 1)) package--builtin-versions) +(push (purecopy '(erc 5 5)) package--builtin-versions) (autoload 'erc-select-read-args "erc" "\ Prompt the user for values of nick, server, port, and password.") (autoload 'erc "erc" "\ @@ -10188,7 +10267,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. @@ -11284,8 +11363,10 @@ For more information, see Info node `(eww) Top'. (defalias 'browse-web 'eww) (autoload 'eww-open-file "eww" "\ Render FILE using EWW. +If NEW-BUFFER is non-nil (interactively, the prefix arg), use a +new buffer instead of reusing the default EWW buffer. -(fn FILE)" t) +(fn FILE &optional NEW-BUFFER)" t) (autoload 'eww-search-words "eww" "\ Search the web for the text in the region. If region is active (and not whitespace), search the web for @@ -14368,12 +14449,12 @@ Add the window configuration CONF to `gnus-buffer-configuration'. ;;; Generated autoloads from progmodes/go-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode)) (autoload 'go-ts-mode "go-ts-mode" "\ Major mode for editing Go, powered by tree-sitter. +\\{go-ts-mode-map} + (fn)" t) -(add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode)) (autoload 'go-mod-ts-mode "go-ts-mode" "\ Major mode for editing go.mod files, powered by tree-sitter. @@ -15035,6 +15116,15 @@ Prefix arg sets default accept amount temporarily. (register-definition-prefixes "hashcash" '("hashcash-")) +;;; Generated autoloads from progmodes/heex-ts-mode.el + +(autoload 'heex-ts-mode "heex-ts-mode" "\ +Major mode for editing HEEx, powered by tree-sitter. + +(fn)" t) +(register-definition-prefixes "heex-ts-mode" '("heex-ts-")) + + ;;; Generated autoloads from help-at-pt.el (autoload 'help-at-pt-string "help-at-pt" "\ @@ -15786,7 +15876,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 @@ -16205,6 +16295,15 @@ values. (register-definition-prefixes "semantic/html" '("semantic-")) +;;; Generated autoloads from textmodes/html-ts-mode.el + +(autoload 'html-ts-mode "html-ts-mode" "\ +Major mode for editing Html, powered by tree-sitter. + +(fn)" t) +(register-definition-prefixes "html-ts-mode" '("html-ts-mode-")) + + ;;; Generated autoloads from htmlfontify.el (push (purecopy '(htmlfontify 0 21)) package--builtin-versions) @@ -17277,12 +17376,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")) @@ -17326,9 +17425,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 @@ -17386,11 +17485,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" "\ @@ -17442,7 +17542,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. @@ -17450,11 +17551,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)) @@ -17469,7 +17570,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" "\ @@ -18282,7 +18384,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 Ispell subprocess"))) (define-key map [ispell-pdict-save] `(menu-item ,(purecopy "Save Dictionary") (lambda nil (interactive) (ispell-pdict-save t t)) :help ,(purecopy "Save personal dictionary"))) (define-key map [ispell-customize] `(menu-item ,(purecopy "Customize...") (lambda nil (interactive) (customize-group 'ispell)) :help ,(purecopy "Customize spell checking options"))) (define-key map [ispell-help] `(menu-item ,(purecopy "Help") (lambda nil (interactive) (describe-function 'ispell-help)) :help ,(purecopy "Show standard Ispell keybindings and commands"))) (define-key map [flyspell-mode] `(menu-item ,(purecopy "Automatic spell checking (Flyspell)") flyspell-mode :help ,(purecopy "Check spelling while you edit the text") :button (:toggle bound-and-true-p flyspell-mode))) (define-key map [ispell-complete-word] `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key map [ispell-complete-word-interior-frag] `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor"))) (define-key map [ispell-continue] `(menu-item ,(purecopy "Continue Spell-Checking") ispell-continue :enable (and (boundp 'ispell-region-end) (marker-position ispell-region-end) (equal (marker-buffer ispell-region-end) (current-buffer))) :help ,(purecopy "Continue spell checking last region"))) (define-key map [ispell-word] `(menu-item ,(purecopy "Spell-Check Word") ispell-word :help ,(purecopy "Spell-check word at cursor"))) (define-key map [ispell-comments-and-strings] `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings :help ,(purecopy "Spell-check only comments and strings"))) (define-key map [ispell-region] `(menu-item ,(purecopy "Spell-Check Region") ispell-region :enable mark-active :help ,(purecopy "Spell-check text in marked region"))) (define-key map [ispell-message] `(menu-item ,(purecopy "Spell-Check Message") ispell-message :visible (eq major-mode 'mail-mode) :help ,(purecopy "Skip headers and included message text"))) (define-key map [ispell-buffer] `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer :help ,(purecopy "Check spelling of selected buffer"))) map) "\ @@ -18662,7 +18766,7 @@ Major mode for editing JSON, powered by tree-sitter. ;;; Generated autoloads from jsonrpc.el -(push (purecopy '(jsonrpc 1 0 16)) package--builtin-versions) +(push (purecopy '(jsonrpc 1 0 17)) package--builtin-versions) (register-definition-prefixes "jsonrpc" '("jsonrpc-")) @@ -19374,7 +19478,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 @@ -19467,7 +19571,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 @@ -23437,6 +23541,11 @@ the `Version:' header.") (defcustom package-quickstart-file (locate-user-emacs-file "package-quickstart.el") "\ Location of the file used to speed up activation of packages at startup." :type 'file :group 'applications :initialize #'custom-initialize-delay :version "27.1") (custom-autoload 'package-quickstart-file "package" t) +(autoload 'package-report-bug "package" "\ +Prepare a message to send to the maintainers of a package. +DESC must be a `package-desc' object. + +(fn DESC)" '(package-menu-mode)) (register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-")) @@ -25116,7 +25225,7 @@ Open profile FILENAME. ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 9 4)) 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'. @@ -26416,6 +26525,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 @@ -26512,8 +26623,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 @@ -27357,6 +27472,7 @@ Major mode for editing Ruby code. ;;; Generated autoloads from progmodes/ruby-ts-mode.el +(push (purecopy '(ruby-ts-mode 0 2)) package--builtin-versions) (autoload 'ruby-ts-mode "ruby-ts-mode" "\ Major mode for editing Ruby, powered by tree-sitter. @@ -27392,7 +27508,6 @@ it is disabled. ;;; Generated autoloads from progmodes/rust-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode)) (autoload 'rust-ts-mode "rust-ts-mode" "\ Major mode for editing Rust, powered by tree-sitter. @@ -28288,29 +28403,17 @@ With ARG non-nil, silently save all file-visiting buffers, then kill. If emacsclient was started with a list of filenames to edit, then only these files will be asked to be saved. +When running Emacs as a daemon and with +`server-stop-automatically' (which see) set to `kill-terminal' or +`delete-frame', this function may call `save-buffers-kill-emacs' +if there are no other active clients. + (fn ARG)") (autoload 'server-stop-automatically "server" "\ -Automatically stop server as specified by ARG. - -If ARG is the symbol `empty', stop the server when it has no -remaining clients, no remaining unsaved file-visiting buffers, -and no running processes with a `query-on-exit' flag. - -If ARG is the symbol `delete-frame', ask the user when the last -frame is deleted whether each unsaved file-visiting buffer must -be saved and each running process with a `query-on-exit' flag -can be stopped, and if so, stop the server itself. - -If ARG is the symbol `kill-terminal', ask the user when the -terminal is killed with \\[save-buffers-kill-terminal] whether each unsaved file-visiting -buffer must be saved and each running process with a `query-on-exit' -flag can be stopped, and if so, stop the server itself. - -Any other value of ARG will cause this function to signal an error. +Automatically stop the Emacs server as specified by VALUE. +This sets the variable `server-stop-automatically' (which see). -This function is meant to be called from the user init file. - -(fn ARG)") +(fn VALUE)") (register-definition-prefixes "server" '("server-")) @@ -30235,7 +30338,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 @@ -30243,10 +30346,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 @@ -32647,7 +32752,7 @@ It must be supported by libarchive(3).") List of suffixes which indicate a compressed file. It must be supported by libarchive(3).") (defmacro tramp-archive-autoload-file-name-regexp nil "\ -Regular expression matching archive file names." (if (<= emacs-major-version 26) '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'") `(rx bos (group (+ nonl) "." (| ,@tramp-archive-suffixes) (32 "." (| ,@tramp-archive-compression-suffixes))) (group "/" (* nonl)) eos))) +Regular expression matching archive file names." `(rx bos (group (+ nonl) "." (| ,@tramp-archive-suffixes) (32 "." (| ,@tramp-archive-compression-suffixes))) (group "/" (* nonl)) eos)) (defun tramp-archive-autoload-file-name-handler (operation &rest args) "\ Load Tramp archive file name handler, and perform OPERATION." (defvar tramp-archive-autoload) (let ((default-directory temporary-file-directory) (tramp-archive-autoload tramp-archive-enabled)) (apply #'tramp-autoload-file-name-handler operation args))) (defun tramp-register-archive-autoload-file-name-handler nil "\ @@ -32669,7 +32774,6 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar ;;; Generated autoloads from net/tramp-compat.el - (defalias 'tramp-compat-rx #'rx) (register-definition-prefixes "tramp-compat" '("tramp-")) @@ -32735,7 +32839,7 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 6 0 29 1)) package--builtin-versions) +(push (purecopy '(tramp 2 7 0 -1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) @@ -33074,8 +33178,6 @@ FRAC should be the inverse of the fractional value; for example, a value of ;;; Generated autoloads from progmodes/typescript-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)) -(add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode)) (autoload 'typescript-ts-base-mode "typescript-ts-mode" "\ Major mode for editing TypeScript. @@ -33816,7 +33918,7 @@ is \"www.fsf.co.uk\". ;;; Generated autoloads from use-package/use-package.el -(push (purecopy '(use-package 2 4 4)) package--builtin-versions) +(push (purecopy '(use-package 2 4 5)) package--builtin-versions) ;;; Generated autoloads from use-package/use-package-bind-key.el @@ -34161,6 +34263,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. @@ -34321,24 +34427,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" "\ @@ -34358,20 +34471,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" "\ @@ -34423,7 +34538,8 @@ On a distributed version control system, this runs a \"pull\" operation on the current branch, prompting for the precise command if required. Optional prefix ARG non-nil forces a prompt for the VCS command to run. If this is successful, a \"push\" -operation will then be done. +operation will then be done. This is supported only in backends +where the pull operation returns a process. On a non-distributed version control system, this signals an error. It also signals an error in a Bazaar bound branch. @@ -34491,7 +34607,7 @@ revision, with SUBJECT derived from each revision subject. When invoked with a numerical prefix argument, use the last N revisions. When invoked interactively in a Log View buffer with -marked revisions, use those these. +marked revisions, use those. (fn ADDRESSEE SUBJECT REVISIONS)" t) (register-definition-prefixes "vc" '("vc-" "with-vc-properties")) @@ -34760,7 +34876,7 @@ Key bindings: ;;; Generated autoloads from progmodes/verilog-mode.el -(push (purecopy '(verilog-mode 2021 10 14 127365406)) package--builtin-versions) +(push (purecopy '(verilog-mode 2022 12 18 181110314)) package--builtin-versions) (autoload 'verilog-mode "verilog-mode" "\ Major mode for editing Verilog code. \\<verilog-mode-map> @@ -34794,6 +34910,11 @@ Variables controlling indentation/edit style: function keyword. `verilog-indent-level-directive' (default 1) Indentation of \\=`ifdef/\\=`endif blocks. + `verilog-indent-ignore-multiline-defines' (default t) + Non-nil means ignore indentation on lines that are part of a multiline + define. + `verilog-indent-ignore-regexp' (default nil + Regexp that matches lines that should be ignored for indentation. `verilog-cexp-indent' (default 1) Indentation of Verilog statements broken across lines i.e.: if (a) @@ -34817,6 +34938,9 @@ Variables controlling indentation/edit style: otherwise you get: if (a) begin + `verilog-indent-class-inside-pkg' (default t) + Non-nil means indent classes inside packages. + Otherwise, classes have zero indentation. `verilog-auto-endcomments' (default t) Non-nil means a comment /* ... */ is set after the ends which ends cases, tasks, functions and modules. @@ -34826,6 +34950,17 @@ Variables controlling indentation/edit style: will be inserted. Setting this variable to zero results in every end acquiring a comment; the default avoids too many redundant comments in tight quarters. + `verilog-align-decl-expr-comments' (default t) + Non-nil means align declaration and expressions comments. + `verilog-align-comment-distance' (default 1) + Distance (in spaces) between longest declaration and comments. + Only works if `verilog-align-decl-expr-comments' is non-nil. + `verilog-align-assign-expr' (default nil) + Non-nil means align expressions of continuous assignments. + `verilog-align-typedef-regexp' (default nil) + Regexp that matches user typedefs for declaration alignment. + `verilog-align-typedef-words' (default nil) + List of words that match user typedefs for declaration alignment. `verilog-auto-lineup' (default `declarations') List of contexts where auto lineup of code should be done. @@ -34849,17 +34984,20 @@ Some other functions are: \\[verilog-mark-defun] Mark function. \\[verilog-beg-of-defun] Move to beginning of current function. \\[verilog-end-of-defun] Move to end of current function. - \\[verilog-label-be] Label matching begin ... end, fork ... join, etc statements. + \\[verilog-label-be] Label matching begin ... end, fork ... join, etc + statements. \\[verilog-comment-region] Put marked area in a comment. - \\[verilog-uncomment-region] Uncomment an area commented with \\[verilog-comment-region]. + \\[verilog-uncomment-region] Uncomment an area commented with + \\[verilog-comment-region]. \\[verilog-insert-block] Insert begin ... end. \\[verilog-star-comment] Insert /* ... */. \\[verilog-sk-always] Insert an always @(AS) begin .. end block. \\[verilog-sk-begin] Insert a begin .. end block. \\[verilog-sk-case] Insert a case block, prompting for details. - \\[verilog-sk-for] Insert a for (...) begin .. end block, prompting for details. + \\[verilog-sk-for] Insert a for (...) begin .. end block, prompting for + details. \\[verilog-sk-generate] Insert a generate .. endgenerate block. \\[verilog-sk-header] Insert a header block at the top of file. \\[verilog-sk-initial] Insert an initial begin .. end block. @@ -34882,14 +35020,17 @@ Some other functions are: \\[verilog-sk-else-if] Insert an else if (..) begin .. end block. \\[verilog-sk-comment] Insert a comment block. \\[verilog-sk-assign] Insert an assign .. = ..; statement. - \\[verilog-sk-function] Insert a function .. begin .. end endfunction block. + \\[verilog-sk-function] Insert a function .. begin .. end endfunction + block. \\[verilog-sk-input] Insert an input declaration, prompting for details. \\[verilog-sk-output] Insert an output declaration, prompting for details. - \\[verilog-sk-state-machine] Insert a state machine definition, prompting for details. + \\[verilog-sk-state-machine] Insert a state machine definition, prompting + for details. \\[verilog-sk-inout] Insert an inout declaration, prompting for details. \\[verilog-sk-wire] Insert a wire declaration, prompting for details. \\[verilog-sk-reg] Insert a register declaration, prompting for details. - \\[verilog-sk-define-signal] Define signal under point as a register at the top of the module. + \\[verilog-sk-define-signal] Define signal under point as a register at + the top of the module. All key bindings can be seen in a Verilog-buffer with \\[describe-bindings]. Key bindings specific to `verilog-mode-map' are: @@ -36008,6 +36149,7 @@ The mode's hook is called both when the mode is enabled and when it is disabled. (fn &optional ARG)" t) +(put 'global-whitespace-mode 'globalized-minor-mode t) (defvar global-whitespace-mode nil "\ Non-nil if Global Whitespace mode is enabled. See the `global-whitespace-mode' command @@ -36017,25 +36159,18 @@ either customize it (see the info node `Easy Customization') or call the function `global-whitespace-mode'.") (custom-autoload 'global-whitespace-mode "whitespace" nil) (autoload 'global-whitespace-mode "whitespace" "\ -Toggle whitespace visualization globally (Global Whitespace mode). - -See also `whitespace-style', `whitespace-newline' and -`whitespace-display-mappings'. - -This is a global minor mode. If called interactively, toggle the -`Global Whitespace mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +Toggle Whitespace mode in all buffers. +With prefix ARG, enable Global Whitespace mode if ARG is positive; +otherwise, disable it. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='global-whitespace-mode)'. +Whitespace mode is enabled in all buffers where +`whitespace-turn-on-if-enabled' would do it. -The mode's hook is called both when the mode is enabled and when -it is disabled. +See `whitespace-mode' for more information on Whitespace mode. (fn &optional ARG)" t) (defvar global-whitespace-newline-mode nil "\ @@ -36833,7 +36968,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 3)) 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" "\ @@ -37001,7 +37136,6 @@ a new xwidget-webkit session, otherwise use an existing session. ;;; Generated autoloads from textmodes/yaml-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode)) (autoload 'yaml-ts-mode "yaml-ts-mode" "\ Major mode for editing YAML, powered by tree-sitter. 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/rmail.el b/lisp/mail/rmail.el index 659649b5d42..c56f4ce62dc 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4580,6 +4580,9 @@ Argument MIME is non-nil if this is a mime message." (current-buffer)))) (error nil)) + ;; Decode any base64-encoded material in what we just decrypted. + (rmail-epa-decode armor-start after-end) + (list armor-start (- (point-max) after-end) mime armor-end-regexp (buffer-substring armor-start (- (point-max) after-end))))) @@ -4622,9 +4625,6 @@ Argument MIME is non-nil if this is a mime message." "> ") (push (rmail-epa-decrypt-1 mime) decrypts)))) - ;; Decode any base64-encoded mime sections. - (rmail-epa-decode) - (when (and decrypts (rmail-buffers-swapped-p)) (when (y-or-n-p "Replace the original message? ") (when (eq major-mode 'rmail-mode) @@ -4689,12 +4689,14 @@ Argument MIME is non-nil if this is a mime message." (unless decrypts (error "Nothing to decrypt"))))) -;; Decode all base64-encoded mime sections, so that this change -;; is made in the Rmail file, not just in the viewing buffer. -(defun rmail-epa-decode () +;; Decode all base64-encoded mime sections from BEG to (Z - BACK-FROM-END), +;; so that we save the decoding permanently in the Rmail buffer +;; if we permanently save the decryption. +(defun rmail-epa-decode (beg back-from-end) (save-excursion - (goto-char (point-min)) - (while (re-search-forward "--------------[0-9a-zA-Z]+\n" nil t) + (goto-char beg) + (while (re-search-forward "--------------[0-9a-zA-Z]+\n" + (- (point-max) back-from-end) t) ;; The ending delimiter is a start delimiter if another section follows. ;; Otherwise it is an end delimiter, with -- affixed. (let ((delim (concat (substring (match-string 0) 0 -1) "\\(\\|--\\)\n"))) diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index d0c0efec53b..6d61dcd8208 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -327,15 +327,14 @@ Replaces the From line with a \"Mail-from\" header. Adds \"Date\" and "Date: \\2, \\4 \\3 \\9 \\5 " ;; The timezone could be matched by group 7 or group 10. - ;; If neither of them matched, assume EST, since only - ;; Easterners would be so sloppy. + ;; If neither matched, use "-0000" for an unknown zone. ;; It's a shame the substitution can't use "\\10". (cond ((/= (match-beginning 7) (match-end 7)) "\\7") ((/= (match-beginning 10) (match-end 10)) (buffer-substring (match-beginning 10) (match-end 10))) - (t "EST")) + (t "-0000")) "\n")) ;; Keep and reformat the sender if we don't ;; have a From: field. 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/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index 502036f78b7..307c7fcf9c7 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -141,7 +141,7 @@ See `mh-identity-list'." (cons '("None") (mapcar #'list (mapcar #'car mh-identity-list))) nil t default nil default)) - (if (eq identity "None") + (if (equal identity "None") nil identity))) 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/mouse.el b/lisp/mouse.el index d93594deb04..9c1a72bb368 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -105,6 +105,15 @@ point at the click position." :type 'boolean :version "22.1") +(defcustom mouse-1-double-click-prefer-symbols nil + "If non-nil, double-clicking Mouse-1 attempts to select the symbol at click. + +If nil, the default, double-clicking Mouse-1 on a word-constituent +character will select only the word at click location, which could +select fewer characters than the symbol at click." + :type 'boolean + :version "30.1") + (defcustom mouse-drag-and-drop-region-scroll-margin nil "If non-nil, the scroll margin inside a window when dragging text. If the mouse moves this many lines close to the top or bottom of @@ -1800,10 +1809,17 @@ The region will be defined with mark and point." ;; Commands to handle xterm-style multiple clicks. (defun mouse-skip-word (dir) "Skip over word, over whitespace, or over identical punctuation. +If `mouse-1-double-click-prefer-symbols' is non-nil, skip over symbol. If DIR is positive skip forward; if negative, skip backward." (let* ((char (following-char)) - (syntax (char-to-string (char-syntax char)))) - (cond ((string= syntax "w") + (syntax (char-to-string (char-syntax char))) + sym) + (cond ((and mouse-1-double-click-prefer-symbols + (setq sym (bounds-of-thing-at-point 'symbol))) + (goto-char (if (< dir 0) + (car sym) + (cdr sym)))) + ((string= syntax "w") ;; Here, we can't use skip-syntax-forward/backward because ;; they don't pay attention to word-separating-categories, ;; and thus they will skip over a true word boundary. So, diff --git a/lisp/mpc.el b/lisp/mpc.el index db1da2ac030..b937a6b5945 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1104,7 +1104,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (interactive) (mpc-constraints-push 'noerror) (mpc-constraints-restore - ',(list (list tag text))))))))) + (list (list tag text))))))))) (funcall insert (concat (when size (propertize " " 'display diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 4bf87c14f31..e21367135d3 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3534,7 +3534,8 @@ system TYPE.") (setq file (expand-file-name file)) (let ((parsed (ange-ftp-ftp-name file))) (if parsed - (if (and delete-by-moving-to-trash trash) + (if (and delete-by-moving-to-trash trash + (not remote-file-name-inhibit-delete-by-moving-to-trash)) (move-file-to-trash file) (let* ((host (nth 0 parsed)) (user (nth 1 parsed)) @@ -4129,7 +4130,7 @@ directory, so that Emacs will know its current contents." (or (file-exists-p parent) (ange-ftp-make-directory parent parents)))) (if (file-exists-p dir) - (unless parents + (if parents t (signal 'file-already-exists (list "Cannot make directory: file already exists" dir))) @@ -4158,7 +4159,8 @@ directory, so that Emacs will know its current contents." (format "Could not make directory %s: %s" dir (cdr result)))) - (ange-ftp-add-file-entry dir t)) + (ange-ftp-add-file-entry dir t) + nil) (ange-ftp-real-make-directory dir))))) (defun ange-ftp-delete-directory (dir &optional recursive trash) @@ -4377,6 +4379,10 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; or return nil meaning don't make a backup. (if ange-ftp-make-backup-files (ange-ftp-real-find-backup-file-name fn))) + +(defun ange-ftp-file-user-uid () + ;; Return "don't know" value. + -1) ;;; Define the handler for special file names ;;; that causes ange-ftp to be invoked. @@ -4498,6 +4504,28 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (put 'process-file 'ange-ftp 'ange-ftp-process-file) (put 'start-file-process 'ange-ftp 'ignore) (put 'shell-command 'ange-ftp 'ange-ftp-shell-command) + +;; Do not execute system information functions. +(put 'file-system-info 'ange-ftp 'ignore) +(put 'list-system-processes 'ange-ftp 'ignore) +(put 'memory-info 'ange-ftp 'ignore) +(put 'process-attributes 'ange-ftp 'ignore) + +;; There aren't ACLs. `file-selinux-context' shall return '(nil nil +;; nil nil) if the file is nonexistent, so we let the default file +;; name handler do the job. +(put 'file-acl 'ange-ftp 'ignore) +;; (put 'file-selinux-context 'ange-ftp 'ignore) +(put 'set-file-acl 'ange-ftp 'ignore) +(put 'set-file-selinux-context 'ange-ftp 'ignore) + +;; There aren't file notifications. +(put 'file-notify-add-watch 'ange-ftp 'ignore) +(put 'file-notify-rm-watch 'ange-ftp 'ignore) +(put 'file-notify-valid-p 'ange-ftp 'ignore) + +;; Return the "don't know' value for remote user uid. +(put 'file-user-uid 'ange-ftp 'ange-ftp-file-user-uid) ;;; Define ways of getting at unmodified Emacs primitives, ;;; turning off our handler. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 859a9b44bcb..73d11c0ef52 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -488,14 +488,17 @@ For more information, see Info node `(eww) Top'." ;;;###autoload (defalias 'browse-web 'eww) ;;;###autoload -(defun eww-open-file (file) - "Render FILE using EWW." - (interactive "fFile: ") +(defun eww-open-file (file &optional new-buffer) + "Render FILE using EWW. +If NEW-BUFFER is non-nil (interactively, the prefix arg), use a +new buffer instead of reusing the default EWW buffer." + (interactive "fFile: \nP") (let ((url-allow-non-local-files t)) (eww (concat "file://" (and (memq system-type '(windows-nt ms-dos)) "/") - (expand-file-name file))))) + (expand-file-name file)) + new-buffer))) (defun eww--file-buffer (file) (with-current-buffer (generate-new-buffer " *eww file*") @@ -2498,10 +2501,10 @@ Otherwise, the restored buffer will contain a prompt to do so by using (when (plist-get eww-data :url) (cl-case eww-restore-desktop ((t auto) (eww (plist-get eww-data :url))) - ((zerop (buffer-size)) - (let ((inhibit-read-only t)) - (insert (substitute-command-keys - eww-restore-reload-prompt))))))) + ((nil) (when (zerop (buffer-size)) + (let ((inhibit-read-only t)) + (insert (substitute-command-keys + eww-restore-reload-prompt)))))))) ;; . (current-buffer))) diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index f7361f38130..36b1654222a 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -262,6 +262,7 @@ For the meaning of the rest of the parameters, see `gnutls-boot-parameters'." &key type hostname priority-string trustfiles crlfiles keylist min-prime-bits verify-flags verify-error verify-hostname-error + pass flags &allow-other-keys) "Return a keyword list of parameters suitable for passing to `gnutls-boot'. @@ -278,6 +279,13 @@ default. VERIFY-HOSTNAME-ERROR is a backwards compatibility option for putting `:hostname' in VERIFY-ERROR. +PASS is a string, the password of the key. It may also be nil, +for a NULL password. + +FLAGS is a list of symbols corresponding to the equivalent ORed +bitflag of the gnutls_pkcs_encrypt_flags_t enum of GnuTLS. The +empty list corresponds to the bitflag with value 0. + When VERIFY-ERROR is t or a list containing `:trustfiles', an error will be raised when the peer certificate verification fails as per GnuTLS' gnutls_certificate_verify_peers2. Otherwise, only @@ -355,6 +363,8 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." :keylist ,keylist :verify-flags ,verify-flags :verify-error ,verify-error + :pass ,pass + :flags ,flags :callbacks nil))) (defun gnutls--get-files (files) 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/newst-backend.el b/lisp/net/newst-backend.el index 1afcd1db3c4..a68a6bf1a24 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -1623,7 +1623,7 @@ Sat, 07 Sep 2002 00:00:01 GMT ":\\([0-9]\\{2\\}\\)" ;; second "\\(:\\([0-9]\\{2\\}\\)\\)?" - ;; zone -- fixme + ;; zone "\\(\\s-+\\(" "UT\\|GMT\\|EST\\|EDT\\|CST\\|CDT\\|MST\\|MDT\\|PST\\|PDT" "\\|\\([-+]\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)" @@ -1642,16 +1642,26 @@ Sat, 07 Sep 2002 00:00:01 GMT (offset-hour (read (or (match-string 14 rfc822-string) "0"))) (offset-minute (read (or (match-string 15 rfc822-string) - "0"))) - ;;FIXME - ) + "0")))) (when zone (cond ((string= sign "+") (setq hour (- hour offset-hour)) (setq minute (- minute offset-minute))) ((string= sign "-") (setq hour (+ hour offset-hour)) - (setq minute (+ minute offset-minute))))) + (setq minute (+ minute offset-minute))) + ((or (string= zone "UT") (string= zone "GMT")) + nil) + ((string= zone "EDT") + (setq hour (+ hour 4))) + ((or (string= zone "EST") (string= zone "CDT")) + (setq hour (+ hour 5))) + ((or (string= zone "CST") (string= zone "MDT")) + (setq hour (+ hour 6))) + ((or (string= zone "MST") (string= zone "PDT")) + (setq hour (+ hour 7))) + ((string= zone "PST") + (setq hour (+ hour 8))))) (condition-case error-data (let ((i 1)) (dolist (m '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el index 5477ad946ba..064b72f02c2 100644 --- a/lisp/net/newst-ticker.el +++ b/lisp/net/newst-ticker.el @@ -44,8 +44,10 @@ "Last message that the newsticker displayed.") (defvar newsticker--scrollable-text "" "The text which is scrolled smoothly in the echo area.") +(defvar newsticker--ticker-period-timer nil + "Timer for newsticker ticker display.") (defvar newsticker--ticker-timer nil - "Timer for newsticker ticker.") + "Timer for newsticker ticker scrolling.") ;;;###autoload (defun newsticker-ticker-running-p () @@ -77,7 +79,7 @@ value effective." (defcustom newsticker-ticker-interval 0.3 - "Time interval for displaying news items in the echo area (seconds). + "Time interval for scrolling news items in the echo area (seconds). If equal or less than 0 no messages are shown in the echo area. For smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems reasonable. For non-smooth display a value of 10 is a good starting @@ -86,6 +88,17 @@ point." :set #'newsticker--set-customvar-ticker :group 'newsticker-ticker) +(defcustom newsticker-ticker-period + 0 + "Time interval for displaying news items in the echo area (seconds). +If equal or less than 0 messages are shown continuously. In order not +to miss new items, a value of equal or less than the shortest feed +retrieval interval (or the global `newsticker-retrieval-interval`) is +recommended." + :type 'number + :set #'newsticker--set-customvar-ticker + :group 'newsticker-ticker) + (defcustom newsticker-scroll-smoothly t "Decides whether to flash or scroll news items. @@ -129,9 +142,16 @@ If t the echo area will not show obsolete items. See also "Called from the display timer. This function calls a display function, according to the variable `newsticker-scroll-smoothly'." - (if newsticker-scroll-smoothly - (newsticker--display-scroll) - (newsticker--display-jump))) + (when (not newsticker--ticker-timer) + (if newsticker-scroll-smoothly + (setq newsticker--ticker-timer + (run-at-time 1 + newsticker-ticker-interval + #'newsticker--display-scroll)) + (setq newsticker--ticker-timer + (run-at-time nil + newsticker-ticker-interval + #'newsticker--display-jump))))) (defsubst newsticker--echo-area-clean-p () "Check whether somebody is using the echo area / minibuffer. @@ -149,7 +169,12 @@ there is another message displayed or the minibuffer is active." (when (newsticker--echo-area-clean-p) (setq newsticker--item-position (1+ newsticker--item-position)) (when (>= newsticker--item-position (length newsticker--item-list)) - (setq newsticker--item-position 0)) + (setq newsticker--item-position 0) + (when (> newsticker-ticker-period 0) + (cancel-timer newsticker--ticker-timer) + (setq newsticker--ticker-timer nil) + (run-at-time newsticker-ticker-interval nil + (lambda () (message ""))))) (setq newsticker--prev-message (nth newsticker--item-position newsticker--item-list)) (message "%s" newsticker--prev-message)))) @@ -192,7 +217,12 @@ there is another message displayed or the minibuffer is active." (setq newsticker--prev-message subtext) (setq newsticker--item-position (1+ i)) (when (>= newsticker--item-position l) - (setq newsticker--item-position 0)))))) + (setq newsticker--item-position 0) + (when (> newsticker-ticker-period 0) + (cancel-timer newsticker--ticker-timer) + (setq newsticker--ticker-timer nil) + (run-at-time newsticker-ticker-interval nil + (lambda () (message ""))))))))) ;;;###autoload (defun newsticker-start-ticker () @@ -200,19 +230,26 @@ there is another message displayed or the minibuffer is active." Start display timer for the actual ticker if wanted and not running already." (interactive) - (if (and (> newsticker-ticker-interval 0) - (not newsticker--ticker-timer)) - (setq newsticker--ticker-timer - (run-at-time newsticker-ticker-interval - newsticker-ticker-interval - #'newsticker--display-tick)))) + (when (and (> newsticker-ticker-interval 0) + (not newsticker--ticker-period-timer) + (not newsticker--ticker-timer)) + (if (> newsticker-ticker-period 0) + (setq newsticker--ticker-period-timer + (run-at-time nil + newsticker-ticker-period + #'newsticker--display-tick)) + (newsticker--display-tick)))) (defun newsticker-stop-ticker () "Stop newsticker's ticker (but not the news retrieval)." (interactive) - (when newsticker--ticker-timer - (cancel-timer newsticker--ticker-timer) - (setq newsticker--ticker-timer nil))) + (progn + (when newsticker--ticker-timer + (cancel-timer newsticker--ticker-timer) + (setq newsticker--ticker-timer nil)) + (when newsticker--ticker-period-timer + (cancel-timer newsticker--ticker-period-timer) + (setq newsticker--ticker-period-timer nil)))) ;; ====================================================================== ;;; Manipulation of ticker text diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 77a9d70ac9e..5e4aa5e1198 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1396,10 +1396,10 @@ inserted." (interactive "P") (rcirc-format "\^_" replace)) -(defun rcirc-format-strike-trough (replace) - "Insert strike-trough formatting. +(defun rcirc-format-strike-through (replace) + "Insert strike-through formatting. If REPLACE is non-nil or a prefix argument is given, any prior -formatting will be replaced before the strike-trough formatting +formatting will be replaced before the strike-through formatting is inserted." (interactive "P") (rcirc-format "\^^" replace)) @@ -1421,7 +1421,7 @@ inserted." "C-c C-f C-b" #'rcirc-format-bold "C-c C-f C-i" #'rcirc-format-italic "C-c C-f C-u" #'rcirc-format-underline - "C-c C-f C-s" #'rcirc-format-strike-trough + "C-c C-f C-s" #'rcirc-format-strike-through "C-c C-f C-f" #'rcirc-format-fixed-width "C-c C-f C-t" #'rcirc-format-fixed-width ;as in AucTeX "C-c C-f C-d" #'rcirc-unformat @@ -1807,7 +1807,7 @@ extracted." "C-c C-f C-b" #'rcirc-format-bold "C-c C-f C-i" #'rcirc-format-italic "C-c C-f C-u" #'rcirc-format-underline - "C-c C-f C-s" #'rcirc-format-strike-trough + "C-c C-f C-s" #'rcirc-format-strike-through "C-c C-f C-f" #'rcirc-format-fixed-width "C-c C-f C-t" #'rcirc-format-fixed-width ;as in AucTeX "C-c C-f C-d" #'rcirc-unformat @@ -2062,12 +2062,11 @@ connection." (next-single-property-change (point) 'hard) (forward-char 1) (throw 'exit nil)))) + (goto-char (line-beginning-position)) (set-marker-insertion-type rcirc-prompt-start-marker t) (set-marker-insertion-type rcirc-prompt-end-marker t) ;; run markup functions - (unless (bolp) - (newline)) (save-excursion (save-restriction (narrow-to-region (point) (point)) @@ -2371,9 +2370,11 @@ This function does not alter the INPUT string." "C-c C-@" #'rcirc-next-active-buffer "C-c C-SPC" #'rcirc-next-active-buffer) -(defcustom rcirc-track-abbrevate-flag t +(define-obsolete-variable-alias 'rcirc-track-abbrevate-flag + 'rcirc-track-abbreviate-flag "30.1") +(defcustom rcirc-track-abbreviate-flag t "Non-nil means `rcirc-track-minor-mode' should abbreviate names." - :version "28.1" + :version "30.1" :type 'boolean) ;;;###autoload @@ -2559,7 +2560,7 @@ activity. Only run if the buffer is not visible and (funcall rcirc-channel-filter (replace-regexp-in-string "@.*?\\'" "" - (or (and rcirc-track-abbrevate-flag + (or (and rcirc-track-abbreviate-flag rcirc-short-buffer-name) (buffer-name)))))) @@ -4002,6 +4003,9 @@ PROCESS is the process object for the current connection." (string-equal (downcase (car setting)) parameter)) return (cadr setting))) +(define-obsolete-function-alias 'rcirc-format-strike-trough + 'rcirc-format-strike-through "30.1") + (provide 'rcirc) ;;; rcirc.el ends here diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index 4866f788bff..5bee4f4c4ad 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -168,25 +168,19 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") ;; Internal utility functions (defun sieve-manage--append-to-log (&rest args) - "Append ARGS to `sieve-manage-log' buffer. + "Append ARGS to sieve-manage log buffer. ARGS can be a string or a list of strings. -The buffer to use for logging is specifified via `sieve-manage-log'. -If it is nil, logging is disabled. - -When the `sieve-manage-log' buffer doesn't exist, it gets created (and -configured with some initial settings)." +The buffer to use for logging is specifified via +`sieve-manage-log'. If it is nil, logging is disabled." (when sieve-manage-log - (let* ((existing-log-buffer (get-buffer sieve-manage-log)) - (log-buffer (or existing-log-buffer - (get-buffer-create sieve-manage-log)))) - (with-current-buffer log-buffer - (unless existing-log-buffer - ;; Do this only once, when creating the log buffer. - (set-buffer-multibyte nil) - (buffer-disable-undo)) - (goto-char (point-max)) - (apply #'insert args))))) + (with-current-buffer (or (get-buffer sieve-manage-log) + (with-current-buffer + (get-buffer-create sieve-manage-log) + (set-buffer-multibyte nil) + (buffer-disable-undo))) + (goto-char (point-max)) + (apply #'insert args)))) (defun sieve-manage--message (format-string &rest args) "Wrapper around `message' which also logs to sieve manage log. diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 73974f864b3..e4b8bbd9cb5 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -1317,7 +1317,7 @@ See also `soap-wsdl-resolve-references'." "Validate VALUE against the basic type TYPE." (let* ((kind (soap-xs-basic-type-kind type))) (cl-case kind - ((anyType Array byte[]) + ((anyType Array byte\[\]) value) (t (let ((convert (get kind 'rng-xsd-convert))) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 4578f1fe073..14c63ba5834 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,7 +55,7 @@ It is used for TCP/IP devices." (defconst tramp-adb-method "adb" "When this method name is used, forward all calls to Android Debug Bridge.") -(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") blank) +(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\r\n"))) (any "#$") blank) "Regexp used as prompt in almquist shell." :type 'regexp :version "28.1" @@ -71,14 +71,14 @@ It is used for TCP/IP devices." "Regexp for date time format in ls output.")) (defconst tramp-adb-ls-date-regexp - (tramp-compat-rx + (rx blank (regexp tramp-adb-ls-date-year-regexp) blank (regexp tramp-adb-ls-date-time-regexp) blank) "Regexp for date format in ls output.") (defconst tramp-adb-ls-toolbox-regexp - (tramp-compat-rx + (rx bol (* blank) (group (+ (any ".-" alpha))) ; \1 permissions (? (+ blank) (+ digit)) ; links (Android 7/toybox) (* blank) (group (+ (not blank))) ; \2 username @@ -153,6 +153,7 @@ It is used for TCP/IP devices." (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-adb-handle-file-system-info) (file-truename . tramp-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) (file-writable-p . tramp-adb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. @@ -327,8 +328,7 @@ arguments to pass to the OPERATION." (tramp-shell-quote-argument (tramp-compat-file-name-concat localname "..")))) (tramp-compat-replace-regexp-in-region - (tramp-compat-rx (literal (tramp-compat-file-name-unquote - (file-name-as-directory localname)))) + (rx (literal (file-name-unquote (file-name-as-directory localname)))) "" (point-min)) (widen))) (tramp-adb-sh-fix-ls-output) @@ -366,14 +366,12 @@ Emacs dired can't find files." (goto-char (point-min)) (while (search-forward-regexp - (tramp-compat-rx - blank (group blank (regexp tramp-adb-ls-date-year-regexp) blank)) + (rx blank (group blank (regexp tramp-adb-ls-date-year-regexp) blank)) nil t) (replace-match "0\\1" "\\1" nil) ;; Insert missing "/". (when (looking-at-p - (tramp-compat-rx - (regexp tramp-adb-ls-date-time-regexp) (+ blank) eol)) + (rx (regexp tramp-adb-ls-date-time-regexp) (+ blank) eol)) (end-of-line) (insert "/"))) ;; Sort entries. @@ -393,12 +391,10 @@ Emacs dired can't find files." (defun tramp-adb-ls-output-time-less-p (a b) "Sort \"ls\" output by time, descending." (let (time-a time-b) - ;; Once we can assume Emacs 27 or later, the two calls - ;; (apply #'encode-time X) can be replaced by (encode-time X). (string-match tramp-adb-ls-date-regexp a) - (setq time-a (apply #'encode-time (parse-time-string (match-string 0 a)))) + (setq time-a (encode-time (parse-time-string (match-string 0 a)))) (string-match tramp-adb-ls-date-regexp b) - (setq time-b (apply #'encode-time (parse-time-string (match-string 0 b)))) + (setq time-b (encode-time (parse-time-string (match-string 0 b)))) (time-less-p time-b time-a))) (defun tramp-adb-ls-output-name-less-p (a b) @@ -411,20 +407,11 @@ Emacs dired can't find files." (defun tramp-adb-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (expand-file-name dir)) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) - (when parents - (let ((par (expand-file-name ".." dir))) - (unless (file-directory-p par) - (make-directory par parents)))) - (tramp-flush-directory-properties v localname) - (unless (or (tramp-adb-send-command-and-check - v (format "mkdir -m %#o %s" - (default-file-modes) - (tramp-shell-quote-argument localname))) - (and parents (file-directory-p dir))) + (tramp-skeleton-make-directory dir parents + (unless (tramp-adb-send-command-and-check + v (format "mkdir -m %#o %s" + (default-file-modes) + (tramp-shell-quote-argument localname))) (tramp-error v 'file-error "Couldn't make directory %s" dir)))) (defun tramp-adb-handle-delete-directory (directory &optional recursive trash) @@ -438,42 +425,39 @@ Emacs dired can't find files." (defun tramp-adb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (setq filename (expand-file-name filename)) - (with-parsed-tramp-file-name filename nil - (tramp-flush-file-properties v localname) - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (tramp-adb-barf-unless-okay - v (format "rm %s" (tramp-shell-quote-argument localname)) - "Couldn't delete %s" filename)))) + (tramp-skeleton-delete-file filename trash + (tramp-adb-barf-unless-okay + v (format "rm %s" (tramp-shell-quote-argument localname)) + "Couldn't delete %s" filename))) (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (tramp-adb-send-command - v (format "%s -a %s | cat" - (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (with-current-buffer (tramp-get-buffer v) - (delete-dups - (append - ;; On some file systems like "sdcard", "." and ".." are - ;; not included. We fix this by `delete-dups'. - '("." "..") - (delq - nil - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n"))))))))))) + (ignore-error file-missing + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (tramp-adb-send-command + v (format "%s -a %s | cat" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname))) + (mapcar + (lambda (f) + (if (file-directory-p (expand-file-name f directory)) + (file-name-as-directory f) + f)) + (with-current-buffer (tramp-get-buffer v) + (delete-dups + (append + ;; On some file systems like "sdcard", "." and ".." are + ;; not included. We fix this by `delete-dups'. + '("." "..") + (delq + nil + (mapcar + (lambda (l) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string (buffer-string) "\n")))))))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." @@ -483,7 +467,7 @@ Emacs dired can't find files." ;; "adb pull ..." does not always return an error code. (unless (and (tramp-adb-execute-adb-command - v "pull" (tramp-compat-file-name-unquote localname) tmpfile) + v "pull" (file-name-unquote localname) tmpfile) (file-exists-p tmpfile)) (ignore-errors (delete-file tmpfile)) (tramp-error @@ -504,16 +488,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." @@ -563,8 +540,7 @@ Emacs dired can't find files." "Moving tmp file `%s' to `%s'" tmpfile filename) (unwind-protect (unless (tramp-adb-execute-adb-command - v "push" tmpfile - (tramp-compat-file-name-unquote localname)) + v "push" tmpfile (file-name-unquote localname)) (tramp-error v 'file-error "Cannot write: `%s'" filename)) (delete-file tmpfile))))))) @@ -579,11 +555,7 @@ Emacs dired can't find files." (defun tramp-adb-handle-set-file-times (filename &optional time flag) "Like `set-file-times' for Tramp files." (tramp-skeleton-set-file-modes-times-uid-gid filename - (let ((time (if (or (null time) - (tramp-compat-time-equal-p time tramp-time-doesnt-exist) - (tramp-compat-time-equal-p time tramp-time-dont-know)) - (current-time) - time)) + (let ((time (tramp-defined-time time)) (nofollow (if (eq flag 'nofollow) "-h" "")) (quoted-name (tramp-shell-quote-argument localname))) ;; Older versions of toybox 'touch' mishandle nanoseconds and/or @@ -669,8 +641,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-flush-file-properties v localname) (unless (tramp-adb-execute-adb-command v "push" - (tramp-compat-file-name-unquote filename) - (tramp-compat-file-name-unquote localname)) + (file-name-unquote filename) + (file-name-unquote localname)) (tramp-error v 'file-error "Cannot copy `%s' `%s'" filename newname))))))))) @@ -736,11 +708,6 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Strings to return by `process-file' in case of signals." (with-tramp-connection-property vec "signal-strings" (let ((default-directory (tramp-make-tramp-file-name vec 'noloc)) - ;; `shell-file-name' and `shell-command-switch' are needed - ;; for Emacs < 27.1, which doesn't support connection-local - ;; variables in `shell-command'. - (shell-file-name "/system/bin/sh") - (shell-command-switch "-c") process-file-return-signal-string signals result) (dotimes (i 128) (push (format "Signal %d" i) result)) (setq result (reverse result) @@ -773,7 +740,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Determine input. (if (null infile) (setq input (tramp-get-remote-null-device v)) - (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) + (setq infile (file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. (setq input (tramp-unquote-file-local-name infile)) @@ -949,7 +916,7 @@ implementation will be used." (i 0) p) - (when (string-match-p (tramp-compat-rx multibyte) command) + (when (string-match-p (rx multibyte) command) (tramp-error v 'file-error "Cannot apply multi-byte command `%s'" command)) @@ -1023,7 +990,7 @@ implementation will be used." (progn (goto-char (point-min)) (not (search-forward "\n" nil t))) - (tramp-accept-process-output p 0)) + (tramp-accept-process-output p)) (delete-region (point-min) (point))) ;; Provide error buffer. This shows only ;; initial error messages; messages @@ -1032,17 +999,19 @@ implementation will be used." ;; file will exist until the process is ;; deleted. (when (bufferp stderr) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit)) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit))) ;; Delete tmpstderr file. (add-function :after (process-sentinel p) (lambda (_proc _msg) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit nil nil 'replace)) - (delete-file remote-tmpstderr)))) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr))))) ;; Return process. p)))) @@ -1106,11 +1075,12 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" (format "%s:%s" host port)) ;; An empty host name shall be mapped as well, when there ;; is exactly one entry in `devices'. - ((and (zerop (length host)) (= (length devices) 1)) + ((and (tramp-string-empty-or-nil-p host) + (tramp-compat-length= devices 1)) (car devices)) ;; Try to connect device. ((and tramp-adb-connect-if-not-connected - (not (zerop (length host))) + (tramp-compat-length> host 0) (tramp-adb-execute-adb-command vec "connect" (tramp-compat-string-replace @@ -1127,7 +1097,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" "Execute an adb command. Insert the result into the connection buffer. Return nil on error and non-nil on success." - (when (and (> (length (tramp-file-name-host vec)) 0) + (when (and (tramp-compat-length> (tramp-file-name-host vec) 0) ;; The -s switch is only available for ADB device commands. (not (member (car args) '("connect" "disconnect")))) (setq args (append (list "-s" (tramp-adb-get-device vec)) args))) @@ -1141,7 +1111,7 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (string-match-p (tramp-compat-rx multibyte) command) + (if (string-match-p (rx multibyte) command) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1165,7 +1135,7 @@ error and non-nil on success." ;; We can't use stty to disable echo of command. stty is said ;; to be added to toybox 0.7.6. busybox shall have it, but this ;; isn't used any longer for Android. - (delete-matching-lines (tramp-compat-rx bol (literal command) eol)) + (delete-matching-lines (rx bol (literal command) eol)) ;; When the local machine is W32, there are still trailing ^M. ;; There must be a better solution by setting the correct coding ;; system, but this requires changes in core Tramp. @@ -1254,7 +1224,7 @@ connection if a previous connection has died for some reason." (unless (process-live-p p) (save-match-data (when (and p (processp p)) (delete-process p)) - (if (zerop (length device)) + (if (tramp-string-empty-or-nil-p device) (tramp-error vec 'file-error "Device %s not connected" host)) (with-tramp-progress-reporter vec 3 "Opening adb shell connection" (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? @@ -1279,7 +1249,7 @@ connection if a previous connection has died for some reason." ;; Set sentinel and query flag. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -1288,7 +1258,7 @@ connection if a previous connection has died for some reason." ;; Change prompt. (tramp-set-connection-property - p "prompt" (tramp-compat-rx "///" (literal prompt) "#$")) + p "prompt" (rx "///" (literal prompt) "#$")) (tramp-adb-send-command vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt)) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 36992014e13..c2175612fa8 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -110,12 +110,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -;; Sometimes, compilation fails with "Variable binding depth exceeds -;; max-specpdl-size". Shall be fixed in Emacs 27. -(with-no-warnings ;; max-specpdl-size - (eval-and-compile - (let ((max-specpdl-size (* 2 max-specpdl-size))) - (require 'tramp-gvfs)))) +(require 'tramp-gvfs) (autoload 'dired-uncache "dired") (autoload 'url-tramp-convert-url-to-tramp "url-tramp") @@ -183,20 +178,9 @@ It must be supported by libarchive(3).") ;; The definition of `tramp-archive-file-name-regexp' contains calls ;; to `regexp-opt', which cannot be autoloaded while loading ;; loaddefs.el. So we use a macro, which is evaluated only when needed. -;; Emacs 26 and earlier cannot use the autoload form -;; `tramp-compat-rx'. So we refrain from using `rx'. ;;;###autoload (progn (defmacro tramp-archive-autoload-file-name-regexp () "Regular expression matching archive file names." - (if (<= emacs-major-version 26) - '(concat - "\\`" "\\(" ".+" "\\." - ;; Default suffixes ... - (regexp-opt tramp-archive-suffixes) - ;; ... with compression. - "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" - "\\)" ;; \1 - "\\(" "/" ".*" "\\)" "\\'") ;; \2 `(rx bos ;; This group is used in `tramp-archive-file-name-archive'. @@ -208,13 +192,10 @@ It must be supported by libarchive(3).") (? "." (| ,@tramp-archive-compression-suffixes))) ;; This group is used in `tramp-archive-file-name-localname'. (group "/" (* nonl)) - eos)))) + eos))) (put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t) -;; In older Emacs (prior 27.1), `tramp-archive-autoload-file-name-regexp' -;; is not autoloaded. So we cannot expect it to be known in -;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded. ;; We must wrap it into `eval-when-compile'. Otherwise, there could ;; be an "Eager macro-expansion failure" when unloading/reloading Tramp. ;;;###tramp-autoload @@ -222,11 +203,6 @@ It must be supported by libarchive(3).") (eval-when-compile (ignore-errors (tramp-archive-autoload-file-name-regexp))) "Regular expression matching archive file names.") -;; The value above is nil for Emacs 26. Set it now. -(if (<= emacs-major-version 26) - (setq tramp-archive-file-name-regexp - (ignore-errors (tramp-archive-autoload-file-name-regexp)))) - ;;;###tramp-autoload (defconst tramp-archive-method "archive" "Method name for archives in GVFS.") @@ -289,6 +265,7 @@ It must be supported by libarchive(3).") (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-archive-handle-file-system-info) (file-truename . tramp-archive-handle-file-truename) + (file-user-uid . tramp-archive-handle-file-user-uid) (file-writable-p . ignore) (find-backup-file-name . ignore) ;; `get-file-buffer' performed by default handler. @@ -299,7 +276,7 @@ It must be supported by libarchive(3).") (lock-file . ignore) (make-auto-save-file-name . ignore) (make-directory . tramp-archive-handle-not-implemented) - (make-directory-internal . tramp-archive-handle-not-implemented) + (make-directory-internal . ignore) (make-lock-file-name . ignore) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) @@ -360,13 +337,9 @@ arguments to pass to the OPERATION." (tramp-register-file-name-handlers) (tramp-archive-run-real-handler operation args)) - (with-no-warnings ;; max-specpdl-size (let* ((filename (apply #'tramp-archive-file-name-for-operation operation args)) - (archive (tramp-archive-file-name-archive filename)) - ;; Sometimes, it fails with "Variable binding depth exceeds - ;; max-specpdl-size". Shall be fixed in Emacs 27. - (max-specpdl-size (* 2 max-specpdl-size))) + (archive (tramp-archive-file-name-archive filename))) ;; `filename' could be a quoted file name. Or the file ;; archive could be a directory, see Bug#30293. @@ -394,7 +367,7 @@ arguments to pass to the OPERATION." (setq args (cons operation args))) (if fn (save-match-data (apply (cdr fn) args)) - (tramp-archive-run-real-handler operation args)))))))) + (tramp-archive-run-real-handler operation args))))))) ;;;###autoload (progn (defun tramp-archive-autoload-file-name-handler (operation &rest args) @@ -432,10 +405,6 @@ arguments to pass to the OPERATION." (remove-hook 'after-init-hook #'tramp-register-archive-autoload-file-name-handler)))) -;; In older Emacsen (prior 27.1), the autoload above does not exist. -;; So we call it again; it doesn't hurt. -(tramp-register-archive-autoload-file-name-handler) - ;; Mark `operations' the handler is responsible for. (put #'tramp-archive-file-name-handler 'operations (mapcar #'car tramp-archive-file-name-handler-alist)) @@ -458,7 +427,7 @@ arguments to pass to the OPERATION." "Return t if NAME is a string with archive file name syntax." (and (stringp name) ;; `tramp-archive-file-name-regexp' does not suppress quoted file names. - (not (tramp-compat-file-name-quoted-p name t)) + (not (file-name-quoted-p name t)) ;; We cannot use `string-match-p', the matches are used. (string-match tramp-archive-file-name-regexp name) t)) @@ -511,7 +480,6 @@ name is kept in slot `hop'" ;; http://... ((and url-handler-mode - tramp-compat-use-url-tramp-p (string-match-p url-handler-regexp archive) (string-match-p "https?" (url-type (url-generic-parse-url archive)))) @@ -631,7 +599,7 @@ offered." (defun tramp-archive-handle-directory-file-name (directory) "Like `directory-file-name' for file archives." (with-parsed-tramp-archive-file-name directory nil - (if (and (not (zerop (length localname))) + (if (and (tramp-compat-length> localname 0) (eq (aref localname (1- (length localname))) ?/) (not (string= localname "/"))) (substring directory 0 -1) @@ -643,23 +611,22 @@ offered." (defun tramp-archive-handle-directory-files (directory &optional full match nosort count) "Like `directory-files' for Tramp files." - (unless (file-exists-p directory) - (tramp-error (tramp-dissect-file-name directory) 'file-missing directory)) - (when (file-directory-p directory) - (setq directory (file-name-as-directory (expand-file-name directory))) - (let ((temp (nreverse (file-name-all-completions "" directory))) - result item) - - (while temp - (setq item (directory-file-name (pop temp))) - (when (or (null match) (string-match-p match item)) - (push (if full (concat directory item) item) - result))) - (unless nosort - (setq result (sort result #'string<))) - (when (and (natnump count) (> count 0)) - (setq result (tramp-compat-ntake count result))) - result))) + (tramp-barf-if-file-missing (tramp-dissect-file-name directory) directory + (when (file-directory-p directory) + (setq directory (file-name-as-directory (expand-file-name directory))) + (let ((temp (nreverse (file-name-all-completions "" directory))) + result item) + + (while temp + (setq item (directory-file-name (pop temp))) + (when (or (null match) (string-match-p match item)) + (push (if full (concat directory item) item) + result))) + (unless nosort + (setq result (sort result #'string<))) + (when (and (natnump count) (> count 0)) + (setq result (tramp-compat-ntake count result))) + result)))) (defun tramp-archive-handle-dired-uncache (dir) "Like `dired-uncache' for file archives." @@ -683,7 +650,9 @@ offered." (defun tramp-archive-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for file archives." - (file-name-all-completions filename (tramp-archive-gvfs-file-name directory))) + (ignore-error file-missing + (file-name-all-completions + filename (tramp-archive-gvfs-file-name directory)))) (defun tramp-archive-handle-file-readable-p (filename) "Like `file-readable-p' for file archives." @@ -702,6 +671,13 @@ offered." (setq local (expand-file-name local (file-name-directory localname)))) (concat (file-truename archive) local)))) +(defun tramp-archive-handle-file-user-uid () + "Like `user-uid' for file archives." + (with-parsed-tramp-archive-file-name default-directory nil + (let ((default-directory (file-name-directory archive))) + ;; `file-user-uid' exists since Emacs 30.1. + (tramp-compat-funcall 'file-user-uid)))) + (defun tramp-archive-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for file archives." diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 09e43a99039..c5864e7fa5e 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -267,8 +267,7 @@ Return VALUE." (defun tramp-flush-directory-properties (key directory) "Remove all properties of DIRECTORY in the cache context of KEY. Remove also properties of all files in subdirectories." - (let* ((directory - (directory-file-name (tramp-compat-file-name-unquote directory))) + (let* ((directory (directory-file-name (file-name-unquote directory))) (truename (tramp-get-file-property key directory "file-truename"))) (tramp-message key 8 "%s" directory) (dolist (key (hash-table-keys tramp-cache-data)) @@ -677,4 +676,8 @@ for all methods. Resulting data are derived from connection history." (provide 'tramp-cache) +;;; TODO: +;; +;; * Use multisession.el, starting with Emacs 29.1. + ;;; tramp-cache.el ends here diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index bf7d45d2a5a..b0cfdb1ebba 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -123,11 +123,11 @@ When called interactively, a Tramp connection has to be selected." ;; Delete processes. (dolist (key (hash-table-keys tramp-cache-data)) (when (and (processp key) - (tramp-file-name-equal-p (process-get key 'vector) vec) + (tramp-file-name-equal-p (process-get key 'tramp-vector) vec) (or (not keep-processes) (eq key (tramp-get-process vec)))) (tramp-flush-connection-properties key) - (delete-process key))) + (ignore-errors (delete-process key)))) ;; Remove buffers. (dolist @@ -359,7 +359,7 @@ The remote connection identified by SOURCE is flushed by (dir (tramp-rename-read-file-name-dir default)) (init (tramp-rename-read-file-name-init default)) (tramp-ignored-file-name-regexp - (tramp-compat-rx (literal (file-remote-p source))))) + (rx (literal (file-remote-p source))))) (read-file-name-default "Enter new Tramp connection: " dir default 'confirm init #'file-directory-p))))) @@ -470,7 +470,7 @@ For details, see `tramp-rename-files'." (dir (tramp-rename-read-file-name-dir default)) (init (tramp-rename-read-file-name-init default)) (tramp-ignored-file-name-regexp - (tramp-compat-rx (literal (file-remote-p source))))) + (rx (literal (file-remote-p source))))) (read-file-name-default (format "Change Tramp connection `%s': " source) dir default 'confirm init #'file-directory-p))))) @@ -625,7 +625,7 @@ buffer in your bug report. (unless (hash-table-p val) ;; Remove string quotation. (when (looking-at - (tramp-compat-rx + (rx bol (group (* anychar)) "\"" ;; \1 " (group "(base64-decode-string ") "\\" ;; \2 \ (group "\"" (* anychar)) "\\" ;; \3 \ diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index f176476a73a..420d6cadb9c 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -23,9 +23,9 @@ ;;; Commentary: -;; Tramp's main Emacs version for development is Emacs 29. This -;; package provides compatibility functions for Emacs 26, Emacs 27 and -;; Emacs 28. +;; Tramp's main Emacs version for development is Emacs 30. This +;; package provides compatibility functions for Emacs 27, Emacs 28 and +;; Emacs 29. ;;; Code: @@ -36,9 +36,7 @@ (require 'shell) (require 'subr-x) -(declare-function tramp-compat-rx "tramp") (declare-function tramp-error "tramp") -(declare-function tramp-file-name-handler "tramp") (declare-function tramp-tramp-file-p "tramp") (defvar tramp-temp-name-prefix) @@ -85,153 +83,6 @@ Add the extension of F, if existing." tramp-temp-name-prefix tramp-compat-temporary-file-directory) dir-flag (file-name-extension f t))) -;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' got -;; a second argument in Emacs 27.1. -;;;###tramp-autoload -(defalias 'tramp-compat-file-name-quoted-p - (if (equal (func-arity #'file-name-quoted-p) '(1 . 2)) - #'file-name-quoted-p - (lambda (name &optional top) - "Whether NAME is quoted with prefix \"/:\". -If NAME is a remote file name and TOP is nil, check the local part of NAME." - (let ((file-name-handler-alist (unless top file-name-handler-alist))) - (string-prefix-p "/:" (file-local-name name)))))) - -(defalias 'tramp-compat-file-name-quote - (if (equal (func-arity #'file-name-quote) '(1 . 2)) - #'file-name-quote - (lambda (name &optional top) - "Add the quotation prefix \"/:\" to file NAME. -If NAME is a remote file name and TOP is nil, the local part of NAME is quoted." - (let ((file-name-handler-alist (unless top file-name-handler-alist))) - (if (tramp-compat-file-name-quoted-p name top) - name - (concat (file-remote-p name) "/:" (file-local-name name))))))) - -(defalias 'tramp-compat-file-name-unquote - (if (equal (func-arity #'file-name-unquote) '(1 . 2)) - #'file-name-unquote - (lambda (name &optional top) - "Remove quotation prefix \"/:\" from file NAME. -If NAME is a remote file name and TOP is nil, the local part of -NAME is unquoted." - (let* ((file-name-handler-alist (unless top file-name-handler-alist)) - (localname (file-local-name name))) - (when (tramp-compat-file-name-quoted-p localname top) - (setq - localname (if (= (length localname) 2) "/" (substring localname 2)))) - (concat (file-remote-p name) localname))))) - -;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still -;; support old settings. -(defsubst tramp-compat-tramp-syntax () - "Return proper value of `tramp-syntax'." - (defvar tramp-syntax) - (cond ((eq tramp-syntax 'ftp) 'default) - ((eq tramp-syntax 'sep) 'separate) - (t tramp-syntax))) - -;; The signature of `tramp-make-tramp-file-name' has been changed. -;; Therefore, we cannot use `url-tramp-convert-url-to-tramp' prior -;; Emacs 26.1. We use `temporary-file-directory' as indicator. -(defconst tramp-compat-use-url-tramp-p (fboundp 'temporary-file-directory) - "Whether to use url-tramp.el.") - -;; `exec-path' is new in Emacs 27.1. -(defalias 'tramp-compat-exec-path - (if (fboundp 'exec-path) - #'exec-path - (lambda () - "List of directories to search programs to run in remote subprocesses." - (if (tramp-tramp-file-p default-directory) - (tramp-file-name-handler 'exec-path) - exec-path)))) - -;; `time-equal-p' has appeared in Emacs 27.1. -(defalias 'tramp-compat-time-equal-p - (if (fboundp 'time-equal-p) - #'time-equal-p - (lambda (t1 t2) - "Return non-nil if time value T1 is equal to time value T2. -A nil value for either argument stands for the current time." - (equal (or t1 (current-time)) (or t2 (current-time)))))) - -;; `flatten-tree' has appeared in Emacs 27.1. -(defalias 'tramp-compat-flatten-tree - (if (fboundp 'flatten-tree) - #'flatten-tree - (lambda (tree) - "Take TREE and \"flatten\" it." - (let (elems) - (setq tree (list tree)) - (while (let ((elem (pop tree))) - (cond ((consp elem) - (setq tree (cons (car elem) (cons (cdr elem) tree)))) - (elem - (push elem elems))) - tree)) - (nreverse elems))))) - -;; `progress-reporter-update' got argument SUFFIX in Emacs 27.1. -(defalias 'tramp-compat-progress-reporter-update - (if (equal (func-arity #'progress-reporter-update) '(1 . 3)) - #'progress-reporter-update - (lambda (reporter &optional value _suffix) - (progress-reporter-update reporter value)))) - -;; `ignore-error' is new in Emacs 27.1. -(defmacro tramp-compat-ignore-error (condition &rest body) - "Execute BODY; if the error CONDITION occurs, return nil. -Otherwise, return result of last form in BODY. - -CONDITION can also be a list of error conditions." - (declare (debug t) (indent 1)) - `(condition-case nil (progn ,@body) (,condition nil))) - -;; `rx' in Emacs 26 doesn't know the `literal', `anychar' and -;; `multibyte' constructs. The `not' construct requires an `any' -;; construct as argument. The `regexp' construct requires a literal -;; string. -(defvar tramp-compat-rx--runtime-params) - -(defun tramp-compat-rx--transform-items (items) - (mapcar #'tramp-compat-rx--transform-item items)) - -;; There is an error in Emacs 26. `(rx "a" (? ""))' => "a?". -;; We must protect the string in regexp and literal, therefore. -(defun tramp-compat-rx--transform-item (item) - (pcase item - ('anychar 'anything) - ('multibyte 'nonascii) - (`(not ,expr) - (if (consp expr) item (list 'not (list 'any expr)))) - (`(regexp ,expr) - (setq tramp-compat-rx--runtime-params t) - `(regexp ,(list '\, `(concat "\\(?:" ,expr "\\)")))) - (`(literal ,expr) - (setq tramp-compat-rx--runtime-params t) - `(regexp ,(list '\, `(concat "\\(?:" (regexp-quote ,expr) "\\)")))) - (`(eval . ,_) item) - (`(,head . ,rest) (cons head (tramp-compat-rx--transform-items rest))) - (_ item))) - -(defun tramp-compat-rx--transform (items) - (let* ((tramp-compat-rx--runtime-params nil) - (new-rx (cons ': (tramp-compat-rx--transform-items items)))) - (if tramp-compat-rx--runtime-params - `(rx-to-string ,(list '\` new-rx) t) - (rx-to-string new-rx t)))) - -(if (ignore-errors (rx-to-string '(literal "a"))) ;; Emacs 27+. - (defalias 'tramp-compat-rx #'rx) - (defmacro tramp-compat-rx (&rest items) - (tramp-compat-rx--transform items))) - -;; This is needed for compilation in the Emacs source tree. -;;;###autoload (defalias 'tramp-compat-rx #'rx) - -(put #'tramp-compat-rx 'tramp-autoload t) - ;; `file-modes', `set-file-modes' and `set-file-times' got argument ;; FLAG in Emacs 28.1. (defalias 'tramp-compat-file-modes @@ -326,6 +177,48 @@ CONDITION can also be a list of error conditions." (car components)) (cdr components))))))) +;; Function `replace-regexp-in-region' is new in Emacs 28.1. +(defalias 'tramp-compat-replace-regexp-in-region + (if (fboundp 'replace-regexp-in-region) + #'replace-regexp-in-region + (lambda (regexp replacement &optional start end) + (if start + (when (< start (point-min)) + (error "Start before start of buffer")) + (setq start (point))) + (if end + (when (> end (point-max)) + (error "End after end of buffer")) + (setq end (point-max))) + (save-excursion + (let ((matches 0) + (case-fold-search nil)) + (goto-char start) + (while (re-search-forward regexp end t) + (replace-match replacement t) + (setq matches (1+ matches))) + (and (not (zerop matches)) + matches)))))) + +;; `length<', `length>' and `length=' are added to Emacs 28.1. +(defalias 'tramp-compat-length< + (if (fboundp 'length<) + #'length< + (lambda (sequence length) + (< (length sequence) length)))) + +(defalias 'tramp-compat-length> + (if (fboundp 'length>) + #'length> + (lambda (sequence length) + (> (length sequence) length)))) + +(defalias 'tramp-compat-length= + (if (fboundp 'length=) + #'length= + (lambda (sequence length) + (= (length sequence) length)))) + ;; `permission-denied' is introduced in Emacs 29.1. (defconst tramp-permission-denied (if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error) @@ -353,7 +246,7 @@ CONDITION can also be a list of error conditions." #'take (lambda (n list) (when (and (natnump n) (> n 0)) - (if (>= n (length list)) + (if (tramp-compat-length< list n) list (butlast list (- (length list) n))))))) ;; Function `ntake' is new in Emacs 29.1. @@ -362,7 +255,7 @@ CONDITION can also be a list of error conditions." #'ntake (lambda (n list) (when (and (natnump n) (> n 0)) - (if (>= n (length list)) + (if (tramp-compat-length< list n) list (nbutlast list (- (length list) n))))))) ;; Function `string-equal-ignore-case' is new in Emacs 29.1. @@ -382,28 +275,18 @@ CONDITION can also be a list of error conditions." (autoload 'netrc-parse "netrc") (netrc-parse file)))) -;; Function `replace-regexp-in-region' is new in Emacs 28.1. -(defalias 'tramp-compat-replace-regexp-in-region - (if (fboundp 'replace-regexp-in-region) - #'replace-regexp-in-region - (lambda (regexp replacement &optional start end) - (if start - (when (< start (point-min)) - (error "Start before start of buffer")) - (setq start (point))) - (if end - (when (> end (point-max)) - (error "End after end of buffer")) - (setq end (point-max))) - (save-excursion - (let ((matches 0) - (case-fold-search nil)) - (goto-char start) - (while (re-search-forward regexp end t) - (replace-match replacement t) - (setq matches (1+ matches))) - (and (not (zerop matches)) - matches)))))) +;; 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)) @@ -419,8 +302,5 @@ CONDITION can also be a list of error conditions." ;; ;; * Starting with Emacs 27.1, there's no need to escape open ;; parentheses with a backslash in docstrings anymore. -;; -;; * Starting with Emacs 27.1, there's `make-empty-file'. Could be -;; used instead of `(write-region "" ...)'. ;;; tramp-compat.el ends here diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 6cdd6c654ea..5ae9ebaefb2 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -41,6 +41,7 @@ ;; CONTAINER is the container to connect to ;; ;; +;; ;; Open file in a Kubernetes container: ;; ;; C-x C-f /kubernetes:POD:/path/to/file @@ -54,6 +55,18 @@ ;; namespace, use this command to change it: ;; ;; "kubectl config set-context --current --namespace=<name>" +;; +;; +;; +;; Open a file on an existing toolbox container via Toolbox: +;; +;; C-x C-f /toolbox:CONTAINER:/path/to/file +;; +;; Where: +;; CONTAINER is the container to connect to (optional) +;; +;; If the container is not running, it is started. If no container is +;; specified, the default Toolbox container is used. ;;; Code: @@ -84,6 +97,14 @@ (string))) ;;;###tramp-autoload +(defcustom tramp-toolbox-program "toolbox" + "Name of the Toolbox client program." + :group 'tramp + :version "30.1" + :type '(choice (const "toolbox") + (string))) + +;;;###tramp-autoload (defconst tramp-docker-method "docker" "Tramp method name to use to connect to Docker containers.") @@ -96,15 +117,20 @@ "Tramp method name to use to connect to Kubernetes containers.") ;;;###tramp-autoload -(defun tramp-docker--completion-function (&rest _args) - "List Docker-like containers available for connection. +(defconst tramp-toolbox-method "toolbox" + "Tramp method name to use to connect to Toolbox containers.") + +;;;###tramp-autoload +(defun tramp-container--completion-function (program) + "List running containers available for connection. +PROGRAM is the program to be run for \"ps\", either +`tramp-docker-program' or `tramp-podman-program'. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." (when-let ((default-directory tramp-compat-temporary-file-directory) (raw-list (shell-command-to-string - (concat tramp-docker-program - " ps --format '{{.ID}}\t{{.Names}}'"))) + (concat program " ps --format '{{.ID}}\t{{.Names}}'"))) (lines (split-string raw-list "\n" 'omit)) (names (mapcar (lambda (line) @@ -114,7 +140,7 @@ see its function help for a description of the format." line) (or (match-string 2 line) (match-string 1 line)))) lines))) - (mapcar (lambda (m) (list nil m)) (delq nil names)))) + (mapcar (lambda (name) (list nil name)) (delq nil names)))) ;;;###tramp-autoload (defun tramp-kubernetes--completion-function (&rest _args) @@ -128,9 +154,7 @@ see its function help for a description of the format." " get pods --no-headers " "-o custom-columns=NAME:.metadata.name"))) (names (split-string raw-list "\n" 'omit))) - (mapcar (lambda (name) - (list nil name)) - names))) + (mapcar (lambda (name) (list nil name)) (delq nil names)))) (defun tramp-kubernetes--current-context-data (vec) "Return Kubernetes current context data as JSON string." @@ -151,6 +175,27 @@ see its function help for a description of the format." (buffer-string)))))) ;;;###tramp-autoload +(defun tramp-toolbox--completion-function (&rest _args) + "List Toolbox containers available for connection. + +This function is used by `tramp-set-completion-function', please +see its function help for a description of the format." + (when-let ((default-directory tramp-compat-temporary-file-directory) + (raw-list (shell-command-to-string + (concat tramp-toolbox-program " list -c"))) + ;; Ignore header line. + (lines (cdr (split-string raw-list "\n" 'omit))) + (names (mapcar + (lambda (line) + (when (string-match + (rx bol (1+ (not space)) + (1+ space) (group (1+ (not space))) space) + line) + (match-string 1 line))) + lines))) + (mapcar (lambda (name) (list nil name)) (delq nil names)))) + +;;;###tramp-autoload (defvar tramp-default-remote-shell) ;; Silence byte compiler. ;;;###tramp-autoload @@ -167,6 +212,7 @@ see its function help for a description of the format." (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods `(,tramp-podman-method (tramp-login-program ,tramp-podman-program) @@ -179,6 +225,7 @@ see its function help for a description of the format." (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods `(,tramp-kubernetes-method (tramp-login-program ,tramp-kubernetes-program) @@ -193,17 +240,36 @@ see its function help for a description of the format." (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods + `(,tramp-toolbox-method + (tramp-login-program ,tramp-toolbox-program) + (tramp-login-args (("run") + ("-c" "%h") + ("%l"))) + (tramp-direct-async (,tramp-default-remote-shell "-c")) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c")))) + + (add-to-list 'tramp-default-host-alist `(,tramp-toolbox-method nil "")) + (tramp-set-completion-function tramp-docker-method - '((tramp-docker--completion-function ""))) + `((tramp-container--completion-function + ,(executable-find tramp-docker-program)))) (tramp-set-completion-function tramp-podman-method - '((tramp-docker--completion-function ""))) + `((tramp-container--completion-function + ,(executable-find tramp-podman-program)))) (tramp-set-completion-function tramp-kubernetes-method - '((tramp-kubernetes--completion-function "")))) + '((tramp-kubernetes--completion-function ""))) + + (tramp-set-completion-function + tramp-toolbox-method + '((tramp-toolbox--completion-function "")))) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index c7696a51dae..116c2b143e9 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -146,7 +146,7 @@ They are completed by \"M-x TAB\" only when encryption support is enabled." If NAME doesn't belong to an encrypted remote directory, return nil." (catch 'crypt-file-name-p (and tramp-crypt-enabled (stringp name) - (not (tramp-compat-file-name-quoted-p name)) + (not (file-name-quoted-p name)) (not (string-suffix-p tramp-crypt-encfs-config name)) (dolist (dir tramp-crypt-directories) (and (string-prefix-p @@ -204,6 +204,7 @@ If NAME doesn't belong to an encrypted remote directory, return nil." (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-crypt-handle-file-system-info) ;; `file-truename' performed by default handler. + ;; `file-user-uid' performed by default-handler. (file-writable-p . tramp-crypt-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. @@ -315,7 +316,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil))) ;; The following operations must be performed without @@ -497,7 +498,7 @@ directory. File names will be also encrypted." (tramp-user-error nil "Feature is not enabled.")) (unless (and (tramp-tramp-file-p name) (file-directory-p name)) (tramp-user-error nil "%s must be an existing remote directory." name)) - (when (tramp-compat-file-name-quoted-p name) + (when (file-name-quoted-p name) (tramp-user-error nil "%s must not be quoted." name)) (setq name (file-name-as-directory (expand-file-name name))) (unless (member name tramp-crypt-directories) @@ -556,7 +557,7 @@ localname." (defun tramp-crypt-handle-access-file (filename string) "Like `access-file' for Tramp files." (let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename)) - (encrypt-regexp (tramp-compat-rx (literal encrypt-filename) eos)) + (encrypt-regexp (rx (literal encrypt-filename) eos)) tramp-crypt-enabled) (condition-case err (access-file encrypt-filename string) @@ -689,17 +690,17 @@ absolute file names." (directory &optional recursive _trash) "Like `delete-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name directory) nil - (tramp-flush-directory-properties v localname) (let (tramp-crypt-enabled) - (delete-directory (tramp-crypt-encrypt-file-name directory) recursive)))) + (delete-directory (tramp-crypt-encrypt-file-name directory) recursive)) + (tramp-flush-directory-properties v localname))) ;; Encrypted files won't be trashed. (defun tramp-crypt-handle-delete-file (filename &optional _trash) "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-flush-file-properties v localname) (let (tramp-crypt-enabled) - (delete-file (tramp-crypt-encrypt-file-name filename))))) + (delete-file (tramp-crypt-encrypt-file-name filename))) + (tramp-flush-file-properties v localname))) (defun tramp-crypt-handle-directory-files (directory &optional full match nosort count) @@ -709,8 +710,7 @@ absolute file names." (mapcar (lambda (x) (replace-regexp-in-string - (tramp-compat-rx bos (literal directory)) "" - (tramp-crypt-decrypt-file-name x))) + (rx bos (literal directory)) "" (tramp-crypt-decrypt-file-name x))) (directory-files (tramp-crypt-encrypt-file-name directory) 'full))))) (defun tramp-crypt-handle-file-attributes (filename &optional id-format) @@ -730,18 +730,19 @@ absolute file names." (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (let* (completion-regexp-list - tramp-crypt-enabled - (directory (file-name-as-directory directory)) - (enc-dir (tramp-crypt-encrypt-file-name directory))) - (mapcar - (lambda (x) - (substring - (tramp-crypt-decrypt-file-name (concat enc-dir x)) - (length directory))) - (file-name-all-completions "" enc-dir))))) + (ignore-error file-missing + (all-completions + filename + (let* (completion-regexp-list + tramp-crypt-enabled + (directory (file-name-as-directory directory)) + (enc-dir (tramp-crypt-encrypt-file-name directory))) + (mapcar + (lambda (x) + (substring + (tramp-crypt-decrypt-file-name (concat enc-dir x)) + (length directory))) + (file-name-all-completions "" enc-dir)))))) (defun tramp-crypt-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -756,9 +757,7 @@ absolute file names." (defun tramp-crypt-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." (let (tramp-crypt-enabled) - ;; `file-system-info' exists since Emacs 27.1. - (tramp-compat-funcall - 'file-system-info (tramp-crypt-encrypt-file-name filename)))) + (file-system-info (tramp-crypt-encrypt-file-name filename)))) (defun tramp-crypt-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -769,27 +768,26 @@ absolute file names." (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files. WILDCARD is not supported." - ;; This package has been added to Emacs 27.1. - (when (load "text-property-search" 'noerror 'nomessage) - (let (tramp-crypt-enabled) - (tramp-handle-insert-directory - (tramp-crypt-encrypt-file-name filename) - switches wildcard full-directory-p) - (let* ((filename (file-name-as-directory filename)) - (enc (tramp-crypt-encrypt-file-name filename)) - match string) - (goto-char (point-min)) - (while (setq match (text-property-search-forward 'dired-filename t t)) - (setq string - (buffer-substring - (prop-match-beginning match) (prop-match-end match)) - string (if (file-name-absolute-p string) - (tramp-crypt-decrypt-file-name string) - (substring - (tramp-crypt-decrypt-file-name (concat enc string)) - (length filename)))) - (delete-region (prop-match-beginning match) (prop-match-end match)) - (insert (propertize string 'dired-filename t))))))) + (require 'text-property-search) + (let (tramp-crypt-enabled) + (tramp-handle-insert-directory + (tramp-crypt-encrypt-file-name filename) + switches wildcard full-directory-p) + (let* ((filename (file-name-as-directory filename)) + (enc (tramp-crypt-encrypt-file-name filename)) + match string) + (goto-char (point-min)) + (while (setq match (text-property-search-forward 'dired-filename t t)) + (setq string + (buffer-substring + (prop-match-beginning match) (prop-match-end match)) + string (if (file-name-absolute-p string) + (tramp-crypt-decrypt-file-name string) + (substring + (tramp-crypt-decrypt-file-name (concat enc string)) + (length filename)))) + (delete-region (prop-match-beginning match) (prop-match-end match)) + (insert (propertize string 'dired-filename t)))))) (defun tramp-crypt-handle-lock-file (filename) "Like `lock-file' for Tramp files." @@ -800,16 +798,9 @@ WILDCARD is not supported." (defun tramp-crypt-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name dir) nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) + (tramp-skeleton-make-directory dir parents (let (tramp-crypt-enabled) - (make-directory (tramp-crypt-encrypt-file-name dir) parents)) - ;; When PARENTS is non-nil, DIR could be a chain of non-existent - ;; directories a/b/c/... Instead of checking, we simply flush the - ;; whole cache. - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))))) + (make-directory (tramp-crypt-encrypt-file-name dir) parents)))) (defun tramp-crypt-handle-rename-file (filename newname &optional ok-if-already-exists) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index e1ad0c2e5d2..8112e564a2c 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -34,15 +34,13 @@ (defun tramp-fuse-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name directory) nil - (tramp-flush-directory-properties v localname) + (tramp-skeleton-delete-directory directory recursive trash (delete-directory (tramp-fuse-local-file-name directory) recursive trash))) (defun tramp-fuse-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (delete-file (tramp-fuse-local-file-name filename) trash) - (tramp-flush-file-properties v localname))) + (tramp-skeleton-delete-file filename trash + (delete-file (tramp-fuse-local-file-name filename) trash))) (defvar tramp-fuse-remove-hidden-files nil "Remove hidden files from directory listings.") @@ -69,15 +67,15 @@ (tramp-fuse-local-file-name directory)))))))) (if full ;; Massage the result. - (let ((local (tramp-compat-rx + (let ((local (rx bol (literal (tramp-fuse-mount-point (tramp-dissect-file-name directory))))) (remote (directory-file-name (funcall - (if (tramp-compat-file-name-quoted-p directory) - #'tramp-compat-file-name-quote #'identity) + (if (file-name-quoted-p directory) + #'file-name-quote #'identity) (file-remote-p directory))))) (mapcar (lambda (x) (replace-regexp-in-string local remote x)) @@ -100,20 +98,21 @@ (defun tramp-fuse-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-fuse-remove-hidden-files - (all-completions - filename - (delete-dups - (append - (file-name-all-completions - filename (tramp-fuse-local-file-name directory)) - ;; Some storage systems do not return "." and "..". - (let (result) - (dolist (item '(".." ".") result) - (when (string-prefix-p filename item) - (catch 'match - (dolist (elt completion-regexp-list) - (unless (string-match-p elt item) (throw 'match nil))) - (setq result (cons (concat item "/") result))))))))))) + (ignore-error file-missing + (all-completions + filename + (delete-dups + (append + (file-name-all-completions + filename (tramp-fuse-local-file-name directory)) + ;; Some storage systems do not return "." and "..". + (let (result) + (dolist (item '(".." ".") result) + (when (string-prefix-p filename item) + (catch 'match + (dolist (elt completion-regexp-list) + (unless (string-match-p elt item) (throw 'match nil))) + (setq result (cons (concat item "/") result)))))))))))) ;; This function isn't used. (defun tramp-fuse-handle-insert-directory @@ -127,14 +126,8 @@ (defun tramp-fuse-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name dir) nil - (make-directory (tramp-fuse-local-file-name dir) parents) - ;; When PARENTS is non-nil, DIR could be a chain of non-existent - ;; directories a/b/c/... Instead of checking, we simply flush the - ;; whole file cache. - (tramp-flush-file-properties v localname) - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))))) + (tramp-skeleton-make-directory dir parents + (make-directory (tramp-fuse-local-file-name dir) parents))) ;; File name helper functions. @@ -180,8 +173,7 @@ It has the same meaning as `remote-file-name-inhibit-cache'.") (tramp-set-file-property vec "/" "mounted" (when (string-match - (tramp-compat-rx - bol (group (literal (tramp-fuse-mount-spec vec))) blank) + (rx bol (group (literal (tramp-fuse-mount-spec vec))) blank) mount) (match-string 1 mount))))))) @@ -211,7 +203,7 @@ It has the same meaning as `remote-file-name-inhibit-cache'.") (defun tramp-fuse-local-file-name (filename) "Return local mount name of FILENAME." - (setq filename (tramp-compat-file-name-unquote (expand-file-name filename))) + (setq filename (file-name-unquote (expand-file-name filename))) (with-parsed-tramp-file-name filename nil ;; As long as we call `tramp-*-maybe-open-connection' here, ;; we cache the result. @@ -220,10 +212,10 @@ It has the same meaning as `remote-file-name-inhibit-cache'.") (intern (format "tramp-%s-maybe-open-connection" (tramp-file-name-method v))) v) - (let ((quoted (tramp-compat-file-name-quoted-p localname)) - (localname (tramp-compat-file-name-unquote localname))) + (let ((quoted (file-name-quoted-p localname)) + (localname (file-name-unquote localname))) (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (expand-file-name (if (file-name-absolute-p localname) (substring localname 1) localname) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0273c28beca..7323374c607 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -414,7 +414,7 @@ It has been changed in GVFS 1.14.") ;; </interface> (defconst tramp-goa-identity-regexp - (tramp-compat-rx + (rx bol (? (group (regexp tramp-user-regexp))) "@" (? (group (regexp tramp-host-regexp))) (? ":" (group (regexp tramp-port-regexp)))) @@ -716,13 +716,13 @@ It has been changed in GVFS 1.14.") "GVFS file attributes.")) (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (tramp-compat-rx + (rx blank (group (regexp (regexp-opt tramp-gvfs-file-attributes))) "=" (group (+? nonl))) "Regexp to parse GVFS file attributes with `gvfs-ls'.") (defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp - (tramp-compat-rx + (rx bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes))) ":" (+ blank) (group (* nonl)) eol) "Regexp to parse GVFS file attributes with `gvfs-info'.") @@ -734,7 +734,7 @@ It has been changed in GVFS 1.14.") "GVFS file system attributes.") (defconst tramp-gvfs-file-system-attributes-regexp - (tramp-compat-rx + (rx bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-system-attributes))) ":" (+ blank) (group (* nonl)) eol) @@ -744,7 +744,7 @@ It has been changed in GVFS 1.14.") "Default prefix for owncloud / nextcloud methods.") (defconst tramp-gvfs-nextcloud-default-prefix-regexp - (tramp-compat-rx (literal tramp-gvfs-nextcloud-default-prefix) eol) + (rx (literal tramp-gvfs-nextcloud-default-prefix) eol) "Regexp of default prefix for owncloud / nextcloud methods.") @@ -798,6 +798,7 @@ It has been changed in GVFS 1.14.") (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-gvfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) (file-writable-p . tramp-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. @@ -1139,25 +1140,23 @@ file names." (defun tramp-gvfs-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-flush-file-properties v localname) - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (unless (and (tramp-gvfs-send-command - v "gvfs-rm" (tramp-gvfs-url-file-name filename)) - (not (tramp-gvfs-info filename))) - ;; Propagate the error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (tramp-error-with-buffer - nil v 'file-error "Couldn't delete %s" filename)))))) + (tramp-skeleton-delete-file filename trash + (unless (and (tramp-gvfs-send-command + v "gvfs-rm" (tramp-gvfs-url-file-name filename)) + (not (tramp-gvfs-info filename))) + ;; Propagate the error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (tramp-error-with-buffer + nil v 'file-error "Couldn't delete %s" filename))))) (defun tramp-gvfs-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -1168,12 +1167,11 @@ file names." (with-parsed-tramp-file-name name nil ;; If there is a default location, expand tilde. (when (string-match - (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) - localname) + (rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (when (tramp-string-empty-or-nil-p uname) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -1186,8 +1184,7 @@ file names." ;; We do not pass "/..". (if (string-match-p (rx bos (| "afp" (: "dav" (? "s")) "smb") eos) method) (when (string-match - (tramp-compat-rx bos "/" (+ (not "/")) (group "/.." (? "/"))) - localname) + (rx bos "/" (+ (not "/")) (group "/.." (? "/"))) localname) (setq localname (replace-match "/" t t localname 1))) (when (string-match (rx bol "/.." (? "/")) localname) (setq localname (replace-match "/" t t localname)))) @@ -1222,7 +1219,7 @@ file names." (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (looking-at - (tramp-compat-rx + (rx bol (group (+ nonl)) blank (group (+ digit)) blank "(" (group (+? nonl)) ")" @@ -1232,7 +1229,7 @@ file names." (cons "name" (match-string 1))))) (goto-char (1+ (match-end 3))) (while (looking-at - (tramp-compat-rx + (rx (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp) (group (| (regexp @@ -1281,11 +1278,10 @@ If FILE-SYSTEM is non-nil, return file system attributes." "Return GVFS attributes association list of FILENAME." (setq filename (directory-file-name (expand-file-name filename))) (with-parsed-tramp-file-name filename nil - (setq localname (tramp-compat-file-name-unquote localname)) + (setq localname (file-name-unquote localname)) (if (or (and (string-match-p (rx bol (| "afp" (: "dav" (? "s")) "smb") eol) method) - (string-match-p - (tramp-compat-rx bol (? "/") (+ (not "/")) eol) localname)) + (string-match-p (rx bol (? "/") (+ (not "/")) eol) localname)) (string-equal localname "/")) (tramp-gvfs-get-root-attributes filename) (assoc @@ -1422,16 +1418,19 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (tramp-compat-string-search "/" filename) - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (let ((result '("./" "../"))) - ;; Get a list of directories and files. - (dolist (item (tramp-gvfs-get-directory-attributes directory) result) - (if (string-equal (cdr (assoc "type" item)) "directory") - (push (file-name-as-directory (car item)) result) - (push (car item) result))))))))) + (ignore-error file-missing + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (let ((result '("./" "../"))) + ;; Get a list of directories and files. + (dolist (item + (tramp-gvfs-get-directory-attributes directory) + result) + (if (string-equal (cdr (assoc "type" item)) "directory") + (push (file-name-as-directory (car item)) result) + (push (car item) result)))))))))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1461,16 +1460,16 @@ If FILE-SYSTEM is non-nil, return file system attributes." v 'file-notify-error "Monitoring not supported for `%s'" file-name) (tramp-message v 6 "Run `%s', %S" (string-join (process-command p) " ") p) - (process-put p 'vector v) - (process-put p 'events events) - (process-put p 'watch-name localname) + (process-put p 'tramp-vector v) + (process-put p 'tramp-events events) + (process-put p 'tramp-watch-name localname) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (set-process-filter p #'tramp-gvfs-monitor-process-filter) (set-process-sentinel p #'tramp-file-notify-process-sentinel) ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (unless (process-live-p p) (tramp-error p 'file-notify-error "Monitoring not supported for `%s'" file-name)) @@ -1482,10 +1481,10 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-monitor-process-filter (proc string) "Read output from \"gvfs-monitor-file\" and add corresponding \ `file-notify' events." - (let* ((events (process-get proc 'events)) - (rest-string (process-get proc 'rest-string)) + (let* ((events (process-get proc 'tramp-events)) + (rest-string (process-get proc 'tramp-rest-string)) (dd (tramp-get-default-directory (process-buffer proc))) - (ddu (tramp-compat-rx (literal (tramp-gvfs-url-file-name dd))))) + (ddu (rx (literal (tramp-gvfs-url-file-name dd))))) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) @@ -1504,7 +1503,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (delete-process proc)) (while (string-match - (tramp-compat-rx + (rx bol (+ nonl) ":" blank (group (+ nonl)) ":" blank (group (regexp (regexp-opt tramp-gio-events))) @@ -1526,7 +1525,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (setq file1 (url-unhex-string file1))) ;; Remove watch when file or directory to be watched is deleted. (when (and (member action '(moved deleted)) - (string-equal file (process-get proc 'watch-name))) + (string-equal file (process-get proc 'tramp-watch-name))) (delete-process proc)) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at @@ -1536,9 +1535,9 @@ If FILE-SYSTEM is non-nil, return file system attributes." 'file-notify-callback (list proc action file file1))))) ;; Save rest of the string. - (when (zerop (length string)) (setq string nil)) + (when (string-empty-p string) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (process-put proc 'rest-string string))) + (process-put proc 'tramp-rest-string string))) (defun tramp-gvfs-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -1560,27 +1559,13 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (directory-file-name (expand-file-name dir))) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) - (tramp-flush-directory-properties v localname) + (tramp-skeleton-make-directory dir parents (save-match-data - (let ((ldir (file-name-directory dir))) - ;; Make missing directory parts. "gvfs-mkdir -p ..." does not - ;; work robust. - (when (and parents (not (file-directory-p ldir))) - (make-directory ldir parents)) - ;; Just do it. - (or (when-let ((mkdir-succeeded - (and - (tramp-gvfs-send-command - v "gvfs-mkdir" (tramp-gvfs-url-file-name dir)) - (tramp-gvfs-info dir)))) - (set-file-modes dir (default-file-modes)) - mkdir-succeeded) - (and parents (file-directory-p dir)) - (tramp-error v 'file-error "Couldn't make directory %s" dir)))))) + (if (and (tramp-gvfs-send-command + v "gvfs-mkdir" (tramp-gvfs-url-file-name dir)) + (tramp-gvfs-info dir)) + (set-file-modes dir (default-file-modes)) + (tramp-error v 'file-error "Couldn't make directory %s" dir))))) (defun tramp-gvfs-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -1621,12 +1606,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (tramp-gvfs-set-attribute v (if (eq flag 'nofollow) "-nt" "-t") "uint64" (tramp-gvfs-url-file-name filename) "time::modified" - (format-time-string - "%s" (if (or (null time) - (tramp-compat-time-equal-p time tramp-time-doesnt-exist) - (tramp-compat-time-equal-p time tramp-time-dont-know)) - nil - time))))) + (format-time-string "%s" (tramp-defined-time time))))) (defun tramp-gvfs-handle-get-home-directory (vec &optional _user) "The remote home directory for connection VEC as local file name. @@ -1636,7 +1616,7 @@ VEC or USER, or if there is no home directory, return nil." (let ((localname (tramp-get-connection-property vec "default-location")) result) (cond - ((zerop (length localname)) + ((tramp-string-empty-or-nil-p localname) (tramp-get-connection-property (tramp-get-process vec) "share")) ;; Google-drive. ((not (string-prefix-p "/" localname)) @@ -1719,7 +1699,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-gvfs-url-file-name (filename) "Return FILENAME in URL syntax." - (setq filename (tramp-compat-file-name-unquote filename)) + (setq filename (file-name-unquote filename)) (let* (;; "/" must NOT be hexified. (url-unreserved-chars (cons ?/ url-unreserved-chars)) (result @@ -1739,8 +1719,7 @@ ID-FORMAT valid values are `string' and `integer'." "Retrieve file name from D-Bus OBJECT-PATH." (dbus-unescape-from-identifier (replace-regexp-in-string - (tramp-compat-rx bol (* nonl) "/" (group (+ (not "/"))) eol) "\\1" - object-path))) + (rx bol (* nonl) "/" (group (+ (not "/"))) eol) "\\1" object-path))) (defun tramp-gvfs-url-host (url) "Return the host name part of URL, a string. @@ -1769,11 +1748,11 @@ a downcased host name only." (condition-case nil (with-parsed-tramp-file-name filename l - (when (and (zerop (length user)) + (when (and (tramp-string-empty-or-nil-p user) (not (zerop (logand flags tramp-gvfs-password-need-username)))) (setq user (read-string "User name: "))) - (when (and (zerop (length domain)) + (when (and (tramp-string-empty-or-nil-p domain) (not (zerop (logand flags tramp-gvfs-password-need-domain)))) (setq domain (read-string "Domain name: "))) @@ -2016,7 +1995,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (string-equal host (tramp-file-name-host vec)) (string-equal port (tramp-file-name-port vec)) (string-match-p - (tramp-compat-rx bol "/" (literal (or share ""))) + (rx bol "/" (literal (or share ""))) (tramp-file-name-unquote-localname vec))) ;; Set mountpoint and location. (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) @@ -2061,8 +2040,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (tramp-media-device-port media) (tramp-file-name-port vec))) (localname (tramp-file-name-unquote-localname vec)) (share (when (string-match - (tramp-compat-rx bol (? "/") (group (+ (not "/")))) - localname) + (rx bol (? "/") (group (+ (not "/")))) localname) (match-string 1 localname))) (ssl (if (string-match-p (rx bol (| "davs" "nextcloud")) method) "true" "false")) @@ -2105,8 +2083,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "port" port))))) (mount-pref (if (and (string-match-p (rx bol "dav") method) - (string-match - (tramp-compat-rx bol (? "/") (+ (not "/"))) localname)) + (string-match (rx bol (? "/") (+ (not "/"))) localname)) (match-string 0 localname) (tramp-gvfs-get-remote-prefix vec)))) @@ -2175,7 +2152,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. @@ -2212,7 +2189,7 @@ connection if a previous connection has died for some reason." (with-tramp-progress-reporter vec 3 - (if (zerop (length user)) + (if (tramp-string-empty-or-nil-p user) (format "Opening connection for %s using %s" host method) (format "Opening connection for %s@%s using %s" user host method)) @@ -2262,7 +2239,7 @@ connection if a previous connection has died for some reason." (with-timeout ((or (tramp-get-method-parameter vec 'tramp-connection-timeout) tramp-connection-timeout) - (if (zerop (length (tramp-file-name-user vec))) + (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) (tramp-error vec 'file-error "Timeout reached mounting %s using %s" host method) @@ -2441,7 +2418,7 @@ VEC is used only for traces." ;; Adapt default host name, supporting /mtp:: when possible. (setq tramp-default-host-alist (append - `(("mtp" nil ,(if (= (length devices) 1) (car devices) ""))) + `(("mtp" nil ,(if (tramp-compat-length= devices 1) (car devices) ""))) (delete (assoc "mtp" tramp-default-host-alist) tramp-default-host-alist))))) @@ -2493,25 +2470,22 @@ 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 - (with-no-warnings ;; max-specpdl-size ;; Suppress D-Bus error messages and Tramp traces. - (let (;; Sometimes, it fails with "Variable binding depth exceeds - ;; max-specpdl-size". Shall be fixed in Emacs 27. - (max-specpdl-size (* 2 max-specpdl-size)) - (tramp-verbose 0) + (let ((tramp-verbose 0) tramp-gvfs-dbus-event-vector fun) ;; Add completion functions for services announced by DNS-SD. ;; See <http://www.dns-sd.org/ServiceTypes.html> for valid service types. @@ -2564,7 +2538,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." "mtp" (mapcar (lambda (method) `(tramp-parse-media-names ,(format "_%s._tcp" method))) - tramp-media-methods))))) + tramp-media-methods)))) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index cff0877555e..5b3259eab03 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -53,7 +53,7 @@ (defvar shortdoc--groups) (defvar tramp-current-connection) (defvar tramp-postfix-host-format) -(defvar tramp-use-ssh-controlmaster-options) +(defvar tramp-use-connection-share) ;;; Fontification of `read-file-name': @@ -133,8 +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 (tramp-compat-exec-path)) path-separator) + (string-join (butlast (exec-path)) path-separator) (getenv "PATH")))) (with-eval-after-load 'esh-util @@ -303,7 +302,7 @@ NAME must be equal to `tramp-current-connection'." ;; Bug#45518. So we don't use ssh ControlMaster options. (defun tramp-compile-disable-ssh-controlmaster-options () "Don't allow ssh ControlMaster while compiling." - (setq-local tramp-use-ssh-controlmaster-options nil)) + (setq-local tramp-use-connection-share 'suppress)) (with-eval-after-load 'compile (add-hook 'compilation-mode-hook @@ -346,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" @@ -356,8 +354,7 @@ NAME must be equal to `tramp-current-connection'." "comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") ",") "-o" - ,(mapconcat - #'identity + ,(string-join '("state" "ppid" "pgid" @@ -420,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" @@ -429,8 +425,7 @@ See `tramp-process-attributes-ps-format'.") ",") "-o" "stat=abcde" "-o" - ,(mapconcat - #'identity + ,(string-join '("ppid" "pgid" "tty" @@ -473,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" @@ -483,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-rclone.el b/lisp/net/tramp-rclone.el index 2360abfb1dd..ec6a1da684f 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -118,6 +118,7 @@ (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-rclone-handle-file-system-info) (file-truename . tramp-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) (file-writable-p . tramp-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. @@ -337,7 +338,7 @@ file names." (defun tramp-rclone-remote-file-name (filename) "Return FILENAME as used in the `rclone' command." - (setq filename (tramp-compat-file-name-unquote (expand-file-name filename))) + (setq filename (file-name-unquote (expand-file-name filename))) (if (tramp-rclone-file-name-p filename) (with-parsed-tramp-file-name filename nil ;; As long as we call `tramp-rclone-maybe-open-connection' here, @@ -361,7 +362,7 @@ connection if a previous connection has died for some reason." (let ((host (tramp-file-name-host vec))) (when (rassoc `(,host) (tramp-rclone-parse-device-names nil)) - (if (zerop (length host)) + (if (tramp-string-empty-or-nil-p host) (tramp-error vec 'file-error "Storage %s not connected" host)) ;; We need a process bound to the connection buffer. Therefore, ;; we create a dummy process. Maybe there is a better solution? @@ -370,7 +371,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ec8437176db..24e90447b24 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -106,13 +106,26 @@ detected as prompt when being sent on echoing hosts, therefore.") (defconst tramp-end-of-heredoc (md5 tramp-end-of-output) "String used to recognize end of heredoc strings.") -(defcustom tramp-use-ssh-controlmaster-options (not (eq system-type 'windows-nt)) - "Whether to use `tramp-ssh-controlmaster-options'. +(defcustom tramp-use-connection-share (not (eq system-type 'windows-nt)) + "Whether to use connection share in ssh or PuTTY. +Set it to t, if you want Tramp to apply respective options. These +are `tramp-ssh-controlmaster-options' for ssh, and \"-share\" for PuTTY. 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\" file or in your PuTTY session." :group 'tramp - :version "28.1" - :type 'boolean) + :version "30.1" + :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-connection-share 'suppress) + :safe (lambda (val) (and (memq val '(t nil suppress)) t))) + +(defvaralias 'tramp-use-connection-share 'tramp-use-ssh-controlmaster-options) +(make-obsolete-variable + 'tramp-use-ssh-controlmaster-options + "Use `tramp-use-connection-share' instead" "30.1") (defvar tramp-ssh-controlmaster-options nil "Which ssh Control* arguments to use. @@ -123,8 +136,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-connection-share' is t. The value depends on the +installed local ssh version. The string is used in `tramp-methods'.") @@ -341,7 +354,7 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-methods `("plink" (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%c") ("-t") ("%h") ("\"") (,(format "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" @@ -354,7 +367,7 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-methods `("plinkx" (tramp-login-program "plink") - (tramp-login-args (("-load") ("%h") ("-t") ("\"") + (tramp-login-args (("-load") ("%h") ("%c") ("-t") ("\"") (,(format "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" tramp-terminal-type @@ -366,7 +379,7 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-methods `("pscp" (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%c") ("-t") ("%h") ("\"") (,(format "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" @@ -384,7 +397,7 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-methods `("psftp" (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%c") ("-t") ("%h") ("\"") (,(format "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" @@ -396,7 +409,7 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "pscp") (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") - ("-p" "%k") ("-q"))) + ("-p" "%k"))) (tramp-copy-keep-date t))) (add-to-list 'tramp-methods `("fcp" @@ -411,7 +424,7 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-default-method-alist `(,tramp-local-host-regexp - ,(tramp-compat-rx bos (literal tramp-root-id-string) eos) "su")) + ,(rx bos (literal tramp-root-id-string) eos) "su")) (add-to-list 'tramp-default-user-alist `(,(rx bos (| "su" "sudo" "doas" "ksu") eos) @@ -631,7 +644,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. @@ -1086,6 +1098,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-sh-handle-file-system-info) (file-truename . tramp-sh-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) (file-writable-p . tramp-sh-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. @@ -1131,140 +1144,67 @@ Operations not mentioned here will be handled by the normal Emacs functions.") (defun tramp-sh-handle-make-symbolic-link (target linkname &optional ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files. -If TARGET is a non-Tramp file, it is used verbatim as the target -of the symlink. If TARGET is a Tramp file, only the localname -component is used as the target of the symlink." - (with-parsed-tramp-file-name (expand-file-name linkname) nil - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (let ((non-essential t)) - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target)))) - ;; There could be a cyclic link. - (tramp-flush-file-properties - v (expand-file-name target (tramp-file-local-name default-directory)))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link - (tramp-compat-file-name-quote target 'top) - linkname ok-if-already-exists) - - (let ((ln (tramp-get-remote-ln v)) - (cwd (tramp-run-real-handler - #'file-name-directory (list localname)))) - (unless ln - (tramp-error - v 'file-error - (concat "Making a symbolic link. " - "ln(1) does not exist on the remote host."))) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not - (yes-or-no-p - (format - "File %s already exists; make it a link anyway?" - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (tramp-flush-file-properties v localname) - - ;; Right, they are on the same host, regardless of user, - ;; method, etc. We now make the link on the remote machine. - ;; This will occur as the user that TARGET belongs to. - (and (tramp-send-command-and-check - v (format "cd %s" (tramp-shell-quote-argument cwd))) - (tramp-send-command-and-check - v (format - "%s -sf %s %s" ln - (tramp-shell-quote-argument target) - ;; The command could exceed PATH_MAX, so we use - ;; relative file names. However, relative file names - ;; could start with "-". - ;; `tramp-shell-quote-argument' does not handle this, - ;; we must do it ourselves. - (tramp-shell-quote-argument - (concat "./" (file-name-nondirectory localname)))))))))) + "Like `make-symbolic-link' for Tramp files." + (let ((v (tramp-dissect-file-name (expand-file-name linkname)))) + (unless (tramp-get-remote-ln v) + (tramp-error + v 'file-error + (concat "Making a symbolic link. " + "ln(1) does not exist on the remote host.")))) + + (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists + (and (tramp-send-command-and-check + v (format + "cd %s" + (tramp-shell-quote-argument (file-name-directory localname)))) + (tramp-send-command-and-check + v (format + "%s -sf %s %s" (tramp-get-remote-ln v) + (tramp-shell-quote-argument target) + ;; The command could exceed PATH_MAX, so we use relative + ;; file names. + (tramp-shell-quote-argument + (concat "./" (file-name-nondirectory localname)))))))) (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." - ;; Preserve trailing "/". - (funcall - (if (directory-name-p filename) #'file-name-as-directory #'identity) - ;; Quote properly. - (funcall - (if (tramp-compat-file-name-quoted-p filename) - #'tramp-compat-file-name-quote #'identity) - (with-parsed-tramp-file-name - (tramp-compat-file-name-unquote (expand-file-name filename)) nil - (tramp-make-tramp-file-name - v - (with-tramp-file-property v localname "file-truename" - (tramp-message v 4 "Finding true name for `%s'" filename) - (let ((result - (cond - ;; Use GNU readlink --canonicalize-missing where available. - ((tramp-get-remote-readlink v) - (tramp-send-command-and-check - v (format "%s --canonicalize-missing %s" - (tramp-get-remote-readlink v) - (tramp-shell-quote-argument localname))) - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (buffer-substring (point-min) (line-end-position)))) - - ;; Use Perl implementation. - ((and (tramp-get-remote-perl v) - (tramp-get-connection-property v "perl-file-spec") - (tramp-get-connection-property v "perl-cwd-realpath")) - (tramp-maybe-send-script - v tramp-perl-file-truename "tramp_perl_file_truename") - (tramp-send-command-and-read - v (format "tramp_perl_file_truename %s" - (tramp-shell-quote-argument localname)))) - - ;; Do it yourself. - (t (tramp-file-local-name - (tramp-handle-file-truename filename)))))) - - ;; Detect cycle. - (when (and (file-symlink-p filename) - (string-equal result localname)) - (tramp-error - v 'file-error - "Apparent cycle of symbolic links for %s" filename)) - ;; If the resulting localname looks remote, we must quote it - ;; for security reasons. - (when (file-remote-p result) - (setq result (tramp-compat-file-name-quote result 'top))) - (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result))))))) + (tramp-skeleton-file-truename filename + (cond + ;; Use GNU readlink --canonicalize-missing where available. + ((tramp-get-remote-readlink v) + (tramp-send-command-and-check + v (format "%s --canonicalize-missing %s" + (tramp-get-remote-readlink v) + (tramp-shell-quote-argument localname))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (buffer-substring (point-min) (line-end-position)))) + + ;; Use Perl implementation. + ((and (tramp-get-remote-perl v) + (tramp-get-connection-property v "perl-file-spec") + (tramp-get-connection-property v "perl-cwd-realpath")) + (tramp-maybe-send-script + v tramp-perl-file-truename "tramp_perl_file_truename") + (tramp-send-command-and-read + v (format "tramp_perl_file_truename %s" + (tramp-shell-quote-argument localname)))) + + ;; Do it yourself. + (t (tramp-file-local-name + (tramp-handle-file-truename filename)))))) ;; Basic 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." @@ -1438,7 +1378,7 @@ component is used as the target of the symlink." (modtime (or (file-attribute-modification-time attr) tramp-time-doesnt-exist))) (setq coding-system-used last-coding-system-used) - (if (not (tramp-compat-time-equal-p modtime tramp-time-dont-know)) + (if (not (time-equal-p modtime tramp-time-dont-know)) (tramp-run-real-handler #'set-visited-file-modtime (list modtime)) (progn (tramp-send-command @@ -1478,9 +1418,7 @@ of." (cond ;; File exists, and has a known modtime. - ((and attr - (not - (tramp-compat-time-equal-p modtime tramp-time-dont-know))) + ((and attr (not (time-equal-p modtime tramp-time-dont-know))) (< (abs (tramp-time-diff modtime mt)) 2)) ;; Modtime has the don't know value. (attr @@ -1497,7 +1435,7 @@ of." v localname "visited-file-modtime-ild" ""))) ;; If file does not exist, say it is not modified if and ;; only if that agrees with the buffer's record. - (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist))))))))) + (t (time-equal-p mt tramp-time-doesnt-exist))))))))) (defun tramp-sh-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." @@ -1519,21 +1457,17 @@ of." "Like `set-file-times' for Tramp files." (tramp-skeleton-set-file-modes-times-uid-gid filename (when (tramp-get-remote-touch v) - (let ((time - (if (or (null time) - (tramp-compat-time-equal-p time tramp-time-doesnt-exist) - (tramp-compat-time-equal-p time tramp-time-dont-know)) - nil - time))) - (tramp-send-command-and-check - v (format - "env TZ=UTC0 %s %s %s %s" - (tramp-get-remote-touch v) - (if (tramp-get-connection-property v "touch-t") - (format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t)) - "") - (if (eq flag 'nofollow) "-h" "") - (tramp-shell-quote-argument localname))))))) + (tramp-send-command-and-check + v (format + "env TZ=UTC0 %s %s %s %s" + (tramp-get-remote-touch v) + (if (tramp-get-connection-property v "touch-t") + (format + "-t %s" + (format-time-string "%Y%m%d%H%M.%S" (tramp-defined-time time) t)) + "") + (if (eq flag 'nofollow) "-h" "") + (tramp-shell-quote-argument localname)))))) (defun tramp-sh-handle-get-home-directory (vec &optional user) "The remote home directory for connection VEC as local file name. @@ -1631,7 +1565,7 @@ ID-FORMAT valid values are `string' and `integer'." (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (tramp-compat-rx + (regexp (rx (group (+ (any "_" alnum))) ":" (group (+ (any "_" alnum))) ":" (group (+ (any "_" alnum))) ":" @@ -1723,7 +1657,7 @@ ID-FORMAT valid values are `string' and `integer'." (if (tramp-file-property-p v localname "file-attributes") (or (tramp-check-cached-permissions v ?x) (tramp-check-cached-permissions v ?s)) - (tramp-run-test "-x" filename))))) + (tramp-run-test v "-x" localname))))) (defun tramp-sh-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -1733,7 +1667,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; satisfied without remote operation. (if (tramp-file-property-p v localname "file-attributes") (tramp-handle-file-readable-p filename) - (tramp-run-test "-r" filename))))) + (tramp-run-test v "-r" localname))))) ;; Functions implemented using the basic functions above. @@ -1744,7 +1678,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; Sometimes, when a connection is not established yet, it is ;; desirable to return t immediately for "/method:foo:". It can ;; be expected that this is always a directory. - (or (zerop (length localname)) + (or (tramp-string-empty-or-nil-p localname) (with-tramp-file-property v localname "file-directory-p" (if-let ((truename (tramp-get-file-property v localname "file-truename")) @@ -1754,7 +1688,7 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-get-file-property v (tramp-file-local-name truename) "file-attributes")) t) - (tramp-run-test "-d" filename)))))) + (tramp-run-test v "-d" localname)))))) (defun tramp-sh-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -1765,7 +1699,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; Examine `file-attributes' cache to see if request can ;; be satisfied without remote operation. (tramp-check-cached-permissions v ?w) - (tramp-run-test "-w" filename)) + (tramp-run-test v "-w" localname)) ;; If file doesn't exist, check if directory is writable. (and (file-directory-p (file-name-directory filename)) @@ -1839,64 +1773,43 @@ ID-FORMAT valid values are `string' and `integer'." (with-parsed-tramp-file-name (expand-file-name directory) nil (when (and (not (tramp-compat-string-search "/" filename)) (tramp-connectable-p v)) - (all-completions - filename - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; 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)))))) + (unless (tramp-compat-string-search "/" filename) + (ignore-error file-missing + (all-completions + filename + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including + ;; reliably tagging the directories with a trailing "/". + ;; Because I rock. --daniel@danann.net + (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 @@ -2357,7 +2270,7 @@ The method used must be an out-of-band method." copy-program copy-args copy-env copy-keep-date listener spec options source target remote-copy-program remote-copy-args p) - (if (and v1 v2 (zerop (length (tramp-scp-direct-remote-copying v1 v2)))) + (if (and v1 v2 (string-empty-p (tramp-scp-direct-remote-copying v1 v2))) ;; Both are Tramp files. We cannot use direct remote copying. (let* ((dir-flag (file-directory-p filename)) @@ -2389,10 +2302,10 @@ The method used must be an out-of-band method." #'identity) (if v1 (tramp-make-copy-program-file-name v1) - (tramp-compat-file-name-unquote filename))) + (file-name-unquote filename))) target (if v2 (tramp-make-copy-program-file-name v2) - (tramp-compat-file-name-unquote newname))) + (file-name-unquote newname))) ;; Check for listener port. (when (tramp-get-method-parameter v 'tramp-remote-copy-args) @@ -2436,7 +2349,7 @@ The method used must be an out-of-band method." ;; `tramp-ssh-controlmaster-options' is a string instead ;; of a list. Unflatten it. copy-args - (tramp-compat-flatten-tree + (flatten-tree (mapcar (lambda (x) (if (tramp-compat-string-search " " x) (split-string x) x)) @@ -2463,8 +2376,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)) "&")) @@ -2517,7 +2429,11 @@ The method used must be an out-of-band method." (tramp-get-connection-buffer v) copy-program copy-args))) (tramp-message v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, + ;; the setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -2557,19 +2473,10 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (expand-file-name dir)) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) - ;; When PARENTS is non-nil, DIR could be a chain of non-existent - ;; directories a/b/c/... Instead of checking, we simply flush the - ;; whole cache. - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))) + (tramp-skeleton-make-directory dir parents (tramp-barf-unless-okay v (format "%s -m %#o %s" - (if parents "mkdir -p" "mkdir") - (default-file-modes) + "mkdir" (default-file-modes) (tramp-shell-quote-argument localname)) "Couldn't make directory %s" dir))) @@ -2584,14 +2491,10 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (setq filename (expand-file-name (expand-file-name filename))) - (with-parsed-tramp-file-name filename nil - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (tramp-barf-unless-okay - v (format "rm -f %s" (tramp-shell-quote-argument localname)) - "Couldn't delete %s" filename)) - (tramp-flush-file-properties v localname))) + (tramp-skeleton-delete-file filename trash + (tramp-barf-unless-okay + v (format "rm -f %s" (tramp-shell-quote-argument localname)) + "Couldn't delete %s" filename))) ;; Dired. @@ -2705,9 +2608,9 @@ The method used must be an out-of-band method." (tramp-get-ls-command v) switches (if (or wildcard - (zerop (length - (tramp-run-real-handler - #'file-name-nondirectory (list localname))))) + (tramp-string-empty-or-nil-p + (tramp-run-real-handler + #'file-name-nondirectory (list localname)))) "" (tramp-shell-quote-argument (tramp-run-real-handler @@ -2742,8 +2645,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. @@ -2824,14 +2727,14 @@ the result will be a local, non-Tramp, file name." ;; If DIR is not given, use `default-directory' or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; On MS Windows, some special file names are not returned properly ;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified', ;; there could be the false positive "/:". (if (or (and (eq system-type 'windows-nt) (string-match-p - (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol))) - name)) + (rx bol (| (: alpha ":") (: (literal null-device) eol))) name)) (and (not (tramp-tramp-file-p name)) (not (tramp-tramp-file-p dir)))) (tramp-run-real-handler #'expand-file-name (list name dir)) @@ -2850,9 +2753,7 @@ the result will be a local, non-Tramp, file name." ;; supposed to find such a shell on the remote host. Please ;; tell me about it when this doesn't work on your system. (when (string-match - (tramp-compat-rx - bos "~" (group (* (not "/"))) (group (* nonl)) eos) - localname) + (rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -2862,7 +2763,7 @@ the result will be a local, non-Tramp, file name." ;; the default user name for tilde expansion is not ;; appropriate either, because ssh and companions might ;; use a user name from the config file. - (when (and (zerop (length uname)) + (when (and (tramp-string-empty-or-nil-p uname) (string-match-p (rx bos "su" (? "do") eos) method)) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) @@ -2963,7 +2864,7 @@ implementation will be used." (heredoc (and (not (bufferp stderr)) (stringp program) (string-match-p (rx "sh" eol) program) - (= (length args) 2) + (tramp-compat-length= args 2) (string-equal "-c" (car args)) ;; Don't if there is a quoted string. (not @@ -2973,7 +2874,7 @@ implementation will be used." ;; When PROGRAM is nil, we just provide a tty. (args (if (not heredoc) args (let ((i 250)) - (while (and (< i (length (cadr args))) + (while (and (not (tramp-compat-length< (cadr args) i)) (string-match " " (cadr args) i)) (setcdr args @@ -3089,13 +2990,20 @@ implementation will be used." (process-put p 'remote-pid pid) (tramp-set-connection-property p "remote-pid" pid)) - ;; Disable carriage return to newline - ;; translation. This does not work on - ;; macOS, see Bug#50748. - (when (and (memq connection-type '(nil pipe)) - (not - (tramp-check-remote-uname v "Darwin"))) - (tramp-send-command v "stty -icrnl")) + (when (memq connection-type '(nil pipe)) + ;; Disable carriage return to newline + ;; translation. This does not work on + ;; macOS, see Bug#50748. + ;; We must also disable buffering, + ;; otherwise strings larger than 4096 + ;; bytes, sent by the process, could + ;; block, see termios(3) and Bug#61341. + ;; FIXME: Shall we rather use "stty raw"? + (if (tramp-check-remote-uname v "Darwin") + (tramp-send-command + v "stty -icanon min 1 time 0") + (tramp-send-command + v "stty -icrnl -icanon min 1 time 0"))) ;; `tramp-maybe-open-connection' and ;; `tramp-send-command-and-read' could ;; have trashed the connection buffer. @@ -3196,8 +3104,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)))) @@ -3244,7 +3151,7 @@ implementation will be used." ;; Determine input. (if (null infile) (setq input (tramp-get-remote-null-device v)) - (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) + (setq infile (file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. (setq input (tramp-unquote-file-local-name infile)) @@ -3855,16 +3762,20 @@ Fall back to normal file name handler if no Tramp handler exists." "`%s' failed to start on remote host" (string-join sequence " ")) (tramp-message v 6 "Run `%s', %S" (string-join sequence " ") p) - (process-put p 'vector v) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and only if + ;; the respective options are set. Perhaps, the setting could + ;; be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) ;; Needed for process filter. - (process-put p 'events events) - (process-put p 'watch-name localname) + (process-put p 'tramp-events events) + (process-put p 'tramp-watch-name localname) (set-process-query-on-exit-flag p nil) (set-process-filter p filter) (set-process-sentinel p #'tramp-file-notify-process-sentinel) ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (unless (process-live-p p) (tramp-error p 'file-notify-error "Monitoring not supported for `%s'" file-name)) @@ -3872,10 +3783,10 @@ Fall back to normal file name handler if no Tramp handler exists." (defun tramp-sh-gio-monitor-process-filter (proc string) "Read output from \"gio monitor\" and add corresponding `file-notify' events." - (let ((events (process-get proc 'events)) + (let ((events (process-get proc 'tramp-events)) (remote-prefix (file-remote-p (tramp-get-default-directory (process-buffer proc)))) - (rest-string (process-get proc 'rest-string)) + (rest-string (process-get proc 'tramp-rest-string)) pos) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) @@ -3925,7 +3836,7 @@ Fall back to normal file name handler if no Tramp handler exists." (setq string (tramp-compat-string-replace "\n\n" "\n" string)) (while (string-match - (tramp-compat-rx + (rx bol (+ (not ":")) ":" blank (group (+ (not ":"))) ":" blank (group (regexp (regexp-opt tramp-gio-events))) @@ -3955,15 +3866,15 @@ Fall back to normal file name handler if no Tramp handler exists." ;; Save rest of the string. (while (string-match (rx bol "\n") string) (setq string (replace-match "" nil nil string))) - (when (zerop (length string)) (setq string nil)) + (when (string-empty-p string) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (process-put proc 'rest-string string))) + (process-put proc 'tramp-rest-string string))) (defun tramp-sh-inotifywait-process-filter (proc string) "Read output from \"inotifywait\" and add corresponding `file-notify' events." - (let ((events (process-get proc 'events))) + (let ((events (process-get proc 'tramp-events))) (tramp-message proc 6 "%S\n%s" proc string) - (dolist (line (split-string string "[\n\r]+" 'omit)) + (dolist (line (split-string string (rx (+ (any "\r\n"))) 'omit)) ;; Check, whether there is a problem. (unless (string-match (rx bol (+ (not blank)) (+ blank) (group (+ (not blank))) @@ -3980,7 +3891,8 @@ Fall back to normal file name handler if no Tramp handler exists." (tramp-compat-string-replace "_" "-" (downcase x)))) (split-string (match-string 1 line) "," 'omit)) (or (match-string 2 line) - (file-name-nondirectory (process-get proc 'watch-name)))))) + (file-name-nondirectory + (process-get proc 'tramp-watch-name)))))) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at ;; once. Therefore, we apply the handler directly. @@ -4028,66 +3940,55 @@ commands. \"%n\" is replaced by \"2>/dev/null\", and \"%t\" is replaced by a temporary file name. If VEC is nil, the respective local commands are used. If there is a format specifier which cannot be expanded, this function returns nil." - (if (not (string-match-p - (tramp-compat-rx (| bol (not "%")) "%" (any "ahlnoprsty")) script)) + (if (not (string-match-p (rx (| bol (not "%")) "%" (any "ahlnoprsty")) script)) script (catch 'wont-work - (let ((awk (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%a") script) + (let ((awk (when (string-match-p (rx (| bol (not "%")) "%a") script) (or (if vec (tramp-get-remote-awk vec) (executable-find "awk")) (throw 'wont-work nil)))) - (hdmp (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%h") script) + (hdmp (when (string-match-p (rx (| bol (not "%")) "%h") script) (or (if vec (tramp-get-remote-hexdump vec) (executable-find "hexdump")) (throw 'wont-work nil)))) - (dev (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%n") script) + (dev (when (string-match-p (rx (| bol (not "%")) "%n") script) (or (if vec (concat "2>" (tramp-get-remote-null-device vec)) (if (eq system-type 'windows-nt) "" (concat "2>" null-device))) (throw 'wont-work nil)))) - (ls (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%l") script) + (ls (when (string-match-p (rx (| bol (not "%")) "%l") script) (format "%s %s" (or (tramp-get-ls-command vec) (throw 'wont-work nil)) (tramp-sh--quoting-style-options vec)))) - (od (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%o") script) + (od (when (string-match-p (rx (| bol (not "%")) "%o") script) (or (if vec (tramp-get-remote-od vec) (executable-find "od")) (throw 'wont-work nil)))) - (perl (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%p") script) + (perl (when (string-match-p (rx (| bol (not "%")) "%p") script) (or (if vec (tramp-get-remote-perl vec) (executable-find "perl")) (throw 'wont-work nil)))) - (python (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%y") script) - (or - (if vec - (tramp-get-remote-python vec) - (executable-find "python")) - (throw 'wont-work nil)))) - (readlink (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%r") script) + (python (when (string-match-p (rx (| bol (not "%")) "%y") script) + (or + (if vec + (tramp-get-remote-python vec) + (executable-find "python")) + (throw 'wont-work nil)))) + (readlink (when (string-match-p (rx (| bol (not "%")) "%r") script) (or (if vec - (tramp-get-remote-readlink vec) - (executable-find "readlink")) - (throw 'wont-work nil)))) - (stat (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%s") script) + (tramp-get-remote-readlink vec) + (executable-find "readlink")) + (throw 'wont-work nil)))) + (stat (when (string-match-p (rx (| bol (not "%")) "%s") script) (or (if vec (tramp-get-remote-stat vec) (executable-find "stat")) (throw 'wont-work nil)))) - (tmp (when (string-match-p - (tramp-compat-rx (| bol (not "%")) "%t") script) + (tmp (when (string-match-p (rx (| bol (not "%")) "%t") script) (or (if vec (tramp-file-local-name (tramp-make-tramp-temp-name vec)) @@ -4126,17 +4027,14 @@ Only send the definition if it has not already been done." (tramp-set-connection-property (tramp-get-connection-process vec) "scripts" (cons name scripts)))))) -(defun tramp-run-test (switch filename) - "Run `test' on the remote system, given a SWITCH and a FILENAME. +(defun tramp-run-test (vec switch localname) + "Run `test' on the remote system VEC, given a SWITCH and a LOCALNAME. Returns the exit code of the `test' program." - (with-parsed-tramp-file-name filename nil - (tramp-send-command-and-check - v - (format - "%s %s %s" - (tramp-get-test-command v) - switch - (tramp-shell-quote-argument localname))))) + (tramp-send-command-and-check + vec + (format + "%s %s %s" + (tramp-get-test-command vec) switch (tramp-shell-quote-argument localname)))) (defun tramp-find-executable (vec progname dirlist &optional ignore-tilde ignore-path) @@ -4211,7 +4109,7 @@ variable PATH." 'noerror))) tmpfile chunk chunksize) (tramp-message vec 5 "Setting $PATH environment variable") - (if (< (length command) pipe-buf) + (if (tramp-compat-length< command pipe-buf) (tramp-send-command vec command) ;; Use a temporary file. We cannot use `write-region' because ;; setting the remote path happens in the early connection @@ -4348,8 +4246,7 @@ file exists and nonzero exit status otherwise." "Couldn't find remote shell prompt for %s" shell) (unless (tramp-check-for-regexp - (tramp-get-connection-process vec) - (tramp-compat-rx (literal tramp-end-of-output))) + (tramp-get-connection-process vec) (rx (literal tramp-end-of-output))) (tramp-wait-for-output (tramp-get-connection-process vec)) (tramp-message vec 5 "Setting shell prompt") (tramp-send-command @@ -4390,8 +4287,7 @@ file exists and nonzero exit status otherwise." (tramp-send-command vec (format "echo ~%s" tramp-root-id-string) t) (if (or (string-match-p - (tramp-compat-rx - bol "~" (literal tramp-root-id-string) eol) + (rx bol "~" (literal tramp-root-id-string) eol) (buffer-string)) ;; The default shell (ksh93) of OpenSolaris ;; and Solaris is buggy. We've got reports @@ -4426,11 +4322,11 @@ file exists and nonzero exit status otherwise." "Wait for shell prompt and barf if none appears. Looks at process PROC to see if a shell prompt appears in TIMEOUT seconds. If not, it produces an error message with the given ERROR-ARGS." - (let ((vec (process-get proc 'vector))) + (let ((vec (process-get proc 'tramp-vector))) (condition-case nil (tramp-wait-for-regexp proc timeout - (tramp-compat-rx + (rx (| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern)) eos)) (error @@ -4602,7 +4498,7 @@ process to set up. VEC specifies the connection." ;; Set `remote-tty' process property. (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) - (unless (zerop (length tty)) + (unless (string-empty-p tty) (process-put proc 'remote-tty tty) (tramp-set-connection-property proc "remote-tty" tty))) @@ -4817,7 +4713,7 @@ Goes through the list `tramp-local-coding-commands' and (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) - (unless (looking-at-p (tramp-compat-rx (literal magic))) + (unless (looking-at-p (rx (literal magic))) (throw 'wont-work-remote nil))) ;; `rem-enc' and `rem-dec' could be a string meanwhile. @@ -4903,7 +4799,7 @@ Goes through the list `tramp-inline-compress-commands'." nil t)) (throw 'next nil)) (goto-char (point-min)) - (unless (looking-at-p (tramp-compat-rx (literal magic))) + (unless (looking-at-p (rx (literal magic))) (throw 'next nil))) (tramp-message vec 5 @@ -4914,7 +4810,7 @@ Goes through the list `tramp-inline-compress-commands'." (throw 'next nil)) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (unless (looking-at-p (tramp-compat-rx (literal magic))) + (unless (looking-at-p (rx (literal magic))) (throw 'next nil))) (setq found t))) @@ -4936,49 +4832,55 @@ 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 ;; No options to be computed. - ((or (null tramp-use-ssh-controlmaster-options) + ((or (null tramp-use-connection-share) (null (assoc "%c" (tramp-get-method-parameter vec 'tramp-login-args)))) "") + ;; Use plink option. + ((string-match-p + (rx "plink" (? ".exe") eol) + (tramp-get-method-parameter vec 'tramp-login-program)) + (if (eq tramp-use-connection-share 'suppress) + "-noshare" "-share")) + ;; There is already a value to be used. - ((stringp tramp-ssh-controlmaster-options) tramp-ssh-controlmaster-options) + ((and (eq tramp-use-connection-share 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-connection-share 'suppress) + "no" "auto") + + " -o ControlPath=" + (if (eq tramp-use-connection-share '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-connection-share '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." @@ -5063,7 +4965,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))))) @@ -5082,11 +4984,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 @@ -5175,7 +5077,7 @@ connection if a previous connection has died for some reason." (unless (process-live-p p) (with-tramp-progress-reporter vec 3 - (if (zerop (length (tramp-file-name-user vec))) + (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) (format "Opening connection %s for %s using %s" process-name (tramp-file-name-host vec) @@ -5232,7 +5134,11 @@ connection if a previous connection has died for some reason." ;; Set sentinel and query flag. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, + ;; the setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (setq tramp-current-connection (cons vec (current-time))) @@ -5259,7 +5165,7 @@ connection if a previous connection has died for some reason." (tramp-get-method-parameter hop 'tramp-remote-shell)) (extra-args (tramp-get-sh-extra-args remote-shell)) (async-args - (tramp-compat-flatten-tree + (flatten-tree (tramp-get-method-parameter hop 'tramp-async-args))) (connection-timeout (tramp-get-method-parameter @@ -5310,8 +5216,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'. @@ -5403,7 +5308,7 @@ function waits for output unless NOOUTPUT is set." ;; Busyboxes built with the EDITING_ASK_TERMINAL config ;; option send also escape sequences, which must be ;; ignored. - (regexp (tramp-compat-rx + (regexp (rx (* (not (any "#$\n"))) (literal tramp-end-of-output) (? (regexp tramp-device-escape-sequence-regexp)) @@ -5411,7 +5316,7 @@ function waits for output unless NOOUTPUT is set." ;; Sometimes, the commands do not return a newline but a ;; null byte before the shell prompt, for example "git ;; ls-files -c -z ...". - (regexp1 (tramp-compat-rx (| bol "\000") (regexp regexp))) + (regexp1 (rx (| bol "\000") (regexp regexp))) (found (tramp-wait-for-regexp proc timeout regexp1))) (if found (let ((inhibit-read-only t)) @@ -5451,8 +5356,7 @@ the exit status." (let (cmd data) (if (and (stringp command) (string-match - (tramp-compat-rx - (* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl)) + (rx (* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl)) command)) (setq cmd (match-string 0 command) data (substring command (match-end 0))) @@ -5549,7 +5453,7 @@ raises an error." (cond ((tramp-get-method-parameter vec 'tramp-remote-copy-program) localname) - ((zerop (length user)) (format "%s:%s" host localname)) + ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname)) (t (format "%s@%s:%s" user host localname))))) (defun tramp-method-out-of-band-p (vec size) @@ -5613,16 +5517,14 @@ 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)) - 'noerror (tramp-compat-rx (literal tramp-end-of-heredoc))) + 'noerror (rx (literal tramp-end-of-heredoc))) (progn (tramp-message vec 2 "Could not retrieve `tramp-own-remote-path'") @@ -5672,8 +5574,7 @@ Nonexistent directories are removed from spec." (while candidates (goto-char (point-min)) (if (string-match-p - (tramp-compat-rx bol (literal (car candidates)) (? "\r") eol) - (buffer-string)) + (rx bol (literal (car candidates)) (? "\r") eol) (buffer-string)) (setq locale (car candidates) candidates nil) (setq candidates (cdr candidates))))) @@ -5751,7 +5652,7 @@ Nonexistent directories are removed from spec." vec (format "( %s / -nt / )" (tramp-get-test-command vec))) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (when (looking-at-p (tramp-compat-rx (literal tramp-end-of-output))) + (when (looking-at-p (rx (literal tramp-end-of-output))) (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) (progn (tramp-send-command @@ -5834,14 +5735,6 @@ Nonexistent directories are removed from spec." vec (format "%s --canonicalize-missing /" result))) result)))) -(defun tramp-get-remote-trash (vec) - "Determine remote `trash' command. -This command is returned only if `delete-by-moving-to-trash' is non-nil." - (and delete-by-moving-to-trash - (with-tramp-connection-property vec "trash" - (tramp-message vec 5 "Finding a suitable `trash' command") - (tramp-find-executable vec "trash" (tramp-get-remote-path vec))))) - (defun tramp-get-remote-touch (vec) "Determine remote `touch' command." (with-tramp-connection-property vec "touch" diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index cad6cb335cc..740841c24db 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -53,7 +53,7 @@ ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-default-user-alist - `(,(tramp-compat-rx bos (literal tramp-smb-method) eos) nil nil)) + `(,(rx bos (literal tramp-smb-method) eos) nil nil)) ;; Add completion function for SMB method. (tramp-set-completion-function @@ -92,9 +92,9 @@ this variable \"client min protocol=NT1\"." "Version string of the SMB client.") (defconst tramp-smb-server-version - (tramp-compat-rx "Domain=[" (* (not "]")) "] " - "OS=[" (* (not "]")) "] " - "Server=[" (* (not "]")) "]") + (rx "Domain=[" (* (not "]")) "] " + "OS=[" (* (not "]")) "] " + "Server=[" (* (not "]")) "]") "Regexp of SMB server identification.") (defconst tramp-smb-prompt @@ -269,6 +269,7 @@ See `tramp-actions-before-shell' for more info.") (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-smb-handle-file-system-info) (file-truename . tramp-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) (file-writable-p . tramp-smb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. @@ -487,9 +488,9 @@ arguments to pass to the OPERATION." (args (list (concat "//" host "/" share) "-E")) (options tramp-smb-options)) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (if (tramp-string-empty-or-nil-p user) + (setq args (append args (list "-N"))) + (setq args (append args (list "-U" user)))) (when domain (setq args (append args (list "-W" domain)))) (when port (setq args (append args (list "-p" port)))) @@ -558,7 +559,7 @@ arguments to pass to the OPERATION." (tramp-message v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) + (process-put p 'tramp-vector v) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -695,31 +696,25 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (setq filename (expand-file-name filename)) - (when (file-exists-p filename) - (with-parsed-tramp-file-name filename nil - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (unless (tramp-smb-send-command - v (format - "%s %s" - (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm") - (tramp-smb-shell-quote-localname v))) - ;; Error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (search-forward-regexp tramp-smb-errors nil t) - (tramp-error v 'file-error "%s `%s'" (match-string 0) filename))))))) + (tramp-skeleton-delete-file filename trash + (unless (tramp-smb-send-command + v (format + "%s %s" + (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm") + (tramp-smb-shell-quote-localname v))) + ;; Error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (search-forward-regexp tramp-smb-errors nil t) + (tramp-error v 'file-error "%s `%s'" (match-string 0) filename))))) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -730,12 +725,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (with-parsed-tramp-file-name name nil ;; Tilde expansion if necessary. (when (string-match - (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) - localname) + (rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (when (tramp-string-empty-or-nil-p uname) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -789,9 +783,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (args (list (concat "//" host "/" share) "-E")) (options tramp-smb-options)) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (if (tramp-string-empty-or-nil-p user) + (setq args (append args (list "-N"))) + (setq args (append args (list "-U" user)))) (when domain (setq args (append args (list "-W" domain)))) (when port (setq args (append args (list "-p" port)))) @@ -826,7 +820,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-message v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) + (process-put p 'tramp-vector v) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-get-acl) @@ -982,18 +976,20 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; files. (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (delete-dups - (mapcar - (lambda (x) - (list - (if (tramp-compat-string-search "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory))))))) + (ignore-error file-missing + (all-completions + filename + (when (file-directory-p directory) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (delete-dups + (mapcar + (lambda (x) + (list + (if (tramp-compat-string-search "d" (nth 1 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + (tramp-smb-get-file-entries directory))))))))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -1079,12 +1075,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq entries (delq nil - (if (or wildcard (zerop (length base))) + (if (or wildcard (string-empty-p base)) ;; Check for matching entries. (mapcar (lambda (x) - (when (string-match-p - (tramp-compat-rx bol (literal base)) (nth 0 x)) + (when (string-match-p (rx bol (literal base)) (nth 0 x)) x)) entries) ;; We just need the only and only entry FILENAME. @@ -1105,7 +1100,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when (tramp-compat-string-search "F" switches) (mapc (lambda (x) - (unless (zerop (length (car x))) + (unless (string-empty-p (car x)) (cond ((char-equal ?d (string-to-char (nth 1 x))) (setcar x (concat (car x) "/"))) @@ -1125,7 +1120,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Print entries. (mapc (lambda (x) - (unless (zerop (length (nth 0 x))) + (unless (string-empty-p (nth 0 x)) (let ((attr (when (tramp-smb-get-stat-capability v) (ignore-errors @@ -1172,98 +1167,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (directory-file-name (expand-file-name dir))) - (unless (file-name-absolute-p dir) - (setq dir (expand-file-name dir default-directory))) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) - (let* ((ldir (file-name-directory dir))) - ;; Make missing directory parts. - (when (and parents - (tramp-smb-get-share v) - (not (file-directory-p ldir))) - (make-directory ldir parents)) - ;; Just do it. - (when (file-directory-p ldir) - (tramp-smb-send-command - v (if (tramp-smb-get-cifs-capabilities v) - (format "posix_mkdir %s %o" - (tramp-smb-shell-quote-localname v) (default-file-modes)) - (format "mkdir %s" (tramp-smb-shell-quote-localname v)))) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname)) - (unless (file-directory-p dir) - (tramp-error v 'file-error "Couldn't make directory %s" dir))))) - -;; This is not used anymore. -(defun tramp-smb-handle-make-directory-internal (directory) - "Like `make-directory-internal' for Tramp files." - (declare (obsolete nil "29.1")) - (setq directory (directory-file-name (expand-file-name directory))) - (unless (file-name-absolute-p directory) - (setq directory (expand-file-name directory default-directory))) - (with-parsed-tramp-file-name directory nil - (when (file-directory-p (file-name-directory directory)) - (tramp-smb-send-command - v (if (tramp-smb-get-cifs-capabilities v) - (format "posix_mkdir %s %o" - (tramp-smb-shell-quote-localname v) (default-file-modes)) - (format "mkdir %s" (tramp-smb-shell-quote-localname v)))) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname)) - (unless (file-directory-p directory) - (tramp-error v 'file-error "Couldn't make directory %s" directory)))) + (tramp-skeleton-make-directory dir parents + (tramp-smb-send-command + v (if (tramp-smb-get-cifs-capabilities v) + (format "posix_mkdir %s %o" + (tramp-smb-shell-quote-localname v) (default-file-modes)) + (format "mkdir %s" (tramp-smb-shell-quote-localname v)))) + (unless (file-directory-p dir) + (tramp-error v 'file-error "Couldn't make directory %s" dir)))) (defun tramp-smb-handle-make-symbolic-link - (target linkname &optional ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files. -If TARGET is a non-Tramp file, it is used verbatim as the target -of the symlink. If TARGET is a Tramp file, only the localname -component is used as the target of the symlink." - (with-parsed-tramp-file-name linkname nil - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (let ((non-essential t)) - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link - (tramp-compat-file-name-quote target 'top) - linkname ok-if-already-exists) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway?" - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (unless (tramp-smb-get-cifs-capabilities v) - (tramp-error v 'file-error "make-symbolic-link not supported")) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - - (unless (tramp-smb-send-command - v (format "symlink %s %s" - (tramp-smb-shell-quote-argument target) - (tramp-smb-shell-quote-localname v))) - (tramp-error - v 'file-error - "error with make-symbolic-link, see buffer `%s' for details" - (tramp-get-connection-buffer v)))))) + (target linkname &optional ok-if-already-exists) + "Like `make-symbolic-link' for Tramp files." + (let ((v (tramp-dissect-file-name (expand-file-name linkname)))) + (unless (tramp-smb-get-cifs-capabilities v) + (tramp-error v 'file-error "make-symbolic-link not supported"))) + + (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists + (unless (tramp-smb-send-command + v (format "symlink %s %s" + (tramp-smb-shell-quote-argument target) + (tramp-smb-shell-quote-localname v))) + (tramp-error + v 'file-error + "error with make-symbolic-link, see buffer `%s' for details" + (tramp-get-connection-buffer v))))) (defun tramp-smb-handle-process-file (program &optional infile destination display &rest args) @@ -1280,7 +1208,7 @@ component is used as the target of the symlink." ;; Determine input. (when infile - (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) + (setq infile (file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. (setq input (tramp-unquote-file-local-name infile)) @@ -1455,9 +1383,9 @@ component is used as the target of the symlink." "\n" "," acl-string))) (options tramp-smb-options)) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (if (tramp-string-empty-or-nil-p user) + (setq args (append args (list "-N"))) + (setq args (append args (list "-U" user)))) (when domain (setq args (append args (list "-W" domain)))) (when port (setq args (append args (list "-p" port)))) @@ -1493,7 +1421,7 @@ component is used as the target of the symlink." (tramp-message v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) + (process-put p 'tramp-vector v) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-set-acl) @@ -1588,7 +1516,7 @@ component is used as the target of the symlink." \"//\" substitutes only in the local filename part. Catches errors for shares like \"C$/\", which are common in Microsoft Windows." ;; Check, whether the local part is a quoted file name. - (if (tramp-compat-file-name-quoted-p filename) + (if (file-name-quoted-p filename) filename (with-parsed-tramp-file-name filename nil ;; Ignore in LOCALNAME everything before "//". @@ -1607,7 +1535,7 @@ If USER is a string, return its home directory instead of the user identified by VEC. If there is no user specified in either VEC or USER, or if there is no home directory, return nil." (let ((user (or user (tramp-file-name-user vec)))) - (unless (zerop (length user)) + (unless (tramp-string-empty-or-nil-p user) (concat "/" user)))) (defun tramp-smb-handle-write-region @@ -1639,8 +1567,7 @@ VEC or USER, or if there is no home directory, return nil." "Return the share name of LOCALNAME." (save-match-data (let ((localname (tramp-file-name-unquote-localname vec))) - (when (string-match - (tramp-compat-rx bol (? "/") (group (+ (not "/"))) "/") localname) + (when (string-match (rx bol (? "/") (group (+ (not "/"))) "/") localname) (match-string 1 localname))))) (defun tramp-smb-get-localname (vec) @@ -1651,8 +1578,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (setq localname (if (string-match - (tramp-compat-rx bol (? "/") (+ (not "/")) (group "/" (* nonl))) - localname) + (rx bol (? "/") (+ (not "/")) (group "/" (* nonl))) localname) ;; There is a share, separated by "/". (if (not (tramp-smb-get-cifs-capabilities vec)) (mapconcat @@ -1660,8 +1586,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (match-string 1 localname) "") (match-string 1 localname)) ;; There is just a share. - (if (string-match - (tramp-compat-rx bol (? "/") (group (+ (not "/"))) eol) localname) + (if (string-match (rx bol (? "/") (group (+ (not "/"))) eol) localname) (match-string 1 localname) ""))) @@ -1789,8 +1714,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (if (not share) ;; Read share entries. - (when (string-match - (tramp-compat-rx bol "Disk|" (group (+ (not "|"))) "|") line) + (when (string-match (rx bol "Disk|" (group (+ (not "|"))) "|") line) (setq localname (match-string 1 line) mode "dr-xr-xr-x" size 0)) @@ -1956,7 +1880,7 @@ If ARGUMENT is non-nil, use it as argument for (setq tramp-smb-version (shell-command-to-string command)) (tramp-message vec 6 command) (tramp-message vec 6 "\n%s" tramp-smb-version) - (if (string-match (rx (+ (any " \t\n\r")) eos) tramp-smb-version) + (if (string-match (rx (+ (any " \t\r\n")) eos) tramp-smb-version) (setq tramp-smb-version (replace-match "" nil nil tramp-smb-version)))) @@ -2009,9 +1933,9 @@ If ARGUMENT is non-nil, use it as argument for (t (setq args (list "-g" "-L" host )))) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (if (tramp-string-empty-or-nil-p user) + (setq args (append args (list "-N"))) + (setq args (append args (list "-U" user)))) (when domain (setq args (append args (list "-W" domain)))) (when port (setq args (append args (list "-p" port)))) @@ -2026,7 +1950,8 @@ If ARGUMENT is non-nil, use it as argument for (with-tramp-progress-reporter vec 3 (format "Opening connection for //%s%s/%s" - (if (not (zerop (length user))) (concat user "@") "") + (if (tramp-string-empty-or-nil-p user) + "" (concat user "@")) host (or share "")) (let* (coding-system-for-read @@ -2044,7 +1969,7 @@ If ARGUMENT is non-nil, use it as argument for args)))) (tramp-message vec 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -2098,7 +2023,7 @@ Removes smb prompt. Returns nil if an error message has appeared." ;; Read pending output. (while (not (re-search-forward tramp-smb-prompt nil t)) - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (goto-char (point-min))) (tramp-message vec 6 "\n%s" (buffer-string)) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 2d3c436632f..6b788c00ba6 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -124,6 +124,7 @@ (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-sshfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) (file-writable-p . tramp-sshfs-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. @@ -228,8 +229,7 @@ arguments to pass to the OPERATION." (defun tramp-sshfs-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." - ;;`file-system-info' exists since Emacs 27.1. - (tramp-compat-funcall 'file-system-info (tramp-fuse-local-file-name filename))) + (file-system-info (tramp-fuse-local-file-name filename))) (defun tramp-sshfs-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -266,7 +266,7 @@ arguments to pass to the OPERATION." ;; Determine input. (if (null infile) (setq input (tramp-get-remote-null-device v)) - (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) + (setq infile (file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. (setq input (tramp-unquote-file-local-name infile)) @@ -399,7 +399,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 88dacdc7893..defd4f430bc 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -49,7 +49,7 @@ (tramp-password-previous-hop t))) (add-to-list 'tramp-default-user-alist - `(,(tramp-compat-rx bos (literal tramp-sudoedit-method) eos) + `(,(rx bos (literal tramp-sudoedit-method) eos) nil ,tramp-root-id-string)) (tramp-set-completion-function @@ -114,6 +114,7 @@ See `tramp-actions-before-shell' for more info.") (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-sudoedit-handle-file-system-info) (file-truename . tramp-sudoedit-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) (file-writable-p . tramp-sudoedit-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. @@ -212,8 +213,8 @@ arguments to pass to the OPERATION." (unless (tramp-sudoedit-send-command v1 "ln" - (tramp-compat-file-name-unquote v1-localname) - (tramp-compat-file-name-unquote v2-localname)) + (file-name-unquote v1-localname) + (file-name-unquote v2-localname)) (tramp-error v1 'file-error "error with add-name-to-file, see buffer `%s' for details" @@ -342,22 +343,19 @@ absolute file names." (tramp-skeleton-delete-directory directory recursive trash (unless (tramp-sudoedit-send-command v (if recursive '("rm" "-rf") "rmdir") - (tramp-compat-file-name-unquote localname)) + (file-name-unquote localname)) (tramp-error v 'file-error "Couldn't delete %s" directory)))) (defun tramp-sudoedit-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-flush-file-properties v localname) - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (unless (tramp-sudoedit-send-command - v "rm" "-f" (tramp-compat-file-name-unquote localname)) - ;; Propagate the error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (tramp-error-with-buffer - nil v 'file-error "Couldn't delete %s" filename)))))) + (tramp-skeleton-delete-file filename trash + (unless (tramp-sudoedit-send-command + v "rm" "-f" (file-name-unquote localname)) + ;; Propagate the error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (tramp-error-with-buffer + nil v 'file-error "Couldn't delete %s" filename))))) (defun tramp-sudoedit-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files. @@ -366,7 +364,8 @@ the result will be a local, non-Tramp, file name." ;; If DIR is not given, use `default-directory' or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -377,17 +376,16 @@ the result will be a local, non-Tramp, file name." ;; Tilde expansion if necessary. We cannot accept "~/", because ;; under sudo "~/" is expanded to the local user home directory ;; but to the root home directory. - (when (zerop (length localname)) + (when (tramp-string-empty-or-nil-p localname) (setq localname "~")) (unless (file-name-absolute-p localname) (setq localname (format "~%s/%s" user localname))) (when (string-match - (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) - localname) + (rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (when (tramp-string-empty-or-nil-p uname) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -413,7 +411,7 @@ the result will be a local, non-Tramp, file name." (let ((result (and (tramp-sudoedit-remote-acl-p v) (tramp-sudoedit-send-command-string v "getfacl" "-acp" - (tramp-compat-file-name-unquote localname))))) + (file-name-unquote localname))))) ;; The acl string must have a trailing \n, which is not ;; provided by `tramp-sudoedit-send-command-string'. Add it. (and (stringp result) (concat result "\n")))))) @@ -440,8 +438,7 @@ the result will be a local, non-Tramp, file name." (tramp-convert-file-attributes v localname id-format (tramp-sudoedit-send-command-and-read v "env" "QUOTING_STYLE=locale" "stat" "-c" - tramp-sudoedit-file-attributes - (tramp-compat-file-name-unquote localname))))) + tramp-sudoedit-file-attributes (file-name-unquote localname))))) (defun tramp-sudoedit-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." @@ -453,43 +450,37 @@ the result will be a local, non-Tramp, file name." (or (tramp-check-cached-permissions v ?x) (tramp-check-cached-permissions v ?s)) (tramp-sudoedit-send-command - v "test" "-x" (tramp-compat-file-name-unquote localname)))))) + v "test" "-x" (file-name-unquote localname)))))) (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" (tramp-compat-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." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (tramp-sudoedit-send-command - v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" - (if (zerop (length localname)) - "" (tramp-compat-file-name-unquote localname))) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (delq - nil + (ignore-error file-missing + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (tramp-sudoedit-send-command + v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" + (if (tramp-string-empty-or-nil-p localname) + "" (file-name-unquote localname))) (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string - (tramp-get-buffer-string (tramp-get-connection-buffer v)) - "\n" 'omit)))))))) + (lambda (f) + (if (ignore-errors (file-directory-p (expand-file-name f directory))) + (file-name-as-directory f) + f)) + (delq + nil + (mapcar + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string + (tramp-get-buffer-string (tramp-get-connection-buffer v)) + "\n" 'omit))))))))) (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -500,7 +491,7 @@ the result will be a local, non-Tramp, file name." (if (tramp-file-property-p v localname "file-attributes") (tramp-handle-file-readable-p filename) (tramp-sudoedit-send-command - v "test" "-r" (tramp-compat-file-name-unquote localname)))))) + v "test" "-r" (file-name-unquote localname)))))) (defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." @@ -508,8 +499,7 @@ the result will be a local, non-Tramp, file name." (unless (and (eq flag 'nofollow) (file-symlink-p filename)) (tramp-skeleton-set-file-modes-times-uid-gid filename (unless (tramp-sudoedit-send-command - v "chmod" (format "%o" mode) - (tramp-compat-file-name-unquote localname)) + v "chmod" (format "%o" mode) (file-name-unquote localname)) (tramp-error v 'file-error "Error while changing file's mode %s" filename))))) @@ -523,15 +513,14 @@ the result will be a local, non-Tramp, file name." (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (tramp-compat-rx + (regexp (rx (group (+ (any "_" alnum))) ":" (group (+ (any "_" alnum))) ":" (group (+ (any "_" alnum))) ":" (group (+ (any "_" alnum)))))) (when (and (tramp-sudoedit-remote-selinux-p v) (tramp-sudoedit-send-command - v "ls" "-d" "-Z" - (tramp-compat-file-name-unquote localname))) + v "ls" "-d" "-Z" (file-name-unquote localname))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (when (re-search-forward regexp (line-end-position) t) @@ -547,7 +536,7 @@ the result will be a local, non-Tramp, file name." (tramp-message v 5 "file system info: %s" localname) (when (tramp-sudoedit-send-command v "df" "--block-size=1" "--output=size,used,avail" - (tramp-compat-file-name-unquote localname)) + (file-name-unquote localname)) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (forward-line) @@ -565,48 +554,17 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-set-file-times (filename &optional time flag) "Like `set-file-times' for Tramp files." (tramp-skeleton-set-file-modes-times-uid-gid filename - (let ((time - (if (or (null time) - (tramp-compat-time-equal-p time tramp-time-doesnt-exist) - (tramp-compat-time-equal-p time tramp-time-dont-know)) - nil - time))) - (tramp-sudoedit-send-command - v "env" "TZ=UTC0" "touch" "-t" - (format-time-string "%Y%m%d%H%M.%S" time t) - (if (eq flag 'nofollow) "-h" "") - (tramp-compat-file-name-unquote localname))))) + (tramp-sudoedit-send-command + v "env" "TZ=UTC0" "touch" "-t" + (format-time-string "%Y%m%d%H%M.%S" (tramp-defined-time time) t) + (if (eq flag 'nofollow) "-h" "") + (file-name-unquote localname)))) (defun tramp-sudoedit-handle-file-truename (filename) "Like `file-truename' for Tramp files." - ;; Preserve trailing "/". - (funcall - (if (directory-name-p filename) #'file-name-as-directory #'identity) - ;; Quote properly. - (funcall - (if (tramp-compat-file-name-quoted-p filename) - #'tramp-compat-file-name-quote #'identity) - (with-parsed-tramp-file-name - (tramp-compat-file-name-unquote (expand-file-name filename)) nil - (tramp-make-tramp-file-name - v - (with-tramp-file-property v localname "file-truename" - (let (result) - (tramp-message v 4 "Finding true name for `%s'" filename) - (setq result (tramp-sudoedit-send-command-string - v "readlink" "--canonicalize-missing" localname)) - ;; Detect cycle. - (when (and (file-symlink-p filename) - (string-equal result localname)) - (tramp-error - v 'file-error - "Apparent cycle of symbolic links for %s" filename)) - ;; If the resulting localname looks remote, we must quote it - ;; for security reasons. - (when (file-remote-p result) - (setq result (tramp-compat-file-name-quote result 'top))) - (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result))))))) + (tramp-skeleton-file-truename filename + (tramp-sudoedit-send-command-string + v "readlink" "--canonicalize-missing" localname))) (defun tramp-sudoedit-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -618,7 +576,7 @@ the result will be a local, non-Tramp, file name." ;; be satisfied without remote operation. (tramp-check-cached-permissions v ?w) (tramp-sudoedit-send-command - v "test" "-w" (tramp-compat-file-name-unquote localname))) + v "test" "-w" (file-name-unquote localname))) ;; If file doesn't exist, check if directory is writable. (and (file-directory-p (file-name-directory filename)) @@ -626,59 +584,20 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (expand-file-name dir)) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) - ;; When PARENTS is non-nil, DIR could be a chain of non-existent - ;; directories a/b/c/... Instead of checking, we simply flush the - ;; whole cache. - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))) + (tramp-skeleton-make-directory dir parents (unless (tramp-sudoedit-send-command - v (if parents '("mkdir" "-p") "mkdir") - "-m" (format "%#o" (default-file-modes)) - (tramp-compat-file-name-unquote localname)) + v "mkdir" "-m" (format "%#o" (default-file-modes)) + (file-name-unquote localname)) (tramp-error v 'file-error "Couldn't make directory %s" dir)))) (defun tramp-sudoedit-handle-make-symbolic-link (target linkname &optional ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files. -If TARGET is a non-Tramp file, it is used verbatim as the target -of the symlink. If TARGET is a Tramp file, only the localname -component is used as the target of the symlink." - (with-parsed-tramp-file-name (expand-file-name linkname) nil - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (let ((non-essential t)) - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link - (tramp-compat-file-name-quote target 'top) - linkname ok-if-already-exists) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not - (yes-or-no-p - (format - "File %s already exists; make it a link anyway?" - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (tramp-flush-file-properties v localname) - (tramp-sudoedit-send-command - v "ln" "-sf" - (tramp-compat-file-name-unquote target) - (tramp-compat-file-name-unquote localname))))) + "Like `make-symbolic-link' for Tramp files." + (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists + (tramp-sudoedit-send-command + v "ln" "-sf" + (file-name-unquote target) + (file-name-unquote localname)))) (defun tramp-sudoedit-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -702,8 +621,7 @@ component is used as the target of the symlink." (setq acl-string (string-join (split-string acl-string "\n" 'omit) ",")) (prog1 (tramp-sudoedit-send-command - v "setfacl" "-m" - acl-string (tramp-compat-file-name-unquote localname)) + v "setfacl" "-m" acl-string (file-name-unquote localname)) (tramp-flush-file-property v localname "file-acl"))))) (defun tramp-sudoedit-handle-set-file-selinux-context (filename context) @@ -721,7 +639,7 @@ component is used as the target of the symlink." (when role (format "--role=%s" role)) (when type (format "--type=%s" type)) (when range (format "--range=%s" range)) - (tramp-compat-file-name-unquote localname)) + (file-name-unquote localname)) (if (and user role type range) (tramp-set-file-property v localname "file-selinux-context" context) @@ -774,7 +692,7 @@ ID-FORMAT valid values are `string' and `integer'." "Check, whether a sudo process has finished. Remove unneeded output." ;; There might be pending output for the exit status. (unless (process-live-p proc) - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) ;; Delete narrowed region, it would be in the way reading a Lisp form. (goto-char (point-min)) (widen) @@ -802,7 +720,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. @@ -829,7 +747,7 @@ in case of error, t otherwise." vec 'tramp-sudo-login ?h (or (tramp-file-name-host vec) "") ?u (or (tramp-file-name-user vec) "")) - (tramp-compat-flatten-tree args)))) + (flatten-tree args)))) ;; We suppress the messages `Waiting for prompts from remote shell'. (tramp-verbose (if (= tramp-verbose 3) 2 tramp-verbose)) ;; The password shall be cached also in case of "emacs -Q". @@ -840,7 +758,7 @@ in case of error, t otherwise." (tramp-message vec 6 "%s" (string-join (process-command p) " ")) ;; Avoid process status message in output buffer. (set-process-sentinel p #'ignore) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 123d01c747d..6eff5b2ca60 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -82,6 +82,7 @@ (progn (defvar tramp--startup-hook nil "Forms to be executed at the end of tramp.el.") + (put 'tramp--startup-hook 'tramp-suppress-trace t) (defmacro tramp--with-startup (&rest body) @@ -440,12 +441,12 @@ 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 -\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'. - -This variable is regarded as obsolete, and will be removed soon." +\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'." :type '(choice (const nil) string)) ;;;###tramp-autoload @@ -525,7 +526,7 @@ interpreted as a regular expression which always matches." (defcustom tramp-restricted-shell-hosts-alist (when (and (eq system-type 'windows-nt) (not (string-match-p (rx "sh" eol) tramp-encoding-shell))) - (list (tramp-compat-rx + (list (rx bos (| (literal (downcase tramp-system-name)) (literal (upcase tramp-system-name))) eos))) @@ -539,7 +540,7 @@ host runs a restricted shell, it shall be added to this list, too." ;;;###tramp-autoload (defcustom tramp-local-host-regexp - (tramp-compat-rx + (rx bos (| (literal tramp-system-name) (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1")) @@ -640,10 +641,11 @@ This regexp must match both `tramp-initial-end-of-output' and :type 'regexp) (defcustom tramp-password-prompt-regexp - (tramp-compat-rx - bol (* nonl) - (group (regexp (regexp-opt password-word-equivalents))) - (* nonl) ":" (? "\^@") (* 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. @@ -653,20 +655,19 @@ usually more convenient to add new passphrases to that variable instead of altering this variable. The `sudo' program appears to insert a `^@' character into the prompt." - :version "24.4" + :version "29.1" :type 'regexp) (defcustom tramp-wrong-passwd-regexp (rx bol (* nonl) (| "Permission denied" - "Login [Ii]ncorrect" - "Connection refused" - "Connection closed" "Timeout, server not responding." "Sorry, try again." "Name or service not known" "Host key verification failed." "No supported authentication methods left to try!" + (: "Login " (| "Incorrect" "incorrect")) + (: "Connection " (| "refused" "closed")) (: "Received signal " (+ digit))) (* nonl)) "Regexp matching a `login failed' message. @@ -684,7 +685,7 @@ See also `tramp-yn-prompt-regexp'." :type 'regexp) (defcustom tramp-yn-prompt-regexp - (rx (| "Store key in cache? (y/n)" + (rx (| (: "Store key in cache? (y/n" (* nonl) ")") "Update cached key? (y/n, Return cancels connection)") (* blank)) "Regular expression matching all y/n queries which need to be confirmed. @@ -724,7 +725,8 @@ The regexp should match at end of buffer." ;; A security key requires the user physically to touch the device ;; with their finger. We must tell it to the user. -;; Added in OpenSSH 8.2. I've tested it with yubikey. +;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey, +;; which has also passed the tests, does not show such a message. (defcustom tramp-security-key-confirm-regexp (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) "Regular expression matching security key confirmation message. @@ -789,6 +791,7 @@ It shall be used in combination with `generate-new-buffer-name'.") (defvar tramp-temp-buffer-file-name nil "File name of a persistent local temporary file. Useful for \"rsync\" like methods.") + (make-variable-buffer-local 'tramp-temp-buffer-file-name) (put 'tramp-temp-buffer-file-name 'permanent-local t) @@ -899,18 +902,17 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-regexp () "Return `tramp-prefix-regexp'." - (tramp-compat-rx bol (literal (tramp-build-prefix-format)))) + (rx bol (literal (tramp-build-prefix-format)))) (defvar tramp-prefix-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching the very beginning of Tramp file names. Should always start with \"^\". Derived from `tramp-prefix-format'.") (defconst tramp-method-regexp-alist - `((default . ,(tramp-compat-rx - (| (literal tramp-default-method-marker) (>= 2 alnum)))) + `((default . ,(rx (| (literal tramp-default-method-marker) (>= 2 alnum)))) (simplified . "") - (separate . ,(tramp-compat-rx - (? (| (literal tramp-default-method-marker) (>= 2 alnum)))))) + (separate + . ,(rx (? (| (literal tramp-default-method-marker) (>= 2 alnum)))))) "Alist mapping Tramp syntax to regexps matching methods identifiers.") (defun tramp-build-method-regexp () @@ -938,7 +940,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-method-regexp () "Return `tramp-postfix-method-regexp'." - (tramp-compat-rx (literal (tramp-build-postfix-method-format)))) + (rx (literal (tramp-build-postfix-method-format)))) (defvar tramp-postfix-method-regexp nil ; Init'd when defining `tramp-syntax'! "Regexp matching delimiter between method and user or host names. @@ -950,8 +952,7 @@ Derived from `tramp-postfix-method-format'.") (defconst tramp-prefix-domain-format "%" "String matching delimiter between user and domain names.") -(defconst tramp-prefix-domain-regexp - (tramp-compat-rx (literal tramp-prefix-domain-format)) +(defconst tramp-prefix-domain-regexp (rx (literal tramp-prefix-domain-format)) "Regexp matching delimiter between user and domain names. Derived from `tramp-prefix-domain-format'.") @@ -959,7 +960,7 @@ Derived from `tramp-prefix-domain-format'.") "Regexp matching domain names.") (defconst tramp-user-with-domain-regexp - (tramp-compat-rx + (rx (group (regexp tramp-user-regexp)) (regexp tramp-prefix-domain-regexp) (group (regexp tramp-domain-regexp))) @@ -969,8 +970,7 @@ Derived from `tramp-prefix-domain-format'.") "String matching delimiter between user and host names. Used in `tramp-make-tramp-file-name'.") -(defconst tramp-postfix-user-regexp - (tramp-compat-rx (literal tramp-postfix-user-format)) +(defconst tramp-postfix-user-regexp (rx (literal tramp-postfix-user-format)) "Regexp matching delimiter between user and host names. Derived from `tramp-postfix-user-format'.") @@ -993,7 +993,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-ipv6-regexp () "Return `tramp-prefix-ipv6-regexp'." - (tramp-compat-rx (literal tramp-prefix-ipv6-format))) + (rx (literal tramp-prefix-ipv6-format))) (defvar tramp-prefix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching left hand side of IPv6 addresses. @@ -1021,7 +1021,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-ipv6-regexp () "Return `tramp-postfix-ipv6-regexp'." - (tramp-compat-rx (literal tramp-postfix-ipv6-format))) + (rx (literal tramp-postfix-ipv6-format))) (defvar tramp-postfix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching right hand side of IPv6 addresses. @@ -1030,8 +1030,7 @@ Derived from `tramp-postfix-ipv6-format'.") (defconst tramp-prefix-port-format "#" "String matching delimiter between host names and port numbers.") -(defconst tramp-prefix-port-regexp - (tramp-compat-rx (literal tramp-prefix-port-format)) +(defconst tramp-prefix-port-regexp (rx (literal tramp-prefix-port-format)) "Regexp matching delimiter between host names and port numbers. Derived from `tramp-prefix-port-format'.") @@ -1039,7 +1038,7 @@ Derived from `tramp-prefix-port-format'.") "Regexp matching port numbers.") (defconst tramp-host-with-port-regexp - (tramp-compat-rx + (rx (group (regexp tramp-host-regexp)) (regexp tramp-prefix-port-regexp) (group (regexp tramp-port-regexp))) @@ -1048,8 +1047,7 @@ Derived from `tramp-prefix-port-format'.") (defconst tramp-postfix-hop-format "|" "String matching delimiter after ad-hoc hop definitions.") -(defconst tramp-postfix-hop-regexp - (tramp-compat-rx (literal tramp-postfix-hop-format)) +(defconst tramp-postfix-hop-regexp (rx (literal tramp-postfix-hop-format)) "Regexp matching delimiter after ad-hoc hop definitions. Derived from `tramp-postfix-hop-format'.") @@ -1069,7 +1067,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-host-regexp () "Return `tramp-postfix-host-regexp'." - (tramp-compat-rx (literal tramp-postfix-host-format))) + (rx (literal tramp-postfix-host-format))) (defvar tramp-postfix-host-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching delimiter between host names and localnames. @@ -1096,7 +1094,7 @@ Derived from `tramp-postfix-host-format'.") (defun tramp-build-remote-file-name-spec-regexp () "Construct a regexp matching a Tramp file name for a Tramp syntax. It is expected, that `tramp-syntax' has the proper value." - (tramp-compat-rx + (rx ;; Method. (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) ;; Optional user. This includes domain. @@ -1118,7 +1116,7 @@ It is expected, that `tramp-syntax' has the proper value." It is expected, that `tramp-syntax' has the proper value. See `tramp-file-name-structure'." (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (? (group (+ (regexp tramp-remote-file-name-spec-regexp) (regexp tramp-postfix-hop-regexp)))) @@ -1178,11 +1176,9 @@ initial value is overwritten by the car of `tramp-file-name-structure'.") ;; `tramp-method-regexp' needs at least two characters, in order to ;; distinguish from volume letter. This is in the way when completing. (defconst tramp-completion-method-regexp-alist - `((default . ,(tramp-compat-rx - (| (literal tramp-default-method-marker) (+ alnum)))) + `((default . ,(rx (| (literal tramp-default-method-marker) (+ alnum)))) (simplified . "") - (separate . ,(tramp-compat-rx - (| (literal tramp-default-method-marker) (* alnum))))) + (separate . ,(rx (| (literal tramp-default-method-marker) (* alnum))))) "Alist mapping Tramp syntax to regexps matching completion methods.") (defun tramp-build-completion-method-regexp () @@ -1198,8 +1194,8 @@ The `ftp' syntax does not support methods.") "Return `tramp-completion-file-name-regexp' according to `tramp-syntax'." (if (eq tramp-syntax 'separate) ;; FIXME: This shouldn't be necessary. - (tramp-compat-rx bos "/" (? "[" (* (not "]"))) eos) - (tramp-compat-rx + (rx bos "/" (? "[" (* (not "]"))) eos) + (rx bos ;; `file-name-completion' uses absolute paths for matching. ;; This means that on W32 systems, something like @@ -1217,9 +1213,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 @@ -1372,7 +1371,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) @@ -1402,20 +1403,6 @@ based on the Tramp and Emacs versions, and should not be set here." :version "26.1" :type '(repeat string)) -(defcustom tramp-completion-reread-directory-timeout 10 - "Defines seconds since last remote command before rereading a directory. -A remote directory might have changed its contents. In order to -make it visible during file name completion in the minibuffer, -Tramp flushes its cache and rereads the directory contents when -more than `tramp-completion-reread-directory-timeout' seconds -have been gone since last remote command execution. A value of t -would require an immediate reread during filename completion, nil -means to use always cached values for the directory contents." - :type '(choice (const nil) (const t) integer)) -(make-obsolete-variable - 'tramp-completion-reread-directory-timeout - 'remote-file-name-inhibit-cache "27.2") - ;;; Internal Variables: (defvar tramp-current-connection nil @@ -1427,6 +1414,7 @@ the (optional) timestamp of last activity on this connection.") "Password save function. Will be called once the password has been verified by successful authentication.") + (put 'tramp-password-save-function 'tramp-suppress-trace t) (defvar tramp-password-prompt-not-unique nil @@ -1435,9 +1423,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 @@ -1525,8 +1517,7 @@ same connection. Make a copy in order to avoid side effects." (setq vec (copy-tramp-file-name vec)) (setf (tramp-file-name-localname vec) (and (stringp localname) - (tramp-compat-file-name-unquote - (directory-file-name localname))) + (file-name-unquote (directory-file-name localname))) (tramp-file-name-hop vec) nil)) vec)) @@ -1559,7 +1550,7 @@ entry does not exist, return nil." ;; The localname can be quoted with "/:". Extract this. (defun tramp-file-name-unquote-localname (vec) "Return unquoted localname component of VEC." - (tramp-compat-file-name-unquote (tramp-file-name-localname vec))) + (file-name-unquote (tramp-file-name-localname vec))) ;;;###tramp-autoload (defun tramp-tramp-file-p (name) @@ -1597,7 +1588,7 @@ of `process-file', `start-file-process', or `shell-command'." ;; The localname can be quoted with "/:". Extract this. (defun tramp-unquote-file-local-name (name) "Return unquoted localname of NAME." - (tramp-compat-file-name-unquote (tramp-file-local-name name))) + (file-name-unquote (tramp-file-local-name name))) (defun tramp-find-method (method user host) "Return the right method string to use depending on USER and HOST. @@ -1654,7 +1645,7 @@ This is USER, if non-nil. Otherwise, do a lookup in This is HOST, if non-nil. Otherwise, do a lookup in `tramp-default-host-alist' and `tramp-default-host'." (let ((result - (or (and (> (length host) 0) host) + (or (and (tramp-compat-length> host 0) host) (let ((choices tramp-default-host-alist) lhost item) (while choices @@ -1666,7 +1657,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in lhost) tramp-default-host))) ;; We must mark, whether a default value has been used. - (if (or (> (length host) 0) (null result)) + (if (or (tramp-compat-length> host 0) (null result)) result (propertize result 'tramp-default t)))) @@ -1729,7 +1720,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)) @@ -1759,7 +1749,7 @@ See `tramp-dissect-file-name' for details." (let ((v (tramp-dissect-file-name (concat tramp-prefix-format (replace-regexp-in-string - (tramp-compat-rx (regexp tramp-postfix-hop-regexp) eos) + (rx (regexp tramp-postfix-hop-regexp) eos) tramp-postfix-host-format name)) nodefault))) ;; Only some methods from tramp-sh.el do support multi-hops. @@ -1772,14 +1762,18 @@ See `tramp-dissect-file-name' for details." (put #'tramp-dissect-hop-name 'tramp-suppress-trace t) +(defsubst tramp-string-empty-or-nil-p (string) + "Check whether STRING is empty or nil." + (or (null string) (string= string ""))) + (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." (let ((method (tramp-file-name-method vec)) (user-domain (tramp-file-name-user-domain vec)) (host-port (tramp-file-name-host-port vec))) - (if (not (zerop (length user-domain))) - (format "*tramp/%s %s@%s*" method user-domain host-port) - (format "*tramp/%s %s*" method host-port)))) + (if (tramp-string-empty-or-nil-p user-domain) + (format "*tramp/%s %s*" method host-port) + (format "*tramp/%s %s@%s*" method user-domain host-port)))) (put #'tramp-buffer-name 'tramp-suppress-trace t) @@ -1824,23 +1818,23 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." hop (nth 6 args)))) ;; Unless `tramp-syntax' is `simplified', we need a method. - (when (and (not (zerop (length tramp-postfix-method-format))) - (zerop (length method))) + (when (and (not (string-empty-p tramp-postfix-method-format)) + (tramp-string-empty-or-nil-p method)) (signal 'wrong-type-argument (list #'stringp method))) (concat tramp-prefix-format hop - (unless (zerop (length tramp-postfix-method-format)) + (unless (string-empty-p tramp-postfix-method-format) (concat method tramp-postfix-method-format)) user - (unless (zerop (length domain)) + (unless (tramp-string-empty-or-nil-p domain) (concat tramp-prefix-domain-format domain)) - (unless (zerop (length user)) + (unless (tramp-string-empty-or-nil-p user) tramp-postfix-user-format) (when host (if (string-match-p tramp-ipv6-regexp host) (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) host)) - (unless (zerop (length port)) + (unless (tramp-string-empty-or-nil-p port) (concat tramp-prefix-port-format port)) tramp-postfix-host-format localname))) @@ -1855,8 +1849,7 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." (replace-regexp-in-string tramp-prefix-regexp "" (replace-regexp-in-string - (tramp-compat-rx - (regexp tramp-postfix-host-regexp) eos) + (rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format (tramp-make-tramp-file-name vec 'noloc))))) @@ -1865,12 +1858,12 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." It must not be a complete Tramp file name, but as long as there are necessary only. This function will be used in file name completion." (concat tramp-prefix-format - (unless (or (zerop (length method)) - (zerop (length tramp-postfix-method-format))) + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-postfix-method-format)) (concat method tramp-postfix-method-format)) - (unless (zerop (length user)) + (unless (tramp-string-empty-or-nil-p user) (concat user tramp-postfix-user-format)) - (unless (zerop (length host)) + (unless (tramp-string-empty-or-nil-p host) (concat (if (string-match-p tramp-ipv6-regexp host) (concat @@ -1917,7 +1910,7 @@ Return `tramp-cache-undefined' in case it doesn't exist." (or (and (tramp-file-name-p vec-or-proc) (get-buffer-process (tramp-buffer-name vec-or-proc))) (and (processp vec-or-proc) - (tramp-get-process (process-get vec-or-proc 'vector))) + (tramp-get-process (process-get vec-or-proc 'tramp-vector))) tramp-cache-undefined)) (defun tramp-get-connection-process (vec) @@ -1965,9 +1958,9 @@ of `current-buffer'." (let ((method (tramp-file-name-method vec)) (user-domain (tramp-file-name-user-domain vec)) (host-port (tramp-file-name-host-port vec))) - (if (not (zerop (length user-domain))) - (format "*debug tramp/%s %s@%s*" method user-domain host-port) - (format "*debug tramp/%s %s*" method host-port)))) + (if (tramp-string-empty-or-nil-p user-domain) + (format "*debug tramp/%s %s*" method host-port) + (format "*debug tramp/%s %s@%s*" method user-domain host-port)))) (put #'tramp-debug-buffer-name 'tramp-suppress-trace t) @@ -1986,7 +1979,7 @@ of `current-buffer'." ;; Also, in `font-lock-defaults' you can specify a function name for ;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords! '(list - (tramp-compat-rx bol (regexp tramp-debug-outline-regexp) (+ nonl)) + (rx bol (regexp tramp-debug-outline-regexp) (+ nonl)) '(1 font-lock-warning-face t t) '(0 (outline-font-lock-face) keep t)) "Used for highlighting Tramp debug buffers in `outline-mode'.") @@ -2197,7 +2190,7 @@ applicable)." vec-or-proc 'dont-create)))))))) ;; Translate proc to vec. (when (processp vec-or-proc) - (setq vec-or-proc (process-get vec-or-proc 'vector)))) + (setq vec-or-proc (process-get vec-or-proc 'tramp-vector)))) ;; Do it. (when (tramp-file-name-p vec-or-proc) (apply #'tramp-debug-message @@ -2320,12 +2313,12 @@ the resulting error message." (progn ,@body) (error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) -;; This macro shall optimize the cases where an `file-exists-p' call -;; is invoked first. Often, the file exists, so the remote command is +;; This macro shall optimize the cases where a `file-exists-p' call is +;; invoked first. Often, the file exists, so the remote command is ;; superfluous. (defmacro tramp-barf-if-file-missing (vec filename &rest body) "Execute BODY and return the result. -In case if an error, raise a `file-missing' error if FILENAME +In case of an error, raise a `file-missing' error if FILENAME does not exist, otherwise propagate the error." (declare (indent 2) (debug (symbolp form body))) (let ((err (make-symbol "err"))) @@ -2400,7 +2393,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (let* ((parameters (cdr reporter)) (message (aref parameters 3))) (when (tramp-compat-string-search message (or (current-message) "")) - (tramp-compat-progress-reporter-update reporter value suffix)))) + (progress-reporter-update reporter value suffix)))) (defmacro with-tramp-progress-reporter (vec level message &rest body) "Execute BODY, spinning a progress reporter with MESSAGE in interactive mode. @@ -2438,13 +2431,12 @@ locally on a remote file name. When the local system is a W32 system but the remote system is Unix, this introduces a superfluous drive letter into the file name. This function removes it." (save-match-data - (let ((quoted (tramp-compat-file-name-quoted-p name 'top)) - (result (tramp-compat-file-name-unquote name 'top))) + (let ((quoted (file-name-quoted-p name 'top)) + (result (file-name-unquote name 'top))) (setq result (replace-regexp-in-string - (tramp-compat-rx (regexp tramp-volume-letter-regexp) "/") - "/" result)) - (if quoted (tramp-compat-file-name-quote result 'top) result)))) + (rx (regexp tramp-volume-letter-regexp) "/") "/" result)) + (if quoted (file-name-quote result 'top) result)))) ;;; Config Manipulation Functions: @@ -2478,13 +2470,14 @@ Example: (setcdr v (delete (car v) (cdr v)))) ;; Check for function and file or registry key. (unless (and (functionp (nth 0 (car v))) + (stringp (nth 1 (car v))) (cond ;; Windows registry. ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v))) (and (memq system-type '(cygwin windows-nt)) (zerop (tramp-call-process - v "reg" nil nil nil "query" (nth 1 (car v)))))) + nil "reg" nil nil nil "query" (nth 1 (car v)))))) ;; DNS-SD service type. ((string-match-p tramp-dns-sd-service-regexp (nth 1 (car v)))) @@ -2552,7 +2545,7 @@ coding system might not be determined. This function repairs it." ;; We found a matching entry in `file-coding-system-alist'. ;; So we add a similar entry, but with the temporary file name ;; as regexp. - (push (cons (tramp-compat-rx (literal tmpname)) (cdr elt)) result))))) + (push (cons (rx (literal tmpname)) (cdr elt)) result))))) (defun tramp-run-real-handler (operation args) "Invoke normal file name handler for OPERATION. @@ -2602,15 +2595,13 @@ Must be handled by the callers." file-name-nondirectory file-name-sans-versions file-notify-add-watch file-ownership-preserved-p file-readable-p file-regular-p file-remote-p - file-selinux-context file-symlink-p file-truename - file-writable-p find-backup-file-name get-file-buffer - insert-directory insert-file-contents load - make-directory set-file-acl set-file-modes + file-selinux-context file-symlink-p file-system-info + file-truename file-writable-p find-backup-file-name + get-file-buffer insert-directory insert-file-contents + load make-directory set-file-acl set-file-modes set-file-selinux-context set-file-times substitute-in-file-name unhandled-file-name-directory vc-registered - ;; Emacs 27+ only. - file-system-info ;; Emacs 28- only. make-directory-internal ;; Emacs 28+ only. @@ -2653,12 +2644,12 @@ Must be handled by the callers." (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) ;; COMMAND. ((member operation - '(make-nearby-temp-file process-file shell-command - start-file-process temporary-file-directory - ;; Emacs 27+ only. - exec-path make-process + '(exec-path make-nearby-temp-file make-process process-file + shell-command start-file-process temporary-file-directory ;; Emacs 29+ only. - list-system-processes memory-info process-attributes)) + list-system-processes memory-info process-attributes + ;; Emacs 30+ only. + file-user-uid)) default-directory) ;; PROC. ((member operation '(file-notify-rm-watch file-notify-valid-p)) @@ -2789,7 +2780,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))) @@ -2837,7 +2828,7 @@ remote file names." #'file-name-sans-extension (directory-files dir nil (rx bos "tramp" (+ nonl) ".el" (? "c") eos))))) - (files-regexp (tramp-compat-rx bol (regexp (regexp-opt files)) eol))) + (files-regexp (rx bol (regexp (regexp-opt files)) eol))) (mapatoms (lambda (atom) (when (and (functionp atom) @@ -2874,7 +2865,7 @@ remote file names." (put #'tramp-completion-file-name-handler 'operations (mapcar #'car tramp-completion-file-name-handler-alist)) - ;; Integrated in Emacs 27. + ;; After unloading, `tramp-archive-enabled' might not be defined. (when (bound-and-true-p tramp-archive-enabled) (add-to-list 'file-name-handler-alist (cons tramp-archive-file-name-regexp @@ -2959,9 +2950,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 @@ -2972,10 +3030,10 @@ not in completion mode." (tramp-drop-volume-letter (expand-file-name filename directory))) ;; When `tramp-syntax' is `simplified', we need a default method. (tramp-default-method - (and (zerop (length tramp-postfix-method-format)) + (and (string-empty-p tramp-postfix-method-format) tramp-default-method)) (tramp-default-method-alist - (and (zerop (length tramp-postfix-method-format)) + (and (string-empty-p tramp-postfix-method-format) tramp-default-method-alist)) tramp-default-user tramp-default-user-alist tramp-default-host tramp-default-host-alist @@ -2983,7 +3041,7 @@ not in completion mode." ;; Suppress hop from completion. (when (string-match - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (+ (regexp tramp-remote-file-name-spec-regexp) (regexp tramp-postfix-hop-regexp)))) @@ -3035,11 +3093,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 @@ -3076,14 +3135,14 @@ They are collected by `tramp-completion-dissect-file-name1'." (let (;; "/method" "/[method" (tramp-completion-file-name-structure1 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (? (regexp tramp-completion-method-regexp))) eol) 1 nil nil nil)) ;; "/method:user" "/[method/user" (tramp-completion-file-name-structure2 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3092,7 +3151,7 @@ They are collected by `tramp-completion-dissect-file-name1'." ;; "/method:host" "/[method/host" (tramp-completion-file-name-structure3 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3101,7 +3160,7 @@ They are collected by `tramp-completion-dissect-file-name1'." ;; "/method:[ipv6" "/[method/ipv6" (tramp-completion-file-name-structure4 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3111,7 +3170,7 @@ They are collected by `tramp-completion-dissect-file-name1'." ;; "/method:user@host" "/[method/user@host" (tramp-completion-file-name-structure5 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3122,7 +3181,7 @@ They are collected by `tramp-completion-dissect-file-name1'." ;; "/method:user@[ipv6" "/[method/user@ipv6" (tramp-completion-file-name-structure6 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3197,6 +3256,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' @@ -3255,7 +3353,7 @@ Either user or host may be nil." Either user or host may be nil." (let (result (regexp - (tramp-compat-rx + (rx bol (group (regexp tramp-host-regexp)) (? (+ blank) (group (regexp tramp-user-regexp)))))) (when (re-search-forward regexp (line-end-position) t) @@ -3271,8 +3369,7 @@ User is always nil." (defun tramp-parse-shosts-group () "Return a (user host) tuple allowed to access. User is always nil." - (tramp-parse-group - (tramp-compat-rx bol (group (regexp tramp-host-regexp))) 1 ",")) + (tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ",")) (defun tramp-parse-sconfig (filename) "Return a list of (user host) tuples allowed to access. @@ -3283,7 +3380,7 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (tramp-compat-rx + (rx (| (: bol (* blank) "Host") (: bol (+ nonl)) ;; ??? (group (regexp tramp-host-regexp)))) @@ -3308,15 +3405,14 @@ User is always nil." User is always nil." (tramp-parse-shostkeys-sknownhosts dirname - (tramp-compat-rx - bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol))) + (rx bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol))) (defun tramp-parse-sknownhosts (dirname) "Return a list of (user host) tuples allowed to access. User is always nil." (tramp-parse-shostkeys-sknownhosts dirname - (tramp-compat-rx + (rx bol (group (regexp tramp-host-regexp)) ".ssh-" (| "dss" "rsa") ".pub" eol))) (defun tramp-parse-hosts (filename) @@ -3328,8 +3424,7 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (tramp-compat-rx - bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) + (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) 1 (rx blank))) (defun tramp-parse-passwd (filename) @@ -3348,7 +3443,7 @@ Host is always \"localhost\"." "Return a (user host) tuple allowed to access. Host is always \"localhost\"." (let (result - (regexp (tramp-compat-rx bol (group (regexp tramp-user-regexp)) ":"))) + (regexp (rx bol (group (regexp tramp-user-regexp)) ":"))) (when (re-search-forward regexp (line-end-position) t) (setq result (list (match-string 1) "localhost"))) (forward-line 1) @@ -3399,14 +3494,13 @@ User is always nil." (tramp-parse-putty-group registry-or-dirname))))) ;; UNIX case. (tramp-parse-shostkeys-sknownhosts - registry-or-dirname - (tramp-compat-rx bol (group (regexp tramp-host-regexp)) eol)))) + registry-or-dirname (rx bol (group (regexp tramp-host-regexp)) eol)))) (defun tramp-parse-putty-group (registry) "Return a (user host) tuple allowed to access. User is always nil." (let (result - (regexp (tramp-compat-rx (literal registry) "\\" (group (+ nonl))))) + (regexp (rx (literal registry) "\\" (group (+ nonl))))) (when (re-search-forward regexp (line-end-position) t) (setq result (list nil (match-string 1)))) (forward-line 1) @@ -3433,15 +3527,35 @@ BODY is the backend specific code." BODY is the backend specific code." (declare (indent 3) (debug t)) `(with-parsed-tramp-file-name (expand-file-name ,directory) nil - (if (and delete-by-moving-to-trash ,trash) - ;; Move non-empty dir to trash only if recursive deletion was - ;; requested. - (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) - (tramp-error - v 'file-error "Directory is not empty, not moving to trash") - (move-file-to-trash ,directory)) - ,@body) - (tramp-flush-directory-properties v localname))) + (let ((delete-by-moving-to-trash + (and delete-by-moving-to-trash + ;; This variable exists since Emacs 30.1. + (not (bound-and-true-p + remote-file-name-inhibit-delete-by-moving-to-trash))))) + (if (and delete-by-moving-to-trash ,trash) + ;; Move non-empty dir to trash only if recursive deletion was + ;; requested. + (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) + (tramp-error + v 'file-error "Directory is not empty, not moving to trash") + (move-file-to-trash ,directory)) + ,@body) + (tramp-flush-directory-properties v localname)))) + +(defmacro tramp-skeleton-delete-file (filename &optional trash &rest body) + "Skeleton for `tramp-*-handle-delete-file'. +BODY is the backend specific code." + (declare (indent 2) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,filename) nil + (let ((delete-by-moving-to-trash + (and delete-by-moving-to-trash + ;; This variable exists since Emacs 30.1. + (not (bound-and-true-p + remote-file-name-inhibit-delete-by-moving-to-trash))))) + (if (and delete-by-moving-to-trash ,trash) + (move-file-to-trash ,filename) + ,@body) + (tramp-flush-file-properties v localname)))) (defmacro tramp-skeleton-directory-files (directory &optional full match nosort count &rest body) @@ -3522,6 +3636,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." @@ -3537,6 +3670,99 @@ BODY is the backend specific code." ;; Trigger the `file-missing' error. (signal 'error nil))))) +(defmacro tramp-skeleton-file-truename (filename &rest body) + "Skeleton for `tramp-*-handle-file-truename'. +BODY is the backend specific code." + (declare (indent 1) (debug (form body))) + ;; Preserve trailing "/". + `(funcall + (if (directory-name-p ,filename) #'file-name-as-directory #'identity) + ;; Quote properly. + (funcall + (if (file-name-quoted-p ,filename) #'file-name-quote #'identity) + (with-parsed-tramp-file-name + (file-name-unquote (expand-file-name ,filename)) nil + (tramp-make-tramp-file-name + v + (with-tramp-file-property v localname "file-truename" + (let (result) + (setq result (progn ,@body)) + ;; Detect cycle. + (when (and (file-symlink-p ,filename) + (string-equal result localname)) + (tramp-error + v 'file-error + "Apparent cycle of symbolic links for %s" ,filename)) + ;; If the resulting localname looks remote, we must quote + ;; it for security reasons. + (when (file-remote-p result) + (setq result (file-name-quote result 'top))) + result))))))) + +(defmacro tramp-skeleton-make-directory (dir &optional parents &rest body) + "Skeleton for `tramp-*-handle-make-directory'. +BODY is the backend specific code." + ;; Since Emacs 29.1, PARENTS isn't propagated to the handlers + ;; anymore. And the return values are specified since then as well. + (declare (indent 2) (debug t)) + `(let* ((dir (directory-file-name (expand-file-name ,dir))) + (par (file-name-directory dir))) + (with-parsed-tramp-file-name dir nil + (when (and (null ,parents) (file-exists-p dir)) + (tramp-error v 'file-already-exists dir)) + ;; Make missing directory parts. + (when ,parents + (unless (file-directory-p par) + (make-directory par ,parents))) + ;; Just do it. + (if (file-exists-p dir) t + (tramp-flush-file-properties v localname) + ,@body + nil)))) + +(defmacro tramp-skeleton-handle-make-symbolic-link + (target linkname &optional ok-if-already-exists &rest body) + "Skeleton for `tramp-*-handle-make-symbolic-link'. +BODY is the backend specific code. +If TARGET is a non-Tramp file, it is used verbatim as the target +of the symlink. If TARGET is a Tramp file, only the localname +component is used as the target of the symlink if it is located +on the same host. Otherwise, TARGET is quoted." + (declare (indent 3) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,linkname) nil + ;; If TARGET is a Tramp name, use just the localname component. + ;; Don't check for a proper method. + (let ((non-essential t)) + (when (and (tramp-tramp-file-p ,target) + (tramp-file-name-equal-p v (tramp-dissect-file-name ,target))) + (setq ,target (tramp-file-local-name (expand-file-name ,target)))) + ;; There could be a cyclic link. + (tramp-flush-file-properties + v (expand-file-name ,target (tramp-file-local-name default-directory)))) + + ;; If TARGET is still remote, quote it. + (if (tramp-tramp-file-p ,target) + (make-symbolic-link + (file-name-quote ,target 'top) ,linkname ,ok-if-already-exists) + + ;; Do the 'confirm if exists' thing. + (when (file-exists-p ,linkname) + ;; What to do? + (if (or (null ,ok-if-already-exists) ; not allowed to exist + (and (numberp ,ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway?" + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file ,linkname))) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + + ,@body))) + (defmacro tramp-skeleton-set-file-modes-times-uid-gid (filename &rest body) "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'. @@ -3703,6 +3929,15 @@ Let-bind it when necessary.") vec (concat "~" (substring filename (match-beginning 1)))) (tramp-make-tramp-file-name (tramp-dissect-file-name filename))))) +(defun tramp-handle-file-user-uid () + "Like `user-uid' for Tramp files." + (let ((v (tramp-dissect-file-name default-directory))) + (or (tramp-get-remote-uid v 'integer) + ;; Some handlers for `tramp-get-remote-uid' return nil if they + ;; can't get the UID; always return -1 in this case for + ;; consistency. + -1))) + (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." (setq filename (file-truename filename)) @@ -3761,7 +3996,7 @@ Let-bind it when necessary.") ;; Otherwise, remove any trailing slash from localname component. ;; Method, host, etc, are unchanged. (while (with-parsed-tramp-file-name directory nil - (and (not (zerop (length localname))) + (and (tramp-compat-length> localname 0) (eq (aref localname (1- (length localname))) ?/) (not (string= localname "/")))) (setq directory (substring directory 0 -1))) @@ -3792,7 +4027,8 @@ Let-bind it when necessary.") ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -3807,12 +4043,11 @@ Let-bind it when necessary.") ;; not support tilde expansion. But users could declare a ;; respective connection property. (Bug#53847) (when (string-match - (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) - localname) + (rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (when (tramp-string-empty-or-nil-p uname) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -3841,9 +4076,10 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." ;; `file-truename' could raise an error, for example due to a cyclic - ;; symlink. - (ignore-errors - (eq (file-attribute-type (file-attributes (file-truename filename))) t))) + ;; symlink. We don't protect this despite it, because other errors + ;; might be worth to be visible, for example impossibility to mount + ;; in tramp-gvfs.el. + (eq (file-attribute-type (file-attributes (file-truename filename))) t)) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equalp-p' for Tramp files." @@ -3856,13 +4092,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." @@ -3895,7 +4126,7 @@ Let-bind it when necessary.") ;; Run the command on the localname portion only unless we are in ;; completion mode. (tramp-make-tramp-file-name - v (or (and (zerop (length (tramp-file-name-localname v))) + v (or (and (tramp-string-empty-or-nil-p (tramp-file-name-localname v)) (not (tramp-connectable-p file))) (tramp-run-real-handler #'file-name-as-directory @@ -3958,7 +4189,8 @@ Let-bind it when necessary.") ;; "." and ".." are never interesting as completions, and are ;; actually in the way in a directory with only one file. See ;; file_name_completion() in dired.c. - (when (and (consp fnac) (= (length (delete "./" (delete "../" fnac))) 1)) + (when (and (consp fnac) + (tramp-compat-length= (delete "./" (delete "../" fnac)) 1)) (setq fnac (delete "./" (delete "../" fnac)))) (or (try-completion @@ -3969,9 +4201,7 @@ Let-bind it when necessary.") (and completion-ignored-extensions (string-match-p - (tramp-compat-rx - (regexp (regexp-opt completion-ignored-extensions)) eos) - x) + (rx (regexp (regexp-opt completion-ignored-extensions)) eos) x) ;; We remember the hit. (push x hits-ignored-extensions)))))) ;; No match. So we try again for ignored files. @@ -4002,18 +4232,11 @@ Let-bind it when necessary.") ((not (file-exists-p file2)) t) ;; Tramp reads and writes timestamps on second level. So we round ;; the timestamps to seconds without fractions. - ;; `time-convert' has been introduced with Emacs 27.1. - ((fboundp 'time-convert) - (time-less-p - (tramp-compat-funcall - 'time-convert - (file-attribute-modification-time (file-attributes file2)) 'integer) - (tramp-compat-funcall - 'time-convert - (file-attribute-modification-time (file-attributes file1)) 'integer))) (t (time-less-p - (file-attribute-modification-time (file-attributes file2)) - (file-attribute-modification-time (file-attributes file1)))))) + (time-convert + (file-attribute-modification-time (file-attributes file2)) 'integer) + (time-convert + (file-attribute-modification-time (file-attributes file1)) 'integer))))) (defun tramp-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -4077,14 +4300,8 @@ Let-bind it when necessary.") (defun tramp-handle-file-truename (filename) "Like `file-truename' for Tramp files." - ;; Preserve trailing "/". - (funcall - (if (directory-name-p filename) #'file-name-as-directory #'identity) - ;; Quote properly. - (funcall - (if (tramp-compat-file-name-quoted-p filename) - #'tramp-compat-file-name-quote #'identity) - (let ((result (tramp-compat-file-name-unquote (expand-file-name filename))) + (tramp-skeleton-file-truename filename + (let ((result (directory-file-name localname)) (numchase 0) ;; Don't make the following value larger than necessary. ;; People expect an error message in a timely fashion when @@ -4094,31 +4311,21 @@ Let-bind it when necessary.") ;; Unquoting could enable encryption. tramp-crypt-enabled symlink-target) - (with-parsed-tramp-file-name result v1 - ;; We cache only the localname. - (tramp-make-tramp-file-name - v1 - (with-tramp-file-property v1 v1-localname "file-truename" - (while (and (setq symlink-target (file-symlink-p result)) - (< numchase numchase-limit)) - (setq numchase (1+ numchase) - result - (with-parsed-tramp-file-name (expand-file-name result) v2 - (tramp-make-tramp-file-name - v2 - (if (stringp symlink-target) - (if (file-remote-p symlink-target) - (tramp-compat-file-name-quote symlink-target 'top) - (tramp-drop-volume-letter - (expand-file-name - symlink-target - (file-name-directory v2-localname)))) - v2-localname)))) - (when (>= numchase numchase-limit) - (tramp-error - v1 'file-error - "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (tramp-file-local-name (directory-file-name result))))))))) + (while (and (setq symlink-target + (file-symlink-p (tramp-make-tramp-file-name v result))) + (< numchase numchase-limit)) + (setq numchase (1+ numchase) + result + (if (file-remote-p symlink-target) + (file-name-quote symlink-target 'top) + (tramp-drop-volume-letter + (expand-file-name + symlink-target (file-name-directory result))))) + (when (>= numchase numchase-limit) + (tramp-error + v 'file-error + "Maximum number (%d) of symlinks exceeded" numchase-limit))) + (directory-file-name result)))) (defun tramp-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -4341,8 +4548,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" @@ -4418,53 +4624,49 @@ Parsing the remote \"ps\" output is controlled by It is not guaranteed, that all process attributes as described in `process-attributes' are returned. The additional attribute `pid' shall be returned always." - ;; Since Emacs 27.1. - (when (fboundp 'connection-local-criteria-for-default-directory) - (with-tramp-file-property vec "/" "process-attributes" - (ignore-errors - (with-temp-buffer - (hack-connection-local-variables-apply - (connection-local-criteria-for-default-directory)) - ;; (pop-to-buffer (current-buffer)) - (when (zerop - (apply - #'process-file - "ps" nil t nil tramp-process-attributes-ps-args)) - (let (result res) - (goto-char (point-min)) - (while (not (eobp)) - ;; (tramp-test-message - ;; "%s" (buffer-substring (point) (line-end-position))) - (when (save-excursion - (search-forward-regexp - (rx digit) (line-end-position) 'noerror)) - (setq res nil) - (dolist (elt tramp-process-attributes-ps-format) - (push - (cons - (car elt) - (cond - ((eq (cdr elt) 'number) (read (current-buffer))) - ((eq (cdr elt) 'string) - (search-forward-regexp (rx (+ (not blank)))) - (match-string 0)) - ((numberp (cdr elt)) - (search-forward-regexp (rx (+ blank))) - (search-forward-regexp - (rx (+ nonl)) (+ (point) (cdr elt))) - (string-trim (match-string 0))) - ((fboundp (cdr elt)) - (funcall (cdr elt))) - ((null (cdr elt)) - (search-forward-regexp (rx (+ blank))) - (buffer-substring (point) (line-end-position))))) - res)) - ;; `nice' could be `-'. - (setq res (rassq-delete-all '- res)) - (push (append res) result)) - (forward-line)) - ;; Return result. - result))))))) + (with-tramp-file-property vec "/" "process-attributes" + (ignore-errors + (with-temp-buffer + (hack-connection-local-variables-apply + (connection-local-criteria-for-default-directory)) + ;; (pop-to-buffer (current-buffer)) + (when (zerop + (apply + #'process-file "ps" nil t nil tramp-process-attributes-ps-args)) + (let (result res) + (goto-char (point-min)) + (while (not (eobp)) + ;; (tramp-test-message + ;; "%s" (buffer-substring (point) (line-end-position))) + (when (save-excursion + (search-forward-regexp + (rx digit) (line-end-position) 'noerror)) + (setq res nil) + (dolist (elt tramp-process-attributes-ps-format) + (push + (cons + (car elt) + (cond + ((eq (cdr elt) 'number) (read (current-buffer))) + ((eq (cdr elt) 'string) + (search-forward-regexp (rx (+ (not blank)))) + (match-string 0)) + ((numberp (cdr elt)) + (search-forward-regexp (rx (+ blank))) + (search-forward-regexp (rx (+ nonl)) (+ (point) (cdr elt))) + (string-trim (match-string 0))) + ((fboundp (cdr elt)) + (funcall (cdr elt))) + ((null (cdr elt)) + (search-forward-regexp (rx (+ blank))) + (buffer-substring (point) (line-end-position))))) + res)) + ;; `nice' could be `-'. + (setq res (rassq-delete-all '- res)) + (push (append res) result)) + (forward-line)) + ;; Return result. + result)))))) (defun tramp-handle-list-system-processes () "Like `list-system-processes' for Tramp files." @@ -4579,11 +4781,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." @@ -4625,9 +4836,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") tramp-prefix-format proxy tramp-postfix-host-format)) (entry (list (and (stringp host-port) - (tramp-compat-rx bol (literal host-port) eol)) + (rx bol (literal host-port) eol)) (and (stringp user-domain) - (tramp-compat-rx bol (literal user-domain) eol)) + (rx bol (literal user-domain) eol)) (propertize proxy 'tramp-ad-hoc t)))) (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry) ;; Add the hop. @@ -4700,14 +4911,14 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (or ;; The host name is used for the remote shell command. (member - "%h" (tramp-compat-flatten-tree + "%h" (flatten-tree (tramp-get-method-parameter item 'tramp-login-args))) ;; The host name must match previous hop. (string-match-p previous-host host)) (setq tramp-default-proxies-alist saved-tdpa) (tramp-user-error vec "Host name `%s' does not match `%s'" host previous-host)) - (setq previous-host (tramp-compat-rx bol (literal host) eol))))) + (setq previous-host (rx bol (literal host) eol))))) ;; Result. target-alist)) @@ -4721,7 +4932,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (let ((args (tramp-get-method-parameter vec parameter)) (spec (apply 'format-spec-make spec-list))) ;; Expand format spec. - (tramp-compat-flatten-tree + (flatten-tree (mapcar (lambda (x) (setq x (mapcar (lambda (y) (format-spec y spec)) x)) @@ -4739,7 +4950,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (tramp-get-connection-property v "direct-async-process") ;; There's no multi-hop. (or (not (tramp-multi-hop-p v)) - (= (length (tramp-compute-multi-hops v)) 1)) + (null (cdr (tramp-compute-multi-hops v)))) ;; There's no remote stdout or stderr file. (or (not (stringp buffer)) (not (tramp-tramp-file-p buffer))) (or (not (stringp stderr)) (not (tramp-tramp-file-p stderr)))))) @@ -4820,7 +5031,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 @@ -4858,9 +5069,8 @@ substitution. SPEC-LIST is a list of char/value pairs used for (setq login-args (append - (tramp-compat-flatten-tree - (tramp-get-method-parameter v 'tramp-async-args)) - (tramp-compat-flatten-tree + (flatten-tree (tramp-get-method-parameter v 'tramp-async-args)) + (flatten-tree (mapcar (lambda (x) (split-string x " ")) (tramp-expand-args @@ -4873,11 +5083,16 @@ substitution. SPEC-LIST is a list of char/value pairs used for :command (append `(,login-program) login-args command) :coding coding :noquery noquery :connection-type connection-type :sentinel sentinel :stderr stderr)) - ;; Set filter. Prior Emacs 29.1, it doesn't work reliable + ;; Set filter. Prior Emacs 29.1, it doesn't work reliably ;; to provide it as `make-process' argument when filter is ;; t. See Bug#51177. (when filter (set-process-filter p filter)) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, the + ;; setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'remote-command orig-command) (tramp-set-connection-property p "remote-command" orig-command) @@ -5062,19 +5277,11 @@ support symbolic links." (when current-buffer-p (barf-if-buffer-read-only) (push-mark nil t)) - ;; `shell-command-save-pos-or-erase' has been introduced with - ;; Emacs 27.1. - (if (fboundp 'shell-command-save-pos-or-erase) - (tramp-compat-funcall - 'shell-command-save-pos-or-erase current-buffer-p) - (setq buffer-read-only nil) - (erase-buffer))) + (shell-command-save-pos-or-erase current-buffer-p)) (if (integerp asynchronous) (let ((tramp-remote-process-environment - ;; `async-shell-command-width' has been introduced with - ;; Emacs 27.1. - (if (natnump (bound-and-true-p async-shell-command-width)) + (if (natnump async-shell-command-width) (cons (format "COLUMNS=%d" (bound-and-true-p async-shell-command-width)) tramp-remote-process-environment) @@ -5095,17 +5302,19 @@ support symbolic links." (add-function :after (process-sentinel p) (lambda (_proc _string) - (with-current-buffer error-buffer - (insert-file-contents-literally - error-file nil nil nil 'replace)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally + error-file nil nil nil 'replace)) + (delete-file error-file))))) (display-buffer output-buffer '(nil (allow-no-window . t))))) ;; Insert error messages if they were separated. (when (and error-file (not (process-live-p p))) - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))))) ;; Synchronous case. (prog1 @@ -5113,9 +5322,10 @@ support symbolic links." (process-file-shell-command command nil buffer) ;; Insert error messages if they were separated. (when error-file - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))) (if current-buffer-p ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, @@ -5125,11 +5335,7 @@ support symbolic links." (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer)))) - ;; `shell-command-set-point-after-cmd' has been - ;; introduced with Emacs 27.1. - (if (fboundp 'shell-command-set-point-after-cmd) - (tramp-compat-funcall - 'shell-command-set-point-after-cmd))) + (shell-command-set-point-after-cmd)) ;; There's some output, display it. (when (with-current-buffer output-buffer (> (point-max) (point-min))) (display-message-or-buffer output-buffer))))))) @@ -5137,10 +5343,7 @@ support symbolic links." (defun tramp-handle-start-file-process (name buffer program &rest args) "Like `start-file-process' for Tramp files. BUFFER might be a list, in this case STDERR is separated." - ;; `make-process' knows the `:file-handler' argument since Emacs - ;; 27.1 only. Therefore, we invoke it via `tramp-file-name-handler'. - (tramp-file-name-handler - 'make-process + (make-process :name name :buffer (if (consp buffer) (car buffer) buffer) :command (and program (cons program args)) @@ -5153,7 +5356,7 @@ BUFFER might be a list, in this case STDERR is separated." "Like `substitute-in-file-name' for Tramp files. \"//\" and \"/~\" substitute only in the local filename part." ;; Check, whether the local part is a quoted file name. - (if (tramp-compat-file-name-quoted-p filename) + (if (file-name-quoted-p filename) filename ;; First, we must replace environment variables. (setq filename (tramp-replace-environment-variables filename)) @@ -5184,6 +5387,12 @@ BUFFER might be a list, in this case STDERR is separated." (defconst tramp-time-doesnt-exist '(-1 65535) "An invalid time value, used as \"Doesn't exist\" value.") +(defsubst tramp-defined-time (time) + "Return TIME or nil (when TIME is not a time spec)." + (unless (or (time-equal-p time tramp-time-doesnt-exist) + (time-equal-p time tramp-time-dont-know)) + time)) + (defun tramp-handle-set-visited-file-modtime (&optional time-list) "Like `set-visited-file-modtime' for Tramp files." (unless (buffer-file-name) @@ -5195,7 +5404,7 @@ BUFFER might be a list, in this case STDERR is separated." (or (file-attribute-modification-time (file-attributes (buffer-file-name))) tramp-time-doesnt-exist)))) - (unless (tramp-compat-time-equal-p time-list tramp-time-dont-know) + (unless (time-equal-p time-list tramp-time-dont-know) (tramp-run-real-handler #'set-visited-file-modtime (list time-list)))) (defun tramp-handle-verify-visited-file-modtime (&optional buf) @@ -5221,14 +5430,13 @@ of." (cond ;; File exists, and has a known modtime. - ((and attr - (not (tramp-compat-time-equal-p modtime tramp-time-dont-know))) + ((and attr (not (time-equal-p modtime tramp-time-dont-know))) (< (abs (tramp-time-diff modtime mt)) 2)) ;; Modtime has the don't know value. (attr t) ;; If file does not exist, say it is not modified if and ;; only if that agrees with the buffer's record. - (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))) + (t (time-equal-p mt tramp-time-doesnt-exist)))))))) (defun tramp-handle-write-region (start end filename &optional append visit lockname mustbenew) @@ -5287,7 +5495,7 @@ of." ;; There might be pending output. Avoid problems with reentrant ;; call of Tramp. (ignore-errors - (while (tramp-accept-process-output proc 0))) + (while (tramp-accept-process-output proc))) (tramp-message proc 6 "Kill %S" proc) (delete-process proc)) @@ -5299,7 +5507,7 @@ of." (with-current-buffer (process-buffer proc) (file-exists-p (concat (file-remote-p default-directory) - (process-get proc 'watch-name)))))) + (process-get proc 'tramp-watch-name)))))) (defun tramp-file-notify-process-sentinel (proc event) "Call `file-notify-rm-watch'." @@ -5425,7 +5633,7 @@ Wait, until the connection buffer changes." ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. - (while (not (tramp-compat-ignore-error 'file-error + (while (not (ignore-error file-error (tramp-wait-for-regexp proc 0.1 tramp-security-key-confirmed-regexp))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) @@ -5439,13 +5647,13 @@ Wait, until the connection buffer changes." "Check, whether a process has finished." (unless (process-live-p proc) ;; There might be pending output. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (throw 'tramp-action 'process-died))) (defun tramp-action-out-of-band (proc vec) "Check, whether an out-of-band copy has finished." ;; There might be pending output for the exit status. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (cond ((and (not (process-live-p proc)) (zerop (process-exit-status proc))) (tramp-message vec 3 "Process has finished.") @@ -5476,7 +5684,7 @@ See `tramp-process-actions' for the format of ACTIONS." (while (not found) ;; Reread output once all actions have been performed. ;; Obviously, the output was not complete. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (setq todo actions) (while todo (setq item (pop todo) @@ -5519,7 +5727,7 @@ performed successfully. Any other value means an error." ;; use the "password-vector" property in case we have several hops. (tramp-set-connection-property (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector)) + proc "password-vector" (process-get proc 'tramp-vector)) "first-password-request" tramp-cache-read-persistent-data) (save-restriction (with-tramp-progress-reporter @@ -5593,11 +5801,22 @@ Mostly useful to protect BODY from being interrupted by timers." ,@body) (tramp-flush-connection-property ,proc "locked")))) -(defun tramp-accept-process-output (proc &optional timeout) +(defun tramp-accept-process-output (proc &optional _timeout) "Like `accept-process-output' for Tramp processes. This is needed in order to hide `last-coding-system-used', which is set for process communication also. If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." + (declare (advertised-calling-convention (proc) "29.2")) + ;; There could be other processes which use the same socket for + ;; communication. This could block the output for the current + ;; process. Read such output first. (Bug#61350) + ;; The process property isn't set anymore due to Bug#62194. + (when-let (((process-get proc 'tramp-shared-socket)) + (v (process-get proc 'tramp-vector))) + (dolist (p (delq proc (process-list))) + (when (tramp-file-name-equal-p v (process-get p 'tramp-vector)) + (accept-process-output p 0 nil t)))) + (with-current-buffer (process-buffer proc) (let ((inhibit-read-only t) last-coding-system-used @@ -5607,10 +5826,10 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit' ;; returns t in order to report success. (if (with-local-quit - (setq result (accept-process-output proc timeout nil t)) t) + (setq result (accept-process-output proc 0 nil t)) t) (tramp-message - proc 10 "%s %s %s %s\n%s" - proc timeout (process-status proc) result (buffer-string)) + proc 10 "%s %s %s\n%s" + proc (process-status proc) result (buffer-string)) ;; Propagate quit. (keyboard-quit))) result))) @@ -5724,8 +5943,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))) @@ -5748,7 +5966,7 @@ the remote host use line-endings as defined in the variable (defun tramp-process-sentinel (proc event) "Flush file caches and remove shell prompt." (unless (process-live-p proc) - (let ((vec (process-get proc 'vector)) + (let ((vec (process-get proc 'tramp-vector)) (buf (process-buffer proc)) (prompt (tramp-get-connection-property proc "prompt"))) (when vec @@ -5757,8 +5975,7 @@ the remote host use line-endings as defined in the variable (tramp-flush-directory-properties vec "/")) (when (buffer-live-p buf) (with-current-buffer buf - (when (and prompt - (tramp-search-regexp (tramp-compat-rx (literal prompt)))) + (when (and prompt (tramp-search-regexp (rx (literal prompt)))) (delete-region (point) (point-max)))))))) (defun tramp-get-inode (vec) @@ -5943,9 +6160,7 @@ ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property nil (format "gid-%s" id-format) (cond ((equal id-format 'integer) (group-gid)) - ;; `group-name' has been introduced with Emacs 27.1. - ((and (fboundp 'group-name) (equal id-format 'string)) - (tramp-compat-funcall 'group-name (group-gid))) + ((equal id-format 'string) (group-name (group-gid))) ((file-attribute-group-id (file-attributes "~/" id-format)))))) (defun tramp-get-local-locale (&optional vec) @@ -5962,7 +6177,7 @@ VEC is used for tracing." (while candidates (goto-char (point-min)) (if (string-match-p - (tramp-compat-rx bol (literal (car candidates)) (? "\r") eol) + (rx bol (literal (car candidates)) (? "\r") eol) (buffer-string)) (setq locale (car candidates) candidates nil) @@ -6293,7 +6508,7 @@ this file, if that variable is non-nil." ("|" . "__") ("[" . "_l") ("]" . "_r")) - (tramp-compat-file-name-unquote (buffer-file-name))) + (file-name-unquote (buffer-file-name))) tramp-auto-save-directory))) result) (prog1 ;; Run plain `make-auto-save-file-name'. @@ -6322,7 +6537,7 @@ ALIST is of the form ((FROM . TO) ...)." (let* ((pr (car alist)) (from (car pr)) (to (cdr pr))) - (while (string-match (tramp-compat-rx (literal from)) string) + (while (string-match (rx (literal from)) string) (setq string (replace-match to t t string))) (setq alist (cdr alist)))) string)) @@ -6351,6 +6566,7 @@ It always returns a return code. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (destination (if (eq destination t) (current-buffer) destination)) (vec (or vec (car tramp-current-connection))) @@ -6371,7 +6587,7 @@ are written with verbosity of 6." (error (setq error (error-message-string err) result 1))) - (if (zerop (length error)) + (if (tramp-string-empty-or-nil-p error) (tramp-message vec 6 "%s\n%s" result output) (tramp-message vec 6 "%s\n%s\n%s" result output error)) result)) @@ -6383,6 +6599,7 @@ It always returns a return code. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (buffer (if (eq buffer t) (current-buffer) buffer)) result) @@ -6424,7 +6641,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) @@ -6456,7 +6673,7 @@ Consults the auth-source package." ;; In tramp-sh.el, we must use "password-vector" due to ;; multi-hop. (vec (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector))) + proc "password-vector" (process-get proc 'tramp-vector))) (key (tramp-make-tramp-file-name vec 'noloc)) (method (tramp-file-name-method vec)) (user (or (tramp-file-name-user-domain vec) @@ -6507,7 +6724,7 @@ Consults the auth-source package." ;; Workaround. Prior Emacs 28.1, auth-source has saved empty ;; passwords. See discussion in Bug#50399. - (when (zerop (length auth-passwd)) + (when (tramp-string-empty-or-nil-p auth-passwd) (setq tramp-password-save-function nil)) (tramp-set-connection-property vec "first-password-request" nil) @@ -6557,7 +6774,7 @@ T1 and T2 are time values (as returned by `current-time' for example)." Suppress `shell-file-name'. This is needed on w32 systems, which would use a wrong quoting for local file names. See `w32-shell-name'." (let (shell-file-name) - (shell-quote-argument (tramp-compat-file-name-unquote s)))) + (shell-quote-argument (file-name-unquote s)))) ;; Currently (as of Emacs 20.5), the function `shell-quote-argument' ;; does not deal well with newline characters. Newline is replaced by @@ -6590,7 +6807,7 @@ Only works for Bourne-like shells." (string= (substring result 0 2) "\\~")) (setq result (substring result 1))) (replace-regexp-in-string - (tramp-compat-rx "\\" (literal tramp-rsh-end-of-line)) + (rx "\\" (literal tramp-rsh-end-of-line)) (format "'%s'" tramp-rsh-end-of-line) result))))) ;;; Signal handling. This works for remote processes, which have set @@ -6619,13 +6836,14 @@ name of a process or buffer, or nil to default to the current buffer." ;; negative pid, so we try both variants. (tramp-compat-funcall 'tramp-send-command - (process-get proc 'vector) + (process-get proc 'tramp-vector) (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s" pid pid - (tramp-get-remote-null-device (process-get proc 'vector)))) + (tramp-get-remote-null-device + (process-get proc 'tramp-vector)))) ;; Wait, until the process has disappeared. If it doesn't, ;; fall back to the default implementation. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (not (process-live-p proc)))))) (add-hook 'interrupt-process-functions #'tramp-interrupt-process) @@ -6648,7 +6866,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name." (cond ((processp process) (setq pid (process-get process 'remote-pid) - vec (process-get process 'vector))) + vec (process-get process 'tramp-vector))) ((numberp process) (setq pid process vec (and (stringp remote) (tramp-dissect-file-name remote)))) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index fa4604103c5..ad7bf94cdcd 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,8 +7,8 @@ ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.6.0.29.1 -;; Package-Requires: ((emacs "26.1")) +;; Version: 2.7.0-pre +;; Package-Requires: ((emacs "27.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.6.0.29.1" +(defconst tramp-version "2.7.0-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -55,11 +55,9 @@ (dir (or (locate-dominating-file (locate-library "tramp") ".git") source-directory)) debug-on-error) - ;; `emacs-repository-get-branch' has been introduced with Emacs 27.1. - (with-no-warnings - (and (stringp dir) (file-directory-p dir) - (executable-find "git") - (emacs-repository-get-branch dir))))) + (and (stringp dir) (file-directory-p dir) + (executable-find "git") + (emacs-repository-get-branch dir)))) "The repository branch of the Tramp sources.") (defconst tramp-repository-version @@ -76,9 +74,9 @@ "The repository revision of the Tramp sources.") ;; Check for Emacs version. -(let ((x (if (not (string-version-lessp emacs-version "26.1")) +(let ((x (if (not (string-version-lessp emacs-version "27.1")) "ok" - (format "Tramp 2.6.0.29.1 is not fit for %s" + (format "Tramp 2.7.0-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) @@ -104,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/novice.el b/lisp/novice.el index c3549acef3e..05e4bfc91c9 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -79,16 +79,22 @@ If nil, the feature is disabled, i.e., all commands work normally.") Do you want to use this command anyway? You can now type: - \\`y' to try it and enable it (no questions if you use it again). - \\`n' to cancel--don't try the command, and it remains disabled. + \\`n' (also C-g) to cancel--don't try the command; it remains disabled. + \\`y' to enable the command (no questions if you use it again). \\`SPC' to try the command just this once, but leave it disabled. - \\`!' to try it, and enable all disabled commands for this session only."))) + \\`!' to enable it and all the disabled commands for this session."))) (char + ;; Note: the prompt produced from the choices below must not + ;; overflow a single screen line, because otherwise it will + ;; cause the mini-window to resize, which will in turn hide + ;; the last line of the help text above: the code which fits + ;; the window to the size of the help text does not expect + ;; the mini-window to become taller. (car (read-multiple-choice "Use this command?" - '((?y "yes") - (?n "no") - (?! "yes; enable for session") - (?\s "(space bar) yes; once")) + '((?n "no") + (?y "yes") + (?\s "(space bar) only once") + (?! "use and enable all")) help-string "*Disabled Command*")))) (pcase char diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index c36d225c7c9..6f9df554da0 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -734,8 +734,13 @@ and VALUE-END, otherwise a STRING giving the value." (atts-needing-normalization nil)) (while (cond ((or (looking-at (xmltok-attribute regexp)) ;; use non-greedy group - (when (looking-at (concat "[^<>\n]+?" - (xmltok-attribute regexp))) + ;; Limit the search to 10000 characters, to + ;; avoid slowdowns due to the quadratic + ;; complexity of the regexp. See bug#61514. + (when (with-restriction + (point) (min (+ (point) 10000) (point-max)) + (looking-at (concat "[^<>\n]+?" + (xmltok-attribute regexp)))) (unless recovering (xmltok-add-error "Malformed attribute" (point) diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1 index eb126df6334..a4eae350d98 100644 --- a/lisp/org/ChangeLog.1 +++ b/lisp/org/ChangeLog.1 @@ -30500,7 +30500,7 @@ * org.el (org-make-tags-matcher): Never use IDO for completing the tags matcher match string. - (org-completing-read): Also remove the special biding for "?". + (org-completing-read): Also remove the special binding for "?". * org-attach.el (org-attach-allow-inheritance): New option. (org-attach-inherited): New variable. 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-latex.el b/lisp/org/ob-latex.el index 428907a270d..ce39628d642 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -141,7 +141,7 @@ exporting the literal LaTeX source." (org-trim body)) (defun org-babel-execute:latex (body params) - "Execute a block of Latex code with Babel. + "Execute a block of LaTeX code with Babel. This function is called by `org-babel-execute-src-block'." (setq body (org-babel-expand-body:latex body params)) (if (cdr (assq :file params)) @@ -180,7 +180,7 @@ This function is called by `org-babel-execute-src-block'." tmp-pdf (list org-babel-latex-pdf-svg-process) extension err-msg log-buf))) - (shell-command (format "mv %s %s" img-out out-file))))) + (rename-file img-out out-file t)))) ((string-suffix-p ".tikz" out-file) (when (file-exists-p out-file) (delete-file out-file)) (with-temp-file out-file @@ -218,17 +218,14 @@ This function is called by `org-babel-execute-src-block'." (if (string-suffix-p ".svg" out-file) (progn (shell-command "pwd") - (shell-command (format "mv %s %s" - (concat (file-name-sans-extension tex-file) "-1.svg") - out-file))) + (rename-file (concat (file-name-sans-extension tex-file) "-1.svg") + out-file t)) (error "SVG file produced but HTML file requested"))) ((file-exists-p (concat (file-name-sans-extension tex-file) ".html")) (if (string-suffix-p ".html" out-file) - (shell-command "mv %s %s" - (concat (file-name-sans-extension tex-file) - ".html") - out-file) - (error "HTML file produced but SVG file requested"))))) + (rename-file (concat (file-name-sans-extension tex-file) ".html") + out-file t) + (error "HTML file produced but SVG file requested"))))) ((or (string= "pdf" extension) imagemagick) (with-temp-file tex-file (require 'ox-latex) 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/ol-bibtex.el b/lisp/org/ol-bibtex.el index 7d6ed85345f..fd9517233e0 100644 --- a/lisp/org/ol-bibtex.el +++ b/lisp/org/ol-bibtex.el @@ -86,8 +86,8 @@ ;; the active region, then call `org-bibtex-write' in a .org file to ;; insert a heading for the read bibtex entry ;; -;; - All Bibtex information is taken from the document compiled by -;; Andrew Roberts from the Bibtex manual, available at +;; - All BibTeX information is taken from the document compiled by +;; Andrew Roberts from the BibTeX manual, available at ;; https://www.andy-roberts.net/res/writing/latex/bibentries.pdf ;; ;;; History: @@ -99,7 +99,7 @@ ;; and then implemented by Bastien Guerry. ;; ;; Eric Schulte eventually added the functions for translating between -;; Org headlines and Bibtex entries, and for fleshing out the Bibtex +;; Org headlines and BibTeX entries, and for fleshing out the BibTeX ;; fields of existing Org headlines. ;; ;; Org mode loads this module by default - if this is not what you want, @@ -144,7 +144,7 @@ (declare-function org-search-view "org-agenda" (&optional todo-only string edit-at)) -;;; Bibtex data +;;; BibTeX data (defvar org-bibtex-types '((:article (:description . "An article from a journal or magazine") @@ -202,7 +202,7 @@ (:description . "A document having an author and title, but not formally published.") (:required :author :title :note) (:optional :month :year :doi :url))) - "Bibtex entry types with required and optional parameters.") + "BibTeX entry types with required and optional parameters.") (defvar org-bibtex-fields '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.") @@ -231,7 +231,7 @@ (:url . "Uniform resource locator.") (:volume . "The volume of a journal or multi-volume book.") (:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'")) - "Bibtex fields with descriptions.") + "BibTeX fields with descriptions.") (defvar org-bibtex-entries nil "List to hold parsed bibtex entries.") @@ -439,7 +439,7 @@ at point." (error "Field:%s is not known" field)) (save-window-excursion (let* ((name (substring (symbol-name field) 1)) - (buf-name (format "*Bibtex Help %s*" name))) + (buf-name (format "*BibTeX Help %s*" name))) (with-output-to-temp-buffer buf-name (princ (cdr (assoc field org-bibtex-fields)))) (with-current-buffer buf-name (visual-line-mode 1)) @@ -496,7 +496,7 @@ With optional argument OPTIONAL, also prompt for optional fields." (org-bibtex-autokey))) -;;; Bibtex link functions +;;; BibTeX link functions (org-link-set-parameters "bibtex" :follow #'org-bibtex-open :store #'org-bibtex-store-link) @@ -593,13 +593,13 @@ ARG, when non-nil, is a universal prefix argument. See (add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex) -;;; Bibtex <-> Org headline translation functions +;;; BibTeX <-> Org headline translation functions (defun org-bibtex (filename) "Export each headline in the current file to a bibtex entry. Headlines are exported using `org-bibtex-headline'." (interactive (list (read-file-name - "Bibtex file: " nil nil nil + "BibTeX file: " nil nil nil (let ((file (buffer-file-name (buffer-base-buffer)))) (and file (file-name-nondirectory @@ -619,7 +619,7 @@ Headlines are exported using `org-bibtex-headline'." nil)))) (when error-point (goto-char error-point) - (message "Bibtex error at %S" (nth 4 (org-heading-components)))))) + (message "BibTeX error at %S" (nth 4 (org-heading-components)))))) (defun org-bibtex-check (&optional optional) "Check the current headline for required fields. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 2d194ad3413..2ec2f4c00bc 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -3348,7 +3348,7 @@ s Search for keywords M Like m, but only TODO entries (`agenda (call-interactively 'org-agenda-list)) (`agenda* - (funcall 'org-agenda-list nil nil t)) + (funcall 'org-agenda-list nil nil nil t)) (`alltodo (call-interactively 'org-todo-list)) (`search @@ -3474,13 +3474,17 @@ This ensures the export commands can easily use it." (when (setq tmp (plist-get props 'date)) (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) (let ((calendar-date-display-form - '(year "-" (string-pad month 2 ?0 'left) "-" (string-pad day 2 ?0 'left)))) + '((format "%s-%.2d-%.2d" year + (string-to-number month) + (string-to-number day))))) (setq tmp (calendar-date-string tmp))) (setq props (plist-put props 'date tmp))) (when (setq tmp (plist-get props 'day)) (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) (let ((calendar-date-display-form - '(year "-" (string-pad month 2 ?0 'left) "-" (string-pad day 2 ?0 'left)))) + '((format "%s-%.2d-%.2d" year + (string-to-number month) + (string-to-number day))))) (setq tmp (calendar-date-string tmp))) (setq props (plist-put props 'day tmp)) (setq props (plist-put props 'agenda-day tmp))) @@ -7326,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) @@ -8207,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..51729b3f33d 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -2462,7 +2462,7 @@ CDR is a plist containing `:key', `:value', `:begin', `:end', (org-element-property :value keyword))) -;;;; Latex Environment +;;;; LaTeX Environment (defconst org-element--latex-begin-environment "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}" @@ -3412,7 +3412,7 @@ CONTENTS is the contents of the object." (format "/%s/" contents)) -;;;; Latex Fragment +;;;; LaTeX Fragment (defun org-element-latex-fragment-parser () "Parse LaTeX fragment at point, if any. @@ -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-macs.el b/lisp/org/org-macs.el index 07c668a807d..8d7b0b034f8 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -46,7 +46,7 @@ ;; `org-git-version' check because the generated Org version strings ;; will not match. `(unless (equal (org-release) ,(org-release)) - (warn "Org version mismatch. Make sure that correct `load-path' is set early in init.el + (warn "Org version mismatch. Org loading aborted. This warning usually appears when a built-in Org version is loaded prior to the more recent Org version. diff --git a/lisp/org/org-persist.el b/lisp/org/org-persist.el index a0652b99c56..01078f4596d 100644 --- a/lisp/org/org-persist.el +++ b/lisp/org/org-persist.el @@ -540,13 +540,13 @@ COLLECTION is the plist holding data collection." (defun org-persist-read:file (_ path __) "Read file container from PATH." - (when (and path (file-exists-p (concat org-persist-directory path))) - (concat org-persist-directory path))) + (when (and path (file-exists-p (org-file-name-concat org-persist-directory path))) + (org-file-name-concat org-persist-directory path))) (defun org-persist-read:url (_ path __) "Read file container from PATH." - (when (and path (file-exists-p (concat org-persist-directory path))) - (concat org-persist-directory path))) + (when (and path (file-exists-p (org-file-name-concat org-persist-directory path))) + (org-file-name-concat org-persist-directory path))) (defun org-persist-read:index (cont index-file _) "Read index container CONT from INDEX-FILE." diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 9e439281118..aadd8eba579 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -315,7 +315,7 @@ is 0.") (defun org-src--construct-edit-buffer-name (org-buffer-name lang) "Construct the buffer name for a source editing buffer. -Format is \"*Org Src ORG-BUFFER-NAME [ LANG ]*\"." +Format is \"*Org Src ORG-BUFFER-NAME[ LANG ]*\"." (concat "*Org Src " org-buffer-name "[ " lang " ]*")) (defun org-src--edit-buffer (beg end) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 22f952d7a30..20636a3dd04 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-16-ge37e9b")) + (let ((org-git-version "release_9.6.1-48-g92471e")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 153e860f9a5..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")) @@ -8608,6 +8618,7 @@ or to another Org file, automatically push the old position onto the ring." (defvar org-agenda-buffer-name) (defun org-follow-timestamp-link () "Open an agenda view for the time-stamp date/range at point." + (require 'org-agenda) ;; Avoid changing the global value. (let ((org-agenda-buffer-name org-agenda-buffer-name)) (cond @@ -18843,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-ascii.el b/lisp/org/ox-ascii.el index 9c4424b14f1..692dd216d61 100644 --- a/lisp/org/ox-ascii.el +++ b/lisp/org/ox-ascii.el @@ -1549,7 +1549,7 @@ information." keyword info))))) -;;;; Latex Environment +;;;; LaTeX Environment (defun org-ascii-latex-environment (latex-environment _contents info) "Transcode a LATEX-ENVIRONMENT element from Org to ASCII. @@ -1561,7 +1561,7 @@ information." latex-environment info))) -;;;; Latex Fragment +;;;; LaTeX Fragment (defun org-ascii-latex-fragment (latex-fragment _contents info) "Transcode a LATEX-FRAGMENT object from Org to ASCII. diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 7b79c57d4a4..b27254b8ac5 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -2969,7 +2969,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ((string= "listings" value) (org-html-list-of-listings info)) ((string= "tables" value) (org-html-list-of-tables info)))))))) -;;;; Latex Environment +;;;; LaTeX Environment (defun org-html-format-latex (latex-frag processing-type info) "Format a LaTeX fragment LATEX-FRAG into HTML. @@ -3086,7 +3086,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." info caption label))))) (t (org-html--wrap-latex-environment latex-frag info caption label))))) -;;;; Latex Fragment +;;;; LaTeX Fragment (defun org-html-latex-fragment (latex-fragment _contents info) "Transcode a LATEX-FRAGMENT object from Org to HTML. diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index 5ac9c378133..50a0950aa04 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -1272,7 +1272,7 @@ used. When nil, no theme is applied." (defun org-latex-generate-engraved-preamble (info) "Generate the preamble to setup engraved code. The result is constructed from the :latex-engraved-preamble and -:latex-engraved-optionsn export options, the default values of +:latex-engraved-options export options, the default values of which are given by `org-latex-engraved-preamble' and `org-latex-engraved-options' respectively." (let* ((engraved-options @@ -2600,7 +2600,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." (otherwise "\\lstlistoflistings"))))))))) -;;;; Latex Environment +;;;; LaTeX Environment (defun org-latex--environment-type (latex-environment) "Return the TYPE of LATEX-ENVIRONMENT. @@ -2658,7 +2658,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." (insert caption) (buffer-string)))))) -;;;; Latex Fragment +;;;; LaTeX Fragment (defun org-latex-latex-fragment (latex-fragment _contents _info) "Transcode a LATEX-FRAGMENT object from Org to LaTeX. diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el index 5cb79ef2396..5be0ca22e07 100644 --- a/lisp/org/ox-md.el +++ b/lisp/org/ox-md.el @@ -486,7 +486,7 @@ channel." (_ (org-export-with-backend 'html keyword contents info)))) -;;;; Latex Environment +;;;; LaTeX Environment (defun org-md-latex-environment (latex-environment _contents info) "Transcode a LATEX-ENVIRONMENT object from Org to Markdown. @@ -501,7 +501,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." latex-frag) latex-frag)))) -;;;; Latex Fragment +;;;; LaTeX Fragment (defun org-md-latex-fragment (latex-fragment _contents info) "Transcode a LATEX-FRAGMENT object from Org to Markdown. diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 949c8f9b5b2..cf217c9e781 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -1986,7 +1986,7 @@ information." (ignore)))))))) -;;;; Latex Environment +;;;; LaTeX Environment ;; (eval-after-load 'ox-odt '(ad-deactivate 'org-format-latex-as-mathml)) ;; (advice-add 'org-format-latex-as-mathml ; FIXME @@ -2007,7 +2007,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." (org-odt-do-format-code latex-frag info))) -;;;; Latex Fragment +;;;; LaTeX Fragment ;; (when latex-frag ; FIXME ;; (setq href (propertize href :title "LaTeX Fragment" 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/org/ox.el b/lisp/org/ox.el index 65f9ff18279..6f819def93a 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -6600,14 +6600,14 @@ see. Optional argument POST-PROCESS is a function which should accept no argument. It is always called within the current process, from BUFFER, with point at its beginning. Export back-ends can -use it to set a major mode there, e.g, +use it to set a major mode there, e.g., (defun org-latex-export-as-latex (&optional async subtreep visible-only body-only ext-plist) (interactive) (org-export-to-buffer \\='latex \"*Org LATEX Export*\" async subtreep visible-only body-only ext-plist - #'LaTeX-mode)) + #\\='LaTeX-mode)) When expressed as an anonymous function, using `lambda', POST-PROCESS needs to be quoted. diff --git a/lisp/outline.el b/lisp/outline.el index 0bfda8388ed..a89985d1990 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1776,6 +1776,20 @@ With a prefix argument, show headings up to that LEVEL." ;;; Button/margin indicators +(defvar-keymap outline-button-icon-map + "<mouse-2>" #'outline-cycle + ;; Need to override the global binding + ;; `mouse-appearance-menu' with <down->: + "S-<down-mouse-1>" #'ignore + "S-<mouse-1>" #'outline-cycle-buffer) + +(defvar-keymap outline-overlay-button-map + "RET" #'outline-cycle) + +(defvar-keymap outline-inserted-button-map + :parent (make-composed-keymap outline-button-icon-map + outline-overlay-button-map)) + (defun outline--create-button-icons () (pcase outline-minor-mode-use-buttons ('in-margins @@ -1808,12 +1822,7 @@ With a prefix argument, show headings up to that LEVEL." (propertize (icon-string icon-name) 'mouse-face 'default 'follow-link 'mouse-face - 'keymap (define-keymap - "<mouse-2>" #'outline-cycle - ;; Need to override the global binding - ;; `mouse-appearance-menu' with <down->: - "S-<down-mouse-1>" #'ignore - "S-<mouse-1>" #'outline-cycle-buffer))) + 'keymap outline-button-icon-map)) (list 'outline-open (if outline--use-rtl 'outline-close-rtl 'outline-close)))))) @@ -1839,19 +1848,13 @@ With a prefix argument, show headings up to that LEVEL." (overlay-put o 'face (plist-get icon 'face)) (overlay-put o 'follow-link 'mouse-face) (overlay-put o 'mouse-face 'highlight) - (overlay-put o 'keymap (define-keymap - "RET" #'outline-cycle - "<mouse-2>" #'outline-cycle - ;; Need to override the global binding - ;; `mouse-appearance-menu' with <down->: - "S-<down-mouse-1>" #'ignore - "S-<mouse-1>" #'outline-cycle-buffer))) + (overlay-put o 'keymap outline-inserted-button-map)) ('in-margins (overlay-put o 'before-string icon) - (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle))) + (overlay-put o 'keymap outline-overlay-button-map)) (_ (overlay-put o 'before-string icon) - (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle)))))))) + (overlay-put o 'keymap outline-overlay-button-map))))))) (defun outline--fix-up-all-buttons (&optional from to) (when outline-minor-mode-use-buttons 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/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index 7d270ea789f..1553c3efed7 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -184,6 +184,86 @@ Return the new list." (when (and (not ,exist) (buffer-live-p ,buf)) (kill-buffer ,buf)))))) +(defvar pcmpl-gnu--tar-long-options + ;; FIXME: Extract this list from "tar --help". + '("--absolute-names" + "--after-date=" + "--append" + "--atime-preserve" + "--backup" + "--block-number" + "--blocking-factor=" + "--catenate" + "--checkpoint" + "--compare" + "--compress" + "--concatenate" + "--confirmation" + "--create" + "--delete" + "--dereference" + "--diff" + "--directory=" + "--exclude=" + "--exclude-from=" + "--extract" + "--file=" + "--files-from=" + "--force-local" + "--get" + "--group=" + "--gzip" + "--help" + "--ignore-failed-read" + "--ignore-zeros" + "--incremental" + "--info-script=" + "--interactive" + "--keep-old-files" + "--label=" + "--list" + "--listed-incremental" + "--mode=" + "--modification-time" + "--multi-volume" + "--new-volume-script=" + "--newer=" + "--newer-mtime" + "--no-recursion" + "--null" + "--numeric-owner" + "--old-archive" + "--one-file-system" + "--owner=" + "--portability" + "--posix" + "--preserve" + "--preserve-order" + "--preserve-permissions" + "--read-full-records" + "--record-size=" + "--recursive-unlink" + "--remove-files" + "--rsh-command=" + "--same-order" + "--same-owner" + "--same-permissions" + "--sparse" + "--starting-file=" + "--suffix=" + "--tape-length=" + "--to-stdout" + "--totals" + "--uncompress" + "--ungzip" + "--unlink-first" + "--update" + "--use-compress-program=" + "--verbose" + "--verify" + "--version" + "--volno-file=")) + ;;;###autoload (defun pcomplete/tar () "Completion for the GNU tar utility." @@ -192,148 +272,53 @@ Return the new list." (while (pcomplete-match "^-" 0) (setq saw-option t) (if (pcomplete-match "^--" 0) - (if (pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0) - ;; FIXME: Extract this list from "tar --help". - (pcomplete-here* - '("--absolute-names" - "--after-date=" - "--append" - "--atime-preserve" - "--backup" - "--block-number" - "--blocking-factor=" - "--catenate" - "--checkpoint" - "--compare" - "--compress" - "--concatenate" - "--confirmation" - "--create" - "--delete" - "--dereference" - "--diff" - "--directory=" - "--exclude=" - "--exclude-from=" - "--extract" - "--file=" - "--files-from=" - "--force-local" - "--get" - "--group=" - "--gzip" - "--help" - "--ignore-failed-read" - "--ignore-zeros" - "--incremental" - "--info-script=" - "--interactive" - "--keep-old-files" - "--label=" - "--list" - "--listed-incremental" - "--mode=" - "--modification-time" - "--multi-volume" - "--new-volume-script=" - "--newer=" - "--newer-mtime" - "--no-recursion" - "--null" - "--numeric-owner" - "--old-archive" - "--one-file-system" - "--owner=" - "--portability" - "--posix" - "--preserve" - "--preserve-order" - "--preserve-permissions" - "--read-full-records" - "--record-size=" - "--recursive-unlink" - "--remove-files" - "--rsh-command=" - "--same-order" - "--same-owner" - "--same-permissions" - "--sparse" - "--starting-file=" - "--suffix=" - "--tape-length=" - "--to-stdout" - "--totals" - "--uncompress" - "--ungzip" - "--unlink-first" - "--update" - "--use-compress-program=" - "--verbose" - "--verify" - "--version" - "--volno-file="))) - (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz")) - (cond - ((pcomplete-match "\\`-\\'" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--after-date=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--backup=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--blocking-factor=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--directory=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-dirs) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--exclude=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0) - (setq complete-within t)) - ((pcomplete-match "\\`--file=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-dirs-or-entries pcmpl-gnu-tarfile-regexp) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--files-from=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--group=\\(.*\\)" 0) - (pcomplete-here* (pcmpl-unix-group-names) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--info-script=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--label=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--mode=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--newer=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--owner=\\(.*\\)" 0) - (pcomplete-here* (pcmpl-unix-user-names) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--record-size=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0) - (pcomplete-here* (funcall pcomplete-command-completion-function) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--suffix=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--tape-length=" 0) - (pcomplete-here*)) - ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0) - (pcomplete-here* (funcall pcomplete-command-completion-function) - (pcomplete-match-string 1 0))) - ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0) - (pcomplete-here* (pcomplete-entries) - (pcomplete-match-string 1 0))))) + (cond + ((pcomplete-match "^--\\([^= \t\n\f]*\\)\\'" 0) + (pcomplete-here* pcmpl-gnu--tar-long-options)) + ((pcomplete-match "\\`--directory=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-dirs) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--exclude-from=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--\\(extract\\|list\\)\\'" 0) + (setq complete-within t)) + ((pcomplete-match "\\`--file=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-dirs-or-entries + pcmpl-gnu-tarfile-regexp) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--files-from=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--group=\\(.*\\)" 0) + (pcomplete-here* (pcmpl-unix-group-names) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--info-script=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--new-volume-script=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--owner=\\(.*\\)" 0) + (pcomplete-here* (pcmpl-unix-user-names) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--rsh-command=\\(.*\\)" 0) + (pcomplete-here* (funcall pcomplete-command-completion-function) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--starting-file=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--use-compress-program=\\(.*\\)" 0) + (pcomplete-here* (funcall pcomplete-command-completion-function) + (pcomplete-match-string 1 0))) + ((pcomplete-match "\\`--volno-file=\\(.*\\)" 0) + (pcomplete-here* (pcomplete-entries) + (pcomplete-match-string 1 0))) + (t + (pcomplete-here*))) + (pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz") + (when (pcomplete-match "\\`-\\'" 0) + (pcomplete-here*)))) (unless saw-option (pcomplete-here (mapcar #'char-to-string 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/proced.el b/lisp/proced.el index a9c7ef9ef3d..03a7f1bebdf 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -656,6 +656,14 @@ Important: the match ends just after the marker.") ) (put 'proced-mark :advertised-binding "m") +(defvar-local proced-refinements nil + "Information about the current buffer refinements. + +It should be a list of elements of the form (REFINER PID KEY GRAMMAR), where +REFINER and GRAMMAR are as described in `proced-grammar-alist', PID is the +process ID of the process used to create the refinement, and KEY the attribute +of the process. A value of nil indicates that there are no active refinements.") + (easy-menu-define proced-menu proced-mode-map "Proced Menu." `("Proced" @@ -784,6 +792,52 @@ Return nil if point is not on a process line." (if (looking-at "^. .") (get-text-property (match-end 0) 'proced-pid)))) +(defun proced--position-info (pos) + "Return information of the process at POS. + +The returned information will have the form `(PID KEY COLUMN)' where +PID is the process ID of the process at point, KEY is the value of the +proced-key text property at point, and COLUMN is the column for which the +current value of the proced-key text property starts, or 0 if KEY is nil." + ;; If point is on a field, we try to return point to that field. + ;; Otherwise we try to return to the same column + (save-excursion + (goto-char pos) + (let ((pid (proced-pid-at-point)) + (key (get-text-property (point) 'proced-key))) + (list pid key ; can both be nil + (if key + (if (get-text-property (1- (point)) 'proced-key) + (- (point) (previous-single-property-change + (point) 'proced-key)) + 0) + (current-column)))))) + +(defun proced--determine-pos (key column) + "Return position of point in the current line using KEY and COLUMN. + +Attempt to find the first position on the current line where the +text property proced-key is equal to KEY. If this is not possible, return +the position of point of column COLUMN on the current line." + (save-excursion + (let (new-pos) + (if key + (let ((limit (line-end-position)) pos) + (while (and (not new-pos) + (setq pos (next-property-change (point) nil limit))) + (goto-char pos) + (when (eq key (get-text-property (point) 'proced-key)) + (forward-char (min column (- (next-property-change (point)) + (point)))) + (setq new-pos (point)))) + (unless new-pos + ;; we found the process, but the field of point + ;; is not listed anymore + (setq new-pos (proced-move-to-goal-column)))) + (setq new-pos (min (+ (line-beginning-position) column) + (line-end-position)))) + new-pos))) + ;; proced mode (define-derived-mode proced-mode special-mode "Proced" @@ -839,6 +893,7 @@ normal hook `proced-post-display-hook'. (setq-local revert-buffer-function #'proced-revert) (setq-local font-lock-defaults '(proced-font-lock-keywords t nil nil beginning-of-line)) + (setq-local switch-to-buffer-preserve-window-point nil) (if (and (not proced-auto-update-timer) proced-auto-update-interval) (setq proced-auto-update-timer (run-at-time t proced-auto-update-interval @@ -1337,20 +1392,7 @@ a certain refinement, consider defining a new filter in `proced-filter-alist'." (let* ((grammar (assq key proced-grammar-alist)) (refiner (nth 7 grammar))) (when refiner - (cond ((functionp (car refiner)) - (setq proced-process-alist (funcall (car refiner) pid))) - ((consp refiner) - (let ((predicate (nth 4 grammar)) - (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) - val new-alist) - (dolist (process proced-process-alist) - (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) - (if (cond ((not val) (nth 2 refiner)) - ((eq val 'equal) (nth 1 refiner)) - (val (car refiner))) - (push process new-alist))) - (setq proced-process-alist new-alist)))) - ;; Do not revert listing. + (add-to-list 'proced-refinements (list refiner pid key grammar) t) (proced-update))) (message "No refiner defined here.")))) @@ -1859,10 +1901,29 @@ After updating a displayed Proced buffer run the normal hook "Updating process display..."))) (if revert ;; evaluate all processes (setq proced-process-alist (proced-process-attributes))) - ;; filtering and sorting + ;; filtering + (setq proced-process-alist (proced-filter proced-process-alist proced-filter)) + ;; refinements + (pcase-dolist (`(,refiner ,pid ,key ,grammar) proced-refinements) + ;; It's possible the process has exited since the refinement was made + (when (assq pid proced-process-alist) + (cond ((functionp (car refiner)) + (setq proced-process-alist (funcall (car refiner) pid))) + ((consp refiner) + (let ((predicate (nth 4 grammar)) + (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) + val new-alist) + (dolist (process proced-process-alist) + (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) + (when (cond ((not val) (nth 2 refiner)) + ((eq val 'equal) (nth 1 refiner)) + (val (car refiner))) + (push process new-alist))) + (setq proced-process-alist new-alist)))))) + + ;; sorting (setq proced-process-alist - (proced-sort (proced-filter proced-process-alist proced-filter) - proced-sort proced-descend)) + (proced-sort proced-process-alist proced-sort proced-descend)) ;; display as process tree? (setq proced-process-alist @@ -1875,17 +1936,10 @@ After updating a displayed Proced buffer run the normal hook (if (consp buffer-undo-list) (setq buffer-undo-list nil)) (let ((buffer-undo-list t) - ;; If point is on a field, we try to return point to that field. - ;; Otherwise we try to return to the same column - (old-pos (let ((pid (proced-pid-at-point)) - (key (get-text-property (point) 'proced-key))) - (list pid key ; can both be nil - (if key - (if (get-text-property (1- (point)) 'proced-key) - (- (point) (previous-single-property-change - (point) 'proced-key)) - 0) - (current-column))))) + (window-pos-infos + (mapcar (lambda (w) `(,w . ,(proced--position-info (window-point w)))) + (get-buffer-window-list (current-buffer) nil t))) + (old-pos (proced--position-info (point))) buffer-read-only mp-list) ;; remember marked processes (whatever the mark was) (goto-char (point-min)) @@ -1918,7 +1972,8 @@ After updating a displayed Proced buffer run the normal hook ;; Sometimes this puts point in the middle of the proced buffer ;; where it is not interesting. Is there a better / more flexible solution? (goto-char (point-min)) - (let (pid mark new-pos) + + (let (pid mark new-pos win-points) (if (or mp-list (car old-pos)) (while (not (eobp)) (setq pid (proced-pid-at-point)) @@ -1927,28 +1982,25 @@ After updating a displayed Proced buffer run the normal hook (delete-char 1) (beginning-of-line)) (when (eq (car old-pos) pid) - (if (nth 1 old-pos) - (let ((limit (line-end-position)) pos) - (while (and (not new-pos) - (setq pos (next-property-change (point) nil limit))) - (goto-char pos) - (when (eq (nth 1 old-pos) - (get-text-property (point) 'proced-key)) - (forward-char (min (nth 2 old-pos) - (- (next-property-change (point)) - (point)))) - (setq new-pos (point)))) - (unless new-pos - ;; we found the process, but the field of point - ;; is not listed anymore - (setq new-pos (proced-move-to-goal-column)))) - (setq new-pos (min (+ (line-beginning-position) (nth 2 old-pos)) - (line-end-position))))) + (setq new-pos (proced--determine-pos (nth 1 old-pos) + (nth 2 old-pos)))) + (mapc (lambda (w-pos) + (when (eq (cadr w-pos) pid) + (push `(,(car w-pos) . ,(proced--determine-pos + (nth 1 (cdr w-pos)) + (nth 2 (cdr w-pos)))) + win-points))) + window-pos-infos) (forward-line))) - (if new-pos - (goto-char new-pos) - (goto-char (point-min)) - (proced-move-to-goal-column))) + (let ((fallback (save-excursion (goto-char (point-min)) + (proced-move-to-goal-column) + (point)))) + (goto-char (or new-pos fallback)) + ;; Update window points + (mapc (lambda (w-pos) + (set-window-point (car w-pos) + (alist-get (car w-pos) win-points fallback))) + window-pos-infos))) ;; update mode line ;; Does the long `mode-name' clutter the mode line? It would be nice ;; to have some other location for displaying the values of the various @@ -1976,7 +2028,9 @@ After updating a displayed Proced buffer run the normal hook (defun proced-revert (&rest _args) "Reevaluate the process listing based on the currently running processes. -Preserves point and marks." +Preserves point and marks, but not refinements (see `proced-refine' for +information on refinements)." + (setq proced-refinements nil) (proced-update t)) (defun proced-marked-processes () 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 6671d4be5b6..85db39aaeae 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2023 Free Software Foundation, Inc. -;; Author : 付禹安 (Yuan Fu) <casouri@gmail.com> +;; Maintainer : 付禹安 (Yuan Fu) <casouri@gmail.com> ;; Keywords : c c++ java javascript rust languages tree-sitter ;; This file is part of GNU Emacs. @@ -22,7 +22,10 @@ ;;; Commentary: ;; -;; For C-like language major modes: +;; This file contains functions that can be shared by C-like language +;; major modes, like indenting and filling "/* */" block comments. +;; +;; For indenting and filling comments: ;; ;; - Use `c-ts-common-comment-setup' to setup comment variables and ;; filling. @@ -30,6 +33,14 @@ ;; - Use simple-indent matcher `c-ts-common-looking-at-star' and ;; anchor `c-ts-common-comment-start-after-first-star' for indenting ;; block comments. See `c-ts-mode--indent-styles' for example. +;; +;; For indenting statements: +;; +;; - Set `c-ts-common-indent-offset', +;; `c-ts-common-indent-block-type-regexp', and +;; `c-ts-common-indent-bracketless-type-regexp', then use simple-indent +;; offset `c-ts-common-statement-offset' in +;; `treesit-simple-indent-rules'. ;;; Code: @@ -39,6 +50,10 @@ (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-node-prev-sibling "treesit.c") + +;;; Comment indentation and filling (defun c-ts-common-looking-at-star (_n _p bol &rest _) "A tree-sitter simple indent matcher. @@ -180,7 +195,8 @@ comment." (when end-marker (goto-char end-marker) (delete-region (point) (+ end-len (point))) - (insert (make-string end-len ?\s)))))) + (insert (make-string end-len ?\s))) + (goto-char orig-point)))) (defun c-ts-common-comment-setup () "Set up local variables for C-like comment. @@ -242,6 +258,129 @@ Set up: (setq-local paragraph-separate paragraph-start) (setq-local fill-paragraph-function #'c-ts-common--fill-paragraph)) +;;; Statement indent + +(defvar c-ts-common-indent-offset nil + "Indent offset used by `c-ts-common' indent functions. + +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-type-regexp-alist nil + "An alist of node type regexps. + +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. + +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. + +If the language doesn't have a particular type, it is fine to +omit it.") + +(defun c-ts-common--node-is (node &rest types) + "Return non-nil if NODE is any one of the TYPES. + +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-common-indent-block-type-regexp') +between NODE and the root node (not counting NODE itself), and +multiply that by `c-ts-common-indent-offset'. + +To support GNU style, on each block level, this function also +checks whether the opening bracket { is on its own line, if so, +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 (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. + (when (null node) + (setq node t)) + ;; Go up the tree and compute indent level. + (while (if (eq node t) + (setq node parent) + 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)))) + (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 95f9001e0d7..1c55c7fbdde 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -63,11 +63,6 @@ ;; will set up Emacs to use the C/C++ modes defined here for other ;; files, provided that you have the corresponding parser grammar ;; libraries installed. -;; -;; - Use variable `c-ts-mode-indent-block-type-regexp' with indent -;; offset c-ts-mode--statement-offset for indenting statements. -;; Again, see `c-ts-mode--indent-styles' for example. -;; ;;; Code: @@ -82,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 @@ -92,21 +89,109 @@ :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. + +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 + (c-ts-mode-set-style val))) + res) + (let ((buffer (car buffers))) + (with-current-buffer buffer + (if (derived-mode-p 'c-ts-mode 'c++-ts-mode) + (loop (append res (list buffer)) (cdr buffers)) + (loop res (cdr buffers)))))))) + (defcustom c-ts-mode-indent-style 'gnu "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) - (symbol :tag "K&R" 'k&r) - (symbol :tag "Linux" 'linux) - (symbol :tag "BSD" 'bsd) + :type '(choice (symbol :tag "Gnu" gnu) + (symbol :tag "K&R" k&r) + (symbol :tag "Linux" linux) + (symbol :tag "BSD" bsd) (function :tag "A function for user customized style" ignore)) + :set #'c-ts-mode--indent-style-setter :group 'c) +(defun c-ts-mode--get-indent-style (mode) + "Helper function to set indentation style. +MODE is either `c' or `cpp'." + (let ((style + (if (functionp c-ts-mode-indent-style) + (funcall c-ts-mode-indent-style) + (alist-get c-ts-mode-indent-style (c-ts-mode--indent-styles mode))))) + `((,mode ,@style)))) + +(defun c-ts-mode--prompt-for-style () + "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 + "Style: " + (mapcar #'car (c-ts-mode--indent-styles mode)) + nil t nil nil "gnu")))) + +(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 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-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'") + (setq-local c-ts-mode-indent-style style) + (setq treesit-simple-indent-rules + (treesit--indent-rules-optimize + (c-ts-mode--get-indent-style + (if (derived-mode-p 'c-ts-mode) 'c 'cpp)))))) + ;;; Syntax table (defvar c-ts-mode--syntax-table @@ -155,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) @@ -175,25 +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-mode--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) - - ;; {} blocks. - ((node-is "}") point-min c-ts-mode--close-bracket-offset) - ((parent-is "compound_statement") - point-min c-ts-mode--statement-offset) - ((parent-is "enumerator_list") - point-min c-ts-mode--statement-offset) - ((parent-is "field_declaration_list") - point-min c-ts-mode--statement-offset) + 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) @@ -210,31 +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))) - ((parent-is "initializer_list") parent-bol c-ts-mode-indent-offset) - ((parent-is "if_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "for_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "while_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "switch_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "case_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "do_statement") parent-bol c-ts-mode-indent-offset) + + ;; int[5] a = { 0, 0, 0, 0 }; + ((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. + ((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. + ((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. + ((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") 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) @@ -249,85 +461,13 @@ MODE is either `c' or `cpp'." ((parent-is "do_statement") parent-bol 0) ,@common)))) -(defun c-ts-mode--set-indent-style (mode) - "Helper function to set indentation style. -MODE is either `c' or `cpp'." - (let ((style - (if (functionp c-ts-mode-indent-style) - (funcall c-ts-mode-indent-style) - (pcase c-ts-mode-indent-style - ('gnu (alist-get 'gnu (c-ts-mode--indent-styles mode))) - ('k&r (alist-get 'k&r (c-ts-mode--indent-styles mode))) - ('bsd (alist-get 'bsd (c-ts-mode--indent-styles mode))) - ('linux (alist-get 'linux (c-ts-mode--indent-styles mode))))))) - `((,mode ,@style)))) - -(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"))))) - -(defvar c-ts-mode-indent-block-type-regexp - (rx (or "compound_statement" - "field_declaration_list" - "enumerator_list")) - "Regexp matching types of block nodes (i.e., {} blocks).") - -(defun c-ts-mode--statement-offset (node parent &rest _) - "This anchor is used for children of a statement inside a block. - -This function basically counts the number of block nodes (defined -by `c-ts-mode--indent-block-type-regexp') between NODE and the -root node (not counting NODE itself), and multiply that by -`c-ts-mode-indent-offset'. - -To support GNU style, on each block level, this function also -checks whether the opening bracket { is on its own line, if so, -it adds an extra level, except for the top-level. - -PARENT is NODE's parent." - (let ((level 0)) - ;; If point is on an empty line, NODE would be nil, but we pretend - ;; there is a statement node. - (when (null node) - (setq node t)) - (while (if (eq node t) - (setq node parent) - (setq node (treesit-node-parent node))) - (when (string-match-p c-ts-mode-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 immedate - ;; 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-mode-indent-block-type-regexp - parent-type))) - nil) - ;; Add a level. - ((looking-back (rx bol (* whitespace)) - (line-beginning-position)) - (cl-incf level)))))) - (* level c-ts-mode-indent-offset))) - -(defun c-ts-mode--close-bracket-offset (node parent &rest _) - "Offset for the closing bracket, NODE. -It's basically one level less that the statements in the block. -PARENT is NODE's parent." - (- (c-ts-mode--statement-offset node parent) - c-ts-mode-indent-offset)) +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 @@ -457,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) - ;; Should we highlight identifiers in the parameter list? - ;; (parameter_declaration - ;; declarator: (_) @c-ts-mode--fontify-declarator)) + (parameter_declaration + declarator: (_) @c-ts-mode--fontify-declarator) + + (enumerator + name: (identifier) @font-lock-property-name-face)) :language mode :feature 'assignment @@ -471,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)) @@ -483,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 @@ -505,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 @@ -567,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. @@ -582,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. @@ -726,16 +870,19 @@ the semicolon. This function skips the semicolon." ;;; Modes -(defvar-keymap c-ts-mode-map - :doc "Keymap for the C language with tree-sitter" +(defvar-keymap c-ts-base-mode-map + :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-q" #'c-ts-mode-indent-defun + "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" "Major mode for editing C, powered by tree-sitter. -\\{c-ts-mode-map}" +\\{c-ts-base-mode-map}" :syntax-table c-ts-mode--syntax-table ;; Navigation. @@ -751,6 +898,37 @@ the semicolon. This function skips the semicolon." (setq-local treesit-defun-skipper #'c-ts-mode--defun-skipper) (setq-local treesit-defun-name-function #'c-ts-mode--defun-name) + (setq-local treesit-sentence-type-regexp + ;; compound_statement makes us jump over too big units + ;; of code, so skip that one, and include the other + ;; statements. + (regexp-opt '("preproc" + "declaration" + "specifier" + "attributed_statement" + "labeled_statement" + "expression_statement" + "if_statement" + "switch_statement" + "do_statement" + "while_statement" + "for_statement" + "return_statement" + "break_statement" + "continue_statement" + "goto_statement" + "case_statement"))) + + (setq-local treesit-sexp-type-regexp + (regexp-opt '("preproc" + "declarator" + "qualifier" + "type" + "parameter" + "expression" + "literal" + "string"))) + ;; Nodes like struct/enum/union_specifier can appear in ;; function_definitions, so we need to find the top-level node. (setq-local treesit-defun-prefer-top-level t) @@ -758,20 +936,34 @@ the semicolon. This function skips the semicolon." ;; Indent. (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) + ;; 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 (let ((pred #'c-ts-mode--defun-valid-p)) - `(("Struct" ,(rx bos (or "struct" "enum" "union") - "_specifier" eos) - ,pred nil) + `(("Enum" "\\`enum_specifier\\'" ,pred nil) + ("Struct" "\\`struct_specifier\\'" ,pred nil) + ("Union" "\\`union_specifier\\'" ,pred nil) ("Variable" ,(rx bos "declaration" eos) ,pred nil) ("Function" "\\`function_definition\\'" ,pred nil) ("Class" ,(rx bos (or "class_specifier" @@ -782,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" @@ -802,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) @@ -810,9 +1003,11 @@ in your configuration." (setq-local comment-end " */") ;; Indent. (setq-local treesit-simple-indent-rules - (c-ts-mode--set-indent-style 'c)) + (c-ts-mode--get-indent-style 'c)) ;; Font-lock. (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c)) + ;; Navigation. + (setq-local treesit-defun-tactic 'top-level) (treesit-major-mode-setup))) ;;;###autoload @@ -832,17 +1027,26 @@ 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 + (regexp-opt '("comment" + "raw_string_literal"))) + (treesit-parser-create 'cpp) + ;; Syntax. (setq-local syntax-propertize-function #'c-ts-mode--syntax-propertize) + ;; Indent. (setq-local treesit-simple-indent-rules - (c-ts-mode--set-indent-style 'cpp)) + (c-ts-mode--get-indent-style 'cpp)) + ;; Font-lock. (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp)) + (treesit-major-mode-setup))) ;; We could alternatively use parsers, but if this works well, I don't @@ -896,10 +1100,15 @@ the code is C or C++ and based on that chooses whether to enable '("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'" . c++-ts-mode))) -(if (treesit-ready-p 'c) - (add-to-list 'auto-mode-alist - '("\\(\\.[chi]\\|\\.lex\\|\\.y\\(acc\\)?\\|\\.x[bp]m\\)\\'" - . c-ts-mode))) +(when (treesit-ready-p 'c) + (add-to-list 'auto-mode-alist + '("\\(\\.[chi]\\|\\.lex\\|\\.y\\(acc\\)?\\)\\'" . c-ts-mode)) + (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . c-ts-mode)) + ;; image-mode's association must be before the C mode, otherwise XPM + ;; images will be initially visited as C files. Also note that the + ;; regexp must be different from what files.el does, or else + ;; add-to-list will not add the association where we want it. + (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . image-mode))) (if (and (treesit-ready-p 'cpp) (treesit-ready-p 'c)) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index bdbc03e7c94..aa6f33e9cab 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1994,7 +1994,7 @@ when it's needed. The default is the current language taken from ;; doesn't occur in any word in LIST. Append it to all ;; the alternatives where we want to add \>. Run through ;; `regexp-opt' and then replace it with \>. - (let ((unique "") pos) + (let ((unique "") (list1 (copy-tree list)) pos) (while (let (found) (setq unique (concat unique "@") pos list) @@ -2005,13 +2005,12 @@ when it's needed. The default is the current language taken from t)) (setq pos (cdr pos))) found)) - (setq pos (copy-tree list) - ) + (setq pos list1) (while pos (if (string-match "\\w\\'" (car pos)) (setcar pos (concat (car pos) unique))) (setq pos (cdr pos))) - (setq re (regexp-opt list)) + (setq re (regexp-opt list1)) (setq pos 0) (while (string-match unique re pos) (setq pos (+ (match-beginning 0) 2) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index ebcb20f0f8c..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)))) @@ -5915,19 +5915,21 @@ comment at the start of cc-engine.el for more info." (cond ((> pos start) ; Nothing but literals base) - ((> base (point-min)) + ((and + (> base (point-min)) + (> (- base try-size) (point-min))) ; prevent infinite recursion. (c-determine-limit how-far-back base (* 2 try-size) org-start)) (t base))) ((>= count how-far-back) (c-determine-limit-no-macro - (+ (car elt) (- count how-far-back)) - org-start)) + (+ (car elt) (- count how-far-back)) + org-start)) ((eq base (point-min)) (point-min)) ((> base (- start try-size)) ; Can only happen if we hit point-min. (c-determine-limit-no-macro - (car elt) - org-start)) + (car elt) + org-start)) (t (c-determine-limit (- how-far-back count) base (* 2 try-size) org-start)))))) @@ -7357,7 +7359,7 @@ multi-line strings (but not C++, for example)." (cons (match-beginning 1) (cons (match-end 1) (match-beginning 2)))) (goto-char here)))) - + (defun c-ml-string-opener-intersects-region (&optional start finish) ;; If any part of the region [START FINISH] is inside an ml-string opener, ;; return a dotted list of the start, end and double-quote position of that @@ -8288,10 +8290,17 @@ multi-line strings (but not C++, for example)." (setq c-record-ref-identifiers (cons range c-record-ref-identifiers)))))) -(defmacro c-forward-keyword-prefixed-id (type) +(defmacro c-forward-keyword-prefixed-id (type &optional stop-at-end) ;; Used internally in `c-forward-keyword-clause' to move forward ;; over a type (if TYPE is 'type) or a name (otherwise) which ;; possibly is prefixed by keywords and their associated clauses. + ;; Point should be at the type/name or a preceding keyword at the start of + ;; the macro, and it is left at the first token following the type/name, + ;; or (when STOP-AT-END is non-nil) immediately after that type/name. + ;; + ;; Note that both parameters are evaluated at compile time, not run time, + ;; so they must be constants. + ;; ;; Try with a type/name first to not trip up on those that begin ;; with a keyword. Return t if a known or found type is moved ;; over. The point is clobbered if nil is returned. If range @@ -8300,51 +8309,84 @@ multi-line strings (but not C++, for example)." ;; ;; This macro might do hidden buffer changes. (declare (debug t)) - `(let (res) + `(let (res pos) (setq c-last-identifier-range nil) (while (if (setq res ,(if (eq type 'type) - '(c-forward-type) - '(c-forward-name))) - nil - (cond ((looking-at c-keywords-regexp) - (c-forward-keyword-clause 1)) - ((and c-opt-cpp-prefix - (looking-at c-noise-macro-with-parens-name-re)) - (c-forward-noise-clause))))) + `(c-forward-type nil ,stop-at-end) + `(c-forward-name ,stop-at-end))) + (progn + (setq pos (point)) + nil) + (and + (cond ((looking-at c-keywords-regexp) + (c-forward-keyword-clause 1 t)) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause t))) + (progn + (setq pos (point)) + (c-forward-syntactic-ws) + t)))) (when (memq res '(t known found prefix maybe)) (when c-record-type-identifiers - ,(if (eq type 'type) - '(c-record-type-id c-last-identifier-range) - '(c-record-ref-id c-last-identifier-range))) + ,(if (eq type 'type) + '(c-record-type-id c-last-identifier-range) + '(c-record-ref-id c-last-identifier-range))) + (when pos + (goto-char pos) + ,(unless stop-at-end + `(c-forward-syntactic-ws))) t))) -(defmacro c-forward-id-comma-list (type update-safe-pos) +(defmacro c-forward-id-comma-list (type update-safe-pos &optional stop-at-end) ;; Used internally in `c-forward-keyword-clause' to move forward ;; over a comma separated list of types or names using - ;; `c-forward-keyword-prefixed-id'. + ;; `c-forward-keyword-prefixed-id'. Point should start at the first token + ;; after the already scanned type/name, or (if STOP-AT-END is non-nil) + ;; immediately after that type/name. Point is left either before or + ;; after the whitespace following the last type/name in the list, depending + ;; on whether STOP-AT-END is non-nil or nil. The return value is without + ;; significance. + ;; + ;; Note that all three parameters are evaluated at compile time, not run + ;; time, so they must be constants. ;; ;; This macro might do hidden buffer changes. (declare (debug t)) - `(while (and (progn - ,(when update-safe-pos - '(setq safe-pos (point))) - (eq (char-after) ?,)) - (progn - (forward-char) - (c-forward-syntactic-ws) - (c-forward-keyword-prefixed-id ,type))))) + `(let ((pos (point))) + (while (and (progn + ,(when update-safe-pos + `(setq safe-pos (point))) + (setq pos (point)) + (c-forward-syntactic-ws) + (eq (char-after) ?,)) + (progn + (forward-char) + (setq pos (point)) + (c-forward-syntactic-ws) + (c-forward-keyword-prefixed-id ,type t)))) + (goto-char pos) + ,(unless stop-at-end + `(c-forward-syntactic-ws)))) -(defun c-forward-noise-clause () +(defun c-forward-noise-clause (&optional stop-at-end) ;; Point is at a c-noise-macro-with-parens-names macro identifier. Go ;; forward over this name, any parenthesis expression which follows it, and - ;; any syntactic WS, ending up at the next token or EOB. If there is an + ;; any syntactic WS, ending up either at the next token or EOB or (when + ;; STOP-AT-END is non-nil) directly after the clause. If there is an ;; unbalanced paren expression, leave point at it. Always Return t. - (or (zerop (c-forward-token-2)) - (goto-char (point-max))) - (if (and (eq (char-after) ?\() - (c-go-list-forward)) + (let (pos) + (or (c-forward-over-token) + (goto-char (point-max))) + (setq pos (point)) + (c-forward-syntactic-ws) + (when (and (eq (char-after) ?\() + (c-go-list-forward)) + (setq pos (point))) + (goto-char pos) + (unless stop-at-end (c-forward-syntactic-ws)) - t) + t)) (defun c-forward-noise-clause-not-macro-decl (maybe-parens) ;; Point is at a noise macro identifier, which, when MAYBE-PARENS is @@ -8378,11 +8420,12 @@ multi-line strings (but not C++, for example)." (goto-char here) nil))) -(defun c-forward-keyword-clause (match) +(defun c-forward-keyword-clause (match &optional stop-at-end) ;; Submatch MATCH in the current match data is assumed to surround a ;; token. If it's a keyword, move over it and any immediately - ;; following clauses associated with it, stopping at the start of - ;; the next token. t is returned in that case, otherwise the point + ;; following clauses associated with it, stopping either at the start + ;; of the next token, or (when STOP-AT-END is non-nil) at the end + ;; of the clause. t is returned in that case, otherwise the point ;; stays and nil is returned. The kind of clauses that are ;; recognized are those specified by `c-type-list-kwds', ;; `c-ref-list-kwds', `c-colon-type-list-kwds', @@ -8412,19 +8455,23 @@ multi-line strings (but not C++, for example)." (when kwd-sym (goto-char (match-end match)) - (c-forward-syntactic-ws) (setq safe-pos (point)) + (c-forward-syntactic-ws) (cond ((and (c-keyword-member kwd-sym 'c-type-list-kwds) - (c-forward-keyword-prefixed-id type)) + (c-forward-keyword-prefixed-id type t)) ;; There's a type directly after a keyword in `c-type-list-kwds'. - (c-forward-id-comma-list type t)) + (setq safe-pos (point)) + (c-forward-syntactic-ws) + (c-forward-id-comma-list type t t)) ((and (c-keyword-member kwd-sym 'c-ref-list-kwds) - (c-forward-keyword-prefixed-id ref)) + (c-forward-keyword-prefixed-id ref t)) ;; There's a name directly after a keyword in `c-ref-list-kwds'. - (c-forward-id-comma-list ref t)) + (setq safe-pos (point)) + (c-forward-syntactic-ws) + (c-forward-id-comma-list ref t t)) ((and (c-keyword-member kwd-sym 'c-paren-any-kwds) (eq (char-after) ?\()) @@ -8444,20 +8491,20 @@ multi-line strings (but not C++, for example)." (goto-char (match-end 0))))) (goto-char pos) - (c-forward-syntactic-ws) - (setq safe-pos (point)))) + (setq safe-pos (point))) + (c-forward-syntactic-ws)) ((and (c-keyword-member kwd-sym 'c-<>-sexp-kwds) (eq (char-after) ?<) (c-forward-<>-arglist (c-keyword-member kwd-sym 'c-<>-type-kwds))) - (c-forward-syntactic-ws) - (setq safe-pos (point))) + (setq safe-pos (point)) + (c-forward-syntactic-ws)) ((and (c-keyword-member kwd-sym 'c-nonsymbol-sexp-kwds) (not (looking-at c-symbol-start)) (c-safe (c-forward-sexp) t)) - (c-forward-syntactic-ws) - (setq safe-pos (point))) + (setq safe-pos (point)) + (c-forward-syntactic-ws)) ((and (c-keyword-member kwd-sym 'c-protection-kwds) (or (null c-post-protection-token) @@ -8467,8 +8514,8 @@ multi-line strings (but not C++, for example)." (not (c-end-of-current-token)))))) (if c-post-protection-token (goto-char (match-end 0))) - (c-forward-syntactic-ws) - (setq safe-pos (point)))) + (setq safe-pos (point)) + (c-forward-syntactic-ws))) (when (c-keyword-member kwd-sym 'c-colon-type-list-kwds) (if (eq (char-after) ?:) @@ -8477,8 +8524,10 @@ multi-line strings (but not C++, for example)." (progn (forward-char) (c-forward-syntactic-ws) - (when (c-forward-keyword-prefixed-id type) - (c-forward-id-comma-list type t))) + (when (c-forward-keyword-prefixed-id type t) + (setq safe-pos (point)) + (c-forward-syntactic-ws) + (c-forward-id-comma-list type t t))) ;; Not at the colon, so stop here. But the identifier ;; ranges in the type list later on should still be ;; recorded. @@ -8488,15 +8537,18 @@ multi-line strings (but not C++, for example)." ;; this one, we move forward to the colon following the ;; clause matched above. (goto-char safe-pos) + (c-forward-syntactic-ws) (c-forward-over-colon-type-list)) (progn (c-forward-syntactic-ws) - (c-forward-keyword-prefixed-id type)) + (c-forward-keyword-prefixed-id type t)) ;; There's a type after the `c-colon-type-list-re' match ;; after a keyword in `c-colon-type-list-kwds'. (c-forward-id-comma-list type nil)))) (goto-char safe-pos) + (unless stop-at-end + (c-forward-syntactic-ws)) t))) ;; cc-mode requires cc-fonts. @@ -8827,11 +8879,12 @@ multi-line strings (but not C++, for example)." (/= (point) start)))) -(defun c-forward-name () - ;; Move forward over a complete name if at the beginning of one, - ;; stopping at the next following token. A keyword, as such, - ;; doesn't count as a name. If the point is not at something that - ;; is recognized as a name then it stays put. +(defun c-forward-name (&optional stop-at-end) + ;; Move forward over a complete name if at the beginning of one, stopping + ;; either at the next following token or (when STOP-AT-END is non-nil) at + ;; the end of the name. A keyword, as such, doesn't count as a name. If + ;; the point is not at something that is recognized as a name then it stays + ;; put. ;; ;; A name could be something as simple as "foo" in C or something as ;; complex as "X<Y<class A<int>::B, BIT_MAX >> b>, ::operator<> :: @@ -8853,7 +8906,7 @@ multi-line strings (but not C++, for example)." ;; ;; This function might do hidden buffer changes. - (let ((pos (point)) (start (point)) res id-start id-end + (let ((pos (point)) pos2 pos3 (start (point)) res id-start id-end ;; Turn off `c-promote-possible-types' here since we might ;; call `c-forward-<>-arglist' and we don't want it to promote ;; every suspect thing in the arglist to a type. We're @@ -8895,7 +8948,7 @@ multi-line strings (but not C++, for example)." (c-forward-syntactic-ws lim+) (cond ((eq (char-before id-end) ?e) ;; Got "... ::template". - (let ((subres (c-forward-name))) + (let ((subres (c-forward-name t))) (when subres (setq pos (point) res subres)))) @@ -8907,7 +8960,7 @@ multi-line strings (but not C++, for example)." (and (eq (c-forward-token-2) 0) (not (eq (char-after) ?\()))))) ;; Got a cast operator. - (when (c-forward-type) + (when (c-forward-type nil t) (setq pos (point) res 'operator) ;; Now we should match a sequence of either @@ -8931,8 +8984,8 @@ multi-line strings (but not C++, for example)." (forward-char) t))))) (while (progn - (c-forward-syntactic-ws lim+) (setq pos (point)) + (c-forward-syntactic-ws lim+) (and (<= (point) lim+) (looking-at c-opt-type-modifier-key))) @@ -8947,30 +9000,34 @@ multi-line strings (but not C++, for example)." ;; operator"" has an (?)optional tag after it. (progn (goto-char (match-end 0)) + (setq pos2 (point)) (c-forward-syntactic-ws lim+) (when (c-on-identifier) - (c-forward-token-2 1 nil lim+))) - (goto-char (match-end 0)) - (c-forward-syntactic-ws lim+)) - (setq pos (point) + (c-forward-over-token nil lim+))) + (goto-char (match-end 0)) + (setq pos2 (point)) + (c-forward-syntactic-ws lim+)) + (setq pos pos2 res 'operator))) nil) ;; `id-start' is equal to `id-end' if we've jumped over ;; an identifier that doesn't end with a symbol token. - ;; That can occur e.g. for Java import directives on the + ;; That can occur e.g. for Java import directives of the ;; form "foo.bar.*". (when (and id-start (/= id-start id-end)) (setq c-last-identifier-range (cons id-start id-end))) (goto-char id-end) + (setq pos (point)) (c-forward-syntactic-ws lim+) - (setq pos (point) - res t))) + (setq res t))) (progn (goto-char pos) + (c-forward-syntactic-ws lim+) + (setq pos3 (point)) (when (or c-opt-identifier-concat-key c-recognize-<>-arglists) @@ -8981,7 +9038,6 @@ multi-line strings (but not C++, for example)." ;; cases with tricky syntactic whitespace that aren't ;; covered in `c-identifier-key'. (goto-char (match-end 0)) - (c-forward-syntactic-ws lim+) t) ((and c-recognize-<>-arglists @@ -8993,11 +9049,12 @@ multi-line strings (but not C++, for example)." ;; `lim+'. (setq lim+ (c-determine-+ve-limit 500)) + (setq pos2 (point)) (c-forward-syntactic-ws lim+) (unless (eq (char-after) ?\() (setq c-last-identifier-range nil) - (c-add-type start (1+ pos))) - (setq pos (point)) + (c-add-type start (1+ pos3))) + (setq pos pos2) (if (and c-opt-identifier-concat-key (looking-at c-opt-identifier-concat-key)) @@ -9007,7 +9064,7 @@ multi-line strings (but not C++, for example)." (progn (when (and c-record-type-identifiers id-start) (c-record-ref-id (cons id-start id-end))) - (forward-char 2) + (goto-char (match-end 0)) (c-forward-syntactic-ws lim+) t) @@ -9019,11 +9076,14 @@ multi-line strings (but not C++, for example)." ))))) (goto-char pos) + (unless stop-at-end + (c-forward-syntactic-ws lim+)) res)) -(defun c-forward-type (&optional brace-block-too) +(defun c-forward-type (&optional brace-block-too stop-at-end) ;; Move forward over a type spec if at the beginning of one, - ;; stopping at the next following token. The keyword "typedef" + ;; stopping at the next following token (if STOP-AT-END is nil) or + ;; at the end of the type spec (otherwise). The keyword "typedef" ;; isn't part of a type spec here. ;; ;; BRACE-BLOCK-TOO, when non-nil, means move over the brace block in @@ -9072,6 +9132,7 @@ multi-line strings (but not C++, for example)." (when (looking-at c-no-type-key) (setq res 'no-id))) (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (or (eq res 'no-id) (setq res 'prefix)))) @@ -9080,32 +9141,41 @@ multi-line strings (but not C++, for example)." (cond ((looking-at c-typeof-key) ; e.g. C++'s "decltype". (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (setq res (and (eq (char-after) ?\() (c-safe (c-forward-sexp)) 'decltype)) (if res - (c-forward-syntactic-ws) + (progn + (setq pos (point)) + (c-forward-syntactic-ws)) (goto-char start))) ((looking-at c-type-prefix-key) ; e.g. "struct", "class", but NOT ; "typedef". (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (while (cond ((looking-at c-decl-hangon-key) - (c-forward-keyword-clause 1)) + (c-forward-keyword-clause 1 t) + (setq pos (point)) + (c-forward-syntactic-ws)) ((looking-at c-pack-key) (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws)) ((and c-opt-cpp-prefix (looking-at c-noise-macro-with-parens-name-re)) - (c-forward-noise-clause)))) + (c-forward-noise-clause t) + (setq pos (point)) + (c-forward-syntactic-ws)))) + (setq id-start (point)) + (setq name-res (c-forward-name t)) (setq pos (point)) - - (setq name-res (c-forward-name)) (setq res (not (null name-res))) (when (eq name-res t) ;; With some keywords the name can be used without the prefix, so we @@ -9113,21 +9183,21 @@ multi-line strings (but not C++, for example)." (when (save-excursion (goto-char post-prefix-pos) (looking-at c-self-contained-typename-key)) - (c-add-type pos (save-excursion - (c-backward-syntactic-ws) - (point)))) + (c-add-type id-start + (point))) (when (and c-record-type-identifiers c-last-identifier-range) (c-record-type-id c-last-identifier-range))) + (c-forward-syntactic-ws) (when (and brace-block-too (memq res '(t nil)) (eq (char-after) ?\{) (save-excursion (c-safe (progn (c-forward-sexp) - (c-forward-syntactic-ws) (setq pos (point)))))) (goto-char pos) + (c-forward-syntactic-ws) (setq res t)) (unless res (goto-char start))) ; invalid syntax @@ -9141,7 +9211,7 @@ multi-line strings (but not C++, for example)." (if (looking-at c-identifier-start) (save-excursion (setq id-start (point) - name-res (c-forward-name)) + name-res (c-forward-name t)) (when name-res (setq id-end (point) id-range c-last-identifier-range)))) @@ -9154,8 +9224,9 @@ multi-line strings (but not C++, for example)." (>= (save-excursion (save-match-data (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) - (setq pos (point)))) + pos)) id-end) (setq res nil))))) ;; Looking at a primitive or known type identifier. We've @@ -9173,35 +9244,41 @@ multi-line strings (but not C++, for example)." (looking-at c-opt-type-component-key))) ;; There might be more keywords for the type. (let (safe-pos) - (c-forward-keyword-clause 1) + (c-forward-keyword-clause 1 t) (while (progn (setq safe-pos (point)) + (c-forward-syntactic-ws) (looking-at c-opt-type-component-key)) (when (and c-record-type-identifiers (looking-at c-primitive-type-key)) (c-record-type-id (cons (match-beginning 1) (match-end 1)))) - (c-forward-keyword-clause 1)) + (c-forward-keyword-clause 1 t)) (if (looking-at c-primitive-type-key) (progn (when c-record-type-identifiers (c-record-type-id (cons (match-beginning 1) (match-end 1)))) - (c-forward-keyword-clause 1) + (c-forward-keyword-clause 1 t) (setq res t)) (goto-char safe-pos) - (setq res 'prefix))) - (unless (save-match-data (c-forward-keyword-clause 1)) + (setq res 'prefix)) + (setq pos (point))) + (if (save-match-data (c-forward-keyword-clause 1 t)) + (setq pos (point)) (if pos (goto-char pos) (goto-char (match-end 1)) - (c-forward-syntactic-ws))))) + (setq pos (point))))) + (c-forward-syntactic-ws)) ((and (eq name-res t) (eq res 'prefix) (c-major-mode-is 'c-mode) (save-excursion (goto-char id-end) + (setq pos (point)) + (c-forward-syntactic-ws) (and (not (looking-at c-symbol-start)) (not (looking-at c-type-decl-prefix-key))))) ;; A C specifier followed by an implicit int, e.g. @@ -9213,13 +9290,11 @@ multi-line strings (but not C++, for example)." (cond ((eq name-res t) ;; A normal identifier. (goto-char id-end) + (setq pos (point)) (if (or res c-promote-possible-types) (progn (when (not (eq c-promote-possible-types 'just-one)) - (c-add-type id-start (save-excursion - (goto-char id-end) - (c-backward-syntactic-ws) - (point)))) + (c-add-type id-start id-end)) (when (and c-record-type-identifiers id-range) (c-record-type-id id-range)) (unless res @@ -9233,6 +9308,7 @@ multi-line strings (but not C++, for example)." ((eq name-res 'template) ;; A template is sometimes a type. (goto-char id-end) + (setq pos (point)) (c-forward-syntactic-ws) (setq res (if (eq (char-after) ?\() @@ -9258,6 +9334,7 @@ multi-line strings (but not C++, for example)." (when c-opt-type-modifier-key (while (looking-at c-opt-type-modifier-key) ; e.g. "const", "volatile" (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (setq res t))) @@ -9268,11 +9345,13 @@ multi-line strings (but not C++, for example)." (when c-opt-type-suffix-key ; e.g. "..." (while (looking-at c-opt-type-suffix-key) (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws))) ;; Skip any "WS" identifiers (e.g. "final" or "override" in C++) (while (looking-at c-type-decl-suffix-ws-ids-key) (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (setq res t)) @@ -9296,7 +9375,8 @@ multi-line strings (but not C++, for example)." (progn (goto-char (match-end 1)) (c-forward-syntactic-ws) - (setq subres (c-forward-type)))) + (setq subres (c-forward-type nil t)) + (setq pos (point)))) (progn ;; If either operand certainly is a type then both are, but we @@ -9332,9 +9412,11 @@ multi-line strings (but not C++, for example)." ;; `nconc' doesn't mind that the tail of ;; `c-record-found-types' is t. (nconc c-record-found-types - c-record-type-identifiers)))) + c-record-type-identifiers))))))) - (goto-char pos)))) + (goto-char pos) + (unless stop-at-end + (c-forward-syntactic-ws)) (when (and c-record-found-types (memq res '(known found)) id-range) (setq c-record-found-types @@ -9737,7 +9819,7 @@ point unchanged and return nil." ;; (e.g. "," or ";" or "}"). (let ((here (point)) id-start id-end brackets-after-id paren-depth decorated - got-init arglist double-double-quote) + got-init arglist double-double-quote pos) (or limit (setq limit (point-max))) (if (and (< (point) limit) @@ -9771,6 +9853,7 @@ point unchanged and return nil." (eq (char-after (1+ (point))) ?\")) (setq double-double-quote t)) (goto-char (match-end 0)) + (setq pos (point)) (c-forward-syntactic-ws limit) (setq got-identifier t) nil) @@ -9783,7 +9866,10 @@ point unchanged and return nil." ;; prefix only if it specifies a member pointer. (progn (setq id-start (point)) - (when (c-forward-name) + (when (c-forward-name t) + (setq pos (point)) + (c-forward-syntactic-ws limit) + (if (save-match-data (looking-at "\\(::\\)")) ;; We only check for a trailing "::" and @@ -9812,10 +9898,12 @@ point unchanged and return nil." (setq id-start (point))) (cond ((or got-identifier - (c-forward-name)) - (save-excursion - (c-backward-syntactic-ws) - (setq id-end (point)))) + (c-forward-name t)) + (setq id-end + (or pos + (point))) + (c-forward-syntactic-ws limit) + t) (accept-anon (setq id-start nil id-end nil) t) @@ -10060,6 +10148,24 @@ This function might do hidden buffer changes." ;; This identifier is bound only in the inner let. '(setq start id-start)))) +(defmacro c-fdoc-assymetric-space-about-asterisk () + ;; We've got a "*" at `id-start' between two identifiers, the first at + ;; `type-start'. Return non-nil when there is either whitespace between the + ;; first id and the "*" or between the "*" and the second id, but not both. + `(let ((space-before-id + (save-excursion + (goto-char id-start) ; Position of "*". + (and (> (skip-chars-forward "* \t\n\r") 0) + (memq (char-before) '(?\ ?\t ?\n ?\r))))) + (space-after-type + (save-excursion + (goto-char type-start) + (and (c-forward-type nil t) + (or (eolp) + (memq (char-after) '(?\ ?\t))))))) + (not (eq (not space-before-id) + (not space-after-type))))) + (defun c-forward-decl-or-cast-1 (preceding-token-end context last-cast-end &optional inside-macro) ;; Move forward over a declaration or a cast if at the start of one. @@ -10569,11 +10675,11 @@ This function might do hidden buffer changes." (or got-identifier (and (looking-at c-identifier-start) (setq pos (point)) - (setq got-identifier (c-forward-name)) + (setq got-identifier (c-forward-name t)) (save-excursion - (c-backward-syntactic-ws) (c-simple-skip-symbol-backward) (setq identifier-start (point))) + (progn (c-forward-syntactic-ws) t) (setq name-start pos)) (when (looking-at "[0-9]") (setq got-number t)) ; We probably have an arithmetic expression. @@ -10796,8 +10902,7 @@ This function might do hidden buffer changes." type-start (progn (goto-char type-start) - (c-forward-type) - (c-backward-syntactic-ws) + (c-forward-type nil t) (point))))))))) ;; Got a declaration of the form "foo bar (gnu);" or "bar ;; (gnu);" where we've recognized "bar" as the type and "gnu" @@ -11081,19 +11186,25 @@ This function might do hidden buffer changes." ;; CASE 16 (when (and got-prefix-before-parens at-type - (or at-decl-end (looking-at "=[^=]")) (memq context '(nil top)) (or (not got-suffix) at-decl-start)) ;; Got something like "foo * bar;". Since we're not inside ;; an arglist it would be a meaningless expression because ;; the result isn't used. We therefore choose to recognize - ;; it as a declaration. We only allow a suffix (which makes - ;; the construct look like a function call) when - ;; `at-decl-start' provides additional evidence that we do - ;; have a declaration. + ;; it as a declaration when there's "symmetrical WS" around + ;; the "*" or the flag `c-assymetry-fontification-flag' is + ;; not set. We only allow a suffix (which makes the + ;; construct look like a function call) when `at-decl-start' + ;; provides additional evidence that we do have a + ;; declaration. (setq maybe-expression t) - (throw 'at-decl-or-cast t)) + (when (or (not c-asymmetry-fontification-flag) + (looking-at "=[^=]") + (c-fdoc-assymetric-space-about-asterisk)) + (when (eq at-type 'maybe) + (setq unsafe-maybe t)) + (throw 'at-decl-or-cast t))) ;; CASE 17 (when (and (or got-suffix-after-parens @@ -11112,25 +11223,12 @@ This function might do hidden buffer changes." got-prefix-before-parens at-type (or (not got-suffix) - at-decl-start)) - (let ((space-before-id - (save-excursion - (goto-char id-start) ; Position of "*". - (and (> (skip-chars-forward "* \t\n\r") 0) - (memq (char-before) '(?\ ?\t ?\n ?\r))))) - (space-after-type - (save-excursion - (goto-char type-start) - (and (c-forward-type) - (progn (c-backward-syntactic-ws) t) - (or (eolp) - (memq (char-after) '(?\ ?\t))))))) - (when (not (eq (not space-before-id) - (not space-after-type))) - (when (eq at-type 'maybe) - (setq unsafe-maybe t)) - (setq maybe-expression t) - (throw 'at-decl-or-cast t))))) + at-decl-start) + (c-fdoc-assymetric-space-about-asterisk)) + (when (eq at-type 'maybe) + (setq unsafe-maybe t)) + (setq maybe-expression t) + (throw 'at-decl-or-cast t))) ;; CASE 18 (when (and at-decl-end @@ -14813,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/cc-vars.el b/lisp/progmodes/cc-vars.el index 2206e0fcab6..afeb88c7b8a 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -232,6 +232,7 @@ See `c-offsets-alist'." (setq offset (cdr offset))) (null offset))))) +;;;###autoload (defun c-string-list-p (val) "Return non-nil if VAL is a list of strings." (and @@ -1576,8 +1577,11 @@ also elsewhere in CC Mode to tell types from other identifiers.")) "For example, a value of (\"FILE\" \"\\\\sw+_t\") means the word \"FILE\" and words ending in \"_t\" are treated as type names.") :type 'c-extra-types-widget + :safe #'c-string-list-p :group 'c) +;;;###autoload (put 'c-font-lock-extra-types 'safe-local-variable #'c-string-list-p) + (defcustom c++-font-lock-extra-types '("\\sw+_t" ;; C library types (except those matched by the _t pattern): @@ -1607,18 +1611,23 @@ and words ending in \"_t\" are treated as type names.") "For example, a value of (\"string\") means the word \"string\" is treated as a type name.") :type 'c-extra-types-widget + :safe #'c-string-list-p :group 'c) -(defcustom objc-font-lock-extra-types - (list (concat "[" c-upper "]\\sw*[" c-lower "]\\sw*")) +;;;###autoload (put 'c++-font-lock-extra-types 'safe-local-variable #'c-string-list-p) + +(defcustom objc-font-lock-extra-types nil (c-make-font-lock-extra-types-blurb "ObjC" "objc-mode" (concat "For example, a value of (\"[" c-upper "]\\\\sw*[" c-lower "]\\\\sw*\") means capitalized words are treated as type names (the requirement for a lower case char is to avoid recognizing all-caps macro and constant names).")) :type 'c-extra-types-widget + :safe #'c-string-list-p :group 'c) +;;;###autoload (put 'objc-font-lock-extra-types 'safe-local-variable #'c-string-list-p) + (defcustom java-font-lock-extra-types (list (concat "[" c-upper "]\\sw*[" c-lower "]\\sw")) (c-make-font-lock-extra-types-blurb "Java" "java-mode" (concat @@ -1626,13 +1635,19 @@ names).")) capitalized words are treated as type names (the requirement for a lower case char is to avoid recognizing all-caps constant names).")) :type 'c-extra-types-widget + :safe #'c-string-list-p :group 'c) +;;;###autoload (put 'java-font-lock-extra-types 'safe-local-variable #'c-string-list-p) + (defcustom idl-font-lock-extra-types nil (c-make-font-lock-extra-types-blurb "IDL" "idl-mode" "") :type 'c-extra-types-widget + :safe #'c-string-list-p :group 'c) +;;;###autoload (put 'idl-font-lock-extra-types 'safe-local-variable #'c-string-list-p) + (defcustom pike-font-lock-extra-types (list (concat "[" c-upper "]\\sw*[" c-lower "]\\sw*")) (c-make-font-lock-extra-types-blurb "Pike" "pike-mode" (concat @@ -1641,8 +1656,11 @@ capitalized words are treated as type names (the requirement for a lower case char is to avoid recognizing all-caps macro and constant names).")) :type 'c-extra-types-widget + :safe #'c-string-list-p :group 'c) +;;;###autoload (put 'pike-font-lock-extra-types 'safe-local-variable #'c-string-list-p) + (defcustom c-asymmetry-fontification-flag t "Whether to fontify certain ambiguous constructs by white space asymmetry. 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 852e893dc25..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)) @@ -910,6 +942,11 @@ Key bindings: ;; Comments. (c-ts-common-comment-setup) + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" + "verbatim_string-literal" + "interpolated_verbatim_string-text"))) + ;; Indent. (setq-local treesit-simple-indent-rules csharp-ts-mode--indent-rules) @@ -925,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/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index 2a295e885b0..c9125bc6cbd 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -51,9 +51,27 @@ ((parent-is "expose_instruction") (nth-sibling 1) 0) ((parent-is "label_instruction") (nth-sibling 1) 0) ((parent-is "shell_command") first-sibling 0) - ((parent-is "string_array") first-sibling 1))) + ((parent-is "string_array") first-sibling 1) + ((dockerfile-ts-mode--line-continuation-p) dockerfile-ts-mode--line-continuation-anchor 0))) "Tree-sitter indent rules.") +(defun dockerfile-ts-mode--line-continuation-p () + "Return t if the current node is a line continuation node." + (lambda (node _ _ &rest _) + (string= (treesit-node-type node) "\n"))) + +(defun dockerfile-ts-mode--line-continuation-anchor (_ _ &rest _) + "This anchor is used to align any nodes that are part of a line +continuation to the previous entry." + (save-excursion + (forward-line -1) + (let ((prev-node (treesit-node-at (point)))) + (if (string= (treesit-node-type prev-node) "\\\n") + (back-to-indentation) + (forward-word) + (forward-char)) + (+ 1 (- (point) (pos-bol)))))) + (defvar dockerfile-ts-mode--keywords '("ADD" "ARG" "AS" "CMD" "COPY" "CROSS_BUILD" "ENTRYPOINT" "ENV" "EXPOSE" "FROM" "HEALTHCHECK" "LABEL" "MAINTAINER" "ONBUILD" "RUN" @@ -155,6 +173,10 @@ the subtrees." (setq-local treesit-simple-indent-rules dockerfile-ts-mode--indent-rules) + ;; Navigation + (setq-local treesit-sentence-type-regexp + "instruction") + ;; Font-lock. (setq-local treesit-font-lock-settings dockerfile-ts-mode--font-lock-settings) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index dc73152f5ab..fe9bc510049 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2023 Free Software Foundation, Inc. -;; Version: 1.10 +;; Version: 1.13 ;; Author: João Távora <joaotavora@gmail.com> ;; Maintainer: João Távora <joaotavora@gmail.com> ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1") (project "0.9.3") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23") (external-completion "0.1")) +;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.11.0") (seq "2.23") (external-completion "0.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any @@ -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 @@ -182,7 +184,7 @@ chosen (interactively or automatically)." when probe return (cons probe args) finally (funcall err))))))) -(defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ,(eglot-alternatives '("rust-analyzer" "rls"))) +(defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ("rust-analyzer")) ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) (vimrc-mode . ("vim-language-server" "--stdio")) ((python-mode python-ts-mode) @@ -219,9 +221,10 @@ chosen (interactively or automatically)." ((java-mode java-ts-mode) . ("jdtls")) (dart-mode . ("dart" "language-server" "--client-id" "emacs.eglot-dart")) - (elixir-mode . ("language_server.sh")) + ((elixir-ts-mode 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. @@ -753,7 +759,9 @@ treated as in `eglot--dbind'." :completion (list :dynamicRegistration :json-false :completionItem `(:snippetSupport - ,(if (eglot--snippet-expansion-fn) + ,(if (and + (not (eglot--stay-out-of-p 'yasnippet)) + (eglot--snippet-expansion-fn)) t :json-false) :deprecatedSupport t @@ -802,6 +810,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 +820,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 +964,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 +1081,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 @@ -1146,12 +1157,12 @@ INTERACTIVE is t if called interactively." (cl-labels ((maybe-connect () - (remove-hook 'post-command-hook #'maybe-connect nil) (eglot--when-live-buffer buffer + (remove-hook 'post-command-hook #'maybe-connect t) (unless eglot--managed-mode (apply #'eglot--connect (eglot--guess-contact)))))) (when buffer-file-name - (add-hook 'post-command-hook #'maybe-connect 'append nil))))) + (add-hook 'post-command-hook #'maybe-connect 'append t))))) (defun eglot-events-buffer (server) "Display events buffer for SERVER. @@ -1198,7 +1209,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 +1253,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 'suppress) + (tramp-ssh-controlmaster-options + "-o ControlMaster=no -o ControlPath=none")) (make-process :name readable-name :command (setq server-info (eglot--cmd contact)) @@ -1328,10 +1347,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 +1450,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 +1566,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 @@ -1572,9 +1629,11 @@ If optional MARKER, return a marker instead" (defun eglot--snippet-expansion-fn () "Compute a function to expand snippets. Doubles as an indicator of snippet support." - (and (boundp 'yas-minor-mode) - (symbol-value 'yas-minor-mode) - 'yas-expand-snippet)) + (and (fboundp 'yas-minor-mode) + (lambda (&rest args) + (with-no-warnings + (unless (bound-and-true-p yas-minor-mode) (yas-minor-mode 1)) + (apply #'yas-expand-snippet args))))) (defun eglot--format-markup (markup) "Format MARKUP according to LSP's spec." @@ -1624,7 +1683,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 +1700,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 +1812,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 +1835,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 +1866,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 +1881,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 +1924,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) @@ -1862,8 +1944,8 @@ If it is activated, also signal textDocument/didOpen." (put 'eglot--mode-line-format 'risky-local-variable t) -(defun eglot--mouse-call (what) - "Make an interactive lambda for calling WHAT from mode-line." +(defun eglot--mouse-call (what &optional update-mode-line) + "Make an interactive lambda for calling WHAT with the mouse." (lambda (event) (interactive "e") (let ((start (event-start event))) (with-selected-window (posn-window start) @@ -1871,7 +1953,8 @@ If it is activated, also signal textDocument/didOpen." (goto-char (or (posn-point start) (point))) (call-interactively what) - (force-mode-line-update t)))))) + (when update-mode-line + (force-mode-line-update t))))))) (defun eglot-manual () "Open documentation." (declare (obsolete info "29.1")) @@ -1945,7 +2028,7 @@ Uses THING, FACE, DEFS and PREPEND." (cl-loop with map = (make-sparse-keymap) for (elem . rest) on defs for (key def help) = elem - do (define-key map `[mode-line ,key] (eglot--mouse-call def)) + do (define-key map `[mode-line ,key] (eglot--mouse-call def t)) concat (format "%s: %s" key help) into blurb when rest concat "\n" into blurb finally (return `(:propertize ,thing @@ -2006,15 +2089,18 @@ still unanswered LSP requests to the server\n")))))))) (defalias 'eglot--make-diag 'flymake-make-diagnostic) (defalias 'eglot--diag-data 'flymake-diagnostic-data) +(defvar eglot-diagnostics-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'eglot-code-actions-at-mouse) + map) + "Keymap active in Eglot-backed Flymake diagnostic overlays.") + (cl-loop for i from 1 for type in '(eglot-note eglot-warning eglot-error) do (put type 'flymake-overlay-control `((mouse-face . highlight) (priority . ,(+ 50 i)) - (keymap . ,(let ((map (make-sparse-keymap))) - (define-key map [mouse-1] - (eglot--mouse-call 'eglot-code-actions)) - map))))) + (keymap . ,eglot-diagnostics-map)))) ;;; Protocol implementation (Requests, notifications, etc) @@ -2069,6 +2155,10 @@ COMMAND is a symbol naming the command." (_server (_method (eql telemetry/event)) &rest _any) "Handle notification telemetry/event.") ;; noop, use events buffer +(defalias 'eglot--reporter-update + (if (> emacs-major-version 26) #'progress-reporter-update + (lambda (a b &optional _c) (progress-reporter-update a b)))) + (cl-defmethod eglot-handle-notification (server (_method (eql $/progress)) &key token value) "Handle $/progress notification identified by TOKEN from SERVER." @@ -2084,10 +2174,10 @@ COMMAND is a symbol naming the command." (make-progress-reporter prefix 0 100 percentage 1 0) (make-progress-reporter prefix nil nil nil 1 0)) (eglot--progress-reporters server)))) - (progress-reporter-update pr percentage (fmt title message)))) + (eglot--reporter-update pr percentage (fmt title message)))) ("report" (when-let ((pr (gethash token (eglot--progress-reporters server)))) - (progress-reporter-update pr percentage (fmt title message)))) + (eglot--reporter-update pr percentage (fmt title message)))) ("end" (remhash token (eglot--progress-reporters server)))))))) (cl-defmethod eglot-handle-notification @@ -2105,7 +2195,7 @@ COMMAND is a symbol naming the command." (buffer (find-buffer-visiting path))) (with-current-buffer buffer (cl-loop - initially (assoc-delete-all path flymake-list-only-diagnostics #'string=) + initially (assoc-delete-all path flymake-list-only-diagnostics) for diag-spec across diagnostics collect (eglot--dbind ((Diagnostic) range code message severity source tags) diag-spec @@ -2124,7 +2214,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 @@ -2159,7 +2249,7 @@ COMMAND is a symbol naming the command." into diags finally (setq flymake-list-only-diagnostics - (assoc-delete-all path flymake-list-only-diagnostics #'string=)) + (assoc-delete-all path flymake-list-only-diagnostics)) (push (cons path diags) flymake-list-only-diagnostics))))) (cl-defun eglot--register-unregister (server things how) @@ -2283,29 +2373,30 @@ 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." (cl-incf eglot--versioned-identifier) - (pcase (and (listp eglot--recent-changes) - (car eglot--recent-changes)) + (pcase (car-safe eglot--recent-changes) (`(,lsp-beg ,lsp-end (,b-beg . ,b-beg-marker) (,b-end . ,b-end-marker)) - ;; github#259 and github#367: With `capitalize-word' or somesuch, - ;; `before-change-functions' always records the whole word's - ;; `b-beg' and `b-end'. Similarly, when coalescing two lines - ;; into one, `fill-paragraph' they mark the end of the first line - ;; up to the end of the second line. In both situations, args - ;; received here contradict that information: `beg' and `end' - ;; will differ by 1 and will likely only encompass the letter - ;; that was capitalized or, in the sentence-joining situation, - ;; the replacement of the newline with a space. That's we keep - ;; markers _and_ positions so we're able to detect and correct - ;; this. We ignore `beg', `len' and `pre-change-len' and send - ;; "fuller" information about the region from the markers. I've - ;; also experimented with doing this unconditionally but it seems - ;; to break when newlines are added. + ;; github#259 and github#367: with `capitalize-word' & friends, + ;; `before-change-functions' records the whole word's `b-beg' and + ;; `b-end'. Similarly, when `fill-paragraph' coalesces two + ;; lines, `b-beg' and `b-end' mark end of first line and end of + ;; second line, resp. In both situations, `beg' and `end' + ;; received here seemingly contradict that: they will differ by 1 + ;; and encompass the capitalized character or, in the coalescing + ;; case, the replacement of the newline with a space. We keep + ;; both markers and positions to detect and correct this. In + ;; this specific case, we ignore `beg', `len' and + ;; `pre-change-len' and send richer information about the region + ;; from the markers. I've also experimented with doing this + ;; unconditionally but it seems to break when newlines are added. (if (and (= b-end b-end-marker) (= b-beg b-beg-marker) (or (/= beg b-beg) (/= end b-end))) (setcar eglot--recent-changes @@ -2323,7 +2414,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 +2460,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 +2471,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 +2512,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 +2571,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 +2583,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 +2650,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 +2680,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 +2742,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 +2844,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 +2868,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 +2890,19 @@ 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 (eql insertTextFormat 2) + 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 +2963,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 +3000,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)) @@ -3131,8 +3224,9 @@ Returns a list as described in docstring of `imenu--index-alist'." ,(eglot--TextDocumentIdentifier)) :cancel-on-input non-essential)))))) -(defun eglot--apply-text-edits (edits &optional version) +(cl-defun eglot--apply-text-edits (edits &optional version) "Apply EDITS for current buffer if at VERSION, or if it's nil." + (unless edits (cl-return-from eglot--apply-text-edits)) (unless (or (not version) (equal version eglot--versioned-identifier)) (jsonrpc-error "Edits on `%s' require version %d, you have %d" (current-buffer) version eglot--versioned-identifier)) @@ -3197,8 +3291,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 +3318,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 @@ -3253,6 +3344,9 @@ at point. With prefix argument, prompt for ACTION-KIND." (eglot--read-execute-code-action actions server action-kind) actions))) +(defalias 'eglot-code-actions-at-mouse (eglot--mouse-call 'eglot-code-actions) + "Like `eglot-code-actions', but intended for mouse events.") + (defun eglot--read-execute-code-action (actions server &optional action-kind) "Helper for interactive calls to `eglot-code-actions'." (let* ((menu-items @@ -3290,7 +3384,7 @@ at point. With prefix argument, prompt for ACTION-KIND." `(defun ,name (beg &optional end) ,(format "Execute `%s' code actions between BEG and END." kind) (interactive (eglot--region-bounds)) - (eglot-code-actions beg end ,kind))) + (eglot-code-actions beg end ,kind t))) (eglot--code-action eglot-code-action-organize-imports "source.organizeImports") (eglot--code-action eglot-code-action-extract "refactor.extract") @@ -3454,17 +3548,152 @@ 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))) " ")) + (peg-after-p (eql kind 1))) + (cl-labels + ((make-ov () + (if peg-after-p + (make-overlay (point) (1+ (point)) nil t) + (make-overlay (1- (point)) (point) nil nil nil))) + (do-it (label lpad rpad firstp) + (let* ((tweak-cursor-p (and firstp peg-after-p)) + (ov (make-ov)) + (text (concat lpad label rpad))) + (when tweak-cursor-p (put-text-property 0 1 'cursor 1 text)) + (overlay-put ov (if peg-after-p 'before-string 'after-string) + (propertize + text + '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 'evaporate t) + (overlay-put ov 'eglot--overlay t)))) + (if (stringp label) (do-it label left-pad right-pad t) + (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) + (zerop i)))))))))) + (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 -;; optimal solution agreed to there is a bit more work than what I -;; have time to right now. See -;; e.g. https://debbugs.gnu.org/cgi/bugreport.cgi?bug=bug%2356407#68. -;; For now, just use `with-eval-after-load' +;; Emacs bug#56407, the optimal solution is in desktop.el, but that's +;; harder. For now, use `with-eval-after-load'. See also github#1183. (with-eval-after-load 'desktop - (add-to-list 'desktop-minor-mode-handlers '(eglot--managed-mode . ignore))) + (add-to-list 'desktop-minor-mode-handlers '(eglot--managed-mode . ignore)) + (add-to-list 'desktop-minor-mode-handlers '(eglot-inlay-hints-mode . ignore))) +;;; Misc +;;; +;;;###autoload +(progn + (put 'eglot--debbugs-or-github-bug-uri 'bug-reference-url-format t) + (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)))) ;;; Obsolete ;;; @@ -3474,8 +3703,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/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el new file mode 100644 index 00000000000..286f3e39f43 --- /dev/null +++ b/lisp/progmodes/elixir-ts-mode.el @@ -0,0 +1,641 @@ +;;; elixir-ts-mode.el --- Major mode for Elixir with tree-sitter support -*- lexical-binding: t; -*- + +;; Copyright (C) 2022-2023 Free Software Foundation, Inc. + +;; Author: Wilhelm H Kirschbaum <wkirschbaum@gmail.com> +;; Created: November 2022 +;; Keywords: elixir languages tree-sitter + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This package provides `elixir-ts-mode' which is a major mode for editing +;; Elixir files and embedded HEEx templates that uses Tree Sitter to parse +;; the language. +;; +;; This package is compatible with and was tested against the tree-sitter grammar +;; for Elixir found at https://github.com/elixir-lang/tree-sitter-elixir. +;; +;; Features +;; +;; * Indent +;; +;; `elixir-ts-mode' tries to replicate the indentation provided by +;; mix format, but will come with some minor differences. +;; +;; * IMenu +;; * Navigation +;; * Which-fun + +;;; Code: + +(require 'treesit) +(eval-when-compile (require 'rx)) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-node-child "treesit.c") +(declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") +(declare-function treesit-parser-language "treesit.c") +(declare-function treesit-parser-included-ranges "treesit.c") +(declare-function treesit-parser-list "treesit.c") +(declare-function treesit-node-parent "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-query-compile "treesit.c") +(declare-function treesit-node-eq "treesit.c") +(declare-function treesit-node-prev-sibling "treesit.c") + +(defgroup elixir-ts nil + "Major mode for editing Elixir code." + :prefix "elixir-ts-" + :group 'languages) + +(defcustom elixir-ts-indent-offset 2 + "Indentation of Elixir statements." + :version "30.1" + :type 'integer + :safe 'integerp + :group 'elixir-ts) + +(defface elixir-ts-font-comment-doc-identifier-face + '((t (:inherit font-lock-doc-face))) + "Face used for @comment.doc tags in Elixir files.") + +(defface elixir-ts-font-comment-doc-attribute-face + '((t (:inherit font-lock-doc-face))) + "Face used for @comment.doc.__attribute__ tags in Elixir files.") + +(defface elixir-ts-font-sigil-name-face + '((t (:inherit font-lock-string-face))) + "Face used for @__name__ tags in Elixir files.") + +(defconst elixir-ts--sexp-regexp + (rx bol + (or "call" "stab_clause" "binary_operator" "list" "tuple" "map" "pair" + "sigil" "string" "atom" "alias" "arguments" "identifier" + "boolean" "quoted_content") + eol)) + +(defconst elixir-ts--test-definition-keywords + '("describe" "test")) + +(defconst elixir-ts--definition-keywords + '("def" "defdelegate" "defexception" "defguard" "defguardp" + "defimpl" "defmacro" "defmacrop" "defmodule" "defn" "defnp" + "defoverridable" "defp" "defprotocol" "defstruct")) + +(defconst elixir-ts--definition-keywords-re + (concat "^" (regexp-opt elixir-ts--definition-keywords) "$")) + +(defconst elixir-ts--kernel-keywords + '("alias" "case" "cond" "else" "for" "if" "import" "quote" + "raise" "receive" "require" "reraise" "super" "throw" "try" + "unless" "unquote" "unquote_splicing" "use" "with")) + +(defconst elixir-ts--kernel-keywords-re + (concat "^" (regexp-opt elixir-ts--kernel-keywords) "$")) + +(defconst elixir-ts--builtin-keywords + '("__MODULE__" "__DIR__" "__ENV__" "__CALLER__" "__STACKTRACE__")) + +(defconst elixir-ts--builtin-keywords-re + (concat "^" (regexp-opt elixir-ts--builtin-keywords) "$")) + +(defconst elixir-ts--doc-keywords + '("moduledoc" "typedoc" "doc")) + +(defconst elixir-ts--doc-keywords-re + (concat "^" (regexp-opt elixir-ts--doc-keywords) "$")) + +(defconst elixir-ts--reserved-keywords + '("when" "and" "or" "not" "in" + "not in" "fn" "do" "end" "catch" "rescue" "after" "else")) + +(defconst elixir-ts--reserved-keywords-re + (concat "^" (regexp-opt elixir-ts--reserved-keywords) "$")) + +(defconst elixir-ts--reserved-keywords-vector + (apply #'vector elixir-ts--reserved-keywords)) + +(defvar elixir-ts--capture-anonymous-function-end + (when (treesit-available-p) + (treesit-query-compile 'elixir '((anonymous_function "end" @end))))) + +(defvar elixir-ts--capture-operator-parent + (when (treesit-available-p) + (treesit-query-compile 'elixir '((binary_operator operator: _ @val))))) + +(defvar elixir-ts--syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?/ "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?? "w" table) + (modify-syntax-entry ?~ "w" table) + (modify-syntax-entry ?! "_" table) + (modify-syntax-entry ?' "\"" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?# "<" table) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + (modify-syntax-entry ?\{ "(}" table) + (modify-syntax-entry ?\} "){" table) + (modify-syntax-entry ?\[ "(]" table) + (modify-syntax-entry ?\] ")[" table) + (modify-syntax-entry ?: "'" table) + (modify-syntax-entry ?@ "'" table) + table) + "Syntax table for `elixir-ts-mode'.") + +(defun elixir-ts--argument-indent-offset (node _parent &rest _) + "Return the argument offset position for NODE." + (if (treesit-node-prev-sibling node t) 0 elixir-ts-indent-offset)) + +(defun elixir-ts--argument-indent-anchor (node parent &rest _) + "Return the argument anchor position for NODE and PARENT." + (let ((first-sibling (treesit-node-child parent 0 t))) + (if (and first-sibling (not (treesit-node-eq first-sibling node))) + (treesit-node-start first-sibling) + (elixir-ts--parent-expression-start node parent)))) + +(defun elixir-ts--parent-expression-start (_node parent &rest _) + "Return the indentation expression start for NODE and PARENT." + ;; If the parent is the first expression on the line return the + ;; parent start of node position, otherwise use the parent call + ;; start if available. + (if (eq (treesit-node-start parent) + (save-excursion + (goto-char (treesit-node-start parent)) + (back-to-indentation) + (point))) + (treesit-node-start parent) + (let ((expr-parent + (treesit-parent-until + parent + (lambda (n) + (member (treesit-node-type n) + '("call" "binary_operator" "keywords" "list")))))) + (save-excursion + (goto-char (treesit-node-start expr-parent)) + (back-to-indentation) + (if (looking-at "|>") + (point) + (treesit-node-start expr-parent)))))) + +(defvar elixir-ts--indent-rules + (let ((offset elixir-ts-indent-offset)) + `((elixir + ((parent-is "^source$") column-0 0) + ((parent-is "^string$") parent-bol 0) + ((parent-is "^quoted_content$") + (lambda (_n parent bol &rest _) + (save-excursion + (back-to-indentation) + (if (bolp) + (progn + (goto-char (treesit-node-start parent)) + (back-to-indentation) + (point)) + (point)))) + 0) + ((node-is "^|>$") parent-bol 0) + ((node-is "^|$") parent-bol 0) + ((node-is "^]$") ,'elixir-ts--parent-expression-start 0) + ((node-is "^}$") ,'elixir-ts--parent-expression-start 0) + ((node-is "^)$") ,'elixir-ts--parent-expression-start 0) + ((node-is "^else_block$") grand-parent 0) + ((node-is "^catch_block$") grand-parent 0) + ((node-is "^rescue_block$") grand-parent 0) + ((node-is "^after_block$") grand-parent 0) + ((parent-is "^else_block$") parent ,offset) + ((parent-is "^catch_block$") parent ,offset) + ((parent-is "^rescue_block$") parent ,offset) + ((parent-is "^rescue_block$") parent ,offset) + ((parent-is "^after_block$") parent ,offset) + ((parent-is "^access_call$") + ,'elixir-ts--argument-indent-anchor + ,'elixir-ts--argument-indent-offset) + ((parent-is "^tuple$") + ,'elixir-ts--argument-indent-anchor + ,'elixir-ts--argument-indent-offset) + ((parent-is "^list$") + ,'elixir-ts--argument-indent-anchor + ,'elixir-ts--argument-indent-offset) + ((parent-is "^pair$") parent ,offset) + ((parent-is "^map_content$") parent-bol 0) + ((parent-is "^map$") ,'elixir-ts--parent-expression-start ,offset) + ((node-is "^stab_clause$") parent-bol ,offset) + ((query ,elixir-ts--capture-operator-parent) grand-parent 0) + ((node-is "^when$") parent 0) + ((node-is "^keywords$") parent-bol ,offset) + ((parent-is "^body$") + (lambda (node parent _) + (save-excursion + ;; The grammar adds a comment outside of the body, so we have to indent + ;; to the grand-parent if it is available. + (goto-char (treesit-node-start + (or (treesit-node-parent parent) (parent)))) + (back-to-indentation) + (point))) + ,offset) + ((parent-is "^arguments$") + ,'elixir-ts--argument-indent-anchor + ,'elixir-ts--argument-indent-offset) + ;; Handle incomplete maps when parent is ERROR. + ((n-p-gp "^binary_operator$" "ERROR" nil) parent-bol 0) + ;; When there is an ERROR, just indent to prev-line. + ((parent-is "ERROR") prev-line 0) + ((node-is "^binary_operator$") + (lambda (node parent &rest _) + (let ((top-level + (treesit-parent-while + node + (lambda (node) + (equal (treesit-node-type node) + "binary_operator"))))) + (if (treesit-node-eq top-level node) + (elixir-ts--parent-expression-start node parent) + (treesit-node-start top-level)))) + (lambda (node parent _) + (cond + ((equal (treesit-node-type parent) "do_block") + ,offset) + ((equal (treesit-node-type parent) "binary_operator") + ,offset) + (t 0)))) + ((parent-is "^binary_operator$") + (lambda (node parent bol &rest _) + (treesit-node-start + (treesit-parent-while + parent + (lambda (node) + (equal (treesit-node-type node) "binary_operator"))))) + ,offset) + ((node-is "^pair$") first-sibling 0) + ((query ,elixir-ts--capture-anonymous-function-end) parent-bol 0) + ((node-is "^end$") standalone-parent 0) + ((parent-is "^do_block$") grand-parent ,offset) + ((parent-is "^anonymous_function$") + elixir-ts--treesit-anchor-grand-parent-bol ,offset) + ((parent-is "^else_block$") parent ,offset) + ((parent-is "^rescue_block$") parent ,offset) + ((parent-is "^catch_block$") parent ,offset) + ((parent-is "^keywords$") parent-bol 0) + ((node-is "^call$") parent-bol ,offset) + ((node-is "^comment$") parent-bol ,offset))))) + +(defvar elixir-ts--font-lock-settings + (treesit-font-lock-rules + :language 'elixir + :feature 'elixir-comment + '((comment) @font-lock-comment-face) + + :language 'elixir + :feature 'elixir-string + :override t + '([(string) (charlist)] @font-lock-string-face) + + :language 'elixir + :feature 'elixir-string-interpolation + :override t + '((string + [ + quoted_end: _ @font-lock-string-face + quoted_start: _ @font-lock-string-face + (quoted_content) @font-lock-string-face + (interpolation + "#{" @font-lock-regexp-grouping-backslash "}" + @font-lock-regexp-grouping-backslash) + ]) + (charlist + [ + quoted_end: _ @font-lock-string-face + quoted_start: _ @font-lock-string-face + (quoted_content) @font-lock-string-face + (interpolation + "#{" @font-lock-regexp-grouping-backslash "}" + @font-lock-regexp-grouping-backslash) + ])) + + :language 'elixir + :feature 'elixir-keyword + `(,elixir-ts--reserved-keywords-vector + @font-lock-keyword-face + (binary_operator + operator: _ @font-lock-keyword-face + (:match ,elixir-ts--reserved-keywords-re @font-lock-keyword-face))) + + :language 'elixir + :feature 'elixir-doc + :override t + `((unary_operator + operator: "@" @elixir-ts-font-comment-doc-attribute-face + operand: (call + target: (identifier) @elixir-ts-font-comment-doc-identifier-face + ;; Arguments can be optional, so adding another + ;; entry without arguments. + ;; If we don't handle then we don't apply font + ;; and the non doc fortification query will take specify + ;; a more specific font which takes precedence. + (arguments + [ + (string) @font-lock-doc-face + (charlist) @font-lock-doc-face + (sigil) @font-lock-doc-face + (boolean) @font-lock-doc-face + ])) + (:match ,elixir-ts--doc-keywords-re + @elixir-ts-font-comment-doc-identifier-face)) + (unary_operator + operator: "@" @elixir-ts-font-comment-doc-attribute-face + operand: (call + target: (identifier) @elixir-ts-font-comment-doc-identifier-face) + (:match ,elixir-ts--doc-keywords-re + @elixir-ts-font-comment-doc-identifier-face))) + + :language 'elixir + :feature 'elixir-unary-operator + `((unary_operator operator: "@" @font-lock-preprocessor-face + operand: [ + (identifier) @font-lock-preprocessor-face + (call target: (identifier) + @font-lock-preprocessor-face) + (boolean) @font-lock-preprocessor-face + (nil) @font-lock-preprocessor-face + ]) + + (unary_operator operator: "&") @font-lock-function-name-face + (operator_identifier) @font-lock-operator-face) + + :language 'elixir + :feature 'elixir-operator + '((binary_operator operator: _ @font-lock-operator-face) + (dot operator: _ @font-lock-operator-face) + (stab_clause operator: _ @font-lock-operator-face) + + [(boolean) (nil)] @font-lock-constant-face + [(integer) (float)] @font-lock-number-face + (alias) @font-lock-type-face + (call target: (dot left: (atom) @font-lock-type-face)) + (char) @font-lock-constant-face + [(atom) (quoted_atom)] @font-lock-type-face + [(keyword) (quoted_keyword)] @font-lock-builtin-face) + + :language 'elixir + :feature 'elixir-call + `((call + target: (identifier) @font-lock-keyword-face + (:match ,elixir-ts--definition-keywords-re @font-lock-keyword-face)) + (call + target: (identifier) @font-lock-keyword-face + (:match ,elixir-ts--kernel-keywords-re @font-lock-keyword-face)) + (call + target: [(identifier) @font-lock-function-name-face + (dot right: (identifier) @font-lock-keyword-face)]) + (call + target: (identifier) @font-lock-keyword-face + (arguments + [ + (identifier) @font-lock-keyword-face + (binary_operator + left: (identifier) @font-lock-keyword-face + operator: "when") + ]) + (:match ,elixir-ts--definition-keywords-re @font-lock-keyword-face)) + (call + target: (identifier) @font-lock-keyword-face + (arguments + (binary_operator + operator: "|>" + right: (identifier))) + (:match ,elixir-ts--definition-keywords-re @font-lock-keyword-face))) + + :language 'elixir + :feature 'elixir-constant + `((binary_operator operator: "|>" right: (identifier) + @font-lock-function-name-face) + ((identifier) @font-lock-keyword-face + (:match ,elixir-ts--builtin-keywords-re + @font-lock-keyword-face)) + ((identifier) @font-lock-comment-face + (:match "^_" @font-lock-comment-face)) + (identifier) @font-lock-function-name-face + ["%"] @font-lock-keyward-face + ["," ";"] @font-lock-keyword-face + ["(" ")" "[" "]" "{" "}" "<<" ">>"] @font-lock-keyword-face) + + :language 'elixir + :feature 'elixir-sigil + :override t + `((sigil + (sigil_name) @elixir-ts-font-sigil-name-face + quoted_start: _ @font-lock-string-face + quoted_end: _ @font-lock-string-face + (:match "^[sSwWpP]$" @elixir-ts-font-sigil-name-face)) + @font-lock-string-face + (sigil + (sigil_name) @elixir-ts-font-sigil-name-face + quoted_start: _ @font-lock-regex-face + quoted_end: _ @font-lock-regex-face + (:match "^[rR]$" @elixir-ts-font-sigil-name-face)) + @font-lock-regex-face + (sigil + "~" @font-lock-string-face + (sigil_name) @elixir-ts-font-sigil-name-face + quoted_start: _ @font-lock-string-face + quoted_end: _ @font-lock-string-face + (:match "^[HF]$" @elixir-ts-font-sigil-name-face))) + + :language 'elixir + :feature 'elixir-string-escape + :override t + `((escape_sequence) @font-lock-regexp-grouping-backslash)) + "Tree-sitter font-lock settings.") + +(defvar elixir-ts--treesit-range-rules + (when (treesit-available-p) + (treesit-range-rules + :embed 'heex + :host 'elixir + '((sigil (sigil_name) @name (:match "^[HF]$" @name) (quoted_content) @heex))))) + +(defvar heex-ts--sexp-regexp) +(defvar heex-ts--indent-rules) +(defvar heex-ts--font-lock-settings) + +(defun elixir-ts--forward-sexp (&optional arg) + "Move forward across one balanced expression (sexp). +With ARG, do it many times. Negative ARG means move backward." + (or arg (setq arg 1)) + (funcall + (if (> arg 0) #'treesit-end-of-thing #'treesit-beginning-of-thing) + (if (eq (treesit-language-at (point)) 'heex) + heex-ts--sexp-regexp + elixir-ts--sexp-regexp) + (abs arg))) + +(defun elixir-ts--treesit-anchor-grand-parent-bol (_n parent &rest _) + "Return the beginning of non-space characters for the parent node of PARENT." + (save-excursion + (goto-char (treesit-node-start (treesit-node-parent parent))) + (back-to-indentation) + (point))) + +(defun elixir-ts--treesit-language-at-point (point) + "Return the language at POINT." + (let* ((range nil) + (language-in-range + (cl-loop + for parser in (treesit-parser-list) + do (setq range + (cl-loop + for range in (treesit-parser-included-ranges parser) + if (and (>= point (car range)) (<= point (cdr range))) + return parser)) + if range + return (treesit-parser-language parser)))) + (if (null language-in-range) + (when-let ((parser (car (treesit-parser-list)))) + (treesit-parser-language parser)) + language-in-range))) + +(defun elixir-ts--defun-p (node) + "Return non-nil when NODE is a defun." + (member (treesit-node-text + (treesit-node-child-by-field-name node "target")) + (append + elixir-ts--definition-keywords + elixir-ts--test-definition-keywords))) + +(defun elixir-ts--defun-name (node) + "Return the name of the defun NODE. +Return nil if NODE is not a defun node or doesn't have a name." + (pcase (treesit-node-type node) + ("call" (let ((node-child + (treesit-node-child (treesit-node-child node 1) 0))) + (pcase (treesit-node-type node-child) + ("alias" (treesit-node-text node-child t)) + ("call" (treesit-node-text + (treesit-node-child-by-field-name node-child "target") t)) + ("binary_operator" + (treesit-node-text + (treesit-node-child-by-field-name + (treesit-node-child-by-field-name node-child "left") "target") + t)) + ("identifier" + (treesit-node-text node-child t)) + (_ nil)))) + (_ nil))) + +;;;###autoload +(define-derived-mode elixir-ts-mode prog-mode "Elixir" + "Major mode for editing Elixir, powered by tree-sitter." + :group 'elixir-ts + :syntax-table elixir-ts--syntax-table + + ;; Comments + (setq-local comment-start "# ") + (setq-local comment-start-skip + (rx "#" (* (syntax whitespace)))) + + (setq-local comment-end "") + (setq-local comment-end-skip + (rx (* (syntax whitespace)) + (group (or (syntax comment-end) "\n")))) + + ;; Compile + (setq-local compile-command "mix") + + (when (treesit-ready-p 'elixir) + ;; The HEEx parser has to be created first for elixir to ensure elixir + ;; is the first language when looking for treesit ranges. + (when (treesit-ready-p 'heex) + ;; Require heex-ts-mode only when we load elixir-ts-mode + ;; so that we don't get a tree-sitter compilation warning for + ;; elixir-ts-mode. + (require 'heex-ts-mode) + (treesit-parser-create 'heex)) + + (treesit-parser-create 'elixir) + + (setq-local treesit-language-at-point-function + 'elixir-ts--treesit-language-at-point) + + ;; Font-lock. + (setq-local treesit-font-lock-settings elixir-ts--font-lock-settings) + (setq-local treesit-font-lock-feature-list + '(( elixir-comment elixir-constant elixir-doc ) + ( elixir-string elixir-keyword elixir-unary-operator + elixir-call elixir-operator ) + ( elixir-sigil elixir-string-escape elixir-string-interpolation))) + + ;; Imenu. + (setq-local treesit-simple-imenu-settings + '((nil "\\`call\\'" elixir-ts--defun-p nil))) + + ;; Indent. + (setq-local treesit-simple-indent-rules elixir-ts--indent-rules) + + ;; Navigation + (setq-local forward-sexp-function #'elixir-ts--forward-sexp) + (setq-local treesit-defun-type-regexp + '("call" . elixir-ts--defun-p)) + + (setq-local treesit-defun-name-function #'elixir-ts--defun-name) + + ;; Embedded Heex + (when (treesit-ready-p 'heex) + (setq-local treesit-range-settings elixir-ts--treesit-range-rules) + + (setq-local treesit-simple-indent-rules + (append treesit-simple-indent-rules heex-ts--indent-rules)) + + (setq-local treesit-font-lock-settings + (append treesit-font-lock-settings + heex-ts--font-lock-settings)) + + (setq-local treesit-simple-indent-rules + (append treesit-simple-indent-rules + heex-ts--indent-rules)) + + (setq-local treesit-font-lock-feature-list + '(( elixir-comment elixir-constant elixir-doc + heex-comment heex-keyword heex-doctype ) + ( elixir-string elixir-keyword elixir-unary-operator + elixir-call elixir-operator + heex-component heex-tag heex-attribute heex-string) + ( elixir-sigil elixir-string-escape + elixir-string-interpolation )))) + + (treesit-major-mode-setup))) + +(if (treesit-ready-p 'elixir) + (progn + (add-to-list 'auto-mode-alist '("\\.elixir\\'" . elixir-ts-mode)) + (add-to-list 'auto-mode-alist '("\\.ex\\'" . elixir-ts-mode)) + (add-to-list 'auto-mode-alist '("\\.exs\\'" . elixir-ts-mode)) + (add-to-list 'auto-mode-alist '("mix\\.lock" . elixir-ts-mode)))) + +(provide 'elixir-ts-mode) + +;;; elixir-ts-mode.el ends here diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 8efdae6060f..cb95f29b5fe 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -146,7 +146,10 @@ Otherwise, `find-tag-default' is used." (define-obsolete-variable-alias 'find-tag-marker-ring-length 'tags-location-ring-length "25.1") -(defvar tags-location-ring-length 16) +(defvar tags-location-ring-length 16 + "Size of the find-tag marker ring. +This variable has no effect, and is kept only for backward compatibility. +The actual size of the find-tag marker ring is unlimited.") (defcustom tags-tag-face 'default "Face for tags in the output of `tags-apropos'." @@ -181,8 +184,9 @@ Example value: (sexp :tag "Tags to search"))) :version "21.1") -;; Obsolete variable kept for compatibility. We don't use it in any way. -(defvar find-tag-marker-ring (make-ring 16)) +(defvar find-tag-marker-ring (make-ring 16) + "Find-tag marker ring. +Obsolete variable kept for compatibility. It is not used in any way.") (make-obsolete-variable 'find-tag-marker-ring "use `xref-push-marker-stack' or `xref-go-back' instead." diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 6f293acca5e..a352adbba19 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1635,6 +1635,7 @@ buffer." (define-derived-mode flymake-diagnostics-buffer-mode tabulated-list-mode "Flymake diagnostics" "A mode for listing Flymake diagnostics." + :interactive nil (setq tabulated-list-format flymake--diagnostics-base-tabulated-list-format) (setq tabulated-list-entries 'flymake--diagnostics-buffer-entries) @@ -1692,6 +1693,7 @@ some of this variable's contents the diagnostic listings.") (define-derived-mode flymake-project-diagnostics-mode tabulated-list-mode "Flymake diagnostics" "A mode for listing Flymake diagnostics." + :interactive nil (setq tabulated-list-format (vconcat [("File" 25 t)] flymake--diagnostics-base-tabulated-list-format)) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 8b157dd3333..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) @@ -1113,13 +1167,13 @@ no input, and GDB is waiting for input." (process-live-p proc) (not gud-running) (= (point) (marker-position (process-mark proc)))) - ;; Sending an EOF does not work with GDB-MI; submit an - ;; explicit quit command. - (progn - (if (> gdb-control-level 0) - (process-send-eof proc) - (insert "quit") - (comint-send-input t t))) + ;; Exit a recursive reading loop or quit. + (if (> gdb-control-level 0) + (process-send-eof proc) + ;; Sending an EOF does not work with GDB-MI; submit an + ;; explicit quit command. + (insert "quit") + (comint-send-input t t)) (delete-char arg)))) (defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.") @@ -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)) @@ -4355,6 +4404,24 @@ member." :group 'gud :version "29.1") +(defcustom gdb-locals-table-row-config `((name . 20) + (type . 20) + (value . ,gdb-locals-value-limit)) + "Configuration for table rows in the local variable display. + +An alist that controls the display of the name, type and value of +local variables inside the currently active stack-frame. The key +controls which column to change whereas the value determines the +maximum number of characters to display in each column. A value +of 0 means there is no limit. + +Additionally, the order the element in the alist determines the +left-to-right display order of the properties." + :type '(alist :key-type symbol :value-type integer) + :group 'gud + :version "30.1") + + (defvar gdb-locals-values-table (make-hash-table :test #'equal) "Mapping of local variable names to a string with their value.") @@ -4384,12 +4451,9 @@ member." (defun gdb-locals-value-filter (value) "Filter function for the local variable VALUE." - (let* ((no-nl (replace-regexp-in-string "\n" " " value)) - (str (replace-regexp-in-string "[[:space:]]+" " " no-nl)) - (limit gdb-locals-value-limit)) - (if (>= (length str) limit) - (concat (substring str 0 limit) "...") - str))) + (let* ((no-nl (replace-regexp-in-string "\n" " " (or value "<Unknown>"))) + (str (replace-regexp-in-string "[[:space:]]+" " " no-nl))) + str)) (defun gdb-edit-locals-value (&optional event) "Assign a value to a variable displayed in the locals buffer." @@ -4403,6 +4467,22 @@ member." (gud-basic-call (concat "-gdb-set variable " var " = " value))))) + +(defun gdb-locals-table-columns-list (alist) + "Format and arrange the columns in locals display based on ALIST." + (let (columns) + (dolist (config gdb-locals-table-row-config columns) + (let* ((key (car config)) + (max (cdr config)) + (prop (alist-get key alist))) + (when prop + (if (and (> max 0) (length> prop max)) + (push (propertize (string-truncate-left prop max) 'help-echo prop) + columns) + (push prop columns))))) + (nreverse columns))) + + ;; Complex data types are looked up in `gdb-locals-values-table'. (defun gdb-locals-handler-custom () "Handler to rebuild the local variables table buffer." @@ -4431,12 +4511,14 @@ member." help-echo "mouse-2: edit value" local-map ,gdb-edit-locals-map-1) value)) + (setf (gdb-table-right-align table) t) + (setq name (propertize name 'font-lock-face font-lock-variable-name-face)) + (setq type (propertize type 'font-lock-face font-lock-type-face)) (gdb-table-add-row table - (list - (propertize type 'font-lock-face font-lock-type-face) - (propertize name 'font-lock-face font-lock-variable-name-face) - value) + (gdb-locals-table-columns-list `((name . ,name) + (type . ,type) + (value . ,value))) `(gdb-local-variable ,local)))) (insert (gdb-table-string table " ")) (setq mode-name @@ -5124,6 +5206,8 @@ This arrangement depends on the values of variable (defun gdb-reset () "Exit a debugging session cleanly. Kills the gdb buffers, and resets variables and the source buffers." + ;; Save GDB history + (comint-write-input-ring) ;; The gdb-inferior buffer has a pty hooked up to the main gdb ;; process. This pty must be deleted explicitly. (let ((pty (get-process "gdb-inferior"))) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index d552e1360e0..e6e8abd6445 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -35,10 +35,11 @@ (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-search-subtree "treesit.c") -(defcustom go-ts-mode-indent-offset 4 +(defcustom go-ts-mode-indent-offset 8 "Number of spaces for each indentation step in `go-ts-mode'." :version "29.1" :type 'integer @@ -66,21 +67,29 @@ (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) ((parent-is "expression_switch_statement") parent-bol 0) ((parent-is "field_declaration_list") parent-bol go-ts-mode-indent-offset) ((parent-is "import_spec_list") parent-bol go-ts-mode-indent-offset) + ((parent-is "interface_type") parent-bol go-ts-mode-indent-offset) ((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'.") @@ -118,16 +127,31 @@ '((["," "." ";" ":"]) @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 @@ -154,8 +178,13 @@ '([(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 @@ -163,20 +192,21 @@ '((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 '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `go-ts-mode'.") +(defvar-keymap go-ts-mode-map + :doc "Keymap used in Go mode, powered by tree-sitter" + :parent prog-mode-map + "C-c C-d" #'go-ts-mode-docstring) + ;;;###autoload (define-derived-mode go-ts-mode prog-mode "Go" - "Major mode for editing Go, powered by tree-sitter." + "Major mode for editing Go, powered by tree-sitter. + +\\{go-ts-mode-map}" :group 'go :syntax-table go-ts-mode--syntax-table @@ -215,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))) @@ -274,6 +303,32 @@ Return nil if there is no name or if NODE is not a defun node." (not (go-ts-mode--struct-node-p node)) (not (go-ts-mode--alias-node-p node)))) +(defun go-ts-mode-docstring () + "Add a docstring comment for the current defun. +The added docstring is prefilled with the defun's name. If the +comment already exists, jump to it." + (interactive) + (when-let ((defun-node (treesit-defun-at-point))) + (goto-char (treesit-node-start defun-node)) + (if (go-ts-mode--comment-on-previous-line-p) + ;; go to top comment line + (while (go-ts-mode--comment-on-previous-line-p) + (forward-line -1)) + (insert "// " (treesit-defun-name defun-node)) + (newline) + (backward-char)))) + +(defun go-ts-mode--comment-on-previous-line-p () + "Return t if the previous line is a comment." + (when-let ((point (- (pos-bol) 1)) + ((> point 0)) + (node (treesit-node-at point))) + (and + ;; check point is actually inside the found node + ;; treesit-node-at can return nodes after point + (<= (treesit-node-start node) point (treesit-node-end node)) + (string-equal "comment" (treesit-node-type node))))) + ;; go.mod support. (defvar go-mod-ts-mode--syntax-table 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/gud.el b/lisp/progmodes/gud.el index 3b792354cbc..d5c8e37a37b 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -135,9 +135,9 @@ Used to gray out relevant toolbar icons.") (defun gud-goto-info () "Go to relevant Emacs info node." (interactive) - (if (eq gud-minor-mode 'gdbmi) - (info-other-window "(emacs)GDB Graphical Interface") - (info-other-window "(emacs)Debuggers"))) + (info-other-window (if (eq gud-minor-mode 'gdbmi) + "(emacs)GDB Graphical Interface" + "(emacs)Debuggers"))) (defun gud-tool-bar-item-visible-no-fringe () (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) @@ -159,143 +159,145 @@ Used to gray out relevant toolbar icons.") (t (comint-interrupt-subjob))))) -(easy-mmode-defmap gud-menu-map - '(([help] "Info (debugger)" . gud-goto-info) - ([tooltips] menu-item "Show GUD tooltips" gud-tooltip-mode - :enable (and (not emacs-basic-display) - (display-graphic-p) - (fboundp 'x-show-tip)) - :visible (memq gud-minor-mode - '(gdbmi guiler dbx sdb xdb pdb)) - :button (:toggle . gud-tooltip-mode)) - ([refresh] "Refresh" . gud-refresh) - ([run] menu-item "Run" gud-run - :enable (not gud-running) - :visible (or (memq gud-minor-mode '(gdb dbx jdb)) - (and (eq gud-minor-mode 'gdbmi) - (or (not (gdb-show-run-p)) - (bound-and-true-p - gdb-active-process))))) - ([go] . (menu-item (if (bound-and-true-p gdb-active-process) - "Continue" "Run") - gud-go - :visible (and (eq gud-minor-mode 'gdbmi) - (gdb-show-run-p)))) - ([stop] menu-item "Stop" gud-stop-subjob - :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) - (and (eq gud-minor-mode 'gdbmi) - (gdb-show-stop-p)))) - ([until] menu-item "Continue to selection" gud-until - :enable (not gud-running) - :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) - (gud-tool-bar-item-visible-no-fringe))) - ([remove] menu-item "Remove Breakpoint" gud-remove - :enable (not gud-running) - :visible (gud-tool-bar-item-visible-no-fringe)) - ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak - :enable (not gud-running) - :visible (memq gud-minor-mode - '(gdbmi gdb sdb xdb))) - ([break] menu-item "Set Breakpoint" gud-break - :enable (not gud-running) - :visible (gud-tool-bar-item-visible-no-fringe)) - ([up] menu-item "Up Stack" gud-up - :enable (not gud-running) - :visible (memq gud-minor-mode - '(gdbmi gdb guiler dbx xdb jdb pdb))) - ([down] menu-item "Down Stack" gud-down - :enable (not gud-running) - :visible (memq gud-minor-mode - '(gdbmi gdb guiler dbx xdb jdb pdb))) - ([pp] menu-item "Print S-expression" gud-pp - :enable (and (not gud-running) - (bound-and-true-p gdb-active-process)) - :visible (and (string-equal - (buffer-local-value - 'gud-target-name gud-comint-buffer) - "emacs") - (eq gud-minor-mode 'gdbmi))) - ([print*] . (menu-item (if (eq gud-minor-mode 'jdb) - "Dump object" - "Print Dereference") - gud-pstar - :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdb jdb)))) - ([print] menu-item "Print Expression" gud-print - :enable (not gud-running)) - ([watch] menu-item "Watch Expression" gud-watch - :enable (not gud-running) - :visible (eq gud-minor-mode 'gdbmi)) - ([finish] menu-item "Finish Function" gud-finish - :enable (not gud-running) - :visible (memq gud-minor-mode - '(gdbmi gdb guiler xdb jdb pdb))) - ([stepi] menu-item "Step Instruction" gud-stepi - :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdb dbx))) - ([nexti] menu-item "Next Instruction" gud-nexti - :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdb dbx))) - ([step] menu-item "Step Line" gud-step - :enable (not gud-running)) - ([next] menu-item "Next Line" gud-next - :enable (not gud-running)) - ([cont] menu-item "Continue" gud-cont - :enable (not gud-running) - :visible (not (eq gud-minor-mode 'gdbmi)))) - "Menu for `gud-mode'." - :name "Gud") - -(easy-mmode-defmap gud-minor-mode-map - (append - `(([menu-bar debug] . ("Gud" . ,gud-menu-map))) - ;; Get tool bar like functionality from the menu bar on a text only - ;; terminal. - (unless window-system - `(([menu-bar down] - . (,(propertize "down" 'face 'font-lock-doc-face) . gud-down)) - ([menu-bar up] - . (,(propertize "up" 'face 'font-lock-doc-face) . gud-up)) - ([menu-bar finish] - . (,(propertize "finish" 'face 'font-lock-doc-face) . gud-finish)) - ([menu-bar step] - . (,(propertize "step" 'face 'font-lock-doc-face) . gud-step)) - ([menu-bar next] - . (,(propertize "next" 'face 'font-lock-doc-face) . gud-next)) - ([menu-bar until] menu-item - ,(propertize "until" 'face 'font-lock-doc-face) gud-until - :visible (memq gud-minor-mode '(gdbmi gdb perldb))) - ([menu-bar cont] menu-item - ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont - :visible (not (eq gud-minor-mode 'gdbmi))) - ([menu-bar run] menu-item - ,(propertize "run" 'face 'font-lock-doc-face) gud-run - :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) - ([menu-bar go] menu-item - ,(propertize " go " 'face 'font-lock-doc-face) gud-go - :visible (and (eq gud-minor-mode 'gdbmi) - (gdb-show-run-p))) - ([menu-bar stop] menu-item - ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob - :visible (or (and (eq gud-minor-mode 'gdbmi) - (gdb-show-stop-p)) - (not (eq gud-minor-mode 'gdbmi)))) - ([menu-bar print] - . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print)) - ([menu-bar tools] . undefined) - ([menu-bar buffer] . undefined) - ([menu-bar options] . undefined) - ([menu-bar edit] . undefined) - ([menu-bar file] . undefined)))) - "Map used in visited files.") - -(setf (alist-get 'gud-minor-mode minor-mode-map-alist) - gud-minor-mode-map) +(defvar-keymap gud-text-menu-bar-map + :doc "Menu-bar keymap used in GUD buffers on text frames." + ;; Use the menu-bar as a pseudo-tool-bar. + "<down>" `(,(propertize "down" 'face 'font-lock-doc-face) . gud-down) + "<up>" `(,(propertize "up" 'face 'font-lock-doc-face) . gud-up) + "<finish>" `(,(propertize "finish" 'face 'font-lock-doc-face) . gud-finish) + "<step>" `(,(propertize "step" 'face 'font-lock-doc-face) . gud-step) + "<next>" `(,(propertize "next" 'face 'font-lock-doc-face) . gud-next) + "<until>" `(menu-item + ,(propertize "until" 'face 'font-lock-doc-face) gud-until + :visible (memq gud-minor-mode '(gdbmi gdb perldb))) + "<cont>" `(menu-item + ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont + :visible (not (eq gud-minor-mode 'gdbmi))) + "<run>" `(menu-item + ,(propertize "run" 'face 'font-lock-doc-face) gud-run + :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) + "<go>" `(menu-bar-item + ,(propertize " go " 'face 'font-lock-doc-face) gud-go + :visible (and (eq gud-minor-mode 'gdbmi) + (gdb-show-run-p))) + "<stop>" `(menu-item + ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob + :visible (or (and (eq gud-minor-mode 'gdbmi) + (gdb-show-stop-p)) + (not (eq gud-minor-mode 'gdbmi)))) + "<print>" `(,(propertize "print" 'face 'font-lock-doc-face) . gud-print) + ;; Hide the usual menus to make room. + "<tools>" #'undefined + "<buffer>" #'undefined + "<options>" #'undefined + "<edit>" #'undefined + "<file>" #'undefined) + +(defvar-keymap gud-menu-mode-map + :doc "Keymap shared between `gud-mode' and `gud-minor-mode'.") + +(defvar-keymap gud-mode-map + :doc "`gud-mode' keymap." + ;; BEWARE: `gud-mode-map' does not inherit from something like + ;; `gud-menu-mode-map' because the `gud-mode' buffer is also in + ;; `gud-minor-mode'. + ;;:parent (make-composed-keymap gud-menu-mode-map comint-mode-map) + ) -(defvar gud-mode-map - ;; Will inherit from comint-mode via define-derived-mode. - (make-sparse-keymap) - "`gud-mode' keymap.") +(defvar-keymap gud-minor-mode-map + ;; Part of the menu is dynamic, so we use 2 keymaps: `gud-menu-mode-map' + ;; is the static/normal menu defined with easy-menu, and + ;; `gud-text-menu-bar-map' is the part that's only used on text frames. + ;; We then merge them here into `gud-minor-mode-map'. + :parent gud-menu-mode-map + "<menu-bar>" `(menu-item nil ,gud-text-menu-bar-map + ;; Be careful to return an empty keymap rather than nil + ;; so as not to hide the parent's menus. + :filter ,(lambda (map) (if window-system '(keymap) map)))) + +(easy-menu-define gud-menu-map gud-menu-mode-map + "Menu for `gud-mode'." + '("Gud" + ["Continue" gud-cont + :enable (not gud-running) + :visible (not (eq gud-minor-mode 'gdbmi))] + ["Next Line" gud-next + :enable (not gud-running)] + ["Step Line" gud-step + :enable (not gud-running)] + ["Next Instruction" gud-nexti + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdb dbx))] + ["Step Instruction" gud-stepi + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdb dbx))] + ["Finish Function" gud-finish + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdb guiler xdb jdb pdb))] + ["Watch Expression" gud-watch + :enable (not gud-running) + :visible (eq gud-minor-mode 'gdbmi)] + ["Print Expression" gud-print + :enable (not gud-running)] + ["Dump object-Derefenrece" gud-pstar + :label (if (eq gud-minor-mode 'jdb) + "Dump object" + "Print Dereference") + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdb jdb))] + ["Print S-expression" gud-pp + :enable (and (not gud-running) + (bound-and-true-p gdb-active-process)) + :visible (and (string-equal + (buffer-local-value + 'gud-target-name gud-comint-buffer) + "emacs") + (eq gud-minor-mode 'gdbmi))] + ["Down Stack" gud-down + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdb guiler dbx xdb jdb pdb))] + ["Up Stack" gud-up + :enable (not gud-running) + :visible (memq gud-minor-mode + '(gdbmi gdb guiler dbx xdb jdb pdb))] + ["Set Breakpoint" gud-break + :enable (not gud-running) + :visible (gud-tool-bar-item-visible-no-fringe)] + ["Temporary Breakpoint" gud-tbreak + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdb sdb xdb))] + ["Remove Breakpoint" gud-remove + :enable (not gud-running) + :visible (gud-tool-bar-item-visible-no-fringe)] + ["Continue to selection" gud-until + :enable (not gud-running) + :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) + (gud-tool-bar-item-visible-no-fringe))] + ["Stop" gud-stop-subjob + :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) + (and (eq gud-minor-mode 'gdbmi) + (gdb-show-stop-p)))] + ["Continue-Run" gud-go + :label (if (bound-and-true-p gdb-active-process) + "Continue" "Run") + :visible (and (eq gud-minor-mode 'gdbmi) + (gdb-show-run-p))] + ["Run" gud-run + :enable (not gud-running) + :visible (or (memq gud-minor-mode '(gdb dbx jdb)) + (and (eq gud-minor-mode 'gdbmi) + (or (not (gdb-show-run-p)) + (bound-and-true-p + gdb-active-process))))] + ["Refresh" gud-refresh] + ["Show GUD tooltips" gud-tooltip-mode + :enable (and (not emacs-basic-display) + (display-graphic-p) + (fboundp 'x-show-tip)) + :visible (memq gud-minor-mode + '(gdbmi guiler dbx sdb xdb pdb)) + :button (:toggle . gud-tooltip-mode)] + ["Info (debugger)" gud-goto-info])) (setf (alist-get 'gud-minor-mode minor-mode-map-alist) gud-minor-mode-map) @@ -323,7 +325,7 @@ Used to gray out relevant toolbar icons.") (gud-goto-info . "info")) map) (tool-bar-local-item-from-menu - (car x) (cdr x) map gud-minor-mode-map)))) + (car x) (cdr x) map gud-menu-mode-map)))) (defvar gud-gdb-repeat-map (let ((map (make-sparse-keymap))) @@ -582,9 +584,9 @@ required by the caller." (value (nth 4 var)) (status (nth 5 var)) (has-more (nth 6 var))) (put-text-property - 0 (length expr) 'face font-lock-variable-name-face expr) + 0 (length expr) 'face 'font-lock-variable-name-face expr) (put-text-property - 0 (length type) 'face font-lock-type-face type) + 0 (length type) 'face 'font-lock-type-face type) (while (string-match "\\." varnum start) (setq depth (1+ depth) start (1+ (match-beginning 0)))) @@ -1307,7 +1309,7 @@ whereby $stopformat=1 produces an output format compatible with (define-key map key cmd)) (when (or gud-mips-p gud-irix-p) - (define-key map "f" 'gud-finish)) + (define-key map "f" #'gud-finish)) map) "Keymap to repeat `dbx' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") @@ -3469,9 +3471,9 @@ class of the file (using s to separate nested class ids)." (defun gdb-script-font-lock-syntactic-face (state) (cond - ((nth 3 state) font-lock-string-face) - ((nth 7 state) font-lock-doc-face) - (t font-lock-comment-face))) + ((nth 3 state) 'font-lock-string-face) + ((nth 7 state) 'font-lock-doc-face) + (t 'font-lock-comment-face))) (defvar gdb-script-basic-indent 2) @@ -3502,7 +3504,7 @@ class of the file (using s to separate nested class ids)." (defun gdb-script-indent-line () "Indent current line of GDB script." (interactive) - (if (and (eq (get-text-property (point) 'face) font-lock-doc-face) + (if (and (eq (get-text-property (point) 'face) 'font-lock-doc-face) (save-excursion (forward-line 0) (skip-chars-forward " \t") diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el new file mode 100644 index 00000000000..68a537b9229 --- /dev/null +++ b/lisp/progmodes/heex-ts-mode.el @@ -0,0 +1,185 @@ +;;; heex-ts-mode.el --- Major mode for Heex with tree-sitter support -*- lexical-binding: t; -*- + +;; Copyright (C) 2022-2023 Free Software Foundation, Inc. + +;; Author: Wilhelm H Kirschbaum <wkirschbaum@gmail.com> +;; Created: November 2022 +;; Keywords: elixir languages tree-sitter + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This package provides `heex-ts-mode' which is a major mode for editing +;; HEEx files that uses Tree Sitter to parse the language. +;; +;; This package is compatible with and was tested against the tree-sitter grammar +;; for HEEx found at https://github.com/phoenixframework/tree-sitter-heex. + +;;; Code: + +(require 'treesit) +(eval-when-compile (require 'rx)) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-node-child "treesit.c") +(declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-start "treesit.c") + +(defgroup heex-ts nil + "Major mode for editing HEEx code." + :prefix "heex-ts-" + :group 'langauges) + +(defcustom heex-ts-indent-offset 2 + "Indentation of HEEx statements." + :version "30.1" + :type 'integer + :safe 'integerp + :group 'heex-ts) + +(defconst heex-ts--sexp-regexp + (rx bol + (or "directive" "tag" "component" "slot" + "attribute" "attribute_value" "quoted_attribute_value") + eol)) + +;; There seems to be no parent directive block for tree-sitter-heex, +;; so we ignore them for now until we learn how to query them. +;; https://github.com/phoenixframework/tree-sitter-heex/issues/28 +(defvar heex-ts--indent-rules + (let ((offset heex-ts-indent-offset)) + `((heex + ((parent-is "fragment") + (lambda (node parent &rest _) + ;; If HEEx is embedded indent to parent + ;; otherwise indent to the bol. + (if (eq (treesit-language-at (point-min)) 'heex) + (point-min) + (save-excursion + (goto-char (treesit-node-start parent)) + (back-to-indentation) + (point)) + )) 0) + ((node-is "end_tag") parent-bol 0) + ((node-is "end_component") parent-bol 0) + ((node-is "end_slot") parent-bol 0) + ((node-is "/>") parent-bol 0) + ((node-is ">") parent-bol 0) + ((parent-is "comment") prev-adaptive-prefix 0) + ((parent-is "component") parent-bol ,offset) + ((parent-is "tag") parent-bol ,offset) + ((parent-is "start_tag") parent-bol ,offset) + ((parent-is "component") parent-bol ,offset) + ((parent-is "start_component") parent-bol ,offset) + ((parent-is "slot") parent-bol ,offset) + ((parent-is "start_slot") parent-bol ,offset) + ((parent-is "self_closing_tag") parent-bol ,offset) + (no-node parent-bol ,offset))))) + +(defvar heex-ts--font-lock-settings + (when (treesit-available-p) + (treesit-font-lock-rules + :language 'heex + :feature 'heex-comment + '((comment) @font-lock-comment-face) + :language 'heex + :feature 'heex-doctype + '((doctype) @font-lock-doc-face) + :language 'heex + :feature 'heex-tag + `([(tag_name) (slot_name)] @font-lock-function-name-face) + :language 'heex + :feature 'heex-attribute + `((attribute_name) @font-lock-variable-name-face) + :language 'heex + :feature 'heex-keyword + `((special_attribute_name) @font-lock-keyword-face) + :language 'heex + :feature 'heex-string + `([(attribute_value) (quoted_attribute_value)] @font-lock-constant-face) + :language 'heex + :feature 'heex-component + `([ + (component_name) @font-lock-function-name-face + (module) @font-lock-keyword-face + (function) @font-lock-keyword-face + "." @font-lock-keyword-face + ]))) + "Tree-sitter font-lock settings.") + +(defun heex-ts--defun-name (node) + "Return the name of the defun NODE. +Return nil if NODE is not a defun node or doesn't have a name." + (pcase (treesit-node-type node) + ((or "component" "slot" "tag") + (string-trim + (treesit-node-text + (treesit-node-child (treesit-node-child node 0) 1) nil))) + (_ nil))) + +(defun heex-ts--forward-sexp (&optional arg) + "Move forward across one balanced expression (sexp). +With ARG, do it many times. Negative ARG means move backward." + (or arg (setq arg 1)) + (funcall + (if (> arg 0) #'treesit-end-of-thing #'treesit-beginning-of-thing) + heex-ts--sexp-regexp + (abs arg))) + +;;;###autoload +(define-derived-mode heex-ts-mode html-mode "HEEx" + "Major mode for editing HEEx, powered by tree-sitter." + :group 'heex-ts + + (when (treesit-ready-p 'heex) + (treesit-parser-create 'heex) + + ;; Comments + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" "text"))) + + (setq-local forward-sexp-function #'heex-ts--forward-sexp) + + ;; Navigation. + (setq-local treesit-defun-type-regexp + (rx bol (or "component" "tag" "slot") eol)) + (setq-local treesit-defun-name-function #'heex-ts--defun-name) + + ;; Imenu + (setq-local treesit-simple-imenu-settings + '(("Component" "\\`component\\'" nil nil) + ("Slot" "\\`slot\\'" nil nil) + ("Tag" "\\`tag\\'" nil nil))) + + (setq-local treesit-font-lock-settings heex-ts--font-lock-settings) + + (setq-local treesit-simple-indent-rules heex-ts--indent-rules) + + (setq-local treesit-font-lock-feature-list + '(( heex-comment heex-keyword heex-doctype ) + ( heex-component heex-tag heex-attribute heex-string ) + () ())) + + (treesit-major-mode-setup))) + +(if (treesit-ready-p 'heex) + ;; Both .heex and the deprecated .leex files should work + ;; with the tree-sitter-heex grammar. + (add-to-list 'auto-mode-alist '("\\.[hl]?eex\\'" . heex-ts-mode))) + +(provide 'heex-ts-mode) +;;; heex-ts-mode.el ends here diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 30893638f0d..836db83c2f3 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -113,6 +113,7 @@ ;; Various floating point types and operations are also supported but the ;; actual precision is limited by the Emacs internal floating representation, ;; which is the C data type "double" or IEEE binary64 format. +;; C99 and GNU style variadic arguments support is completed in 2022/E. ;;; Code: @@ -392,8 +393,10 @@ If there is a marked region from START to END it only shows the symbols within." (add-hook 'after-revert-hook 'hif-after-revert-function) (defun hif-end-of-line () + "Find the end-point of line concatenation." (end-of-line) - (while (= (logand 1 (skip-chars-backward "\\\\")) 1) + (while (progn (skip-chars-backward " \t" (line-beginning-position)) + (= ?\\ (char-before))) (end-of-line 2))) (defun hif-merge-ifdef-region (start end) @@ -536,10 +539,10 @@ that form should be displayed.") ;;===%%SF%% parsing (Start) === ;;; The code that understands what ifs and ifdef in files look like. -(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*") +(defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*") (defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) -(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+")) +(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) (defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) (defconst hif-else-regexp (concat hif-cpp-prefix "else")) (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) @@ -547,18 +550,23 @@ that form should be displayed.") (concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp)) (defconst hif-macro-expr-prefix-regexp - (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+")) + (concat hif-cpp-prefix "\\(if(\\|if\\(n?def\\)?[ \t]+\\|elif\\|define[ \t]+\\)")) -(defconst hif-white-regexp "[ \t]*") +(defconst hif-line-concat "\\\\[ \t]*[\n\r]") +;; If `hif-white-regexp' is modified, `hif-tokenize' might need to be modified +;; accordingly. +(defconst hif-white-regexp (concat "\\(?:[ \t]\\|/\\*.*?\\*/" + "\\|\\(?:" hif-line-concat "\\)\\)*")) (defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)")) (defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*")) +(defconst hif-etc-regexp "\\.\\.\\.") (defconst hif-macroref-regexp (concat hif-white-regexp "\\(" hif-id-regexp "\\)" "\\(" "(" hif-white-regexp "\\(" hif-id-regexp "\\)?" hif-white-regexp "\\(" "," hif-white-regexp hif-id-regexp hif-white-regexp "\\)*" - "\\(\\.\\.\\.\\)?" hif-white-regexp + "\\(" "," hif-white-regexp "\\)?" "\\(" hif-etc-regexp "\\)?" hif-white-regexp ")" "\\)?" )) @@ -936,7 +944,11 @@ Assuming we've just performed a `hif-token-regexp' lookup." (defun hif-tokenize (start end) "Separate string between START and END into a list of tokens." (let ((token-list nil) - (white-regexp "[ \t]+") + ;; Similar to `hif-white-regexp' but keep the spaces if there are + (white-regexp (concat "\\(?:" + "\\([ \t]+\\)\\|/\\*.*?\\*/" + "\\|\\(?:" hif-line-concat "\\)" + "\\)*")) token) (setq hif-simple-token-only t) (with-syntax-table hide-ifdef-syntax-table @@ -956,29 +968,31 @@ Assuming we've just performed a `hif-token-regexp' lookup." (forward-char 2)) ((looking-at hif-string-literal-regexp) - (setq token (substring-no-properties (match-string 1))) + (setq token (match-string-no-properties 1)) (goto-char (match-end 0)) (when (looking-at white-regexp) - (add-text-properties 0 1 '(hif-space t) token) + (if (not (zerop (length (match-string-no-properties 1)))) + (add-text-properties 0 1 '(hif-space t) token)) (goto-char (match-end 0))) (push token token-list)) ((looking-at hif-token-regexp) (goto-char (match-end 0)) - (setq token (hif-strtok - (substring-no-properties (match-string 0)))) + (setq token (hif-strtok (match-string-no-properties 0))) (push token token-list) (when (looking-at white-regexp) - ;; We can't just append a space to the token string, otherwise - ;; `0xf0 ' ## `01' will become `0xf0 01' instead of the expected - ;; `0xf001', hence a standalone `hif-space' is placed instead. - (push 'hif-space token-list) + (if (not (zerop (length (match-string-no-properties 1)))) + ;; We can't just append a space to the token string, + ;; otherwise `0xf0 ' ## `01' will become `0xf0 01' instead + ;; of the expected `0xf001', hence a standalone `hif-space' + ;; is placed instead. + (push 'hif-space token-list)) (goto-char (match-end 0)))) ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in (forward-char 1)) ; the source code. Let's not get stuck here. - (t (error "Bad #if expression: %s" (buffer-string))))))) + (t (error "Bad preprocessor expression: %s" (buffer-string))))))) (if (eq 'hif-space (car token-list)) (setq token-list (cdr token-list))) ;; remove trailing white space (nreverse token-list)))) @@ -1126,7 +1140,7 @@ this is to emulate the stringification behavior of C++ preprocessor." (and (eq (car remains) 'hif-space) (eq (cadr remains) 'hif-lparen) (setq remains (cdr remains))))) - ;; No argument, no invocation + ;; No argument list, no invocation tok ;; Argumented macro, get arguments and invoke it. ;; Dynamically bind `hif-token-list' and `hif-token' @@ -1369,8 +1383,9 @@ factor : `!' factor | `~' factor | `(' exprlist `)' | `defined(' id `)' | (parmlist nil) ; A "token" list of parameters, will later be parsed (parm nil)) - (while (or (not (eq (hif-nexttoken keep-space) 'hif-rparen)) - (/= nest 0)) + (while (and (or (not (eq (hif-nexttoken keep-space) 'hif-rparen)) + (/= nest 0)) + hif-token) (if (eq (car (last parm)) 'hif-comma) (setq parm nil)) (cond @@ -1384,6 +1399,8 @@ factor : `!' factor | `~' factor | `(' exprlist `)' | `defined(' id `)' | (setq parm nil))) (push hif-token parm)) + (if (equal parm '(hif-comma)) ;; missing the last argument + (setq parm '(nil))) (push (nreverse parm) parmlist) ; Okay even if PARM is nil (hif-nexttoken keep-space) ; Drop the `hif-rparen', get next token (nreverse parmlist))) @@ -1609,11 +1626,21 @@ and `+='...)." ;; no need to reassemble the list if no `##' presents l)) -(defun hif-delimit (lis atom) - (nconc (mapcan (lambda (l) (list l atom)) +(defun hif-delimit (lis elem) + (nconc (mapcan (lambda (l) (list l elem)) (butlast lis)) (last lis))) +(defun hif-delete-nth (n lst) + "Non-destructively delete the nth item from a list." + (if (zerop n) + (cdr lst) + ;; non-destructive + (let* ((duplst (copy-sequence lst)) + (node (nthcdr (1- n) duplst))) + (setcdr node (cddr node)) + duplst))) + ;; Perform token replacement: (defun hif-macro-supply-arguments (macro-name actual-parms) "Expand a macro call, replace ACTUAL-PARMS in the macro body." @@ -1633,49 +1660,160 @@ and `+='...)." ;; For each actual parameter, evaluate each one and associate it ;; with an actual parameter, put it into local table and finally ;; evaluate the macro body. - (if (setq etc (eq (car formal-parms) 'hif-etc)) + (if (setq etc (or (eq (car formal-parms) 'hif-etc) + (and (eq (car formal-parms) 'hif-etc-c99) 'c99))) ;; Take care of `hif-etc' first. Prefix `hif-comma' back if needed. (setq formal-parms (cdr formal-parms))) (setq formal-count (length formal-parms) actual-count (length actual-parms)) - (if (> formal-count actual-count) - (error "Too few parameters for macro %S" macro-name) - (if (< formal-count actual-count) - (or etc - (error "Too many parameters for macro %S" macro-name)))) + ;; Fix empty arguments applied + (if (and (= formal-count 1) + (null (car formal-parms))) + (setq formal-parms nil + formal-count (1- formal-count))) + (if (and (= actual-count 1) + (or (null (car actual-parms)) + ;; white space as the only argument + (equal '(hif-space) (car actual-parms)))) + (setq actual-parms nil + actual-count (1- actual-count))) + + ;; Basic error checking + (if etc + (if (eq etc 'c99) + (if (and (> formal-count 1) ; f(a,b,...) + (< actual-count formal-count)) + (error "C99 variadic argument macro %S need at least %d arguments" + macro-name formal-count)) + ;; GNU style variadic argument + (if (and (> formal-count 1) + (< actual-count (1- formal-count))) + (error "GNU variadic argument macro %S need at least %d arguments" + macro-name (1- formal-count)))) + (if (> formal-count actual-count) + (error "Too few parameters for macro %S; %d instead of %d" + macro-name actual-count formal-count) + (if (< formal-count actual-count) + (error "Too many parameters for macro %S; %d instead of %d" + macro-name actual-count formal-count)))) ;; Perform token replacement on the MACRO-BODY with the parameters - (while (setq formal (pop formal-parms)) - ;; Prevent repetitive substitution, thus cannot use `subst' - ;; for example: - ;; #define mac(a,b) (a+b) - ;; #define testmac mac(b,y) - ;; testmac should expand to (b+y): replace of argument a and b - ;; occurs simultaneously, not sequentially. If sequentially, - ;; according to the argument order, it will become: - ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b) - ;; becomes (b+b) - ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b) - ;; becomes (y+y). - (setq macro-body - ;; Unlike `subst', `substitute' replace only the top level - ;; instead of the whole tree; more importantly, it's not - ;; destructive. - (cl-substitute (if (and etc (null formal-parms)) - (hif-delimit actual-parms 'hif-comma) - (car actual-parms)) - formal macro-body)) - (setq actual-parms (cdr actual-parms))) - - ;; Replacement completed, stringifiy and concatenate the token list. - ;; Stringification happens must take place before flattening, otherwise - ;; only the first token will be stringified. - (setq macro-body - (flatten-tree (hif-token-stringification macro-body))) - - ;; Token concatenation happens here, keep single 'hif-space - (hif-keep-single (hif-token-concatenation macro-body) 'hif-space)))) + + ;; Every substituted argument in the macro-body must be in list form so + ;; that it won't again be substituted incorrectly in later iterations. + ;; Finally we will flatten the list to fix that. + (cl-loop + do + ;; Note that C99 '...' and GNU 'x...' allow empty match + (setq formal (pop formal-parms)) + ;; + ;; Prevent repetitive substitution, thus cannot use `subst' + ;; for example: + ;; #define mac(a,b) (a+b) + ;; #define testmac mac(b,y) + ;; testmac should expand to (b+y): replace of argument a and b + ;; occurs simultaneously, not sequentially. If sequentially, + ;; according to the argument order, it will become: + ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b) + ;; becomes (b+b) + ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b) + ;; becomes (y+y). + ;; Unlike `subst', `cl-substitute' replace only the top level + ;; instead of the whole tree; more importantly, it's not + ;; destructive. + ;; + (if (not (and (null formal-parms) etc)) + ;; One formal with one actual + (setq macro-body + (cl-substitute (car actual-parms) formal macro-body)) + ;; `formal-parms' used up, now take care of '...' + (cond + + ((eq etc 'c99) ; C99 __VA_ARGS__ style '...' + (when formal + (setq macro-body + (cl-substitute (car actual-parms) formal macro-body)) + ;; Now the whole __VA_ARGS__ represents the whole + ;; remaining actual params + (pop actual-parms)) + ;; Replace if __VA_ARGS__ presents: + ;; if yes, see if it's prefixed with ", ##" or not, + ;; if yes, remove the "##", then if actual-params is + ;; exhausted, remove the prefixed ',' as well. + ;; Prepare for destructive operation + (let ((rem-body (copy-sequence macro-body)) + new-body va left part) + ;; Find each __VA_ARGS__ and remove its immediate prefixed '##' + ;; and comma if presents and if `formal_param' is exhausted + (while (setq va (cl-position '__VA_ARGS__ rem-body)) + ;; Split REM-BODY @ __VA_ARGS__ into LEFT and right + (setq part nil) + (if (zerop va) + (setq left nil ; __VA_ARGS__ trimed + rem-body (cdr rem-body)) + (setq left rem-body + rem-body (cdr (nthcdr va rem-body))) ; _V_ removed + (setcdr (nthcdr va left) nil) ; now _V_ be the last in LEFT + ;; now LEFT=(, w? ## w? _V_) rem=(W X Y) where w = white space + (setq left (cdr (nreverse left)))) ; left=(w? ## w? ,) + + ;; Try to recognize w?##w? and remove ", ##" if found + ;; (remember head = __VA_ARGS__ is temporarily removed) + (while (and left (eq 'hif-space (car left))) ; skip whites + (setq part (cons 'hif-space part) + left (cdr left))) + + (if (eq (car left) 'hif-token-concat) ; match '##' + (if actual-parms + ;; Keep everything + (setq part (append part (cdr left))) + ;; `actual-params' exhausted, delete ',' if presents + (while (and left (eq 'hif-space (car left))) ; skip whites + (setq part (cons 'hif-space part) + left (cdr left))) + (setq part + (append part + (if (eq (car left) 'hif-comma) ; match ',' + (cdr left) + left)))) + ;; No immediate '##' found + (setq part (append part left))) + + ;; Insert __VA_ARGS__ as a list + (push (hif-delimit actual-parms 'hif-comma) part) + ;; Reverse `left' back + (setq left (nreverse part) + new-body (append new-body left))) + + ;; Replacement of __VA_ARGS__ done here, add rem-body back + (setq macro-body (append new-body rem-body) + actual-parms nil))) + + (etc ; GNU style '...', substitute last argument + (if (null actual-parms) + ;; Must be non-destructive otherwise the original function + ;; definition defined in `hide-ifdef-env' will be destroyed. + (setq macro-body (remove formal macro-body)) + (setq macro-body + (cl-substitute (hif-delimit actual-parms 'hif-comma) + formal macro-body) + actual-parms nil))) + + (t + (error "Interal error: impossible case.")))) + + (pop actual-parms) + while actual-parms) ; end cl-loop + + ;; Replacement completed, stringifiy and concatenate the token list. + ;; Stringification happens must take place before flattening, otherwise + ;; only the first token will be stringified. + (setq macro-body + (flatten-tree (hif-token-stringification macro-body)))) + + ;; Token concatenation happens here, keep single 'hif-space + (hif-keep-single (hif-token-concatenation macro-body) 'hif-space))) (defun hif-invoke (macro-name actual-parms) "Invoke a macro by expanding it, reparse macro-body and finally invoke it." @@ -1710,7 +1848,9 @@ and `+='...)." Do this when cursor is at the beginning of `regexp' (i.e. #ifX)." (let ((case-fold-search nil)) (save-excursion - (re-search-forward regexp) + (if (re-search-forward regexp) + (if (= ?\( (char-before)) ;; "#if(" found + (goto-char (1- (point))))) (let* ((curr-regexp (match-string 0)) (defined (string-match hif-ifxdef-regexp curr-regexp)) (negate (and defined @@ -1724,29 +1864,48 @@ Do this when cursor is at the beginning of `regexp' (i.e. #ifX)." (setq tokens (list 'hif-not tokens))) (hif-parse-exp tokens))))) +(defun hif-is-in-comment () + "Check if we're currently within a C(++) comment." + (or (nth 4 (syntax-ppss)) + (looking-at "/[/*]"))) + +(defun hif-search-ifX-regexp (hif-regexp &optional backward) + "Search for a valid ifX regexp defined in hideif." + (let ((start (point)) + (re-search-func (if backward + #'re-search-backward + #'re-search-forward)) + (limit (if backward (point-min) (point-max))) + found) + (while (and (setq found + (funcall re-search-func hif-regexp limit t)) + (hif-is-in-comment))) + ;; Jump to the pattern if found + (if found + (unless backward + (setq found + (goto-char (- (point) (length (match-string 0)))))) + (goto-char start)) + found)) + (defun hif-find-any-ifX () "Move to next #if..., or #ifndef, at point or after." ;; (message "find ifX at %d" (point)) - (prog1 - (re-search-forward hif-ifx-regexp (point-max) t) - (beginning-of-line))) - + (hif-search-ifX-regexp hif-ifx-regexp)) (defun hif-find-next-relevant () "Move to next #if..., #elif..., #else, or #endif, after the current line." ;; (message "hif-find-next-relevant at %d" (point)) (end-of-line) - ;; Avoid infinite recursion by only going to line-beginning if match found - (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t) - (beginning-of-line))) + ;; Avoid infinite recursion by going to the pattern only if a match is found + (hif-search-ifX-regexp hif-ifx-else-endif-regexp)) (defun hif-find-previous-relevant () "Move to previous #if..., #else, or #endif, before the current line." ;; (message "hif-find-previous-relevant at %d" (point)) (beginning-of-line) - ;; Avoid infinite recursion by only going to line-beginning if match found - (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t) - (beginning-of-line))) + ;; Avoid infinite recursion by going to the pattern only if a match is found + (hif-search-ifX-regexp hif-ifx-else-endif-regexp 't)) (defun hif-looking-at-ifX () @@ -1931,6 +2090,7 @@ Point is left unchanged." ((hif-looking-at-else) (setq else (point))) (t + (beginning-of-line) ; otherwise #endif line will be hidden (setq end (point))))) ;; If found #else, look for #endif. (when else @@ -1940,6 +2100,7 @@ Point is left unchanged." (hif-ifdef-to-endif)) (if (hif-looking-at-else) (error "Found two elses in a row? Broken!")) + (beginning-of-line) ; otherwise #endif line will be hidden (setq end (point))) ; (line-end-position) (hif-make-range start end else elif)))) @@ -2085,16 +2246,20 @@ Refer to `hide-ifdef-expand-reinclusion-guard' for more details." (eq (car def) 'hif-define-macro)) (let ((cdef (concat "#define " name)) (parmlist (cadr def)) - s) + p s etc) (setq def (caddr def)) ;; parmlist (when parmlist (setq cdef (concat cdef "(")) - (while (car parmlist) - (setq cdef (concat cdef (symbol-name (car parmlist)) - (if (cdr parmlist) ",")) + (if (setq etc (or (eq (setq p (car parmlist)) 'hif-etc) + (and (eq p 'hif-etc-c99) 'c99))) + (pop parmlist)) + (while (setq p (car parmlist)) + (setq cdef (concat cdef (symbol-name p) (if (cdr parmlist) ",")) parmlist (cdr parmlist))) - (setq cdef (concat cdef ")"))) + (setq cdef (concat cdef + (if etc (concat (if (eq etc 'c99) ",") "...")) + ")"))) (setq cdef (concat cdef " ")) ;; body (while def @@ -2221,25 +2386,38 @@ however, when this command is prefixed, it will display the error instead." result)))) (defun hif-parse-macro-arglist (str) - "Parse argument list formatted as `( arg1 [ , argn] [...] )'. + "Parse argument list formatted as `( arg1 [ , argn] [,] [...] )'. The `...' is also included. Return a list of the arguments, if `...' exists the first arg will be `hif-etc'." (let* ((hif-simple-token-only nil) ; Dynamic binding var for `hif-tokenize' (tokenlist (cdr (hif-tokenize (- (point) (length str)) (point)))) ; Remove `hif-lparen' - etc result token) - (while (not (eq (setq token (pop tokenlist)) 'hif-rparen)) + etc result token prevtok prev2tok) + (while (not (eq (setq prev2tok prevtok + prevtok token + token (pop tokenlist)) 'hif-rparen)) (cond ((eq token 'hif-etc) - (setq etc t)) + ;; GNU type "..." or C99 type + (setq etc (if (or (null prevtok) + (eq prevtok 'hif-comma) + (and (eq prevtok 'hif-space) + (eq prev2tok 'hif-comma))) + 'c99 t))) ((eq token 'hif-comma) - t) + (if etc + (error "Syntax error: no comma allowed after `...'."))) (t (push token result)))) - (if etc - (cons 'hif-etc (nreverse result)) - (nreverse result)))) + (setq result (nreverse result)) + (cond + ((eq etc 'c99) + (cons 'hif-etc-c99 result)) + ((eq etc t) + (cons 'hif-etc result)) + (t + result)))) ;; The original version of hideif evaluates the macro early and store the ;; final values for the defined macro into the symbol database (aka @@ -2280,9 +2458,11 @@ first arg will be `hif-etc'." (let* ((defining (string= "define" (match-string 2))) (name (and (re-search-forward hif-macroref-regexp max t) (match-string 1))) - (parmlist (or (and (match-string 3) ; First arg id found + (parmlist (or (and (or (match-string 3) ; First arg id found + (match-string 6)) ; '...' found (delq 'hif-space - (hif-parse-macro-arglist (match-string 2)))) + (hif-parse-macro-arglist + (match-string 2)))) (and (match-string 2) ; empty arglist (list nil))))) (if defining @@ -2325,7 +2505,8 @@ first arg will be `hif-etc'." (expr (and tokens ;; `hif-simple-token-only' is checked only ;; here. - (or (and hif-simple-token-only + (or (and (null parmlist) + hif-simple-token-only (listp tokens) (= (length tokens) 1) (hif-parse-exp tokens)) @@ -2354,13 +2535,22 @@ first arg will be `hif-etc'." (save-excursion (save-restriction ;; (mark-region min max) ;; for debugging + (and min (goto-char min)) (setq hif-verbose-define-count 0) (forward-comment (point-max)) - (while (hif-find-define min max) - (forward-comment (point-max)) - (setf min (point))) + (setq min (point)) + (let ((breakloop nil)) + (while (and (not breakloop) + (hif-find-define min max)) + (forward-comment (point-max)) + (if (and max + (> (point) max)) + (setq max (point) + breakloop t)) + (setq min (point)))) (if max (goto-char max) - (goto-char (point-max)))))) + (goto-char (point-max)) + nil)))) (defun hide-ifdef-guts () "Does most of the work of `hide-ifdefs'. @@ -2376,7 +2566,7 @@ It does not do the work that's pointless to redo on a recursive entry." min max) (setq hif-__COUNTER__ 0) (goto-char (point-min)) - (setf min (point)) + (setq min (point)) ;; Without this `condition-case' it would be easier to see which ;; operation went wrong thru the backtrace `iff' user realize ;; the underlying meaning of all hif-* operation; for example, @@ -2384,11 +2574,11 @@ It does not do the work that's pointless to redo on a recursive entry." ;; operation arguments would be invalid. (condition-case err (cl-loop do - (setf max (hif-find-any-ifX)) - (hif-add-new-defines min max) + (setq max (hif-find-any-ifX)) + (setq max (hif-add-new-defines min max)) (if max (hif-possibly-hide expand-header)) - (setf min (point)) + (setq min (point)) while max) (error (error "Error: failed at line %d %S" (line-number-at-pos) err)))))) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index c160e6ad1df..b878986d7a4 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -256,10 +256,14 @@ This has effect only if `search-invisible' is set to `open'." (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) ;; Add more support here. )) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index af2b0c1fa8d..47d87112ffb 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -36,6 +36,8 @@ (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") +(declare-function treesit-query-capture "treesit.c") (defcustom java-ts-mode-indent-offset 4 "Number of spaces for each indentation step in `java-ts-mode'." @@ -69,30 +71,37 @@ (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 "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 "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") 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) ((parent-is "expression_statement") parent-bol java-ts-mode-indent-offset) + ((match "type_identifier" "field_declaration") parent-bol 0) ((parent-is "field_declaration") parent-bol java-ts-mode-indent-offset) ((parent-is "return_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "variable_declarator") parent-bol java-ts-mode-indent-offset) ((parent-is "method_invocation") parent-bol java-ts-mode-indent-offset) ((parent-is "switch_rule") parent-bol java-ts-mode-indent-offset) + ((parent-is "switch_label") parent-bol java-ts-mode-indent-offset) ((parent-is "ternary_expression") parent-bol java-ts-mode-indent-offset) ((parent-is "lambda_expression") parent-bol java-ts-mode-indent-offset) ((parent-is "element_value_array_initializer") parent-bol java-ts-mode-indent-offset) @@ -114,7 +123,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 @@ -138,6 +147,16 @@ "|=" "~" ">>" ">>>" "<<" "::" "?" "&=") "Java operators for tree-sitter font-locking.") +(defun java-ts-mode--string-highlight-helper () +"Returns, for strings, a query based on what is supported by +the available version of Tree-sitter for java." + (condition-case nil + (progn (treesit-query-capture 'java '((text_block) @font-lock-string-face)) + `((string_literal) @font-lock-string-face + (text_block) @font-lock-string-face)) + (error + `((string_literal) @font-lock-string-face)))) + (defvar java-ts-mode--font-lock-settings (treesit-font-lock-rules :language 'java @@ -155,7 +174,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 @@ -174,8 +194,7 @@ :language 'java :override t :feature 'string - `((string_literal) @font-lock-string-face - (text_block) @font-lock-string-face) + (java-ts-mode--string-highlight-helper) :language 'java :override t :feature 'literal @@ -212,7 +231,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)) @@ -236,7 +255,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) @@ -247,14 +266,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 @@ -295,7 +314,30 @@ Return nil if there is no name or if NODE is not a defun node." ;; Comments. (c-ts-common-comment-setup) + (setq-local treesit-text-type-regexp + (regexp-opt '("line_comment" + "block_comment" + "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 @@ -315,6 +357,29 @@ Return nil if there is no name or if NODE is not a defun node." "constructor_declaration"))) (setq-local treesit-defun-name-function #'java-ts-mode--defun-name) + (setq-local treesit-sentence-type-regexp + (regexp-opt '("statement" + "local_variable_declaration" + "field_declaration" + "module_declaration" + "package_declaration" + "import_declaration"))) + + (setq-local treesit-sexp-type-regexp + (regexp-opt '("annotation" + "parenthesized_expression" + "argument_list" + "identifier" + "modifiers" + "block" + "body" + "literal" + "access" + "reference" + "_type" + "true" + "false"))) + ;; Font-lock. (setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings) (setq-local treesit-font-lock-feature-list diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index b5c912b8b0d..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,26 +3544,32 @@ 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) - (import_clause (named_imports (import_specifier (identifier)) - @font-lock-variable-name-face))) + ;; named imports with aliasing + (import_clause (named_imports (import_specifier + alias: (identifier) @font-lock-variable-name-face))) + ;; named imports without aliasing + (import_clause (named_imports (import_specifier + !alias + name: (identifier) @font-lock-variable-name-face))) + + ;; full namespace import (* as alias) + (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) :language '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 @@ -3570,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)) @@ -3585,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) @@ -3672,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) @@ -3792,6 +3801,54 @@ Currently there are `js-mode' and `js-ts-mode'." ;;(syntax-propertize (point-max)) ) +(defvar js--treesit-sentence-nodes + '("import_statement" + "debugger_statement" + "expression_statement" + "if_statement" + "switch_statement" + "for_statement" + "for_in_statement" + "while_statement" + "do_statement" + "try_statement" + "with_statement" + "break_statement" + "continue_statement" + "return_statement" + "throw_statement" + "empty_statement" + "labeled_statement" + "variable_declaration" + "lexical_declaration" + "jsx_element" + "jsx_self_closing_element") + "Nodes that designate sentences in JavaScript. +See `treesit-sentence-type-regexp' for more information.") + +(defvar js--treesit-sexp-nodes + '("expression" + "pattern" + "array" + "function" + "string" + "escape" + "template" + "regex" + "number" + "identifier" + "this" + "super" + "true" + "false" + "null" + "undefined" + "arguments" + "pair" + "jsx") + "Nodes that designate sexps in JavaScript. +See `treesit-sexp-type-regexp' for more information.") + ;;;###autoload (define-derived-mode js-ts-mode js-base-mode "JavaScript" "Major mode for editing JavaScript. @@ -3808,9 +3865,14 @@ Currently there are `js-mode' and `js-ts-mode'." ;; Comment. (c-ts-common-comment-setup) (setq-local comment-multi-line t) + + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" + "template_string"))) + ;; 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))) @@ -3826,6 +3888,13 @@ Currently there are `js-mode' and `js-ts-mode'." "function_declaration" "lexical_declaration"))) (setq-local treesit-defun-name-function #'js--treesit-defun-name) + + (setq-local treesit-sentence-type-regexp + (regexp-opt js--treesit-sentence-nodes)) + + (setq-local treesit-sexp-type-regexp + (regexp-opt js--treesit-sexp-nodes)) + ;; Fontification. (setq-local treesit-font-lock-settings js--treesit-font-lock-settings) (setq-local treesit-font-lock-feature-list diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index f54d0187f98..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 @@ -147,6 +147,8 @@ Return nil if there is no name or if NODE is not a defun node." (rx (or "pair" "object"))) (setq-local treesit-defun-name-function #'json-ts-mode--defun-name) + (setq-local treesit-sentence-type-regexp "pair") + ;; Font-lock. (setq-local treesit-font-lock-settings json-ts-mode--font-lock-settings) (setq-local treesit-font-lock-feature-list diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 0f3a477abe5..04071703184 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -30,7 +30,12 @@ ;;; Code: (eval-when-compile (require 'cl-lib) - (require 'subr-x)) + (require 'subr-x) + (require 'treesit)) + +(declare-function treesit-available-p "treesit.c") +(declare-function treesit-parser-list "treesit.c") +(declare-function treesit-node-type "treesit.c") (defgroup prog-mode nil "Generic programming mode, from which others derive." @@ -102,7 +107,8 @@ (defvar-keymap prog-mode-map :doc "Keymap used for programming modes." - "C-M-q" #'prog-indent-sexp) + "C-M-q" #'prog-indent-sexp + "M-q" #'prog-fill-reindent-defun) (defvar prog-indentation-context nil "When non-nil, provides context for indenting embedded code chunks. @@ -140,6 +146,31 @@ instead." (end (progn (forward-sexp 1) (point)))) (indent-region start end nil)))) +(defun prog-fill-reindent-defun (&optional argument) + "Refill or reindent the paragraph or defun that contains point. + +If the point is in a string or a comment, fill the paragraph that +contains point or follows point. + +Otherwise, reindent the function definition that contains point +or follows point." + (interactive "P") + (save-excursion + (let ((treesit-text-node + (and (treesit-available-p) + (treesit-parser-list) + (string-match-p + treesit-text-type-regexp + (treesit-node-type (treesit-node-at (point))))))) + (if (or treesit-text-node + (nth 8 (syntax-ppss)) + (re-search-forward "\\s-*\\s<" (line-end-position) t)) + (fill-paragraph argument (region-active-p)) + (beginning-of-defun) + (let ((start (point))) + (end-of-defun) + (indent-region start (point) nil)))))) + (defun prog-first-column () "Return the indentation column normally used for top-level constructs." (or (car prog-indentation-context) 0)) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 59270070484..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.5 +;; 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 @@ -530,11 +539,14 @@ project backend implementation of `project-external-roots'.") dir (lambda (d) ;; Maybe limit count to 100 when we can drop Emacs < 28. - (setq last-matches (directory-files d nil marker-re t))))) + (setq last-matches + (condition-case nil + (directory-files d nil marker-re t) + (file-missing nil)))))) (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 a869cdc5fdb..2fe88323c35 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -426,7 +426,7 @@ This variant of `rx' supports common Python named REGEXPS." (or "def" "for" "with"))) symbol-end)) (dedenter (seq symbol-start - (or "elif" "else" "except" "finally") + (or "elif" "else" "except" "finally" "case") symbol-end)) (block-ender (seq symbol-start (or @@ -511,19 +511,28 @@ This variant of `rx' supports common Python named REGEXPS." (''string `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) (and (nth 3 ppss) (nth 8 ppss)))) + (''single-quoted-string + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (characterp (nth 3 ppss)) (nth 8 ppss)))) + (''triple-quoted-string + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (eq t (nth 3 ppss)) (nth 8 ppss)))) (''paren `(nth 1 (or ,syntax-ppss (syntax-ppss)))) (_ form)))) (defun python-syntax-context (type &optional syntax-ppss) "Return non-nil if point is on TYPE using SYNTAX-PPSS. -TYPE can be `comment', `string' or `paren'. It returns the start +TYPE can be `comment', `string', `single-quoted-string', +`triple-quoted-string' or `paren'. It returns the start character address of the specified TYPE." (declare (compiler-macro python-syntax--context-compiler-macro)) (let ((ppss (or syntax-ppss (syntax-ppss)))) (pcase type ('comment (and (nth 4 ppss) (nth 8 ppss))) ('string (and (nth 3 ppss) (nth 8 ppss))) + ('single-quoted-string (and (characterp (nth 3 ppss)) (nth 8 ppss))) + ('triple-quoted-string (and (eq t (nth 3 ppss)) (nth 8 ppss))) ('paren (nth 1 ppss)) (_ nil)))) @@ -1070,7 +1079,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 +1115,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 +1156,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 +1193,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 +1221,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) @@ -2061,10 +2071,6 @@ of the statement." ;; are somehow out of whack. This has been ;; observed when using `syntax-ppss' during ;; narrowing. - ;; It can also fail in cases where the buffer is in - ;; the process of being modified, e.g. when creating - ;; a string with `electric-pair-mode' disabled such - ;; that there can be an unmatched single quote (when (>= string-start last-string-end) (goto-char string-start) (if (python-syntax-context 'paren) @@ -2075,10 +2081,16 @@ of the statement." (goto-char (+ (point) (python-syntax-count-quotes (char-after (point)) (point)))) - (setq last-string-end - (or (re-search-forward - (rx (syntax string-delimiter)) nil t) - (goto-char (point-max))))))) + (setq + last-string-end + (or (if (eq t (nth 3 (syntax-ppss))) + (re-search-forward + (rx (syntax string-delimiter)) nil t) + (ignore-error scan-error + (goto-char string-start) + (python-nav--lisp-forward-sexp) + (point))) + (goto-char (point-max))))))) ((python-syntax-context 'paren) ;; The statement won't end before we've escaped ;; at least one level of parenthesis. @@ -2147,10 +2159,7 @@ backward to previous statement." (while (and (forward-line 1) (not (eobp)) (or (and (> (current-indentation) block-indentation) - (let ((start (point))) - (python-nav-end-of-statement) - ;; must move forward otherwise infinite loop - (> (point) start))) + (or (python-nav-end-of-statement) t)) (python-info-current-line-comment-p) (python-info-current-line-empty-p)))) (python-util-forward-comment -1) @@ -3759,14 +3768,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 +3795,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) @@ -4803,9 +4814,7 @@ Optional argument JUSTIFY defines if the paragraph should be justified." ((python-syntax-context 'comment) (funcall python-fill-comment-function justify)) ;; Strings/Docstrings - ((save-excursion (or (python-syntax-context 'string) - (equal (string-to-syntax "|") - (syntax-after (point))))) + ((python-info-triple-quoted-string-p) (funcall python-fill-string-function justify)) ;; Decorators ((equal (char-after (save-excursion @@ -4831,10 +4840,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (let* ((str-start-pos (set-marker (make-marker) - (or (python-syntax-context 'string) - (and (equal (string-to-syntax "|") - (syntax-after (point))) - (point))))) + (python-info-triple-quoted-string-p))) ;; JT@2021-09-21: Since bug#49518's fix this will always be 1 (num-quotes (python-syntax-count-quotes (char-after str-start-pos) str-start-pos)) @@ -5781,7 +5787,8 @@ likely an invalid python file." (pairs '(("elif" "elif" "if") ("else" "if" "elif" "except" "for" "while") ("except" "except" "try") - ("finally" "else" "except" "try"))) + ("finally" "else" "except" "try") + ("case" "case"))) (dedenter (match-string-no-properties 0)) (possible-opening-blocks (cdr (assoc-string dedenter pairs))) (collected-indentations) @@ -5789,7 +5796,11 @@ likely an invalid python file." (catch 'exit (while (python-nav--syntactically (lambda () - (re-search-backward (python-rx block-start) nil t)) + (cl-loop while (re-search-backward (python-rx block-start) nil t) + if (save-match-data + (looking-back (rx line-start (* whitespace)) + (line-beginning-position))) + return t)) #'<) (let ((indentation (current-indentation))) (when (and (not (memq indentation collected-indentations)) @@ -6036,6 +6047,21 @@ point's current `syntax-ppss'." ((python-info-looking-at-beginning-of-defun)) (t nil)))))) +(defun python-info-triple-quoted-string-p () + "Check if point is in a triple quoted string including quotes. +It returns the position of the third quote character of the start +of the string." + (save-excursion + (let ((pos (point))) + (cl-loop + for offset in '(0 3 -2 2 -1 1) + if (let ((check-pos (+ pos offset))) + (and (>= check-pos (point-min)) + (<= check-pos (point-max)) + (python-syntax-context + 'triple-quoted-string (syntax-ppss check-pos)))) + return it)))) + (defun python-info-encoding-from-cookie () "Detect current buffer's encoding from its coding cookie. Returns the encoding as a symbol." @@ -6374,7 +6400,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))) @@ -6715,8 +6741,8 @@ implementations: `python-mode' and `python-ts-mode'." (when python-indent-guess-indent-offset (python-indent-guess-indent-offset)) - (add-to-list 'auto-mode-alist - '("\\.py[iw]?\\'\\|python[0-9.]*" . python-ts-mode)))) + (add-to-list 'auto-mode-alist '("\\.py[iw]?\\'" . python-ts-mode)) + (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code 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 eff846f8585..d077c43ba52 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." @@ -209,9 +214,6 @@ values of OVERRIDE" (treesit-fontify-with-override (max plus-1 start) (min node-end end) font-lock-comment-face override))) -(defun ruby-ts--builtin-method-p (node) - (string-match-p ruby-ts--builtin-methods (treesit-node-text node t))) - (defun ruby-ts--font-lock-settings (language) "Tree-sitter font-lock settings for Ruby." (treesit-font-lock-rules @@ -290,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 @@ -340,7 +342,7 @@ values of OVERRIDE" :language language :feature 'builtin-function `((((identifier) @font-lock-builtin-face) - (:pred ruby-ts--builtin-method-p @font-lock-builtin-face))) + (:match ,ruby-ts--builtin-methods @font-lock-builtin-face))) ;; Yuan recommends also putting method definitions into the ;; 'function' category (thus keeping it in both). I've opted to @@ -348,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 @@ -555,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,6 +568,12 @@ a statement container is a node that matches ((n-p-gp nil nil "regex") no-indent 0) ((parent-is "regex") no-indent 0) + ;; Incomplete buffer state, better not reindent (bug#61017). + ((and (parent-is "ERROR") + (or (node-is ,ruby-ts--class-or-module-regex) + (node-is "\\`\\(?:def\\|identifier\\)\\'"))) + no-indent 0) + ;; if then else elseif notes: ;; ;; 1. The "then" starts at the end of the line that ends @@ -653,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 (.); @@ -999,6 +1014,80 @@ 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 "\\s." @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 + (goto-char (treesit-node-end node)) + (skip-syntax-backward "." (treesit-node-start node)) + (put-text-property (point) (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 @@ -1026,6 +1115,23 @@ leading double colon is not added." ;; Navigation. (setq-local treesit-defun-type-regexp ruby-ts--method-regex) + (setq-local treesit-sexp-type-regexp + (regexp-opt '("class" + "module" + "method" + "argument_list" + "array" + "hash" + "parenthesized_statements" + "if" + "case" + "when" + "block" + "do_block" + "begin" + "binary" + "assignment"))) + ;; AFAIK, Ruby can not nest methods (setq-local treesit-defun-prefer-top-level nil) @@ -1046,7 +1152,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 3a6cb61b719..be06acde3e3 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -36,7 +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'." @@ -68,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) @@ -87,6 +91,7 @@ ((parent-is "let_declaration") parent-bol rust-ts-mode-indent-offset) ((parent-is "macro_definition") parent-bol rust-ts-mode-indent-offset) ((parent-is "parameters") parent-bol rust-ts-mode-indent-offset) + ((parent-is "struct_pattern") parent-bol rust-ts-mode-indent-offset) ((parent-is "token_tree") parent-bol rust-ts-mode-indent-offset) ((parent-is "use_list") parent-bol rust-ts-mode-indent-offset))) "Tree-sitter indent rules for `rust-ts-mode'.") @@ -121,8 +126,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,33 +150,42 @@ '(([(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 @@ -194,9 +208,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))) @@ -207,29 +230,48 @@ (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)) + ((scoped_type_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 @@ -237,17 +279,49 @@ '((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." @@ -275,6 +349,28 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-node-text (treesit-node-child-by-field-name node "name") t)))) +(defun rust-ts-mode--syntax-propertize (beg end) + "Apply syntax text property to template delimiters between BEG and END. + +< and > are usually punctuation, e.g., as greater/less-than. But +when used for types, they should be considered pairs. + +This function checks for < and > in the changed RANGES and apply +appropriate text property to alter the syntax of template +delimiters < and >'s." + (goto-char beg) + (while (re-search-forward (rx (or "<" ">")) end t) + (pcase (treesit-node-type + (treesit-node-parent + (treesit-node-at (match-beginning 0)))) + ("type_arguments" + (put-text-property (match-beginning 0) + (match-end 0) + 'syntax-table + (pcase (char-before) + (?< '(4 . ?>)) + (?> '(5 . ?<)))))))) + ;;;###autoload (define-derived-mode rust-ts-mode prog-mode "Rust" "Major mode for editing Rust, powered by tree-sitter." @@ -284,17 +380,21 @@ Return nil if there is no name or if NODE is not a defun node." (when (treesit-ready-p 'rust) (treesit-parser-create 'rust) + ;; Syntax. + (setq-local syntax-propertize-function + #'rust-ts-mode--syntax-propertize) + ;; Comments. (c-ts-common-comment-setup) ;; 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 4c06efc8146..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,10 +1621,15 @@ 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) + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" + "heredoc_start" + "heredoc_body"))) (setq-local treesit-defun-type-regexp "function_definition") (treesit-major-mode-setup))) @@ -1780,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 @@ -2006,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 @@ -2027,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)))))) @@ -2051,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 @@ -2144,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 () @@ -3289,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 34030968806..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 @@ -132,26 +137,21 @@ Argument LANGUAGE is either `typescript' or `tsx'." Argument LANGUAGE is either `typescript' or `tsx'." (treesit-font-lock-rules :language language - :override t :feature 'comment `((comment) @font-lock-comment-face) :language language - :override t :feature 'constant `(((identifier) @font-lock-constant-face (:match "^[A-Z_][A-Z_\\d]*$" @font-lock-constant-face)) - [(true) (false) (null)] @font-lock-constant-face) :language language - :override t :feature 'keyword `([,@typescript-ts-mode--keywords] @font-lock-keyword-face [(this) (super)] @font-lock-keyword-face) :language language - :override t :feature 'string `((regex pattern: (regex_pattern)) @font-lock-regexp-face (string) @font-lock-string-face @@ -159,7 +159,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) :language language - :override t + :override t ;; for functions assigned to variables :feature 'declaration `((function name: (identifier) @font-lock-function-name-face) @@ -175,6 +175,10 @@ Argument LANGUAGE is either `typescript' or `tsx'." (optional_parameter (identifier) @font-lock-variable-name-face) (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function) (arrow_function)]) + + (variable_declarator name: (identifier) @font-lock-variable-name-face) (enum_declaration (identifier) @font-lock-type-face) @@ -189,10 +193,6 @@ Argument LANGUAGE is either `typescript' or `tsx'." parameter: (identifier) @font-lock-variable-name-face) (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) - - (variable_declarator name: (array_pattern (identifier) (identifier) @font-lock-function-name-face) @@ -201,11 +201,20 @@ Argument LANGUAGE is either `typescript' or `tsx'." (catch_clause parameter: (identifier) @font-lock-variable-name-face) + ;; full module imports (import_clause (identifier) @font-lock-variable-name-face) - (import_clause (named_imports (import_specifier (identifier)) @font-lock-variable-name-face))) + ;; named imports with aliasing + (import_clause (named_imports (import_specifier + alias: (identifier) @font-lock-variable-name-face))) + ;; named imports without aliasing + (import_clause (named_imports (import_specifier + !alias + name: (identifier) @font-lock-variable-name-face))) + + ;; full namespace import (* as alias) + (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) :language language - :override t :feature 'identifier `((nested_type_identifier module: (identifier) @font-lock-type-face) @@ -234,22 +243,17 @@ Argument LANGUAGE is either `typescript' or `tsx'." (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) :language language - :override t :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) - - (pair key: (property_identifier) @font-lock-variable-name-face) + name: (property_identifier) @font-lock-property-name-face) - ((shorthand_property_identifier) @font-lock-property-face) + (pair key: (property_identifier) @font-lock-property-use-face) - ((shorthand_property_identifier_pattern) - @font-lock-property-face)) + ((shorthand_property_identifier) @font-lock-property-use-face)) :language language - :override t :feature 'expression '((assignment_expression left: [(identifier) @font-lock-function-name-face @@ -261,32 +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 - :override t :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 - :override t :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)) @@ -314,6 +320,52 @@ Argument LANGUAGE is either `typescript' or `tsx'." :override t '((escape_sequence) @font-lock-escape-face))) +(defvar typescript-ts-mode--sentence-nodes + '("import_statement" + "debugger_statement" + "expression_statement" + "if_statement" + "switch_statement" + "for_statement" + "for_in_statement" + "while_statement" + "do_statement" + "try_statement" + "with_statement" + "break_statement" + "continue_statement" + "return_statement" + "throw_statement" + "empty_statement" + "labeled_statement" + "variable_declaration" + "lexical_declaration" + "property_signature") + "Nodes that designate sentences in TypeScript. +See `treesit-sentence-type-regexp' for more information.") + +(defvar typescript-ts-mode--sexp-nodes + '("expression" + "pattern" + "array" + "function" + "string" + "escape" + "template" + "regex" + "number" + "identifier" + "this" + "super" + "true" + "false" + "null" + "undefined" + "arguments" + "pair") + "Nodes that designate sexps in TypeScript. +See `treesit-sexp-type-regexp' for more information.") + ;;;###autoload (define-derived-mode typescript-ts-base-mode prog-mode "TypeScript" "Major mode for editing TypeScript." @@ -322,11 +374,17 @@ Argument LANGUAGE is either `typescript' or `tsx'." ;; Comments. (c-ts-common-comment-setup) + (setq-local treesit-defun-prefer-top-level t) + + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" + "template_string"))) ;; 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" @@ -335,6 +393,12 @@ Argument LANGUAGE is either `typescript' or `tsx'." "lexical_declaration"))) (setq-local treesit-defun-name-function #'js--treesit-defun-name) + (setq-local treesit-sentence-type-regexp + (regexp-opt typescript-ts-mode--sentence-nodes)) + + (setq-local treesit-sexp-type-regexp + (regexp-opt typescript-ts-mode--sexp-nodes)) + ;; Imenu (same as in `js-ts-mode'). (setq-local treesit-simple-imenu-settings `(("Function" "\\`function_declaration\\'" nil nil) @@ -396,6 +460,18 @@ Argument LANGUAGE is either `typescript' or `tsx'." (setq-local treesit-simple-indent-rules (typescript-ts-mode--indent-rules 'tsx)) + ;; Navigation + (setq-local treesit-sentence-type-regexp + (regexp-opt (append + typescript-ts-mode--sentence-nodes + '("jsx_element" + "jsx_self_closing_element")))) + + (setq-local treesit-sexp-type-regexp + (regexp-opt (append + typescript-ts-mode--sexp-nodes + '("jsx")))) + ;; Font-lock. (setq-local treesit-font-lock-settings (typescript-ts-mode--font-lock-settings 'tsx)) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 3134a09c44f..ac6fd382a46 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2021.10.14.127365406 +;; Version: 2022.12.18.181110314 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2021-10-14-797711e-vpo-GNU" +(defconst verilog-mode-version "2022-12-18-acb862a-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -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) @@ -455,11 +456,11 @@ This function may be removed when Emacs 21 is no longer supported." last-command-event))) (defvar verilog-no-change-functions nil - "True if `after-change-functions' is disabled. + "Non-nil if `after-change-functions' is disabled. Use of `syntax-ppss' may break, as ppss's cache may get corrupted.") (defvar verilog-in-hooks nil - "True when within a `verilog-run-hooks' block.") + "Non-nil when within a `verilog-run-hooks' block.") (defmacro verilog-run-hooks (&rest hooks) "Run each hook in HOOKS using `run-hooks'. @@ -505,8 +506,14 @@ Set `verilog-in-hooks' during this time, to assist AUTO caches." (defvar verilog-debug nil "Non-nil means enable debug messages for `verilog-mode' internals.") -(defvar verilog-warn-fatal nil - "Non-nil means `verilog-warn-error' warnings are fatal `error's.") +(defcustom verilog-warn-fatal nil + "Non-nil means `verilog-warn-error' warnings are fatal `error's." + :group 'verilog-mode-auto + :type 'boolean) +(put 'verilog-warn-fatal 'safe-local-variable #'verilog-booleanp) + +;; Internal use similar to `verilog-warn-fatal' +(defvar verilog-warn-fatal-internal t) (defcustom verilog-linter "echo 'No verilog-linter set, see \"M-x describe-variable verilog-linter\"'" @@ -679,6 +686,18 @@ Set to 0 to have all directives start at the left side of the screen." :type 'integer) (put 'verilog-indent-level-directive 'safe-local-variable #'integerp) +(defcustom verilog-indent-ignore-multiline-defines t + "Non-nil means ignore indentation on lines that are part of a multiline define." + :group 'verilog-mode-indent + :type 'boolean) +(put 'verilog-indent-ignore-multiline-defines 'safe-local-variable #'verilog-booleanp) + +(defcustom verilog-indent-ignore-regexp nil + "Regexp that matches lines that should be ignored for indentation." + :group 'verilog-mode-indent + :type 'boolean) +(put 'verilog-indent-ignore-regexp 'safe-local-variable #'stringp) + (defcustom verilog-cexp-indent 2 "Indentation of Verilog statements split across lines." :group 'verilog-mode-indent @@ -723,6 +742,13 @@ Otherwise, line them up." :type 'boolean) (put 'verilog-indent-begin-after-if 'safe-local-variable #'verilog-booleanp) +(defcustom verilog-indent-class-inside-pkg t + "Non-nil means indent classes inside packages. +Otherwise, classes have zero indentation." + :group 'verilog-mode-indent + :type 'boolean) +(put 'verilog-indent-class-inside-pkg 'safe-local-variable #'verilog-booleanp) + (defcustom verilog-align-ifelse nil "Non-nil means align `else' under matching `if'. Otherwise else is lined up with first character on line holding matching if." @@ -730,6 +756,38 @@ Otherwise else is lined up with first character on line holding matching if." :type 'boolean) (put 'verilog-align-ifelse 'safe-local-variable #'verilog-booleanp) +(defcustom verilog-align-decl-expr-comments t + "Non-nil means align declaration and expressions comments." + :group 'verilog-mode-indent + :type 'boolean) +(put 'verilog-align-decl-expr-comments 'safe-local-variable #'verilog-booleanp) + +(defcustom verilog-align-comment-distance 1 + "Distance (in spaces) between longest declaration/expression and comments. +Only works if `verilog-align-decl-expr-comments' is non-nil." + :group 'verilog-mode-indent + :type 'integer) +(put 'verilog-align-comment-distance 'safe-local-variable #'integerp) + +(defcustom verilog-align-assign-expr nil + "Non-nil means align expressions of continuous assignments." + :group 'verilog-mode-indent + :type 'boolean) +(put 'verilog-align-assign-expr 'safe-local-variable #'verilog-booleanp) + +(defcustom verilog-align-typedef-regexp nil + "Regexp that matches user typedefs for declaration alignment." + :group 'verilog-mode-indent + :type '(choice (regexp :tag "Regexp") + (const :tag "None" nil))) +(put 'verilog-align-typedef-regexp 'safe-local-variable #'stringp) + +(defcustom verilog-align-typedef-words nil + "List of words that match user typedefs for declaration alignment." + :group 'verilog-mode-indent + :type '(repeat string)) +(put 'verilog-align-typedef-words 'safe-local-variable #'listp) + (defcustom verilog-minimum-comment-distance 10 "Minimum distance (in lines) between begin and end required before a comment. Setting this variable to zero results in every end acquiring a comment; the @@ -876,6 +934,12 @@ always be saved." :type 'boolean) (put 'verilog-auto-star-save 'safe-local-variable #'verilog-booleanp) +(defcustom verilog-fontify-variables t + "Non-nil means fontify declaration variables." + :group 'verilog-mode-actions + :type 'boolean) +(put 'verilog-fontify-variables 'safe-local-variable #'verilog-booleanp) + (defvar verilog-auto-update-tick nil "Modification tick at which autos were last performed.") @@ -1052,7 +1116,7 @@ You might want these defined in each file; put at the *END* of your file something like: // Local Variables: - // verilog-library-files:(\"/some/path/technology.v\" \"/some/path/tech2.v\") + // verilog-library-files:(\"/path/technology.v\" \"/path2/tech2.v\") // End: Verilog-mode attempts to detect changes to this local variable, but they @@ -1124,7 +1188,7 @@ those temporaries reset. See example in `verilog-auto-reset'." (put 'verilog-auto-reset-blocking-in-non 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-reset-widths t - "True means AUTORESET should determine the width of signals. + "Non-nil means AUTORESET should determine the width of signals. This is then used to set the width of the zero (32'h0 for example). This is required by some lint tools that aren't smart enough to ignore widths of the constant zero. This may result in ugly code when parameters determine @@ -1264,7 +1328,7 @@ See `verilog-auto-inst-param-value'." Also affects AUTOINSTPARAM. Declaration order is the default for backward compatibility, and as some teams prefer signals that are declared together to remain together. Sorted order reduces -changes when declarations are moved around in a file. Sorting is +changes when declarations are moved around in a file. Sorting is within input/output/inout groupings, there is intentionally no option to intermix between input/output/inouts. @@ -1275,7 +1339,7 @@ See also `verilog-auto-arg-sort'." (put 'verilog-auto-inst-sort 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-inst-vector t - "True means when creating default ports with AUTOINST, use bus subscripts. + "Non-nil means when creating default ports with AUTOINST, use bus subscripts. If nil, skip the subscript when it matches the entire bus as declared in the module (AUTOWIRE signals always are subscripted, you must manually declare the wire to have the subscripts removed.) Setting this to nil may @@ -1515,10 +1579,9 @@ If set will become buffer local.") (define-key map "\C-c/" #'verilog-star-comment) (define-key map "\C-c\C-c" #'verilog-comment-region) (define-key map "\C-c\C-u" #'verilog-uncomment-region) - (when (featurep 'xemacs) - (define-key map [(meta control h)] #'verilog-mark-defun) - (define-key map "\M-\C-a" #'verilog-beg-of-defun) - (define-key map "\M-\C-e" #'verilog-end-of-defun)) + (define-key map "\M-\C-h" #'verilog-mark-defun) + (define-key map "\M-\C-a" #'verilog-beg-of-defun) + (define-key map "\M-\C-e" #'verilog-end-of-defun) (define-key map "\C-c\C-d" #'verilog-goto-defun) (define-key map "\C-c\C-k" #'verilog-delete-auto) (define-key map "\C-c\C-a" #'verilog-auto) @@ -2028,11 +2091,11 @@ Where __FLAGS__ appears in the string `verilog-current-flags' will be substituted. Where __FILE__ appears in the string, the current buffer's file-name, without the directory portion, will be substituted." - (setq command (verilog-string-replace-matches + (setq command (verilog-string-replace-matches ;; Note \\b only works if under verilog syntax table "\\b__FLAGS__\\b" (verilog-current-flags) t t command)) - (setq command (verilog-string-replace-matches + (setq command (verilog-string-replace-matches "\\b__FILE__\\b" (file-name-nondirectory (or (buffer-file-name) "")) t t command)) @@ -2468,13 +2531,8 @@ find the errors." ;; ;; Regular expressions used to calculate indent, etc. ;; -(defconst verilog-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>") -;; Want to match -;; aa : -;; aa,bb : -;; a[34:32] : -;; a, -;; b : +(defconst verilog-identifier-re "[a-zA-Z_][a-zA-Z_0-9]*") +(defconst verilog-identifier-sym-re (concat "\\<" verilog-identifier-re "\\>")) (defconst verilog-assignment-operator-re (eval-when-compile (verilog-regexp-opt @@ -2492,12 +2550,11 @@ find the errors." ) 't ))) (defconst verilog-assignment-operation-re - (concat - ;; "\\(^\\s-*[A-Za-z0-9_]+\\(\\[\\([A-Za-z0-9_]+\\)\\]\\)*\\s-*\\)" - ;; "\\(^\\s-*[^=<>+-*/%&|^:\\s-]+[^=<>+-*/%&|^\n]*?\\)" - "\\(^.*?\\)" "\\B" verilog-assignment-operator-re "\\B" )) + (concat "\\(^.*?\\)" verilog-assignment-operator-re)) +(defconst verilog-assignment-operation-re-2 + (concat "\\(.*?\\)" verilog-assignment-operator-re)) -(defconst verilog-label-re (concat verilog-symbol-re "\\s-*:\\s-*")) +(defconst verilog-label-re (concat verilog-identifier-sym-re "\\s-*:\\s-*")) (defconst verilog-property-re (concat "\\(" verilog-label-re "\\)?" ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>" @@ -2732,6 +2789,9 @@ find the errors." "\\|\\(\\<clocking\\>\\)" ;17 "\\|\\(\\<`[ou]vm_[a-z_]+_begin\\>\\)" ;18 "\\|\\(\\<`vmm_[a-z_]+_member_begin\\>\\)" + "\\|\\(\\<`ifn?def\\>\\)" ;20, matched end can be: `else `elsif `endif + "\\|\\(\\<`else\\>\\)" ;21, matched end can be: `endif + "\\|\\(\\<`elsif\\>\\)" ;22, matched end can be: `else `endif ;; )) @@ -2817,40 +2877,54 @@ find the errors." "localparam" "parameter" "var" ;; misc "string" "event" "chandle" "virtual" "enum" "genvar" - "struct" "union" + "struct" "union" "type" ;; builtin classes "mailbox" "semaphore" )))) -(defconst verilog-declaration-re - (concat "\\(" verilog-declaration-prefix-re "\\s-*\\)?" verilog-declaration-core-re)) (defconst verilog-range-re "\\(\\[[^]]*\\]\\s-*\\)+") (defconst verilog-optional-signed-re "\\s-*\\(\\(un\\)?signed\\)?") (defconst verilog-optional-signed-range-re - (concat - "\\s-*\\(\\<\\(reg\\|wire\\)\\>\\s-*\\)?\\(\\<\\(un\\)?signed\\>\\s-*\\)?\\(" verilog-range-re "\\)?")) + (concat "\\s-*\\(\\<\\(reg\\|wire\\)\\>\\s-*\\)?\\(\\<\\(un\\)?signed\\>\\s-*\\)?\\(" verilog-range-re "\\)?")) (defconst verilog-macroexp-re "`\\sw+") - (defconst verilog-delay-re "#\\s-*\\(\\([0-9_]+\\('s?[hdxbo][0-9a-fA-F_xz]+\\)?\\)\\|\\(([^()]*)\\)\\|\\(\\sw+\\)\\)") -(defconst verilog-declaration-re-2-no-macro - (concat "\\s-*" verilog-declaration-re - "\\s-*\\(\\(" verilog-optional-signed-range-re "\\)\\|\\(" verilog-delay-re "\\)" - "\\)")) -(defconst verilog-declaration-re-2-macro - (concat "\\s-*" verilog-declaration-re - "\\s-*\\(\\(" verilog-optional-signed-range-re "\\)\\|\\(" verilog-delay-re "\\)" - "\\|\\(" verilog-macroexp-re "\\)" - "\\)")) -(defconst verilog-declaration-re-1-macro - (concat "^" verilog-declaration-re-2-macro)) - -(defconst verilog-declaration-re-1-no-macro (concat "^" verilog-declaration-re-2-no-macro)) +(defconst verilog-interface-modport-re "\\(\\s-*\\([a-zA-Z0-9`_$]+\\.[a-zA-Z0-9`_$]+\\)[ \t\f]+\\)") +(defconst verilog-comment-start-regexp "//\\|/\\*" "Dual comment value for `comment-start-regexp'.") +(defconst verilog-typedef-enum-re + (concat "^\\s-*\\(typedef\\s-+\\)?enum\\(\\s-+" verilog-declaration-core-re verilog-optional-signed-range-re "\\)?")) + +(defconst verilog-declaration-simple-re + (concat "\\(" verilog-declaration-prefix-re "\\s-*\\)?" verilog-declaration-core-re)) +(defconst verilog-declaration-re + (concat "\\s-*" verilog-declaration-simple-re + "\\s-*\\(\\(" verilog-optional-signed-range-re "\\)\\|\\(" verilog-delay-re "\\)\\)")) +(defconst verilog-declaration-re-macro + (concat "\\s-*" verilog-declaration-simple-re + "\\s-*\\(\\(" verilog-optional-signed-range-re "\\)\\|\\(" verilog-delay-re "\\)\\|\\(" verilog-macroexp-re "\\)\\)")) +(defconst verilog-declaration-or-iface-mp-re + (concat "\\(" verilog-declaration-re "\\)\\|\\(" verilog-interface-modport-re "\\)")) +(defconst verilog-declaration-embedded-comments-re + (concat "\\( " verilog-declaration-re "\\) ""\\s-*" "\\(" verilog-comment-start-regexp "\\)") + "Match expressions such as: input logic [7:0] /* auto enum sm_psm */ sm_psm;.") (defconst verilog-defun-re (eval-when-compile (verilog-regexp-words '("macromodule" "connectmodule" "module" "class" "program" "interface" "package" "primitive" "config")))) (defconst verilog-end-defun-re (eval-when-compile (verilog-regexp-words '("endconnectmodule" "endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig")))) +(defconst verilog-defun-tf-re-beg + (eval-when-compile (verilog-regexp-words '("macromodule" "connectmodule" "module" "class" "program" "interface" "package" "primitive" "config" "function" "task")))) +(defconst verilog-defun-tf-re-end + (eval-when-compile (verilog-regexp-words '("endconnectmodule" "endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig" "endfunction" "endtask")))) +(defconst verilog-defun-tf-re-all + (eval-when-compile (verilog-regexp-words '("macromodule" "connectmodule" "module" "class" "program" "interface" "package" "primitive" "config" "function" "task" + "endconnectmodule" "endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig" "endfunction" "endtask")))) +(defconst verilog-defun-no-class-re + (eval-when-compile (verilog-regexp-words '("macromodule" "connectmodule" "module" "program" "interface" "package" "primitive" "config")))) +(defconst verilog-end-defun-no-class-re + (eval-when-compile (verilog-regexp-words '("endconnectmodule" "endmodule" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig")))) (defconst verilog-zero-indent-re (concat verilog-defun-re "\\|" verilog-end-defun-re)) +(defconst verilog-zero-indent-no-class-re + (concat verilog-defun-no-class-re "\\|" verilog-end-defun-no-class-re)) (defconst verilog-inst-comment-re (eval-when-compile (verilog-regexp-words '("Outputs" "Inouts" "Inputs" "Interfaces" "Interfaced")))) @@ -2983,19 +3057,38 @@ find the errors." (defconst verilog-extended-case-re "\\(\\(unique0?\\s-+\\|priority\\s-+\\)?case[xz]?\\|randcase\\)") (defconst verilog-extended-complete-re ;; verilog-beg-of-statement also looks backward one token to extend this match - (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\|\\<static\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)" + (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?virtual\\s-+\\|\\<local\\s-+\\|\\<protected\\s-+\\|\\<static\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)" "\\|\\(\\(\\<typedef\\>\\s-+\\)*\\(\\<struct\\>\\|\\<union\\>\\|\\<class\\>\\)\\)" "\\|\\(\\(\\<\\(import\\|export\\)\\>\\s-+\\)?\\(\"DPI\\(-C\\)?\"\\s-+\\)?\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_]*\\s-*=\\s-*\\)?\\(function\\>\\|task\\>\\)\\)" "\\|" verilog-extended-case-re )) + +(eval-and-compile + (defconst verilog-basic-complete-words + '("always" "assign" "always_latch" "always_ff" "always_comb" "analog" "connectmodule" "constraint" + "import" "initial" "final" "module" "macromodule" "repeat" "randcase" "while" + "if" "for" "forever" "foreach" "else" "parameter" "do" "localparam" "assert" "default" "generate")) + (defconst verilog-basic-complete-words-expr + (let ((words verilog-basic-complete-words)) + (dolist (word '("default" "parameter" "localparam")) + (setq words (remove word words))) + words)) + (defconst verilog-basic-complete-words-expr-no-assign + (remove "assign" verilog-basic-complete-words-expr))) + (defconst verilog-basic-complete-re (eval-when-compile - (verilog-regexp-words - '( - "always" "assign" "always_latch" "always_ff" "always_comb" "analog" "connectmodule" "constraint" - "import" "initial" "final" "module" "macromodule" "repeat" "randcase" "while" - "if" "for" "forever" "foreach" "else" "parameter" "do" "localparam" "assert" - )))) -(defconst verilog-complete-reg + (verilog-regexp-words verilog-basic-complete-words))) + +(defconst verilog-basic-complete-expr-re + (eval-when-compile + (verilog-regexp-words verilog-basic-complete-words-expr))) + +(defconst verilog-basic-complete-expr-no-assign-re + (eval-when-compile + (verilog-regexp-words verilog-basic-complete-words-expr-no-assign))) + + +(defconst verilog-complete-re (concat verilog-extended-complete-re "\\|\\(" verilog-basic-complete-re "\\)")) @@ -3114,9 +3207,6 @@ find the errors." )) "List of Verilog keywords.") -(defconst verilog-comment-start-regexp "//\\|/\\*" - "Dual comment value for `comment-start-regexp'.") - (defvar verilog-mode-syntax-table (let ((table (make-syntax-table))) ;; Populate the syntax TABLE. @@ -3338,12 +3428,12 @@ See also `verilog-font-lock-extra-types'.") (list "\\<\\(\\(macro\\|connect\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)" '(1 font-lock-keyword-face) - '(3 font-lock-function-name-face prepend)) + '(3 font-lock-function-name-face)) ;; Fontify function definitions (list (concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" ) '(1 font-lock-keyword-face) - '(3 font-lock-constant-face prepend)) + '(3 font-lock-constant-face)) '("\\<function\\>\\s-+\\(\\[[^]]+\\]\\)\\s-+\\(\\sw+\\)" (1 font-lock-keyword-face) (2 font-lock-constant-face append)) @@ -3358,12 +3448,12 @@ See also `verilog-font-lock-extra-types'.") ;; Pre-form for this anchored matcher: ;; First, avoid declaration keywords written in comments, ;; which can also trigger this anchor. - '(if (not (verilog-in-comment-p)) + '(if (and (not (verilog-in-comment-p)) + (not (member (thing-at-point 'symbol) verilog-keywords))) (verilog-single-declaration-end verilog-highlight-max-lookahead) (point)) ;; => current declaration statement is of 0 length nil ;; Post-form: nothing to be done - '(0 font-lock-variable-name-face t t))) - ))) + '(0 font-lock-variable-name-face)))))) (setq verilog-font-lock-keywords-2 @@ -3617,7 +3707,7 @@ inserted using a single call to `verilog-insert'." (defun verilog-single-declaration-end (limit) "Return pos where current (single) declaration statement ends. Also, this function moves POINT forward to the start of a variable name -(skipping the range-part and whitespace). +\(skipping the range-part and whitespace). Function expected to be called with POINT just after a declaration keyword. LIMIT sets the max POINT for searching and moving to. No such limit if LIMIT is 0. @@ -3629,8 +3719,6 @@ Meaning of *single* declaration: and `output [1:0] y' is the other single declaration. In the 1st single declaration, POINT is moved to start of `clk'. And in the 2nd declaration, POINT is moved to `y'." - - (let (maxpoint old-point) ;; maxpoint = min(curr-point + limit, buffer-size) (setq maxpoint (if (eq limit 0) @@ -3651,7 +3739,7 @@ POINT is moved to `y'." (not (eq old-point (point))) (not (eq (char-after) ?\; )) (not (eq (char-after) ?\) )) - (not (looking-at verilog-declaration-re))) + (not (looking-at (verilog-get-declaration-re)))) (setq old-point (point)) (ignore-errors (forward-sexp) @@ -3669,31 +3757,28 @@ This function moves POINT to the next variable within the same declaration (if it exists). LIMIT is expected to be the pos at which current single-declaration ends, obtained using `verilog-single-declaration-end'." - - (let (found-var old-point) - - ;; Remove starting whitespace - (verilog-forward-ws&directives limit) - - (when (< (point) limit) ;; no matching if this is violated - - ;; Find the variable name (match-data is set here) - (setq found-var (re-search-forward verilog-symbol-re limit t)) - - ;; Walk to this variable's delimiter - (save-match-data - (verilog-forward-ws&directives limit) - (setq old-point nil) - (while (and (< (point) limit) - (not (member (char-after) '(?, ?\) ?\;))) - (not (eq old-point (point)))) - (setq old-point (point)) + (when (and verilog-fontify-variables + (not (member (thing-at-point 'symbol) verilog-keywords))) + (let (found-var old-point) + ;; Remove starting whitespace + (verilog-forward-ws&directives limit) + (when (< (point) limit) ;; no matching if this is violated + ;; Find the variable name (match-data is set here) + (setq found-var (re-search-forward verilog-identifier-sym-re limit t)) + ;; Walk to this variable's delimiter + (save-match-data (verilog-forward-ws&directives limit) - (forward-sexp) - (verilog-forward-ws&directives limit)) - ;; Only a comma or semicolon expected at this point - (skip-syntax-forward ".")) - found-var))) + (setq old-point nil) + (while (and (< (point) limit) + (not (member (char-after) '(?, ?\) ?\] ?\} ?\;))) + (not (eq old-point (point)))) + (setq old-point (point)) + (verilog-forward-ws&directives limit) + (forward-sexp) + (verilog-forward-ws&directives limit)) + ;; Only a comma or semicolon expected at this point + (skip-syntax-forward ".")) + found-var)))) (defun verilog-point-text (&optional pointnum) "Return text describing where POINTNUM or current point is (for errors). @@ -3728,9 +3813,14 @@ Use filename, if current buffer being edited shorten to just buffer name." (elsec 1) (found nil) (st (point))) - (if (not (looking-at "\\<")) - (forward-word-strictly -1)) + (unless (looking-at "\\<") + (forward-word-strictly -1)) (cond + ((save-excursion + (goto-char st) + (member (preceding-char) '(?\) ?\} ?\]))) + (goto-char st) + (backward-sexp 1)) ((verilog-skip-backward-comment-or-string)) ((looking-at "\\<else\\>") (setq reg (concat @@ -3754,7 +3844,17 @@ Use filename, if current buffer being edited shorten to just buffer name." (setq found 't)))))) ((looking-at verilog-end-block-re) (verilog-leap-to-head)) - ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)\\|\\(\\<endconnectmodule\\>\\)") + (;; Fallback, when current word does not match `verilog-end-block-re' + (looking-at (concat + "\\(\\<endmodule\\>\\)\\|" ; 1 + "\\(\\<endprimitive\\>\\)\\|" ; 2 + "\\(\\<endclass\\>\\)\\|" ; 3 + "\\(\\<endprogram\\>\\)\\|" ; 4 + "\\(\\<endinterface\\>\\)\\|" ; 5 + "\\(\\<endpackage\\>\\)\\|" ; 6 + "\\(\\<endconnectmodule\\>\\)\\|" ; 7 + "\\(\\<endchecker\\>\\)\\|" ; 8 + "\\(\\<endconfig\\>\\)")) ; 9 (cond ((match-end 1) (verilog-re-search-backward "\\<\\(macro\\)?module\\>" nil 'move)) @@ -3769,7 +3869,11 @@ Use filename, if current buffer being edited shorten to just buffer name." ((match-end 6) (verilog-re-search-backward "\\<package\\>" nil 'move)) ((match-end 7) - (verilog-re-search-backward "\\<connectmodule\\>" nil 'move)) + (verilog-re-search-backward "\\<connectmodule\\>" nil 'move)) + ((match-end 8) + (verilog-re-search-backward "\\<checker\\>" nil 'move)) + ((match-end 9) + (verilog-re-search-backward "\\<config\\>" nil 'move)) (t (goto-char st) (backward-sexp 1)))) @@ -3782,9 +3886,14 @@ Use filename, if current buffer being edited shorten to just buffer name." (md 2) (st (point)) (nest 'yes)) - (if (not (looking-at "\\<")) - (forward-word-strictly -1)) + (unless (looking-at "\\<") + (forward-word-strictly -1)) (cond + ((save-excursion + (goto-char st) + (member (following-char) '(?\( ?\{ ?\[))) + (goto-char st) + (forward-sexp 1)) ((verilog-skip-forward-comment-or-string) (verilog-forward-syntactic-ws)) ((looking-at verilog-beg-block-re-ordered) @@ -3843,22 +3952,31 @@ Use filename, if current buffer being edited shorten to just buffer name." ;; Search forward for matching endtask (setq reg "\\<endtask\\>" ) (setq nest 'no)) - ((match-end 12) + ((match-end 13) ;; Search forward for matching endgenerate (setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" )) - ((match-end 13) + ((match-end 14) ;; Search forward for matching endgroup (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" )) - ((match-end 14) + ((match-end 15) ;; Search forward for matching endproperty (setq reg "\\(\\<property\\>\\)\\|\\(\\<endproperty\\>\\)" )) - ((match-end 15) + ((match-end 16) ;; Search forward for matching endsequence (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" ) (setq md 3)) ; 3 to get to endsequence in the reg above ((match-end 17) ;; Search forward for matching endclocking - (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" ))) + (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" )) + ((match-end 20) + ;; Search forward for matching `ifn?def, can be `else `elseif or `endif + (setq reg "\\(\\<`ifn?def\\>\\)\\|\\(\\<`endif\\>\\|\\<`else\\>\\|\\<`elsif\\>\\)" )) + ((match-end 21) + ;; Search forward for matching `else, can be `endif + (setq reg "\\(\\<`else\\>\\|\\<`ifn?def\\>\\)\\|\\(\\<`endif\\>\\)" )) + ((match-end 22) + ;; Search forward for matching `elsif, can be `else or `endif, DONT support `elsif + (setq reg "\\(\\<`elsif\\>\\|\\<`ifn?def\\>\\)\\|\\(\\<`endif\\>\\|\\<`else\\>\\)" ))) (if (and reg (forward-word-strictly 1)) (catch 'skip @@ -3867,15 +3985,26 @@ Use filename, if current buffer being edited shorten to just buffer name." here) (while (verilog-re-search-forward reg nil 'move) (cond - ((match-end md) ; a closer in regular expression, so we are climbing out + ((and (or (match-end md) + (and (member (match-string-no-properties 1) '("`else" "`elsif")) + (= 1 depth))) + (or (and (member (match-string-no-properties 2) '("`else" "`elsif")) + (= 1 depth)) + ;; stop at `else/`elsif which matching ifn?def (or `elsif with same depth) + ;; a closer in regular expression, so we are climbing out + (not (member (match-string-no-properties 2) '("`else" "`elsif"))))) (setq depth (1- depth)) (if (= 0 depth) ; we are out! (throw 'skip 1))) - ((match-end 1) ; an opener in the r-e, so we are in deeper now + ((and (match-end 1) ; an opener in the r-e, so we are in deeper now + (not (member (match-string-no-properties 1) '("`else" "`elsif")))) (setq here (point)) ; remember where we started (goto-char (match-beginning 1)) (cond - ((if (or + ((verilog-looking-back "\\(\\<typedef\\>\\s-+\\)" (point-at-bol)) + ;; avoid nesting for typedef class defs + (forward-word-strictly 1)) + ((if (or (looking-at verilog-disable-fork-re) (and (looking-at "fork") (progn @@ -3890,28 +4019,37 @@ Use filename, if current buffer being edited shorten to just buffer name." (throw 'skip 1)))))) ((looking-at (concat - "\\(\\<\\(macro\\)?module\\>\\)\\|" - "\\(\\<primitive\\>\\)\\|" - "\\(\\<class\\>\\)\\|" - "\\(\\<program\\>\\)\\|" - "\\(\\<interface\\>\\)\\|" - "\\(\\<package\\>\\)\\|" - "\\(\\<connectmodule\\>\\)")) + "\\(\\<\\(macro\\)?module\\>\\)\\|" ; 1,2 + "\\(\\<primitive\\>\\)\\|" ; 3 + "\\(\\(\\(interface\\|virtual\\)\\s-+\\)?\\<class\\>\\)\\|" ; 4,5,6 + "\\(\\<program\\>\\)\\|" ; 7 + "\\(\\<interface\\>\\)\\|" ; 8 + "\\(\\<package\\>\\)\\|" ; 9 + "\\(\\<connectmodule\\>\\)\\|" ; 10 + "\\(\\<generate\\>\\)\\|" ; 11 + "\\(\\<checker\\>\\)\\|" ; 12 + "\\(\\<config\\>\\)")) ; 13 (cond ((match-end 1) (verilog-re-search-forward "\\<endmodule\\>" nil 'move)) - ((match-end 2) - (verilog-re-search-forward "\\<endprimitive\\>" nil 'move)) ((match-end 3) - (verilog-re-search-forward "\\<endclass\\>" nil 'move)) + (verilog-re-search-forward "\\<endprimitive\\>" nil 'move)) ((match-end 4) + (verilog-re-search-forward "\\<endclass\\>" nil 'move)) + ((match-end 7) (verilog-re-search-forward "\\<endprogram\\>" nil 'move)) - ((match-end 5) + ((match-end 8) (verilog-re-search-forward "\\<endinterface\\>" nil 'move)) - ((match-end 6) + ((match-end 9) (verilog-re-search-forward "\\<endpackage\\>" nil 'move)) - ((match-end 7) - (verilog-re-search-forward "\\<endconnectmodule\\>" nil 'move)) + ((match-end 10) + (verilog-re-search-forward "\\<endconnectmodule\\>" nil 'move)) + ((match-end 11) + (verilog-re-search-forward "\\<endgenerate\\>" nil 'move)) + ((match-end 12) + (verilog-re-search-forward "\\<endchecker\\>" nil 'move)) + ((match-end 13) + (verilog-re-search-forward "\\<endconfig\\>" nil 'move)) (t (goto-char st) (if (= (following-char) ?\) ) @@ -3924,11 +4062,69 @@ Use filename, if current buffer being edited shorten to just buffer name." (forward-sexp 1)))))) (defun verilog-declaration-beg () - (verilog-re-search-backward verilog-declaration-re (bobp) t)) - -;; -;; -;; Mode + (verilog-re-search-backward (verilog-get-declaration-re) (bobp) t)) + +(defun verilog-align-typedef-enabled-p () + "Return non-nil if alignment of user typedefs is enabled. +This will be automatically set when either `verilog-align-typedef-regexp' +or `verilog-align-typedef-words' are non-nil." + (when (or verilog-align-typedef-regexp + verilog-align-typedef-words) + t)) + +(defun verilog-get-declaration-typedef-re () + "Return regexp of a user defined typedef. +See `verilog-align-typedef-regexp' and `verilog-align-typedef-words'." + (let (typedef-re words words-re re) + (when (verilog-align-typedef-enabled-p) + (setq typedef-re verilog-align-typedef-regexp) + (setq words verilog-align-typedef-words) + (setq words-re (verilog-regexp-words verilog-align-typedef-words)) + (cond ((and typedef-re (not words)) + (setq re typedef-re)) + ((and (not typedef-re) words) + (setq re words-re)) + ((and typedef-re words) + (setq re (concat verilog-align-typedef-regexp "\\|" words-re)))) + (concat "\\s-*" "\\(" verilog-declaration-prefix-re "\\s-*\\(" verilog-range-re "\\)?" "\\s-*\\)?" + (concat "\\(" re "\\)") + "\\(\\s-*" verilog-range-re "\\)?\\s-+")))) + +(defun verilog-get-declaration-re (&optional type) + "Return declaration regexp depending on customizable variables and TYPE." + (let ((re (cond ((equal type 'iface-mp) + verilog-declaration-or-iface-mp-re) + ((equal type 'embedded-comments) + verilog-declaration-embedded-comments-re) + (verilog-indent-declaration-macros + verilog-declaration-re-macro) + (t + verilog-declaration-re)))) + (when (and (verilog-align-typedef-enabled-p) + (or (string= re verilog-declaration-or-iface-mp-re) + (string= re verilog-declaration-re))) + (setq re (concat "\\(" (verilog-get-declaration-typedef-re) "\\)\\|\\(" re "\\)"))) + re)) + +(defun verilog-looking-at-decl-to-align () + "Return non-nil if pointing at a Verilog variable declaration that must be aligned." + (let* ((re (verilog-get-declaration-re)) + (valid-re (looking-at re)) + (id-pos (match-end 0))) + (and valid-re + (not (verilog-at-struct-decl-p)) + (not (verilog-at-enum-decl-p)) + (save-excursion + (goto-char id-pos) + (verilog-forward-syntactic-ws) + (and (not (looking-at ";")) + (not (member (thing-at-point 'symbol) verilog-keywords)) + (progn ; Avoid alignment of instances whose name match user defined types + (forward-word) + (verilog-forward-syntactic-ws) + (not (looking-at "(")))))))) + +;;; Mode: ;; (defvar verilog-which-tool 1) ;;;###autoload @@ -3965,6 +4161,11 @@ Variables controlling indentation/edit style: function keyword. `verilog-indent-level-directive' (default 1) Indentation of \\=`ifdef/\\=`endif blocks. + `verilog-indent-ignore-multiline-defines' (default t) + Non-nil means ignore indentation on lines that are part of a multiline + define. + `verilog-indent-ignore-regexp' (default nil + Regexp that matches lines that should be ignored for indentation. `verilog-cexp-indent' (default 1) Indentation of Verilog statements broken across lines i.e.: if (a) @@ -3988,6 +4189,9 @@ Variables controlling indentation/edit style: otherwise you get: if (a) begin + `verilog-indent-class-inside-pkg' (default t) + Non-nil means indent classes inside packages. + Otherwise, classes have zero indentation. `verilog-auto-endcomments' (default t) Non-nil means a comment /* ... */ is set after the ends which ends cases, tasks, functions and modules. @@ -3997,6 +4201,17 @@ Variables controlling indentation/edit style: will be inserted. Setting this variable to zero results in every end acquiring a comment; the default avoids too many redundant comments in tight quarters. + `verilog-align-decl-expr-comments' (default t) + Non-nil means align declaration and expressions comments. + `verilog-align-comment-distance' (default 1) + Distance (in spaces) between longest declaration and comments. + Only works if `verilog-align-decl-expr-comments' is non-nil. + `verilog-align-assign-expr' (default nil) + Non-nil means align expressions of continuous assignments. + `verilog-align-typedef-regexp' (default nil) + Regexp that matches user typedefs for declaration alignment. + `verilog-align-typedef-words' (default nil) + List of words that match user typedefs for declaration alignment. `verilog-auto-lineup' (default `declarations') List of contexts where auto lineup of code should be done. @@ -4020,17 +4235,20 @@ Some other functions are: \\[verilog-mark-defun] Mark function. \\[verilog-beg-of-defun] Move to beginning of current function. \\[verilog-end-of-defun] Move to end of current function. - \\[verilog-label-be] Label matching begin ... end, fork ... join, etc statements. + \\[verilog-label-be] Label matching begin ... end, fork ... join, etc + statements. \\[verilog-comment-region] Put marked area in a comment. - \\[verilog-uncomment-region] Uncomment an area commented with \\[verilog-comment-region]. + \\[verilog-uncomment-region] Uncomment an area commented with + \\[verilog-comment-region]. \\[verilog-insert-block] Insert begin ... end. \\[verilog-star-comment] Insert /* ... */. \\[verilog-sk-always] Insert an always @(AS) begin .. end block. \\[verilog-sk-begin] Insert a begin .. end block. \\[verilog-sk-case] Insert a case block, prompting for details. - \\[verilog-sk-for] Insert a for (...) begin .. end block, prompting for details. + \\[verilog-sk-for] Insert a for (...) begin .. end block, prompting for + details. \\[verilog-sk-generate] Insert a generate .. endgenerate block. \\[verilog-sk-header] Insert a header block at the top of file. \\[verilog-sk-initial] Insert an initial begin .. end block. @@ -4053,14 +4271,17 @@ Some other functions are: \\[verilog-sk-else-if] Insert an else if (..) begin .. end block. \\[verilog-sk-comment] Insert a comment block. \\[verilog-sk-assign] Insert an assign .. = ..; statement. - \\[verilog-sk-function] Insert a function .. begin .. end endfunction block. + \\[verilog-sk-function] Insert a function .. begin .. end endfunction + block. \\[verilog-sk-input] Insert an input declaration, prompting for details. \\[verilog-sk-output] Insert an output declaration, prompting for details. - \\[verilog-sk-state-machine] Insert a state machine definition, prompting for details. + \\[verilog-sk-state-machine] Insert a state machine definition, prompting + for details. \\[verilog-sk-inout] Insert an inout declaration, prompting for details. \\[verilog-sk-wire] Insert a wire declaration, prompting for details. \\[verilog-sk-reg] Insert a register declaration, prompting for details. - \\[verilog-sk-define-signal] Define signal under point as a register at the top of the module. + \\[verilog-sk-define-signal] Define signal under point as a register at + the top of the module. All key bindings can be seen in a Verilog-buffer with \\[describe-bindings]. Key bindings specific to `verilog-mode-map' are: @@ -4147,7 +4368,7 @@ Key bindings specific to `verilog-mode-map' are: ;; verilog-mode-hook call added by define-derived-mode ) -;;; Integration with the speedbar +;;; Integration with the speedbar: ;; ;; Avoid problems with XEmacs byte-compiles. @@ -4427,15 +4648,24 @@ following code fragment: "Mark the current Verilog function (or procedure). This puts the mark at the end, and point at the beginning." (interactive) - (if (featurep 'xemacs) - (progn - (push-mark) - (verilog-end-of-defun) - (push-mark) - (verilog-beg-of-defun) - (if (fboundp 'zmacs-activate-region) - (zmacs-activate-region))) - (mark-defun))) + (let (found) + (if (featurep 'xemacs) + (progn + (push-mark) + (verilog-end-of-defun) + (push-mark) + (verilog-beg-of-defun) + (if (fboundp 'zmacs-activate-region) + (zmacs-activate-region))) + ;; GNU Emacs + (when (verilog-beg-of-defun) + (setq found (point)) + (verilog-end-of-defun) + (end-of-line) + (push-mark) + (goto-char found) + (beginning-of-line) + (setq mark-active t))))) (defun verilog-comment-region (start end) ;; checkdoc-params: (start end) @@ -4514,7 +4744,21 @@ area. See also `verilog-comment-region'." (defun verilog-beg-of-defun () "Move backward to the beginning of the current function or procedure." (interactive) - (verilog-re-search-backward verilog-defun-re nil 'move)) + (let (found) + (save-excursion + (when (verilog-looking-back verilog-defun-tf-re-end (point-at-bol)) + (verilog-backward-sexp) + (setq found (point))) + (while (and (not found) + (verilog-re-search-backward verilog-defun-tf-re-all nil t)) + (cond ((verilog-looking-back "\\(\\<typedef\\>\\s-+\\)" (point-at-bol)) ; corner case, e.g. 'typedef class <id>;' + (backward-word)) + ((looking-at verilog-defun-tf-re-end) + (verilog-backward-sexp)) + ((looking-at verilog-defun-tf-re-beg) + (setq found (point)))))) + (when found + (goto-char found)))) (defun verilog-beg-of-defun-quick () "Move backward to the beginning of the current function or procedure. @@ -4525,7 +4769,10 @@ Uses `verilog-scan' cache." (defun verilog-end-of-defun () "Move forward to the end of the current function or procedure." (interactive) - (verilog-re-search-forward verilog-end-defun-re nil 'move)) + (when (or (looking-at verilog-defun-tf-re-beg) + (verilog-beg-of-defun)) + (verilog-forward-sexp) + (point))) (defun verilog-get-end-of-defun () (save-excursion @@ -4542,10 +4789,10 @@ Uses `verilog-scan' cache." (case-fold-search nil) (oldpos (point)) (b (progn - (verilog-beg-of-defun) + (verilog-re-search-backward verilog-defun-re nil 'move) (point-marker))) (e (progn - (verilog-end-of-defun) + (verilog-re-search-forward verilog-end-defun-re nil 'move) (point-marker)))) (goto-char (marker-position b)) (if (> (- e b) 200) @@ -4605,19 +4852,18 @@ Uses `verilog-scan' cache." (goto-char h))) ;; stop if we see an extended complete reg, perhaps a complete one (and - (looking-at verilog-complete-reg) + (looking-at verilog-complete-re) (let* ((p (point))) (while (and (looking-at verilog-extended-complete-re) (progn (setq p (point)) (verilog-backward-token) (/= p (point))))) (goto-char p))) - ;; stop if we see a complete reg (previous found extended ones) - (looking-at verilog-basic-complete-re) ;; stop if previous token is an ender (save-excursion (verilog-backward-token) - (looking-at verilog-end-block-re)))) + (or (looking-at verilog-end-block-re) + (verilog-in-directive-p))))) (verilog-backward-syntactic-ws) (verilog-backward-token)) ;; Now point is where the previous line ended. @@ -4634,28 +4880,23 @@ Uses `verilog-scan' cache." (verilog-backward-syntactic-ws)) (let ((pt (point))) (catch 'done - (while (not (looking-at verilog-complete-reg)) + (while (not (looking-at verilog-complete-re)) (setq pt (point)) (verilog-backward-syntactic-ws) (if (or (bolp) (= (preceding-char) ?\;) + (and (= (preceding-char) ?\{) + (save-excursion + (backward-char) + (verilog-at-struct-p))) (progn (verilog-backward-token) - (looking-at verilog-ends-re))) + (or (looking-at verilog-ends-re) + (looking-at "begin")))) (progn (goto-char pt) (throw 'done t))))) (verilog-forward-syntactic-ws))) -;; -;; (while (and -;; (not (looking-at verilog-complete-reg)) -;; (not (bolp)) -;; (not (= (preceding-char) ?\;))) -;; (verilog-backward-token) -;; (verilog-backward-syntactic-ws) -;; (setq pt (point))) -;; (goto-char pt) -;; ;(verilog-forward-syntactic-ws) (defun verilog-end-of-statement () "Move forward to end of current statement." @@ -4713,7 +4954,7 @@ Uses `verilog-scan' cache." pos))))) (defun verilog-in-case-region-p () - "Return true if in a case region. + "Return non-nil if in a case region. More specifically, point @ in the line foo : @ begin" (interactive) (save-excursion @@ -4758,37 +4999,29 @@ More specifically, point @ in the line foo : @ begin" (forward-sexp arg))) (defun verilog-in-generate-region-p () - "Return true if in a generate region. + "Return non-nil if in a generate region. More specifically, after a generate and before an endgenerate." (interactive) - (let ((nest 1)) - (save-excursion - (catch 'done - (while (and - (/= nest 0) - (verilog-re-search-backward - "\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\>" nil 'move) - (cond - ((match-end 1) ; module - we have crawled out - (throw 'done 1)) - ((match-end 2) ; connectmodule - we have crawled out - (throw 'done 1)) - ((match-end 3) ; generate - (setq nest (1- nest))) - ((match-end 4) ; endgenerate - (setq nest (1+ nest))) - ((match-end 5) ; if - (setq nest (1- nest))) - ((match-end 6) ; case - (setq nest (1- nest))) - ((match-end 7) ; for - (setq nest (1- nest)))))))) - (= nest 0) )) ; return nest + (let ((pos (point)) + gen-beg-point gen-end-point) + (save-match-data + (save-excursion + (and (verilog-re-search-backward "\\<\\(generate\\)\\>" nil t) + (forward-word) + (setq gen-beg-point (point)) + (verilog-forward-sexp) + (backward-word) + (setq gen-end-point (point))))) + (if (and gen-beg-point gen-end-point + (>= pos gen-beg-point) + (<= pos gen-end-point)) + t + nil))) (defun verilog-in-fork-region-p () - "Return true if between a fork and join." + "Return non-nil if between a fork and join." (interactive) - (let ((lim (save-excursion (verilog-beg-of-defun) (point))) + (let ((lim (save-excursion (verilog-re-search-backward verilog-defun-re nil 'move) (point))) (nest 1)) (save-excursion (while (and @@ -4802,7 +5035,7 @@ More specifically, after a generate and before an endgenerate." (= nest 0) )) ; return nest (defun verilog-in-deferred-immediate-final-p () - "Return true if inside an `assert/assume/cover final' statement." + "Return non-nil if inside an `assert/assume/cover final' statement." (interactive) (and (looking-at "final") (verilog-looking-back "\\<\\(?:assert\\|assume\\|cover\\)\\>\\s-+" nil)) @@ -5013,7 +5246,7 @@ primitive or interface named NAME." (insert str) (ding 't)) (let ((lim - (save-excursion (verilog-beg-of-defun) (point))) + (save-excursion (verilog-re-search-backward verilog-defun-re nil 'move) (point))) (here (point))) (cond (;-- handle named block differently @@ -5461,7 +5694,7 @@ For example: becomes: // surefire lint_line_off UDDONX" (interactive) - (let ((buff (if (boundp 'next-error-last-buffer) ;Added to Emacs-22.1 + (let ((buff (if (boundp 'next-error-last-buffer) ; Added to Emacs-22.1 next-error-last-buffer (verilog--suppressed-warnings ((obsolete compilation-last-buffer)) @@ -5585,13 +5818,14 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'." (defun verilog-warn-error (string &rest args) "Call `error' using STRING and optional ARGS. If `verilog-warn-fatal' is non-nil, call `verilog-warn' instead." - (apply (if verilog-warn-fatal #'error #'verilog-warn) + (apply (if (and verilog-warn-fatal verilog-warn-fatal-internal) + #'error #'verilog-warn) string args)) (defmacro verilog-batch-error-wrapper (&rest body) "Execute BODY and add error prefix to any errors found. This lets programs calling batch mode to easily extract error messages." - `(let ((verilog-warn-fatal nil)) + `(let ((verilog-warn-fatal-internal nil)) (condition-case err (progn ,@body) (error @@ -5721,7 +5955,7 @@ This sets up the appropriate Verilog mode environment, calls (string . 0))) (defun verilog-continued-line-1 (lim) - "Return true if this is a continued line. + "Return non-nil if this is a continued line. Set point to where line starts. Limit search to point LIM." (let ((continued 't)) (if (eq 0 (forward-line -1)) @@ -5774,7 +6008,6 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." ;; if we are in a parenthesized list, and the user likes to indent these, return. ;; unless we are in the newfangled coverpoint or constraint blocks (if (and - verilog-indent-lists (verilog-in-paren) (not (verilog-in-coverage-p)) ) @@ -5791,7 +6024,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (looking-at verilog-in-constraint-re) )) ; may still get hosed if concat in constraint (let ((sp (point))) (if (and - (not (looking-at verilog-complete-reg)) + (not (looking-at verilog-complete-re)) (verilog-continued-line-1 lim)) (progn (goto-char sp) (throw 'nesting 'cexp)) @@ -5996,6 +6229,12 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (goto-char here) ; or is clocking, starts a new block (throw 'nesting 'block))))) + ;; if find `ifn?def `else `elsif + ((or (match-end 20) + (match-end 21) + (match-end 22)) + (throw 'continue 'foo)) + ((looking-at "\\<class\\|struct\\|function\\|task\\>") ;; *sigh* These words have an optional prefix: ;; extern {virtual|protected}? function a(); @@ -6025,7 +6264,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." ;; {assert|assume|cover} property (); are complete ;; and could also be labeled: - foo: assert property ;; but - ;; property ID () ... needs end_property + ;; property ID () ... needs endproperty (verilog-beg-of-statement) (if (looking-at verilog-property-re) (throw 'continue 'statement) ; We don't need an endproperty for these @@ -6110,6 +6349,23 @@ of the appropriate enclosing block." (ding 't) (setq nest 0)))))) +(defun verilog-leap-to-class-head () + (let ((nest 1) + (class-re (concat "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)"))) + (catch 'skip + (while (verilog-re-search-backward class-re nil 'move) + (cond + ((match-end 1) ; begin + (when (verilog-looking-back "\\(\\<interface\\>\\s-+\\)\\|\\(\\<virtual\\>\\s-+\\)" (point-at-bol)) + (goto-char (match-beginning 0))) + (unless (verilog-looking-back "\\<typedef\\>\\s-+" (point-at-bol)) + (setq nest (1- nest)) + (if (= 0 nest) + ;; Now previous line describes syntax + (throw 'skip 1)))) + ((match-end 2) ; end + (setq nest (1+ nest)))))))) + (defun verilog-leap-to-head () "Move point to the head of this block. Jump from end to matching begin, from endcase to matching case, and so on." @@ -6137,7 +6393,9 @@ Jump from end to matching begin, from endcase to matching case, and so on." (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )) ((looking-at "\\<endclass\\>") ;; 5: Search back for matching class - (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" )) + (catch 'nesting + (verilog-leap-to-class-head) + (setq reg nil))) ((looking-at "\\<endtable\\>") ;; 6: Search back for matching table (setq reg "\\(\\<table\\>\\)\\|\\(\\<endtable\\>\\)" )) @@ -6175,7 +6433,19 @@ Jump from end to matching begin, from endcase to matching case, and so on." (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" )) ((looking-at "\\<endclocking\\>") ;; 12: Search back for matching clocking - (setq reg "\\(\\<clocking\\)\\|\\(\\<endclocking\\>\\)" ))) + (setq reg "\\(\\<clocking\\)\\|\\(\\<endclocking\\>\\)" )) + ;; Search back for matching package + ((looking-at "\\<endpackage\\>") + (setq reg "\\(\\<package\\>\\)" )) + ;; Search back for matching program + ((looking-at "\\<endprogram\\>") + (setq reg "\\(\\<program\\>\\)" )) + ((looking-at "\\<`endif\\>") + ;; Search back for matching `endif `else `elsif + (setq reg "\\(\\<`ifn?def\\>\\)\\|\\(\\<`endif\\>\\)" )) + ((looking-at "\\<`else\\>") + ;; Search back for matching `else `else `elsif + (setq reg "\\(\\<`ifn?def\\>\\|\\<`elsif\\>\\)\\|\\(\\<`else\\>\\)" ))) (if reg (catch 'skip (if (eq nesting 'yes) @@ -6221,7 +6491,7 @@ Jump from end to matching begin, from endcase to matching case, and so on." (throw 'skip 1))))))) (defun verilog-continued-line () - "Return true if this is a continued line. + "Return non-nil if this is a continued line. Set point to where line starts." (let ((continued 't)) (if (eq 0 (forward-line -1)) @@ -6394,10 +6664,10 @@ Optional BOUND limits search." (let ((state (save-excursion (verilog-syntax-ppss)))) (cond ((nth 7 state) ; in // comment - (verilog-re-search-backward "//" nil 'move) + (re-search-backward "//" nil 'move) (skip-chars-backward "/")) ((nth 4 state) ; in /* */ comment - (verilog-re-search-backward "/\\*" nil 'move)))) + (re-search-backward "/\\*" nil 'move)))) (narrow-to-region bound (point)) (while (/= here (point)) (setq here (point)) @@ -6450,13 +6720,60 @@ Optional BOUND limits search." (if jump (beginning-of-line 2)))))))) +(defun verilog-pos-at-beg-of-statement () + "Return point position at the beginning of current statement." + (save-excursion + (verilog-beg-of-statement) + (point))) + +(defun verilog-col-at-beg-of-statement () + "Return current column at the beginning of current statement." + (save-excursion + (verilog-beg-of-statement) + (current-column))) + +(defun verilog-pos-at-end-of-statement () + "Return point position at the end of current statement." + (save-excursion + (verilog-end-of-statement))) + +(defun verilog-col-at-end-of-statement () + "Return current column at the end of current statement." + (save-excursion + (verilog-end-of-statement) + (current-column))) + +(defun verilog-pos-at-forward-syntactic-ws () + "Return point position at next non whitespace/comment token." + (save-excursion + (verilog-forward-syntactic-ws) + (point))) + +(defun verilog-col-at-forward-syntactic-ws () + "Return current column at next non whitespace/comment token." + (save-excursion + (verilog-forward-syntactic-ws) + (current-column))) + +(defun verilog-pos-at-backward-syntactic-ws () + "Return point position at previous non whitespace/comment token." + (save-excursion + (verilog-backward-syntactic-ws) + (point))) + +(defun verilog-col-at-backward-syntactic-ws () + "Return current column at previous non whitespace/comment token." + (save-excursion + (verilog-backward-syntactic-ws) + (current-column))) + (defun verilog-in-comment-p () - "Return true if in a star or // comment." + "Return non-nil if in a star or // comment." (let ((state (save-excursion (verilog-syntax-ppss)))) (or (nth 4 state) (nth 7 state)))) (defun verilog-in-star-comment-p () - "Return true if in a star comment." + "Return non-nil if in a star comment." (let ((state (save-excursion (verilog-syntax-ppss)))) (and (nth 4 state) ; t if in a comment of style a // or b /**/ @@ -6465,40 +6782,39 @@ Optional BOUND limits search." )))) (defun verilog-in-slash-comment-p () - "Return true if in a slash comment." + "Return non-nil if in a slash comment." (let ((state (save-excursion (verilog-syntax-ppss)))) (nth 7 state))) (defun verilog-in-comment-or-string-p () - "Return true if in a string or comment." + "Return non-nil if in a string or comment." (let ((state (save-excursion (verilog-syntax-ppss)))) (or (nth 3 state) (nth 4 state) (nth 7 state)))) ; Inside string or comment) (defun verilog-in-attribute-p () - "Return true if point is in an attribute (* [] attribute *)." - (save-match-data - (save-excursion - (verilog-re-search-backward "\\((\\*\\)\\|\\(\\*)\\)" nil 'move) - (cond - ((match-end 1) - (progn (goto-char (match-end 1)) - (not (looking-at "\\s-*)"))) - nil) - ((match-end 2) - (progn (goto-char (match-beginning 2)) - (not (looking-at "(\\s-*"))) - nil) - (t nil))))) + "Return non-nil if point is in an attribute (* [] attribute *)." + (let ((pos (point))) + (save-match-data + (save-excursion + (and (verilog-re-search-backward "(\\*" nil 'move) + (progn (forward-sexp) + (skip-chars-backward "*)")) + (< pos (point))))))) (defun verilog-in-parameter-p () - "Return true if point is in a parameter assignment #( p1=1, p2=5)." + "Return non-nil if point is in a parameter assignment #( p1=1, p2=5)." (save-match-data (save-excursion - (verilog-re-search-backward "\\(#(\\)\\|\\()\\)" nil 'move) - (numberp (match-beginning 1))))) + (and (progn + (verilog-backward-up-list 1) + (verilog-backward-syntactic-ws) + (= (preceding-char) ?\#)) + (progn + (verilog-beg-of-statement-1) + (looking-at verilog-defun-re)))))) (defun verilog-in-escaped-name-p () - "Return true if in an escaped name." + "Return non-nil if in an escaped name." (save-excursion (backward-char) (skip-chars-backward "^ \t\n\f") @@ -6507,20 +6823,20 @@ Optional BOUND limits search." nil))) (defun verilog-in-directive-p () - "Return true if in a directive." + "Return non-nil if in a directive." (save-excursion (beginning-of-line) (looking-at verilog-directive-re-1))) (defun verilog-in-parenthesis-p () - "Return true if in a ( ) expression (but not { } or [ ])." + "Return non-nil if in a ( ) expression (but not { } or [ ])." (save-match-data (save-excursion (verilog-re-search-backward "\\((\\)\\|\\()\\)" nil 'move) (numberp (match-beginning 1))))) (defun verilog-in-paren () - "Return true if in a parenthetical expression. + "Return non-nil if in a parenthetical expression. May cache result using `verilog-syntax-ppss'." (let ((state (save-excursion (verilog-syntax-ppss)))) (> (nth 0 state) 0 ))) @@ -6534,7 +6850,7 @@ May cache result using `verilog-syntax-ppss'." 0 ))) (defun verilog-in-paren-quick () - "Return true if in a parenthetical expression. + "Return non-nil if in a parenthetical expression. Always starts from `point-min', to allow inserts with hooks disabled." ;; The -quick refers to its use alongside the other -quick functions, ;; not that it's likely to be faster than verilog-in-paren. @@ -6542,7 +6858,7 @@ Always starts from `point-min', to allow inserts with hooks disabled." (> (nth 0 state) 0 ))) (defun verilog-in-struct-p () - "Return true if in a struct declaration." + "Return non-nil if in a struct declaration." (interactive) (save-excursion (if (verilog-in-paren) @@ -6568,7 +6884,7 @@ Return >0 for nested struct." nil)))) (defun verilog-in-coverage-p () - "Return true if in a constraint or coverpoint expression." + "Return non-nil if in a constraint or coverpoint expression." (interactive) (save-excursion (if (verilog-in-paren) @@ -6608,7 +6924,7 @@ Also move point to constraint." (equal (char-before) ?\;) (equal (char-before) ?\})) ;; skip what looks like bus repetition operator {#{ - (not (string-match "^{\\s-*[()0-9a-zA-Z_\\]*\\s-*{" + (not (string-match "^{\\s-*[][()0-9a-zA-Z_,:\\]*\\s-*{" (buffer-substring p (point))))))))) (progn (let ( (pt (point)) (pass 0)) @@ -6625,7 +6941,7 @@ Also move point to constraint." )) ;; if first word token not keyword, it maybe the instance name ;; check next word token - (if (looking-at "\\<\\w+\\>\\|\\s-*(\\s-*\\S-+") + (if (looking-at "\\<\\w+\\>\\|\\s-*[[(}]\\s-*\\S-+") (progn (verilog-beg-of-statement) (if (and (not (string-match verilog-named-block-re (buffer-substring pt (point)))) ;; Abort if 'begin' keyword is found @@ -6674,13 +6990,39 @@ Also move point to constraint." (verilog-in-struct-p) (looking-at "}\\(?:\\s-*\\w+\\s-*\\(?:,\\s-*\\w+\\s-*\\)*\\)?;"))) +(defun verilog-at-struct-decl-p () + "Return non-nil if at a struct declaration." + (interactive) + (save-excursion + (verilog-re-search-forward "{" (point-at-eol) t) + (unless (bobp) + (backward-char)) + (verilog-at-struct-p))) + +(defun verilog-at-enum-p () + "If at the { of a enum, return true, not moving point." + (save-excursion + (when (equal (char-after) ?\{) + (verilog-beg-of-statement) + (beginning-of-line) + (when (verilog-re-search-forward verilog-typedef-enum-re (verilog-pos-at-end-of-statement) t) + t)))) + +(defun verilog-at-enum-decl-p () + "Return non-nil if at a enum declaration." + (interactive) + (save-excursion + (verilog-re-search-forward "{" (verilog-pos-at-end-of-statement) t) + (unless (bobp) + (backward-char)) + (verilog-at-enum-p))) + (defun verilog-parenthesis-depth () "Return non zero if in parenthetical-expression." (save-excursion (nth 1 (verilog-syntax-ppss)))) - (defun verilog-skip-forward-comment-or-string () - "Return true if in a string or comment." + "Return non-nil if in a string or comment." (let ((state (save-excursion (verilog-syntax-ppss)))) (cond ((nth 3 state) ;Inside string @@ -6695,7 +7037,7 @@ Also move point to constraint." nil)))) (defun verilog-skip-backward-comment-or-string () - "Return true if in a string or comment." + "Return non-nil if in a string or comment." (let ((state (save-excursion (verilog-syntax-ppss)))) (cond ((nth 3 state) ;Inside string @@ -6712,7 +7054,7 @@ Also move point to constraint." nil)))) (defun verilog-skip-backward-comments () - "Return true if a comment was skipped." + "Return non-nil if a comment was skipped." (let ((more t)) (while more (setq more @@ -6831,6 +7173,9 @@ Only look at a few lines to determine indent level." (let ((type (car indent-str)) (ind (car (cdr indent-str)))) (cond + (; handle indentation ignoring + (verilog-indent-ignore-p) + nil) (; handle continued exp (eq type 'cexp) (let ((here (point))) @@ -6840,14 +7185,14 @@ Only look at a few lines to determine indent level." (= (preceding-char) ?\,) (save-excursion (verilog-beg-of-statement-1) - (looking-at verilog-declaration-re))) + (verilog-looking-at-decl-to-align))) (let* ( fst (val (save-excursion (backward-char 1) (verilog-beg-of-statement-1) (setq fst (point)) - (if (looking-at verilog-declaration-re) + (if (looking-at (verilog-get-declaration-re)) (progn ; we have multiple words (goto-char (match-end 0)) (skip-chars-forward " \t") @@ -6869,9 +7214,9 @@ Only look at a few lines to determine indent level." (+ (current-column) verilog-cexp-indent)))))) (goto-char here) (indent-line-to val) - (if (and (not verilog-indent-lists) - (verilog-in-paren)) - (verilog-pretty-declarations-auto)) + (when (and (not verilog-indent-lists) + (verilog-in-paren)) + (verilog-pretty-declarations-auto)) )) ((= (preceding-char) ?\) ) (goto-char here) @@ -6897,21 +7242,17 @@ Only look at a few lines to determine indent level." (; handle inside parenthetical expressions (eq type 'cparenexp) - (let* ( here - (val (save-excursion - (verilog-backward-up-list 1) - (forward-char 1) - (if verilog-indent-lists - (skip-chars-forward " \t") - (verilog-forward-syntactic-ws)) + (let* ((val (verilog-cparenexp-indent-level)) + (here (save-excursion + (verilog-backward-up-list 1) + (forward-char 1) + (skip-chars-forward " \t") + (point))) + (decl (save-excursion + (goto-char here) + (verilog-forward-syntactic-ws) (setq here (point)) - (current-column))) - - (decl (save-excursion - (goto-char here) - (verilog-forward-syntactic-ws) - (setq here (point)) - (looking-at verilog-declaration-re)))) + (looking-at (verilog-get-declaration-re))))) (indent-line-to val) (if decl (verilog-pretty-declarations-auto)))) @@ -6938,17 +7279,20 @@ Only look at a few lines to determine indent level." (;-- defun (and (eq type 'defun) - (looking-at verilog-zero-indent-re)) + (or (and verilog-indent-class-inside-pkg + (looking-at verilog-zero-indent-no-class-re)) + (and (not verilog-indent-class-inside-pkg) + (looking-at verilog-zero-indent-re)))) (indent-line-to 0)) (;-- declaration (and (or (eq type 'defun) (eq type 'block)) - (looking-at verilog-declaration-re) + (verilog-looking-at-decl-to-align) ;; Do not consider "virtual function", "virtual task", "virtual class" ;; as declarations - (not (looking-at (concat verilog-declaration-re + (not (looking-at (concat (verilog-get-declaration-re) "\\s-+\\(function\\|task\\|class\\)\\b")))) (verilog-indent-declaration ind)) @@ -6994,6 +7338,81 @@ Do not count named blocks or case-statements." (t (current-column))))) +(defun verilog-cparenexp-indent-level () + "Return indent level for current line inside a parenthetical expression." + (let ((start-pos (point)) + (close-par (looking-at "[)}]")) + pos pos-arg-paren) + (save-excursion + (verilog-backward-up-list 1) + (if verilog-indent-lists + (progn + (forward-char 1) + (skip-chars-forward " \t") + (current-column)) + ;; Indentation with `verilog-indent-lists' set to nil + (verilog-beg-of-statement-1) + (when (looking-at "\\<\\(function\\|task\\)\\>") + (verilog-beg-of-statement)) ; find virtual/protected/static + (cond (;; 1) Closing ); of a module/function/task + (and close-par + (save-excursion + (verilog-beg-of-statement-1) + (or (looking-at verilog-complete-re) + (progn (beginning-of-line) + (not (looking-at verilog-assignment-operation-re)))))) + (current-column)) + (;; 2) if (condition) + (looking-at "(") + (forward-char 1) + (skip-chars-forward " \t\f" (point-at-eol)) + (current-column)) + (;; 3) Inside a module/defun param list or function/task argument list + (or (looking-at verilog-defun-level-re) + (looking-at "\\(\\<\\(virtual\\|protected\\|static\\)\\>\\s-+\\)?\\(\\<task\\>\\|\\<function\\>\\)")) + (setq pos-arg-paren (save-excursion + (goto-char start-pos) + (verilog-backward-up-list 1) + (forward-char) + (skip-chars-forward " \t") + (when (not (eolp)) + (current-column)))) + (or pos-arg-paren + ;; arg in next line after ( + (+ (current-column) verilog-indent-level))) + (;; 4) Assignment operation + (save-excursion + (beginning-of-line) + (and (looking-at verilog-assignment-operation-re) + (save-excursion + (goto-char (match-beginning 2)) + (not (verilog-within-string))) + (progn (verilog-forward-syntactic-ws) + (not (looking-at verilog-complete-re))))) + (goto-char (match-end 2)) + (skip-chars-forward " \t\f" (point-at-eol)) + (skip-chars-forward "{(" (1+ (point))) + (skip-chars-forward " \t\f" (point-at-eol)) + (current-column)) + (;; 5) Typedef enum declaration + (verilog-at-enum-decl-p) + (verilog-re-search-forward "{" (verilog-pos-at-end-of-statement) t) + (if (> (verilog-pos-at-forward-syntactic-ws) (point-at-eol)) + (+ (verilog-col-at-beg-of-statement) verilog-indent-level) + (verilog-col-at-forward-syntactic-ws))) + (;; 6) Long reporting strings (e.g. $display or $sformatf inside `uvm_info) + (save-excursion + (goto-char start-pos) + (verilog-backward-up-list 1) + (setq pos (1+ (point))) + (backward-word) + (or (looking-at (concat "\\$" verilog-identifier-re)) ; System function/task + (looking-at verilog-uvm-statement-re))) ; `uvm_* macros + (goto-char pos) + (current-column)) + (t ;; 7) Default + (+ (current-column) verilog-indent-level))))))) + (defun verilog-indent-comment () "Indent current line as comment." (let* ((stcol @@ -7053,90 +7472,137 @@ _ARG is ignored, for `comment-indent-function' compatibility." ;; +(defun verilog-align-comments (startpos endpos) + "Align inline comments between STARTPOS and ENDPOS." + (let (comm-ind e) + (when verilog-align-decl-expr-comments + (setq comm-ind (verilog-get-comment-align-indent (marker-position startpos) endpos)) + (save-excursion + (goto-char (marker-position startpos)) + (while (progn (setq e (marker-position endpos)) + (< (point) e)) + (when (verilog-search-comment-in-declaration e) + (goto-char (match-beginning 0)) + (delete-horizontal-space) + (indent-to (1- (+ comm-ind verilog-align-comment-distance))))))))) + (defun verilog-pretty-declarations-auto (&optional quiet) "Call `verilog-pretty-declarations' QUIET based on `verilog-auto-lineup'." (when (or (eq 'all verilog-auto-lineup) (eq 'declarations verilog-auto-lineup)) (verilog-pretty-declarations quiet))) +(defun verilog--pretty-declarations-find-end (&optional reg-end) + "Find end position for current alignment of declarations. +If region is active, use arg REG-END to set a limit on the alignment." + (let (e) + (if (and (verilog-parenthesis-depth) + (not (verilog-in-struct-p))) + ;; In an argument list or parameter block + (progn + (verilog-backward-up-list -1) + (forward-char -1) + (verilog-backward-syntactic-ws) + (if (region-active-p) + (min reg-end (point)) + (point))) + ;; In a declaration block (not in argument list) + (verilog-end-of-statement) + (setq e (point)) ; Might be on last line + (verilog-forward-syntactic-ws) + (while (verilog-looking-at-decl-to-align) + (verilog-end-of-statement) + (setq e (point)) + (verilog-forward-syntactic-ws)) + (if (region-active-p) + (min reg-end e) + e)))) + +(defun verilog--pretty-declarations-find-base-ind () + "Find base indentation for current alignment of declarations." + (if (and (verilog-parenthesis-depth) + (not (verilog-in-struct-p))) + ;; In an argument list or parameter block + (progn + (unless (or (verilog-looking-back "(" (point-at-bol)) + (bolp)) + (forward-char 1)) + (skip-chars-forward " \t") + (current-column)) + ;; In a declaration block (not in argument list) + (progn + (verilog-do-indent (verilog-calculate-indent)) + (verilog-forward-ws&directives) + (current-column)))) + (defun verilog-pretty-declarations (&optional quiet) "Line up declarations around point. Be verbose about progress unless optional QUIET set." (interactive) - (let* ((m1 (make-marker)) - (e (point)) - el - r - (here (point)) - ind - start - startpos - end - endpos - base-ind - ) + (let ((m1 (make-marker)) + (e (point)) + (here (point)) + el r ind start startpos end endpos base-ind rstart rend) (save-excursion + (when (region-active-p) + (setq rstart (region-beginning)) + (setq rend (region-end)) + (goto-char rstart)) ; Shrinks the region but ensures that start is a valid declaration (if (progn - ;; (verilog-beg-of-statement-1) + ;; Check if alignment can be performed (beginning-of-line) (verilog-forward-syntactic-ws) - (and (not (verilog-in-directive-p)) ; could have `define input foo - (looking-at verilog-declaration-re))) - (progn - (if (verilog-parenthesis-depth) - ;; in an argument list or parameter block - (setq el (verilog-backward-up-list -1) - start (progn - (goto-char e) - (verilog-backward-up-list 1) - (forward-line) ; ignore ( input foo, - (verilog-re-search-forward verilog-declaration-re el 'move) - (goto-char (match-beginning 0)) + (or (and (not (verilog-in-directive-p)) ; could have `define input foo + (verilog-looking-at-decl-to-align)) + (and (verilog-parenthesis-depth) + (looking-at verilog-interface-modport-re)))) + ;; Find boundaries of alignment + (progn + (cond (;; Using region + (region-active-p) + (setq start rstart + startpos (set-marker (make-marker) start) + end (progn (goto-char start) + (verilog--pretty-declarations-find-end rend)) + endpos (set-marker (make-marker) end) + base-ind (progn (goto-char start) + (verilog--pretty-declarations-find-base-ind)))) + (;; In an argument list or parameter block + (and (verilog-parenthesis-depth) + (not (verilog-in-struct-p))) + (setq el (verilog-backward-up-list -1) + start (progn + (goto-char e) + (verilog-backward-up-list 1) + (verilog-re-search-forward (verilog-get-declaration-re 'iface-mp) el 'move) + (goto-char (match-beginning 0)) + (skip-chars-backward " \t") + (point)) + startpos (set-marker (make-marker) start) + end (progn (goto-char start) + (verilog--pretty-declarations-find-end)) + endpos (set-marker (make-marker) end) + base-ind (progn (goto-char start) + (verilog--pretty-declarations-find-base-ind)))) + (;; In a declaration block (not in argument list) + t + (setq + start (progn + (verilog-beg-of-statement-1) + (while (and (verilog-looking-at-decl-to-align) + (not (bobp))) (skip-chars-backward " \t") - (point)) - startpos (set-marker (make-marker) start) - end (progn - (goto-char start) - (verilog-backward-up-list -1) - (forward-char -1) - (verilog-backward-syntactic-ws) - (point)) - endpos (set-marker (make-marker) end) - base-ind (progn - (goto-char start) - (forward-char 1) - (skip-chars-forward " \t") - (current-column))) - ;; in a declaration block (not in argument list) - (setq - start (progn - (verilog-beg-of-statement-1) - (while (and (looking-at verilog-declaration-re) - (not (bobp))) - (skip-chars-backward " \t") - (setq e (point)) - (beginning-of-line) - (verilog-backward-syntactic-ws) - (backward-char) - (verilog-beg-of-statement-1)) - e) - startpos (set-marker (make-marker) start) - end (progn - (goto-char here) - (verilog-end-of-statement) - (setq e (point)) ;Might be on last line - (verilog-forward-syntactic-ws) - (while (looking-at verilog-declaration-re) - (verilog-end-of-statement) - (setq e (point)) - (verilog-forward-syntactic-ws)) - e) - endpos (set-marker (make-marker) end) - base-ind (progn - (goto-char start) - (verilog-do-indent (verilog-calculate-indent)) - (verilog-forward-ws&directives) - (current-column)))) + (setq e (point)) + (verilog-backward-syntactic-ws) + (backward-char) + (verilog-beg-of-statement-1)) + e) + startpos (set-marker (make-marker) start) + end (progn (goto-char here) + (verilog--pretty-declarations-find-end)) + endpos (set-marker (make-marker) end) + base-ind (progn (goto-char start) + (verilog--pretty-declarations-find-base-ind))))) ;; OK, start and end are set (goto-char (marker-position startpos)) (if (and (not quiet) @@ -7152,12 +7618,13 @@ Be verbose about progress unless optional QUIET set." (indent-line-to base-ind) (verilog-forward-ws&directives) (if (< (point) e) - (verilog-re-search-forward "[ \t\n\f]" e 'move))) + (verilog-re-search-forward "[ \t\n\f]" (marker-position endpos) 'move))) (t - (just-one-space) - (verilog-re-search-forward "[ \t\n\f]" e 'move))) - ;;(forward-line) - ) + (unless (verilog-looking-back "(" (point-at-bol)) + (just-one-space)) + (if (looking-at verilog-comment-start-regexp) + (verilog-forward-syntactic-ws) + (verilog-re-search-forward "[ \t\n\f]" e 'move))))) ;; Now find biggest prefix (setq ind (verilog-get-lineup-indent (marker-position startpos) endpos)) ;; Now indent each line. @@ -7167,27 +7634,27 @@ Be verbose about progress unless optional QUIET set." (> r 0)) (setq e (point)) (unless quiet (message "%d" r)) - ;; (verilog-do-indent (verilog-calculate-indent))) (verilog-forward-ws&directives) (cond - ((or (and verilog-indent-declaration-macros - (looking-at verilog-declaration-re-2-macro)) - (looking-at verilog-declaration-re-2-no-macro)) - (let ((p (match-end 0))) - (set-marker m1 p) - (if (verilog-re-search-forward "[[#`]" p 'move) - (progn - (forward-char -1) - (just-one-space) - (goto-char (marker-position m1)) + ((looking-at (verilog-get-declaration-re 'iface-mp)) + (unless (looking-at (verilog-get-declaration-re 'embedded-comments)) + (let ((p (match-end 0))) + (set-marker m1 p) + (if (verilog-re-search-forward "[[#`]" p 'move) + (progn + (forward-char -1) + (just-one-space) + (goto-char (marker-position m1)) + (delete-horizontal-space) + (indent-to ind 1)) + (progn (delete-horizontal-space) - (indent-to ind 1)) - (progn - (delete-horizontal-space) - (indent-to ind 1))))) + (indent-to ind 1)))))) ((verilog-continued-line-1 (marker-position startpos)) (goto-char e) - (indent-line-to ind)) + (unless (and (verilog-in-parenthesis-p) + (looking-at (concat "\\s-*" verilog-identifier-sym-re "\\s-+" verilog-identifier-sym-re "\\s-*"))) + (indent-line-to ind))) ((verilog-in-struct-p) ;; could have a declaration of a user defined item (goto-char e) @@ -7197,104 +7664,202 @@ Be verbose about progress unless optional QUIET set." (verilog-forward-ws&directives) (forward-line -1))) (forward-line 1)) - (unless quiet (message ""))))))) + ;; Align comments if enabled + (when verilog-align-decl-expr-comments + (verilog-align-comments startpos endpos))) + ;; Exit + (unless quiet (message "")))))) + +(defun verilog--pretty-expr-assignment-found (&optional discard-re) + "Return non-nil if point is at a valid assignment operation to be aligned. +Ensure cursor is not over DISCARD-RE (e.g. Verilog keywords). +If returned non-nil, update match data according to `verilog-assignment-operation-re'." + ;; Not looking at a verilog keyword sentence (i.e looking at a potential assignment) + (and (if discard-re + (not (looking-at discard-re)) + t) + ;; Corner case to filter first parameter on param lists + (save-excursion + (if (and (verilog-re-search-forward verilog-assignment-operation-re (point-at-eol) 'move) + (verilog-in-parenthesis-p)) + (progn (verilog-backward-up-list 1) + (forward-char 1) + (not (eq 0 (string-match discard-re (buffer-substring-no-properties (point) (point-at-eol)))))) + t)) + ;; Don't work on multiline assignments unless they are continued lines + ;; e.g, multiple parameters or variable declarations in the same statement + (if (save-excursion + (and (not (verilog-in-parameter-p)) + (verilog-continued-line) + (not (looking-at verilog-basic-complete-re)))) + (save-excursion + (verilog-beg-of-statement-1) + (looking-at (verilog-get-declaration-re))) + t) + ;; Ensure it's not any kind of logical comparison + (save-excursion + (unless (and (not (verilog-in-parameter-p)) + (verilog-re-search-forward (verilog-regexp-words '("if" "for" "assert" "with")) (point-at-eol) 'move)) + t)) + ;; Looking at an assignment (last check, provides match data) + (looking-at verilog-assignment-operation-re))) + +(defun verilog--pretty-expr-find-end (&optional discard-re reg-end) + "Find end position for current alignment of expressions. +Use optional arg DISCARD-RE when aligning expressions outside of an +argument list and REG-END to set a limit on the alignment when the +region is active." + (if (verilog-in-parenthesis-p) + ;; Limit end in argument list + (progn + (verilog-backward-up-list -1) + (forward-char -1) + (verilog-backward-syntactic-ws) + (if (region-active-p) + (min reg-end (point)) + (point))) + ;; Limit end in non-argument list + (save-excursion ; EOL of the last line of the assignment block + (end-of-line) + (let ((pt (point))) ; Might be on last line + (verilog-forward-syntactic-ws) + (beginning-of-line) + (while (and (verilog--pretty-expr-assignment-found discard-re) + (progn + (end-of-line) + (not (eq pt (point))))) + (setq pt (point)) + (verilog-forward-syntactic-ws) + (beginning-of-line)) + (if (region-active-p) + (min reg-end pt) + pt))))) (defun verilog-pretty-expr (&optional quiet) "Line up expressions around point. If QUIET is non-nil, do not print messages showing the progress of line-up." (interactive) - (unless (verilog-in-comment-or-string-p) + (let* ((basic-complete-pretty-expr-re (if verilog-align-assign-expr + verilog-basic-complete-expr-no-assign-re + verilog-basic-complete-expr-re)) + (complete-pretty-expr-re (concat verilog-extended-complete-re "\\|\\(" basic-complete-pretty-expr-re "\\)")) + (discard-re (concat "^\\s-*\\(" complete-pretty-expr-re "\\)")) + rstart rend) (save-excursion - (let ((regexp (concat "^\\s-*" verilog-complete-reg)) - (regexp1 (concat "^\\s-*" verilog-basic-complete-re))) + (when (region-active-p) + (setq rstart (region-beginning)) + (setq rend (region-end)) + (goto-char rstart)) + (unless (verilog-in-comment-or-string-p) (beginning-of-line) - (when (and (not (looking-at regexp)) - (looking-at verilog-assignment-operation-re) + (when (and (verilog--pretty-expr-assignment-found discard-re) (save-excursion (goto-char (match-end 2)) (and (not (verilog-in-attribute-p)) - (not (verilog-in-parameter-p)) (not (verilog-in-comment-or-string-p))))) - (let* ((start (save-excursion ; BOL of the first line of the assignment block - (beginning-of-line) - (let ((pt (point))) - (verilog-backward-syntactic-ws) - (beginning-of-line) - (while (and (not (looking-at regexp1)) - (looking-at verilog-assignment-operation-re) - (not (bobp))) - (setq pt (point)) - (verilog-backward-syntactic-ws) - (beginning-of-line)) ; Ack, need to grok `define - pt))) - (end (save-excursion ; EOL of the last line of the assignment block - (end-of-line) - (let ((pt (point))) ; Might be on last line - (verilog-forward-syntactic-ws) - (beginning-of-line) - (while (and - (not (looking-at regexp1)) - (looking-at verilog-assignment-operation-re) - (progn - (end-of-line) - (not (eq pt (point))))) - (setq pt (point)) - (verilog-forward-syntactic-ws) - (beginning-of-line)) - pt))) - (contains-2-char-operator (string-match "<=" (buffer-substring-no-properties start end))) - (endmark (set-marker (make-marker) end))) - (goto-char start) - (verilog-do-indent (verilog-calculate-indent)) + (let* ((start (cond (;; Using region + (region-active-p) + rstart) + (;; Parameter list + (verilog-in-parenthesis-p) + (progn + (verilog-backward-up-list 1) + (forward-char) + (verilog-re-search-forward verilog-assignment-operation-re-2 nil 'move) + (goto-char (match-beginning 0)) + (point))) + (t ;; Declarations + (save-excursion ; BOL of the first line of the assignment block + (beginning-of-line) + (let ((pt (point))) + (verilog-backward-syntactic-ws) + (beginning-of-line) + (while (and (verilog--pretty-expr-assignment-found discard-re) + (not (bobp))) + (setq pt (point)) + (verilog-backward-syntactic-ws) + (beginning-of-line)) ; Ack, need to grok `define + pt))))) + (startpos (set-marker (make-marker) start)) + (end (cond (;; Using region + (region-active-p) + (verilog--pretty-expr-find-end discard-re rend)) + (;; Parameter list + (verilog-in-parenthesis-p) + (verilog--pretty-expr-find-end)) + (t ;; Declarations + (verilog--pretty-expr-find-end discard-re)))) + (endpos (set-marker (make-marker) end)) + (contains-2-char-operator (string-match "<=" (buffer-substring-no-properties start end)))) + ;; Start with alignment + (goto-char startpos) + (unless (save-excursion + (beginning-of-line) + (looking-at discard-re)) + (verilog-do-indent (verilog-calculate-indent))) (when (and (not quiet) - (> (- end start) 100)) + (> (- (marker-position endpos) (marker-position startpos)) 100)) (message "Lining up expressions.. (please stand by)")) - ;; Set indent to minimum throughout region ;; Rely on mark rather than on point as the indentation changes can ;; make the older point reference obsolete - (while (< (point) (marker-position endmark)) + (while (< (point) (marker-position endpos)) (beginning-of-line) (save-excursion - (verilog-just-one-space verilog-assignment-operation-re)) + (if (looking-at verilog-complete-re) + (progn (goto-char (marker-position startpos)) + (verilog-just-one-space verilog-assignment-operation-re-2)) + (verilog-just-one-space verilog-assignment-operation-re))) (verilog-do-indent (verilog-calculate-indent)) (end-of-line) (verilog-forward-syntactic-ws)) - (let ((ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start (marker-position endmark))) ; Find the biggest prefix + (let ((ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re (marker-position startpos) (marker-position endpos))) ; Find the biggest prefix e) ;; Now indent each line. - (goto-char start) + (goto-char (marker-position startpos)) (while (progn - (setq e (marker-position endmark)) + (setq e (marker-position endpos)) (> e (point))) (unless quiet (message " verilog-pretty-expr: %d" (- e (point)))) (setq e (point)) (cond - ((looking-at verilog-assignment-operation-re) + ((or (looking-at verilog-assignment-operation-re) + (and (verilog-in-parenthesis-p) + (looking-at verilog-assignment-operation-re-2))) (goto-char (match-beginning 2)) - (unless (or (verilog-in-parenthesis-p) ; Leave attributes and comparisons alone + (unless (or (and (verilog-in-parenthesis-p) ; Leave attributes and comparisons alone + (save-excursion ; Allow alignment of some expressions inside param/port list + (verilog-backward-up-list 1) + (verilog-beg-of-statement-1) + (not (looking-at verilog-defun-level-re)))) (verilog-in-coverage-p)) (if (and contains-2-char-operator (eq (char-after) ?=)) (indent-to (1+ ind)) ; Line up the = of the <= with surrounding = - (indent-to ind)))) - ((verilog-continued-line-1 start) + (indent-to ind))) + (forward-line 1)) + ((and (save-excursion + (verilog-forward-syntactic-ws) + (not (looking-at verilog-complete-re))) + (verilog-continued-line-1 (marker-position startpos))) (goto-char e) - (indent-line-to ind)) - (t ; Must be comment or white space + (indent-line-to ind) + (forward-line 1)) + (t ; Must be comment, white space or syntax error (goto-char e) - (verilog-forward-ws&directives) - (forward-line -1))) - (forward-line 1)) + (forward-line 1)))) + ;; Align comments if enabled + (when verilog-align-decl-expr-comments + (verilog-align-comments startpos endpos)) (unless quiet (message ""))))))))) (defun verilog-just-one-space (myre) "Remove extra spaces around regular expression MYRE." (interactive) - (if (and (not(looking-at verilog-complete-reg)) + (if (and (not(looking-at verilog-complete-re)) (looking-at myre)) (let ((p1 (match-end 1)) (p2 (match-end 2))) @@ -7312,59 +7877,63 @@ BASEIND is the base indent to offset everything." ;; `ind' is used in expressions stored in `verilog-indent-alist'. (verilog--suppressed-warnings ((lexical ind)) (defvar ind)) (let ((pos (point-marker)) - (lim (save-excursion - ;; (verilog-re-search-backward verilog-declaration-opener nil 'move) - (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<\\(connect\\)?module\\>\\)\\|\\(\\<task\\>\\)" nil 'move) - (point))) - (ind) - (val) - (m1 (make-marker))) - (setq val - (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist))))) + (m1 (make-marker)) + (in-paren (verilog-parenthesis-depth)) + (val (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist))))) + ind) (indent-line-to val) - ;; Use previous declaration (in this module) as template. - (if (or (eq 'all verilog-auto-lineup) - (eq 'declarations verilog-auto-lineup)) - (if (verilog-re-search-backward - (or (and verilog-indent-declaration-macros - verilog-declaration-re-1-macro) - verilog-declaration-re-1-no-macro) - lim t) - (progn - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (setq ind (current-column)) - (goto-char pos) - (setq val - (+ baseind - (eval (cdr (assoc 'declaration verilog-indent-alist))))) - (indent-line-to val) - (if (and verilog-indent-declaration-macros - (looking-at verilog-declaration-re-2-macro)) - (let ((p (match-end 0))) - (set-marker m1 p) - (if (verilog-re-search-forward "[[#`]" p 'move) - (progn - (forward-char -1) - (just-one-space) - (goto-char (marker-position m1)) - (delete-horizontal-space) - (indent-to ind 1)) - (delete-horizontal-space) - (indent-to ind 1))) - (if (looking-at verilog-declaration-re-2-no-macro) - (let ((p (match-end 0))) - (set-marker m1 p) - (if (verilog-re-search-forward "[[`#]" p 'move) - (progn - (forward-char -1) - (just-one-space) - (goto-char (marker-position m1)) - (delete-horizontal-space) - (indent-to ind 1)) - (delete-horizontal-space) - (indent-to ind 1)))))))) + (when (and (or (eq 'all verilog-auto-lineup) + (eq 'declarations verilog-auto-lineup)) + ;; Limit alignment to consecutive statements + (progn + (verilog-backward-syntactic-ws) + (backward-char) + (looking-at ";")) + (progn + (verilog-beg-of-statement) + (looking-at (verilog-get-declaration-re))) + ;; Make sure that we don't jump to an argument list or parameter block if + ;; we were in a declaration block (not in argument list) + (or (and in-paren + (verilog-parenthesis-depth)) + (and (not in-paren) + (not (verilog-parenthesis-depth)))) + ;; Skip variable declarations inside functions/tasks + (skip-chars-backward " \t\f") + (bolp)) + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (setq ind (current-column)) + (goto-char pos) + (setq val + (+ baseind + (eval (cdr (assoc 'declaration verilog-indent-alist))))) + (indent-line-to val) + (if (looking-at (verilog-get-declaration-re)) + (let ((p (match-end 0))) + (set-marker m1 p) + (if (verilog-re-search-forward "[[#`]" p 'move) + (progn + (forward-char -1) + (just-one-space) + (goto-char (marker-position m1)) + (delete-horizontal-space) + (indent-to ind 1)) + (delete-horizontal-space) + (indent-to ind 1))) + (when (looking-at (verilog-get-declaration-re)) + (let ((p (match-end 0))) + (set-marker m1 p) + (if (verilog-re-search-forward "[[`#]" p 'move) + (progn + (forward-char -1) + (just-one-space) + (goto-char (marker-position m1)) + (delete-horizontal-space) + (indent-to ind 1)) + (delete-horizontal-space) + (indent-to ind 1)))))) (goto-char pos))) (defun verilog-get-lineup-indent (b edpos) @@ -7376,16 +7945,13 @@ Region is defined by B and EDPOS." ;; Get rightmost position (while (progn (setq e (marker-position edpos)) (< (point) e)) - (if (verilog-re-search-forward - (or (and verilog-indent-declaration-macros - verilog-declaration-re-1-macro) - verilog-declaration-re-1-no-macro) e 'move) - (progn - (goto-char (match-end 0)) - (verilog-backward-syntactic-ws) - (if (> (current-column) ind) - (setq ind (current-column))) - (goto-char (match-end 0))))) + (when (verilog-re-search-forward (verilog-get-declaration-re 'iface-mp) e 'move) + (goto-char (match-end 0)) + (verilog-backward-syntactic-ws) + (if (> (current-column) ind) + (setq ind (current-column))) + (goto-char (match-end 0)) + (forward-line 1))) (if (> ind 0) (1+ ind) ;; No lineup-string found @@ -7402,12 +7968,13 @@ BEG and END." (save-excursion (let ((ind 0)) (goto-char beg) + (beginning-of-line) ;; Get rightmost position (while (< (point) end) (when (and (verilog-re-search-forward regexp end 'move) (not (verilog-in-attribute-p))) ; skip attribute exprs (goto-char (match-beginning 2)) - (verilog-backward-syntactic-ws) + (skip-chars-backward " \t") (if (> (current-column) ind) (setq ind (current-column))) (goto-char (match-end 0)))) @@ -7420,6 +7987,32 @@ BEG and END." (1+ (current-column)))) ind))) +(defun verilog-search-comment-in-declaration (bound) + "Move cursor to position of comment in declaration and return point. +BOUND is a buffer position that bounds the search." + (and (verilog-re-search-forward (verilog-get-declaration-re 'iface-mp) bound 'move) + (not (looking-at (concat "\\s-*" verilog-comment-start-regexp))) + (re-search-forward verilog-comment-start-regexp (point-at-eol) :noerror))) + +(defun verilog-get-comment-align-indent (b endpos) + "Return the indent level that will line up comments within the region. +Region is defined by B and ENDPOS." + (save-excursion + (let ((ind 0) + e comm-ind) + (goto-char b) + ;; Get rightmost position + (while (progn (setq e (marker-position endpos)) + (< (point) e)) + (when (verilog-search-comment-in-declaration e) + (end-of-line) + (verilog-backward-syntactic-ws) + (setq comm-ind (1+ (current-column))) + (when (> comm-ind ind) + (setq ind comm-ind))) + (forward-line 1)) + ind))) + (defun verilog-comment-depth (type val) "A useful mode debugging aide. TYPE and VAL are comments for insertion." (save-excursion @@ -7439,6 +8032,19 @@ BEG and END." (insert (format "%s %d" type val)))) +(defun verilog-indent-ignore-p () + "Return non-nil if current line should ignore indentation." + (or (and verilog-indent-ignore-multiline-defines + ;; Line with multiline define, ends with "\" or "\" plus trailing whitespace + (or (looking-at ".*\\\\\\s-*$") + (save-excursion ; Last line after multiline define + (verilog-backward-syntactic-ws) + (unless (bobp) + (backward-char)) + (looking-at "\\\\")))) + (and verilog-indent-ignore-regexp ; Ignore lines according to specified regexp + (looking-at verilog-indent-ignore-regexp)))) + ;;; Completion: ;; @@ -7446,7 +8052,7 @@ BEG and END." (defvar verilog-all nil) (defvar verilog-buffer-to-use nil) (defvar verilog-toggle-completions nil - "True means \\<verilog-mode-map>\\[verilog-complete-word] should try all possible completions one by one. + "Non-nil means \\<verilog-mode-map>\\[verilog-complete-word] should try all possible completions one by one. Repeated use of \\[verilog-complete-word] will show you all of them. Normally, when there is more than one possible completion, it displays a list of all possible completions.") @@ -7598,16 +8204,14 @@ TYPE is `module', `tf' for task or function, or t if unknown." (defun verilog-get-completion-decl (end) "Macro for searching through current declaration (var, type or const) for matches of `str' and adding the occurrence tp `all' through point END." - (let ((re (or (and verilog-indent-declaration-macros - verilog-declaration-re-2-macro) - verilog-declaration-re-2-no-macro)) + (let ((re (verilog-get-declaration-re)) decl-end match) ;; Traverse lines (while (and (< (point) end) (verilog-re-search-forward re end t)) ;; Traverse current line (setq decl-end (save-excursion (verilog-declaration-end))) - (while (and (verilog-re-search-forward verilog-symbol-re decl-end t) + (while (and (verilog-re-search-forward verilog-identifier-sym-re decl-end t) (not (match-end 1))) (setq match (buffer-substring (match-beginning 0) (match-end 0))) (if (string-match (concat "\\<" verilog-str) match) @@ -7619,7 +8223,7 @@ for matches of `str' and adding the occurrence tp `all' through point END." "Calculate all possible completions for variables (or constants)." (let ((start (point))) ;; Search for all reachable var declarations - (verilog-beg-of-defun) + (verilog-re-search-backward verilog-defun-re nil 'move) (save-excursion ;; Check var declarations (verilog-get-completion-decl start)))) @@ -8765,6 +9369,11 @@ Return an array of [outputs inouts inputs wire reg assign const gparam intf]." (t ; Bit width (setq vec (verilog-string-replace-matches "\\s-+" "" nil nil keywd))))) + ;; int'(a) is cast, not declaration of a + ((and (looking-at "'") + (not rvalue)) + (forward-char 1) + (setq expect-signal nil rvalue nil)) ;; Normal or escaped identifier -- note we remember the \ if escaped ((looking-at "\\s-*\\([a-zA-Z0-9`_$]+\\|\\\\[^ \t\n\f]+\\)") (goto-char (match-end 0)) @@ -9702,9 +10311,9 @@ resolve it. If optional RECURSE is non-nil, recurse through \\=`includes. Localparams must be simple assignments to constants, or have their own \"localparam\" label rather than a list of localparams. Thus: - localparam X = 5, Y = 10; // Ok - localparam X = {1\\='b1, 2\\='h2}; // Ok - localparam X = {1\\='b1, 2\\='h2}, Y = 10; // Bad, make into 2 localparam lines + localparam X = 5, Y = 10; // Ok + localparam X = {1\\='b1, 2\\='h2}; // Ok + localparam X = {1\\='b1, 2\\='h2}, Y = 10; // Bad, make into 2 localparam lines Defines must be simple text substitutions, one on a line, starting at the beginning of the line. Any ifdefs or multiline comments around the @@ -9827,8 +10436,7 @@ variable over and over when many modules are compiled together, put a test around the inside each include file: foo.v (an include file): - \\=`ifdef _FOO_V // include if not already included - \\=`else + \\=`ifndef _FOO_V // include if not already included \\=`define _FOO_V ... contents of file \\=`endif // _FOO_V" @@ -10066,7 +10674,7 @@ Results are cached if inside `verilog-preserve-dir-cache'." ;; (prin1 (verilog-dir-files ".")) nil) (defun verilog-dir-file-exists-p (filename) - "Return true if FILENAME exists. + "Return non-nil if FILENAME exists. Like `file-exists-p' but results are cached if inside `verilog-preserve-dir-cache'." (let* ((dirname (file-name-directory filename)) @@ -10105,7 +10713,7 @@ Allows version control to check out the file if need be." modi))))) (defun verilog-is-number (symbol) - "Return true if SYMBOL is number-like." + "Return non-nil if SYMBOL is number-like." (or (string-match "^[0-9 \t:]+$" symbol) (string-match "^[---]*[0-9]+$" symbol) (string-match "^[0-9 \t]+'s?[hdxbo][0-9a-fA-F_xz? \t]*$" symbol))) @@ -10177,7 +10785,7 @@ Or, just the existing dirnames themselves if there are no wildcards." (unless dirnames (error "`verilog-library-directories' should include at least `.'")) (save-match-data - (setq dirnames (reverse dirnames)) ; not nreverse + (setq dirnames (reverse dirnames)) ; not nreverse (let ((dirlist nil) pattern dirfile dirfiles dirname root filename rest basefile) (setq dirnames (mapcar #'substitute-in-file-name dirnames)) @@ -10885,12 +11493,12 @@ This repairs those mis-inserted by an AUTOARG." (if (equal (match-string 3 out) ">>") (int-to-string (ash (string-to-number (match-string 2 out)) (* -1 (string-to-number (match-string 4 out)))))) - (if (equal (match-string 3 out) "<<") - (int-to-string (ash (string-to-number (match-string 2 out)) - (string-to-number (match-string 4 out))))) (if (equal (match-string 3 out) ">>>") (int-to-string (ash (string-to-number (match-string 2 out)) (* -1 (string-to-number (match-string 4 out)))))) + (if (equal (match-string 3 out) "<<") + (int-to-string (ash (string-to-number (match-string 2 out)) + (string-to-number (match-string 4 out))))) (if (equal (match-string 3 out) "<<<") (int-to-string (ash (string-to-number (match-string 2 out)) (string-to-number (match-string 4 out))))) @@ -10920,7 +11528,7 @@ This repairs those mis-inserted by an AUTOARG." (ceiling (/ (log value) (log 2))))) (defun verilog-typedef-name-p (variable-name) - "Return true if the VARIABLE-NAME is a type definition." + "Return non-nil if the VARIABLE-NAME is a type definition." (when verilog-typedef-regexp (verilog-string-match-fold verilog-typedef-regexp variable-name))) @@ -11678,7 +12286,7 @@ If PAR-VALUES replace final strings with these parameter values." (concat "." vl-modport) "") dflt-bits)) ;; Find template - (cond (tpl-ass ; Template of exact port name + (cond (tpl-ass ; Template of exact port name (setq tpl-net (nth 1 tpl-ass))) ((nth 1 tpl-list) ; Wildcards in template, search them (let ((wildcards (nth 1 tpl-list))) @@ -12240,7 +12848,9 @@ For more information see the \\[verilog-faq] and forums at URL (cond ((not verilog-auto-inst-first-any) (re-search-backward "," pt t) (delete-char 1) - (insert ");") + (when (looking-at " ") + (delete-char 1)) ; so we can align // Templated comments + (insert ");") (search-forward "\n") ; Added by inst-port (delete-char -1) (if (search-forward ")" nil t) ; From user, moved up a line @@ -14645,7 +15255,7 @@ and the case items." (if (not (member v1 verilog-keywords)) (save-excursion (setq verilog-sk-signal v1) - (verilog-beg-of-defun) + (verilog-re-search-backward verilog-defun-re nil 'move) (verilog-end-of-statement) (verilog-forward-syntactic-ws) (verilog-sk-def-reg) @@ -14897,7 +15507,12 @@ Files are checked based on `verilog-library-flags'." '( verilog-active-low-regexp verilog-after-save-font-hook + verilog-align-assign-expr + verilog-align-comment-distance + verilog-align-decl-expr-comments verilog-align-ifelse + verilog-align-typedef-regexp + verilog-align-typedef-words verilog-assignment-delay verilog-auto-arg-sort verilog-auto-declare-nettype @@ -14942,13 +15557,17 @@ Files are checked based on `verilog-library-flags'." verilog-compiler verilog-coverage verilog-delete-auto-hook + verilog-fontify-variables verilog-getopt-flags-hook verilog-highlight-grouping-keywords verilog-highlight-includes verilog-highlight-modules verilog-highlight-translate-off verilog-indent-begin-after-if + verilog-indent-class-inside-pkg verilog-indent-declaration-macros + verilog-indent-ignore-multiline-defines + verilog-indent-ignore-regexp verilog-indent-level verilog-indent-level-behavioral verilog-indent-level-declaration diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 916d83d407b..ee4253960c5 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.3 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -355,8 +355,10 @@ backward." (t (goto-char start) nil)))) -;; Dummy variable retained for compatibility. -(defvar xref-marker-ring-length 16) +(defvar xref-marker-ring-length 16 + "Xref marker ring length. +This is a dummy variable retained for backward compatibility, and +otherwise unused.") (make-obsolete-variable 'xref-marker-ring-length nil "29.1") (defcustom xref-prompt-for-identifier '(not xref-find-definitions @@ -453,7 +455,9 @@ are predefined: (make-obsolete-variable 'xref--marker-ring 'xref--history "29.1") (defun xref-set-marker-ring-length (_var _val) - (declare (obsolete nil "29.1")) + (declare (obsolete + "this function has no effect: Xref marker ring is now unlimited in size" + "29.1")) nil) (defun xref--make-xref-history () @@ -499,7 +503,7 @@ Override existing value with NEW-VALUE if NEW-VALUE is set." (defun xref-push-marker-stack (&optional m) "Add point M (defaults to `point-marker') to the marker stack. -The future stack is erased." +Erase the stack slots following this one." (xref--push-backward (or m (point-marker))) (let ((history (xref--get-history))) (dolist (mk (cdr history)) @@ -527,7 +531,7 @@ To undo, use \\[xref-go-forward]." ;;;###autoload (defun xref-go-forward () - "Got to the point where a previous \\[xref-go-back] was invoked." + "Go to the point where a previous \\[xref-go-back] was invoked." (interactive) (let ((history (xref--get-history))) (if (null (cdr history)) @@ -568,7 +572,8 @@ This can be used from `xref-after-jump-hook', for instance.") (dolist (l (list (car history) (cdr history))) (dolist (m l) (set-marker m nil nil))) - (setq history (cons nil nil))) + (setcar history nil) + (setcdr history nil)) nil) ;;;###autoload @@ -980,7 +985,7 @@ point." map)) (declare-function outline-search-text-property "outline" - (property &optional value bound move backward looking-at)) + (property &optional value bound move backward looking-at)) (define-derived-mode xref--xref-buffer-mode special-mode "XREF" "Mode for displaying cross-references." @@ -992,14 +997,14 @@ point." (setq imenu-extract-index-name-function #'xref--imenu-extract-index-name) (setq-local add-log-current-defun-function - #'xref--add-log-current-defun) - (setq-local outline-minor-mode-cycle t - outline-minor-mode-use-buttons 'insert - outline-search-function + #'xref--add-log-current-defun) + (setq-local outline-minor-mode-cycle t) + (setq-local outline-minor-mode-use-buttons 'insert) + (setq-local outline-search-function (lambda (&optional bound move backward looking-at) (outline-search-text-property - 'xref-group nil bound move backward looking-at)) - outline-level (lambda () 1))) + 'xref-group nil bound move backward looking-at))) + (setq-local outline-level (lambda () 1))) (defvar xref--transient-buffer-mode-map (let ((map (make-sparse-keymap))) @@ -1125,7 +1130,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 @@ -1145,8 +1152,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 0124ff4bc0c..2fcac4d2ce3 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -349,7 +349,7 @@ For example, you can set it to <return> like `isearch-exit'." :version "28.1") (defcustom repeat-exit-timeout nil - "Break the repetition chain of keys after specified timeout. + "Break the repetition chain of keys after specified amount of idle time. When a number, exit the transient repeating mode after idle time of the specified number of seconds. You can also set the property `repeat-exit-timeout' on the command symbol. @@ -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.") @@ -380,12 +380,12 @@ This property can override the value of this variable." (defcustom repeat-check-key t "Whether to check that the last key exists in the repeat map. -When non-nil and the last typed key (with or without modifiers) -doesn't exist in the keymap attached by the `repeat-map' property, -then don't activate that keymap for the next command. So only the -same keys among repeatable keys are allowed in the repeating sequence. -For example, with a non-nil value, only \\`C-x u u' repeats undo, -whereas \\`C-/ u' doesn't. +When non-nil, and the last typed key (with or without modifiers) +doesn't exist in the keymap specified by the `repeat-map' property +of the command, don't activate that keymap for the next command. +Thus, when this is non-nil, only the same keys among repeatable +keys are allowed in the repeating sequence. For example, with a +non-nil value, only \\`C-x u u' repeats undo, whereas \\`C-/ u' doesn't. You can also set the property `repeat-check-key' on the command symbol. This property can override the value of this variable. @@ -398,7 +398,7 @@ but the property value is `t', then check the last key." (defcustom repeat-echo-function #'repeat-echo-message "Function to display a hint about available keys. -Function is called after every repeatable command with one argument: +The function is called after every repeatable command with one argument: a repeating map, or nil after deactivating the transient repeating mode. You can use `add-function' for multiple functions simultaneously." :type '(choice (const :tag "Show hints in the echo area" @@ -422,8 +422,12 @@ the map can't be set on the command symbol property `repeat-map'.") ;;;###autoload (define-minor-mode repeat-mode "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." :global t :group 'repeat (if (not repeat-mode) @@ -459,7 +463,7 @@ See `describe-repeat-maps' for a list of all repeatable commands." rep-map)))) (defun repeat-check-key (key map) - "Check if the last key is suitable to activate the repeating MAP." + "Check if the last KEY is suitable for activating the repeating MAP." (let* ((prop (repeat--command-property 'repeat-check-key)) (check-key (unless (eq prop 'no) (or prop repeat-check-key)))) (or (not check-key) @@ -471,7 +475,7 @@ See `describe-repeat-maps' for a list of all repeatable commands." "Previous minibuffer state.") (defun repeat-check-map (map) - "Decides whether MAP can be used for the next command." + "Decide whether MAP can be used for the next command." (and map ;; Detect changes in the minibuffer state to allow repetitions ;; in the same minibuffer, but not when the minibuffer is activated @@ -513,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)))) @@ -534,20 +538,20 @@ 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 a list of repeating keys." + "Return a string with the list of repeating keys in KEYMAP." (let (keys) (map-keymap (lambda (key cmd) (and cmd (push key keys))) keymap) (format-message "Repeat with %s%s" @@ -565,7 +569,8 @@ This function can be used to force exit of repetition while it's active." "")))) (defun repeat-echo-message (keymap) - "Display available repeating keys in the echo area." + "Display in the echo area the repeating keys defined by KEYMAP. +See `repeat-echo-function' to enable/disable." (let ((message-log-max nil)) (if keymap (let ((message (repeat-echo-message-string keymap))) @@ -586,7 +591,9 @@ This function can be used to force exit of repetition while it's active." "String displayed in the mode line in repeating mode.") (defun repeat-echo-mode-line (keymap) - "Display the repeat indicator in the mode line." + "Display the repeat indicator in the mode line. +KEYMAP should be non-nil, but is otherwise ignored. +See `repeat-echo-function' to enable/disable." (if keymap (unless (assq 'repeat-in-progress mode-line-modes) (add-to-list 'mode-line-modes (list 'repeat-in-progress @@ -596,8 +603,11 @@ This function can be used to force exit of repetition while it's active." (declare-function help-fns--analyze-function "help-fns" (function)) (defun describe-repeat-maps () - "Describe mappings of commands repeatable by symbol property `repeat-map'. -Used in `repeat-mode'." + "Describe transient keymaps installed for repeating multi-key commands. +These keymaps enable repetition of commands bound to multi-key +sequences by typing just one key, when `repeat-mode' is enabled. +Commands that can be repeated this way must have their symbol +to have the `repeat-map' property whose value specified a keymap." (interactive) (require 'help-fns) (let ((help-buffer-under-preparation t)) @@ -612,7 +622,9 @@ Used in `repeat-mode'." (with-help-window (help-buffer) (with-current-buffer standard-output (setq-local outline-regexp "[*]+") - (insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n") + (insert "\ +A list of keymaps and their single-key shortcuts for repeating commands. +Click on a keymap to see the commands repeatable by the keymap.\n") (dolist (keymap (sort keymaps (lambda (a b) (when (and (symbolp (car a)) diff --git a/lisp/reveal.el b/lisp/reveal.el index 8a1239e1aa2..5ebc5f7c6c3 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -118,17 +118,13 @@ Each element has the form (WINDOW . OVERLAY).") ;; overlay. Always reveal invisible text, but only reveal ;; display properties if `reveal-toggle-invisible' is ;; present. - (let ((inv (overlay-get ol 'invisible)) - (disp (and (overlay-get ol 'display) - (overlay-get ol 'reveal-toggle-invisible))) - open) - (when (and (or (and inv - ;; There's an `invisible' property. - ;; Make sure it's actually invisible, - ;; and ellipsized. - (and (consp buffer-invisibility-spec) - (cdr (assq inv buffer-invisibility-spec)))) - disp) + (let* ((inv (overlay-get ol 'invisible)) + (disp (and (overlay-get ol 'display) + (overlay-get ol 'reveal-toggle-invisible))) + (hidden (invisible-p inv)) + (ellipsis (and hidden (not (eq t hidden)))) + open) + (when (and (or ellipsis disp) (or (setq open (or (overlay-get ol 'reveal-toggle-invisible) (and (symbolp inv) diff --git a/lisp/server.el b/lisp/server.el index eaf24a770e4..608e5df3a5b 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -273,6 +273,11 @@ If nil, no instructions are displayed." :version "28.1" :type 'boolean) +(defvar server-stop-automatically) ; Defined below to avoid recursive load. + +(defvar server-stop-automatically--timer nil + "The timer object for `server-stop-automatically--maybe-kill-emacs'.") + ;; We do not use `temporary-file-directory' here, because emacsclient ;; does not read the init file. (defvar server-socket-dir @@ -636,7 +641,8 @@ anyway." (setq stopped-p t server-process nil server-mode nil - global-minor-modes (delq 'server-mode global-minor-modes))) + global-minor-modes (delq 'server-mode global-minor-modes)) + (server-apply-stop-automatically)) (unwind-protect ;; Delete the socket files made by previous server ;; invocations. @@ -757,6 +763,7 @@ the `server-process' variable." (list :family 'local :service server-file :plist '(:authenticated t))))) + (server-apply-stop-automatically) (unless server-process (error "Could not start server process")) (server-log "Started server") (process-put server-process :server-file server-file) @@ -1769,9 +1776,6 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." (when server-raise-frame (select-frame-set-input-focus (window-frame))))) -(defvar server-stop-automatically nil - "Internal status variable for `server-stop-automatically'.") - ;;;###autoload (defun server-save-buffers-kill-terminal (arg) ;; Called from save-buffers-kill-terminal in files.el. @@ -1779,11 +1783,19 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." With ARG non-nil, silently save all file-visiting buffers, then kill. If emacsclient was started with a list of filenames to edit, then -only these files will be asked to be saved." - (let ((proc (frame-parameter nil 'client))) +only these files will be asked to be saved. + +When running Emacs as a daemon and with +`server-stop-automatically' (which see) set to `kill-terminal' or +`delete-frame', this function may call `save-buffers-kill-emacs' +if there are no other active clients." + (let ((stop-automatically + (and (daemonp) + (memq server-stop-automatically '(kill-terminal delete-frame)))) + (proc (frame-parameter nil 'client))) (cond ((eq proc 'nowait) ;; Nowait frames have no client buffer list. - (if (length> (frame-list) (if server-stop-automatically 2 1)) + (if (length> (frame-list) (if stop-automatically 2 1)) ;; If there are any other frames, only delete this one. ;; When `server-stop-automatically' is set, don't count ;; the daemon frame. @@ -1792,7 +1804,7 @@ only these files will be asked to be saved." ;; If we're the last frame standing, kill Emacs. (save-buffers-kill-emacs arg))) ((processp proc) - (if (or (not server-stop-automatically) + (if (or (not stop-automatically) (length> server-clients 1) (seq-some (lambda (frame) @@ -1818,31 +1830,14 @@ only these files will be asked to be saved." (save-buffers-kill-emacs arg))) (t (error "Invalid client frame"))))) -(defun server-stop-automatically--handle-delete-frame (frame) - "Handle deletion of FRAME when `server-stop-automatically' is used." - (when server-stop-automatically - (if (if (and (processp (frame-parameter frame 'client)) - (eq this-command 'save-buffers-kill-terminal)) - (progn - (dolist (f (frame-list)) - (when (and (eq (frame-parameter frame 'client) - (frame-parameter f 'client)) - (not (eq frame f))) - (set-frame-parameter f 'client nil) - (let ((server-stop-automatically nil)) - (delete-frame f)))) - (if (cddr (frame-list)) - (let ((server-stop-automatically nil)) - (delete-frame frame) - nil) - t)) - (null (cddr (frame-list)))) - (let ((server-stop-automatically nil)) - (save-buffers-kill-emacs) - (delete-frame frame))))) +(defun server-stop-automatically--handle-delete-frame (_frame) + "Handle deletion of FRAME when `server-stop-automatically' is `delete-frame'." + (when (null (cddr (frame-list))) + (let ((server-stop-automatically nil)) + (save-buffers-kill-emacs)))) (defun server-stop-automatically--maybe-kill-emacs () - "Handle closing of Emacs daemon when `server-stop-automatically' is used." + "Handle closing of Emacs daemon when `server-stop-automatically' is `empty'." (unless (cdr (frame-list)) (when (and (not (memq t (mapcar (lambda (b) @@ -1856,41 +1851,70 @@ only these files will be asked to be saved." (process-list))))) (kill-emacs)))) -;;;###autoload -(defun server-stop-automatically (arg) - "Automatically stop server as specified by ARG. - -If ARG is the symbol `empty', stop the server when it has no +(defun server-apply-stop-automatically () + "Apply the current value of `server-stop-automatically'. +This function adds or removes the necessary helpers to manage +stopping the Emacs server automatically, depending on the whether +the server is running or not. This function only applies when +running Emacs as a daemon." + (when (daemonp) + (let (empty-timer-p delete-frame-p) + (when server-process + (pcase server-stop-automatically + ('empty (setq empty-timer-p t)) + ('delete-frame (setq delete-frame-p t)))) + ;; Start or stop the timer. + (if empty-timer-p + (unless server-stop-automatically--timer + (setq server-stop-automatically--timer + (run-with-timer + 10 2 + #'server-stop-automatically--maybe-kill-emacs))) + (when server-stop-automatically--timer + (cancel-timer server-stop-automatically--timer) + (setq server-stop-automatically--timer nil))) + ;; Add or remove the delete-frame hook. + (if delete-frame-p + (add-hook 'delete-frame-functions + #'server-stop-automatically--handle-delete-frame) + (remove-hook 'delete-frame-functions + #'server-stop-automatically--handle-delete-frame)))) + ;; Return the current value of `server-stop-automatically'. + server-stop-automatically) + +(defcustom server-stop-automatically nil + "If non-nil, stop the server under the requested conditions. + +If this is the symbol `empty', stop the server when it has no remaining clients, no remaining unsaved file-visiting buffers, and no running processes with a `query-on-exit' flag. -If ARG is the symbol `delete-frame', ask the user when the last +If this is the symbol `delete-frame', ask the user when the last frame is deleted whether each unsaved file-visiting buffer must be saved and each running process with a `query-on-exit' flag can be stopped, and if so, stop the server itself. -If ARG is the symbol `kill-terminal', ask the user when the +If this is the symbol `kill-terminal', ask the user when the terminal is killed with \\[save-buffers-kill-terminal] \ whether each unsaved file-visiting buffer must be saved and each running process with a `query-on-exit' -flag can be stopped, and if so, stop the server itself. - -Any other value of ARG will cause this function to signal an error. +flag can be stopped, and if so, stop the server itself." + :type '(choice + (const :tag "Never" nil) + (const :tag "When no clients, unsaved files, or processes" + empty) + (const :tag "When killing last terminal" kill-terminal) + (const :tag "When killing last terminal or frame" delete-frame)) + :set (lambda (symbol value) + (set-default symbol value) + (server-apply-stop-automatically)) + :version "29.1") -This function is meant to be called from the user init file." - (when (daemonp) - (setq server-stop-automatically arg) - (cond - ((eq arg 'empty) - (setq server-stop-automatically nil) - (run-with-timer 10 2 - #'server-stop-automatically--maybe-kill-emacs)) - ((eq arg 'delete-frame) - (add-hook 'delete-frame-functions - #'server-stop-automatically--handle-delete-frame)) - ((eq arg 'kill-terminal)) - (t - (error "Unexpected argument"))))) +;;;###autoload +(defun server-stop-automatically (value) + "Automatically stop the Emacs server as specified by VALUE. +This sets the variable `server-stop-automatically' (which see)." + (setopt server-stop-automatically value)) (define-key ctl-x-map "#" 'server-edit) @@ -1905,12 +1929,22 @@ This function is meant to be called from the user init file." ;; continue standard unloading nil) +(define-error 'server-return-invalid-read-syntax + "Emacs server returned unreadable result of evaluation" + 'invalid-read-syntax) + (defun server-eval-at (server form) "Contact the Emacs server named SERVER and evaluate FORM there. -Returns the result of the evaluation, or signals an error if it -cannot contact the specified server. For example: +Returns the result of the evaluation. For example: (server-eval-at \"server\" \\='(emacs-pid)) -returns the process ID of the Emacs instance running \"server\"." +returns the process ID of the Emacs instance running \"server\". + +This function signals `error' if it could not contact the server. + +This function signals `server-return-invalid-read-syntax' if +`read' fails on the result returned by the server. +This will occur whenever the result of evaluating FORM is +something that cannot be printed readably." (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) (server-file (expand-file-name server server-dir)) (coding-system-for-read 'binary) @@ -1956,8 +1990,14 @@ returns the process ID of the Emacs instance running \"server\"." (progn (skip-chars-forward "^\n") (point)))))) (if (not (equal answer "")) - (read (decode-coding-string (server-unquote-arg answer) - 'emacs-internal))))))) + (condition-case err + (read + (decode-coding-string (server-unquote-arg answer) + 'emacs-internal)) + ;; Re-signal with a more specific condition. + (invalid-read-syntax + (signal 'server-return-invalid-read-syntax + (cdr err))))))))) (provide 'server) diff --git a/lisp/simple.el b/lisp/simple.el index aaad3217982..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) @@ -2709,7 +2716,16 @@ function as needed." (let ((doc (car body))) (when (funcall docstring-p doc) doc))) - (_ (signal 'invalid-function (list function)))))) + ((pred symbolp) + (let ((f (indirect-function function))) + (if f (function-documentation f) + (signal 'void-function (list function))))) + (`(macro . ,f) (function-documentation f)) + (_ + (let ((doc (internal-subr-documentation function))) + (if (eq t doc) + (signal 'invalid-function (list function)) + doc)))))) (cl-defmethod function-documentation ((function accessor)) (oclosure--accessor-docstring function)) ;; FIXME: η-reduce! @@ -2729,7 +2745,8 @@ instead." nil) (cl-defmethod oclosure-interactive-form ((f cconv--interactive-helper)) - `(interactive (funcall ',(cconv--interactive-helper--if f)))) + (let ((if (cconv--interactive-helper--if f))) + `(interactive ,(if (functionp if) `(funcall ',if) if)))) (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. @@ -3852,16 +3869,14 @@ whether (MARKER . ADJUSTMENT) undo elements are in the region, because markers can be arbitrarily relocated. Instead, pass the marker adjustment's corresponding (TEXT . POS) element." (cond ((integerp undo-elt) - (and (>= undo-elt start) - (<= undo-elt end))) + (<= start undo-elt end)) ((eq undo-elt nil) t) ((atom undo-elt) nil) ((stringp (car undo-elt)) ;; (TEXT . POSITION) - (and (>= (abs (cdr undo-elt)) start) - (<= (abs (cdr undo-elt)) end))) + (<= start (abs (cdr undo-elt)) end)) ((and (consp undo-elt) (markerp (car undo-elt))) ;; (MARKER . ADJUSTMENT) (<= start (car undo-elt) end)) @@ -4547,6 +4562,9 @@ If the output is short enough to display in the echo area \(determined by the variable `max-mini-window-height' if `resize-mini-windows' is non-nil), it is shown there. Otherwise, the buffer containing the output is displayed. +Note that if `shell-command-dont-erase-buffer' is non-nil, +the echo area could display more than just the output of the +last command. If there is output and an error, and you did not specify \"insert it in the current buffer\", a message about the error goes at the end @@ -4723,6 +4741,18 @@ Also see the `async-shell-command-buffer' variable." action)) (user-error "Shell command in progress")))) +(defun file-user-uid () + "Return the connection-local effective uid. +This is similar to `user-uid', but may invoke a file name handler +based on `default-directory'. See Info node `(elisp)Magic File +Names'. + +If a file name handler is unable to retrieve the effective uid, +this function will instead return -1." + (if-let ((handler (find-file-name-handler default-directory 'file-user-uid))) + (funcall handler 'file-user-uid) + (user-uid))) + (defun max-mini-window-lines (&optional frame) "Compute maximum number of lines for echo area in FRAME. As defined by `max-mini-window-height'. FRAME defaults to the @@ -4829,6 +4859,9 @@ If the output is short enough to display in the echo area `resize-mini-windows' is non-nil), it is shown there. Otherwise it is displayed in the buffer named by `shell-command-buffer-name'. The output is available in that buffer in both cases. +Note that if `shell-command-dont-erase-buffer' is non-nil, +the echo area could display more than just the output of the +last command. If there is output and an error, a message about the error appears at the end of the output. @@ -5846,6 +5879,25 @@ The value 0 disables blinking." :group 'killing :version "28.1") +(defcustom copy-region-blink-predicate #'region-indistinguishable-p + "Whether the cursor must be blinked after a copy. +When this condition holds, and the copied region fits in the +current window, `kill-ring-save' will blink the cursor between +point and mark for `copy-region-blink-delay' seconds." + :type '(radio (function-item region-indistinguishable-p) + (function-item :doc "Always blink point and mark." always) + (function-item :doc "Never blink point and mark." ignore) + (function :tag "Other predicate function")) + :group 'killing + :version "29.1") + +(defun region-indistinguishable-p () + "Whether the current region is not denoted visually. +This holds when the region is inactive, or when the `region' face +cannot be distinguished from the `default' face." + (not (and (region-active-p) + (face-differs-from-default-p 'region)))) + (defun indicate-copied-region (&optional message-len) "Indicate that the region text has been copied interactively. If the mark is visible in the selected window, blink the cursor between @@ -5866,8 +5918,7 @@ of this sample text; it defaults to 40." ;; was selected. Don't do it if the region is highlighted. (when (and (numberp copy-region-blink-delay) (> copy-region-blink-delay 0) - (or (not (region-active-p)) - (not (face-background 'region nil t)))) + (funcall copy-region-blink-predicate)) ;; Swap point and mark. (set-marker (mark-marker) (point) (current-buffer)) (goto-char mark) @@ -6476,7 +6527,7 @@ If the Unicode tables are not yet available, e.g. during bootstrap, then gives correct answers only for ASCII characters." (cond ((unicode-property-table-internal 'lowercase) (characterp (get-char-code-property char 'lowercase))) - ((and (>= char ?A) (<= char ?Z))))) + ((<= ?A char ?Z)))) (defun zap-to-char (arg char &optional interactive) "Kill up to and including ARGth occurrence of CHAR. @@ -6786,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))) @@ -8495,6 +8547,45 @@ are interchanged." (interactive "*p") (transpose-subr 'forward-word arg)) +(defun transpose-sexps-default-function (arg) + "Default method to locate a pair of points for transpose-sexps." + ;; Here we should try to simulate the behavior of + ;; (cons (progn (forward-sexp x) (point)) + ;; (progn (forward-sexp (- x)) (point))) + ;; Except that we don't want to rely on the second forward-sexp + ;; putting us back to where we want to be, since forward-sexp-function + ;; might do funny things like infix-precedence. + (if (if (> arg 0) + (looking-at "\\sw\\|\\s_") + (and (not (bobp)) + (save-excursion + (forward-char -1) + (looking-at "\\sw\\|\\s_")))) + ;; Jumping over a symbol. We might be inside it, mind you. + (progn (funcall (if (> arg 0) + #'skip-syntax-backward #'skip-syntax-forward) + "w_") + (cons (save-excursion (forward-sexp arg) (point)) (point))) + ;; Otherwise, we're between sexps. Take a step back before jumping + ;; to make sure we'll obey the same precedence no matter which + ;; direction we're going. + (funcall (if (> arg 0) #'skip-syntax-backward #'skip-syntax-forward) + " .") + (cons (save-excursion (forward-sexp arg) (point)) + (progn (while (or (forward-comment (if (> arg 0) 1 -1)) + (not (zerop (funcall (if (> arg 0) + #'skip-syntax-forward + #'skip-syntax-backward) + "."))))) + (point))))) + +(defvar transpose-sexps-function #'transpose-sexps-default-function + "If non-nil, `transpose-sexps' delegates to this function. + +This function takes one argument ARG, a number. Its expected +return value is a position pair, which is a cons (BEG . END), +where BEG and END are buffer positions.") + (defun transpose-sexps (arg &optional interactive) "Like \\[transpose-chars] (`transpose-chars'), but applies to sexps. Unlike `transpose-words', point must be between the two sexps and not @@ -8510,38 +8601,7 @@ report errors as appropriate for this kind of usage." (condition-case nil (transpose-sexps arg nil) (scan-error (user-error "Not between two complete sexps"))) - (transpose-subr - (lambda (arg) - ;; Here we should try to simulate the behavior of - ;; (cons (progn (forward-sexp x) (point)) - ;; (progn (forward-sexp (- x)) (point))) - ;; Except that we don't want to rely on the second forward-sexp - ;; putting us back to where we want to be, since forward-sexp-function - ;; might do funny things like infix-precedence. - (if (if (> arg 0) - (looking-at "\\sw\\|\\s_") - (and (not (bobp)) - (save-excursion - (forward-char -1) - (looking-at "\\sw\\|\\s_")))) - ;; Jumping over a symbol. We might be inside it, mind you. - (progn (funcall (if (> arg 0) - 'skip-syntax-backward 'skip-syntax-forward) - "w_") - (cons (save-excursion (forward-sexp arg) (point)) (point))) - ;; Otherwise, we're between sexps. Take a step back before jumping - ;; to make sure we'll obey the same precedence no matter which - ;; direction we're going. - (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) - " .") - (cons (save-excursion (forward-sexp arg) (point)) - (progn (while (or (forward-comment (if (> arg 0) 1 -1)) - (not (zerop (funcall (if (> arg 0) - 'skip-syntax-forward - 'skip-syntax-backward) - "."))))) - (point))))) - arg 'special))) + (transpose-subr transpose-sexps-function arg 'special))) (defun transpose-lines (arg) "Exchange current line and previous line, leaving point after both. @@ -8566,13 +8626,15 @@ With argument 0, interchanges line point is in with line mark is in." ;; FIXME document SPECIAL. (defun transpose-subr (mover arg &optional special) "Subroutine to do the work of transposing objects. -Works for lines, sentences, paragraphs, etc. MOVER is a function that -moves forward by units of the given object (e.g. `forward-sentence', -`forward-paragraph'). If ARG is zero, exchanges the current object -with the one containing mark. If ARG is an integer, moves the -current object past ARG following (if ARG is positive) or -preceding (if ARG is negative) objects, leaving point after the -current object." +Works for lines, sentences, paragraphs, etc. MOVER is a function +that moves forward by units of the given +object (e.g. `forward-sentence', `forward-paragraph'), or a +function calculating a cons of buffer positions. + + If ARG is zero, exchanges the current object with the one +containing mark. If ARG is an integer, moves the current object +past ARG following (if ARG is positive) or preceding (if ARG is +negative) objects, leaving point after the current object." (let ((aux (if special mover (lambda (x) (cons (progn (funcall mover x) (point)) @@ -8599,6 +8661,8 @@ current object." (goto-char (+ (car pos2) (- (cdr pos1) (car pos1)))))))) (defun transpose-subr-1 (pos1 pos2) + (unless (and pos1 pos2) + (error "Don't have two things to transpose")) (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1)))) (when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2)))) (when (> (car pos1) (car pos2)) @@ -9858,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))) @@ -10108,8 +10177,7 @@ PREFIX is the string that represents this modifier in an event type symbol." ((eq symbol 'shift) ;; FIXME: Should we also apply this "upcase" behavior of shift ;; to non-ascii letters? - (if (and (<= (downcase event) ?z) - (>= (downcase event) ?a)) + (if (<= ?a (downcase event) ?z) (upcase event) (logior (ash 1 lshiftby) event))) (t @@ -10775,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") @@ -10785,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 () @@ -10802,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 bbcf60556ae..8d163684f55 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"))) @@ -1601,7 +1597,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)) @@ -2926,7 +2923,7 @@ nil default-directory" name) (when (looking-at "#!") (forward-line)) (let (value form) - (while (ignore-error 'end-of-file + (while (ignore-error end-of-file (setq form (read (current-buffer)))) (setq value (eval form t))) (kill-emacs (if (numberp value) diff --git a/lisp/subr.el b/lisp/subr.el index 0f754fcd31f..99ddd813867 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -163,7 +163,7 @@ of previous VARs. (defmacro setq-local (&rest pairs) "Make each VARIABLE buffer-local and assign to it the corresponding VALUE. -The arguments are variable/value pairs For each VARIABLE in a pair, +The arguments are variable/value pairs. For each VARIABLE in a pair, make VARIABLE buffer-local and assign to it the corresponding VALUE of the pair. The VARIABLEs are literal symbols and should not be quoted. @@ -280,14 +280,20 @@ change the list." When COND yields non-nil, eval BODY forms sequentially and return value of last one, or nil if there are none." (declare (indent 1) (debug t)) - (list 'if cond (cons 'progn body))) + (if body + (list 'if cond (cons 'progn body)) + (macroexp-warn-and-return (format-message "`when' with empty body") + cond '(empty-body when) t))) (defmacro unless (cond &rest body) "If COND yields nil, do BODY, else return nil. When COND yields nil, eval BODY forms sequentially and return value of last one, or nil if there are none." (declare (indent 1) (debug t)) - (cons 'if (cons cond (cons nil body)))) + (if body + (cons 'if (cons cond (cons nil body))) + (macroexp-warn-and-return (format-message "`unless' with empty body") + cond '(empty-body unless) t))) (defsubst subr-primitive-p (object) "Return t if OBJECT is a built-in primitive function." @@ -380,9 +386,24 @@ without silencing all errors." "Execute BODY; if the error CONDITION occurs, return nil. Otherwise, return result of last form in BODY. -CONDITION can also be a list of error conditions." +CONDITION can also be a list of error conditions. +The CONDITION argument is not evaluated. Do not quote it." (declare (debug t) (indent 1)) - `(condition-case nil (progn ,@body) (,condition nil))) + (cond + ((and (eq (car-safe condition) 'quote) + (cdr condition) (null (cddr condition))) + (macroexp-warn-and-return + (format-message + "`ignore-error' condition argument should not be quoted: %S" + condition) + `(condition-case nil (progn ,@body) (,(cadr condition) nil)) + nil t condition)) + (body + `(condition-case nil (progn ,@body) (,condition nil))) + (t + (macroexp-warn-and-return (format-message "`ignore-error' with empty body") + nil '(empty-body ignore-error) t condition)))) + ;;;; Basic Lisp functions. @@ -401,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) @@ -409,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. @@ -488,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) @@ -510,8 +537,10 @@ This function is provided for compatibility. In new code, use `ash' instead." (declare (compiler-macro (lambda (form) - (macroexp-warn-and-return "avoid `lsh'; use `ash' instead" - form '(suspicious lsh) t form)))) + (macroexp-warn-and-return + (format-message "avoid `lsh'; use `ash' instead") + 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))) @@ -684,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))) @@ -739,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)) @@ -775,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)) @@ -796,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) @@ -812,6 +845,7 @@ argument VECP, this copies vectors as well as conses." (aset tree i (copy-tree (aref tree i) vecp))) tree) tree))) + ;;;; Various list-search functions. @@ -1503,6 +1537,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)) @@ -1565,6 +1600,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) @@ -1837,7 +1873,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 @@ -1894,8 +1930,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. @@ -2401,8 +2442,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 @@ -2961,6 +3003,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))) @@ -3282,7 +3325,7 @@ floating point support." (lambda (form) (if (not (or (numberp nodisp) obsolete)) form (macroexp-warn-and-return - "Obsolete calling convention for 'sit-for'" + (format-message "Obsolete calling convention for `sit-for'") `(,(car form) (+ ,seconds (/ (or ,nodisp 0) 1000.0)) ,obsolete) '(obsolete sit-for)))))) ;; This used to be implemented in C until the following discussion: @@ -3573,12 +3616,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'). @@ -3939,30 +3984,53 @@ 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)" + (declare (indent 0) (debug t)) + (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)" + (declare (indent 0) (debug t)) + (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. @@ -4100,15 +4168,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) @@ -4121,21 +4192,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)) @@ -4145,6 +4220,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) @@ -4158,8 +4234,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 @@ -4851,6 +4927,7 @@ but that should be robust in the unexpected case that an error is signaled." (declare (debug t) (indent 1)) (let* ((err (make-symbol "err")) (orig-body body) + (orig-format format) (format (if (and (stringp format) body) format (prog1 "Error: %S" (if format (push format body))))) @@ -4861,7 +4938,10 @@ but that should be robust in the unexpected case that an error is signaled." (if (eq orig-body body) exp ;; The use without `format' is obsolete, let's warn when we bump ;; into any such remaining uses. - (macroexp-warn-and-return "Missing format argument" exp nil nil format)))) + (macroexp-warn-and-return + (format-message "Missing format argument in `with-demote-errors'") + exp nil nil + orig-format)))) (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. @@ -4942,21 +5022,20 @@ the function `undo--wrap-and-run-primitive-undo'." beg (marker-position end-marker) #'undo--wrap-and-run-primitive-undo - beg (marker-position end-marker) buffer-undo-list)) + beg (marker-position end-marker) + ;; We will truncate this list by side-effect below. + buffer-undo-list)) (ptr buffer-undo-list)) (if (not (eq buffer-undo-list old-bul)) (progn (while (and (not (eq (cdr ptr) old-bul)) ;; In case garbage collection has removed OLD-BUL. - (cdr ptr)) - (if (and (consp (cdr ptr)) - (consp (cadr ptr)) - (eq (caadr ptr) t)) - ;; Don't include a timestamp entry. - (setcdr ptr (cddr ptr)) - (setq ptr (cdr ptr)))) - (unless (cdr ptr) - (message "combine-change-calls: buffer-undo-list broken")) + (or (cdr ptr) + (progn + (message "combine-change-calls: buffer-undo-list broken") + nil))) + (setq ptr (cdr ptr))) + ;; Truncate the list that's in the `apply' entry. (setcdr ptr nil) (push ap-elt buffer-undo-list) (setcdr buffer-undo-list old-bul))))) @@ -5168,11 +5247,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) @@ -5443,14 +5524,14 @@ 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) "Return non-nil if PREFIX is a prefix of STRING. If IGNORE-CASE is non-nil, the comparison is done without paying attention to case differences." - (declare (pure t) (side-effect-free t)) + (declare (side-effect-free t)) (let ((prefix-length (length prefix))) (if (> prefix-length (length string)) nil (eq t (compare-strings prefix 0 prefix-length string @@ -5460,7 +5541,7 @@ to case differences." "Return non-nil if SUFFIX is a suffix of STRING. If IGNORE-CASE is non-nil, the comparison is done without paying attention to case differences." - (declare (pure t) (side-effect-free t)) + (declare (side-effect-free t)) (let ((start-pos (- (length string) (length suffix)))) (and (>= start-pos 0) (eq t (compare-strings suffix nil nil @@ -5488,6 +5569,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)) @@ -5769,6 +5851,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 @@ -6087,14 +6170,8 @@ command is called from a keyboard macro?" ;; Skip special forms (from non-compiled code). (and frame (null (car frame))) ;; Skip also `interactive-p' (because we don't want to know if - ;; interactive-p was called interactively but if it's caller was) - ;; and `byte-code' (idem; this appears in subexpressions of things - ;; like condition-case, which are wrapped in a separate bytecode - ;; chunk). - ;; FIXME: For lexical-binding code, this is much worse, - ;; because the frames look like "byte-code -> funcall -> #[...]", - ;; which is not a reliable signature. - (memq (nth 1 frame) '(interactive-p 'byte-code)) + ;; interactive-p was called interactively but if it's caller was). + (eq (nth 1 frame) 'interactive-p) ;; Skip package-specific stack-frames. (let ((skip (run-hook-with-args-until-success 'called-interactively-p-functions @@ -6137,7 +6214,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) @@ -6624,6 +6702,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))) @@ -6645,6 +6724,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))) @@ -6666,6 +6746,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))) @@ -6683,6 +6764,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 @@ -6822,6 +6904,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))) @@ -6848,6 +6931,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))) @@ -6919,6 +7003,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))) @@ -6934,27 +7019,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. @@ -7004,6 +7079,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/tab-bar.el b/lisp/tab-bar.el index 119a243d6b3..7c3069ca269 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -105,7 +105,7 @@ For easier selection of tabs by their numbers, consider customizing (const hyper) (const super) (const alt)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) ;; Reenable the tab-bar with new keybindings @@ -116,23 +116,23 @@ For easier selection of tabs by their numbers, consider customizing :version "27.1") (defun tab-bar--define-keys () - "Install key bindings for switching between tabs if the user has configured them." + "Install key bindings to switch between tabs if so configured." (when tab-bar-select-tab-modifiers (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0))) - 'tab-recent) + #'tab-recent) (dotimes (i 8) (global-set-key (vector (append tab-bar-select-tab-modifiers (list (+ i 1 ?0)))) - 'tab-bar-select-tab)) + #'tab-bar-select-tab)) (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?9))) - 'tab-last)) + #'tab-last)) ;; Don't override user customized key bindings (unless (global-key-binding [(control tab)]) - (global-set-key [(control tab)] 'tab-next)) + (global-set-key [(control tab)] #'tab-next)) (unless (global-key-binding [(control shift tab)]) - (global-set-key [(control shift tab)] 'tab-previous)) + (global-set-key [(control shift tab)] #'tab-previous)) (unless (global-key-binding [(control shift iso-lefttab)]) - (global-set-key [(control shift iso-lefttab)] 'tab-previous)) + (global-set-key [(control shift iso-lefttab)] #'tab-previous)) ;; Replace default value with a condition that supports displaying ;; global-mode-string in the tab bar instead of the mode line. @@ -157,6 +157,9 @@ For easier selection of tabs by their numbers, consider customizing (defun tab-bar--load-buttons () "Load the icons for the tab buttons." (require 'icons) + (declare-function icon-string "icons" (name)) + (declare-function iconp "icons" (object)) + (declare-function icons--register "icons") (unless (iconp 'tab-bar-new) (define-icon tab-bar-new nil `((image "tabs/new.xpm" @@ -227,7 +230,8 @@ a list of frames to update." ;; Update `default-frame-alist' (when (eq frames t) (setq default-frame-alist - (cons (cons 'tab-bar-lines (if (and tab-bar-mode (eq tab-bar-show t)) 1 0)) + (cons (cons 'tab-bar-lines + (if (and tab-bar-mode (eq tab-bar-show t)) 1 0)) (assq-delete-all 'tab-bar-lines default-frame-alist))))) (define-minor-mode tab-bar-mode @@ -279,7 +283,8 @@ It returns a list of the form (KEY KEY-BINDING CLOSE-P), where: ;; This code is used when you click the mouse in the tab bar ;; on a console which has no window system but does have a mouse. (let* ((x-position (car (posn-x-y posn))) - (keymap (lookup-key (cons 'keymap (nreverse (current-active-maps))) [tab-bar])) + (keymap (lookup-key (cons 'keymap (nreverse (current-active-maps))) + [tab-bar])) (column 0)) (when x-position (catch 'done @@ -478,7 +483,7 @@ you can use the command `toggle-frame-tab-bar'." :type '(choice (const :tag "Always" t) (const :tag "When more than one tab" 1) (const :tag "Never" nil)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (if val @@ -529,7 +534,7 @@ to get the group name." "If non-nil, show the \"New tab\" button in the tab bar. When this is nil, you can create new tabs with \\[tab-new]." :type 'boolean - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (force-mode-line-update)) @@ -550,7 +555,7 @@ If nil, don't show it at all." (const :tag "On selected tab" selected) (const :tag "On non-selected tabs" non-selected) (const :tag "None" nil)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (force-mode-line-update)) @@ -574,7 +579,7 @@ If nil, don't show it at all." This helps to select the tab by its number using `tab-bar-select-tab' and `tab-bar-select-tab-modifiers'." :type 'boolean - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (force-mode-line-update)) @@ -604,7 +609,7 @@ from all windows in the window configuration." (const :tag "All window buffers" tab-bar-tab-name-all) (function :tag "Function")) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (force-mode-line-update)) @@ -704,7 +709,7 @@ Function gets one argument: a tab." Function gets two arguments, the tab and its number, and should return the formatted tab name to display in the tab bar." :type 'function - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (force-mode-line-update)) @@ -753,7 +758,7 @@ of the mode line. Replacing `tab-bar-format-tabs' with tab-bar-format-add-tab tab-bar-format-align-right tab-bar-format-global) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (force-mode-line-update)) @@ -815,7 +820,8 @@ You can hide these buttons by customizing `tab-bar-format' and removing ,(alist-get 'binding tab) :help "Click to visit tab")))) (when (alist-get 'close-binding tab) - `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) + `((,(if (eq (car tab) 'current-tab) 'C-current-tab + (intern (format "C-tab-%i" i))) menu-item "" ,(alist-get 'close-binding tab)))))) @@ -832,7 +838,7 @@ You can hide these buttons by customizing `tab-bar-format' and removing "Function to get a tab group name. Function gets one argument: a tab." :type 'function - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (force-mode-line-update)) @@ -848,7 +854,7 @@ Function gets three arguments, a tab with a group name, its number, and an optional value that is non-nil when the tab is from the current group. It should return the formatted tab group name to display in the tab bar." :type 'function - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (force-mode-line-update)) @@ -919,7 +925,8 @@ when the tab is current. Return the result as a keymap." (when (and (not (equal previous-group tab-group)) tab-group) (tab-bar--format-tab-group tab i t)) ;; Override default tab faces to use group faces - (let ((tab-bar-tab-face-function tab-bar-tab-group-face-function)) + (let ((tab-bar-tab-face-function + tab-bar-tab-group-face-function)) (tab-bar--format-tab tab i)))) ;; Show first tab of other groups with a group name ((not (equal previous-group tab-group)) @@ -948,7 +955,8 @@ when the tab is current. Return the result as a keymap." ;; when windows are split horizontally (bug#59620) (if (window-system) `(space :align-to (- right (,hpos))) - `(space :align-to (,(- (frame-inner-width) hpos))))))) + `(space :align-to (,(- (frame-inner-width) + hpos))))))) `((align-right menu-item ,str ignore)))) (defun tab-bar-format-global () @@ -1018,7 +1026,7 @@ This variable has effect only when `tab-bar-auto-width' is non-nil." (const :tag "No limit" nil) (list (integer :tag "Max width (pixels)" :value 220) (integer :tag "Max width (chars)" :value 20))) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (setq tab-bar--auto-width-hash nil)) @@ -1087,12 +1095,14 @@ tab bar might wrap to the second line when it shouldn't.") curr-width) (cond ((< prev-width width) - (let* ((space (apply 'propertize " " + (let* ((space (apply #'propertize " " (text-properties-at 0 name))) (ins-pos (- len (if close-p 1 0))) (prev-name name)) (while continue - (setf (substring name ins-pos ins-pos) space) + (setq name (concat (substring name 0 ins-pos) + space + (substring name ins-pos))) (setq curr-width (string-pixel-width name)) (if (and (< curr-width width) (> curr-width prev-width)) @@ -1105,7 +1115,9 @@ tab bar might wrap to the second line when it shouldn't.") (let ((del-pos1 (if close-p -2 -1)) (del-pos2 (if close-p -1 nil))) (while continue - (setf (substring name del-pos1 del-pos2) "") + (setq name (concat (substring name 0 del-pos1) + (and del-pos2 + (substring name del-pos2)))) (setq curr-width (string-pixel-width name)) (if (and (> curr-width width) (< curr-width prev-width)) @@ -1309,11 +1321,13 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." (when tab-bar-history-mode (puthash (selected-frame) - (and (window-configuration-p (alist-get 'wc (car wc-history-back))) + (and (window-configuration-p + (alist-get 'wc (car wc-history-back))) wc-history-back) tab-bar-history-back) (puthash (selected-frame) - (and (window-configuration-p (alist-get 'wc (car wc-history-forward))) + (and (window-configuration-p + (alist-get 'wc (car wc-history-forward))) wc-history-forward) tab-bar-history-forward)))) @@ -1339,7 +1353,8 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." (when from-index (setf (nth from-index tabs) from-tab)) - (setf (nth to-index tabs) (tab-bar--current-tab-make (nth to-index tabs))) + (setf (nth to-index tabs) + (tab-bar--current-tab-make (nth to-index tabs))) (unless tab-bar-mode (message "Selected tab '%s'" (alist-get 'name to-tab)))) @@ -1406,7 +1421,7 @@ and rename it to NAME." (tab-bar-new-tab) (tab-bar-rename-tab name)))) -(defalias 'tab-bar-select-tab-by-name 'tab-bar-switch-to-tab) +(defalias 'tab-bar-select-tab-by-name #'tab-bar-switch-to-tab) (defun tab-bar-move-tab-to (to-number &optional from-number) @@ -1421,7 +1436,8 @@ where argument addressing is relative." (from-number (or from-number (1+ (tab-bar--current-tab-index tabs)))) (from-tab (nth (1- from-number) tabs)) (to-number (if to-number (prefix-numeric-value to-number) 1)) - (to-number (if (< to-number 0) (+ (length tabs) (1+ to-number)) to-number)) + (to-number (if (< to-number 0) (+ (length tabs) (1+ to-number)) + to-number)) (to-index (max 0 (min (1- to-number) (1- (length tabs)))))) (setq tabs (delq from-tab tabs)) (cl-pushnew from-tab (nthcdr to-index tabs)) @@ -1447,7 +1463,8 @@ Like `tab-bar-move-tab', but moves in the opposite direction." (interactive "p") (tab-bar-move-tab (- (or arg 1)))) -(defun tab-bar-move-tab-to-frame (arg &optional from-frame from-number to-frame to-number) +(defun tab-bar-move-tab-to-frame (arg &optional from-frame from-number + to-frame to-number) "Move tab from FROM-NUMBER position to new position at TO-NUMBER. FROM-NUMBER defaults to the current tab number. FROM-NUMBER and TO-NUMBER count from 1. @@ -1463,7 +1480,8 @@ to which to move the tab; ARG defaults to 1." (setq to-frame (next-frame to-frame)))) (unless (eq from-frame to-frame) (let* ((from-tabs (funcall tab-bar-tabs-function from-frame)) - (from-number (or from-number (1+ (tab-bar--current-tab-index from-tabs)))) + (from-number (or from-number + (1+ (tab-bar--current-tab-index from-tabs)))) (from-tab (nth (1- from-number) from-tabs)) (to-tabs (funcall tab-bar-tabs-function to-frame)) (to-index (max 0 (min (1- (or to-number 1)) (1- (length to-tabs)))))) @@ -1485,7 +1503,8 @@ to which to move the tab; ARG defaults to 1." FROM-NUMBER defaults to the current tab (which happens interactively)." (interactive (list (1+ (tab-bar--current-tab-index)))) (let* ((tabs (funcall tab-bar-tabs-function)) - (tab-index (1- (or from-number (1+ (tab-bar--current-tab-index tabs))))) + (tab-index (1- (or from-number + (1+ (tab-bar--current-tab-index tabs))))) (tab-name (alist-get 'name (nth tab-index tabs))) ;; On some window managers, `make-frame' selects the new frame, ;; so previously selected frame is saved to `from-frame'. @@ -1748,7 +1767,8 @@ for the last tab on a frame is determined by ;; Select another tab before deleting the current tab (let ((to-index (or (if to-number (1- to-number)) (pcase tab-bar-close-tab-select - ('left (1- (if (< current-index 1) 2 current-index))) + ('left (1- (if (< current-index 1) 2 + current-index))) ('right (if (> (length tabs) (1+ current-index)) (1+ current-index) (1- current-index))) @@ -1773,7 +1793,8 @@ for the last tab on a frame is determined by (force-mode-line-update) (unless tab-bar-mode - (message "Deleted tab and switched to %s" tab-bar-close-tab-select)))))) + (message "Deleted tab and switched to %s" + tab-bar-close-tab-select)))))) (defun tab-bar-close-tab-by-name (name) "Close the tab given its NAME. @@ -1864,7 +1885,8 @@ If NAME is the empty string, then use the automatic name function `tab-bar-tab-name-function'." (interactive (let* ((tabs (funcall tab-bar-tabs-function)) - (tab-number (or current-prefix-arg (1+ (tab-bar--current-tab-index tabs)))) + (tab-number (or current-prefix-arg + (1+ (tab-bar--current-tab-index tabs)))) (tab-name (alist-get 'name (nth (1- tab-number) tabs)))) (list (read-from-minibuffer "New name for tab (leave blank for automatic naming): " @@ -2129,10 +2151,10 @@ and can restore them." :version "29.1")) (setq tab-bar-forward-button (icon-string 'tab-bar-forward)) - (add-hook 'pre-command-hook 'tab-bar--history-pre-change) - (add-hook 'window-configuration-change-hook 'tab-bar--history-change)) - (remove-hook 'pre-command-hook 'tab-bar--history-pre-change) - (remove-hook 'window-configuration-change-hook 'tab-bar--history-change))) + (add-hook 'pre-command-hook #'tab-bar--history-pre-change) + (add-hook 'window-configuration-change-hook #'tab-bar--history-change)) + (remove-hook 'pre-command-hook #'tab-bar--history-pre-change) + (remove-hook 'window-configuration-change-hook #'tab-bar--history-change))) ;;; Non-graphical access to frame-local tabs (named window configurations) @@ -2172,8 +2194,9 @@ For more information, see the function `tab-switcher'." (tabs (sort tabs (lambda (a b) (< (alist-get 'time b) (alist-get 'time a)))))) (with-current-buffer (get-buffer-create - (format " *Tabs*<%s>" (or (frame-parameter nil 'window-id) - (frame-parameter nil 'name)))) + (format " *Tabs*<%s>" + (or (frame-parameter nil 'window-id) + (frame-parameter nil 'name)))) (setq buffer-read-only nil) (erase-buffer) (tab-switcher-mode) @@ -2188,7 +2211,8 @@ For more information, see the function `tab-switcher'." (propertize (alist-get 'name tab) 'mouse-face 'highlight - 'help-echo "mouse-2: select this window configuration")) + 'help-echo + "mouse-2: select this window configuration")) 'tab tab))) (goto-char (point-min)) (goto-char (or (next-single-property-change (point) 'tab) (point-min))) @@ -2264,8 +2288,8 @@ Interactively, ARG is the prefix numeric argument and defaults to 1." (move-to-column tab-switcher-column)) (defun tab-switcher-unmark (&optional backup) - "Cancel requested operations on window configuration on this line and move down. -With prefix arg, move up instead." + "Cancel operations on window configuration on this line and move down. +With prefix arg BACKUP, move up instead." (interactive "P") (beginning-of-line) (move-to-column tab-switcher-column) @@ -2276,7 +2300,7 @@ With prefix arg, move up instead." (move-to-column tab-switcher-column)) (defun tab-switcher-backup-unmark () - "Move up one line and cancel requested operations on window configuration there." + "Move up one line and cancel operations on window configuration there." (interactive) (forward-line -1) (tab-switcher-unmark) @@ -2284,9 +2308,10 @@ With prefix arg, move up instead." (move-to-column tab-switcher-column)) (defun tab-switcher-delete (&optional arg) - "Mark window configuration on this line to be deleted by \\<tab-switcher-mode-map>\\[tab-switcher-execute] command. + "Mark window configuration on this line to be deleted. Prefix arg says how many window configurations to delete. -Negative arg means delete backwards." +Negative arg means delete backwards. +The deletion will be done by the \\<tab-switcher-mode-map>\\[tab-switcher-execute] command." (interactive "p") (let ((buffer-read-only nil)) (if (or (null arg) (= arg 0)) @@ -2304,8 +2329,9 @@ Negative arg means delete backwards." (move-to-column tab-switcher-column))) (defun tab-switcher-delete-backwards (&optional arg) - "Mark window configuration on this line to be deleted by \\<tab-switcher-mode-map>\\[tab-switcher-execute] command. -Then move up one line. Prefix arg means move that many lines." + "Mark window configuration on this line to be deleted. +Then move up one line. Prefix arg means move that many lines. +The deletion will be done by the \\<tab-switcher-mode-map>\\[tab-switcher-execute] command." (interactive "p") (tab-switcher-delete (- (or arg 1)))) @@ -2318,7 +2344,9 @@ Then move up one line. Prefix arg means move that many lines." (tab-bar-tabs-set (delq tab (funcall tab-bar-tabs-function)))) (defun tab-switcher-execute () - "Delete window configurations marked with \\<tab-switcher-mode-map>\\[tab-switcher-delete] commands." + "Delete the marked window configurations. +Use the \\<tab-switcher-mode-map>\\[tab-switcher-delete] commands +to set those marks." (interactive) (save-excursion (goto-char (point-min)) @@ -2364,7 +2392,8 @@ with those specified by the selected window configuration." ((framep all-frames) (list all-frames)) (t (list (selected-frame))))) -(defun tab-bar-get-buffer-tab (buffer-or-name &optional all-frames ignore-current-tab all-tabs) +(defun tab-bar-get-buffer-tab (buffer-or-name + &optional all-frames ignore-current-tab all-tabs) "Return the tab that owns the window whose buffer is BUFFER-OR-NAME. BUFFER-OR-NAME may be a buffer or a buffer name, and defaults to the current buffer. @@ -2540,7 +2569,7 @@ files will be visited." (progn (setq value (nreverse value)) (switch-to-buffer-other-tab (car value)) - (mapc 'switch-to-buffer (cdr value)) + (mapc #'switch-to-buffer (cdr value)) value) (switch-to-buffer-other-tab value)))) @@ -2582,26 +2611,26 @@ When `switch-to-buffer-obey-display-actions' is non-nil, ;;; Short aliases and keybindings -(defalias 'tab-new 'tab-bar-new-tab) -(defalias 'tab-new-to 'tab-bar-new-tab-to) -(defalias 'tab-duplicate 'tab-bar-duplicate-tab) -(defalias 'tab-detach 'tab-bar-detach-tab) -(defalias 'tab-window-detach 'tab-bar-move-window-to-tab) -(defalias 'tab-close 'tab-bar-close-tab) -(defalias 'tab-close-other 'tab-bar-close-other-tabs) -(defalias 'tab-close-group 'tab-bar-close-group-tabs) -(defalias 'tab-undo 'tab-bar-undo-close-tab) -(defalias 'tab-select 'tab-bar-select-tab) -(defalias 'tab-switch 'tab-bar-switch-to-tab) -(defalias 'tab-next 'tab-bar-switch-to-next-tab) -(defalias 'tab-previous 'tab-bar-switch-to-prev-tab) -(defalias 'tab-last 'tab-bar-switch-to-last-tab) -(defalias 'tab-recent 'tab-bar-switch-to-recent-tab) -(defalias 'tab-move 'tab-bar-move-tab) -(defalias 'tab-move-to 'tab-bar-move-tab-to) -(defalias 'tab-rename 'tab-bar-rename-tab) -(defalias 'tab-group 'tab-bar-change-tab-group) -(defalias 'tab-list 'tab-switcher) +(defalias 'tab-new #'tab-bar-new-tab) +(defalias 'tab-new-to #'tab-bar-new-tab-to) +(defalias 'tab-duplicate #'tab-bar-duplicate-tab) +(defalias 'tab-detach #'tab-bar-detach-tab) +(defalias 'tab-window-detach #'tab-bar-move-window-to-tab) +(defalias 'tab-close #'tab-bar-close-tab) +(defalias 'tab-close-other #'tab-bar-close-other-tabs) +(defalias 'tab-close-group #'tab-bar-close-group-tabs) +(defalias 'tab-undo #'tab-bar-undo-close-tab) +(defalias 'tab-select #'tab-bar-select-tab) +(defalias 'tab-switch #'tab-bar-switch-to-tab) +(defalias 'tab-next #'tab-bar-switch-to-next-tab) +(defalias 'tab-previous #'tab-bar-switch-to-prev-tab) +(defalias 'tab-last #'tab-bar-switch-to-last-tab) +(defalias 'tab-recent #'tab-bar-switch-to-recent-tab) +(defalias 'tab-move #'tab-bar-move-tab) +(defalias 'tab-move-to #'tab-bar-move-tab-to) +(defalias 'tab-rename #'tab-bar-rename-tab) +(defalias 'tab-group #'tab-bar-change-tab-group) +(defalias 'tab-list #'tab-switcher) (keymap-set tab-prefix-map "n" #'tab-duplicate) (keymap-set tab-prefix-map "N" #'tab-new-to) @@ -2624,14 +2653,14 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (keymap-set tab-prefix-map "t" #'other-tab-prefix) (defvar-keymap tab-bar-switch-repeat-map - :doc "Keymap to repeat tab switch key sequences \\`C-x t o o O'. + :doc "Keymap to repeat tab switch commands `tab-next' and `tab-previous'. Used in `repeat-mode'." :repeat t "o" #'tab-next "O" #'tab-previous) (defvar-keymap tab-bar-move-repeat-map - :doc "Keymap to repeat tab move key sequences \\`C-x t m m M'. + :doc "Keymap to repeat tab move commands `tab-move' and `tab-bar-move-tab-backward'. Used in `repeat-mode'." :repeat t "m" #'tab-move 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/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el new file mode 100644 index 00000000000..58dcc7d8cad --- /dev/null +++ b/lisp/textmodes/html-ts-mode.el @@ -0,0 +1,134 @@ +;;; html-ts-mode.el --- tree-sitter support for HTML -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author : Theodor Thornhill <theo@thornhill.no> +;; Maintainer : Theodor Thornhill <theo@thornhill.no> +;; Created : January 2023 +;; Keywords : html languages tree-sitter + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; + +;;; Code: + +(require 'treesit) +(require 'sgml-mode) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-node-type "treesit.c") + +(defcustom html-ts-mode-indent-offset 2 + "Number of spaces for each indentation step in `html-ts-mode'." + :version "29.1" + :type 'integer + :safe 'integerp + :group 'html) + +(defvar html-ts-mode--indent-rules + `((html + ((parent-is "fragment") point-min 0) + ((node-is "/>") parent-bol 0) + ((node-is ">") parent-bol 0) + ((node-is "end_tag") parent-bol 0) + ((parent-is "comment") prev-adaptive-prefix 0) + ((parent-is "element") parent-bol html-ts-mode-indent-offset) + ((parent-is "script_element") parent-bol html-ts-mode-indent-offset) + ((parent-is "style_element") parent-bol html-ts-mode-indent-offset) + ((parent-is "start_tag") parent-bol html-ts-mode-indent-offset) + ((parent-is "self_closing_tag") parent-bol html-ts-mode-indent-offset))) + "Tree-sitter indent rules.") + +(defvar html-ts-mode--font-lock-settings + (treesit-font-lock-rules + :language 'html + :override t + :feature 'comment + `((comment) @font-lock-comment-face) + :language 'html + :override t + :feature 'keyword + `("doctype" @font-lock-keyword-face) + :language 'html + :override t + :feature 'definition + `((tag_name) @font-lock-function-name-face) + :language 'html + :override t + :feature 'string + `((quoted_attribute_value) @font-lock-string-face) + :language 'html + :override t + :feature 'property + `((attribute_name) @font-lock-variable-name-face)) + "Tree-sitter font-lock settings for `html-ts-mode'.") + +(defun html-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (when (equal (treesit-node-type node) "tag_name") + (treesit-node-text node t))) + +;;;###autoload +(define-derived-mode html-ts-mode html-mode "HTML" + "Major mode for editing Html, powered by tree-sitter." + :group 'html + + (unless (treesit-ready-p 'html) + (error "Tree-sitter for HTML isn't available")) + + (treesit-parser-create 'html) + + ;; Comments. + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" "text"))) + + ;; Indent. + (setq-local treesit-simple-indent-rules html-ts-mode--indent-rules) + + ;; Navigation. + (setq-local treesit-defun-type-regexp "element") + + (setq-local treesit-defun-name-function #'html-ts-mode--defun-name) + + (setq-local treesit-sentence-type-regexp "tag") + + (setq-local treesit-sexp-type-regexp + (regexp-opt '("element" + "text" + "attribute" + "value"))) + + ;; Font-lock. + (setq-local treesit-font-lock-settings html-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-feature-list + '((comment keyword definition) + (property string) + () ())) + + ;; Imenu. + (setq-local treesit-simple-imenu-settings + '(("Element" "\\`tag_name\\'" nil nil))) + (treesit-major-mode-setup)) + +(if (treesit-ready-p 'html) + (add-to-list 'auto-mode-alist '("\\.html\\'" . html-ts-mode))) + +(provide 'html-ts-mode) + +;;; html-ts-mode.el ends here 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 73abb155aaa..6c33380b6bd 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -441,13 +441,12 @@ the current paragraph with the one containing the mark." (if (< (point) (point-max)) (end-of-paragraph-text)))))) -(defun forward-sentence (&optional arg) +(defun forward-sentence-default-function (&optional arg) "Move forward to next end of sentence. With argument, repeat. When ARG is negative, move backward repeatedly to start of sentence. The variable `sentence-end' is a regular expression that matches ends of sentences. Also, every paragraph boundary terminates sentences as well." - (interactive "^p") (or arg (setq arg 1)) (let ((opoint (point)) (sentence-end (sentence-end))) @@ -477,8 +476,19 @@ 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. +See `forward-sentence' for a description of its behavior.") + +(defun forward-sentence (&optional arg) + "Move forward to next end of sentence. With argument ARG, repeat. +If ARG is negative, move backward repeatedly to start of +sentence. Delegates its work to `forward-sentence-function'." + (interactive "^p") + (or arg (setq arg 1)) + (funcall forward-sentence-function arg)) (defun count-sentences (start end) "Count sentences in current buffer from START to END." @@ -488,8 +498,13 @@ sentences. Also, every paragraph boundary terminates sentences as well." (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/thingatpt.el b/lisp/thingatpt.el index 9363a474cb5..f3367290dee 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -645,7 +645,7 @@ back from point." ;; Email addresses (defvar thing-at-point-email-regexp - "<?[-+_.~a-zA-Z][-+_.~:a-zA-Z0-9]*@[-.a-zA-Z0-9]+>?" + "<?[-+_~a-zA-Z0-9][-+_.~:a-zA-Z0-9]*@[-a-zA-Z0-9]+[-.a-zA-Z0-9]*>?" "A regular expression probably matching an email address. This does not match the real name portion, only the address, optionally with angle brackets.") 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 eb3c4ab6bca..96e711e950c 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Package-Version: 0.3.7 +;; Package-Version: 0.3.7.50 ;; Package-Requires: ((emacs "26.1")) ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -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 @@ -798,8 +799,8 @@ They become the value of this argument.") (defclass transient-columns (transient-group) () "Group class that displays elements organized in columns. Direct elements have to be groups whose elements have to be -commands or string. Each subgroup represents a column. This -class takes care of inserting the subgroups' elements.") +commands or strings. Each subgroup represents a column. +This class takes care of inserting the subgroups' elements.") (defclass transient-subgroups (transient-group) () "Group class that wraps other groups. @@ -860,7 +861,7 @@ to the setup function: (indent defun) (doc-string 3)) (pcase-let ((`(,class ,slots ,suffixes ,docstr ,body) - (transient--expand-define-args args))) + (transient--expand-define-args args arglist))) `(progn (defalias ',name ,(if body @@ -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. @@ -913,7 +902,7 @@ ARGLIST. The infix arguments are usually accessed by using (indent defun) (doc-string 3)) (pcase-let ((`(,class ,slots ,_ ,docstr ,body) - (transient--expand-define-args args))) + (transient--expand-define-args args arglist))) `(progn (defalias ',name (lambda ,arglist ,@body)) (put ',name 'interactive-only t) @@ -921,7 +910,7 @@ ARGLIST. The infix arguments are usually accessed by using (put ',name 'transient--suffix (,(or class 'transient-suffix) :command ',name ,@slots))))) -(defmacro transient-define-infix (name _arglist &rest args) +(defmacro transient-define-infix (name arglist &rest args) "Define NAME as a transient infix command. ARGLIST is always ignored and reserved for future use. @@ -962,7 +951,7 @@ keyword. (indent defun) (doc-string 3)) (pcase-let ((`(,class ,slots ,_ ,docstr ,_) - (transient--expand-define-args args))) + (transient--expand-define-args args arglist))) `(progn (defalias ',name ,(transient--default-infix-command)) (put ',name 'interactive-only t) @@ -976,11 +965,13 @@ 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]...)") -(defun transient--expand-define-args (args) +(defun transient--expand-define-args (args &optional arglist) + (unless (listp arglist) + (error "Mandatory ARGLIST is missing")) (let (class keys suffixes docstr) (when (stringp (car args)) (setq docstr (pop args))) @@ -1057,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)) @@ -1150,7 +1145,7 @@ example, sets a variable use `transient-define-infix' instead. PREFIX is a prefix command, a symbol. SUFFIX is a suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). -Intended for use in PREFIX's `:setup-children' function." +Intended for use in a group's `:setup-children' function." (eval (car (transient--parse-child prefix suffix)))) (defun transient-parse-suffixes (prefix suffixes) @@ -1158,7 +1153,7 @@ Intended for use in PREFIX's `:setup-children' function." PREFIX is a prefix command, a symbol. SUFFIXES is a list of suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). -Intended for use in PREFIX's `:setup-children' function." +Intended for use in a group's `:setup-children' function." (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes)) ;;; Edit @@ -1409,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 @@ -1469,14 +1453,25 @@ probably use this instead: (cl-check-type command command)) (if (or transient--prefix transient-current-prefix) - (cl-find-if (lambda (obj) - (eq (transient--suffix-command obj) - ;; When `this-command' is `transient-set-level', - ;; its reader needs to know what command is being - ;; configured. - (or command this-original-command))) - (or transient--suffixes - transient-current-suffixes)) + (let ((suffixes + (cl-remove-if-not + (lambda (obj) + (eq (transient--suffix-command obj) + (or command + (if (eq this-command 'transient-set-level) + ;; This is how it can look up for which + ;; command it is setting the level. + this-original-command + this-command)))) + (or transient--suffixes + transient-current-suffixes)))) + (or (and (cdr suffixes) + (cl-find-if + (lambda (obj) + (equal (listify-key-sequence (transient--kbd (oref obj key))) + (listify-key-sequence (this-command-keys)))) + suffixes)) + (car suffixes))) (when-let* ((obj (get (or command this-command) 'transient--suffix)) (obj (clone obj))) ;; Cannot use and-let* because of debbugs#31840. @@ -1518,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 @@ -1542,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)) @@ -1615,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 @@ -1689,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) @@ -1705,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))))) @@ -1733,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. @@ -1750,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)) @@ -1818,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." @@ -2030,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 @@ -2065,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))) @@ -2151,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)) @@ -2160,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")) @@ -2187,71 +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)) - post-command abort-minibuffer) - (unless abort-only - (setq post-command - (lambda () "@transient--delay-post-command" - (let ((act (and (not (eq (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)))))) - (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 (or (memq this-command transient--abort-commands) - (equal (this-command-keys) "")) - (= (minibuffer-depth) depth)))) - (transient--debug - 'abort-minibuffer - "mini: %s|%s, act %s" (minibuffer-depth) depth act) - (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 (eq (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) @@ -2272,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) @@ -2341,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) @@ -2407,6 +2405,10 @@ If there is no parent prefix, then behave like `transient--do-exit'." (transient--stack-zap) transient--exit) +(defun transient--do-leave () + "Call the command without exporting variables and exit the transient." + transient--stay) + (defun transient--do-push-button () "Call the command represented by the activated button. Use that command's pre-command to determine transient behavior." @@ -2575,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 @@ -3376,7 +3378,7 @@ have a history of their own.") (insert ?\n) (insert (propertize " " 'display `(space :align-to (,(nth (1+ c) cc))))))) - (insert (make-string (- (nth c cc) (current-column)) ?\s)) + (insert (make-string (max 1 (- (nth c cc) (current-column))) ?\s)) (when-let ((cell (nth r (nth c columns)))) (insert cell)) (when (= c (1- cs)) @@ -3819,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.") @@ -3889,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. @@ -3973,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)) @@ -4039,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)) @@ -4084,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_\\)+\\)?") @@ -4119,7 +4101,10 @@ we stop there." 'face 'transient-value)) (cl-defmethod transient-prompt ((obj transient-lisp-variable)) - (format "Set %s: " (oref obj variable))) + (if (and (slot-boundp obj 'prompt) + (oref obj prompt)) + (cl-call-next-method obj) + (format "Set %s: " (oref obj variable)))) (defun transient-lisp-variable--reader (prompt initial-input _history) (read--expression prompt initial-input)) diff --git a/lisp/treesit.el b/lisp/treesit.el index 660039cc7cc..9bb58ec4ab1 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -87,6 +87,7 @@ (declare-function treesit-search-subtree "treesit.c") (declare-function treesit-search-forward "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") +(declare-function treesit-subtree-stat "treesit.c") (declare-function treesit-available-p "treesit.c") @@ -165,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. @@ -554,7 +558,54 @@ omitted, default END to BEG." "Generic tree-sitter font-lock error" 'treesit-error) -(defvar-local treesit-font-lock-level 3 +(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'. +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) + (buffers (buffer-list))) + (if (null buffers) + (mapc (lambda (b) + (with-current-buffer b + (setq-local treesit-font-lock-level val) + (treesit-font-lock-recompute-features) + (treesit-font-lock-fontify-region (point-min) + (point-max)))) + res) + (let ((buffer (car buffers))) + (with-current-buffer buffer + (if treesit-font-lock-settings + (loop (append res (list buffer)) (cdr buffers)) + (loop res (cdr buffers))))))))) + +(defcustom treesit-font-lock-level 3 "Decoration level to be used by tree-sitter fontifications. Major modes categorize their fontification features into levels, @@ -562,16 +613,25 @@ from 1 which is the absolute minimum, to 4 that yields the maximum fontifications. Level 1 usually contains only comments and definitions. -Level 2 usually adds keywords, strings, constants, types, etc. -Level 3 usually represents a full-blown fontification, including -assignment, constants, numbers, properties, etc. +Level 2 usually adds keywords, strings, data types, etc. +Level 3 usually represents full-blown fontifications, including +assignments, constants, numbers and literals, etc. Level 4 adds everything else that can be fontified: delimiters, -operators, brackets, 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'. Changing the decoration level requires calling -`treesit-font-lock-recompute-features' to have an effect.") +`treesit-font-lock-recompute-features' to have an effect, unless +done via `customize-variable'. + +To see which syntactical categories are fontified by each level +in a particular major mode, examine the buffer-local value of the +variable `treesit-font-lock-feature-list'." + :type 'integer + :set #'treesit--font-lock-level-setter + :version "29.1") (defvar-local treesit--font-lock-query-expand-range (cons 0 0) "The amount to expand the start and end of the region when fontifying. @@ -605,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'. @@ -892,27 +928,20 @@ LIMIT is the recursion limit, which defaults to 100." (push r result)) (push child result)) (setq child (treesit-node-next-sibling child))) - ;; If NODE has no child, keep NODE. - (or result (list node)))) + ;; If NODE has no child, keep NODE. If LIMIT is exceeded, return + ;; nil. + (or result (and (> limit 0) (list node))))) (defsubst treesit--node-length (node) "Return the length of the text of NODE." (- (treesit-node-end node) (treesit-node-start node))) -(defvar-local treesit--font-lock-fast-mode nil +(defvar-local treesit--font-lock-fast-mode 'unspecified "If this variable is t, change the way we query so it's faster. This is not a general optimization and should be RARELY needed! See comments in `treesit-font-lock-fontify-region' for more detail.") -(defvar-local treesit--font-lock-fast-mode-grace-count 5 - "Grace counts before we turn on the fast mode. - -When query takes abnormally long time to execute, we turn on the -\"fast mode\", but just to be on the safe side, we only turn on -the fast mode after this number of offenses. See bug#60691, -bug#60223.") - ;; Some details worth explaining: ;; ;; 1. When we apply face to a node, we clip the face into the @@ -964,36 +993,34 @@ If LOUDLY is non-nil, display some debugging information." (enable (nth 1 setting)) (override (nth 3 setting)) (language (treesit-query-language query))) - (when-let ((nodes (list (treesit-buffer-root-node language))) - ;; Only activate if ENABLE flag is t. - (activate (eq t enable))) - (ignore activate) - ;; If we run into problematic files, use the "fast mode" to - ;; try to recover. See comment #2 above for more explanation. - (when treesit--font-lock-fast-mode - (setq nodes (treesit--children-covering-range-recurse - (car nodes) start end (* 4 jit-lock-chunk-size)))) + ;; Use deterministic way to decide whether to turn on "fast + ;; mode". (See bug#60691, bug#60223.) + (when (eq treesit--font-lock-fast-mode 'unspecified) + (pcase-let ((`(,max-depth ,max-width) + (treesit-subtree-stat + (treesit-buffer-root-node language)))) + (if (or (> max-depth 100) (> max-width 4000)) + (setq treesit--font-lock-fast-mode t) + (setq treesit--font-lock-fast-mode nil)))) + + (when-let* ((root (treesit-buffer-root-node language)) + (nodes (if (eq t treesit--font-lock-fast-mode) + (treesit--children-covering-range-recurse + root start end (* 4 jit-lock-chunk-size)) + (list (treesit-buffer-root-node language)))) + ;; Only activate if ENABLE flag is t. + (activate (eq t enable))) + (ignore activate) ;; Query each node. (dolist (sub-node nodes) (let* ((delta-start (car treesit--font-lock-query-expand-range)) (delta-end (cdr treesit--font-lock-query-expand-range)) - (start-time (current-time)) (captures (treesit-query-capture sub-node query (max (- start delta-start) (point-min)) - (min (+ end delta-end) (point-max)))) - (end-time (current-time))) - ;; If for any query the query time is strangely long, - ;; switch to fast mode (see comments above). - (when (and (null treesit--font-lock-fast-mode) - (> (time-to-seconds - (time-subtract end-time start-time)) - 0.01)) - (if (> treesit--font-lock-fast-mode-grace-count 0) - (cl-decf treesit--font-lock-fast-mode-grace-count) - (setq-local treesit--font-lock-fast-mode t))) + (min (+ end delta-end) (point-max))))) ;; For each captured node, fontify that node. (with-silent-modifications @@ -1002,12 +1029,14 @@ If LOUDLY is non-nil, display some debugging information." (node (cdr capture)) (node-start (treesit-node-start node)) (node-end (treesit-node-end node))) + ;; If node is not in the region, take them out. See ;; comment #3 above for more detail. (if (and (facep face) (or (>= start node-end) (>= node-start end))) (when (or loudly treesit--font-lock-verbose) (message "Captured node %s(%s-%s) but it is outside of fontifing region" node node-start node-end)) + (cond ((facep face) (treesit-fontify-with-override @@ -1015,6 +1044,7 @@ If LOUDLY is non-nil, display some debugging information." face override)) ((functionp face) (funcall face node override start end))) + ;; Don't raise an error if FACE is neither a face nor ;; a function. This is to allow intermediate capture ;; names used for #match and #eq. @@ -1077,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))) @@ -1156,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 @@ -1169,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 _) @@ -1232,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 @@ -1275,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. @@ -1287,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 @@ -1301,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. @@ -1466,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. @@ -1482,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))))) @@ -1639,6 +1730,47 @@ BACKWARD and ALL are the same as in `treesit-search-forward'." (goto-char current-pos))) node)) +(defvar-local treesit-sexp-type-regexp nil + "A regexp that matches the node type of sexp nodes. + +A sexp node is a node that is bigger than punctuation, and +delimits medium sized statements in the source code. It is, +however, smaller in scope than sentences. This is used by +`treesit-forward-sexp' and friends.") + +(defun treesit-forward-sexp (&optional arg) + (interactive "^p") + (or arg (setq arg 1)) + (funcall + (if (> arg 0) #'treesit-end-of-thing #'treesit-beginning-of-thing) + treesit-sexp-type-regexp (abs arg))) + +(defun treesit-transpose-sexps (&optional arg) + "Tree-sitter `transpose-sexps' function. +Arg is the same as in `transpose-sexps'. + +Locate the node closest to POINT, and transpose that node with +its sibling node ARG nodes away. + +Return a pair of positions as described by +`transpose-sexps-function' for use in `transpose-subr' and +friends." + (let* ((parent (treesit-node-parent (treesit-node-at (point)))) + (child (treesit-node-child parent 0 t))) + (named-let loop ((prev child) + (next (treesit-node-next-sibling child t))) + (when (and prev next) + (if (< (point) (treesit-node-end next)) + (if (= arg -1) + (cons (treesit-node-start prev) + (treesit-node-end prev)) + (when-let ((n (treesit-node-child + parent (+ arg (treesit-node-index prev t)) t))) + (cons (treesit-node-end n) + (treesit-node-start n)))) + (loop (treesit-node-next-sibling prev t) + (treesit-node-next-sibling next t))))))) + ;;; Navigation, defun, things ;; ;; Emacs lets you define "things" by a regexp that matches the type of @@ -1762,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. @@ -1777,9 +1922,55 @@ 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. + +A textual node is a node that is not normal code, such as +comments and multiline string literals. For example, +\"(line|block)_comment\" in the case of a comment, or +\"text_block\" in the case of a string. This is used by +`prog-fill-reindent-defun' and friends.") + +(defvar-local treesit-sentence-type-regexp nil + "A regexp that matches the node type of sentence nodes. + +A sentence node is a node that is bigger than a sexp, and +delimits larger statements in the source code. It is, however, +smaller in scope than defuns. This is used by +`treesit-forward-sentence' and friends.") + +(defun treesit-forward-sentence (&optional arg) + "Tree-sitter `forward-sentence-function' function. + +ARG is the same as in `forward-sentence'. + +If inside comment or other nodes described in +`treesit-sentence-type-regexp', use +`forward-sentence-default-function', else move across nodes as +described by `treesit-sentence-type-regexp'." + (if (string-match-p + treesit-text-type-regexp + (treesit-node-type (treesit-node-at (point)))) + (funcall #'forward-sentence-default-function arg) + (funcall + (if (> arg 0) #'treesit-end-of-thing #'treesit-beginning-of-thing) + treesit-sentence-type-regexp (abs arg)))) (defun treesit-default-defun-skipper () "Skips spaces after navigating a defun. @@ -1901,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 @@ -1953,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) @@ -1973,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)) @@ -2243,6 +2440,13 @@ before calling this function." (when treesit-defun-name-function (setq-local add-log-current-defun-function #'treesit-add-log-current-defun)) + + (when treesit-sexp-type-regexp + (setq-local forward-sexp-function #'treesit-forward-sexp)) + (setq-local transpose-sexps-function #'treesit-transpose-sexps) + (when treesit-sentence-type-regexp + (setq-local forward-sentence-function #'treesit-forward-sentence)) + ;; Imenu. (when treesit-simple-imenu-settings (setq-local imenu-create-index-function @@ -2350,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) @@ -2707,8 +2912,10 @@ See `treesit-language-source-alist' for details." (if (equal string "") nil string))) (list lang - (read-string - "Enter the URL of the Git repository of the language grammar: ") + (let ((repo-default (format "https://github.com/tree-sitter/tree-sitter-%s" lang))) + (read-string + "Enter the URL of the Git repository of the language grammar: " + (and (treesit--check-repo-url repo-default) repo-default))) (empty-string-to-nil (read-string "Enter the tag or branch (default: default branch): ")) @@ -2722,6 +2929,16 @@ See `treesit-language-source-alist' for details." (read-string "Enter the C++ compiler to use (default: auto-detect): ")))))) +(defun treesit--check-repo-url (url) + (defvar url-request-method) + (let ((url-request-method "HEAD")) + (let ((buffer (condition-case nil (url-retrieve-synchronously url t t) + (file-error nil)))) + (and buffer + (eql + (buffer-local-value 'url-http-response-status buffer) + 200))))) + ;;;###autoload (defun treesit-install-language-grammar (lang) "Build and install the tree-sitter language grammar library for LANG. @@ -2846,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))))) @@ -2914,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)) @@ -2939,10 +3166,10 @@ function signals an error." :no-value (treesit-parser-set-included-ranges parser '((1 . 4) (5 . 8)))) (treesit-parser-included-ranges :no-eval (treesit-parser-included-ranges parser) - :eg-result '((1 . 4) (5 . 8))) + :eg-result ((1 . 4) (5 . 8))) (treesit-query-range :no-eval (treesit-query-range node '((script_element) @cap)) - :eg-result-string '((1 . 4) (5 . 8))) + :eg-result ((1 . 4) (5 . 8))) "Retrieving a node" @@ -3088,7 +3315,12 @@ function signals an error." :eg-result-string "#<treesit-node (translation_unit) in 1-11>") (treesit-query-string :no-eval (treesit-query-string "int c = 0;" '((identifier) @id) 'c) - :eg-result-string "((id . #<treesit-node (identifier) in 5-6>))")) + :eg-result-string "((id . #<treesit-node (identifier) in 5-6>))") + + "Misc" + (treesit-subtree-stat + :no-eval (treesit-subtree-stat node) + :eg-result (6 33 487))) (provide 'treesit) 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-future.el b/lisp/url/url-future.el index fc852ed7c0b..9b528835a7b 100644 --- a/lisp/url/url-future.el +++ b/lisp/url/url-future.el @@ -53,7 +53,7 @@ (define-inline url-future-errored-p (url-future) (inline-quote (eq (url-future-status ,url-future) 'error))) -(define-inline url-future-cancelled-p (url-future) +(define-inline url-future-canceled-p (url-future) (inline-quote (eq (url-future-status ,url-future) 'cancel))) (defun url-future-finish (url-future &optional status) @@ -96,5 +96,8 @@ (signal 'error 'url-future-already-done) (url-future-finish url-future 'cancel))) +(define-obsolete-function-alias 'url-future-cancelled-p + #'url-future-canceled-p "30.1") + (provide 'url-future) ;;; url-future.el ends here diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index b20e5073f74..4d7297f6f2e 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -208,7 +208,7 @@ linked Emacs under SunOS 4.x." proc))) (defvar url-gw-rlogin-obsolete-warned-once nil) -(make-obsolete-variable url-gw-rlogin-obsolete-warned-once nil "29.1") +(make-obsolete-variable 'url-gw-rlogin-obsolete-warned-once nil "29.1") ;;;###autoload (defun url-open-stream (name buffer host service &optional gateway-method) @@ -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/url/url-misc.el b/lisp/url/url-misc.el index 3caaf49f58e..96f5c46ea00 100644 --- a/lisp/url/url-misc.el +++ b/lisp/url/url-misc.el @@ -48,7 +48,7 @@ nil)) (defvar url-misc-rlogin-obsolete-warned-once nil) -(make-obsolete-variable url-misc-rlogin-obsolete-warned-once nil "29.1") +(make-obsolete-variable 'url-misc-rlogin-obsolete-warned-once nil "29.1") (defun url-do-terminal-emulator (type server port user) (switch-to-buffer diff --git a/lisp/use-package/bind-key.el b/lisp/use-package/bind-key.el index 0ab72eafce2..b216c668d83 100644 --- a/lisp/use-package/bind-key.el +++ b/lisp/use-package/bind-key.el @@ -447,7 +447,7 @@ This binds keys in such a way that bindings are not overridden by other modes. See `override-global-mode'." (macroexp-progn (bind-keys-form args 'override-global-map))) -(defun get-binding-description (elem) +(defun bind-key--get-binding-description (elem) (cond ((listp elem) (cond @@ -474,7 +474,7 @@ other modes. See `override-global-mode'." (t "#<byte-compiled lambda>"))) -(defun compare-keybindings (l r) +(defun bind-key--compare-keybindings (l r) (let* ((regex bind-key-segregation-regexp) (lgroup (and (string-match regex (caar l)) (match-string 0 (caar l)))) @@ -517,7 +517,7 @@ other modes. See `override-global-mode'." (setq personal-keybindings (sort personal-keybindings (lambda (l r) - (car (compare-keybindings l r)))))) + (car (bind-key--compare-keybindings l r)))))) (if (not (eq (cdar last-binding) (cdar binding))) (princ (format "\n\n%s: %s\n%s\n\n" @@ -525,7 +525,7 @@ other modes. See `override-global-mode'." (make-string (+ 21 (car bind-key-column-widths) (cdr bind-key-column-widths)) ?-))) (if (and last-binding - (cdr (compare-keybindings last-binding binding))) + (cdr (bind-key--compare-keybindings last-binding binding))) (princ "\n"))) (let* ((key-name (caar binding)) @@ -534,10 +534,10 @@ other modes. See `override-global-mode'." (read-kbd-macro key-name))) (command (nth 1 binding)) (was-command (nth 2 binding)) - (command-desc (get-binding-description command)) + (command-desc (bind-key--get-binding-description command)) (was-command-desc (and was-command - (get-binding-description was-command))) - (at-present-desc (get-binding-description at-present))) + (bind-key--get-binding-description was-command))) + (at-present-desc (bind-key--get-binding-description at-present))) (let ((line (format (format "%%-%ds%%-%ds%%s\n" (car bind-key-column-widths) @@ -555,6 +555,11 @@ other modes. See `override-global-mode'." (setq last-binding binding))))) +(define-obsolete-function-alias 'get-binding-description + 'bind-key--get-binding-description "30.1") +(define-obsolete-function-alias 'compare-keybindings + 'bind-key--compare-keybindings "30.1") + (provide 'bind-key) ;; Local Variables: 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-bzr.el b/lisp/vc/vc-bzr.el index 6443f6d57aa..f66e37fffa4 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -381,7 +381,9 @@ If PROMPT is non-nil, prompt for the Bzr command to run." (setq-local compile-command (concat vc-bzr-program " " command " " (if args (mapconcat #'identity args " ") ""))))) - (vc-set-async-update buf)))) + (vc-set-async-update buf) + ;; Return the process for `vc-pull-and-push' + (get-buffer-process buf)))) (defun vc-bzr-pull (prompt) "Pull changes into the current Bzr branch. diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index e1a3eff448d..fd5f655a0f6 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -608,7 +608,10 @@ reverting. NOQUERY should be t *only* if it is known the only difference between the buffer and the file is due to modifications by the dispatcher client code, rather than user editing!" - (and (string= buffer-file-name file) + (and (string= buffer-file-name + (if (file-name-absolute-p file) + file + (expand-file-name file (vc-root-dir)))) (if keep (when (file-exists-p file) (when reset-vc-info @@ -643,7 +646,10 @@ editing!" (defun vc-resynch-buffer (file &optional keep noquery reset-vc-info) "If FILE is currently visited, resynch its buffer." - (if (string= buffer-file-name file) + (if (string= buffer-file-name + (if (file-name-absolute-p file) + file + (expand-file-name file (vc-root-dir)))) (vc-resynch-window file keep noquery reset-vc-info) (if (file-directory-p file) (vc-resynch-buffers-in-directory file keep noquery reset-vc-info) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 04aa37d6400..a3469b71386 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -136,12 +136,19 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches." ;;;###autoload(put 'vc-git-annotate-switches 'safe-local-variable (lambda (switches) (equal switches "-w"))) (defcustom vc-git-log-switches nil - "String or list of strings specifying switches for Git log under VC." + "String or list of strings giving Git log switches for non-shortlogs." :type '(choice (const :tag "None" nil) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) :version "28.1") +(defcustom vc-git-shortlog-switches nil + "String or list of strings giving Git log switches for shortlogs." + :type '(choice (const :tag "None" nil) + (string :tag "Argument String") + (repeat :tag "Argument List" :value ("") string)) + :version "30.1") + (defcustom vc-git-resolve-conflicts t "When non-nil, mark conflicted file as resolved upon saving. That is performed after all conflict markers in it have been @@ -308,6 +315,23 @@ Good example of file name that needs this: \"test[56].xx\".") (string-trim-right (match-string 1 version-string) "\\.") "0"))))) +(defun vc-git--git-path (&optional path) + "Resolve .git/PATH for the current working tree. +In particular, handle the case where this is a linked working +tree, such that .git is a plain file. + +See the --git-dir and --git-path options to git-rev-parse(1)." + (if (and path (not (string-empty-p path))) + ;; Canonicalize in this branch because --git-dir always returns + ;; an absolute file name. + (expand-file-name + (string-trim-right + (vc-git--run-command-string nil "rev-parse" + "--git-path" path))) + (concat (string-trim-right + (vc-git--run-command-string nil "rev-parse" "--git-dir")) + "/"))) + (defun vc-git--git-status-to-vc-state (code-list) "Convert CODE-LIST to a VC status. @@ -752,12 +776,32 @@ or an empty string if none." :help "Show the contents of the current stash")) map)) +(defun vc-git--cmds-in-progress () + "Return a list of Git commands in progress in this worktree." + (let ((gitdir (vc-git--git-path)) + cmds) + ;; See contrib/completion/git-prompt.sh in git.git. + (when (or (file-directory-p + (expand-file-name "rebase-merge" gitdir)) + (file-exists-p + (expand-file-name "rebase-apply/rebasing" gitdir))) + (push 'rebase cmds)) + (when (file-exists-p + (expand-file-name "rebase-apply/applying" gitdir)) + (push 'am cmds)) + (when (file-exists-p (expand-file-name "MERGE_HEAD" gitdir)) + (push 'merge cmds)) + (when (file-exists-p (expand-file-name "BISECT_START" gitdir)) + (push 'bisect cmds)) + cmds)) + (defun vc-git-dir-extra-headers (dir) (let ((str (with-output-to-string (with-current-buffer standard-output (vc-git--out-ok "symbolic-ref" "HEAD")))) (stash-list (vc-git-stash-list)) (default-directory dir) + (in-progress (vc-git--cmds-in-progress)) branch remote remote-url stash-button stash-string) (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) @@ -832,9 +876,9 @@ or an empty string if none." (propertize remote-url 'face 'vc-dir-header-value))) ;; For now just a heading, key bindings can be added later for various bisect actions - (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir))) + (when (memq 'bisect in-progress) (propertize "\nBisect : in progress" 'face 'vc-dir-status-warning)) - (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir))) + (when (memq 'rebase in-progress) (propertize "\nRebase : in progress" 'face 'vc-dir-status-warning)) (if stash-list (concat @@ -1015,13 +1059,26 @@ It is based on `log-edit-mode', and has Git-specific extensions." ;; message. Handle also remote files. (if (eq system-type 'windows-nt) (let ((default-directory (file-name-directory file1))) - (make-nearby-temp-file "git-msg"))))) + (make-nearby-temp-file "git-msg")))) + to-stash) (when vc-git-patch-string (unless (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet")) - ;; Check that all staged changes also exist in the patch. - ;; This is needed to allow adding/removing files that are - ;; currently staged to the index. So remove the whole file diff - ;; from the patch because commit will take it from the index. + ;; Check that what's already staged is compatible with what + ;; we want to commit (bug#60126). + ;; + ;; 1. If the changes to a file in the index are identical to + ;; the changes to that file we want to commit, remove the + ;; changes from our patch, and let the commit take them + ;; from the index. This is necessary for adding and + ;; removing files to work. + ;; + ;; 2. If the changes to a file in the index are different to + ;; changes to that file we want to commit, then we have to + ;; unstage the changes or abort. + ;; + ;; 3. If there are changes to a file in the index but we don't + ;; want to commit any changes to that file, we need to + ;; stash those changes before committing. (with-temp-buffer ;; If the user has switches like -D, -M etc. in their ;; `vc-git-diff-switches', we must pass them here too, or @@ -1032,23 +1089,35 @@ It is based on `log-edit-mode', and has Git-specific extensions." ;; Following code doesn't understand plain diff(1) output. (user-error "Cannot commit patch with nil `vc-git-diff-switches'")) (goto-char (point-min)) - (let ((pos (point)) file-diff file-beg) + (let ((pos (point)) file-name file-header file-diff file-beg) (while (not (eobp)) + (when (and (looking-at "^diff --git a/\\(.+\\) b/\\(.+\\)") + (string= (match-string 1) (match-string 2))) + (setq file-name (match-string 1))) (forward-line 1) ; skip current "diff --git" line + (setq file-header (buffer-substring pos (point))) (search-forward "diff --git" nil 'move) (move-beginning-of-line 1) (setq file-diff (buffer-substring pos (point))) - (if (and (setq file-beg (string-search - file-diff vc-git-patch-string)) - ;; Check that file diff ends with an empty string - ;; or the beginning of the next file diff. - (string-match-p "\\`\\'\\|\\`diff --git" - (substring - vc-git-patch-string - (+ file-beg (length file-diff))))) - (setq vc-git-patch-string - (string-replace file-diff "" vc-git-patch-string)) - (user-error "Index not empty")) + (cond ((and (setq file-beg (string-search + file-diff vc-git-patch-string)) + ;; Check that file diff ends with an empty string + ;; or the beginning of the next file diff. + (string-match-p "\\`\\'\\|\\`diff --git" + (substring + vc-git-patch-string + (+ file-beg (length file-diff))))) + (setq vc-git-patch-string + (string-replace file-diff "" vc-git-patch-string))) + ((string-match (format "^%s" (regexp-quote file-header)) + vc-git-patch-string) + (if (and file-name + (yes-or-no-p + (format "Unstage already-staged changes to %s?" + file-name))) + (vc-git-command nil 0 file-name "reset" "-q" "--") + (user-error "Index not empty"))) + (t (push file-name to-stash))) (setq pos (point)))))) (unless (string-empty-p vc-git-patch-string) (let ((patch-file (make-nearby-temp-file "git-patch"))) @@ -1056,7 +1125,8 @@ It is based on `log-edit-mode', and has Git-specific extensions." (insert vc-git-patch-string)) (unwind-protect (vc-git-command nil 0 patch-file "apply" "--cached") - (delete-file patch-file))))) + (delete-file patch-file)))) + (when to-stash (vc-git--stash-staged-changes files))) (cl-flet ((boolean-arg-fn (argument) (lambda (value) (when (equal value "yes") (list argument))))) @@ -1082,7 +1152,58 @@ It is based on `log-edit-mode', and has Git-specific extensions." args) (unless vc-git-patch-string (if only (list "--only" "--") '("-a")))))) - (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file)))) + (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file)) + (when to-stash + (let ((cached (make-nearby-temp-file "git-cached"))) + (unwind-protect + (progn (with-temp-file cached + (vc-git-command t 0 nil "stash" "show" "-p")) + (vc-git-command nil 0 cached "apply" "--cached")) + (delete-file cached)) + (vc-git-command nil 0 nil "stash" "drop"))))) + +(defun vc-git--stash-staged-changes (files) + "Stash only the staged changes to FILES." + ;; This is necessary because even if you pass a list of file names + ;; to 'git stash push', it will stash any and all staged changes. + (unless (zerop + (vc-git-command nil t files "diff" "--cached" "--quiet")) + (cl-flet + ((git-string (&rest args) + (string-trim-right + (with-output-to-string + (apply #'vc-git-command standard-output 0 nil args))))) + (let ((cached (make-nearby-temp-file "git-cached")) + (message "Previously staged changes") + tree) + ;; Use a temporary index to create a tree object corresponding + ;; to the staged changes to FILES. + (unwind-protect + (progn + (with-temp-file cached + (vc-git-command t 0 files "diff" "--cached" "--")) + (let* ((index (make-nearby-temp-file "git-index")) + (process-environment + (cons (format "GIT_INDEX_FILE=%s" index) + process-environment))) + (unwind-protect + (progn + (vc-git-command nil 0 nil "read-tree" "HEAD") + (vc-git-command nil 0 cached "apply" "--cached") + (setq tree (git-string "write-tree"))) + (delete-file index)))) + (delete-file cached)) + ;; Prepare stash commit object, which has a special structure. + (let* ((tree-commit (git-string "commit-tree" "-m" message + "-p" "HEAD" tree)) + (stash-commit (git-string "commit-tree" "-m" message + "-p" "HEAD" "-p" tree-commit + tree))) + ;; Push the new stash entry. + (vc-git-command nil 0 nil "update-ref" "--create-reflog" + "-m" message "refs/stash" stash-commit) + ;; Unstage the changes we've now stashed. + (vc-git-command nil 0 files "reset" "--")))))) (defun vc-git-find-revision (file rev buffer) (let* (process-file-side-effects @@ -1168,6 +1289,7 @@ If PROMPT is non-nil, prompt for the Git command to run." (lambda (_name-of-mode) buffer) nil)))) (vc-set-async-update buffer) + ;; Return the process for `vc-pull-and-push' proc)) (defun vc-git-pull (prompt) @@ -1192,8 +1314,7 @@ This prompts for a branch to merge from." (completing-read "Merge from branch: " (if (or (member "FETCH_HEAD" branches) (not (file-readable-p - (expand-file-name ".git/FETCH_HEAD" - root)))) + (vc-git--git-path "FETCH_HEAD")))) branches (cons "FETCH_HEAD" branches)) nil t))) @@ -1238,8 +1359,7 @@ This prompts for a branch to merge from." (unless (or (not (eq vc-git-resolve-conflicts 'unstage-maybe)) ;; Doing a merge, so bug#20292 doesn't apply. - (file-exists-p (expand-file-name ".git/MERGE_HEAD" - (vc-git-root buffer-file-name))) + (file-exists-p (vc-git--git-path "MERGE_HEAD")) (vc-git-conflicted-files (vc-git-root buffer-file-name))) (vc-git-command nil 0 nil "reset")) (vc-resynch-buffer buffer-file-name t t) @@ -1314,7 +1434,8 @@ If LIMIT is a revision string, use it as an end-revision." ,(format "--pretty=tformat:%s" (car vc-git-root-log-format)) "--abbrev-commit")) - (ensure-list vc-git-log-switches) + (ensure-list + (if shortlog vc-git-shortlog-switches vc-git-log-switches)) (when (numberp limit) (list "-n" (format "%s" limit))) (when start-revision @@ -1329,16 +1450,16 @@ If LIMIT is a revision string, use it as an end-revision." (defun vc-git-log-outgoing (buffer remote-location) (vc-setup-buffer buffer) - (vc-git-command - buffer 'async nil - "log" - "--no-color" "--graph" "--decorate" "--date=short" - (format "--pretty=tformat:%s" (car vc-git-root-log-format)) - "--abbrev-commit" - (concat (if (string= remote-location "") - "@{upstream}" - remote-location) - "..HEAD"))) + (apply #'vc-git-command buffer 'async nil + `("log" + "--no-color" "--graph" "--decorate" "--date=short" + ,(format "--pretty=tformat:%s" (car vc-git-root-log-format)) + "--abbrev-commit" + ,@(ensure-list vc-git-shortlog-switches) + ,(concat (if (string= remote-location "") + "@{upstream}" + remote-location) + "..HEAD")))) (defun vc-git-log-incoming (buffer remote-location) (vc-setup-buffer buffer) @@ -1348,15 +1469,15 @@ If LIMIT is a revision string, use it as an end-revision." ;; so remove everything except a repository name. (replace-regexp-in-string "/.*" "" remote-location))) - (vc-git-command - buffer 'async nil - "log" - "--no-color" "--graph" "--decorate" "--date=short" - (format "--pretty=tformat:%s" (car vc-git-root-log-format)) - "--abbrev-commit" - (concat "HEAD.." (if (string= remote-location "") - "@{upstream}" - remote-location)))) + (apply #'vc-git-command buffer 'async nil + `("log" + "--no-color" "--graph" "--decorate" "--date=short" + ,(format "--pretty=tformat:%s" (car vc-git-root-log-format)) + "--abbrev-commit" + ,@(ensure-list vc-git-shortlog-switches) + ,(concat "HEAD.." (if (string= remote-location "") + "@{upstream}" + remote-location))))) (defun vc-git-log-search (buffer pattern) "Search the log of changes for PATTERN and output results into BUFFER. @@ -1367,6 +1488,7 @@ 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." (let ((args `("log" "--no-color" "-i" + ,@(ensure-list vc-git-log-switches) ,(format "--grep=%s" (or pattern ""))))) (when current-prefix-arg (setq args (cdr (split-string @@ -1414,11 +1536,11 @@ log entries." `((,log-view-message-re (1 'change-log-acknowledgment))) ;; Handle the case: ;; user: foo@bar - '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" + '(("^\\(?:Author\\|Commit\\):[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" (1 'change-log-email)) ;; Handle the case: ;; user: FirstName LastName <foo@bar> - ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" + ("^\\(?:Author\\|Commit\\):[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" (1 'change-log-name) (2 'change-log-email)) ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" @@ -1429,7 +1551,7 @@ log entries." ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)" (1 'change-log-acknowledgment) (2 'change-log-acknowledgment)) - ("^\\(?:Date: \\|AuthorDate: \\)\\(.+\\)" (1 'change-log-date)) + ("^\\(?:Date: \\|AuthorDate: \\|CommitDate: \\)\\(.+\\)" (1 'change-log-date)) ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) @@ -1451,7 +1573,11 @@ or BRANCH^ (where \"^\" can be repeated)." (defun vc-git-expanded-log-entry (revision) (with-temp-buffer - (apply #'vc-git-command t nil nil (list "log" revision "-1" "--no-color" "--")) + (apply #'vc-git-command t nil nil + `("log" + ,revision + "-1" "--no-color" ,@(ensure-list vc-git-log-switches) + "--")) (goto-char (point-min)) (unless (eobp) ;; Indent the expanded log entry. @@ -1650,7 +1776,8 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (if branchp "branch" "tag")))) (if branchp (vc-git-command nil 0 nil "checkout" "-b" name - (when (and start-point (not (eq start-point ""))) + (when (and start-point + (not (equal start-point ""))) start-point)) (vc-git-command nil 0 nil "tag" name))))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index d4a3280f1bd..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)) @@ -3064,7 +3086,8 @@ On a distributed version control system, this runs a \"pull\" operation on the current branch, prompting for the precise command if required. Optional prefix ARG non-nil forces a prompt for the VCS command to run. If this is successful, a \"push\" -operation will then be done. +operation will then be done. This is supported only in backends +where the pull operation returns a process. On a non-distributed version control system, this signals an error. It also signals an error in a Bazaar bound branch." @@ -3380,7 +3403,7 @@ If nil, no default will be used. This option may be set locally." (declare-function message--name-table "message" (orig-string)) (declare-function mml-attach-buffer "mml" - (buffer &optional type description disposition)) + (buffer &optional type description disposition filename)) (declare-function log-view-get-marked "log-view" ()) (defun vc-default-prepare-patch (_backend rev) @@ -3421,6 +3444,19 @@ of the current file." (and-let* ((file (buffer-file-name))) (vc-working-revision file))))) +(defun vc--subject-to-file-name (subject) + "Generate a file name for a patch with subject line SUBJECT." + (let* ((stripped + (replace-regexp-in-string "\\`\\[.*PATCH.*\\]\\s-*" "" + subject)) + (truncated (if (length> stripped 50) + (substring stripped 0 50) + stripped))) + (concat + (string-trim (replace-regexp-in-string "\\W" "-" truncated) + "-+" "-+") + ".patch"))) + ;;;###autoload (defun vc-prepare-patch (addressee subject revisions) "Compose an Email sending patches for REVISIONS to ADDRESSEE. @@ -3431,7 +3467,7 @@ revision, with SUBJECT derived from each revision subject. When invoked with a numerical prefix argument, use the last N revisions. When invoked interactively in a Log View buffer with -marked revisions, use those these." +marked revisions, use those." (interactive (let ((revs (vc-prepare-patch-prompt-revisions)) to) (require 'message) @@ -3477,11 +3513,17 @@ marked revisions, use those these." (rfc822-goto-eoh) (forward-line) (save-excursion - (dolist (patch patches) - (mml-attach-buffer (buffer-name (plist-get patch :buffer)) - "text/x-patch" - (plist-get patch :subject) - "attachment"))) + (let ((i 0)) + (dolist (patch patches) + (let* ((patch-subject (plist-get patch :subject)) + (filename + (vc--subject-to-file-name patch-subject))) + (mml-attach-buffer + (buffer-name (plist-get patch :buffer)) + "text/x-patch" + patch-subject + "attachment" + (format "%04d-%s" (cl-incf i) filename)))))) (open-line 2))))) (defun vc-default-responsible-p (_backend _file) @@ -3622,7 +3664,7 @@ it indicates a specific revision to check out." "Default `last-change' implementation. It returns the last revision that changed LINE number in FILE." (unless (file-exists-p file) - (signal 'file-error "File doesn't exist")) + (signal 'file-error '("File doesn't exist"))) (with-temp-buffer (vc-call-backend (vc-backend file) 'annotate-command file (current-buffer)) 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/whitespace.el b/lisp/whitespace.el index 9995706a5da..86fc179396e 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1014,34 +1014,11 @@ See also `whitespace-newline' and `whitespace-display-mappings'." ;;;###autoload -(define-minor-mode global-whitespace-mode - "Toggle whitespace visualization globally (Global Whitespace mode). - -See also `whitespace-style', `whitespace-newline' and -`whitespace-display-mappings'." - :lighter " WS" +(define-globalized-minor-mode global-whitespace-mode + whitespace-mode + whitespace-turn-on-if-enabled :init-value nil - :global t - :group 'whitespace - (cond - (noninteractive ; running a batch job - (setq global-whitespace-mode nil)) - (global-whitespace-mode ; global-whitespace-mode on - (save-current-buffer - (add-hook 'find-file-hook 'whitespace-turn-on-if-enabled) - (add-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled) - (dolist (buffer (buffer-list)) ; adjust all local mode - (set-buffer buffer) - (unless whitespace-mode - (whitespace-turn-on-if-enabled))))) - (t ; global-whitespace-mode off - (save-current-buffer - (remove-hook 'find-file-hook 'whitespace-turn-on-if-enabled) - (remove-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled) - (dolist (buffer (buffer-list)) ; adjust all local mode - (set-buffer buffer) - (unless whitespace-mode - (whitespace-turn-off))))))) + :group 'whitespace) (defvar whitespace-enable-predicate (lambda () @@ -1067,7 +1044,7 @@ This variable is normally modified via `add-function'.") (defun whitespace-turn-on-if-enabled () (when (funcall whitespace-enable-predicate) - (whitespace-turn-on))) + (whitespace-mode))) ;;;###autoload (define-minor-mode global-whitespace-newline-mode @@ -2511,7 +2488,7 @@ purposes)." (setq whitespace-display-table-was-local t) ;; Save the old table so we can restore it when ;; `whitespace-mode' is switched off again. - (when (or whitespace-mode global-whitespace-mode) + (when whitespace-mode (setq whitespace-display-table (copy-sequence buffer-display-table))) ;; Assure `buffer-display-table' is unique diff --git a/lisp/window.el b/lisp/window.el index 84f5c5c3f5a..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 @@ -5670,9 +5668,11 @@ the original point in both windows." (defun split-window-below (&optional size window-to-split) "Split WINDOW-TO-SPLIT into two windows, one above the other. -WINDOW-TO-SPLIT defaults to the selected window and and will be above -the other window after splitting. The newly split-off window is -below and displays the same buffer. Return the new window. +WINDOW-TO-SPLIT defaults to the selected window if omitted or nil. +The newly created window will be below WINDOW-TO-SPLIT and will show +the same buffer as WINDOW-TO-SPLIT, if it is a live window, else the +buffer shown in the WINDOW-TO-SPLIT's frame's selected window. +Return the new window. If optional argument SIZE is omitted or nil, both windows get the same height, or close to it. If SIZE is positive, the upper @@ -5735,9 +5735,11 @@ handled as in `split-window-below'." (defun split-window-right (&optional size window-to-split) "Split WINDOW-TO-SPLIT into two side-by-side windows. -WINDOW-TO-SPLIT defaults to the selected window and and will be on the -left after splitting. The newly split-off window is on the right and -displays the same buffer. Return the new window. +WINDOW-TO-SPLIT defaults to the selected window if omitted or nil. +The newly created window will be to the right of WINDOW-TO-SPLIT and +will show the same buffer as WINDOW-TO-SPLIT, if it is a live window, +else the buffer shown in the WINDOW-TO-SPLIT's frame's selected window. +Return the new window. If optional argument SIZE is omitted or nil, both windows get the same width, or close to it. If SIZE is positive, the left-hand @@ -7270,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) @@ -7277,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 @@ -8498,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. @@ -8530,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))) @@ -8560,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 @@ -10563,8 +10697,7 @@ displaying that processes's buffer." (define-key ctl-x-4-map "4" 'other-window-prefix) (defvar-keymap other-window-repeat-map - :doc "Keymap to repeat `other-window' key sequences. -Used in `repeat-mode'." + :doc "Keymap to repeat `other-window'. Used in `repeat-mode'." :repeat t "o" #'other-window "O" (lambda () @@ -10574,6 +10707,8 @@ Used in `repeat-mode'." (defvar-keymap resize-window-repeat-map :doc "Keymap to repeat window resizing commands. +Repeatable commands are `enlarge-window' and `shrink-window', +and also `enlarge-window-horizontally' and `shrink-window-horizontally'. Used in `repeat-mode'." :repeat t ;; Standard keys: 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/xt-mouse.el b/lisp/xt-mouse.el index adfa480bc0f..4ccd35d5277 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -151,16 +151,22 @@ If `xterm-mouse-utf-8' was non-nil when `turn-on-xterm-mouse-tracking-on-terminal' was called, reads the coordinate as an UTF-8 code unit sequence; otherwise, reads a single byte." - (let ((previous-keyboard-coding-system (keyboard-coding-system))) + (let ((previous-keyboard-coding-system (keyboard-coding-system)) + (utf-8-p (terminal-parameter nil 'xterm-mouse-utf-8)) + ;; Prevent conversions inside 'read-char' due to input method, + ;; when we call 'read-char' below with 2nd argument non-nil. + (input-method-function nil)) (unwind-protect (progn - (set-keyboard-coding-system - (if (terminal-parameter nil 'xterm-mouse-utf-8) - 'utf-8-unix - 'no-conversion)) - ;; Wait only a little; we assume that the entire escape sequence - ;; has already been sent when this function is called. - (read-char nil nil 0.1)) + (set-keyboard-coding-system (if utf-8-p 'utf-8-unix 'no-conversion)) + (read-char nil + ;; Force 'read-char' to decode UTF-8 sequences if + ;; 'xterm-mouse-utf-8' is non-nil. + utf-8-p + ;; Wait only a little; we assume that the entire + ;; escape sequence has already been sent when + ;; this function is called. + 0.1)) (set-keyboard-coding-system previous-keyboard-coding-system)))) ;; In default mode, each numeric parameter of XTerm's mouse report is 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/acl.m4 b/m4/acl.m4 index 98362858ce5..dc9853a156d 100644 --- a/m4/acl.m4 +++ b/m4/acl.m4 @@ -1,5 +1,5 @@ # acl.m4 - check for access control list (ACL) primitives -# serial 24 +# serial 27 # Copyright (C) 2002, 2004-2023 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation @@ -17,7 +17,7 @@ AC_DEFUN([gl_FUNC_ACL_ARG], ]) -AC_DEFUN([gl_FUNC_ACL], +AC_DEFUN_ONCE([gl_FUNC_ACL], [ AC_REQUIRE([gl_FUNC_ACL_ARG]) AC_CHECK_FUNCS_ONCE([fchmod]) @@ -139,7 +139,9 @@ int type = ACL_TYPE_EXTENDED;]])], AC_MSG_WARN([AC_PACKAGE_NAME will be built without ACL support.]) fi fi - test -n "$gl_need_lib_has_acl" && LIB_HAS_ACL=$LIB_ACL + if test -n "$gl_need_lib_has_acl"; then + FILE_HAS_ACL_LIB=$LIB_ACL + fi AC_SUBST([LIB_ACL]) AC_DEFINE_UNQUOTED([USE_ACL], [$use_acl], [Define to nonzero if you want access control list support.]) @@ -197,15 +199,15 @@ AC_DEFUN([gl_FILE_HAS_ACL], [gl_cv_getxattr_with_posix_acls=yes])]) fi if test "$gl_cv_getxattr_with_posix_acls" = yes; then - LIB_HAS_ACL= + FILE_HAS_ACL_LIB= AC_DEFINE([GETXATTR_WITH_POSIX_ACLS], 1, [Define to 1 if getxattr works with XATTR_NAME_POSIX_ACL_ACCESS and XATTR_NAME_POSIX_ACL_DEFAULT.]) else dnl Set gl_need_lib_has_acl to a nonempty value, so that any - dnl later gl_FUNC_ACL call will set LIB_HAS_ACL=$LIB_ACL. + dnl later gl_FUNC_ACL call will set FILE_HAS_ACL_LIB=$LIB_ACL. gl_need_lib_has_acl=1 - LIB_HAS_ACL=$LIB_ACL + FILE_HAS_ACL_LIB=$LIB_ACL fi - AC_SUBST([LIB_HAS_ACL]) + AC_SUBST([FILE_HAS_ACL_LIB]) ]) diff --git a/m4/alloca.m4 b/m4/alloca.m4 index 75851875910..c685fac918a 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -1,6 +1,6 @@ # alloca.m4 serial 21 -dnl Copyright (C) 2002-2004, 2006-2007, 2009-2023 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2004, 2006-2007, 2009-2023 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/assert_h.m4 b/m4/assert_h.m4 index 6275f633a69..d255855d313 100644 --- a/m4/assert_h.m4 +++ b/m4/assert_h.m4 @@ -18,7 +18,7 @@ AC_DEFUN([gl_ASSERT_H], [AC_LANG_PROGRAM( [[#if defined __clang__ && __STDC_VERSION__ < 202311 #pragma clang diagnostic error "-Wc2x-extensions" - #pragma clang diagnostic error "-Wc++17-extensions" + #pragma clang diagnostic error "-Wc++1z-extensions" #endif #ifdef INCLUDE_ASSERT_H #include <assert.h> @@ -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,10 +60,13 @@ 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 - #undef static_assert + #undef/**/static_assert #define static_assert _Static_assert #endif #endif]) diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4 index 03cb0aec93f..d319645fd3f 100644 --- a/m4/canonicalize.m4 +++ b/m4/canonicalize.m4 @@ -1,4 +1,4 @@ -# canonicalize.m4 serial 37 +# canonicalize.m4 serial 38 dnl Copyright (C) 2003-2007, 2009-2023 Free Software Foundation, Inc. @@ -12,7 +12,8 @@ AC_DEFUN([gl_FUNC_CANONICALIZE_FILENAME_MODE], [ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK]) - AC_CHECK_FUNCS_ONCE([canonicalize_file_name faccessat]) + AC_CHECK_FUNCS_ONCE([canonicalize_file_name]) + gl_CHECK_FUNCS_ANDROID([faccessat], [[#include <unistd.h>]]) AC_REQUIRE([gl_DOUBLE_SLASH_ROOT]) AC_REQUIRE([gl_FUNC_REALPATH_WORKS]) if test $ac_cv_func_canonicalize_file_name = no; then @@ -58,7 +59,8 @@ AC_DEFUN([gl_CANONICALIZE_LGPL_SEPARATE], [ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK]) - AC_CHECK_FUNCS_ONCE([canonicalize_file_name faccessat]) + AC_CHECK_FUNCS_ONCE([canonicalize_file_name]) + gl_CHECK_FUNCS_ANDROID([faccessat], [[#include <unistd.h>]]) dnl On native Windows, we use _getcwd(), regardless whether getcwd() is dnl available through the linker option '-loldnames'. diff --git a/m4/clock_time.m4 b/m4/clock_time.m4 index 411e0710e7f..d624a73d35d 100644 --- a/m4/clock_time.m4 +++ b/m4/clock_time.m4 @@ -1,14 +1,14 @@ -# clock_time.m4 serial 11 +# clock_time.m4 serial 12 dnl Copyright (C) 2002-2006, 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, dnl with or without modifications, as long as this notice is preserved. # Check for clock_getres, clock_gettime and clock_settime, -# and set LIB_CLOCK_GETTIME. +# and set CLOCK_TIME_LIB. # For a program named, say foo, you should add a line like the following # in the corresponding Makefile.am file: -# foo_LDADD = $(LDADD) $(LIB_CLOCK_GETTIME) +# foo_LDADD = $(LDADD) $(CLOCK_TIME_LIB) AC_DEFUN([gl_CLOCK_TIME], [ @@ -21,12 +21,15 @@ AC_DEFUN([gl_CLOCK_TIME], # Save and restore LIBS so e.g., -lrt, isn't added to it. Otherwise, *all* # programs in the package would end up linked with that potentially-shared # library, inducing unnecessary run-time overhead. - LIB_CLOCK_GETTIME= - AC_SUBST([LIB_CLOCK_GETTIME]) + CLOCK_TIME_LIB= + AC_SUBST([CLOCK_TIME_LIB]) gl_saved_libs=$LIBS AC_SEARCH_LIBS([clock_gettime], [rt posix4], [test "$ac_cv_search_clock_gettime" = "none required" || - LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime]) + CLOCK_TIME_LIB=$ac_cv_search_clock_gettime]) AC_CHECK_FUNCS([clock_getres clock_gettime clock_settime]) LIBS=$gl_saved_libs + # For backward compatibility. + LIB_CLOCK_GETTIME="$CLOCK_TIME_LIB" + AC_SUBST([LIB_CLOCK_GETTIME]) ]) diff --git a/m4/d-type.m4 b/m4/d-type.m4 index 05eb8ac0cfa..3f63bbe78ee 100644 --- a/m4/d-type.m4 +++ b/m4/d-type.m4 @@ -5,8 +5,7 @@ dnl dnl Check whether struct dirent has a member named d_type. dnl -# Copyright (C) 1997, 1999-2004, 2006, 2009-2023 Free Software -# Foundation, Inc. +# Copyright (C) 1997, 1999-2004, 2006, 2009-2023 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/dup2.m4 b/m4/dup2.m4 index 8a040d4c369..e1cc73e18db 100644 --- a/m4/dup2.m4 +++ b/m4/dup2.m4 @@ -1,6 +1,5 @@ #serial 27 -dnl Copyright (C) 2002, 2005, 2007, 2009-2023 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005, 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, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/euidaccess.m4 b/m4/euidaccess.m4 index 0dc757820ee..7429779c152 100644 --- a/m4/euidaccess.m4 +++ b/m4/euidaccess.m4 @@ -1,4 +1,4 @@ -# euidaccess.m4 serial 15 +# euidaccess.m4 serial 17 dnl Copyright (C) 2002-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, @@ -32,7 +32,7 @@ AC_DEFUN([gl_FUNC_EUIDACCESS], # Prerequisites of lib/euidaccess.c. AC_DEFUN([gl_PREREQ_EUIDACCESS], [ dnl Prefer POSIX faccessat over non-standard euidaccess. - AC_CHECK_FUNCS_ONCE([faccessat]) + gl_CHECK_FUNCS_ANDROID([faccessat], [[#include <unistd.h>]]) dnl Try various other non-standard fallbacks. AC_CHECK_HEADERS([libgen.h]) AC_FUNC_GETGROUPS @@ -41,12 +41,15 @@ AC_DEFUN([gl_PREREQ_EUIDACCESS], [ # Save and restore LIBS so -lgen isn't added to it. Otherwise, *all* # programs in the package would end up linked with that potentially-shared # library, inducing unnecessary run-time overhead. - LIB_EACCESS= - AC_SUBST([LIB_EACCESS]) + EUIDACCESS_LIBGEN= + AC_SUBST([EUIDACCESS_LIBGEN]) gl_saved_libs=$LIBS AC_SEARCH_LIBS([eaccess], [gen], [test "$ac_cv_search_eaccess" = "none required" || - LIB_EACCESS=$ac_cv_search_eaccess]) + EUIDACCESS_LIBGEN=$ac_cv_search_eaccess]) AC_CHECK_FUNCS([eaccess]) LIBS=$gl_saved_libs + # For backward compatibility. + LIB_EACCESS="$EUIDACCESS_LIBGEN" + AC_SUBST([LIB_EACCESS]) ]) diff --git a/m4/extensions.m4 b/m4/extensions.m4 index 6596e7efc06..5336b8daf7e 100644 --- a/m4/extensions.m4 +++ b/m4/extensions.m4 @@ -1,4 +1,4 @@ -# serial 22 -*- Autoconf -*- +# serial 23 -*- Autoconf -*- # Enable extensions on systems that normally disable them. # Copyright (C) 2003, 2006-2023 Free Software Foundation, Inc. @@ -31,7 +31,7 @@ m4_ifndef([AC_CHECK_INCLUDES_DEFAULT], # its dependencies. This will ensure that the gl_USE_SYSTEM_EXTENSIONS # invocation occurs in gl_EARLY, not in gl_INIT. -m4_version_prereq([2.70.1], [], [ +m4_version_prereq([2.72], [], [ # AC_USE_SYSTEM_EXTENSIONS # ------------------------ @@ -113,11 +113,15 @@ AH_VERBATIM([USE_SYSTEM_EXTENSIONS], #ifndef __STDC_WANT_IEC_60559_DFP_EXT__ # undef __STDC_WANT_IEC_60559_DFP_EXT__ #endif +/* Enable extensions specified by C23 Annex F. */ +#ifndef __STDC_WANT_IEC_60559_EXT__ +# undef __STDC_WANT_IEC_60559_EXT__ +#endif /* Enable extensions specified by ISO/IEC TS 18661-4:2015. */ #ifndef __STDC_WANT_IEC_60559_FUNCS_EXT__ # undef __STDC_WANT_IEC_60559_FUNCS_EXT__ #endif -/* Enable extensions specified by ISO/IEC TS 18661-3:2015. */ +/* Enable extensions specified by C23 Annex H and ISO/IEC TS 18661-3:2015. */ #ifndef __STDC_WANT_IEC_60559_TYPES_EXT__ # undef __STDC_WANT_IEC_60559_TYPES_EXT__ #endif @@ -187,6 +191,7 @@ dnl it should only be defined when necessary. AC_DEFINE([__STDC_WANT_IEC_60559_ATTRIBS_EXT__]) AC_DEFINE([__STDC_WANT_IEC_60559_BFP_EXT__]) AC_DEFINE([__STDC_WANT_IEC_60559_DFP_EXT__]) + AC_DEFINE([__STDC_WANT_IEC_60559_EXT__]) AC_DEFINE([__STDC_WANT_IEC_60559_FUNCS_EXT__]) AC_DEFINE([__STDC_WANT_IEC_60559_TYPES_EXT__]) AC_DEFINE([__STDC_WANT_LIB_EXT2__]) diff --git a/m4/faccessat.m4 b/m4/faccessat.m4 index 934c1f41546..a858bfee33d 100644 --- a/m4/faccessat.m4 +++ b/m4/faccessat.m4 @@ -1,4 +1,4 @@ -# serial 10 +# serial 12 # See if we need to provide faccessat replacement. dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. @@ -16,9 +16,12 @@ AC_DEFUN([gl_FUNC_FACCESSAT], dnl Persuade glibc <unistd.h> to declare faccessat(). AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([faccessat]) + gl_CHECK_FUNCS_ANDROID([faccessat], [[#include <unistd.h>]]) if test $ac_cv_func_faccessat = no; then HAVE_FACCESSAT=0 + case "$gl_cv_onwards_func_faccessat" in + future*) REPLACE_FACCESSAT=1 ;; + esac else case $gl_cv_func_lstat_dereferences_slashed_symlink in *yes) ;; diff --git a/m4/fchmodat.m4 b/m4/fchmodat.m4 index 7a3ee863e3c..5356da40bae 100644 --- a/m4/fchmodat.m4 +++ b/m4/fchmodat.m4 @@ -1,4 +1,4 @@ -# fchmodat.m4 serial 7 +# fchmodat.m4 serial 8 dnl Copyright (C) 2004-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, @@ -97,6 +97,6 @@ AC_DEFUN([gl_FUNC_FCHMODAT], # Prerequisites of lib/fchmodat.c. AC_DEFUN([gl_PREREQ_FCHMODAT], [ - AC_CHECK_FUNCS_ONCE([readlinkat]) + gl_CHECK_FUNCS_ANDROID([readlinkat], [[#include <unistd.h>]]) : ]) 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/filemode.m4 b/m4/filemode.m4 index 2fcc69d119b..3cafc5cd1e1 100644 --- a/m4/filemode.m4 +++ b/m4/filemode.m4 @@ -1,6 +1,5 @@ # filemode.m4 serial 9 -dnl Copyright (C) 2002, 2005-2006, 2009-2023 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 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, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/fsusage.m4 b/m4/fsusage.m4 index aeb3467a272..88f3ca817cb 100644 --- a/m4/fsusage.m4 +++ b/m4/fsusage.m4 @@ -1,8 +1,7 @@ # serial 35 # Obtaining file system usage information. -# Copyright (C) 1997-1998, 2000-2001, 2003-2023 Free Software -# Foundation, Inc. +# Copyright (C) 1997-1998, 2000-2001, 2003-2023 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/futimens.m4 b/m4/futimens.m4 index 3aaa10a0b52..dc0b21b9d51 100644 --- a/m4/futimens.m4 +++ b/m4/futimens.m4 @@ -1,4 +1,4 @@ -# serial 9 +# serial 11 # See if we need to provide futimens replacement. dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. @@ -13,9 +13,12 @@ AC_DEFUN([gl_FUNC_FUTIMENS], AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS]) AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([futimens]) + gl_CHECK_FUNCS_ANDROID([futimens], [[#include <sys/stat.h>]]) if test $ac_cv_func_futimens = no; then HAVE_FUTIMENS=0 + case "$gl_cv_onwards_func_futimens" in + future*) REPLACE_FUTIMENS=1 ;; + esac else AC_CACHE_CHECK([whether futimens works], [gl_cv_func_futimens_works], diff --git a/m4/getgroups.m4 b/m4/getgroups.m4 index d5a18ea88b0..241fec88e3c 100644 --- a/m4/getgroups.m4 +++ b/m4/getgroups.m4 @@ -3,8 +3,7 @@ dnl From Jim Meyering. dnl A wrapper around AC_FUNC_GETGROUPS. -# Copyright (C) 1996-1997, 1999-2004, 2008-2023 Free Software -# Foundation, Inc. +# Copyright (C) 1996-1997, 1999-2004, 2008-2023 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 index 7097e5dd512..ee83b32f1e0 100644 --- a/m4/getloadavg.m4 +++ b/m4/getloadavg.m4 @@ -1,13 +1,13 @@ # Check for getloadavg. -# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2023 Free -# Software Foundation, Inc. +# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2023 Free Software +# Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -#serial 10 +#serial 12 # Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent. # New applications should use gl_GETLOADAVG instead. @@ -25,8 +25,13 @@ gl_save_LIBS=$LIBS # getloadavg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0, # NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. HAVE_GETLOADAVG=1 -AC_CHECK_FUNC([getloadavg], [], - [gl_func_getloadavg_done=no +gl_CHECK_FUNCS_ANDROID([getloadavg], [[#include <stdlib.h>]]) +if test $ac_cv_func_getloadavg != yes; then + case "$gl_cv_onwards_func_getloadavg" in + future*) REPLACE_GETLOADAVG=1 ;; + esac + + gl_func_getloadavg_done=no # Some systems with -lutil have (and need) -lkvm as well, some do not. # On Solaris, -lkvm requires nlist from -lelf, so check that first @@ -73,7 +78,8 @@ AC_CHECK_FUNC([getloadavg], [], AC_DEFINE([DGUX], [1], [Define to 1 for DGUX with <sys/dg_sys_info.h>.]) AC_CHECK_LIB([dgc], [dg_sys_info])]) fi - fi]) + fi +fi if test "x$gl_save_LIBS" = x; then GETLOADAVG_LIBS=$LIBS diff --git a/m4/getrandom.m4 b/m4/getrandom.m4 index 95111567d79..7b7f9ce2ee8 100644 --- a/m4/getrandom.m4 +++ b/m4/getrandom.m4 @@ -1,4 +1,4 @@ -# getrandom.m4 serial 8 +# getrandom.m4 serial 11 dnl Copyright 2020-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, @@ -9,9 +9,18 @@ dnl Written by Paul Eggert. AC_DEFUN([gl_FUNC_GETRANDOM], [ AC_REQUIRE([gl_SYS_RANDOM_H_DEFAULTS]) - AC_CHECK_FUNCS_ONCE([getrandom]) + gl_CHECK_FUNCS_ANDROID([getrandom], + [[/* Additional includes are needed before <sys/random.h> on uClibc + and Mac OS X. */ + #include <sys/types.h> + #include <stdlib.h> + #include <sys/random.h> + ]]) if test "$ac_cv_func_getrandom" != yes; then HAVE_GETRANDOM=0 + case "$gl_cv_onwards_func_getrandom" in + future*) REPLACE_GETRANDOM=1 ;; + esac else dnl On Solaris 11.4 the return type is 'int', not 'ssize_t'. AC_CACHE_CHECK([whether getrandom is compatible with its GNU+BSD signature], @@ -56,13 +65,16 @@ AC_DEFUN([gl_FUNC_GETRANDOM], if test $gl_cv_lib_assume_bcrypt = yes; then AC_DEFINE([HAVE_LIB_BCRYPT], [1], [Define to 1 if the bcrypt library is guaranteed to be present.]) - LIB_GETRANDOM='-lbcrypt' + GETRANDOM_LIB='-lbcrypt' else - LIB_GETRANDOM='-ladvapi32' + GETRANDOM_LIB='-ladvapi32' fi ;; *) - LIB_GETRANDOM= ;; + GETRANDOM_LIB= ;; esac + AC_SUBST([GETRANDOM_LIB]) + dnl For backward compatibility. + LIB_GETRANDOM="$GETRANDOM_LIB" AC_SUBST([LIB_GETRANDOM]) ]) diff --git a/m4/gettime.m4 b/m4/gettime.m4 index 39067be6fa8..ec1f97ee0d5 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,6 +1,5 @@ -# gettime.m4 serial 12 -dnl Copyright (C) 2002, 2004-2006, 2009-2023 Free Software Foundation, -dnl Inc. +# gettime.m4 serial 14 +dnl Copyright (C) 2002, 2004-2006, 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, dnl with or without modifications, as long as this notice is preserved. @@ -19,25 +18,45 @@ AC_DEFUN([gl_GETTIME], ]) dnl Tests whether the function timespec_get exists. -dnl Sets gl_cv_func_timespec_get. +dnl Sets gl_cv_func_timespec_get and gl_cv_onwards_func_timespec_get. AC_DEFUN([gl_CHECK_FUNC_TIMESPEC_GET], [ + AC_REQUIRE([AC_CANONICAL_HOST]) + dnl Persuade OpenBSD <time.h> to declare timespec_get(). AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) dnl We can't use AC_CHECK_FUNC here, because timespec_get() is defined as a dnl static inline function in <time.h> on MSVC 14. - AC_CACHE_CHECK([for timespec_get], [gl_cv_func_timespec_get], - [AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include <time.h> - struct timespec ts; - ]], - [[return timespec_get (&ts, 0);]]) - ], - [gl_cv_func_timespec_get=yes], - [gl_cv_func_timespec_get=no]) + dnl But at the same time, we need to notice a missing declaration, like + dnl gl_CHECK_FUNCS_ANDROID does. + AC_CHECK_DECL([timespec_get], , , [[#include <time.h>]]) + AC_CACHE_CHECK([for timespec_get], [gl_cv_onwards_func_timespec_get], + [if test $ac_cv_have_decl_timespec_get = yes; then + AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include <time.h> + struct timespec ts; + ]], + [[return timespec_get (&ts, 0);]]) + ], + [gl_cv_onwards_func_timespec_get=yes], + [gl_cv_onwards_func_timespec_get=no]) + else + gl_cv_onwards_func_timespec_get=no + fi + case "$host_os" in + linux*-android*) + if test $gl_cv_onwards_func_timespec_get = no; then + gl_cv_onwards_func_timespec_get='future OS version' + fi + ;; + esac ]) + case "$gl_cv_onwards_func_timespec_get" in + future*) gl_cv_func_timespec_get=no ;; + *) gl_cv_func_timespec_get=$gl_cv_onwards_func_timespec_get ;; + esac ]) AC_DEFUN([gl_GETTIME_RES], diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4 index 66231e0174f..5051d61cc87 100644 --- a/m4/gettimeofday.m4 +++ b/m4/gettimeofday.m4 @@ -1,7 +1,6 @@ # serial 29 -# Copyright (C) 2001-2003, 2005, 2007, 2009-2023 Free Software -# Foundation, Inc. +# Copyright (C) 2001-2003, 2005, 2007, 2009-2023 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 70e9105bee1..c84a2afd9c5 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 74 +# 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, @@ -38,6 +38,11 @@ AC_DEFUN([gl_COMMON_BODY], [ AIX system header files and several gnulib header files use precisely this syntax with 'extern'. */ # define _Noreturn [[noreturn]] +# elif (defined __clang__ && __clang_major__ < 16 \ + && defined _GL_WORK_AROUND_LLVM_BUG_59792) + /* Compile with -D_GL_WORK_AROUND_LLVM_BUG_59792 to work around + that rare LLVM bug, though you may get many false-alarm warnings. */ +# define _Noreturn # elif ((!defined __cplusplus || defined __clang__) \ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ || (!defined __STRICT_ANSI__ \ @@ -71,7 +76,7 @@ AC_DEFUN([gl_COMMON_BODY], [ && (!defined __clang_minor__ \ || (defined __apple_build_version__ \ ? 6000000 <= __apple_build_version__ \ - : 3 < __clang_major__ + (5 <= __clang_minor__)))) + : 5 <= __clang_major__))) # define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) #else # define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr @@ -105,14 +110,10 @@ AC_DEFUN([gl_COMMON_BODY], [ # define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4) #endif -#ifdef __has_c_attribute -# if ((defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) <= 201710 \ - && _GL_GNUC_PREREQ (4, 6)) -# pragma GCC diagnostic ignored "-Wpedantic" -# endif -# define _GL_HAS_C_ATTRIBUTE(attr) __has_c_attribute (__##attr##__) -#else -# define _GL_HAS_C_ATTRIBUTE(attr) 0 +/* Disable GCC -Wpedantic if using __has_c_attribute and this is not C23+. */ +#if (defined __has_c_attribute && _GL_GNUC_PREREQ (4, 6) \ + && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) <= 201710) +# pragma GCC diagnostic ignored "-Wpedantic" #endif ]dnl There is no _GL_ATTRIBUTE_ALIGNED; use stdalign's alignas instead. @@ -123,29 +124,35 @@ AC_DEFUN([gl_COMMON_BODY], [ by the Nth argument of the function is the size of the returned memory block. */ /* Applies to: function, pointer to function, function types. */ -#if _GL_HAS_ATTRIBUTE (alloc_size) -# define _GL_ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args)) -#else -# define _GL_ATTRIBUTE_ALLOC_SIZE(args) +#ifndef _GL_ATTRIBUTE_ALLOC_SIZE +# if _GL_HAS_ATTRIBUTE (alloc_size) +# define _GL_ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args)) +# else +# define _GL_ATTRIBUTE_ALLOC_SIZE(args) +# endif #endif /* _GL_ATTRIBUTE_ALWAYS_INLINE tells that the compiler should always inline the function and report an error if it cannot do so. */ /* Applies to: function. */ -#if _GL_HAS_ATTRIBUTE (always_inline) -# define _GL_ATTRIBUTE_ALWAYS_INLINE __attribute__ ((__always_inline__)) -#else -# define _GL_ATTRIBUTE_ALWAYS_INLINE +#ifndef _GL_ATTRIBUTE_ALWAYS_INLINE +# if _GL_HAS_ATTRIBUTE (always_inline) +# define _GL_ATTRIBUTE_ALWAYS_INLINE __attribute__ ((__always_inline__)) +# else +# define _GL_ATTRIBUTE_ALWAYS_INLINE +# endif #endif /* _GL_ATTRIBUTE_ARTIFICIAL declares that the function is not important to show in stack traces when debugging. The compiler should omit the function from stack traces. */ /* Applies to: function. */ -#if _GL_HAS_ATTRIBUTE (artificial) -# define _GL_ATTRIBUTE_ARTIFICIAL __attribute__ ((__artificial__)) -#else -# define _GL_ATTRIBUTE_ARTIFICIAL +#ifndef _GL_ATTRIBUTE_ARTIFICIAL +# if _GL_HAS_ATTRIBUTE (artificial) +# define _GL_ATTRIBUTE_ARTIFICIAL __attribute__ ((__artificial__)) +# else +# define _GL_ATTRIBUTE_ARTIFICIAL +# endif #endif /* _GL_ATTRIBUTE_COLD declares that the function is rarely executed. */ @@ -153,14 +160,16 @@ AC_DEFUN([gl_COMMON_BODY], [ /* Avoid __attribute__ ((cold)) on MinGW; see thread starting at <https://lists.gnu.org/r/emacs-devel/2019-04/msg01152.html>. Also, Oracle Studio 12.6 requires 'cold' not '__cold__'. */ -#if _GL_HAS_ATTRIBUTE (cold) && !defined __MINGW32__ -# ifndef __SUNPRO_C -# define _GL_ATTRIBUTE_COLD __attribute__ ((__cold__)) +#ifndef _GL_ATTRIBUTE_COLD +# if _GL_HAS_ATTRIBUTE (cold) && !defined __MINGW32__ +# ifndef __SUNPRO_C +# define _GL_ATTRIBUTE_COLD __attribute__ ((__cold__)) +# else +# define _GL_ATTRIBUTE_COLD __attribute__ ((cold)) +# endif # else -# define _GL_ATTRIBUTE_COLD __attribute__ ((cold)) +# define _GL_ATTRIBUTE_COLD # endif -#else -# define _GL_ATTRIBUTE_COLD #endif /* _GL_ATTRIBUTE_CONST declares that it is OK for a compiler to omit duplicate @@ -170,10 +179,12 @@ AC_DEFUN([gl_COMMON_BODY], [ forever, and does not call longjmp. (This attribute is stricter than _GL_ATTRIBUTE_PURE.) */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (const) -# define _GL_ATTRIBUTE_CONST __attribute__ ((__const__)) -#else -# define _GL_ATTRIBUTE_CONST +#ifndef _GL_ATTRIBUTE_CONST +# if _GL_HAS_ATTRIBUTE (const) +# define _GL_ATTRIBUTE_CONST __attribute__ ((__const__)) +# else +# define _GL_ATTRIBUTE_CONST +# endif #endif /* _GL_ATTRIBUTE_DEALLOC (F, I) declares that the function returns pointers @@ -182,16 +193,25 @@ AC_DEFUN([gl_COMMON_BODY], [ _GL_ATTRIBUTE_DEALLOC_FREE declares that the function returns pointers that can be freed via 'free'; it can be used only after declaring 'free'. */ /* Applies to: functions. Cannot be used on inline functions. */ -#if _GL_GNUC_PREREQ (11, 0) -# define _GL_ATTRIBUTE_DEALLOC(f, i) __attribute__ ((__malloc__ (f, i))) -#else -# define _GL_ATTRIBUTE_DEALLOC(f, i) +#ifndef _GL_ATTRIBUTE_DEALLOC +# if _GL_GNUC_PREREQ (11, 0) +# define _GL_ATTRIBUTE_DEALLOC(f, i) __attribute__ ((__malloc__ (f, i))) +# else +# define _GL_ATTRIBUTE_DEALLOC(f, i) +# endif #endif /* If gnulib's <string.h> or <wchar.h> has already defined this macro, continue to use this earlier definition, since <stdlib.h> may not have been included yet. */ #ifndef _GL_ATTRIBUTE_DEALLOC_FREE -# define _GL_ATTRIBUTE_DEALLOC_FREE _GL_ATTRIBUTE_DEALLOC (free, 1) +# if defined __cplusplus && defined __GNUC__ && !defined __clang__ +/* Work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=108231> */ +# define _GL_ATTRIBUTE_DEALLOC_FREE \ + _GL_ATTRIBUTE_DEALLOC ((void (*) (void *)) free, 1) +# else +# define _GL_ATTRIBUTE_DEALLOC_FREE \ + _GL_ATTRIBUTE_DEALLOC (free, 1) +# endif #endif /* _GL_ATTRIBUTE_DEPRECATED: Declares that an entity is deprecated. @@ -202,12 +222,18 @@ AC_DEFUN([gl_COMMON_BODY], [ - enumeration, enumeration item, - typedef, in C++ also: namespace, class, template specialization. */ -#if _GL_HAS_C_ATTRIBUTE (deprecated) -# define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]] -#elif _GL_HAS_ATTRIBUTE (deprecated) -# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__)) -#else -# define _GL_ATTRIBUTE_DEPRECATED +#ifndef _GL_ATTRIBUTE_DEPRECATED +# ifdef __has_c_attribute +# if __has_c_attribute (__deprecated__) +# define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]] +# endif +# endif +# if !defined _GL_ATTRIBUTE_DEPRECATED && _GL_HAS_ATTRIBUTE (deprecated) +# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__)) +# endif +# ifndef _GL_ATTRIBUTE_DEPRECATED +# define _GL_ATTRIBUTE_DEPRECATED +# endif #endif /* _GL_ATTRIBUTE_ERROR(msg) requests an error if a function is called and @@ -215,24 +241,28 @@ AC_DEFUN([gl_COMMON_BODY], [ _GL_ATTRIBUTE_WARNING(msg) requests a warning if a function is called and the function call is not optimized away. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (error) -# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__error__ (msg))) -# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__warning__ (msg))) -#elif _GL_HAS_ATTRIBUTE (diagnose_if) -# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__diagnose_if__ (1, msg, "error"))) -# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__diagnose_if__ (1, msg, "warning"))) -#else -# define _GL_ATTRIBUTE_ERROR(msg) -# define _GL_ATTRIBUTE_WARNING(msg) +#if !(defined _GL_ATTRIBUTE_ERROR && defined _GL_ATTRIBUTE_WARNING) +# if _GL_HAS_ATTRIBUTE (error) +# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__error__ (msg))) +# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__warning__ (msg))) +# elif _GL_HAS_ATTRIBUTE (diagnose_if) +# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__diagnose_if__ (1, msg, "error"))) +# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__diagnose_if__ (1, msg, "warning"))) +# else +# define _GL_ATTRIBUTE_ERROR(msg) +# define _GL_ATTRIBUTE_WARNING(msg) +# endif #endif /* _GL_ATTRIBUTE_EXTERNALLY_VISIBLE declares that the entity should remain visible to debuggers etc., even with '-fwhole-program'. */ /* Applies to: functions, variables. */ -#if _GL_HAS_ATTRIBUTE (externally_visible) -# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE __attribute__ ((externally_visible)) -#else -# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE +#ifndef _GL_ATTRIBUTE_EXTERNALLY_VISIBLE +# if _GL_HAS_ATTRIBUTE (externally_visible) +# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE __attribute__ ((externally_visible)) +# else +# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE +# endif #endif /* _GL_ATTRIBUTE_FALLTHROUGH declares that it is not a programming mistake if @@ -240,12 +270,18 @@ AC_DEFUN([gl_COMMON_BODY], [ 'default' label. The compiler should not warn in this case. */ /* Applies to: Empty statement (;), inside a 'switch' statement. */ /* Always expands to something. */ -#if _GL_HAS_C_ATTRIBUTE (fallthrough) -# define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]] -#elif _GL_HAS_ATTRIBUTE (fallthrough) -# define _GL_ATTRIBUTE_FALLTHROUGH __attribute__ ((__fallthrough__)) -#else -# define _GL_ATTRIBUTE_FALLTHROUGH ((void) 0) +#ifndef _GL_ATTRIBUTE_FALLTHROUGH +# ifdef __has_c_attribute +# if __has_c_attribute (__fallthrough__) +# define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]] +# endif +# endif +# if !defined _GL_ATTRIBUTE_FALLTHROUGH && _GL_HAS_ATTRIBUTE (fallthrough) +# define _GL_ATTRIBUTE_FALLTHROUGH __attribute__ ((__fallthrough__)) +# endif +# ifndef _GL_ATTRIBUTE_FALLTHROUGH +# define _GL_ATTRIBUTE_FALLTHROUGH ((void) 0) +# endif #endif /* _GL_ATTRIBUTE_FORMAT ((ARCHETYPE, STRING-INDEX, FIRST-TO-CHECK)) @@ -259,10 +295,12 @@ AC_DEFUN([gl_COMMON_BODY], [ If FIRST-TO-CHECK is not 0, arguments starting at FIRST-TO_CHECK are suitable for the format string. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (format) -# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec)) -#else -# define _GL_ATTRIBUTE_FORMAT(spec) +#ifndef _GL_ATTRIBUTE_FORMAT +# if _GL_HAS_ATTRIBUTE (format) +# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec)) +# else +# define _GL_ATTRIBUTE_FORMAT(spec) +# endif #endif /* _GL_ATTRIBUTE_LEAF declares that if the function is called from some other @@ -270,19 +308,23 @@ AC_DEFUN([gl_COMMON_BODY], [ exception handling. This declaration lets the compiler optimize that unit more aggressively. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (leaf) -# define _GL_ATTRIBUTE_LEAF __attribute__ ((__leaf__)) -#else -# define _GL_ATTRIBUTE_LEAF +#ifndef _GL_ATTRIBUTE_LEAF +# if _GL_HAS_ATTRIBUTE (leaf) +# define _GL_ATTRIBUTE_LEAF __attribute__ ((__leaf__)) +# else +# define _GL_ATTRIBUTE_LEAF +# endif #endif /* _GL_ATTRIBUTE_MALLOC declares that the function returns a pointer to freshly allocated memory. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (malloc) -# define _GL_ATTRIBUTE_MALLOC __attribute__ ((__malloc__)) -#else -# define _GL_ATTRIBUTE_MALLOC +#ifndef _GL_ATTRIBUTE_MALLOC +# if _GL_HAS_ATTRIBUTE (malloc) +# define _GL_ATTRIBUTE_MALLOC __attribute__ ((__malloc__)) +# else +# define _GL_ATTRIBUTE_MALLOC +# endif #endif /* _GL_ATTRIBUTE_MAY_ALIAS declares that pointers to the type may point to the @@ -290,10 +332,12 @@ AC_DEFUN([gl_COMMON_BODY], [ strict aliasing optimization. */ /* Applies to: types. */ /* Oracle Studio 12.6 mishandles may_alias despite __has_attribute OK. */ -#if _GL_HAS_ATTRIBUTE (may_alias) && !defined __SUNPRO_C -# define _GL_ATTRIBUTE_MAY_ALIAS __attribute__ ((__may_alias__)) -#else -# define _GL_ATTRIBUTE_MAY_ALIAS +#ifndef _GL_ATTRIBUTE_MAY_ALIAS +# if _GL_HAS_ATTRIBUTE (may_alias) && !defined __SUNPRO_C +# define _GL_ATTRIBUTE_MAY_ALIAS __attribute__ ((__may_alias__)) +# else +# define _GL_ATTRIBUTE_MAY_ALIAS +# endif #endif /* _GL_ATTRIBUTE_MAYBE_UNUSED declares that it is not a programming mistake if @@ -305,13 +349,24 @@ AC_DEFUN([gl_COMMON_BODY], [ - enumeration, enumeration item, - typedef, in C++ also: class. */ -/* In C++ and C2x, this is spelled [[__maybe_unused__]]. +/* In C++ and C23, this is spelled [[__maybe_unused__]]. GCC's syntax is __attribute__ ((__unused__)). - clang supports both syntaxes. */ -#if _GL_HAS_C_ATTRIBUTE (maybe_unused) -# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]] -#else -# define _GL_ATTRIBUTE_MAYBE_UNUSED _GL_ATTRIBUTE_UNUSED + clang supports both syntaxes. Except that with clang ≥ 6, < 10, in C++ mode, + __has_c_attribute (__maybe_unused__) yields true but the use of + [[__maybe_unused__]] nevertheless produces a warning. */ +#ifndef _GL_ATTRIBUTE_MAYBE_UNUSED +# if defined __clang__ && defined __cplusplus +# if !defined __apple_build_version__ && __clang_major__ >= 10 +# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]] +# endif +# elif defined __has_c_attribute +# if __has_c_attribute (__maybe_unused__) +# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]] +# endif +# endif +# ifndef _GL_ATTRIBUTE_MAYBE_UNUSED +# define _GL_ATTRIBUTE_MAYBE_UNUSED _GL_ATTRIBUTE_UNUSED +# endif #endif /* Alternative spelling of this macro, for convenience and for compatibility with glibc/include/libc-symbols.h. */ @@ -323,21 +378,38 @@ AC_DEFUN([gl_COMMON_BODY], [ discard the return value. The compiler may warn if the caller does not use the return value, unless the caller uses something like ignore_value. */ /* Applies to: function, enumeration, class. */ -#if _GL_HAS_C_ATTRIBUTE (nodiscard) -# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]] -#elif _GL_HAS_ATTRIBUTE (warn_unused_result) -# define _GL_ATTRIBUTE_NODISCARD __attribute__ ((__warn_unused_result__)) -#else -# define _GL_ATTRIBUTE_NODISCARD +#ifndef _GL_ATTRIBUTE_NODISCARD +# if defined __clang__ && defined __cplusplus + /* With clang up to 15.0.6 (at least), in C++ mode, [[__nodiscard__]] produces + a warning. + The 1000 below means a yet unknown threshold. When clang++ version X + starts supporting [[__nodiscard__]] without warning about it, you can + replace the 1000 with X. */ +# if __clang_major__ >= 1000 +# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]] +# endif +# elif defined __has_c_attribute +# if __has_c_attribute (__nodiscard__) +# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]] +# endif +# endif +# if !defined _GL_ATTRIBUTE_NODISCARD && _GL_HAS_ATTRIBUTE (warn_unused_result) +# define _GL_ATTRIBUTE_NODISCARD __attribute__ ((__warn_unused_result__)) +# endif +# ifndef _GL_ATTRIBUTE_NODISCARD +# define _GL_ATTRIBUTE_NODISCARD +# endif #endif /* _GL_ATTRIBUTE_NOINLINE tells that the compiler should not inline the function. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (noinline) -# define _GL_ATTRIBUTE_NOINLINE __attribute__ ((__noinline__)) -#else -# define _GL_ATTRIBUTE_NOINLINE +#ifndef _GL_ATTRIBUTE_NOINLINE +# if _GL_HAS_ATTRIBUTE (noinline) +# define _GL_ATTRIBUTE_NOINLINE __attribute__ ((__noinline__)) +# else +# define _GL_ATTRIBUTE_NOINLINE +# endif #endif /* _GL_ATTRIBUTE_NONNULL ((N1, N2,...)) declares that the arguments N1, N2,... @@ -345,20 +417,24 @@ AC_DEFUN([gl_COMMON_BODY], [ _GL_ATTRIBUTE_NONNULL () declares that all pointer arguments must not be null. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (nonnull) -# define _GL_ATTRIBUTE_NONNULL(args) __attribute__ ((__nonnull__ args)) -#else -# define _GL_ATTRIBUTE_NONNULL(args) +#ifndef _GL_ATTRIBUTE_NONNULL +# if _GL_HAS_ATTRIBUTE (nonnull) +# define _GL_ATTRIBUTE_NONNULL(args) __attribute__ ((__nonnull__ args)) +# else +# define _GL_ATTRIBUTE_NONNULL(args) +# endif #endif /* _GL_ATTRIBUTE_NONSTRING declares that the contents of a character array is not meant to be NUL-terminated. */ /* Applies to: struct/union members and variables that are arrays of element type '[[un]signed] char'. */ -#if _GL_HAS_ATTRIBUTE (nonstring) -# define _GL_ATTRIBUTE_NONSTRING __attribute__ ((__nonstring__)) -#else -# define _GL_ATTRIBUTE_NONSTRING +#ifndef _GL_ATTRIBUTE_NONSTRING +# if _GL_HAS_ATTRIBUTE (nonstring) +# define _GL_ATTRIBUTE_NONSTRING __attribute__ ((__nonstring__)) +# else +# define _GL_ATTRIBUTE_NONSTRING +# endif #endif /* There is no _GL_ATTRIBUTE_NORETURN; use _Noreturn instead. */ @@ -366,10 +442,12 @@ AC_DEFUN([gl_COMMON_BODY], [ /* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (nothrow) && !defined __cplusplus -# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) -#else -# define _GL_ATTRIBUTE_NOTHROW +#ifndef _GL_ATTRIBUTE_NOTHROW +# if _GL_HAS_ATTRIBUTE (nothrow) && !defined __cplusplus +# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif #endif /* _GL_ATTRIBUTE_PACKED declares: @@ -378,10 +456,12 @@ AC_DEFUN([gl_COMMON_BODY], [ minimizing the memory required. */ /* Applies to: struct members, struct, union, in C++ also: class. */ -#if _GL_HAS_ATTRIBUTE (packed) -# define _GL_ATTRIBUTE_PACKED __attribute__ ((__packed__)) -#else -# define _GL_ATTRIBUTE_PACKED +#ifndef _GL_ATTRIBUTE_PACKED +# if _GL_HAS_ATTRIBUTE (packed) +# define _GL_ATTRIBUTE_PACKED __attribute__ ((__packed__)) +# else +# define _GL_ATTRIBUTE_PACKED +# endif #endif /* _GL_ATTRIBUTE_PURE declares that It is OK for a compiler to omit duplicate @@ -391,19 +471,23 @@ AC_DEFUN([gl_COMMON_BODY], [ observable state, and always returns exactly once. (This attribute is looser than _GL_ATTRIBUTE_CONST.) */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (pure) -# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__)) -#else -# define _GL_ATTRIBUTE_PURE +#ifndef _GL_ATTRIBUTE_PURE +# if _GL_HAS_ATTRIBUTE (pure) +# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__)) +# else +# define _GL_ATTRIBUTE_PURE +# endif #endif /* _GL_ATTRIBUTE_RETURNS_NONNULL declares that the function's return value is a non-NULL pointer. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (returns_nonnull) -# define _GL_ATTRIBUTE_RETURNS_NONNULL __attribute__ ((__returns_nonnull__)) -#else -# define _GL_ATTRIBUTE_RETURNS_NONNULL +#ifndef _GL_ATTRIBUTE_RETURNS_NONNULL +# if _GL_HAS_ATTRIBUTE (returns_nonnull) +# define _GL_ATTRIBUTE_RETURNS_NONNULL __attribute__ ((__returns_nonnull__)) +# else +# define _GL_ATTRIBUTE_RETURNS_NONNULL +# endif #endif /* _GL_ATTRIBUTE_SENTINEL(pos) declares that the variadic function expects a @@ -411,17 +495,21 @@ AC_DEFUN([gl_COMMON_BODY], [ _GL_ATTRIBUTE_SENTINEL () - The last argument is NULL (requires C99). _GL_ATTRIBUTE_SENTINEL ((N)) - The (N+1)st argument from the end is NULL. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (sentinel) -# define _GL_ATTRIBUTE_SENTINEL(pos) __attribute__ ((__sentinel__ pos)) -#else -# define _GL_ATTRIBUTE_SENTINEL(pos) +#ifndef _GL_ATTRIBUTE_SENTINEL +# if _GL_HAS_ATTRIBUTE (sentinel) +# define _GL_ATTRIBUTE_SENTINEL(pos) __attribute__ ((__sentinel__ pos)) +# else +# define _GL_ATTRIBUTE_SENTINEL(pos) +# endif #endif /* A helper macro. Don't use it directly. */ -#if _GL_HAS_ATTRIBUTE (unused) -# define _GL_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) -#else -# define _GL_ATTRIBUTE_UNUSED +#ifndef _GL_ATTRIBUTE_UNUSED +# if _GL_HAS_ATTRIBUTE (unused) +# define _GL_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) +# else +# define _GL_ATTRIBUTE_UNUSED +# endif #endif ]dnl There is no _GL_ATTRIBUTE_VISIBILITY; see m4/visibility.m4 instead. @@ -432,10 +520,12 @@ AC_DEFUN([gl_COMMON_BODY], [ /* Applies to: label (both in C and C++). */ /* Note that g++ < 4.5 does not support the '__attribute__ ((__unused__)) ;' syntax. But clang does. */ -#if !(defined __cplusplus && !_GL_GNUC_PREREQ (4, 5)) || defined __clang__ -# define _GL_UNUSED_LABEL _GL_ATTRIBUTE_UNUSED -#else -# define _GL_UNUSED_LABEL +#ifndef _GL_UNUSED_LABEL +# if !(defined __cplusplus && !_GL_GNUC_PREREQ (4, 5)) || defined __clang__ +# define _GL_UNUSED_LABEL _GL_ATTRIBUTE_UNUSED +# else +# define _GL_UNUSED_LABEL +# endif #endif ]) AH_VERBATIM([async_safe], @@ -1005,6 +1095,238 @@ 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. +dnl +dnl When code is compiled on Android, it is in the context of a certain +dnl "Android API level", which indicates the minimum version of Android on +dnl which the app can be installed. In other words, you don't compile for a +dnl specific version of Android. You compile for all versions of Android, +dnl onwards from the given API level. +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 API level, +dnl - no, in no version, +dnl - not in the given API level, but in a later version of Android. +dnl +dnl In detail, this works as follows: +dnl If func was added to Android API level, say, 28, then the libc.so has the +dnl symbol func always, whereas the header file <foo.h> declares func +dnl conditionally: +dnl #if __ANDROID_API__ >= 28 +dnl ... func (...) __INTRODUCED_IN(28); +dnl #endif +dnl Thus, when compiling with "clang -target armv7a-unknown-linux-android28", +dnl the function func is declared and exists in libc. +dnl Whereas when compiling with "clang -target armv7a-unknown-linux-android27", +dnl the function func is not declared but exists in libc. +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_ANDROID([func], [[#include <foo.h>]]) +dnl can be used as a drop-in replacement for +dnl AC_CHECK_FUNCS([func]). +AC_DEFUN([gl_CHECK_FUNCS_ANDROID], +[ + AC_REQUIRE([AC_CANONICAL_HOST]) + 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_DEFAULT_CASE([$1]) + esac + ]) + ]) + 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 dnl the Microsoft deprecated alias function names to the underscore-prefixed dnl actual function names. With this macro, these function names are available diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index e03946c94ca..1bd16a779eb 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -44,6 +44,7 @@ AC_DEFUN([gl_EARLY], # Code from module absolute-header: # Code from module acl-permissions: + # Code from module alignasof: # Code from module alloca-opt: # Code from module allocator: # Code from module assert-h: @@ -82,7 +83,6 @@ AC_DEFUN([gl_EARLY], # Code from module errno: # Code from module euidaccess: # Code from module execinfo: - # Code from module explicit_bzero: # Code from module extensions: # Code from module extern-inline: # Code from module faccessat: @@ -124,7 +124,6 @@ AC_DEFUN([gl_EARLY], # Code from module intprops: # Code from module inttypes-incomplete: # Code from module largefile: - AC_REQUIRE([gl_YEAR2038_EARLY]) AC_REQUIRE([AC_SYS_LARGEFILE]) # Code from module lchmod: # Code from module libc-config: @@ -137,6 +136,7 @@ AC_DEFUN([gl_EARLY], # Code from module memmem-simple: # Code from module mempcpy: # Code from module memrchr: + # Code from module memset_explicit: # Code from module minmax: # Code from module mkostemp: # Code from module mktime: @@ -171,7 +171,6 @@ AC_DEFUN([gl_EARLY], # Code from module ssize_t: # Code from module stat-time: # Code from module std-gnu11: - # Code from module stdalign: # Code from module stdbool: # Code from module stdckdint: # Code from module stddef: @@ -190,7 +189,7 @@ AC_DEFUN([gl_EARLY], # Code from module sys_time: # Code from module sys_types: # Code from module tempname: - # Code from module time: + # Code from module time-h: # Code from module time_r: # Code from module time_rz: # Code from module timegm: @@ -232,6 +231,7 @@ AC_DEFUN([gl_INIT], gl_source_base='lib' gl_source_base_prefix= gl_FUNC_ACL + gl_ALIGNASOF gl_FUNC_ALLOCA gl_CONDITIONAL_HEADER([alloca.h]) AC_PROG_MKDIR_P @@ -249,7 +249,7 @@ AC_DEFUN([gl_INIT], gl_STDLIB_MODULE_INDICATOR([canonicalize_file_name]) gl_STDLIB_MODULE_INDICATOR([realpath]) AC_REQUIRE([AC_C_RESTRICT]) - AC_CHECK_FUNCS_ONCE([readlinkat]) + gl_CHECK_FUNCS_ANDROID([readlinkat], [[#include <unistd.h>]]) gl_CLOCK_TIME gl_MODULE_INDICATOR([close-stream]) gl_FUNC_COPY_FILE_RANGE @@ -285,12 +285,6 @@ AC_DEFUN([gl_INIT], gl_CONDITIONAL_HEADER([execinfo.h]) AC_PROG_MKDIR_P gl_CONDITIONAL([GL_COND_OBJ_EXECINFO], [$GL_GENERATE_EXECINFO_H]) - gl_FUNC_EXPLICIT_BZERO - gl_CONDITIONAL([GL_COND_OBJ_EXPLICIT_BZERO], [test $HAVE_EXPLICIT_BZERO = 0]) - AM_COND_IF([GL_COND_OBJ_EXPLICIT_BZERO], [ - gl_PREREQ_EXPLICIT_BZERO - ]) - gl_STRING_MODULE_INDICATOR([explicit_bzero]) AC_REQUIRE([gl_EXTERN_INLINE]) gl_FUNC_FACCESSAT gl_CONDITIONAL([GL_COND_OBJ_FACCESSAT], @@ -351,7 +345,8 @@ AC_DEFUN([gl_INIT], gl_SYS_STAT_MODULE_INDICATOR([futimens]) AC_REQUIRE([AC_CANONICAL_HOST]) gl_GETLOADAVG - gl_CONDITIONAL([GL_COND_OBJ_GETLOADAVG], [test $HAVE_GETLOADAVG = 0]) + gl_CONDITIONAL([GL_COND_OBJ_GETLOADAVG], + [test $HAVE_GETLOADAVG = 0 || test $REPLACE_GETLOADAVG = 1]) AM_COND_IF([GL_COND_OBJ_GETLOADAVG], [ gl_PREREQ_GETLOADAVG ]) @@ -411,7 +406,8 @@ AC_DEFUN([gl_INIT], fi gl_STRING_MODULE_INDICATOR([memmem]) gl_FUNC_MEMPCPY - gl_CONDITIONAL([GL_COND_OBJ_MEMPCPY], [test $HAVE_MEMPCPY = 0]) + gl_CONDITIONAL([GL_COND_OBJ_MEMPCPY], + [test $HAVE_MEMPCPY = 0 || test $REPLACE_MEMPCPY = 1]) AM_COND_IF([GL_COND_OBJ_MEMPCPY], [ gl_PREREQ_MEMPCPY ]) @@ -422,9 +418,16 @@ AC_DEFUN([gl_INIT], gl_PREREQ_MEMRCHR ]) gl_STRING_MODULE_INDICATOR([memrchr]) + gl_FUNC_MEMSET_EXPLICIT + gl_CONDITIONAL([GL_COND_OBJ_MEMSET_EXPLICIT], [test $HAVE_MEMSET_EXPLICIT = 0]) + AM_COND_IF([GL_COND_OBJ_MEMSET_EXPLICIT], [ + gl_PREREQ_MEMSET_EXPLICIT + ]) + gl_STRING_MODULE_INDICATOR([memset_explicit]) gl_MINMAX gl_FUNC_MKOSTEMP - gl_CONDITIONAL([GL_COND_OBJ_MKOSTEMP], [test $HAVE_MKOSTEMP = 0]) + gl_CONDITIONAL([GL_COND_OBJ_MKOSTEMP], + [test $HAVE_MKOSTEMP = 0 || test $REPLACE_MKOSTEMP = 1]) AM_COND_IF([GL_COND_OBJ_MKOSTEMP], [ gl_PREREQ_MKOSTEMP ]) @@ -457,6 +460,14 @@ AC_DEFUN([gl_INIT], gl_PREREQ_PTHREAD_SIGMASK ]) gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask]) + gl_FUNC_XATTR + AC_REQUIRE([gl_FUNC_ACL]) + if test "$use_xattr" = yes; then + QCOPY_ACL_LIB="$LIB_XATTR" + else + QCOPY_ACL_LIB="$LIB_ACL" + fi + AC_SUBST([QCOPY_ACL_LIB]) gl_FUNC_READLINK gl_CONDITIONAL([GL_COND_OBJ_READLINK], [test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1]) @@ -488,9 +499,6 @@ AC_DEFUN([gl_INIT], gt_TYPE_SSIZE_T gl_STAT_TIME gl_STAT_BIRTHTIME - gl_STDALIGN_H - gl_CONDITIONAL_HEADER([stdalign.h]) - AC_PROG_MKDIR_P gl_C_BOOL AC_CHECK_HEADERS_ONCE([stdckdint.h]) if test $ac_cv_header_stdckdint_h = yes; then @@ -541,7 +549,8 @@ AC_DEFUN([gl_INIT], gl_STDLIB_H_REQUIRE_DEFAULTS AC_PROG_MKDIR_P gl_FUNC_STPCPY - gl_CONDITIONAL([GL_COND_OBJ_STPCPY], [test $HAVE_STPCPY = 0]) + gl_CONDITIONAL([GL_COND_OBJ_STPCPY], + [test $HAVE_STPCPY = 0 || test $REPLACE_STPCPY = 1]) AM_COND_IF([GL_COND_OBJ_STPCPY], [ gl_PREREQ_STPCPY ]) @@ -966,7 +975,7 @@ AC_DEFUN([gl_INIT], if test $HAVE_FUTIMENS = 0 || test $REPLACE_FUTIMENS = 1; then func_gl_gnulib_m4code_utimens fi - if case $host_os in mingw*) false;; *) test $HAVE_GETLOADAVG = 0;; esac; then + if case $host_os in mingw*) false;; *) test $HAVE_GETLOADAVG = 0 || test $REPLACE_GETLOADAVG = 1;; esac; then func_gl_gnulib_m4code_open fi if test $REPLACE_GETOPT = 1; then @@ -1248,7 +1257,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/euidaccess.c lib/execinfo.c lib/execinfo.in.h - lib/explicit_bzero.c lib/faccessat.c lib/fchmodat.c lib/fcntl.c @@ -1318,6 +1326,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/memmem.c lib/mempcpy.c lib/memrchr.c + lib/memset_explicit.c lib/mini-gmp-gnulib.c lib/mini-gmp.c lib/mini-gmp.h @@ -1364,7 +1373,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/signal.in.h lib/stat-time.c lib/stat-time.h - lib/stdalign.in.h lib/stdckdint.in.h lib/stddef.in.h lib/stdint.in.h @@ -1432,7 +1440,6 @@ AC_DEFUN([gl_FILE_LIST], [ m4/errno_h.m4 m4/euidaccess.m4 m4/execinfo.m4 - m4/explicit_bzero.m4 m4/extensions.m4 m4/extern-inline.m4 m4/faccessat.m4 @@ -1476,6 +1483,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/memmem.m4 m4/mempcpy.m4 m4/memrchr.m4 + m4/memset_explicit.m4 m4/minmax.m4 m4/mkostemp.m4 m4/mktime.m4 @@ -1544,6 +1552,6 @@ AC_DEFUN([gl_FILE_LIST], [ m4/warnings.m4 m4/wchar_t.m4 m4/wint_t.m4 - m4/year2038.m4 + m4/xattr.m4 m4/zzgnulib.m4 ]) diff --git a/m4/group-member.m4 b/m4/group-member.m4 index 6e860c6189d..7c56ee3de7d 100644 --- a/m4/group-member.m4 +++ b/m4/group-member.m4 @@ -1,7 +1,6 @@ # serial 14 -# Copyright (C) 1999-2001, 2003-2007, 2009-2023 Free Software -# Foundation, Inc. +# Copyright (C) 1999-2001, 2003-2007, 2009-2023 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/inttypes.m4 b/m4/inttypes.m4 index bf2eab2ba31..e7efbe94167 100644 --- a/m4/inttypes.m4 +++ b/m4/inttypes.m4 @@ -1,4 +1,4 @@ -# inttypes.m4 serial 36 +# inttypes.m4 serial 37 dnl Copyright (C) 2006-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, @@ -170,6 +170,10 @@ AC_DEFUN([gl_INTTYPES_H_DEFAULTS], HAVE_DECL_STRTOIMAX=1; AC_SUBST([HAVE_DECL_STRTOIMAX]) HAVE_DECL_STRTOUMAX=1; AC_SUBST([HAVE_DECL_STRTOUMAX]) HAVE_IMAXDIV_T=1; AC_SUBST([HAVE_IMAXDIV_T]) + HAVE_IMAXABS=1; AC_SUBST([HAVE_IMAXABS]) + HAVE_IMAXDIV=1; AC_SUBST([HAVE_IMAXDIV]) + REPLACE_IMAXABS=0; AC_SUBST([REPLACE_IMAXABS]) + REPLACE_IMAXDIV=0; AC_SUBST([REPLACE_IMAXDIV]) REPLACE_STRTOIMAX=0; AC_SUBST([REPLACE_STRTOIMAX]) REPLACE_STRTOUMAX=0; AC_SUBST([REPLACE_STRTOUMAX]) INT32_MAX_LT_INTMAX_MAX=1; AC_SUBST([INT32_MAX_LT_INTMAX_MAX]) diff --git a/m4/largefile.m4 b/m4/largefile.m4 index bc8a2b93534..7fb81b864af 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 @@ -12,8 +12,7 @@ # and ftello in C++ mode as well. # Fixed in Autoconf 2.72, which has AC_SYS_YEAR2038. AC_DEFUN([gl_SET_LARGEFILE_SOURCE], -[ - m4_ifndef([AC_SYS_YEAR2038], [ + m4_ifndef([AC_SYS_YEAR2038], [[ AC_REQUIRE([AC_CANONICAL_HOST]) AC_FUNC_FSEEKO case "$host_os" in @@ -22,11 +21,10 @@ AC_DEFUN([gl_SET_LARGEFILE_SOURCE], [Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2).]) ;; esac - ]) -]) + ]]) +) -# Work around a problem in Autoconf through 2.71 on glibc 2.34+ -# with _TIME_BITS. Also, work around a problem in autoconf <= 2.69: +# Work around a problem in autoconf <= 2.69: # AC_SYS_LARGEFILE does not configure for large inodes on Mac OS X 10.5, # or configures them incorrectly in some cases. m4_version_prereq([2.70], [], [ @@ -46,34 +44,258 @@ m4_define([_AC_SYS_LARGEFILE_TEST_INCLUDES], ]) ])# m4_version_prereq 2.70 +# Support AC_SYS_YEAR2038, even if Autoconf 2.71 or earlier. +# This code is taken from Autoconf master. m4_ifndef([AC_SYS_YEAR2038], [ -# _AC_SYS_LARGEFILE_MACRO_VALUE(C-MACRO, VALUE, -# CACHE-VAR, -# DESCRIPTION, -# PROLOGUE, [FUNCTION-BODY]) -# -------------------------------------------------------- -m4_define([_AC_SYS_LARGEFILE_MACRO_VALUE], -[AC_CACHE_CHECK([for $1 value needed for large files], [$3], -[while :; do - m4_ifval([$6], [AC_LINK_IFELSE], [AC_COMPILE_IFELSE])( - [AC_LANG_PROGRAM([$5], [$6])], - [$3=no; break]) - m4_ifval([$6], [AC_LINK_IFELSE], [AC_COMPILE_IFELSE])( - [AC_LANG_PROGRAM([#undef $1 -#define $1 $2 -$5], [$6])], - [$3=$2; break]) - $3=unknown - break -done]) -case $$3 in #( - no | unknown) ;; - *) AC_DEFINE_UNQUOTED([$1], [$$3], [$4]);; -esac -rm -rf conftest*[]dnl -])# _AC_SYS_LARGEFILE_MACRO_VALUE +# _AC_SYS_YEAR2038_TEST_CODE +# -------------------------- +# C code used to probe for time_t that can represent time points more +# than 2**31 - 1 seconds after the epoch. With the usual Unix epoch, +# these correspond to dates after 2038-01-18 22:14:07 +0000 (Gregorian), +# hence the name. +AC_DEFUN([_AC_SYS_YEAR2038_TEST_CODE], +[[ + #include <time.h> + /* Check that time_t can represent 2**32 - 1 correctly. */ + #define LARGE_TIME_T \\ + ((time_t) (((time_t) 1 << 30) - 1 + 3 * ((time_t) 1 << 30))) + int verify_time_t_range[(LARGE_TIME_T / 65537 == 65535 + && LARGE_TIME_T % 65537 == 0) + ? 1 : -1]; +]]) + +# _AC_SYS_YEAR2038_OPTIONS +# ------------------------ +# List of known ways to enable support for large time_t. If you change +# this list you probably also need to change the AS_CASE at the end of +# _AC_SYS_YEAR2038_PROBE. +m4_define([_AC_SYS_YEAR2038_OPTIONS], m4_normalize( + ["none needed"] dnl 64-bit and newer 32-bit Unix + ["-D_TIME_BITS=64"] dnl glibc 2.34 with some 32-bit ABIs + ["-D__MINGW_USE_VC2005_COMPAT"] dnl 32-bit MinGW + ["-U_USE_32_BIT_TIME_T -D__MINGW_USE_VC2005_COMPAT"] + dnl 32-bit MinGW (misconfiguration) +)) + +# _AC_SYS_YEAR2038_PROBE([IF-NOT-DETECTED]) +# ----------------------------------------- +# Subroutine of AC_SYS_YEAR2038. Probe for time_t that can represent +# time points more than 2**31 - 1 seconds after the epoch (dates after +# 2038-01-18, see above) and set the cache variable ac_cv_sys_year2038_opts +# to one of the values in the _AC_SYS_YEAR2038_OPTIONS list, or to +# "support not detected" if none of them worked. Then, set compilation +# options and #defines as necessary to enable large time_t support. +# +# Note that we do not test whether mktime, localtime, etc. handle +# large values of time_t correctly, as that would require use of +# AC_TRY_RUN. Note also that some systems only support large time_t +# together with large off_t. +# +# If support is not detected, the behavior depends on which of the +# top-level AC_SYS_YEAR2038 macros was used (see below). +# +# If you change this macro you may also need to change +# _AC_SYS_YEAR2038_OPTIONS. +AC_DEFUN([_AC_SYS_YEAR2038_PROBE], +[AC_CACHE_CHECK([for $CC option to enable timestamps after Jan 2038], + [ac_cv_sys_year2038_opts], + [ac_save_CPPFLAGS="$CPPFLAGS" + ac_opt_found=no + for ac_opt in _AC_SYS_YEAR2038_OPTIONS; do + AS_IF([test x"$ac_opt" != x"none needed"], + [CPPFLAGS="$ac_save_CPPFLAGS $ac_opt"]) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([_AC_SYS_YEAR2038_TEST_CODE])], + [ac_cv_sys_year2038_opts="$ac_opt" + ac_opt_found=yes]) + test $ac_opt_found = no || break + done + CPPFLAGS="$ac_save_CPPFLAGS" + test $ac_opt_found = yes || ac_cv_sys_year2038_opts="support not detected"]) + +ac_have_year2038=yes +AS_CASE([$ac_cv_sys_year2038_opts], + ["none needed"], [], + ["support not detected"], + [ac_have_year2038=no + AS_CASE([$enable_year2038], + [yes], + [# If we're not cross compiling and 'touch' works with a large + # timestamp, then we can presume the system supports wider time_t + # *somehow* and we just weren't able to detect it. One common + # case that we deliberately *don't* probe for is a system that + # supports both 32- and 64-bit ABIs but only the 64-bit ABI offers + # wide time_t. (It would be inappropriate for us to override an + # intentional use of -m32.) Error out, demanding use of + # --disable-year2038 if this is intentional. + AS_IF([test $cross_compiling = no], + [AS_IF([TZ=UTC0 touch -t 210602070628.15 conftest.time 2>/dev/null], + [AS_CASE([`TZ=UTC0 LC_ALL=C ls -l conftest.time 2>/dev/null`], + [*'Feb 7 2106'* | *'Feb 7 17:10'*], + [AC_MSG_FAILURE(m4_text_wrap( + [this system appears to support timestamps after January 2038, + but no mechanism for enabling wide 'time_t' was detected. + Did you mean to build a 64-bit binary? (e.g. 'CC="${CC} -m64"'.) + To proceed with 32-bit time_t, configure with '--disable-year2038'.], + [], [], [55]))])])])])], + + ["-D_TIME_BITS=64"], + [AC_DEFINE([_TIME_BITS], [64], + [Number of bits in time_t, on hosts where this is settable.])], + + ["-D__MINGW_USE_VC2005_COMPAT=1"], + [AC_DEFINE([__MINGW_USE_VC2005_COMPAT], [1], + [Define to 1 on platforms where this makes time_t a 64-bit type.])], + + ["-U_USE_32_BIT_TIME_T"*], + [AC_MSG_FAILURE(m4_text_wrap( + [the 'time_t' type is currently forced to be 32-bit. + It will stop working after January 2038. + Remove _USE_32BIT_TIME_T from the compiler flags.], + [], [], [55]))], + + [AC_MSG_ERROR( + [internal error: bad value for \$ac_cv_sys_year2038_opts])]) +]) + +# _AC_SYS_YEAR2038_ENABLE +# ----------------------- +# Subroutine of AC_SYS_YEAR2038 and _AC_SYS_YEAR2038_OPT_IN. +# Depending on which of the YEAR2038 macros was used, add either an +# --enable-year2038, or a --disable-year2038, or no option at all to +# the configure script. Note that this is expanded very late and +# therefore there cannot be any code in the AC_ARG_ENABLE. The +# default value for enable_year2038 is emitted unconditionally +# because the generated code always looks at this variable. +m4_define([_AC_SYS_YEAR2038_ENABLE], +[m4_divert_text([DEFAULTS], + m4_provide_if([AC_SYS_YEAR2038], + [enable_year2038=yes], + [enable_year2038=no]))]dnl +[AC_ARG_ENABLE([year2038], + m4_provide_if([AC_SYS_YEAR2038], + [AS_HELP_STRING([--disable-year2038], + [do not support timestamps after 2038])], + [AS_HELP_STRING([--enable-year2038], + [support timestamps after 2038])]))]) + +# _AC_SYS_YEAR2038_OPT_IN +# ----------------------- +# If the --enable-year2038 option is given to configure, attempt to +# detect and activate support for large time_t on 32-bit systems. +# This macro is automatically invoked by AC_SYS_LARGEFILE when large +# *file* support is detected. It does not AC_REQUIRE AC_SYS_LARGEFILE +# to avoid a dependency loop, and is therefore unsafe to expose as a +# documented macro. +AC_DEFUN([_AC_SYS_YEAR2038_OPT_IN], +[m4_provide_if([_AC_SYS_YEAR2038_PROBE], [], [dnl + AS_IF([test "$enable_year2038" != no], [_AC_SYS_YEAR2038_PROBE]) + AC_CONFIG_COMMANDS_PRE([_AC_SYS_YEAR2038_ENABLE]) +])]) + +# AC_SYS_YEAR2038 +# --------------- +# Attempt to detect and activate support for large time_t. +# On systems where time_t is not always 64 bits, this probe can be +# skipped by passing the --disable-year2038 option to configure. +AC_DEFUN([AC_SYS_YEAR2038], +[AC_REQUIRE([AC_SYS_LARGEFILE])]dnl +[m4_provide_if([_AC_SYS_YEAR2038_PROBE], [], [dnl + AS_IF([test "$enable_year2038" != no], [_AC_SYS_YEAR2038_PROBE]) + AC_CONFIG_COMMANDS_PRE([_AC_SYS_YEAR2038_ENABLE]) +])]) + +# _AC_SYS_LARGEFILE_TEST_CODE +# --------------------------- +# C code used to probe for large file support. +m4_define([_AC_SYS_LARGEFILE_TEST_CODE], +[@%:@include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +@%:@define LARGE_OFF_T (((off_t) 1 << 31 << 31) - 1 + ((off_t) 1 << 31 << 31)) + int off_t_is_large[[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]];[]dnl +]) + +# _AC_SYS_LARGEFILE_OPTIONS +# ------------------------- +# List of known ways to enable support for large files. If you change +# this list you probably also need to change the AS_CASE at the end of +# _AC_SYS_LARGEFILE_PROBE. +m4_define([_AC_SYS_LARGEFILE_OPTIONS], m4_normalize( + ["none needed"] dnl Most current systems + ["-D_FILE_OFFSET_BITS=64"] dnl X/Open LFS spec + ["-D_LARGE_FILES=1"] dnl AIX (which versions?) + ["-n32"] dnl Irix 6.2 w/ SGI compiler +)) + +# _AC_SYS_LARGEFILE_PROBE +# ----------------------- +# Subroutine of AC_SYS_LARGEFILE. Probe for large file support and set +# the cache variable ac_cv_sys_largefile_opts to one of the values in +# the _AC_SYS_LARGEFILE_OPTIONS list, or to "support not detected" if +# none of the options in that list worked. Then, set compilation +# options and #defines as necessary to enable large file support. +# +# If large file support is not detected, the behavior depends on which of +# the top-level AC_SYS_LARGEFILE macros was used (see below). +# +# If you change this macro you may also need to change +# _AC_SYS_LARGEFILE_OPTIONS. +AC_DEFUN([_AC_SYS_LARGEFILE_PROBE], +[AC_CACHE_CHECK([for $CC option to enable large file support], + [ac_cv_sys_largefile_opts], + [ac_save_CC="$CC" + ac_opt_found=no + for ac_opt in _AC_SYS_LARGEFILE_OPTIONS; do + AS_IF([test x"$ac_opt" != x"none needed"], + [CC="$ac_save_CC $ac_opt"]) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([_AC_SYS_LARGEFILE_TEST_CODE])], + [ac_cv_sys_largefile_opts="$ac_opt" + ac_opt_found=yes]) + test $ac_opt_found = no || break + done + CC="$ac_save_CC" + test $ac_opt_found = yes || ac_cv_sys_largefile_opts="support not detected"]) + +ac_have_largefile=yes +AS_CASE([$ac_cv_sys_largefile_opts], + ["none needed"], [], + ["support not detected"], + [ac_have_largefile=no], + + ["-D_FILE_OFFSET_BITS=64"], + [AC_DEFINE([_FILE_OFFSET_BITS], [64], + [Number of bits in a file offset, on hosts where this is settable.])], + + ["-D_LARGE_FILES=1"], + [AC_DEFINE([_LARGE_FILES], [1], + [Define to 1 on platforms where this makes off_t a 64-bit type.])], + + ["-n32"], + [CC="$CC -n32"], + + [AC_MSG_ERROR( + [internal error: bad value for \$ac_cv_sys_largefile_opts])]) + +_AC_SYS_YEAR2038_OPT_IN +]) +# _AC_SYS_LARGEFILE_ENABLE +# ------------------------ +# Subroutine of AC_SYS_LARGEFILE. Note that this +# is expanded very late and therefore there cannot be any code in the +# AC_ARG_ENABLE. The default value for enable_largefile is emitted +# unconditionally because the generated shell code always looks at +# this variable. +m4_define([_AC_SYS_LARGEFILE_ENABLE], +[m4_divert_text([DEFAULTS], + enable_largefile=yes)]dnl +[AC_ARG_ENABLE([largefile], + [AS_HELP_STRING([--disable-largefile], [omit support for large files])])]) # AC_SYS_LARGEFILE # ---------------- @@ -84,44 +306,13 @@ rm -rf conftest*[]dnl # Additionally, on Linux file systems with 64-bit inodes a file that happens # to have a 64-bit inode number cannot be accessed by 32-bit applications on # Linux x86/x86_64. This can occur with file systems such as XFS and NFS. +# This macro allows configuration to continue if the system doesn't support +# large files. AC_DEFUN([AC_SYS_LARGEFILE], -[AC_ARG_ENABLE(largefile, - [ --disable-largefile omit support for large files]) -AS_IF([test "$enable_largefile" != no], - [AC_CACHE_CHECK([for special C compiler options needed for large files], - ac_cv_sys_largefile_CC, - [ac_cv_sys_largefile_CC=no - if test "$GCC" != yes; then - ac_save_CC=$CC - while :; do - # IRIX 6.2 and later do not support large files by default, - # so use the C compiler's -n32 option if that helps. - AC_LANG_CONFTEST([AC_LANG_PROGRAM([_AC_SYS_LARGEFILE_TEST_INCLUDES])]) - AC_COMPILE_IFELSE([], [break]) - CC="$CC -n32" - AC_COMPILE_IFELSE([], [ac_cv_sys_largefile_CC=' -n32'; break]) - break - done - CC=$ac_save_CC - rm -f conftest.$ac_ext - fi]) - if test "$ac_cv_sys_largefile_CC" != no; then - CC=$CC$ac_cv_sys_largefile_CC - fi - - _AC_SYS_LARGEFILE_MACRO_VALUE(_FILE_OFFSET_BITS, 64, - ac_cv_sys_file_offset_bits, - [Number of bits in a file offset, on hosts where this is settable.], - [_AC_SYS_LARGEFILE_TEST_INCLUDES]) - AS_CASE([$ac_cv_sys_file_offset_bits], - [unknown], - [_AC_SYS_LARGEFILE_MACRO_VALUE([_LARGE_FILES], [1], - [ac_cv_sys_large_files], - [Define for large files, on AIX-style hosts.], - [_AC_SYS_LARGEFILE_TEST_INCLUDES])], - [64], - [gl_YEAR2038_BODY([])])]) -])# AC_SYS_LARGEFILE +[m4_provide_if([_AC_SYS_LARGEFILE_PROBE], [], [dnl + AS_IF([test "$enable_largefile" != no], [_AC_SYS_LARGEFILE_PROBE]) + AC_CONFIG_COMMANDS_PRE([_AC_SYS_LARGEFILE_ENABLE]) +])]) ])# m4_ifndef AC_SYS_YEAR2038 # Enable large files on systems where this is implemented by Gnulib, not by the 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/mempcpy.m4 b/m4/mempcpy.m4 index 3ac8a305bde..612b77b3c11 100644 --- a/m4/mempcpy.m4 +++ b/m4/mempcpy.m4 @@ -1,6 +1,6 @@ -# mempcpy.m4 serial 12 -dnl Copyright (C) 2003-2004, 2006-2007, 2009-2023 Free Software -dnl Foundation, Inc. +# mempcpy.m4 serial 14 +dnl Copyright (C) 2003-2004, 2006-2007, 2009-2023 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. @@ -14,9 +14,12 @@ AC_DEFUN([gl_FUNC_MEMPCPY], AC_REQUIRE([AC_C_RESTRICT]) AC_REQUIRE([gl_STRING_H_DEFAULTS]) - AC_CHECK_FUNCS([mempcpy]) + gl_CHECK_FUNCS_ANDROID([mempcpy], [[#include <string.h>]]) if test $ac_cv_func_mempcpy = no; then HAVE_MEMPCPY=0 + case "$gl_cv_onwards_func_mempcpy" in + future*) REPLACE_MEMPCPY=1 ;; + esac fi ]) diff --git a/m4/memrchr.m4 b/m4/memrchr.m4 index ed750b7bdf1..7611ac7e3ac 100644 --- a/m4/memrchr.m4 +++ b/m4/memrchr.m4 @@ -1,6 +1,6 @@ # memrchr.m4 serial 11 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2023 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2023 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/memset_explicit.m4 b/m4/memset_explicit.m4 new file mode 100644 index 00000000000..9dcd89a758a --- /dev/null +++ b/m4/memset_explicit.m4 @@ -0,0 +1,20 @@ +dnl Copyright 2022-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, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_MEMSET_EXPLICIT], +[ + AC_REQUIRE([gl_STRING_H_DEFAULTS]) + + AC_CHECK_FUNCS_ONCE([memset_explicit]) + if test $ac_cv_func_memset_explicit = no; then + HAVE_MEMSET_EXPLICIT=0 + fi +]) + +AC_DEFUN([gl_PREREQ_MEMSET_EXPLICIT], +[ + AC_CHECK_FUNCS([explicit_memset]) + AC_CHECK_FUNCS_ONCE([memset_s]) +]) diff --git a/m4/mkostemp.m4 b/m4/mkostemp.m4 index a7cfac4cb87..1b0d0d55946 100644 --- a/m4/mkostemp.m4 +++ b/m4/mkostemp.m4 @@ -1,4 +1,4 @@ -# mkostemp.m4 serial 2 +# mkostemp.m4 serial 4 dnl Copyright (C) 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, @@ -11,9 +11,12 @@ AC_DEFUN([gl_FUNC_MKOSTEMP], dnl Persuade glibc <stdlib.h> to declare mkostemp(). AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([mkostemp]) + gl_CHECK_FUNCS_ANDROID([mkostemp], [[#include <stdlib.h>]]) if test $ac_cv_func_mkostemp != yes; then HAVE_MKOSTEMP=0 + case "$gl_cv_onwards_func_mkostemp" in + future*) REPLACE_MKOSTEMP=1 ;; + esac fi ]) diff --git a/m4/mktime.m4 b/m4/mktime.m4 index 604dd766f5d..e9d31f35a46 100644 --- a/m4/mktime.m4 +++ b/m4/mktime.m4 @@ -1,6 +1,6 @@ # serial 37 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2023 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2023 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4 index 21ee5a21daf..e21a3e343cb 100644 --- a/m4/nanosleep.m4 +++ b/m4/nanosleep.m4 @@ -1,4 +1,4 @@ -# serial 42 +# serial 43 dnl From Jim Meyering. dnl Check for the nanosleep function. @@ -25,11 +25,11 @@ AC_DEFUN([gl_FUNC_NANOSLEEP], # Solaris 2.5.1 needs -lposix4 to get the nanosleep function. # Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4. - LIB_NANOSLEEP= - AC_SUBST([LIB_NANOSLEEP]) + NANOSLEEP_LIB= + AC_SUBST([NANOSLEEP_LIB]) AC_SEARCH_LIBS([nanosleep], [rt posix4], [test "$ac_cv_search_nanosleep" = "none required" || - LIB_NANOSLEEP=$ac_cv_search_nanosleep]) + NANOSLEEP_LIB=$ac_cv_search_nanosleep]) if test "x$ac_cv_search_nanosleep" != xno; then dnl The system has a nanosleep function. @@ -143,4 +143,8 @@ AC_DEFUN([gl_FUNC_NANOSLEEP], HAVE_NANOSLEEP=0 fi LIBS=$nanosleep_save_libs + + # For backward compatibility. + LIB_NANOSLEEP="$NANOSLEEP_LIB" + AC_SUBST([LIB_NANOSLEEP]) ]) diff --git a/m4/nproc.m4 b/m4/nproc.m4 index 3065b7b9bff..c892ad74b7d 100644 --- a/m4/nproc.m4 +++ b/m4/nproc.m4 @@ -1,4 +1,4 @@ -# nproc.m4 serial 5 +# nproc.m4 serial 6 dnl Copyright (C) 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,8 +25,8 @@ AC_DEFUN([gl_PREREQ_NPROC], #endif ]) - AC_CHECK_FUNCS([sched_getaffinity sched_getaffinity_np \ - pstat_getdynamic sysmp sysctl]) + AC_CHECK_FUNCS([sched_getaffinity_np pstat_getdynamic sysmp sysctl]) + gl_CHECK_FUNCS_ANDROID([sched_getaffinity], [[#include <sched.h>]]) dnl Test whether sched_getaffinity has the expected declaration. dnl glibc 2.3.[0-2]: diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4 index 45b89f752a5..04c0b63fbd0 100644 --- a/m4/nstrftime.m4 +++ b/m4/nstrftime.m4 @@ -1,7 +1,6 @@ # serial 37 -# Copyright (C) 1996-1997, 1999-2007, 2009-2023 Free Software -# Foundation, Inc. +# Copyright (C) 1996-1997, 1999-2007, 2009-2023 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/pathmax.m4 b/m4/pathmax.m4 index 5b7fa4242bc..6d47d2c026e 100644 --- a/m4/pathmax.m4 +++ b/m4/pathmax.m4 @@ -1,6 +1,6 @@ # pathmax.m4 serial 11 -dnl Copyright (C) 2002-2003, 2005-2006, 2009-2023 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2006, 2009-2023 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/pipe2.m4 b/m4/pipe2.m4 index 501f3a4303d..79de69cd1a4 100644 --- a/m4/pipe2.m4 +++ b/m4/pipe2.m4 @@ -1,4 +1,4 @@ -# pipe2.m4 serial 2 +# pipe2.m4 serial 4 dnl Copyright (C) 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, @@ -11,8 +11,13 @@ AC_DEFUN([gl_FUNC_PIPE2], dnl Persuade glibc <unistd.h> to declare pipe2(). AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([pipe2]) + gl_CHECK_FUNCS_ANDROID([pipe2], [[#include <unistd.h>]]) if test $ac_cv_func_pipe2 != yes; then HAVE_PIPE2=0 + case "$gl_cv_onwards_func_pipe2" in + future*) REPLACE_PIPE2=1 ;; + esac + else + REPLACE_PIPE2=1 fi ]) 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/pthread_sigmask.m4 b/m4/pthread_sigmask.m4 index 5110668155e..27795282bee 100644 --- a/m4/pthread_sigmask.m4 +++ b/m4/pthread_sigmask.m4 @@ -1,4 +1,4 @@ -# pthread_sigmask.m4 serial 21 +# pthread_sigmask.m4 serial 22 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, @@ -24,7 +24,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], [gl_cv_func_pthread_sigmask_macro=no]) ]) - LIB_PTHREAD_SIGMASK= + PTHREAD_SIGMASK_LIB= if test $gl_cv_func_pthread_sigmask_macro = yes; then dnl pthread_sigmask is a dummy macro. @@ -62,7 +62,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], ]) if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then dnl pthread_sigmask is available with -pthread or -lpthread. - LIB_PTHREAD_SIGMASK="$LIBMULTITHREAD" + PTHREAD_SIGMASK_LIB="$LIBMULTITHREAD" else dnl pthread_sigmask is not available at all. HAVE_PTHREAD_SIGMASK=0 @@ -101,6 +101,9 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], ]) fi + AC_SUBST([PTHREAD_SIGMASK_LIB]) + dnl For backward compatibility. + LIB_PTHREAD_SIGMASK="$PTHREAD_SIGMASK_LIB" AC_SUBST([LIB_PTHREAD_SIGMASK]) dnl We don't need a variable LTLIB_PTHREAD_SIGMASK, because when dnl "$gl_threads_api" = posix, $LTLIBMULTITHREAD and $LIBMULTITHREAD are the @@ -114,7 +117,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], dnl On FreeBSD 13.0, MidnightBSD 1.1, HP-UX 11.31, Solaris 9, in programs dnl that are not linked with -lpthread, the pthread_sigmask() function dnl always returns 0 and has no effect. - if test -z "$LIB_PTHREAD_SIGMASK"; then + if test -z "$PTHREAD_SIGMASK_LIB"; then case " $LIBS " in *' -pthread '*) ;; *' -lpthread '*) ;; @@ -162,7 +165,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], [gl_cv_func_pthread_sigmask_return_works], [ gl_save_LIBS="$LIBS" - LIBS="$LIBS $LIB_PTHREAD_SIGMASK" + LIBS="$LIBS $PTHREAD_SIGMASK_LIB" AC_RUN_IFELSE( [AC_LANG_SOURCE([[ #include <pthread.h> @@ -208,7 +211,7 @@ int main () gl_cv_func_pthread_sigmask_unblock_works="guessing yes";; esac m4_ifdef([gl_][THREADLIB], - [dnl Link against $LIBMULTITHREAD, not only $LIB_PTHREAD_SIGMASK. + [dnl Link against $LIBMULTITHREAD, not only $PTHREAD_SIGMASK_LIB. dnl Otherwise we get a false positive on those platforms where dnl $gl_cv_func_pthread_sigmask_in_libc_works is "no". gl_save_LIBS=$LIBS 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/readlinkat.m4 b/m4/readlinkat.m4 index ffd0b8e9bc1..5c513562919 100644 --- a/m4/readlinkat.m4 +++ b/m4/readlinkat.m4 @@ -1,4 +1,4 @@ -# serial 6 +# serial 8 # See if we need to provide readlinkat replacement. dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. @@ -12,10 +12,13 @@ AC_DEFUN([gl_FUNC_READLINKAT], [ AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([readlinkat]) + gl_CHECK_FUNCS_ANDROID([readlinkat], [[#include <unistd.h>]]) AC_REQUIRE([gl_FUNC_READLINK]) if test $ac_cv_func_readlinkat = no; then HAVE_READLINKAT=0 + case "$gl_cv_onwards_func_readlinkat" in + future*) REPLACE_READLINKAT=1 ;; + esac else AC_CACHE_CHECK([whether readlinkat signature is correct], [gl_cv_decl_readlinkat_works], 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/sig2str.m4 b/m4/sig2str.m4 index 7aad94a9616..aee18efeefd 100644 --- a/m4/sig2str.m4 +++ b/m4/sig2str.m4 @@ -1,6 +1,5 @@ # serial 7 -dnl Copyright (C) 2002, 2005-2006, 2009-2023 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 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, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4 index 1b45e9557cc..1c12c33ea09 100644 --- a/m4/ssize_t.m4 +++ b/m4/ssize_t.m4 @@ -1,6 +1,5 @@ # ssize_t.m4 serial 5 (gettext-0.18.2) -dnl Copyright (C) 2001-2003, 2006, 2010-2023 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2001-2003, 2006, 2010-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, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/stat-time.m4 b/m4/stat-time.m4 index 5b6b8101098..40993d5731c 100644 --- a/m4/stat-time.m4 +++ b/m4/stat-time.m4 @@ -1,7 +1,7 @@ # Checks for stat-related time functions. -# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2023 Free -# Software Foundation, Inc. +# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2023 Free Software +# Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/stdalign.m4 b/m4/stdalign.m4 index b1438eeaced..f49cf8ec162 100644 --- a/m4/stdalign.m4 +++ b/m4/stdalign.m4 @@ -5,9 +5,11 @@ dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. +dnl Written by Paul Eggert and Bruno Haible. + # Prepare for substituting <stdalign.h> if it is not supported. -AC_DEFUN([gl_STDALIGN_H], +AC_DEFUN([gl_ALIGNASOF], [ AC_CACHE_CHECK([for alignas and alignof], [gl_cv_header_working_stdalign_h], @@ -58,77 +60,141 @@ AC_DEFUN([gl_STDALIGN_H], test "$gl_cv_header_working_stdalign_h" != no && break done]) - GL_GENERATE_STDALIGN_H=false AS_CASE([$gl_cv_header_working_stdalign_h], - [no], - [GL_GENERATE_STDALIGN_H=true], [yes*keyword*], [AC_DEFINE([HAVE_C_ALIGNASOF], [1], [Define to 1 if the alignas and alignof keywords work.])]) - AC_CHECK_HEADERS_ONCE([stdalign.h]) - dnl The "zz" puts this toward config.h's end, to avoid potential dnl collisions with other definitions. AH_VERBATIM([zzalignas], [#if !defined HAVE_C_ALIGNASOF && __cplusplus < 201103 && !defined alignof # if HAVE_STDALIGN_H # include <stdalign.h> -# else - /* Substitute. Keep consistent with gnulib/lib/stdalign.in.h. */ -# ifndef _GL_STDALIGN_H -# define _GL_STDALIGN_H -# undef _Alignas -# undef _Alignof -# if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ - || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ - && !defined __clang__) \ - || (defined __clang__ && __clang_major__ < 8)) -# ifdef __cplusplus -# if (201103 <= __cplusplus || defined _MSC_VER) -# define _Alignof(type) alignof (type) -# else - template <class __t> struct __alignof_helper { char __a; __t __b; }; -# define _Alignof(type) offsetof (__alignof_helper<type>, __b) -# define _GL_STDALIGN_NEEDS_STDDEF 1 -# endif +# endif + +/* ISO C23 alignas and alignof for platforms that lack it. + + References: + ISO C23 (latest free draft + <http://www.open-std.org/jtc1/sc22/wg14/www/docs/n3047.pdf>) + sections 6.5.3.4, 6.7.5, 7.15. + C++11 (latest free draft + <http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2011/n3242.pdf>) + section 18.10. */ + +/* alignof (TYPE), also known as _Alignof (TYPE), yields the alignment + requirement of a structure member (i.e., slot or field) that is of + type TYPE, as an integer constant expression. + + This differs from GCC's and clang's __alignof__ operator, which can + yield a better-performing alignment for an object of that type. For + example, on x86 with GCC and on Linux/x86 with clang, + __alignof__ (double) and __alignof__ (long long) are 8, whereas + alignof (double) and alignof (long long) are 4 unless the option + '-malign-double' is used. + + The result cannot be used as a value for an 'enum' constant, if you + want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */ + +/* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023 + <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. + clang versions < 8.0.0 have the same bug. */ +# if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ + || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ + && !defined __clang__) \ + || (defined __clang__ && __clang_major__ < 8)) +# undef/**/_Alignof +# ifdef __cplusplus +# if (201103 <= __cplusplus || defined _MSC_VER) +# define _Alignof(type) alignof (type) # else -# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) + template <class __t> struct __alignof_helper { char __a; __t __b; }; +# define _Alignof(type) offsetof (__alignof_helper<type>, __b) # define _GL_STDALIGN_NEEDS_STDDEF 1 # endif -# endif -# if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)) -# define alignof _Alignof -# endif -# define __alignof_is_defined 1 -# if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 -# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER) -# define _Alignas(a) alignas (a) -# elif (!defined __attribute__ \ - && ((defined __APPLE__ && defined __MACH__ \ - ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \ - : __GNUC__ && !defined __ibmxl__) \ - || (4 <= __clang_major__) \ - || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ - || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__)) -# define _Alignas(a) __attribute__ ((__aligned__ (a))) -# elif 1300 <= _MSC_VER -# define _Alignas(a) __declspec (align (a)) +# else +# if (defined __GNUC__ && 4 <= __GNUC__) || defined __clang__ +# define _Alignof(type) __builtin_offsetof (struct { char __a; type __b; }, __b) +# else +# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) +# define _GL_STDALIGN_NEEDS_STDDEF 1 # endif # endif -# if ((defined _Alignas \ - && !(defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) \ - || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) -# define alignas _Alignas -# endif -# if (defined alignas \ - || (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) -# define __alignas_is_defined 1 -# endif -# if _GL_STDALIGN_NEEDS_STDDEF -# include <stddef.h> +# endif +# if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)) +# undef/**/alignof +# define alignof _Alignof +# endif + +/* alignas (A), also known as _Alignas (A), aligns a variable or type + to the alignment A, where A is an integer constant expression. For + example: + + int alignas (8) foo; + struct s { int a; int alignas (8) bar; }; + + aligns the address of FOO and the offset of BAR to be multiples of 8. + + A should be a power of two that is at least the type's alignment + and at most the implementation's alignment limit. This limit is + 2**28 on typical GNUish hosts, and 2**13 on MSVC. To be portable + to MSVC through at least version 10.0, A should be an integer + constant, as MSVC does not support expressions such as 1 << 3. + To be portable to Sun C 5.11, do not align auto variables to + anything stricter than their default alignment. + + The following C23 requirements are not supported here: + + - If A is zero, alignas has no effect. + - alignas can be used multiple times; the strictest one wins. + - alignas (TYPE) is equivalent to alignas (alignof (TYPE)). + + */ +# if !HAVE_STDALIGN_H +# if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 +# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER) +# define _Alignas(a) alignas (a) +# elif (!defined __attribute__ \ + && ((defined __APPLE__ && defined __MACH__ \ + ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \ + : __GNUC__ && !defined __ibmxl__) \ + || (4 <= __clang_major__) \ + || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ + || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__)) +# define _Alignas(a) __attribute__ ((__aligned__ (a))) +# elif 1300 <= _MSC_VER +# define _Alignas(a) __declspec (align (a)) # endif -# endif /* _GL_STDALIGN_H */ +# endif +# if ((defined _Alignas \ + && !(defined __cplusplus \ + && (201103 <= __cplusplus || defined _MSC_VER))) \ + || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) +# define alignas _Alignas +# endif +# endif + +# if _GL_STDALIGN_NEEDS_STDDEF +# include <stddef.h> # endif #endif]) ]) + +AC_DEFUN([gl_STDALIGN_H], +[ + AC_REQUIRE([gl_ALIGNASOF]) + if test "$gl_cv_header_working_stdalign_h" = no; then + GL_GENERATE_STDALIGN_H=true + else + GL_GENERATE_STDALIGN_H=false + fi + + gl_CHECK_NEXT_HEADERS([stdalign.h]) + if test $ac_cv_header_stdalign_h = yes; then + HAVE_STDALIGN_H=1 + else + HAVE_STDALIGN_H=0 + fi + AC_SUBST([HAVE_STDALIGN_H]) +]) diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4 index c0553d6f2ff..a2322ebb7ee 100644 --- a/m4/stddef_h.m4 +++ b/m4/stddef_h.m4 @@ -1,4 +1,4 @@ -# stddef_h.m4 serial 12 +# stddef_h.m4 serial 13 dnl Copyright (C) 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, @@ -22,7 +22,14 @@ AC_DEFUN_ONCE([gl_STDDEF_H], [gl_cv_type_max_align_t], [AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( - [[#include <stddef.h> + [[/* On FreeBSD 12.0/x86, max_align_t defined by <stddef.h> has + the correct alignment with the default (wrong) definition of + _Alignof, but a wrong alignment as soon as we activate an + ISO C compliant _Alignof definition. */ + #if ((defined __GNUC__ && 4 <= __GNUC__) || defined __clang__) && !defined __cplusplus + #define _Alignof(type) __builtin_offsetof (struct { char __a; type __b; }, __b) + #endif + #include <stddef.h> unsigned int s = sizeof (max_align_t); #if defined __GNUC__ || defined __clang__ || defined __IBM__ALIGNOF__ int check1[2 * (__alignof__ (double) <= __alignof__ (max_align_t)) - 1]; diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4 index 94271e11e78..07569961f8b 100644 --- a/m4/stdio_h.m4 +++ b/m4/stdio_h.m4 @@ -1,4 +1,4 @@ -# stdio_h.m4 serial 59 +# stdio_h.m4 serial 61 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, @@ -82,6 +82,16 @@ AC_DEFUN_ONCE([gl_STDIO_H], if test $ac_cv_have_decl_fcloseall = no; then HAVE_DECL_FCLOSEALL=0 fi + + AC_CHECK_DECLS_ONCE([getw]) + if test $ac_cv_have_decl_getw = no; then + HAVE_DECL_GETW=0 + fi + + AC_CHECK_DECLS_ONCE([putw]) + if test $ac_cv_have_decl_putw = no; then + HAVE_DECL_PUTW=0 + fi ]) # gl_STDIO_MODULE_INDICATOR([modulename]) @@ -178,7 +188,9 @@ AC_DEFUN([gl_STDIO_H_DEFAULTS], HAVE_DECL_FTELLO=1; AC_SUBST([HAVE_DECL_FTELLO]) HAVE_DECL_GETDELIM=1; AC_SUBST([HAVE_DECL_GETDELIM]) HAVE_DECL_GETLINE=1; AC_SUBST([HAVE_DECL_GETLINE]) + HAVE_DECL_GETW=1; AC_SUBST([HAVE_DECL_GETW]) HAVE_DECL_OBSTACK_PRINTF=1; AC_SUBST([HAVE_DECL_OBSTACK_PRINTF]) + HAVE_DECL_PUTW=1; AC_SUBST([HAVE_DECL_PUTW]) HAVE_DECL_SNPRINTF=1; AC_SUBST([HAVE_DECL_SNPRINTF]) HAVE_DECL_VSNPRINTF=1; AC_SUBST([HAVE_DECL_VSNPRINTF]) HAVE_DPRINTF=1; AC_SUBST([HAVE_DPRINTF]) diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index e96be22f583..249ef657224 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -1,4 +1,4 @@ -# stdlib_h.m4 serial 66 +# stdlib_h.m4 serial 71 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, @@ -23,7 +23,7 @@ AC_DEFUN_ONCE([gl_STDLIB_H], # include <random.h> #endif ]], [_Exit aligned_alloc atoll canonicalize_file_name free - getloadavg getsubopt grantpt + getloadavg getprogname getsubopt grantpt initstate initstate_r mbtowc mkdtemp mkostemp mkostemps mkstemp mkstemps posix_memalign posix_openpt ptsname ptsname_r qsort_r random random_r reallocarray realpath rpmatch secure_getenv setenv @@ -73,6 +73,7 @@ AC_DEFUN([gl_STDLIB_H_REQUIRE_DEFAULTS], gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_CANONICALIZE_FILE_NAME]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_FREE_POSIX]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_GETLOADAVG]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_GETPROGNAME]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_GETSUBOPT]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_GRANTPT]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MALLOC_GNU]) @@ -130,6 +131,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], HAVE_DECL_FCVT=1; AC_SUBST([HAVE_DECL_FCVT]) HAVE_DECL_GCVT=1; AC_SUBST([HAVE_DECL_GCVT]) HAVE_DECL_GETLOADAVG=1; AC_SUBST([HAVE_DECL_GETLOADAVG]) + HAVE_GETPROGNAME=1; AC_SUBST([HAVE_GETPROGNAME]) HAVE_GETSUBOPT=1; AC_SUBST([HAVE_GETSUBOPT]) HAVE_GRANTPT=1; AC_SUBST([HAVE_GRANTPT]) HAVE_INITSTATE=1; AC_SUBST([HAVE_INITSTATE]) @@ -166,17 +168,24 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], HAVE_SYS_LOADAVG_H=0; AC_SUBST([HAVE_SYS_LOADAVG_H]) HAVE_UNLOCKPT=1; AC_SUBST([HAVE_UNLOCKPT]) HAVE_DECL_UNSETENV=1; AC_SUBST([HAVE_DECL_UNSETENV]) + REPLACE__EXIT=0; AC_SUBST([REPLACE__EXIT]) REPLACE_ALIGNED_ALLOC=0; AC_SUBST([REPLACE_ALIGNED_ALLOC]) REPLACE_CALLOC_FOR_CALLOC_GNU=0; AC_SUBST([REPLACE_CALLOC_FOR_CALLOC_GNU]) REPLACE_CALLOC_FOR_CALLOC_POSIX=0; AC_SUBST([REPLACE_CALLOC_FOR_CALLOC_POSIX]) REPLACE_CANONICALIZE_FILE_NAME=0; AC_SUBST([REPLACE_CANONICALIZE_FILE_NAME]) REPLACE_FREE=0; AC_SUBST([REPLACE_FREE]) + REPLACE_GETLOADAVG=0; AC_SUBST([REPLACE_GETLOADAVG]) + REPLACE_GETPROGNAME=0; AC_SUBST([REPLACE_GETPROGNAME]) + REPLACE_GETSUBOPT=0; AC_SUBST([REPLACE_GETSUBOPT]) REPLACE_INITSTATE=0; AC_SUBST([REPLACE_INITSTATE]) REPLACE_MALLOC_FOR_MALLOC_GNU=0; AC_SUBST([REPLACE_MALLOC_FOR_MALLOC_GNU]) REPLACE_MALLOC_FOR_MALLOC_POSIX=0; AC_SUBST([REPLACE_MALLOC_FOR_MALLOC_POSIX]) REPLACE_MBTOWC=0; AC_SUBST([REPLACE_MBTOWC]) + REPLACE_MKOSTEMP=0; AC_SUBST([REPLACE_MKOSTEMP]) + REPLACE_MKOSTEMPS=0; AC_SUBST([REPLACE_MKOSTEMPS]) REPLACE_MKSTEMP=0; AC_SUBST([REPLACE_MKSTEMP]) REPLACE_POSIX_MEMALIGN=0; AC_SUBST([REPLACE_POSIX_MEMALIGN]) + REPLACE_POSIX_OPENPT=0; AC_SUBST([REPLACE_POSIX_OPENPT]) REPLACE_PTSNAME=0; AC_SUBST([REPLACE_PTSNAME]) REPLACE_PTSNAME_R=0; AC_SUBST([REPLACE_PTSNAME_R]) REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV]) diff --git a/m4/stpcpy.m4 b/m4/stpcpy.m4 index e8a76bc34f3..f3acbee7be9 100644 --- a/m4/stpcpy.m4 +++ b/m4/stpcpy.m4 @@ -1,4 +1,4 @@ -# stpcpy.m4 serial 9 +# stpcpy.m4 serial 11 dnl Copyright (C) 2002, 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, @@ -13,9 +13,12 @@ AC_DEFUN([gl_FUNC_STPCPY], AC_REQUIRE([AC_C_RESTRICT]) AC_REQUIRE([gl_STRING_H_DEFAULTS]) - AC_CHECK_FUNCS([stpcpy]) + gl_CHECK_FUNCS_ANDROID([stpcpy], [[#include <string.h>]]) if test $ac_cv_func_stpcpy = no; then HAVE_STPCPY=0 + case "$gl_cv_onwards_func_stpcpy" in + future*) REPLACE_STPCPY=1 ;; + esac fi ]) diff --git a/m4/string_h.m4 b/m4/string_h.m4 index 15401e129cd..7f51391cbff 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 @@ -5,7 +5,7 @@ # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -# serial 34 +# serial 37 # Written by Paul Eggert. @@ -21,7 +21,8 @@ AC_DEFUN_ONCE([gl_STRING_H], dnl guaranteed by C89. gl_WARN_ON_USE_PREPARE([[#include <string.h> ]], - [ffsl ffsll memmem mempcpy memrchr rawmemchr stpcpy stpncpy strchrnul + [explicit_bzero ffsl ffsll memmem mempcpy memrchr memset_explicit + rawmemchr stpcpy stpncpy strchrnul strdup strncat strndup strnlen strpbrk strsep strcasestr strtok_r strerror_r strerrorname_np sigabbrev_np sigdescr_np strsignal strverscmp]) @@ -54,6 +55,7 @@ AC_DEFUN([gl_STRING_H_REQUIRE_DEFAULTS], gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MEMMEM]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MEMPCPY]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MEMRCHR]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MEMSET_EXPLICIT]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_RAWMEMCHR]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STPCPY]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STPNCPY]) @@ -107,6 +109,7 @@ AC_DEFUN([gl_STRING_H_DEFAULTS], HAVE_FFSLL=1; AC_SUBST([HAVE_FFSLL]) HAVE_DECL_MEMMEM=1; AC_SUBST([HAVE_DECL_MEMMEM]) HAVE_MEMPCPY=1; AC_SUBST([HAVE_MEMPCPY]) + HAVE_MEMSET_EXPLICIT=1; AC_SUBST([HAVE_MEMSET_EXPLICIT]) HAVE_DECL_MEMRCHR=1; AC_SUBST([HAVE_DECL_MEMRCHR]) HAVE_RAWMEMCHR=1; AC_SUBST([HAVE_RAWMEMCHR]) HAVE_STPCPY=1; AC_SUBST([HAVE_STPCPY]) @@ -128,6 +131,8 @@ AC_DEFUN([gl_STRING_H_DEFAULTS], REPLACE_FFSLL=0; AC_SUBST([REPLACE_FFSLL]) REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR]) REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM]) + REPLACE_MEMPCPY=0; AC_SUBST([REPLACE_MEMPCPY]) + REPLACE_STPCPY=0; AC_SUBST([REPLACE_STPCPY]) REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY]) REPLACE_STRCHRNUL=0; AC_SUBST([REPLACE_STRCHRNUL]) REPLACE_STRDUP=0; AC_SUBST([REPLACE_STRDUP]) diff --git a/m4/strnlen.m4 b/m4/strnlen.m4 index 60e8d81bf3b..d2cac59b6f2 100644 --- a/m4/strnlen.m4 +++ b/m4/strnlen.m4 @@ -1,6 +1,6 @@ # strnlen.m4 serial 14 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2023 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2023 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4 index 1c6ddd386a5..db5cfb7aa9d 100644 --- a/m4/strtoimax.m4 +++ b/m4/strtoimax.m4 @@ -1,6 +1,5 @@ # strtoimax.m4 serial 16 -dnl Copyright (C) 2002-2004, 2006, 2009-2023 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002-2004, 2006, 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, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strtoll.m4 b/m4/strtoll.m4 index 1e042175b18..ede630c6061 100644 --- a/m4/strtoll.m4 +++ b/m4/strtoll.m4 @@ -1,6 +1,5 @@ # strtoll.m4 serial 9 -dnl Copyright (C) 2002, 2004, 2006, 2008-2023 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2004, 2006, 2008-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, dnl with or without modifications, as long as this notice is preserved. 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/m4/time_h.m4 b/m4/time_h.m4 index fd4a469d192..51d553a2f1a 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -1,9 +1,8 @@ # Configure a more-standard replacement for <time.h>. -# Copyright (C) 2000-2001, 2003-2007, 2009-2023 Free Software -# Foundation, Inc. +# Copyright (C) 2000-2001, 2003-2007, 2009-2023 Free Software Foundation, Inc. -# serial 20 +# serial 22 # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, @@ -138,6 +137,7 @@ AC_DEFUN([gl_TIME_H_REQUIRE_DEFAULTS], gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_NANOSLEEP]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRFTIME]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_STRPTIME]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_TIME]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_TIMEGM]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_TIMESPEC_GET]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_TIMESPEC_GETRES]) @@ -170,7 +170,9 @@ AC_DEFUN([gl_TIME_H_DEFAULTS], REPLACE_MKTIME=GNULIB_PORTCHECK; AC_SUBST([REPLACE_MKTIME]) REPLACE_NANOSLEEP=GNULIB_PORTCHECK; AC_SUBST([REPLACE_NANOSLEEP]) REPLACE_STRFTIME=GNULIB_PORTCHECK; AC_SUBST([REPLACE_STRFTIME]) + REPLACE_TIME=0; AC_SUBST([REPLACE_TIME]) REPLACE_TIMEGM=GNULIB_PORTCHECK; AC_SUBST([REPLACE_TIMEGM]) + REPLACE_TIMESPEC_GET=GNULIB_PORTCHECK; AC_SUBST([REPLACE_TIMESPEC_GET]) REPLACE_TZSET=GNULIB_PORTCHECK; AC_SUBST([REPLACE_TZSET]) dnl Hack so that the time module doesn't depend on the sys_time module. diff --git a/m4/timegm.m4 b/m4/timegm.m4 index 6079f1a39c8..8ab265e65fe 100644 --- a/m4/timegm.m4 +++ b/m4/timegm.m4 @@ -1,4 +1,4 @@ -# timegm.m4 serial 13 +# timegm.m4 serial 15 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, @@ -9,7 +9,7 @@ AC_DEFUN([gl_FUNC_TIMEGM], AC_REQUIRE([gl_TIME_H_DEFAULTS]) AC_REQUIRE([gl_FUNC_MKTIME_WORKS]) REPLACE_TIMEGM=0 - AC_CHECK_FUNCS_ONCE([timegm]) + gl_CHECK_FUNCS_ANDROID([timegm], [[#include <time.h>]]) if test $ac_cv_func_timegm = yes; then if test "$gl_cv_func_working_mktime" != yes; then # Assume that timegm is buggy if mktime is. @@ -17,6 +17,9 @@ AC_DEFUN([gl_FUNC_TIMEGM], fi else HAVE_TIMEGM=0 + case "$gl_cv_onwards_func_timegm" in + future*) REPLACE_TIMEGM=1 ;; + esac fi ]) diff --git a/m4/timer_time.m4 b/m4/timer_time.m4 index 4c2608b58e8..437d1dc5428 100644 --- a/m4/timer_time.m4 +++ b/m4/timer_time.m4 @@ -1,10 +1,10 @@ -# timer_time.m4 serial 5 +# timer_time.m4 serial 6 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, dnl with or without modifications, as long as this notice is preserved. -# Check for timer_settime, and set LIB_TIMER_TIME. +# Check for timer_settime, and set TIMER_TIME_LIB. AC_DEFUN([gl_TIMER_TIME], [ @@ -21,13 +21,13 @@ AC_DEFUN([gl_TIMER_TIME], AC_CHECK_DECL([timer_settime], [], [], [[#include <time.h> ]]) - LIB_TIMER_TIME= - AC_SUBST([LIB_TIMER_TIME]) + TIMER_TIME_LIB= + AC_SUBST([TIMER_TIME_LIB]) AS_IF([test "$ac_cv_have_decl_timer_settime" = yes], [ gl_saved_libs=$LIBS AC_SEARCH_LIBS([timer_settime], [rt posix4], [test "$ac_cv_search_timer_settime" = "none required" || - LIB_TIMER_TIME=$ac_cv_search_timer_settime]) + TIMER_TIME_LIB=$ac_cv_search_timer_settime]) m4_ifdef([gl_][PTHREADLIB], [dnl GLIBC uses threads to emulate posix timers when kernel support dnl is not available (like Linux < 2.6 or when used with kFreeBSD) @@ -42,8 +42,11 @@ AC_DEFUN([gl_TIMER_TIME], #endif #endif ], - [LIB_TIMER_TIME="$LIB_TIMER_TIME $LIBPMULTITHREAD"])]) + [TIMER_TIME_LIB="$TIMER_TIME_LIB $LIBPMULTITHREAD"])]) AC_CHECK_FUNCS([timer_settime]) LIBS=$gl_saved_libs ]) + dnl For backward compatibility. + LIB_TIMER_TIME="$TIMER_TIME_LIB" + AC_SUBST([LIB_TIMER_TIME]) ]) diff --git a/m4/timespec.m4 b/m4/timespec.m4 index 354530319fe..95f475f2cc5 100644 --- a/m4/timespec.m4 +++ b/m4/timespec.m4 @@ -1,7 +1,6 @@ #serial 15 -# Copyright (C) 2000-2001, 2003-2007, 2009-2023 Free Software -# Foundation, Inc. +# Copyright (C) 2000-2001, 2003-2007, 2009-2023 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4 index f4384027e37..1c96158155a 100644 --- a/m4/unistd_h.m4 +++ b/m4/unistd_h.m4 @@ -1,4 +1,4 @@ -# unistd_h.m4 serial 90 +# unistd_h.m4 serial 94 dnl Copyright (C) 2006-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, @@ -225,6 +225,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], REPLACE_COPY_FILE_RANGE=0; AC_SUBST([REPLACE_COPY_FILE_RANGE]) REPLACE_DUP=0; AC_SUBST([REPLACE_DUP]) REPLACE_DUP2=0; AC_SUBST([REPLACE_DUP2]) + REPLACE_DUP3=0; AC_SUBST([REPLACE_DUP3]) REPLACE_EXECL=0; AC_SUBST([REPLACE_EXECL]) REPLACE_EXECLE=0; AC_SUBST([REPLACE_EXECLE]) REPLACE_EXECLP=0; AC_SUBST([REPLACE_EXECLP]) @@ -234,10 +235,12 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], REPLACE_EXECVPE=0; AC_SUBST([REPLACE_EXECVPE]) REPLACE_FACCESSAT=0; AC_SUBST([REPLACE_FACCESSAT]) REPLACE_FCHOWNAT=0; AC_SUBST([REPLACE_FCHOWNAT]) + REPLACE_FDATASYNC=0; AC_SUBST([REPLACE_FDATASYNC]) REPLACE_FTRUNCATE=0; AC_SUBST([REPLACE_FTRUNCATE]) REPLACE_GETCWD=0; AC_SUBST([REPLACE_GETCWD]) REPLACE_GETDOMAINNAME=0; AC_SUBST([REPLACE_GETDOMAINNAME]) REPLACE_GETDTABLESIZE=0; AC_SUBST([REPLACE_GETDTABLESIZE]) + REPLACE_GETENTROPY=0; AC_SUBST([REPLACE_GETENTROPY]) REPLACE_GETLOGIN_R=0; AC_SUBST([REPLACE_GETLOGIN_R]) REPLACE_GETGROUPS=0; AC_SUBST([REPLACE_GETGROUPS]) REPLACE_GETPAGESIZE=0; AC_SUBST([REPLACE_GETPAGESIZE]) @@ -248,12 +251,14 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], REPLACE_LINK=0; AC_SUBST([REPLACE_LINK]) REPLACE_LINKAT=0; AC_SUBST([REPLACE_LINKAT]) REPLACE_LSEEK=0; AC_SUBST([REPLACE_LSEEK]) + REPLACE_PIPE2=0; AC_SUBST([REPLACE_PIPE2]) REPLACE_PREAD=0; AC_SUBST([REPLACE_PREAD]) REPLACE_PWRITE=0; AC_SUBST([REPLACE_PWRITE]) REPLACE_READ=0; AC_SUBST([REPLACE_READ]) REPLACE_READLINK=0; AC_SUBST([REPLACE_READLINK]) REPLACE_READLINKAT=0; AC_SUBST([REPLACE_READLINKAT]) REPLACE_RMDIR=0; AC_SUBST([REPLACE_RMDIR]) + REPLACE_SETHOSTNAME=0; AC_SUBST([REPLACE_SETHOSTNAME]) REPLACE_SLEEP=0; AC_SUBST([REPLACE_SLEEP]) REPLACE_SYMLINK=0; AC_SUBST([REPLACE_SYMLINK]) REPLACE_SYMLINKAT=0; AC_SUBST([REPLACE_SYMLINKAT]) diff --git a/m4/utimens.m4 b/m4/utimens.m4 index ae35ef789b8..5f8606167a6 100644 --- a/m4/utimens.m4 +++ b/m4/utimens.m4 @@ -3,7 +3,7 @@ dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. -dnl serial 11 +dnl serial 15 AC_DEFUN([gl_UTIMENS], [ @@ -11,7 +11,11 @@ AC_DEFUN([gl_UTIMENS], AC_REQUIRE([gl_FUNC_UTIMES]) AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC]) AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles - AC_CHECK_FUNCS_ONCE([futimes futimesat futimens utimensat lutimes]) + gl_CHECK_FUNCS_ANDROID([futimes], [[#include <sys/time.h>]]) + gl_CHECK_FUNCS_ANDROID([futimesat], [[#include <sys/time.h>]]) + gl_CHECK_FUNCS_ANDROID([lutimes], [[#include <sys/time.h>]]) + gl_CHECK_FUNCS_ANDROID([futimens], [[#include <sys/stat.h>]]) + gl_CHECK_FUNCS_ANDROID([utimensat], [[#include <sys/stat.h>]]) if test $ac_cv_func_futimens = no && test $ac_cv_func_futimesat = yes; then dnl FreeBSD 8.0-rc2 mishandles futimesat(fd,NULL,time). It is not diff --git a/m4/utimensat.m4 b/m4/utimensat.m4 index dd210fc989a..1a670bb7b78 100644 --- a/m4/utimensat.m4 +++ b/m4/utimensat.m4 @@ -1,4 +1,4 @@ -# serial 9 +# serial 11 # See if we need to provide utimensat replacement. dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. @@ -13,9 +13,12 @@ AC_DEFUN([gl_FUNC_UTIMENSAT], AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS]) AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles - AC_CHECK_FUNCS_ONCE([utimensat]) + gl_CHECK_FUNCS_ANDROID([utimensat], [[#include <sys/stat.h>]]) if test $ac_cv_func_utimensat = no; then HAVE_UTIMENSAT=0 + case "$gl_cv_onwards_func_utimensat" in + future*) REPLACE_UTIMENSAT=1 ;; + esac else AC_CACHE_CHECK([whether utimensat works], [gl_cv_func_utimensat_works], diff --git a/m4/xattr.m4 b/m4/xattr.m4 new file mode 100644 index 00000000000..0e179cc0d1d --- /dev/null +++ b/m4/xattr.m4 @@ -0,0 +1,53 @@ +# xattr.m4 - check for Extended Attributes (Linux) +# serial 6 + +# Copyright (C) 2003-2023 Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_XATTR], +[ + AC_ARG_ENABLE([xattr], + AS_HELP_STRING([--disable-xattr], + [do not support extended attributes]), + [use_xattr=$enableval], [use_xattr=yes]) + + LIB_XATTR= + AC_SUBST([LIB_XATTR]) + + if test "$use_xattr" = yes; then + AC_CACHE_CHECK([for xattr library with ATTR_ACTION_PERMISSIONS], + [gl_cv_xattr_lib], + [gl_cv_xattr_lib=no + AC_LANG_CONFTEST( + [AC_LANG_PROGRAM( + [[#include <attr/error_context.h> + #include <attr/libattr.h> + static int + is_attr_permissions (const char *name, struct error_context *ctx) + { + return attr_copy_action (name, ctx) == ATTR_ACTION_PERMISSIONS; + } + ]], + [[return attr_copy_fd ("/", 0, "/", 0, is_attr_permissions, 0); + ]])]) + AC_LINK_IFELSE([], + [gl_cv_xattr_lib='none required'], + [xattr_saved_LIBS=$LIBS + LIBS="-lattr $LIBS" + AC_LINK_IFELSE([], [gl_cv_xattr_lib=-lattr]) + LIBS=$xattr_saved_LIBS])]) + if test "$gl_cv_xattr_lib" = no; then + AC_MSG_WARN([libattr development library was not found or not usable.]) + AC_MSG_WARN([AC_PACKAGE_NAME will be built without xattr support.]) + use_xattr=no + elif test "$gl_cv_xattr_lib" != 'none required'; then + LIB_XATTR=$gl_cv_xattr_lib + fi + fi + if test "$use_xattr" = yes; then + AC_DEFINE([USE_XATTR], [1], + [Define to 1 to use the Linux extended attributes library.]) + fi +]) diff --git a/msdos/autogen/Makefile.in b/msdos/autogen/Makefile.in index 7f44c9867fe..df9b7797989 100644 --- a/msdos/autogen/Makefile.in +++ b/msdos/autogen/Makefile.in @@ -921,13 +921,11 @@ LIBXT_OTHER = @LIBXT_OTHER@ LIBX_OTHER = @LIBX_OTHER@ LIBZ = @LIBZ@ LIB_ACL = @LIB_ACL@ -LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ -LIB_EACCESS = @LIB_EACCESS@ +CLOCK_TIME_LIB = @CLOCK_TIME_LIB@ +EUIDACCESS_LIBGEN = @EUIDACCESS_LIBGEN@ LIB_EXECINFO = @LIB_EXECINFO@ -LIB_FDATASYNC = @LIB_FDATASYNC@ LIB_MATH = @LIB_MATH@ LIB_PTHREAD = @LIB_PTHREAD@ -LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@ LIB_TIMER_TIME = @LIB_TIMER_TIME@ LIB_WSOCK32 = @LIB_WSOCK32@ LN_S_FILEONLY = @LN_S_FILEONLY@ diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 4d4c80a6b1a..162ccb3e8d8 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -48,9 +48,8 @@ s/\.h\.in/.h-in/ /^LIB_MATH *=/s/@LIB_MATH@/-lm/ /^LIB_PTHREAD *=/s/@LIB_PTHREAD@// /^LIB_ACL *=/s/@LIB_ACL@// -/^LIB_EACCESS *=/s/@LIB_EACCESS@// -/^LIB_FDATASYNC *=/s/@LIB_FDATASYNC@// -/^LIB_NANOSLEEP *=/s/@LIB_NANOSLEEP@// +/^EUIDACCESS_LIBGEN *=/s/@EUIDACCESS_LIBGEN@// +/^NANOSLEEP_LIB *=/s/@NANOSLEEP_LIB@// s/ *@LIBTIFF@// s/ *@LIBJPEG@// s/ *@LIBPNG@// @@ -140,7 +139,7 @@ s/ *@WEBP_LIBS@// /^LIBSELINUX_LIBS *=/s/@LIBSELINUX_LIBS@// /^LIBSYSTEMD_LIBS *=/s/@LIBSYSTEMD_LIBS@// /^LIBSYSTEMD_CFLAGS *=/s/@LIBSYSTEMD_CFLAGS@// -/^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g +/^CLOCK_TIME_LIB *=/s/@[^@\n]*@//g /^LIB_TIMER_TIME *=/s/@[^@\n]*@//g /^LIB_EXECINFO *=/s/@[^@\n]*@//g /^LIBGNUTLS_LIBS *=/s/@[^@\n]*@// @@ -183,6 +182,7 @@ s/ *@WEBP_LIBS@// /^TREE_SITTER_CFLAGS *=/s/@TREE_SITTER_CFLAGS@// /^HARFBUZZ_CFLAGS *=/s/@HARFBUZZ_CFLAGS@// /^HARFBUZZ_LIBS *=/s/@HARFBUZZ_LIBS@// +/^QCOPY_ACL_LIB *=/s/@QCOPY_ACL_LIB@// /^LCMS2_CFLAGS *=/s/@LCMS2_CFLAGS@// /^LCMS2_LIBS *=/s/@LCMS2_LIBS@// /^LIBGMP *=/s/@LIBGMP@// diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 9817c74403a..58c1663dda0 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -67,7 +67,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.0.60"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "30.0.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/msdos/sed3v2.inp b/msdos/sed3v2.inp index dc9eaff27c8..9688a27b066 100644 --- a/msdos/sed3v2.inp +++ b/msdos/sed3v2.inp @@ -32,9 +32,9 @@ /^LIBRESOLV *=/s/@[^@\n]*@//g /^LIBS_MAIL *=/s/@[^@\n]*@//g /^LIBS_SYSTEM *=/s/@[^@\n]*@//g -/^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g +/^CLOCK_TIME_LIB *=/s/@[^@\n]*@//g /^LIB_TIMER_TIME *=/s/@[^@\n]*@//g -/^LIB_GETRANDOM *=/s/@[^@\n]*@//g +/^GETRANDOM_LIB *=/s/@[^@\n]*@//g /^CFLAGS *=/s!=.*$!=-O2 -g! /^CPPFLAGS *=/s/@CPPFLAGS@// /^LDFLAGS *=/s/@LDFLAGS@// @@ -49,7 +49,6 @@ /^ALLOCA *=/s!@ALLOCA@!! /^EXEEXT *=/s!@EXEEXT@!.exe! /^CLIENTW *=/s/@CLIENTW@// -/^LIB_FDATASYNC *=/s/@LIB_FDATASYNC@// /^LIB_WSOCK32 *=/s/@LIB_WSOCK32@// /^LIBS_ECLIENT *=/s/@LIBS_ECLIENT@// /^NTLIB *=/s/@NTLIB@// diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 497aedb2096..c3f410bd74d 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -270,7 +270,6 @@ s/@PACKAGE@/emacs/ /^LDFLAGS *=/s/@[^@\n]*@// /^LD_FIRSTFLAG *=/s/@[^@\n]*@// /^LIB_PTHREAD *=/s/@[^@\n]*@// -/^LIB_PTHREAD_SIGMASK *=/s/@[^@\n]*@// /^LIBS *=/s/@[^@\n]*@// /^MAKEINFO *=/s/@MAKEINFO@/makeinfo/ # MKDIR_P lines are edited further below @@ -323,7 +322,7 @@ s/@PACKAGE@/emacs/ /^REPLACE_MKTIME *=/s/@[^@\n]*@/1/ # We don't want any other gnulib replacement functions /^REPLACE_[^ =]* *= *@/s/@[^@\n]*@/0/ -/^LIB_GETRANDOM[^ =]* *= *@/s/@[^@\n]*@// +/^GETRANDOM_LIB[^ =]* *= *@/s/@[^@\n]*@// /^SIG_ATOMIC_T_SUFFIX *=/s/@SIG_ATOMIC_T_SUFFIX@// /^SIZE_T_SUFFIX *=/s/@SIZE_T_SUFFIX@/u/ /^ASSERT_H *=/s/@[^@\n]*@/assert.h/ @@ -429,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/INSTALL.W64 b/nt/INSTALL.W64 index fa576fb4d7f..fe5f74e3209 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -115,7 +115,7 @@ put the Emacs source into C:\emacs\emacs-master: mkdir /c/emacs cd /c/emacs - git clone git://git.sv.gnu.org/emacs.git emacs-master + git clone https://git.savannah.gnu.org/git/emacs.git emacs-master This will produce the development sources, i.e. the master branch of the Emacs Git repository, in the directory C:\emacs\emacs-master. diff --git a/nt/README.W32 b/nt/README.W32 index 523f833ca24..da1ede1ea4d 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2023 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 29.0.60 for MS-Windows + Emacs version 30.0.50 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You 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 c96c2b597bd..c97e78559f1 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -926,7 +926,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/Makefile.in b/src/Makefile.in index c29c3750e59..e08e5eead28 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -144,9 +144,10 @@ M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@ M17N_FLT_LIBS = @M17N_FLT_LIBS@ LIB_ACL=@LIB_ACL@ -LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@ -LIB_EACCESS=@LIB_EACCESS@ -LIB_NANOSLEEP=@LIB_NANOSLEEP@ +CLOCK_TIME_LIB=@CLOCK_TIME_LIB@ +EUIDACCESS_LIBGEN=@EUIDACCESS_LIBGEN@ +NANOSLEEP_LIB=@NANOSLEEP_LIB@ +QCOPY_ACL_LIB=@QCOPY_ACL_LIB@ LIB_TIMER_TIME=@LIB_TIMER_TIME@ DBUS_CFLAGS = @DBUS_CFLAGS@ @@ -558,9 +559,9 @@ lisp = $(addprefix ${lispsource}/,${shortlisp}) ## Construct full set of libraries to be linked. LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBX_OTHER) $(LIBSOUND) \ - $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(LIB_CLOCK_GETTIME) \ - $(LIB_NANOSLEEP) $(WEBKIT_LIBS) \ - $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ + $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(CLOCK_TIME_LIB) \ + $(NANOSLEEP_LIB) $(QCOPY_ACL_LIB) $(WEBKIT_LIBS) \ + $(EUIDACCESS_LIBGEN) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ $(LIB_EXECINFO) $(XRANDR_LIBS) $(XINERAMA_LIBS) $(XFIXES_LIBS) \ $(XDBE_LIBS) $(XSYNC_LIBS) \ $(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \ diff --git a/src/alloc.c b/src/alloc.c index f7a0a4a80c8..d09fc41dec6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -80,6 +80,37 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <valgrind/memcheck.h> #endif +/* AddressSanitizer exposes additional functions for manually marking + memory as poisoned/unpoisoned. When ASan is enabled and the needed + header is available, memory is poisoned when: + + * An ablock is freed (lisp_align_free), or ablocks are initially + allocated (lisp_align_malloc). + * An interval_block is initially allocated (make_interval). + * A dead INTERVAL is put on the interval free list + (sweep_intervals). + * A sdata is marked as dead (sweep_strings, pin_string). + * An sblock is initially allocated (allocate_string_data). + * A string_block is initially allocated (allocate_string). + * A dead string is put on string_free_list (sweep_strings). + * A float_block is initially allocated (make_float). + * A dead float is put on float_free_list. + * A cons_block is initially allocated (Fcons). + * A dead cons is put on cons_free_list (sweep_cons). + * A dead vector is put on vector_free_list (setup_on_free_list), + or a new vector block is allocated (allocate_vector_from_block). + Accordingly, objects reused from the free list are unpoisoned. + + This feature can be disabled wtih the run-time flag + `allow_user_poisoning' set to zero. */ +#if ADDRESS_SANITIZER && defined HAVE_SANITIZER_ASAN_INTERFACE_H \ + && !defined GC_ASAN_POISON_OBJECTS +# define GC_ASAN_POISON_OBJECTS 1 +# include <sanitizer/asan_interface.h> +#else +# define GC_ASAN_POISON_OBJECTS 0 +#endif + /* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects. We turn that on by default when ENABLE_CHECKING is defined; define GC_CHECK_MARKED_OBJECTS to zero to disable. */ @@ -1052,7 +1083,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)); /* Use aligned_alloc if it or a simple substitute is available. @@ -1157,6 +1192,16 @@ struct ablocks (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void **) (abase))[-1]) #endif +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_ABLOCK(b) \ + __asan_poison_memory_region (&(b)->x, sizeof ((b)->x)) +# define ASAN_UNPOISON_ABLOCK(b) \ + __asan_unpoison_memory_region (&(b)->x, sizeof ((b)->x)) +#else +# define ASAN_POISON_ABLOCK(b) ((void) 0) +# define ASAN_UNPOISON_ABLOCK(b) ((void) 0) +#endif + /* The list of free ablock. */ static struct ablock *free_ablock; @@ -1235,6 +1280,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) { abase->blocks[i].abase = abase; abase->blocks[i].x.next_free = free_ablock; + ASAN_POISON_ABLOCK (&abase->blocks[i]); free_ablock = &abase->blocks[i]; } intptr_t ialigned = aligned; @@ -1247,6 +1293,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) eassert ((intptr_t) ABLOCKS_BUSY (abase) == aligned); } + ASAN_UNPOISON_ABLOCK (free_ablock); abase = ABLOCK_ABASE (free_ablock); ABLOCKS_BUSY (abase) = (struct ablocks *) (2 + (intptr_t) ABLOCKS_BUSY (abase)); @@ -1278,6 +1325,7 @@ lisp_align_free (void *block) #endif /* Put on free list. */ ablock->x.next_free = free_ablock; + ASAN_POISON_ABLOCK (ablock); free_ablock = ablock; /* Update busy count. */ intptr_t busy = (intptr_t) ABLOCKS_BUSY (abase) - 2; @@ -1290,9 +1338,12 @@ lisp_align_free (void *block) bool aligned = busy; struct ablock **tem = &free_ablock; struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1]; - while (*tem) { +#if GC_ASAN_POISON_OBJECTS + __asan_unpoison_memory_region (&(*tem)->x, + sizeof ((*tem)->x)); +#endif if (*tem >= (struct ablock *) abase && *tem < atop) { i++; @@ -1421,6 +1472,24 @@ static int interval_block_index = INTERVAL_BLOCK_SIZE; static INTERVAL interval_free_list; +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_INTERVAL_BLOCK(b) \ + __asan_poison_memory_region ((b)->intervals, \ + sizeof ((b)->intervals)) +# define ASAN_UNPOISON_INTERVAL_BLOCK(b) \ + __asan_unpoison_memory_region ((b)->intervals, \ + sizeof ((b)->intervals)) +# define ASAN_POISON_INTERVAL(i) \ + __asan_poison_memory_region ((i), sizeof (*(i))) +# define ASAN_UNPOISON_INTERVAL(i) \ + __asan_unpoison_memory_region ((i), sizeof (*(i))) +#else +# define ASAN_POISON_INTERVAL_BLOCK(b) ((void) 0) +# define ASAN_UNPOISON_INTERVAL_BLOCK(b) ((void) 0) +# define ASAN_POISON_INTERVAL(i) ((void) 0) +# define ASAN_UNPOISON_INTERVAL(i) ((void) 0) +#endif + /* Return a new interval. */ INTERVAL @@ -1433,6 +1502,7 @@ make_interval (void) if (interval_free_list) { val = interval_free_list; + ASAN_UNPOISON_INTERVAL (val); interval_free_list = INTERVAL_PARENT (interval_free_list); } else @@ -1443,10 +1513,12 @@ make_interval (void) = lisp_malloc (sizeof *newi, false, MEM_TYPE_NON_LISP); newi->next = interval_block; + ASAN_POISON_INTERVAL_BLOCK (newi); interval_block = newi; interval_block_index = 0; } val = &interval_block->intervals[interval_block_index++]; + ASAN_UNPOISON_INTERVAL (val); } MALLOC_UNBLOCK_INPUT; @@ -1687,6 +1759,41 @@ init_strings (void) staticpro (&empty_multibyte_string); } +#if GC_ASAN_POISON_OBJECTS +/* Prepare s for denoting a free sdata struct, i.e, poison all bytes + in the flexible array member, except the first SDATA_OFFSET bytes. + This is only effective for strings of size n where n > sdata_size(n). + */ +# define ASAN_PREPARE_DEAD_SDATA(s, size) \ + do { \ + __asan_poison_memory_region ((s), sdata_size ((size))); \ + __asan_unpoison_memory_region (&(((s))->string), \ + sizeof (struct Lisp_String *)); \ + __asan_unpoison_memory_region (&SDATA_NBYTES ((s)), \ + sizeof (SDATA_NBYTES ((s)))); \ + } while (false) +/* Prepare s for storing string data for NBYTES bytes. */ +# define ASAN_PREPARE_LIVE_SDATA(s, nbytes) \ + __asan_unpoison_memory_region ((s), sdata_size ((nbytes))) +# define ASAN_POISON_SBLOCK_DATA(b, size) \ + __asan_poison_memory_region ((b)->data, (size)) +# define ASAN_POISON_STRING_BLOCK(b) \ + __asan_poison_memory_region ((b)->strings, STRING_BLOCK_SIZE) +# define ASAN_UNPOISON_STRING_BLOCK(b) \ + __asan_unpoison_memory_region ((b)->strings, STRING_BLOCK_SIZE) +# define ASAN_POISON_STRING(s) \ + __asan_poison_memory_region ((s), sizeof (*(s))) +# define ASAN_UNPOISON_STRING(s) \ + __asan_unpoison_memory_region ((s), sizeof (*(s))) +#else +# define ASAN_PREPARE_DEAD_SDATA(s, size) ((void) 0) +# define ASAN_PREPARE_LIVE_SDATA(s, nbytes) ((void) 0) +# define ASAN_POISON_SBLOCK_DATA(b, size) ((void) 0) +# define ASAN_POISON_STRING_BLOCK(b) ((void) 0) +# define ASAN_UNPOISON_STRING_BLOCK(b) ((void) 0) +# define ASAN_POISON_STRING(s) ((void) 0) +# define ASAN_UNPOISON_STRING(s) ((void) 0) +#endif #ifdef GC_CHECK_STRING_BYTES @@ -1805,12 +1912,14 @@ allocate_string (void) NEXT_FREE_LISP_STRING (s) = string_free_list; string_free_list = s; } + ASAN_POISON_STRING_BLOCK (b); } check_string_free_list (); /* Pop a Lisp_String off the free-list. */ s = string_free_list; + ASAN_UNPOISON_STRING (s); string_free_list = NEXT_FREE_LISP_STRING (s); MALLOC_UNBLOCK_INPUT; @@ -1870,6 +1979,7 @@ allocate_string_data (struct Lisp_String *s, #endif b = lisp_malloc (size + GC_STRING_EXTRA, clearit, MEM_TYPE_NON_LISP); + ASAN_POISON_SBLOCK_DATA (b, size); #ifdef DOUG_LEA_MALLOC if (!mmap_lisp_allowed_p ()) @@ -1891,6 +2001,8 @@ allocate_string_data (struct Lisp_String *s, { /* Not enough room in the current sblock. */ b = lisp_malloc (SBLOCK_SIZE, false, MEM_TYPE_NON_LISP); + ASAN_POISON_SBLOCK_DATA (b, SBLOCK_SIZE); + data = b->data; b->next = NULL; b->next_free = data; @@ -1903,10 +2015,19 @@ allocate_string_data (struct Lisp_String *s, } data = b->next_free; + if (clearit) - memset (SDATA_DATA (data), 0, nbytes); + { +#if GC_ASAN_POISON_OBJECTS + /* We are accessing SDATA_DATA (data) before it gets + * normally unpoisoned, so do it manually. */ + __asan_unpoison_memory_region (SDATA_DATA (data), nbytes); +#endif + memset (SDATA_DATA (data), 0, nbytes); + } } + ASAN_PREPARE_LIVE_SDATA (data, nbytes); data->string = s; b->next_free = (sdata *) ((char *) data + needed + GC_STRING_EXTRA); eassert ((uintptr_t) b->next_free % alignof (sdata) == 0); @@ -1998,12 +2119,16 @@ sweep_strings (void) int i, nfree = 0; struct Lisp_String *free_list_before = string_free_list; + ASAN_UNPOISON_STRING_BLOCK (b); + next = b->next; for (i = 0; i < STRING_BLOCK_SIZE; ++i) { struct Lisp_String *s = b->strings + i; + ASAN_UNPOISON_STRING (s); + if (s->u.s.data) { /* String was not on free-list before. */ @@ -2040,6 +2165,8 @@ sweep_strings (void) /* Put the string on the free-list. */ NEXT_FREE_LISP_STRING (s) = string_free_list; + ASAN_POISON_STRING (s); + ASAN_PREPARE_DEAD_SDATA (data, SDATA_NBYTES (data)); string_free_list = s; ++nfree; } @@ -2048,6 +2175,8 @@ sweep_strings (void) { /* S was on the free-list before. Put it there again. */ NEXT_FREE_LISP_STRING (s) = string_free_list; + ASAN_POISON_STRING (s); + string_free_list = s; ++nfree; } @@ -2174,6 +2303,7 @@ compact_small_strings (void) if (from != to) { eassert (tb != b || to < from); + ASAN_PREPARE_LIVE_SDATA (to, nbytes); memmove (to, from, size + GC_STRING_EXTRA); to->string->u.s.data = SDATA_DATA (to); } @@ -2525,6 +2655,7 @@ pin_string (Lisp_Object string) memcpy (s->u.s.data, data, size); old_sdata->string = NULL; SDATA_NBYTES (old_sdata) = size; + ASAN_PREPARE_DEAD_SDATA (old_sdata, size); } s->u.s.size_byte = -3; } @@ -2582,6 +2713,24 @@ struct float_block #define XFLOAT_UNMARK(fptr) \ UNSETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr))) +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_FLOAT_BLOCK(fblk) \ + __asan_poison_memory_region ((fblk)->floats, \ + sizeof ((fblk)->floats)) +# define ASAN_UNPOISON_FLOAT_BLOCK(fblk) \ + __asan_unpoison_memory_region ((fblk)->floats, \ + sizeof ((fblk)->floats)) +# define ASAN_POISON_FLOAT(p) \ + __asan_poison_memory_region ((p), sizeof (struct Lisp_Float)) +# define ASAN_UNPOISON_FLOAT(p) \ + __asan_unpoison_memory_region ((p), sizeof (struct Lisp_Float)) +#else +# define ASAN_POISON_FLOAT_BLOCK(fblk) ((void) 0) +# define ASAN_UNPOISON_FLOAT_BLOCK(fblk) ((void) 0) +# define ASAN_POISON_FLOAT(p) ((void) 0) +# define ASAN_UNPOISON_FLOAT(p) ((void) 0) +#endif + /* Current float_block. */ static struct float_block *float_block; @@ -2606,6 +2755,7 @@ make_float (double float_value) if (float_free_list) { XSETFLOAT (val, float_free_list); + ASAN_UNPOISON_FLOAT (float_free_list); float_free_list = float_free_list->u.chain; } else @@ -2616,9 +2766,11 @@ make_float (double float_value) = lisp_align_malloc (sizeof *new, MEM_TYPE_FLOAT); new->next = float_block; memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); + ASAN_POISON_FLOAT_BLOCK (new); float_block = new; float_block_index = 0; } + ASAN_UNPOISON_FLOAT (&float_block->floats[float_block_index]); XSETFLOAT (val, &float_block->floats[float_block_index]); float_block_index++; } @@ -2690,6 +2842,19 @@ static int cons_block_index = CONS_BLOCK_SIZE; static struct Lisp_Cons *cons_free_list; +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_CONS_BLOCK(b) \ + __asan_poison_memory_region ((b)->conses, sizeof ((b)->conses)) +# define ASAN_POISON_CONS(p) \ + __asan_poison_memory_region ((p), sizeof (struct Lisp_Cons)) +# define ASAN_UNPOISON_CONS(p) \ + __asan_unpoison_memory_region ((p), sizeof (struct Lisp_Cons)) +#else +# define ASAN_POISON_CONS_BLOCK(b) ((void) 0) +# define ASAN_POISON_CONS(p) ((void) 0) +# define ASAN_UNPOISON_CONS(p) ((void) 0) +#endif + /* Explicitly free a cons cell by putting it on the free-list. */ void @@ -2700,6 +2865,7 @@ free_cons (struct Lisp_Cons *ptr) cons_free_list = ptr; ptrdiff_t nbytes = sizeof *ptr; tally_consing (-nbytes); + ASAN_POISON_CONS (ptr); } DEFUN ("cons", Fcons, Scons, 2, 2, 0, @@ -2712,6 +2878,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, if (cons_free_list) { + ASAN_UNPOISON_CONS (cons_free_list); XSETCONS (val, cons_free_list); cons_free_list = cons_free_list->u.s.u.chain; } @@ -2722,10 +2889,12 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, struct cons_block *new = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS); memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); + ASAN_POISON_CONS_BLOCK (new); new->next = cons_block; cons_block = new; cons_block_index = 0; } + ASAN_UNPOISON_CONS (&cons_block->conses[cons_block_index]); XSETCONS (val, &cons_block->conses[cons_block_index]); cons_block_index++; } @@ -2980,6 +3149,19 @@ static struct large_vector *large_vectors; Lisp_Object zero_vector; +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_VECTOR_CONTENTS(v, bytes) \ + __asan_poison_memory_region ((v)->contents, (bytes)) +# define ASAN_UNPOISON_VECTOR_CONTENTS(v, bytes) \ + __asan_unpoison_memory_region ((v)->contents, (bytes)) +# define ASAN_UNPOISON_VECTOR_BLOCK(b) \ + __asan_unpoison_memory_region ((b)->data, sizeof ((b)->data)) +#else +# define ASAN_POISON_VECTOR_CONTENTS(v, bytes) ((void) 0) +# define ASAN_UNPOISON_VECTOR_CONTENTS(v, bytes) ((void) 0) +# define ASAN_UNPOISON_VECTOR_BLOCK(b) ((void) 0) +#endif + /* Common shortcut to setup vector on a free list. */ static void @@ -2992,6 +3174,7 @@ setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes) ptrdiff_t vindex = VINDEX (nbytes); eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX); set_next_vector (v, vector_free_lists[vindex]); + ASAN_POISON_VECTOR_CONTENTS (v, nbytes - header_size); vector_free_lists[vindex] = v; } @@ -3039,6 +3222,7 @@ allocate_vector_from_block (ptrdiff_t nbytes) if (vector_free_lists[index]) { vector = vector_free_lists[index]; + ASAN_UNPOISON_VECTOR_CONTENTS (vector, nbytes - header_size); vector_free_lists[index] = next_vector (vector); return vector; } @@ -3052,12 +3236,18 @@ allocate_vector_from_block (ptrdiff_t nbytes) { /* This vector is larger than requested. */ vector = vector_free_lists[index]; + ASAN_UNPOISON_VECTOR_CONTENTS (vector, nbytes - header_size); vector_free_lists[index] = next_vector (vector); /* Excess bytes are used for the smaller vector, which should be set on an appropriate free list. */ restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes; eassert (restbytes % roundup_size == 0); +#if GC_ASAN_POISON_OBJECTS + /* Ensure that accessing excess bytes does not trigger ASan. */ + __asan_unpoison_memory_region (ADVANCE (vector, nbytes), + restbytes); +#endif setup_on_free_list (ADVANCE (vector, nbytes), restbytes); return vector; } @@ -3233,6 +3423,7 @@ sweep_vectors (void) for (vector = (struct Lisp_Vector *) block->data; VECTOR_IN_BLOCK (vector, block); vector = next) { + ASAN_UNPOISON_VECTOR_BLOCK (block); if (XVECTOR_MARKED_P (vector)) { XUNMARK_VECTOR (vector); @@ -3542,7 +3733,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 @@ -3608,6 +3800,23 @@ struct symbol_block struct symbol_block *next; }; +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_SYMBOL_BLOCK(s) \ + __asan_poison_memory_region ((s)->symbols, sizeof ((s)->symbols)) +# define ASAN_UNPOISON_SYMBOL_BLOCK(s) \ + __asan_unpoison_memory_region ((s)->symbols, sizeof ((s)->symbols)) +# define ASAN_POISON_SYMBOL(sym) \ + __asan_poison_memory_region ((sym), sizeof (*(sym))) +# define ASAN_UNPOISON_SYMBOL(sym) \ + __asan_unpoison_memory_region ((sym), sizeof (*(sym))) + +#else +# define ASAN_POISON_SYMBOL_BLOCK(s) ((void) 0) +# define ASAN_UNPOISON_SYMBOL_BLOCK(s) ((void) 0) +# define ASAN_POISON_SYMBOL(sym) ((void) 0) +# define ASAN_UNPOISON_SYMBOL(sym) ((void) 0) +#endif + /* Current symbol block and index of first unused Lisp_Symbol structure in it. */ @@ -3661,6 +3870,7 @@ Its value is void, and its function definition and property list are nil. */) if (symbol_free_list) { + ASAN_UNPOISON_SYMBOL (symbol_free_list); XSETSYMBOL (val, symbol_free_list); symbol_free_list = symbol_free_list->u.s.next; } @@ -3670,10 +3880,13 @@ Its value is void, and its function definition and property list are nil. */) { struct symbol_block *new = lisp_malloc (sizeof *new, false, MEM_TYPE_SYMBOL); + ASAN_POISON_SYMBOL_BLOCK (new); new->next = symbol_block; symbol_block = new; symbol_block_index = 0; } + + ASAN_UNPOISON_SYMBOL (&symbol_block->symbols[symbol_block_index]); XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); symbol_block_index++; } @@ -4561,6 +4774,11 @@ static struct Lisp_String * live_string_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_STRING); +#if GC_ASAN_POISON_OBJECTS + if (__asan_address_is_poisoned (p)) + return NULL; +#endif + struct string_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->strings[0]; @@ -4577,6 +4795,10 @@ live_string_holding (struct mem_node *m, void *p) || off == offsetof (struct Lisp_String, u.s.data)) { struct Lisp_String *s = p = cp -= off; +#if GC_ASAN_POISON_OBJECTS + if (__asan_region_is_poisoned (s, sizeof (*s))) + return NULL; +#endif if (s->u.s.data) return s; } @@ -4598,6 +4820,11 @@ static struct Lisp_Cons * live_cons_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_CONS); +#if GC_ASAN_POISON_OBJECTS + if (__asan_address_is_poisoned (p)) + return NULL; +#endif + struct cons_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->conses[0]; @@ -4615,6 +4842,10 @@ live_cons_holding (struct mem_node *m, void *p) || off == offsetof (struct Lisp_Cons, u.s.u.cdr)) { struct Lisp_Cons *s = p = cp -= off; +#if GC_ASAN_POISON_OBJECTS + if (__asan_region_is_poisoned (s, sizeof (*s))) + return NULL; +#endif if (!deadp (s->u.s.car)) return s; } @@ -4637,6 +4868,10 @@ static struct Lisp_Symbol * live_symbol_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_SYMBOL); +#if GC_ASAN_POISON_OBJECTS + if (__asan_address_is_poisoned (p)) + return NULL; +#endif struct symbol_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->symbols[0]; @@ -4662,6 +4897,10 @@ live_symbol_holding (struct mem_node *m, void *p) || off == offsetof (struct Lisp_Symbol, u.s.next)) { struct Lisp_Symbol *s = p = cp -= off; +#if GC_ASAN_POISON_OBJECTS + if (__asan_region_is_poisoned (s, sizeof (*s))) + return NULL; +#endif if (!deadp (s->u.s.function)) return s; } @@ -4684,6 +4923,11 @@ static struct Lisp_Float * live_float_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_FLOAT); +#if GC_ASAN_POISON_OBJECTS + if (__asan_address_is_poisoned (p)) + return NULL; +#endif + struct float_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->floats[0]; @@ -4698,8 +4942,12 @@ live_float_holding (struct mem_node *m, void *p) && (b != float_block || offset / sizeof b->floats[0] < float_block_index)) { - p = cp - off; - return p; + struct Lisp_Float *f = (struct Lisp_Float *) (cp - off); +#if GC_ASAN_POISON_OBJECTS + if (__asan_region_is_poisoned (f, sizeof (*f))) + return NULL; +#endif + return f; } } return NULL; @@ -5687,7 +5935,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]); @@ -6221,6 +6469,7 @@ garbage_collect (void) #ifdef HAVE_X_WINDOWS mark_xterm (); + mark_xselect (); #endif #ifdef HAVE_NS @@ -6554,7 +6803,7 @@ mark_buffer (struct buffer *buffer) if (!BUFFER_LIVE_P (buffer)) mark_object (BVAR (buffer, undo_list)); - if (buffer->overlays) + if (!itree_empty_p (buffer->overlays)) mark_overlays (buffer->overlays->root); /* If this is an indirect buffer, mark its base buffer. */ @@ -7180,11 +7429,13 @@ sweep_conses (void) struct Lisp_Cons *acons = &cblk->conses[pos]; if (!XCONS_MARKED_P (acons)) { + ASAN_UNPOISON_CONS (&cblk->conses[pos]); this_free++; cblk->conses[pos].u.s.u.chain = cons_free_list; cons_free_list = &cblk->conses[pos]; cons_free_list->u.s.car = dead_object (); - } + ASAN_POISON_CONS (&cblk->conses[pos]); + } else { num_used++; @@ -7202,6 +7453,7 @@ sweep_conses (void) { *cprev = cblk->next; /* Unhook from the free list. */ + ASAN_UNPOISON_CONS (&cblk->conses[0]); cons_free_list = cblk->conses[0].u.s.u.chain; lisp_align_free (cblk); } @@ -7228,6 +7480,7 @@ sweep_floats (void) for (struct float_block *fblk; (fblk = *fprev); ) { int this_free = 0; + ASAN_UNPOISON_FLOAT_BLOCK (fblk); for (int i = 0; i < lim; i++) { struct Lisp_Float *afloat = &fblk->floats[i]; @@ -7235,6 +7488,7 @@ sweep_floats (void) { this_free++; fblk->floats[i].u.chain = float_free_list; + ASAN_POISON_FLOAT (&fblk->floats[i]); float_free_list = &fblk->floats[i]; } else @@ -7251,7 +7505,8 @@ sweep_floats (void) { *fprev = fblk->next; /* Unhook from the free list. */ - float_free_list = fblk->floats[0].u.chain; + ASAN_UNPOISON_FLOAT (&fblk->floats[0]); + float_free_list = fblk->floats[0].u.chain; lisp_align_free (fblk); } else @@ -7277,13 +7532,14 @@ sweep_intervals (void) for (struct interval_block *iblk; (iblk = *iprev); ) { int this_free = 0; - + ASAN_UNPOISON_INTERVAL_BLOCK (iblk); for (int i = 0; i < lim; i++) { if (!iblk->intervals[i].gcmarkbit) { set_interval_parent (&iblk->intervals[i], interval_free_list); interval_free_list = &iblk->intervals[i]; + ASAN_POISON_INTERVAL (&iblk->intervals[i]); this_free++; } else @@ -7300,6 +7556,7 @@ sweep_intervals (void) { *iprev = iblk->next; /* Unhook from the free list. */ + ASAN_UNPOISON_INTERVAL (&iblk->intervals[0]); interval_free_list = INTERVAL_PARENT (&iblk->intervals[0]); lisp_free (iblk); } @@ -7329,6 +7586,8 @@ sweep_symbols (void) for (sblk = symbol_block; sblk; sblk = *sprev) { + ASAN_UNPOISON_SYMBOL_BLOCK (sblk); + int this_free = 0; struct Lisp_Symbol *sym = sblk->symbols; struct Lisp_Symbol *end = sym + lim; @@ -7350,7 +7609,8 @@ sweep_symbols (void) sym->u.s.next = symbol_free_list; symbol_free_list = sym; symbol_free_list->u.s.function = dead_object (); - ++this_free; + ASAN_POISON_SYMBOL (sym); + ++this_free; } else { @@ -7369,6 +7629,7 @@ sweep_symbols (void) { *sprev = sblk->next; /* Unhook from the free list. */ + ASAN_UNPOISON_SYMBOL (&sblk->symbols[0]); symbol_free_list = sblk->symbols[0].u.s.next; lisp_free (sblk); } 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 23340b4c0ee..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 @@ -1266,8 +1266,7 @@ set_buffer_intervals (struct buffer *b, INTERVAL i) INLINE bool buffer_has_overlays (void) { - return current_buffer->overlays - && (current_buffer->overlays->root != NULL); + return !itree_empty_p (current_buffer->overlays); } /* Functions for accessing a character or byte, 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/coding.c b/src/coding.c index 49dcd8634f3..a2e0d7040f8 100644 --- a/src/coding.c +++ b/src/coding.c @@ -651,6 +651,12 @@ growable_destination (struct coding_system *coding) consumed_chars++; \ } while (0) +/* Suppress clang warnings about consumed_chars never being used. + Although correct, the warnings are too much trouble to code around. */ +#if 13 <= __clang_major__ - defined __apple_build_version__ +# pragma clang diagnostic ignored "-Wunused-but-set-variable" +#endif + /* Safely get two bytes from the source text pointed by SRC which ends at SRC_END, and set C1 and C2 to those bytes while skipping the heading multibyte characters. If there are not enough bytes in the diff --git a/src/comp.c b/src/comp.c index bd7ecfffc23..5cbe441dd7f 100644 --- a/src/comp.c +++ b/src/comp.c @@ -514,6 +514,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)) @@ -531,7 +535,7 @@ load_gccjit_if_necessary (bool mandatory) #define SETJMP_NAME SETJMP /* Max number function importable by native compiled code. */ -#define F_RELOC_MAX_SIZE 1500 +#define F_RELOC_MAX_SIZE 1600 typedef struct { void *link_table[F_RELOC_MAX_SIZE]; @@ -4991,7 +4995,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); @@ -5173,8 +5178,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) @@ -5671,28 +5675,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"); @@ -5836,74 +5830,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); @@ -5912,6 +5915,3 @@ file -> CU. */); defsubr (&Snative_comp_available_p); } -/* Local Variables: */ -/* c-file-offsets: ((arglist-intro . +)) */ -/* End: */ diff --git a/src/data.c b/src/data.c index bb4d1347d72..8dc5000424e 100644 --- a/src/data.c +++ b/src/data.c @@ -773,7 +773,10 @@ DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, } DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, - doc: /* Return SYMBOL's name, a string. */) + doc: /* Return SYMBOL's name, a string. + +Warning: never alter the string returned by `symbol-name'. +Doing that might make Emacs dysfunctional, and might even crash Emacs. */) (register Lisp_Object symbol) { register Lisp_Object name; @@ -840,7 +843,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 +857,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 +1089,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 +1179,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 +2493,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. */ @@ -2619,6 +2597,7 @@ bool-vector. IDX starts at 0. */) } else if (RECORDP (array)) { + CHECK_IMPURE (array, XVECTOR (array)); if (idxval < 0 || idxval >= PVSIZE (array)) args_out_of_range (array, idx); ASET (array, idxval, newelt); diff --git a/src/dispnew.c b/src/dispnew.c index a0a37acb804..43306043a0c 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3188,7 +3188,7 @@ DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "", Lisp_Object tail, frame; FOR_EACH_FRAME (tail, frame) - if (FRAME_VISIBLE_P (XFRAME (frame))) + if (FRAME_REDISPLAY_P (XFRAME (frame))) redraw_frame (XFRAME (frame)); return Qnil; @@ -5009,6 +5009,10 @@ update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p, } while (row > top && col == 0); + /* We exit the loop with COL at the glyph _after_ the last one. */ + if (col > 0) + col--; + /* Make sure COL is not out of range. */ if (col >= FRAME_CURSOR_X_LIMIT (f)) { diff --git a/src/doc.c b/src/doc.c index df57f84603e..174341523d7 100644 --- a/src/doc.c +++ b/src/doc.c @@ -330,19 +330,7 @@ string is passed through `substitute-command-keys'. */) xsignal1 (Qvoid_function, function); if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) fun = XCDR (fun); -#ifdef HAVE_NATIVE_COMP - if (!NILP (Fsubr_native_elisp_p (fun))) - doc = native_function_doc (fun); - else -#endif - if (SUBRP (fun)) - doc = make_fixnum (XSUBR (fun)->doc); -#ifdef HAVE_MODULES - else if (MODULE_FUNCTIONP (fun)) - doc = module_function_documentation (XMODULE_FUNCTION (fun)); -#endif - else - doc = call1 (Qfunction_documentation, fun); + doc = call1 (Qfunction_documentation, fun); /* If DOC is 0, it's typically because of a dumped file missing from the DOC file (bug in src/Makefile.in). */ @@ -371,6 +359,25 @@ string is passed through `substitute-command-keys'. */) return doc; } +DEFUN ("internal-subr-documentation", Fsubr_documentation, Ssubr_documentation, 1, 1, 0, + doc: /* Return the raw documentation info of a C primitive. */) + (Lisp_Object function) +{ +#ifdef HAVE_NATIVE_COMP + if (!NILP (Fsubr_native_elisp_p (function))) + return native_function_doc (function); + else +#endif + if (SUBRP (function)) + return make_fixnum (XSUBR (function)->doc); +#ifdef HAVE_MODULES + else if (MODULE_FUNCTIONP (function)) + return module_function_documentation (XMODULE_FUNCTION (function)); +#endif + else + return Qt; +} + DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 3, 0, doc: /* Return the documentation string that is SYMBOL's PROP property. @@ -713,6 +720,7 @@ compute the correct value for the current terminal in the nil case. */); /* Initialized by ‘main’. */ defsubr (&Sdocumentation); + defsubr (&Ssubr_documentation); defsubr (&Sdocumentation_property); defsubr (&Ssnarf_documentation); defsubr (&Stext_quoting_style); 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-module.h.in b/src/emacs-module.h.in index 6a23aa708e4..a455c41a5f1 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -183,6 +183,21 @@ struct emacs_env_29 @module_env_snippet_29@ }; +struct emacs_env_30 +{ +@module_env_snippet_25@ + +@module_env_snippet_26@ + +@module_env_snippet_27@ + +@module_env_snippet_28@ + +@module_env_snippet_29@ + +@module_env_snippet_30@ +}; + /* Every module should define a function as follows. */ extern int emacs_module_init (struct emacs_runtime *runtime) EMACS_NOEXCEPT diff --git a/src/emacs.c b/src/emacs.c index 214e2e2a296..80a013b68df 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1954,7 +1954,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem /* Do less garbage collection in batch mode (since these tend to be more short-lived, and the memory is returned to the OS on exit anyway). */ - Vgc_cons_percentage = make_float (noninteractive? 1.0: 0.1); + Vgc_cons_percentage = make_float (noninteractive && initialized ? 1.0 : 0.1); no_loadup = argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args); @@ -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 2dd0c356e88..eb40c953f96 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1367,7 +1367,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, error ("Invalid condition handler: %s", SDATA (Fprin1_to_string (tem, Qt, Qnil))); if (CONSP (tem) && EQ (XCAR (tem), QCsuccess)) - success_handler = XCDR (tem); + success_handler = tem; else clausenb++; } @@ -1430,7 +1430,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, if (!NILP (success_handler)) { if (NILP (var)) - return Fprogn (success_handler); + return Fprogn (XCDR (success_handler)); Lisp_Object handler_var = var; if (!NILP (Vinternal_interpreter_environment)) @@ -1442,7 +1442,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, result); - return unbind_to (count, Fprogn (success_handler)); + return unbind_to (count, Fprogn (XCDR (success_handler))); } return result; } @@ -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 f00c389a520..b80f8d61de4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -134,6 +134,7 @@ static dev_t timestamp_file_system; is added here. */ static Lisp_Object Vwrite_region_annotation_buffers; +static Lisp_Object emacs_readlinkat (int, char const *); static Lisp_Object file_name_directory (Lisp_Object); static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, Lisp_Object *, struct coding_system *); @@ -2219,7 +2220,7 @@ permissions. */) report_file_error ("Copying permissions to", newname); } #else /* not WINDOWSNT */ - ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); + ifd = emacs_open (SSDATA (encoded_file), O_RDONLY | O_NONBLOCK, 0); if (ifd < 0) report_file_error ("Opening input file", file); @@ -2705,31 +2706,19 @@ This is what happens in interactive use with M-x. */) } if (dirp) call4 (Qcopy_directory, file, newname, Qt, Qnil); - else - { - Lisp_Object symlink_target - = (S_ISLNK (file_st.st_mode) - ? check_emacs_readlinkat (AT_FDCWD, file, SSDATA (encoded_file)) - : Qnil); - if (!NILP (symlink_target)) - Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); - else if (S_ISFIFO (file_st.st_mode)) - { - /* If it's a FIFO, calling `copy-file' will hang if it's a - inter-file system move, so do it here. (It will signal - an error in that case, but it won't hang in any case.) */ - if (!NILP (ok_if_already_exists)) - barf_or_query_if_file_exists (newname, false, - "rename to it", - FIXNUMP (ok_if_already_exists), - false); - if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) != 0) - report_file_errno ("Renaming", list2 (file, newname), errno); - return Qnil; - } + else if (S_ISREG (file_st.st_mode)) + Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); + else if (S_ISLNK (file_st.st_mode)) + { + Lisp_Object target = emacs_readlinkat (AT_FDCWD, + SSDATA (encoded_file)); + if (!NILP (target)) + Fmake_symbolic_link (target, newname, ok_if_already_exists); else - Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); + report_file_error ("Renaming", list2 (file, newname)); } + else + report_file_errno ("Renaming", list2 (file, newname), rename_errno); specpdl_ref count = SPECPDL_INDEX (); specbind (Qdelete_by_moving_to_trash, Qnil); @@ -3918,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; @@ -3932,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 @@ -3981,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); @@ -4023,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)) { @@ -4031,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); @@ -4117,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 @@ -4135,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); @@ -4420,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)); @@ -4596,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)) { @@ -4605,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; @@ -4619,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. */ @@ -4646,7 +4631,7 @@ by calling `format-decode', which see. */) if (NILP (nbytes)) { - read_quit = true; + read_quit = 1; break; } @@ -4665,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; } } @@ -4698,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: @@ -6345,24 +6322,6 @@ init_fileio (void) umask (realmask); valid_timestamp_file_system = 0; - - /* fsync can be a significant performance hit. Often it doesn't - suffice to make the file-save operation survive a crash. For - batch scripts, which are typically part of larger shell commands - that don't fsync other files, its effect on performance can be - significant so its utility is particularly questionable. - Hence, for now by default fsync is used only when interactive. - - For more on why fsync often fails to work on today's hardware, see: - Zheng M et al. Understanding the robustness of SSDs under power fault. - 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84 - https://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf - - For more on why fsync does not suffice even if it works properly, see: - Roche X. Necessary step(s) to synchronize filename operations on disk. - Austin Group Defect 672, 2013-03-19 - https://austingroupbugs.net/view.php?id=672 */ - write_region_inhibit_fsync = noninteractive; } void @@ -6620,9 +6579,22 @@ file is usually more useful if it contains the deleted text. */); DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync, doc: /* Non-nil means don't call fsync in `write-region'. This variable affects calls to `write-region' as well as save commands. -Setting this to nil may avoid data loss if the system loses power or -the operating system crashes. By default, it is non-nil in batch mode. */); - write_region_inhibit_fsync = 0; /* See also `init_fileio' above. */ +By default, it is non-nil. + +Although setting this to nil may avoid data loss if the system loses power, +it can be a significant performance hit in the usual case, and it doesn't +necessarily cause file-save operations to actually survive a crash. */); + + /* For more on why fsync often fails to work on today's hardware, see: + Zheng M et al. Understanding the robustness of SSDs under power fault. + 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84 + https://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf + + For more on why fsync does not suffice even if it works properly, see: + Roche X. Necessary step(s) to synchronize filename operations on disk. + Austin Group Defect 672, 2013-03-19 + https://austingroupbugs.net/view.php?id=672 */ + write_region_inhibit_fsync = true; DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash, doc: /* Specifies whether to use the system's trash can. diff --git a/src/floatfns.c b/src/floatfns.c index 1d891ef3ce1..13f0ca3e129 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -27,19 +27,22 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ frexp, ldexp, log, log10 [via (log X 10)], *modf, pow, sin, *sinh, sqrt, tan, *tanh. - C99 and C11 require the following math.h functions in addition to + C99, C11 and C17 require the following math.h functions in addition to the C89 functions. Of these, Emacs currently exports only the starred ones to Lisp, since we haven't found a use for the others. Also, it uses the ones marked "+" internally: acosh, atanh, cbrt, copysign (implemented by signbit), erf, erfc, exp2, expm1, fdim, fma, fmax, fmin, fpclassify, hypot, +ilogb, - isfinite, isgreater, isgreaterequal, isinf, isless, islessequal, + +isfinite, isgreater, isgreaterequal, +isinf, isless, islessequal, islessgreater, *isnan, isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], logb (approximately; implemented by frexp), +lrint/llrint, +lround/llround, nan, nearbyint, nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, +scalbn, +signbit, tgamma, *trunc. + C23 requires many more math.h functions. Emacs does not yet export + or use them. + The C standard also requires functions for float and long double that are not listed above. Of these functions, Emacs uses only the following internally: fabsf, powf, sprintf. diff --git a/src/fns.c b/src/fns.c index 3984e318feb..0af9b725c7a 100644 --- a/src/fns.c +++ b/src/fns.c @@ -501,8 +501,13 @@ Symbols are also allowed; their print names are used instead. */) int ws = sizeof (word_t); const word_t *w1 = (const word_t *) SDATA (string1); const word_t *w2 = (const word_t *) SDATA (string2); - while (b < nb - ws + 1 && w1[b / ws] == w2[b / ws]) - b += ws; + while (b < nb - ws + 1) + { + if (UNALIGNED_LOAD_SIZE (w1, b / ws) + != UNALIGNED_LOAD_SIZE (w2, b / ws)) + break; + b += ws; + } } /* Scan forward to the differing byte. */ @@ -3177,13 +3182,14 @@ DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, Return t if answer is yes, and nil if the answer is no. PROMPT is the string to display to ask the question; `yes-or-no-p' -adds \"(yes or no) \" to it. +appends `yes-or-no-prompt' (default \"(yes or no) \") to it. The user must confirm the answer with RET, and can edit it until it has been confirmed. If the `use-short-answers' variable is non-nil, instead of asking for -\"yes\" or \"no\", this function will ask for \"y\" or \"n\". +\"yes\" or \"no\", this function will ask for \"y\" or \"n\" (and +ignore the value of `yes-or-no-prompt'). If dialog boxes are supported, a dialog box will be used if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) @@ -3208,8 +3214,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) if (use_short_answers) return call1 (intern ("y-or-n-p"), prompt); - AUTO_STRING (yes_or_no, "(yes or no) "); - prompt = CALLN (Fconcat, prompt, yes_or_no); + prompt = CALLN (Fconcat, prompt, Vyes_or_no_prompt); specpdl_ref count = SPECPDL_INDEX (); specbind (Qenable_recursive_minibuffers, Qt); @@ -5804,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 @@ -5839,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 @@ -6260,9 +6266,15 @@ When non-nil, `yes-or-no-p' will use `y-or-n-p' to read the answer. We recommend against setting this variable non-nil, because `yes-or-no-p' is intended to be used when users are expected not to respond too quickly, but to take their time and perhaps think about the answer. -The same variable also affects the function `read-answer'. */); +The same variable also affects the function `read-answer'. See also +`yes-or-no-prompt'. */); use_short_answers = false; + DEFVAR_LISP ("yes-or-no-prompt", Vyes_or_no_prompt, + doc: /* String to append when `yes-or-no-p' asks a question. +For best results this should end in a space. */); + Vyes_or_no_prompt = make_unibyte_string ("(yes or no) ", strlen ("(yes or no) ")); + defsubr (&Sidentity); defsubr (&Srandom); defsubr (&Slength); diff --git a/src/frame.c b/src/frame.c index 38a6583605c..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))) @@ -1892,12 +1892,61 @@ other_frames (struct frame *f, bool invisible, bool force) if (f != f1) { + /* The following code is defined out because it is + responsible for a performance drop under X connections + over a network, and its purpose is unclear. XSync does + not handle events (or call any callbacks defined by + Emacs), and as such it should not note any "recent change + in visibility". + + When writing new code, please try as hard as possible to + avoid calls that require a roundtrip to the X server. + When such calls are inevitable, use the XCB library to + handle multiple consecutive requests with a data reply in + a more asynchronous fashion. The following code + demonstrates why: + + rc = XGetWindowProperty (dpyinfo->display, window, ... + status = XGrabKeyboard (dpyinfo->display, ... + + here, `XGetWindowProperty' will wait for a reply from the + X server before returning, and thus allowing Emacs to + make the XGrabKeyboard request, which in itself also + requires waiting a reply. When XCB is available, this + code could be written: + +#ifdef HAVE_XCB + xcb_get_property_cookie_t cookie1; + xcb_get_property_reply_t *reply1; + xcb_grab_keyboard_cookie_t cookie2; + xcb_grab_keyboard_reply_t *reply2; + + cookie1 = xcb_get_property (dpyinfo->xcb_connection, window, ... + cookie2 = xcb_grab_keyboard (dpyinfo->xcb_connection, ... + reply1 = xcb_get_property_reply (dpyinfo->xcb_connection, + cookie1); + reply2 = xcb_grab_keyboard_reply (dpyinfo->xcb_connection, + cookie2); +#endif + + In this code, the GetProperty and GrabKeyboard requests + are made simultaneously, and replies are then obtained + from the server at once, avoiding the extraneous + roundtrip to the X server after the call to + `XGetWindowProperty'. + + However, please keep an alternative implementation + available for use when Emacs is built without XCB. */ + +#if 0 /* Verify that we can still talk to the frame's X window, and note any recent change in visibility. */ #ifdef HAVE_X_WINDOWS if (FRAME_WINDOW_P (f1)) x_sync (f1); #endif +#endif + if (!FRAME_TOOLTIP_P (f1) /* Tooltips and child frames count neither for invisibility nor for deletions. */ diff --git a/src/frame.h b/src/frame.h index 4a4c8c38447..b95b94c7685 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1010,6 +1010,20 @@ default_pixels_per_inch_y (void) /* True if frame F is currently visible. */ #define FRAME_VISIBLE_P(f) (f)->visible +/* True if frame F should be redisplayed. This is normally the same + as FRAME_VISIBLE_P (f). Under X, frames can continue to be + displayed to the user by the compositing manager even if they are + invisible, so this also checks whether or not the frame is reported + visible by the X server. */ + +#ifndef HAVE_X_WINDOWS +#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f)) +#else +#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f) \ + || (FRAME_X_P (f) \ + && FRAME_X_VISIBLE (f))) +#endif + /* True if frame F is currently visible but hidden. */ #define FRAME_OBSCURED_P(f) ((f)->visible > 1) @@ -1718,7 +1732,6 @@ extern void x_wm_set_icon_position (struct frame *, int, int); #if !defined USE_X_TOOLKIT extern const char *x_get_resource_string (const char *, const char *); #endif -extern void x_sync (struct frame *); #endif /* HAVE_X_WINDOWS */ #if !defined (HAVE_NS) && !defined (HAVE_PGTK) diff --git a/src/gnutls.c b/src/gnutls.c index 91e369375f2..ca7e9fc4c73 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -34,6 +34,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # endif # if GNUTLS_VERSION_NUMBER >= 0x030200 +# define HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 # define HAVE_GNUTLS_CIPHER_GET_IV_SIZE # endif @@ -121,6 +122,11 @@ DEF_DLL_FN (int, gnutls_certificate_set_x509_crl_file, DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file, (gnutls_certificate_credentials_t, const char *, const char *, gnutls_x509_crt_fmt_t)); +# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 +DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file2, + (gnutls_certificate_credentials_t, const char *, const char *, + gnutls_x509_crt_fmt_t, const char *, unsigned int)); +# endif # ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust, (gnutls_certificate_credentials_t)); @@ -314,6 +320,9 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_certificate_set_verify_flags); LOAD_DLL_FN (library, gnutls_certificate_set_x509_crl_file); LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file); +# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 + LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file2); +# endif # ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust); # endif @@ -455,6 +464,9 @@ init_gnutls_functions (void) # define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags # define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file # define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file +# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 +# define gnutls_certificate_set_x509_key_file2 fn_gnutls_certificate_set_x509_key_file2 +# endif # define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust # define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file # define gnutls_certificate_type_get fn_gnutls_certificate_type_get @@ -1774,6 +1786,88 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) return gnutls_make_error (ret); } +#ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 + +/* Helper function for gnutls-boot. + + The key :flags receives a list of symbols, each of which + corresponds to a GnuTLS C flag, the ORed result is to be passed to + the function `gnutls_certificate_set_x509_key_file2' as its last + argument. */ +static unsigned int +key_file2_aux (Lisp_Object flags) +{ + unsigned int rv = 0; + Lisp_Object tail = flags; + FOR_EACH_TAIL_SAFE (tail) + { + Lisp_Object flag = XCAR (tail); + if (EQ (flag, Qgnutls_pkcs_plain)) + rv |= GNUTLS_PKCS_PLAIN; +#ifdef GNUTLS_PKCS_PKCS12_3DES + else if (EQ (flag, Qgnutls_pkcs_pkcs12_3des)) + rv |= GNUTLS_PKCS_PKCS12_3DES; +#endif +#ifdef GNUTLS_PKCS_PKCS12_ARCFOUR + else if (EQ (flag, Qgnutls_pkcs_pkcs12_arcfour)) + rv |= GNUTLS_PKCS_PKCS12_ARCFOUR; +#endif +#ifdef GNUTLS_PKCS_PKCS12_RC2_40 + else if (EQ (flag, Qgnutls_pkcs_pkcs12_rc2_40)) + rv |= GNUTLS_PKCS_PKCS12_RC2_40; +#endif +#ifdef GNUTLS_PKCS_PBES2_3DES + else if (EQ (flag, Qgnutls_pkcs_pbes2_3des)) + rv |= GNUTLS_PKCS_PBES2_3DES; +#endif +#ifdef GNUTLS_PKCS_PBES2_AES_128 + else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_128)) + rv |= GNUTLS_PKCS_PBES2_AES_128; +#endif +#ifdef GNUTLS_PKCS_PBES2_AES_192 + else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_192)) + rv |= GNUTLS_PKCS_PBES2_AES_192; +#endif +#ifdef GNUTLS_PKCS_PBES2_AES_256 + else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_256)) + rv |= GNUTLS_PKCS_PBES2_AES_256; +#endif + else if (EQ (flag, Qgnutls_pkcs_null_password)) + rv |= GNUTLS_PKCS_NULL_PASSWORD; +#ifdef GNUTLS_PKCS_PBES2_DES + else if (EQ (flag, Qgnutls_pkcs_pbes2_des)) + rv |= GNUTLS_PKCS_PBES2_DES; +#endif +#ifdef GNUTLS_PKCS_PBES1_DES_MD5 + else if (EQ (flag, Qgnutls_pkcs_pbes1_des_md5)) + rv |= GNUTLS_PKCS_PBES1_DES_MD5; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_TC26Z + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_tc26z)) + rv |= GNUTLS_PKCS_PBES2_GOST_TC26Z; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_CPA + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpa)) + rv |= GNUTLS_PKCS_PBES2_GOST_CPA; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_CPB + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpb)) + rv |= GNUTLS_PKCS_PBES2_GOST_CPB; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_CPC + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpc)) + rv |= GNUTLS_PKCS_PBES2_GOST_CPC; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_CPD + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpd)) + rv |= GNUTLS_PKCS_PBES2_GOST_CPD; +#endif + } + return rv; +} + +#endif /* HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 */ + DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0, doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST. Currently only client mode is supported. Return a success/failure @@ -1813,6 +1907,22 @@ accept in Diffie-Hellman key exchange. :complete-negotiation, if non-nil, will make negotiation complete before returning even on non-blocking sockets. +:pass, the password of the private key as per GnuTLS' +gnutls_certificate_set_x509_key_file2. Specify as nil to have a NULL +password. + +:flags, a list of symbols relating to :pass, each specifying a flag: +GNUTLS_PKCS_PLAIN, GNUTLS_PKCS_PKCS12_3DES, +GNUTLS_PKCS_PKCS12_ARCFOUR, GNUTLS_PKCS_PKCS12_RC2_40, +GNUTLS_PKCS_PBES2_3DES, GNUTLS_PKCS_PBES2_AES_128, +GNUTLS_PKCS_PBES2_AES_192, GNUTLS_PKCS_PBES2_AES_256, +GNUTLS_PKCS_NULL_PASSWORD, GNUTLS_PKCS_PBES2_DES, +GNUTLS_PKCS_PBES2_DES_MD5, GNUTLS_PKCS_PBES2_GOST_TC26Z, +GNUTLS_PKCS_PBES2_GOST_CPA, GNUTLS_PKCS_PBES2_GOST_CPB, +GNUTLS_PKCS_PBES2_GOST_CPC, GNUTLS_PKCS_PBES2_GOST_CPD. If not +specified, or if nil, the bitflag with value 0 is used. +Note that some of these are only supported since GnuTLS 3.6.3. + The debug level will be set for this process AND globally for GnuTLS. So if you set it higher or lower at any point, it affects global debugging. @@ -1825,6 +1935,9 @@ Processes must be initialized with this function before other GnuTLS functions are used. This function allocates resources which can only be deallocated by calling `gnutls-deinit' or by calling it again. +The :pass and :flags keys are ignored with old versions of GnuTLS, and +:flags is ignored if :pass is not specified. + The callbacks alist can have a `verify' key, associated with a verification function (UNUSED). @@ -1842,16 +1955,22 @@ one trustfile (usually a CA bundle). */) Lisp_Object global_init; char const *priority_string_ptr = "NORMAL"; /* default priority string. */ char *c_hostname; + const char *c_pass; /* Placeholders for the property list elements. */ Lisp_Object priority_string; Lisp_Object trustfiles; Lisp_Object crlfiles; Lisp_Object keylist; + Lisp_Object pass; + Lisp_Object flags; /* Lisp_Object callbacks; */ Lisp_Object loglevel; Lisp_Object hostname; Lisp_Object prime_bits; +#ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 + unsigned int aux_key_file; +#endif struct Lisp_Process *p = XPROCESS (proc); CHECK_PROCESS (proc); @@ -1877,6 +1996,13 @@ one trustfile (usually a CA bundle). */) crlfiles = plist_get (proplist, QCcrlfiles); loglevel = plist_get (proplist, QCloglevel); prime_bits = plist_get (proplist, QCmin_prime_bits); + pass = plist_get (proplist, QCpass); + flags = plist_get (proplist, QCflags); + + if (STRINGP (pass)) + c_pass = SSDATA (pass); + else + c_pass = NULL; if (!STRINGP (hostname)) { @@ -2038,6 +2164,20 @@ one trustfile (usually a CA bundle). */) keyfile = ansi_encode_filename (keyfile); certfile = ansi_encode_filename (certfile); # endif +# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 + if (!NILP (plist_member (proplist, QCpass))) + { + aux_key_file = key_file2_aux (flags); + ret + = gnutls_certificate_set_x509_key_file2 (x509_cred, + SSDATA (certfile), + SSDATA (keyfile), + file_format, + c_pass, + aux_key_file); + } + else +# endif ret = gnutls_certificate_set_x509_key_file (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format); @@ -2265,6 +2405,9 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, aead_auth_size = aend_byte - astart_byte; } + /* Only block ciphers require that ISIZE be a multiple of the block + size, and AEAD ciphers are not block ciphers. */ +#if 0 ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size; ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca); @@ -2274,6 +2417,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, "is not %"pD"d greater than a multiple of the required %"pD"d"), gnutls_cipher_get_name (gca), desc, isize, expected_remainder, cipher_block_size); +#endif ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt) (acipher, vdata, vsize, aead_auth_data, aead_auth_size, @@ -2282,7 +2426,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object output; if (GNUTLS_E_SUCCESS <= ret) output = make_unibyte_string (storage, storage_length); - explicit_bzero (storage, storage_length); + memset_explicit (storage, 0, storage_length); gnutls_aead_cipher_deinit (acipher); if (ret < GNUTLS_E_SUCCESS) @@ -2862,8 +3006,26 @@ level in the ones. For builds without libgnutls, the value is -1. */); DEFSYM (QCmin_prime_bits, ":min-prime-bits"); DEFSYM (QCloglevel, ":loglevel"); DEFSYM (QCcomplete_negotiation, ":complete-negotiation"); + DEFSYM (QCpass, ":pass"); + DEFSYM (QCflags, ":flags"); DEFSYM (QCverify_flags, ":verify-flags"); DEFSYM (QCverify_error, ":verify-error"); + DEFSYM (Qgnutls_pkcs_plain, "GNUTLS_PKCS_PLAIN"); + DEFSYM (Qgnutls_pkcs_pkcs12_3des, "GNUTLS_PKCS_PKCS12_3DES"); + DEFSYM (Qgnutls_pkcs_pkcs12_arcfour, "GNUTLS_PKCS_PKCS12_ARCFOUR"); + DEFSYM (Qgnutls_pkcs_pkcs12_rc2_40, "GNUTLS_PKCS_PKCS12_RC2_40"); + DEFSYM (Qgnutls_pkcs_pbes2_3des, "GNUTLS_PKCS_PBES2_3DES"); + DEFSYM (Qgnutls_pkcs_pbes2_aes_128, "GNUTLS_PKCS_PBES2_AES_128"); + DEFSYM (Qgnutls_pkcs_pbes2_aes_192, "GNUTLS_PKCS_PBES2_AES_192"); + DEFSYM (Qgnutls_pkcs_pbes2_aes_256, "GNUTLS_PKCS_PBES2_AES_256"); + DEFSYM (Qgnutls_pkcs_null_password, "GNUTLS_PKCS_NULL_PASSWORD"); + DEFSYM (Qgnutls_pkcs_pbes2_des, "GNUTLS_PKCS_PBES2_DES"); + DEFSYM (Qgnutls_pkcs_pbes1_des_md5, "GNUTLS_PKCS_PBES1_DES_MD5"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_tc26z, "GNUTLS_PKCS_PBES2_GOST_TC26Z"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_cpa, "GNUTLS_PKCS_PBES2_GOST_CPA"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_cpb, "GNUTLS_PKCS_PBES2_GOST_CPB"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_cpc, "GNUTLS_PKCS_PBES2_GOST_CPC"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_cpd, "GNUTLS_PKCS_PBES2_GOST_CPD"); DEFSYM (QCcipher_id, ":cipher-id"); DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable"); diff --git a/src/gtkutil.c b/src/gtkutil.c index f5e70305ead..4cc0f9f15b4 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -2103,7 +2103,7 @@ xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) gdk_window_restack (gwin1, gwin2, above_flag); #ifndef HAVE_PGTK - x_sync (f1); + XSync (FRAME_X_DISPLAY (f1), False); #else gdk_flush (); #endif @@ -4793,7 +4793,7 @@ xg_update_scrollbar_pos (struct frame *f, here to get some events. */ #ifndef HAVE_PGTK - x_sync (f); + XSync (FRAME_X_DISPLAY (f), False); #else gdk_flush (); #endif @@ -4894,7 +4894,7 @@ xg_update_horizontal_scrollbar_pos (struct frame *f, } #ifndef HAVE_PGTK - x_sync (f); + XSync (FRAME_X_DISPLAY (f), False); #else gdk_flush (); #endif diff --git a/src/haikufont.c b/src/haikufont.c index 4599ca40c47..b4c2e547247 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -754,22 +754,30 @@ haikufont_encode_char (struct font *font, int c) } static Lisp_Object -haikufont_open (struct frame *f, Lisp_Object font_entity, int x) +haikufont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) { struct haikufont_info *font_info; 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; - if (x <= 0) + if (XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)) != 0) + pixel_size = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)); + else if (pixel_size == 0) { - /* Get pixel size from frame instead. */ - tem = get_frame_param (f, Qfontsize); - x = NILP (tem) ? 0 : XFIXNAT (tem); + /* Try to resolve a suitable size for the font, if the font size + has not already been specified. First, if FRAME_FONT is set, + use its size. Otherwise, use 12, which is the default on + Haiku. */ + + if (FRAME_FONT (f)) + pixel_size = FRAME_FONT (f)->pixel_size; + else + pixel_size = 12; } extra = AREF (font_entity, FONT_EXTRA_INDEX); @@ -788,7 +796,8 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) { block_input (); be_font = be_open_font_at_index (XFIXNUM (XCAR (indices)), - XFIXNUM (XCDR (indices)), x); + XFIXNUM (XCDR (indices)), + pixel_size); unblock_input (); if (!be_font) @@ -799,7 +808,7 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) block_input (); haikufont_spec_or_entity_to_pattern (font_entity, 1, &ptn); - if (BFont_open_pattern (&ptn, &be_font, x)) + if (BFont_open_pattern (&ptn, &be_font, pixel_size)) { haikufont_done_with_query_pattern (&ptn); unblock_input (); @@ -813,7 +822,7 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) block_input (); font_object = font_make_object (VECSIZE (struct haikufont_info), - font_entity, x); + font_entity, pixel_size); ASET (font_object, FONT_TYPE_INDEX, Qhaiku); font_info = (struct haikufont_info *) XFONT_OBJECT (font_object); diff --git a/src/indent.c b/src/indent.c index 6de18d749ca..08d2bf5ea28 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 b51767bf527..b65a3fbd805 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1101,6 +1101,10 @@ insert_from_gap_1 (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail) eassert (NILP (BVAR (current_buffer, enable_multibyte_characters)) ? nchars == nbytes : nchars <= nbytes); +#ifdef HAVE_TREE_SITTER + ptrdiff_t ins_bytepos = GPT_BYTE; +#endif + GAP_SIZE -= nbytes; if (! text_at_gap_tail) { @@ -1115,6 +1119,12 @@ insert_from_gap_1 (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail) /* Put an anchor to ensure multi-byte form ends at gap. */ if (GAP_SIZE > 0) *(GPT_ADDR) = 0; eassert (GPT <= GPT_BYTE); + +#ifdef HAVE_TREE_SITTER + eassert (nbytes >= 0); + eassert (ins_bytepos >= 0); + treesit_record_change (ins_bytepos, ins_bytepos, ins_bytepos + nbytes); +#endif } /* Insert a sequence of NCHARS chars which occupy NBYTES bytes @@ -1150,12 +1160,6 @@ insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail) current_buffer, 0); } -#ifdef HAVE_TREE_SITTER - eassert (nbytes >= 0); - eassert (ins_bytepos >= 0); - treesit_record_change (ins_bytepos, ins_bytepos, ins_bytepos + nbytes); -#endif - if (ins_charpos < PT) adjust_point (nchars, nbytes); @@ -1175,11 +1179,25 @@ insert_from_buffer (struct buffer *buf, { ptrdiff_t opoint = PT; +#ifdef HAVE_TREE_SITTER + ptrdiff_t obyte = PT_BYTE; +#endif + insert_from_buffer_1 (buf, charpos, nchars, inherit); signal_after_change (opoint, 0, PT - opoint); update_compositions (opoint, PT, CHECK_BORDER); + +#ifdef HAVE_TREE_SITTER + eassert (PT_BYTE >= BEG_BYTE); + eassert (obyte >= BEG_BYTE); + eassert (PT_BYTE >= obyte); + treesit_record_change (obyte, obyte, PT_BYTE); +#endif } +/* NOTE: If we ever make insert_from_buffer_1 public, make sure to + move the call to treesit_record_change into it. */ + static void insert_from_buffer_1 (struct buffer *buf, ptrdiff_t from, ptrdiff_t nchars, bool inherit) @@ -1305,12 +1323,6 @@ insert_from_buffer_1 (struct buffer *buf, /* Insert those intervals. */ graft_intervals_into_buffer (intervals, PT, nchars, current_buffer, inherit); -#ifdef HAVE_TREE_SITTER - eassert (outgoing_nbytes >= 0); - eassert (PT_BYTE >= 0); - treesit_record_change (PT_BYTE, PT_BYTE, PT_BYTE + outgoing_nbytes); -#endif - adjust_point (nchars, outgoing_nbytes); } @@ -1703,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/itree.c b/src/itree.c index b8db08bc74c..bd3e62a374a 100644 --- a/src/itree.c +++ b/src/itree.c @@ -1376,7 +1376,7 @@ itree_iterator_first_node (struct itree_tree *tree, return node; } -/* Start a iterator enumerating all intervals in [BEGIN,END) in the +/* Start an iterator enumerating all intervals in [BEGIN,END) in the given ORDER. */ struct itree_iterator * diff --git a/src/itree.h b/src/itree.h index 8f675fd43bc..79d03d31ce2 100644 --- a/src/itree.h +++ b/src/itree.h @@ -25,6 +25,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" +INLINE_HEADER_BEGIN + /* The tree and node structs are mainly here, so they can be allocated. @@ -114,6 +116,11 @@ extern void itree_node_set_region (struct itree_tree *, struct itree_node *, ptrdiff_t, ptrdiff_t); extern struct itree_tree *itree_create (void); extern void itree_destroy (struct itree_tree *); +INLINE bool +itree_empty_p (struct itree_tree *tree) +{ + return !tree || !tree->root; +} extern intmax_t itree_size (struct itree_tree *); extern void itree_clear (struct itree_tree *); extern void itree_insert (struct itree_tree *, struct itree_node *, @@ -178,4 +185,6 @@ struct itree_iterator #define ITREE_FOREACH_NARROW(beg, end) \ itree_iterator_narrow (itree_iter_, beg, end) +INLINE_HEADER_END + #endif diff --git a/src/keyboard.c b/src/keyboard.c index 6f0f075e54e..f7aa496bb81 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -105,6 +105,13 @@ static bool single_kboard; /* Minimum allowed size of the recent_keys vector. */ #define MIN_NUM_RECENT_KEYS (100) +/* Maximum allowed size of the recent_keys vector. */ +#if INTPTR_MAX <= INT_MAX +# define MAX_NUM_RECENT_KEYS (INT_MAX / EMACS_INT_WIDTH / 10) +#else +# define MAX_NUM_RECENT_KEYS (INT_MAX / EMACS_INT_WIDTH) +#endif + /* Index for storing next element into recent_keys. */ static int recent_keys_index; @@ -1910,12 +1917,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}), @@ -10983,10 +10991,10 @@ The saved keystrokes are shown by `view-lossage'. */) if (!FIXNATP (arg)) user_error ("Value must be a positive integer"); - int osize = ASIZE (recent_keys); + ptrdiff_t osize = ASIZE (recent_keys); eassert (lossage_limit == osize); int min_size = MIN_NUM_RECENT_KEYS; - int new_size = XFIXNAT (arg); + EMACS_INT new_size = XFIXNAT (arg); if (new_size == osize) return make_fixnum (lossage_limit); @@ -10996,6 +11004,12 @@ The saved keystrokes are shown by `view-lossage'. */) AUTO_STRING (fmt, "Value must be >= %d"); Fsignal (Quser_error, list1 (CALLN (Fformat, fmt, make_fixnum (min_size)))); } + if (new_size > MAX_NUM_RECENT_KEYS) + { + AUTO_STRING (fmt, "Value must be <= %d"); + Fsignal (Quser_error, list1 (CALLN (Fformat, fmt, + make_fixnum (MAX_NUM_RECENT_KEYS)))); + } int kept_keys = new_size > osize ? total_keys : min (new_size, total_keys); update_recent_keys (new_size, kept_keys); @@ -12168,6 +12182,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 +12744,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 +12764,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/keymap.c b/src/keymap.c index 23453eaa9a6..efac410d317 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -887,22 +887,23 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, keymap_end: /* We have scanned the entire keymap, and not found a binding for IDX. Let's add one. */ - { - Lisp_Object elt; + if (!remove) + { + Lisp_Object elt; - if (CONSP (idx) && CHARACTERP (XCAR (idx))) - { - /* IDX specifies a range of characters, and not all of them - were handled yet, which means this keymap doesn't have a - char-table. So, we insert a char-table now. */ - elt = Fmake_char_table (Qkeymap, Qnil); - Fset_char_table_range (elt, idx, NILP (def) ? Qt : def); - } - else - elt = Fcons (idx, def); - CHECK_IMPURE (insertion_point, XCONS (insertion_point)); - XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point))); - } + if (CONSP (idx) && CHARACTERP (XCAR (idx))) + { + /* IDX specifies a range of characters, and not all of them + were handled yet, which means this keymap doesn't have a + char-table. So, we insert a char-table now. */ + elt = Fmake_char_table (Qkeymap, Qnil); + Fset_char_table_range (elt, idx, NILP (def) ? Qt : def); + } + else + elt = Fcons (idx, def); + CHECK_IMPURE (insertion_point, XCONS (insertion_point)); + XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point))); + } } return def; diff --git a/src/lisp.h b/src/lisp.h index 70555b3ce91..cacd318c26f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -22,7 +22,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <alloca.h> #include <setjmp.h> -#include <stdalign.h> #include <stdarg.h> #include <stddef.h> #include <string.h> @@ -273,7 +272,7 @@ DEFINE_GDB_SYMBOL_END (VALMASK) emacs_align_type union in alloc.c. Although these macros are reasonably portable, they are not - guaranteed on non-GCC platforms, as C11 does not require support + guaranteed on non-GCC platforms, as the C standard does not require support for alignment to GCALIGNMENT and older compilers may ignore alignment requests. For any type T where garbage collection requires alignment, use verify (GCALIGNED (T)) to verify the @@ -2963,9 +2962,10 @@ XFLOAT_DATA (Lisp_Object f) /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on exceptions. Define IEEE_FLOATING_POINT to 1 if this host is one of the - typical ones. The C11 macro __STDC_IEC_559__ is close to what is + typical ones. The C23 macro __STDC_IEC_60559_BFP__ (or its + obsolescent C11 counterpart __STDC_IEC_559__) is close to what is wanted here, but is not quite right because Emacs does not require - all the features of C11 Annex F (and does not require C11 at all, + all the features of C23 Annex F (and does not require C11 or later, for that matter). */ #define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ @@ -4116,6 +4116,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 *); @@ -4802,6 +4803,9 @@ extern ptrdiff_t find_newline_no_quit (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t *); extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t *); +extern EMACS_INT search_buffer (Lisp_Object, ptrdiff_t, ptrdiff_t, + ptrdiff_t, ptrdiff_t, EMACS_INT, + int, Lisp_Object, Lisp_Object, bool); extern void syms_of_search (void); extern void clear_regexp_cache (void); @@ -5209,6 +5213,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) @@ -5296,6 +5305,26 @@ __lsan_ignore_object (void const *p) } #endif +/* If built with USE_SANITIZER_UNALIGNED_LOAD defined, use compiler + provided ASan functions to perform unaligned loads, allowing ASan + to catch bugs which it might otherwise miss. */ +#if defined HAVE_SANITIZER_COMMON_INTERFACE_DEFS_H \ + && defined ADDRESS_SANITIZER \ + && defined USE_SANITIZER_UNALIGNED_LOAD +# include <sanitizer/common_interface_defs.h> +# if (SIZE_MAX == UINT64_MAX) +# define UNALIGNED_LOAD_SIZE(a, i) \ + (size_t) __sanitizer_unaligned_load64 ((void *) ((a) + (i))) +# elif (SIZE_MAX == UINT32_MAX) +# define UNALIGNED_LOAD_SIZE(a, i) \ + (size_t) __sanitizer_unaligned_load32 ((void *) ((a) + (i))) +# else +# define UNALIGNED_LOAD_SIZE(a, i) *((a) + (i)) +# endif +#else +# define UNALIGNED_LOAD_SIZE(a, i) *((a) + (i)) +#endif + extern void xputenv (const char *); extern char *egetenv_internal (const char *, ptrdiff_t); diff --git a/src/lread.c b/src/lread.c index d0dc85f51c8..273120315df 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2639,154 +2639,137 @@ character_name_to_code (char const *name, ptrdiff_t name_len, Unicode 9.0.0 the maximum is 83, so this should be safe. */ enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 }; -/* Read a \-escape sequence, assuming we already read the `\'. - If the escape sequence forces unibyte, return eight-bit char. */ +static AVOID +invalid_escape_syntax_error (void) +{ + error ("Invalid escape character syntax"); +} +/* Read a character escape sequence, assuming we just read a backslash + and one more character (next_char). */ static int -read_escape (Lisp_Object readcharfun) +read_char_escape (Lisp_Object readcharfun, int next_char) { - int c = READCHAR; - /* \u allows up to four hex digits, \U up to eight. Default to the - behavior for \u, and change this value in the case that \U is seen. */ - int unicode_hex_count = 4; + int modifiers = 0; + ptrdiff_t ncontrol = 0; + int chr; + + again: ; + int c = next_char; + int unicode_hex_count; + int mod; switch (c) { case -1: end_of_file_error (); - case 'a': - return '\007'; - case 'b': - return '\b'; - case 'd': - return 0177; - case 'e': - return 033; - case 'f': - return '\f'; - case 'n': - return '\n'; - case 'r': - return '\r'; - case 't': - return '\t'; - case 'v': - return '\v'; + case 'a': chr = '\a'; break; + case 'b': chr = '\b'; break; + case 'd': chr = 127; break; + case 'e': chr = 27; break; + case 'f': chr = '\f'; break; + case 'n': chr = '\n'; break; + case 'r': chr = '\r'; break; + case 't': chr = '\t'; break; + case 'v': chr = '\v'; break; case '\n': /* ?\LF is an error; it's probably a user mistake. */ error ("Invalid escape character syntax"); - case 'M': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | meta_modifier; - - case 'S': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | shift_modifier; - - case 'H': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | hyper_modifier; + /* \M-x etc: set modifier bit and parse the char to which it applies, + allowing for chains such as \M-\S-\A-\H-\s-\C-q. */ + case 'M': mod = meta_modifier; goto mod_key; + case 'S': mod = shift_modifier; goto mod_key; + case 'H': mod = hyper_modifier; goto mod_key; + case 'A': mod = alt_modifier; goto mod_key; + case 's': mod = super_modifier; goto mod_key; - case 'A': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | alt_modifier; - - case 's': - c = READCHAR; - if (c != '-') - { - UNREAD (c); - return ' '; - } - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | super_modifier; + mod_key: + { + int c1 = READCHAR; + if (c1 != '-') + { + if (c == 's') + { + /* \s not followed by a hyphen is SPC. */ + UNREAD (c1); + chr = ' '; + break; + } + else + /* \M, \S, \H, \A not followed by a hyphen is an error. */ + invalid_escape_syntax_error (); + } + modifiers |= mod; + c1 = READCHAR; + if (c1 == '\\') + { + next_char = READCHAR; + goto again; + } + chr = c1; + break; + } + /* Control modifiers (\C-x or \^x) are messy and not actually idempotent. + For example, ?\C-\C-a = ?\C-\001 = 0x4000001. + Keep a count of them and apply them separately. */ case 'C': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); + { + int c1 = READCHAR; + if (c1 != '-') + invalid_escape_syntax_error (); + } FALLTHROUGH; + /* The prefixes \C- and \^ are equivalent. */ case '^': - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - if ((c & ~CHAR_MODIFIER_MASK) == '?') - return 0177 | (c & CHAR_MODIFIER_MASK); - else if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) - return c | ctrl_modifier; - /* ASCII control chars are made from letters (both cases), - as well as the non-letters within 0100...0137. */ - else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) - return (c & (037 | ~0177)); - else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) - return (c & (037 | ~0177)); - else - return c | ctrl_modifier; - - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - /* An octal escape, as in ANSI C. */ { - register int i = c - '0'; - register int count = 0; - while (++count < 3) + ncontrol++; + int c1 = READCHAR; + if (c1 == '\\') { - if ((c = READCHAR) >= '0' && c <= '7') - { - i *= 8; - i += c - '0'; - } - else + next_char = READCHAR; + goto again; + } + chr = c1; + break; + } + + /* 1-3 octal digits. Values in 0x80..0xff are encoded as raw bytes. */ + case '0': case '1': case '2': case '3': + case '4': case '5': case '6': case '7': + { + int i = c - '0'; + int count = 0; + while (count < 2) + { + int c = READCHAR; + if (c < '0' || c > '7') { UNREAD (c); break; } + i = (i << 3) + (c - '0'); + count++; } if (i >= 0x80 && i < 0x100) i = BYTE8_TO_CHAR (i); - return i; + chr = i; + break; } + /* 1 or more hex digits. Values may encode modifiers. + Values in 0x80..0xff using 2 hex digits are encoded as raw bytes. */ case 'x': - /* A hex escape, as in ANSI C. */ { unsigned int i = 0; int count = 0; while (1) { - c = READCHAR; + int c = READCHAR; int digit = char_hexdigit (c); if (digit < 0) { @@ -2796,40 +2779,37 @@ read_escape (Lisp_Object readcharfun) i = (i << 4) + digit; /* Allow hex escapes as large as ?\xfffffff, because some packages use them to denote characters with modifiers. */ - if ((CHAR_META | (CHAR_META - 1)) < i) + if (i > (CHAR_META | (CHAR_META - 1))) error ("Hex character out of range: \\x%x...", i); count += count < 3; } + if (count == 0) + invalid_escape_syntax_error (); if (count < 3 && i >= 0x80) - return BYTE8_TO_CHAR (i); - return i; + i = BYTE8_TO_CHAR (i); + modifiers |= i & CHAR_MODIFIER_MASK; + chr = i & ~CHAR_MODIFIER_MASK; + break; } + /* 8-digit Unicode hex escape: \UHHHHHHHH */ case 'U': - /* Post-Unicode-2.0: Up to eight hex chars. */ unicode_hex_count = 8; - FALLTHROUGH; - case 'u': + goto unicode_hex; - /* A Unicode escape. We only permit them in strings and characters, - not arbitrarily in the source code, as in some other languages. */ + /* 4-digit Unicode hex escape: \uHHHH */ + case 'u': + unicode_hex_count = 4; + unicode_hex: { unsigned int i = 0; - int count = 0; - - while (++count <= unicode_hex_count) + for (int count = 0; count < unicode_hex_count; count++) { - c = READCHAR; + int c = READCHAR; if (c < 0) - { - if (unicode_hex_count > 4) - error ("Malformed Unicode escape: \\U%x", i); - else - error ("Malformed Unicode escape: \\u%x", i); - } - /* `isdigit' and `isalpha' may be locale-specific, which we don't - want. */ + error ("Malformed Unicode escape: \\%c%x", + unicode_hex_count == 4 ? 'u' : 'U', i); int digit = char_hexdigit (c); if (digit < 0) error ("Non-hex character used for Unicode escape: %c (%d)", @@ -2838,13 +2818,14 @@ read_escape (Lisp_Object readcharfun) } if (i > 0x10FFFF) error ("Non-Unicode character: 0x%x", i); - return i; + chr = i; + break; } + /* Named character: \N{name} */ case 'N': - /* Named character. */ { - c = READCHAR; + int c = READCHAR; if (c != '{') invalid_syntax ("Expected opening brace after \\N", readcharfun); char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1]; @@ -2852,12 +2833,12 @@ read_escape (Lisp_Object readcharfun) ptrdiff_t length = 0; while (true) { - c = READCHAR; + int c = READCHAR; if (c < 0) end_of_file_error (); if (c == '}') break; - if (! (0 < c && c < 0x80)) + if (c >= 0x80) { AUTO_STRING (format, "Invalid character U+%04X in character name"); @@ -2886,13 +2867,41 @@ read_escape (Lisp_Object readcharfun) name[length] = '\0'; /* character_name_to_code can invoke read0, recursively. - This is why read0's buffer is not static. */ - return character_name_to_code (name, length, readcharfun); + This is why read0 needs to be re-entrant. */ + chr = character_name_to_code (name, length, readcharfun); + break; } default: - return c; + chr = c; + break; } + eassert (chr >= 0 && chr < (1 << CHARACTERBITS)); + + /* Apply Control modifiers, using the rules: + \C-X = ascii_ctrl(nomod(X)) | mods(X) if nomod(X) is one of: + A-Z a-z ? @ [ \ ] ^ _ + + X | ctrl_modifier otherwise + + where + nomod(c) = c without modifiers + mods(c) = the modifiers of c + ascii_ctrl(c) = 127 if c = '?' + c & 0x1f otherwise + */ + while (ncontrol > 0) + { + if ((chr >= '@' && chr <= '_') || (chr >= 'a' && chr <= 'z')) + chr &= 0x1f; + else if (chr == '?') + chr = 127; + else + modifiers |= ctrl_modifier; + ncontrol--; + } + + return chr | modifiers; } /* Return the digit that CHARACTER stands for in the given BASE. @@ -3014,7 +3023,7 @@ read_char_literal (Lisp_Object readcharfun) } if (ch == '\\') - ch = read_escape (readcharfun); + ch = read_char_escape (readcharfun, READCHAR); int modifiers = ch & CHAR_MODIFIER_MASK; ch &= ~CHAR_MODIFIER_MASK; @@ -3080,8 +3089,7 @@ read_string_literal (Lisp_Object readcharfun) /* `\SPC' and `\LF' generate no characters at all. */ continue; default: - UNREAD (ch); - ch = read_escape (readcharfun); + ch = read_char_escape (readcharfun, ch); break; } 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/module-env-29.h b/src/module-env-29.h index 6ca03773181..e69de29bb2d 100644 --- a/src/module-env-29.h +++ b/src/module-env-29.h @@ -1,3 +0,0 @@ - /* Add module environment functions newly added in Emacs 29 here. - Before Emacs 29 is released, remove this comment and start - module-env-30.h on the master branch. */ diff --git a/src/module-env-30.h b/src/module-env-30.h new file mode 100644 index 00000000000..6ca03773181 --- /dev/null +++ b/src/module-env-30.h @@ -0,0 +1,3 @@ + /* Add module environment functions newly added in Emacs 29 here. + Before Emacs 29 is released, remove this comment and start + module-env-30.h on the master branch. */ diff --git a/src/nsterm.m b/src/nsterm.m index 4180cdc9e7f..0e75cbf3f0f 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6703,16 +6703,8 @@ ns_create_font_panel_buttons (id target, SEL select, SEL cancel_action) - (void)resetCursorRects { - NSRect visible; - NSCursor *currentCursor; - - /* On macOS 13, [resetCursorRects:] could be called even after the - window is closed. */ - if (! emacsframe || ! FRAME_OUTPUT_DATA (emacsframe)) - return; - - visible = [self visibleRect]; - currentCursor = FRAME_POINTER_TYPE (emacsframe); + NSRect visible = [self visibleRect]; + NSCursor *currentCursor = FRAME_POINTER_TYPE (emacsframe); NSTRACE ("[EmacsView resetCursorRects]"); if (currentCursor == nil) 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 800fc2e9d05..2c3828081fa 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; @@ -2862,7 +2862,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) DUMP_FIELD_COPY (out, buffer, inhibit_buffer_hooks); DUMP_FIELD_COPY (out, buffer, long_line_optimizations_p); - if (buffer->overlays && buffer->overlays->root != NULL) + if (!itree_empty_p (buffer->overlays)) /* We haven't implemented the code to dump overlays. */ emacs_abort (); else diff --git a/src/profiler.c b/src/profiler.c index 81b5e7b0cf0..6217071ef9c 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -49,7 +49,13 @@ static const struct hash_table_test hashtest_profiler = hashfn_profiler, }; -static Lisp_Object +struct profiler_log { + Lisp_Object log; + EMACS_INT gc_count; /* Samples taken during GC. */ + EMACS_INT discarded; /* Samples evicted during table overflow. */ +}; + +static struct profiler_log make_log (void) { /* We use a standard Elisp hash-table object, but we use it in @@ -60,11 +66,13 @@ make_log (void) = clip_to_bounds (0, profiler_log_size, MOST_POSITIVE_FIXNUM); ptrdiff_t max_stack_depth = clip_to_bounds (0, profiler_max_stack_depth, PTRDIFF_MAX);; - Lisp_Object log = make_hash_table (hashtest_profiler, heap_size, - DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, - Qnil, false); - struct Lisp_Hash_Table *h = XHASH_TABLE (log); + struct profiler_log log + = { make_hash_table (hashtest_profiler, heap_size, + DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, + Qnil, false), + 0, 0 }; + struct Lisp_Hash_Table *h = XHASH_TABLE (log.log); /* What is special about our hash-tables is that the values are pre-filled with the vectors we'll use as keys. */ @@ -116,8 +124,9 @@ static EMACS_INT approximate_median (log_t *log, } } -static void evict_lower_half (log_t *log) +static void evict_lower_half (struct profiler_log *plog) { + log_t *log = XHASH_TABLE (plog->log); ptrdiff_t size = ASIZE (log->key_and_value) / 2; EMACS_INT median = approximate_median (log, 0, size); @@ -127,6 +136,8 @@ static void evict_lower_half (log_t *log) if (XFIXNUM (HASH_VALUE (log, i)) <= median) { Lisp_Object key = HASH_KEY (log, i); + EMACS_INT count = XFIXNUM (HASH_VALUE (log, i)); + plog->discarded = saturated_add (plog->discarded, count); { /* FIXME: we could make this more efficient. */ Lisp_Object tmp; XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ @@ -148,12 +159,12 @@ static void evict_lower_half (log_t *log) size for memory. */ static void -record_backtrace (log_t *log, EMACS_INT count) +record_backtrace (struct profiler_log *plog, EMACS_INT count) { + eassert (HASH_TABLE_P (plog->log)); + log_t *log = XHASH_TABLE (plog->log); if (log->next_free < 0) - /* FIXME: transfer the evicted counts to a special entry rather - than dropping them on the floor. */ - evict_lower_half (log); + evict_lower_half (plog); ptrdiff_t index = log->next_free; /* Get a "working memory" vector. */ @@ -222,10 +233,10 @@ static enum profiler_cpu_running profiler_cpu_running; /* Hash-table log of CPU profiler. */ -static Lisp_Object cpu_log; +static struct profiler_log cpu; -/* Separate counter for the time spent in the GC. */ -static EMACS_INT cpu_gc_count; +/* Hash-table log of Memory profiler. */ +static struct profiler_log memory; /* The current sampling interval in nanoseconds. */ static EMACS_INT current_sampling_interval; @@ -233,30 +244,34 @@ static EMACS_INT current_sampling_interval; /* Signal handler for sampling profiler. */ static void -handle_profiler_signal (int signal) +add_sample (struct profiler_log *plog, EMACS_INT count) { - if (EQ (backtrace_top_function (), QAutomatic_GC)) + if (EQ (backtrace_top_function (), QAutomatic_GC)) /* bug#60237 */ /* Special case the time-count inside GC because the hash-table code is not prepared to be used while the GC is running. More specifically it uses ASIZE at many places where it does not expect the ARRAY_MARK_FLAG to be set. We could try and harden the hash-table code, but it doesn't seem worth the effort. */ - cpu_gc_count = saturated_add (cpu_gc_count, 1); + plog->gc_count = saturated_add (plog->gc_count, count); else - { - EMACS_INT count = 1; + record_backtrace (plog, count); +} + + +static void +handle_profiler_signal (int signal) +{ + EMACS_INT count = 1; #if defined HAVE_ITIMERSPEC && defined HAVE_TIMER_GETOVERRUN - if (profiler_timer_ok) - { - int overruns = timer_getoverrun (profiler_timer); - eassert (overruns >= 0); - count += overruns; - } -#endif - eassert (HASH_TABLE_P (cpu_log)); - record_backtrace (XHASH_TABLE (cpu_log), count); + if (profiler_timer_ok) + { + int overruns = timer_getoverrun (profiler_timer); + eassert (overruns >= 0); + count += overruns; } +#endif + add_sample (&cpu, count); } static void @@ -343,11 +358,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) if (profiler_cpu_running) error ("CPU profiler is already running"); - if (NILP (cpu_log)) - { - cpu_gc_count = 0; - cpu_log = make_log (); - } + if (NILP (cpu.log)) + cpu = make_log (); int status = setup_cpu_timer (sampling_interval); if (status < 0) @@ -409,6 +421,26 @@ DEFUN ("profiler-cpu-running-p", return profiler_cpu_running ? Qt : Qnil; } +static Lisp_Object +export_log (struct profiler_log *log) +{ + Lisp_Object result = log->log; + if (log->gc_count) + Fputhash (CALLN (Fvector, QAutomatic_GC, Qnil), + make_fixnum (log->gc_count), + result); + if (log->discarded) + Fputhash (CALLN (Fvector, QDiscarded_Samples, Qnil), + make_fixnum (log->discarded), + result); + /* Here we're making the log visible to Elisp, so it's not safe any + more for our use afterwards since we can't rely on its special + pre-allocated keys anymore. So we have to allocate a new one. */ + if (profiler_cpu_running) + *log = make_log (); + return result; +} + DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log, 0, 0, 0, doc: /* Return the current cpu profiler log. @@ -418,16 +450,7 @@ of functions, where the last few elements may be nil. Before returning, a new log is allocated for future samples. */) (void) { - Lisp_Object result = cpu_log; - /* Here we're making the log visible to Elisp, so it's not safe any - more for our use afterwards since we can't rely on its special - pre-allocated keys anymore. So we have to allocate a new one. */ - cpu_log = profiler_cpu_running ? make_log () : Qnil; - Fputhash (make_vector (1, QAutomatic_GC), - make_fixnum (cpu_gc_count), - result); - cpu_gc_count = 0; - return result; + return (export_log (&cpu)); } #endif /* PROFILER_CPU_SUPPORT */ @@ -436,8 +459,6 @@ Before returning, a new log is allocated for future samples. */) /* True if memory profiler is running. */ bool profiler_memory_running; -static Lisp_Object memory_log; - DEFUN ("profiler-memory-start", Fprofiler_memory_start, Sprofiler_memory_start, 0, 0, 0, doc: /* Start/restart the memory profiler. @@ -450,8 +471,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) if (profiler_memory_running) error ("Memory profiler is already running"); - if (NILP (memory_log)) - memory_log = make_log (); + if (NILP (memory.log)) + memory = make_log (); profiler_memory_running = true; @@ -490,12 +511,7 @@ of functions, where the last few elements may be nil. Before returning, a new log is allocated for future samples. */) (void) { - Lisp_Object result = memory_log; - /* Here we're making the log visible to Elisp , so it's not safe any - more for our use afterwards since we can't rely on its special - pre-allocated keys anymore. So we have to allocate a new one. */ - memory_log = profiler_memory_running ? make_log () : Qnil; - return result; + return (export_log (&memory)); } @@ -505,8 +521,7 @@ Before returning, a new log is allocated for future samples. */) void malloc_probe (size_t size) { - eassert (HASH_TABLE_P (memory_log)); - record_backtrace (XHASH_TABLE (memory_log), min (size, MOST_POSITIVE_FIXNUM)); + add_sample (&memory, min (size, MOST_POSITIVE_FIXNUM)); } DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0, @@ -586,21 +601,22 @@ to make room for new entries. */); profiler_log_size = 10000; DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal"); + DEFSYM (QDiscarded_Samples, "Discarded Samples"); defsubr (&Sfunction_equal); #ifdef PROFILER_CPU_SUPPORT profiler_cpu_running = NOT_RUNNING; - cpu_log = Qnil; - staticpro (&cpu_log); + cpu.log = Qnil; + staticpro (&cpu.log); defsubr (&Sprofiler_cpu_start); defsubr (&Sprofiler_cpu_stop); defsubr (&Sprofiler_cpu_running_p); defsubr (&Sprofiler_cpu_log); #endif profiler_memory_running = false; - memory_log = Qnil; - staticpro (&memory_log); + memory.log = Qnil; + staticpro (&memory.log); defsubr (&Sprofiler_memory_start); defsubr (&Sprofiler_memory_stop); defsubr (&Sprofiler_memory_running_p); @@ -615,16 +631,16 @@ syms_of_profiler_for_pdumper (void) if (dumped_with_pdumper_p ()) { #ifdef PROFILER_CPU_SUPPORT - cpu_log = Qnil; + cpu.log = Qnil; #endif - memory_log = Qnil; + memory.log = Qnil; } else { #ifdef PROFILER_CPU_SUPPORT - eassert (NILP (cpu_log)); + eassert (NILP (cpu.log)); #endif - eassert (NILP (memory_log)); + eassert (NILP (memory.log)); } } 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/search.c b/src/search.c index dbc5a83946f..0bb52c03eef 100644 --- a/src/search.c +++ b/src/search.c @@ -68,9 +68,6 @@ static EMACS_INT simple_search (EMACS_INT, unsigned char *, ptrdiff_t, static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, ptrdiff_t, Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t, int); -static EMACS_INT search_buffer (Lisp_Object, ptrdiff_t, ptrdiff_t, - ptrdiff_t, ptrdiff_t, EMACS_INT, int, - Lisp_Object, Lisp_Object, bool); Lisp_Object re_match_object; @@ -1510,7 +1507,7 @@ search_buffer_non_re (Lisp_Object string, ptrdiff_t pos, return result; } -static EMACS_INT +EMACS_INT search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t lim, ptrdiff_t lim_byte, EMACS_INT n, int RE, Lisp_Object trt, Lisp_Object inverse_trt, bool posix) diff --git a/src/sqlite.c b/src/sqlite.c index c96841e63f9..0361514766a 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -399,7 +399,7 @@ row_to_value (sqlite3_stmt *stmt) int len = sqlite3_column_count (stmt); Lisp_Object values = Qnil; - for (int i = 0; i < len; ++i) + for (int i = len - 1; i >= 0; i--) { Lisp_Object v = Qnil; @@ -434,7 +434,7 @@ row_to_value (sqlite3_stmt *stmt) values = Fcons (v, values); } - return Fnreverse (values); + return values; } static Lisp_Object @@ -718,11 +718,15 @@ Only modules on Emacs' list of allowed modules can be loaded. */) #endif /* HAVE_SQLITE3_LOAD_EXTENSION */ DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0, - doc: /* Return the next result set from SET. */) + doc: /* Return the next result set from SET. +Return nil when the statement has finished executing successfully. */) (Lisp_Object set) { check_sqlite (set, true); + if (XSQLITE (set)->eof) + return Qnil; + int ret = sqlite3_step (XSQLITE (set)->stmt); if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE) xsignal1 (Qsqlite_error, build_string (sqlite3_errmsg (XSQLITE (set)->db))); diff --git a/src/sysdep.c b/src/sysdep.c index ce6a20f5302..a5b3117d262 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2653,10 +2653,11 @@ emacs_perror (char const *message) int renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst) { -#if defined SYS_renameat2 && defined RENAME_NOREPLACE - return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); -#elif defined CYGWIN && defined RENAME_NOREPLACE +#if HAVE_RENAMEAT2 && defined RENAME_NOREPLACE return renameat2 (srcfd, src, dstfd, dst, RENAME_NOREPLACE); +#elif defined SYS_renameat2 && defined RENAME_NOREPLACE + /* Linux kernel 3.15 (2014) or later, with glibc 2.27 (2018) or earlier. */ + return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); #elif defined RENAME_EXCL return renameatx_np (srcfd, src, dstfd, dst, RENAME_EXCL); #else 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 917db582676..5a4fe3e8803 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -72,6 +72,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #undef ts_query_cursor_set_byte_range #undef ts_query_delete #undef ts_query_new +#undef ts_query_pattern_count #undef ts_query_predicates_for_pattern #undef ts_query_string_value_for_id #undef ts_set_allocator @@ -135,6 +136,7 @@ DEF_DLL_FN (void, ts_query_cursor_set_byte_range, DEF_DLL_FN (void, ts_query_delete, (TSQuery *)); DEF_DLL_FN (TSQuery *, ts_query_new, (const TSLanguage *, const char *, uint32_t, uint32_t *, TSQueryError *)); +DEF_DLL_FN (uint32_t, ts_query_pattern_count, (const TSQuery *)); DEF_DLL_FN (const TSQueryPredicateStep *, ts_query_predicates_for_pattern, ( const TSQuery *, uint32_t, uint32_t *)); DEF_DLL_FN (const char *, ts_query_string_value_for_id, @@ -200,6 +202,7 @@ init_treesit_functions (void) LOAD_DLL_FN (library, ts_query_cursor_set_byte_range); LOAD_DLL_FN (library, ts_query_delete); LOAD_DLL_FN (library, ts_query_new); + LOAD_DLL_FN (library, ts_query_pattern_count); LOAD_DLL_FN (library, ts_query_predicates_for_pattern); LOAD_DLL_FN (library, ts_query_string_value_for_id); LOAD_DLL_FN (library, ts_set_allocator); @@ -256,6 +259,7 @@ init_treesit_functions (void) #define ts_query_cursor_set_byte_range fn_ts_query_cursor_set_byte_range #define ts_query_delete fn_ts_query_delete #define ts_query_new fn_ts_query_new +#define ts_query_pattern_count fn_ts_query_pattern_count #define ts_query_predicates_for_pattern fn_ts_query_predicates_for_pattern #define ts_query_string_value_for_id fn_ts_query_string_value_for_id #define ts_set_allocator fn_ts_set_allocator @@ -613,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 (); @@ -712,6 +720,7 @@ Return nil if a grammar library for LANGUAGE is not available. */) } } + /*** Parsing functions */ static void @@ -762,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); @@ -786,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); @@ -809,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); @@ -1096,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 @@ -1258,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. */) @@ -1467,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", @@ -1713,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 @@ -1900,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 @@ -1916,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; @@ -1939,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; } @@ -2229,6 +2266,7 @@ produced by tree-sitter. */) return same_node ? Qt : Qnil; } + /*** Query functions */ DEFUN ("treesit-pattern-expand", @@ -2446,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)); @@ -2466,13 +2504,42 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) build_string ("The second argument to `match' should " "be a capture name, not a string")); - Lisp_Object text = treesit_predicate_capture_name_to_text (capture_name, + Lisp_Object node = treesit_predicate_capture_name_to_node (capture_name, captures); - if (fast_string_match (regexp, text) >= 0) - return true; - else - return false; + struct buffer *old_buffer = current_buffer; + struct buffer *buffer = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); + set_buffer_internal (buffer); + + TSNode treesit_node = XTS_NODE (node)->node; + ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; + uint32_t start_byte_offset = ts_node_start_byte (treesit_node); + uint32_t end_byte_offset = ts_node_end_byte (treesit_node); + ptrdiff_t start_byte = visible_beg + start_byte_offset; + ptrdiff_t end_byte = visible_beg + end_byte_offset; + ptrdiff_t start_pos = BYTE_TO_CHAR (start_byte); + ptrdiff_t end_pos = BYTE_TO_CHAR (end_byte); + ptrdiff_t old_begv = BEGV; + ptrdiff_t old_begv_byte = BEGV_BYTE; + ptrdiff_t old_zv = ZV; + ptrdiff_t old_zv_byte = ZV_BYTE; + + BEGV = start_pos; + BEGV_BYTE = start_byte; + ZV = end_pos; + ZV_BYTE = end_byte; + + ptrdiff_t val = search_buffer (regexp, start_pos, start_byte, + end_pos, end_byte, 1, 1, Qnil, Qnil, false); + + BEGV = old_begv; + BEGV_BYTE = old_begv_byte; + ZV = old_zv; + ZV_BYTE = old_zv_byte; + + set_buffer_internal (old_buffer); + + return (val > 0); } /* Handles predicate (#pred FN ARG...). Return true if FN returns @@ -2720,8 +2787,10 @@ the query. */) every for loop and nconc it to RESULT every time. That is indeed the initial implementation in which Yoav found nconc being the bottleneck (98.4% of the running time spent on nconc). */ + uint32_t patterns_count = ts_query_pattern_count (treesit_query); Lisp_Object result = Qnil; Lisp_Object prev_result = result; + Lisp_Object predicates_table = make_vector (patterns_count, Qt); while (ts_query_cursor_next_match (cursor, &match)) { /* Record the checkpoint that we may roll back to. */ @@ -2750,9 +2819,13 @@ the query. */) result = Fcons (cap, result); } /* Get predicates. */ - Lisp_Object predicates - = treesit_predicates_for_pattern (treesit_query, - match.pattern_index); + Lisp_Object predicates = AREF (predicates_table, match.pattern_index); + if (EQ (predicates, Qt)) + { + predicates = treesit_predicates_for_pattern (treesit_query, + match.pattern_index); + ASET (predicates_table, match.pattern_index, predicates); + } /* captures_lisp = Fnreverse (captures_lisp); */ struct capture_range captures_range = { result, prev_result }; @@ -2768,6 +2841,7 @@ the query. */) return Fnreverse (result); } + /*** Navigation */ static inline void @@ -3092,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), @@ -3109,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 (); @@ -3264,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. @@ -3276,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), @@ -3288,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 (); @@ -3312,6 +3386,68 @@ a regexp. */) return parent; } +DEFUN ("treesit-subtree-stat", + Ftreesit_subtree_stat, + Streesit_subtree_stat, 1, 1, 0, + doc: /* Return information about the subtree of NODE. + +Return a list (MAX-DEPTH MAX-WIDTH COUNT), where MAX-DEPTH is the +maximum depth of the subtree, MAX-WIDTH is the maximum number of +direct children of nodes in the subtree, and COUNT is the number of +nodes in the subtree, including NODE. */) + (Lisp_Object node) +{ + /* Having a limit on the depth to traverse doesn't have much impact + on the time it takes, so I left that out. */ + CHECK_TS_NODE (node); + + treesit_initialize (); + + TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (node)->node); + ptrdiff_t max_depth = 1; + ptrdiff_t max_width = 0; + ptrdiff_t count = 0; + ptrdiff_t current_depth = 0; + + /* Traverse the subtree depth-first. */ + while (true) + { + count++; + + /* Go down depth-first. */ + while (ts_tree_cursor_goto_first_child (&cursor)) + { + current_depth++; + count++; + /* While we're at here, measure the number of siblings. */ + ptrdiff_t width_count = 1; + while (ts_tree_cursor_goto_next_sibling (&cursor)) + width_count++; + max_width = max (max_width, width_count); + /* Go back to the first sibling. */ + treesit_assume_true (ts_tree_cursor_goto_parent (&cursor)); + treesit_assume_true (ts_tree_cursor_goto_first_child (&cursor)); + } + max_depth = max (max_depth, current_depth); + + /* Go to next sibling. If there is no next sibling, go to + parent's next sibling, and so on. If there is no more + parent, we've traversed the whole subtree, stop. */ + while (!ts_tree_cursor_goto_next_sibling (&cursor)) + { + if (ts_tree_cursor_goto_parent (&cursor)) + current_depth--; + else + { + ts_tree_cursor_delete (&cursor); + return list3 (make_fixnum (max_depth), + make_fixnum (max_width), + make_fixnum (count)); + } + } + } +} + #endif /* HAVE_TREE_SITTER */ DEFUN ("treesit-available-p", Ftreesit_available_p, @@ -3326,7 +3462,7 @@ DEFUN ("treesit-available-p", Ftreesit_available_p, #endif } - + /*** Initialization */ /* Initialize the tree-sitter routines. */ @@ -3343,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"); @@ -3511,6 +3648,7 @@ then in the system default locations for dynamic libraries, in that order. */); defsubr (&Streesit_search_subtree); defsubr (&Streesit_search_forward); defsubr (&Streesit_induce_sparse_tree); + defsubr (&Streesit_subtree_stat); #endif /* HAVE_TREE_SITTER */ defsubr (&Streesit_available_p); } diff --git a/src/w32heap.c b/src/w32heap.c index a1975d9a975..628fc28e3c5 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -121,9 +121,9 @@ typedef struct _RTL_HEAP_PARAMETERS { # define DUMPED_HEAP_SIZE 10 #else # if defined _WIN64 || defined WIDE_EMACS_INT -# define DUMPED_HEAP_SIZE (23*1024*1024) +# define DUMPED_HEAP_SIZE (28*1024*1024) # else -# define DUMPED_HEAP_SIZE (13*1024*1024) +# define DUMPED_HEAP_SIZE (18*1024*1024) # endif #endif diff --git a/src/window.c b/src/window.c index 6201a6f4a36..f4e09f49eae 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 d2c91e5847b..7a4f683c973 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); } @@ -12448,7 +12448,7 @@ display_echo_area (struct window *w) reset the echo_area_buffer in question to nil at the end because with_echo_area_buffer will set it to an empty buffer. */ bool i = display_last_displayed_message_p; - /* According to the C99, C11 and C++11 standards, the integral value + /* According to the C standard, the integral value of a "bool" is always 0 or 1, so this array access is safe here, if oddly typed. */ no_message_p = NILP (echo_area_buffer[i]); @@ -12938,7 +12938,7 @@ clear_garbaged_frames (void) { struct frame *f = XFRAME (frame); - if (FRAME_VISIBLE_P (f) && FRAME_GARBAGED_P (f)) + if (FRAME_REDISPLAY_P (f) && FRAME_GARBAGED_P (f)) { if (f->resized_p /* It makes no sense to redraw a non-selected TTY @@ -12987,7 +12987,7 @@ echo_area_display (bool update_frame_p) f = XFRAME (WINDOW_FRAME (w)); /* Don't display if frame is invisible or not yet initialized. */ - if (!FRAME_VISIBLE_P (f) || !f->glyphs_initialized_p) + if (!FRAME_REDISPLAY_P (f) || !f->glyphs_initialized_p) return; #ifdef HAVE_WINDOW_SYSTEM @@ -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); @@ -13543,7 +13544,7 @@ prepare_menu_bars (void) TTY frames to be completely redrawn, when there are more than one of them, even though nothing should be changed on display. */ - || (FRAME_VISIBLE_P (f) == 2 && FRAME_WINDOW_P (f)))) + || (FRAME_REDISPLAY_P (f) && FRAME_WINDOW_P (f)))) gui_consider_frame_title (frame); } } @@ -16432,7 +16433,7 @@ redisplay_internal (void) { struct frame *f = XFRAME (frame); - if (FRAME_VISIBLE_P (f)) + if (FRAME_REDISPLAY_P (f)) { ++number_of_visible_frames; /* Adjust matrices for visible frames only. */ @@ -16574,7 +16575,7 @@ redisplay_internal (void) && !w->update_mode_line && !current_buffer->clip_changed && !current_buffer->prevent_redisplay_optimizations_p - && FRAME_VISIBLE_P (XFRAME (w->frame)) + && FRAME_REDISPLAY_P (XFRAME (w->frame)) && !FRAME_OBSCURED_P (XFRAME (w->frame)) && !XFRAME (w->frame)->cursor_type_changed && !XFRAME (w->frame)->face_change @@ -16852,7 +16853,7 @@ redisplay_internal (void) if (gcscrollbars && FRAME_TERMINAL (f)->condemn_scroll_bars_hook) FRAME_TERMINAL (f)->condemn_scroll_bars_hook (f); - if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f)) + if (FRAME_REDISPLAY_P (f) && !FRAME_OBSCURED_P (f)) { /* Don't allow freeing images and faces for this frame as long as the frame's update wasn't @@ -16878,7 +16879,7 @@ redisplay_internal (void) if (gcscrollbars && FRAME_TERMINAL (f)->judge_scroll_bars_hook) FRAME_TERMINAL (f)->judge_scroll_bars_hook (f); - if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f)) + if (FRAME_REDISPLAY_P (f) && !FRAME_OBSCURED_P (f)) { /* If fonts changed on visible frame, display again. */ if (f->fonts_changed) @@ -16984,7 +16985,7 @@ redisplay_internal (void) } } } - else if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf)) + else if (FRAME_REDISPLAY_P (sf) && !FRAME_OBSCURED_P (sf)) { sf->inhibit_clear_image_cache = true; displayed_buffer = XBUFFER (XWINDOW (selected_window)->contents); @@ -17035,7 +17036,7 @@ redisplay_internal (void) unrequest_sigio (); STOP_POLLING; - if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf)) + if (FRAME_REDISPLAY_P (sf) && !FRAME_OBSCURED_P (sf)) { if (hscroll_retries <= MAX_HSCROLL_RETRIES && hscroll_windows (selected_window)) @@ -17134,7 +17135,7 @@ redisplay_internal (void) FOR_EACH_FRAME (tail, frame) { - if (XFRAME (frame)->visible) + if (FRAME_REDISPLAY_P (XFRAME (frame))) new_count++; } @@ -26332,16 +26333,17 @@ display_menu_bar (struct window *w) it.first_visible_x = 0; it.last_visible_x = FRAME_PIXEL_WIDTH (f); #elif defined (HAVE_X_WINDOWS) /* X without toolkit. */ + struct window *menu_window = NULL; + struct face *face = FACE_FROM_ID (f, MENU_FACE_ID); + if (FRAME_WINDOW_P (f)) { /* Menu bar lines are displayed in the desired matrix of the dummy window menu_bar_window. */ - struct window *menu_w; - menu_w = XWINDOW (f->menu_bar_window); - init_iterator (&it, menu_w, -1, -1, menu_w->desired_matrix->rows, + menu_window = XWINDOW (f->menu_bar_window); + init_iterator (&it, menu_window, -1, -1, + menu_window->desired_matrix->rows, MENU_FACE_ID); - it.first_visible_x = 0; - it.last_visible_x = FRAME_PIXEL_WIDTH (f); } else #endif /* not USE_X_TOOLKIT and not USE_GTK */ @@ -26395,6 +26397,50 @@ display_menu_bar (struct window *w) /* Compute the total height of the lines. */ compute_line_metrics (&it); + it.glyph_row->full_width_p = true; + it.glyph_row->continued_p = false; + it.glyph_row->truncated_on_left_p = false; + it.glyph_row->truncated_on_right_p = false; + +#if defined (HAVE_X_WINDOWS) && !defined (USE_X_TOOLKIT) && !defined (USE_GTK) + /* Make a 3D menu bar have a shadow at its right end. */ + extend_face_to_end_of_line (&it); + if (face->box != FACE_NO_BOX) + { + struct glyph *last = (it.glyph_row->glyphs[TEXT_AREA] + + it.glyph_row->used[TEXT_AREA] - 1); + int box_thickness = face->box_vertical_line_width; + last->right_box_line_p = true; + /* Add back the space for the right box line we subtracted in + init_iterator, since the right_box_line_p flag will make the + glyph wider. We actually add only as much space as is + available for the last glyph of the menu bar and whatever + space is left beyond it, since that glyph could be only + partially visible. */ + if (box_thickness > 0) + last->pixel_width += max (0, (box_thickness + - (it.current_x - it.last_visible_x))); + } + + /* With the non-toolkit version, modify the menu bar window height + accordingly. */ + if (FRAME_WINDOW_P (it.f) && menu_window) + { + struct glyph_row *row; + int delta_height; + + row = it.glyph_row; + delta_height + = ((row->y + row->height) + - WINDOW_BOX_HEIGHT_NO_MODE_LINE (menu_window)); + + if (delta_height != 0) + { + FRAME_MENU_BAR_HEIGHT (it.f) += delta_height; + adjust_frame_size (it.f, -1, -1, 3, false, Qmenu_bar_lines); + } + } +#endif } /* Deep copy of a glyph row, including the glyphs. */ @@ -27576,7 +27622,9 @@ static const char power_letter[] = 'P', /* peta */ 'E', /* exa */ 'Z', /* zetta */ - 'Y' /* yotta */ + 'Y', /* yotta */ + 'R', /* ronna */ + 'Q' /* quetta */ }; static void @@ -29317,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; @@ -29324,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; @@ -29374,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]; } @@ -33216,7 +33269,7 @@ display_and_set_cursor (struct window *w, bool on, windows and frames; in the latter case, the frame or window may be in the midst of changing its size, and x and y may be off the window. */ - if (! FRAME_VISIBLE_P (f) + if (! FRAME_REDISPLAY_P (f) || vpos >= w->current_matrix->nrows || hpos >= w->current_matrix->matrix_w) return; @@ -33377,7 +33430,7 @@ gui_update_cursor (struct frame *f, bool on_p) void gui_clear_cursor (struct window *w) { - if (FRAME_VISIBLE_P (XFRAME (w->frame)) && w->phys_cursor_on_p) + if (FRAME_REDISPLAY_P (XFRAME (w->frame)) && w->phys_cursor_on_p) update_window_cursor (w, false); } @@ -36261,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. */ @@ -36601,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 @@ -36770,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 68f7cc493cc..37b703984be 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2780,8 +2780,7 @@ merge_face_ref (struct window *w, else if (EQ (keyword, QCstipple)) { #if defined (HAVE_WINDOW_SYSTEM) - Lisp_Object pixmap_p = Fbitmap_spec_p (value); - if (!NILP (pixmap_p)) + if (NILP (value) || !NILP (Fbitmap_spec_p (value))) to[LFACE_STIPPLE_INDEX] = value; else err = true; @@ -4187,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). */ @@ -6012,7 +6013,6 @@ realize_non_ascii_face (struct frame *f, Lisp_Object font_object, return face; } -#endif /* HAVE_WINDOW_SYSTEM */ /* Remove the attribute at INDEX from the font object if SYMBOL appears in `font-fallback-ignored-attributes'. */ @@ -6031,6 +6031,7 @@ font_maybe_unset_attribute (Lisp_Object font_object, ASET (font_object, index, Qnil); } } +#endif /* HAVE_WINDOW_SYSTEM */ /* Realize the fully-specified face with attributes ATTRS in face cache CACHE for ASCII characters. Do it for GUI frame CACHE->f. diff --git a/src/xfns.c b/src/xfns.c index 528ae61ca32..9e004f6a678 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -37,13 +37,16 @@ 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> #ifdef USE_XCB #include <xcb/xcb.h> #include <xcb/xproto.h> -#include <xcb/xcb_aux.h> #endif #include "bitmaps/gray.xbm" @@ -1368,7 +1371,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) XCreateFontCursor is not a request that waits for a reply, and as such can return IDs that will not actually be used by the server. */ - x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f), 0); /* Free any successfully created cursors. */ for (i = 0; i < mouse_cursor_max; i++) @@ -2643,12 +2646,18 @@ append_wm_protocols (struct x_display_info *dpyinfo, if (existing) XFree (existing); - if (!found_wm_ping) - protos[num_protos++] = dpyinfo->Xatom_net_wm_ping; + if (!dpyinfo->untrusted) + { + /* Untrusted clients cannot use these protocols which require + communicating with the window manager. */ + + if (!found_wm_ping) + protos[num_protos++] = dpyinfo->Xatom_net_wm_ping; #if !defined HAVE_GTK3 && defined HAVE_XSYNC - if (!found_wm_sync_request && dpyinfo->xsync_supported_p) - protos[num_protos++] = dpyinfo->Xatom_net_wm_sync_request; + if (!found_wm_sync_request && dpyinfo->xsync_supported_p) + protos[num_protos++] = dpyinfo->Xatom_net_wm_sync_request; #endif + } if (num_protos) XChangeProperty (dpyinfo->display, @@ -2666,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. */ @@ -3089,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, @@ -3096,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, @@ -3103,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) @@ -3372,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 @@ -3407,6 +3451,38 @@ x_xim_text_to_utf8_unix_1 (ptrdiff_t nargs, Lisp_Object *args) } 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) { @@ -3463,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) @@ -3659,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 */ @@ -4736,6 +4974,7 @@ This function is an internal primitive--use `make-frame' instead. */) #endif /* USE_LUCID && USE_TOOLKIT_SCROLL_BARS */ f->output_data.x->white_relief.pixel = -1; f->output_data.x->black_relief.pixel = -1; + f->output_data.x->visibility_state = VisibilityFullyObscured; fset_icon_name (f, gui_display_get_arg (dpyinfo, parms, @@ -5723,13 +5962,13 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect) = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) dpyinfo->root_window, (xcb_atom_t) dpyinfo->Xatom_net_current_desktop, - XCB_ATOM_CARDINAL, 0, 1); + XA_CARDINAL, 0, 1); workarea_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) dpyinfo->root_window, (xcb_atom_t) dpyinfo->Xatom_net_workarea, - XCB_ATOM_CARDINAL, 0, UINT32_MAX); + XA_CARDINAL, 0, UINT32_MAX); reply = xcb_get_property_reply (dpyinfo->xcb_connection, current_desktop_cookie, &error); @@ -5740,7 +5979,7 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect) else { if (xcb_get_property_value_length (reply) != 4 - || reply->type != XCB_ATOM_CARDINAL || reply->format != 32) + || reply->type != XA_CARDINAL || reply->format != 32) rc = false; else current_workspace = *(uint32_t *) xcb_get_property_value (reply); @@ -5755,7 +5994,7 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect) free (error), rc = false; else { - if (rc && reply->type == XCB_ATOM_CARDINAL && reply->format == 32 + if (rc && reply->type == XA_CARDINAL && reply->format == 32 && (xcb_get_property_value_length (reply) / sizeof (uint32_t) >= current_workspace + 4)) { @@ -7079,8 +7318,8 @@ that mouse buttons are being held down, such as immediately after a /* Catch errors since interning lots of targets can potentially generate a BadAlloc error. */ x_catch_errors (FRAME_X_DISPLAY (f)); - XInternAtoms (FRAME_X_DISPLAY (f), target_names, - ntargets, False, target_atoms); + x_intern_atoms (FRAME_DISPLAY_INFO (f), target_names, + ntargets, target_atoms); x_check_errors (FRAME_X_DISPLAY (f), "Failed to intern target atoms: %s"); x_uncatch_errors_after_check (); @@ -7377,20 +7616,6 @@ If TERMINAL is omitted or nil, that stands for the selected frame's display. */ return Qnil; } -/* Wait for responses to all X commands issued so far for frame F. */ - -void -x_sync (struct frame *f) -{ - block_input (); -#ifndef USE_XCB - XSync (FRAME_X_DISPLAY (f), False); -#else - xcb_aux_sync (FRAME_DISPLAY_INFO (f)->xcb_connection); -#endif - unblock_input (); -} - /*********************************************************************** Window properties @@ -7484,7 +7709,7 @@ silently ignored. */) elsize = element_format == 32 ? sizeof (long) : element_format >> 3; data = xnmalloc (nelements, elsize); - x_fill_property_data (FRAME_X_DISPLAY (f), value, data, nelements, + x_fill_property_data (FRAME_DISPLAY_INFO (f), value, data, nelements, element_format); } else @@ -9779,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 @@ -10225,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/xftfont.c b/src/xftfont.c index 1ade22a6006..4d5b855f178 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -628,6 +628,12 @@ xftfont_shape (Lisp_Object lgstring, Lisp_Object direction) static int xftfont_end_for_frame (struct frame *f) { + /* XftDrawDestroy tries to access dpyinfo->display, which could've + been destroyed by now, causing Emacs to crash. The alternative + is to leak the XftDraw, but that's better than a crash. */ + if (!FRAME_X_DISPLAY (f)) + return 0; + block_input (); XftDraw *xft_draw; diff --git a/src/xselect.c b/src/xselect.c index 45f933bba30..0586e46870b 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -16,7 +16,6 @@ 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/>. */ - /* Rewritten by jwz */ #include <config.h> @@ -44,7 +43,7 @@ struct prop_location; struct selection_data; static void x_decline_selection_request (struct selection_input_event *); -static bool x_convert_selection (Lisp_Object, Lisp_Object, Atom, bool, +static bool x_convert_selection (Lisp_Object, Lisp_Object, Atom, struct x_display_info *, bool); static bool waiting_for_other_props_on_window (Display *, Window); static struct prop_location *expect_property_change (Display *, Window, @@ -77,18 +76,20 @@ static void x_send_client_event (Lisp_Object, Lisp_Object, Lisp_Object, #define TRACE0(fmt) (void) 0 #define TRACE1(fmt, a0) (void) 0 #define TRACE2(fmt, a0, a1) (void) 0 +#define TRACE3(fmt, a0, a1, a2) (void) 0 #endif /* Bytes needed to represent 'long' data. This is as per libX11; it is not necessarily sizeof (long). */ #define X_LONG_SIZE 4 -/* If this is a smaller number than the max-request-size of the display, - emacs will use INCR selection transfer when the selection is larger - than this. The max-request-size is usually around 64k, so if you want - emacs to use incremental selection transfers when the selection is - smaller than that, set this. I added this mostly for debugging the - incremental transfer stuff, but it might improve server performance. +/* If this is a smaller number than the max-request-size of the + display, Emacs will use INCR selection transfer when the selection + is larger than this. The max-request-size is usually around 64k, + so if you want emacs to use incremental selection transfers when + the selection is smaller than that, set this. I added this mostly + for debugging the incremental transfer stuff, but it might improve + server performance. This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long)) because it is multiplied by X_LONG_SIZE and by sizeof (long) in @@ -101,7 +102,9 @@ static void x_send_client_event (Lisp_Object, Lisp_Object, Lisp_Object, static int selection_quantum (Display *display) { - long mrs = XExtendedMaxRequestSize (display); + long mrs; + + mrs = XExtendedMaxRequestSize (display); if (!mrs) mrs = XMaxRequestSize (display); @@ -281,10 +284,8 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, timestamp = dpyinfo->last_user_time; block_input (); - x_catch_errors (display); - XSetSelectionOwner (display, selection_atom, selecting_window, timestamp); - x_check_errors (display, "Can't set selection: %s"); - x_uncatch_errors_after_check (); + XSetSelectionOwner (display, selection_atom, selecting_window, + timestamp); unblock_input (); /* Now update the local cache */ @@ -459,7 +460,7 @@ x_decline_selection_request (struct selection_input_event *event) /* The reason for the error may be that the receiver has died in the meantime. Handle that case. */ block_input (); - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, reply->requestor, False, 0, &reply_base); x_stop_ignoring_errors (dpyinfo); @@ -472,19 +473,65 @@ x_decline_selection_request (struct selection_input_event *event) struct selection_data { + /* Pointer to the selection data. */ unsigned char *data; + + /* A Lisp_Object containing the selection data. This is either + Qnil, or `data' is NULL. If non-nil, then this must be a string + whose contents will be written out verbatim. */ + Lisp_Object string; + + /* The size, in number of items, of the selection data. + The value is meaningless if string is non-nil. */ ptrdiff_t size; + + /* The format of the selection data. */ int format; + + /* The type of the selection data. */ Atom type; - bool nofree; + + /* The property describing the selection data. */ Atom property; - /* This can be set to non-NULL during x_reply_selection_request, if - the selection is waiting for an INCR transfer to complete. Don't - free these; that's done by unexpect_property_change. */ - struct prop_location *wait_object; + + /* The next piece of selection data in the current selection request + stack frame. This can be NULL. */ struct selection_data *next; }; +/* Structure representing a single outstanding selection request (or + subrequest if MULTIPLE is being used.) */ + +struct transfer +{ + /* The requestor of this transfer. */ + Window requestor; + + /* The current offset in items into the selection data, and the + number of items to send with each ChangeProperty request. */ + size_t offset, items_per_request; + + /* The display info associated with the transfer. */ + struct x_display_info *dpyinfo; + + /* The converted selection data. */ + struct selection_data data; + + /* The next and last selection transfers on this list. */ + struct transfer *next, *last; + + /* The atimer for the timeout. */ + struct atimer *timeout; + + /* The selection serial. */ + unsigned int serial; + + /* Flags. */ + int flags; +}; + +#define SELECTED_EVENTS 1 + struct x_selection_request { /* The last element in this stack. */ @@ -499,8 +546,8 @@ struct x_selection_request /* Linked list of the above (in support of MULTIPLE targets). */ struct selection_data *converted_selections; - /* "Data" to send a requestor for a failed MULTIPLE subtarget. */ - Atom conversion_fail_tag; + /* The serial used to handle X errors. */ + unsigned int serial; /* Whether or not conversion was successful. */ bool converted; @@ -511,6 +558,50 @@ struct x_selection_request struct x_selection_request *selection_request_stack; +/* List of all outstanding selection transfers which are currently + being processed. */ + +struct transfer outstanding_transfers; + +/* A counter for selection serials. */ + +static unsigned int selection_serial; + + + +struct prop_location +{ + int identifier; + Display *display; + Window window; + Atom property; + int desired_state; + bool arrived; + struct prop_location *next; +}; + +static int prop_location_identifier; + +static Lisp_Object property_change_reply; + +static struct prop_location *property_change_reply_object; + +static struct prop_location *property_change_wait_list; + +static void +set_property_change_object (struct prop_location *location) +{ + /* Input must be blocked so we don't get the event before we set + these. */ + if (! input_blocked_p ()) + emacs_abort (); + + XSETCAR (property_change_reply, Qnil); + property_change_reply_object = location; +} + + + static void x_push_current_selection_request (struct selection_input_event *se, struct x_display_info *dpyinfo) @@ -523,7 +614,6 @@ x_push_current_selection_request (struct selection_input_event *se, frame->request = se; frame->dpyinfo = dpyinfo; frame->converted_selections = NULL; - frame->conversion_fail_tag = None; selection_request_stack = frame; } @@ -554,7 +644,7 @@ x_selection_request_lisp_error (void) for (cs = frame->converted_selections; cs; cs = next) { next = cs->next; - if (! cs->nofree && cs->data) + if (cs->data) xfree (cs->data); xfree (cs); } @@ -564,250 +654,450 @@ x_selection_request_lisp_error (void) x_decline_selection_request (frame->request); } -static void -x_catch_errors_unwind (void) + + +static size_t +c_size_for_format (int format) { - block_input (); - x_uncatch_errors (); - unblock_input (); + switch (format) + { + case 8: + return sizeof (char); + + case 16: + return sizeof (short); + + case 32: + return sizeof (long); + } + + emacs_abort (); } - -/* This stuff is so that INCR selections are reentrant (that is, so we can - be servicing multiple INCR selection requests simultaneously.) I haven't - actually tested that yet. */ +static size_t +x_size_for_format (int format) +{ + switch (format) + { + case 8: + return 1; + + case 16: + return 2; -/* Keep a list of the property changes that are awaited. */ + case 32: + return 4; + } -struct prop_location + emacs_abort (); +} + +/* Return a pointer to the remaining part of the selection data, given + a pointer to a struct selection_data and an offset in items. Place + the number of items remaining in REMAINING. Garbage collection + must not happen, or the returned pointer becomes invalid. */ + +static unsigned char * +selection_data_for_offset (struct selection_data *data, + long offset, size_t *remaining) { - int identifier; - Display *display; - Window window; - Atom property; - int desired_state; - bool arrived; - struct prop_location *next; -}; + unsigned char *base; + size_t size; -static int prop_location_identifier; + if (!NILP (data->string)) + { + base = SDATA (data->string); + size = SBYTES (data->string); + } + else + { + base = data->data; + size = data->size; + } -static Lisp_Object property_change_reply; + if (offset >= size) + { + *remaining = 0; + return NULL; + } -static struct prop_location *property_change_reply_object; + base += (offset * c_size_for_format (data->format)); + *remaining = size - offset; + return base; +} -static struct prop_location *property_change_wait_list; +/* Return the size, in bytes transferred to the X server, of + data->size items of selection data in data->format-bit + quantities. */ -static void -set_property_change_object (struct prop_location *location) +static size_t +selection_data_size (struct selection_data *data) { - /* Input must be blocked so we don't get the event before we set these. */ - if (! input_blocked_p ()) - emacs_abort (); - XSETCAR (property_change_reply, Qnil); - property_change_reply_object = location; + size_t scratch; + + if (!NILP (data->string)) + return SBYTES (data->string); + + switch (data->format) + { + case 8: + return (size_t) data->size; + + case 16: + if (INT_MULTIPLY_WRAPV (data->size, 2, &scratch)) + return SIZE_MAX; + + return scratch; + + case 32: + if (INT_MULTIPLY_WRAPV (data->size, 4, &scratch)) + return SIZE_MAX; + + return scratch; + } + + /* The specified format is invalid. */ + emacs_abort (); } - -/* Send the reply to a selection request event EVENT. */ +/* Return whether or not another outstanding selection transfer is + still selecting for events on the specified requestor window. */ -#ifdef TRACE_SELECTION -static int x_reply_selection_request_cnt; -#endif /* TRACE_SELECTION */ +static bool +transfer_selecting_event (struct x_display_info *dpyinfo, + Window requestor) +{ + struct transfer *next; + + next = outstanding_transfers.next; + for (; next != &outstanding_transfers; next = next->next) + { + if (next->requestor == requestor + && next->dpyinfo == dpyinfo) + return true; + } + + return false; +} + +/* Cancel the specified selection transfer. When called by + `start_transfer', the transfer may be partially formed. */ static void -x_reply_selection_request (struct selection_input_event *event, - struct x_display_info *dpyinfo) +x_cancel_selection_transfer (struct transfer *transfer) { - XEvent reply_base; - XSelectionEvent *reply = &(reply_base.xselection); - Display *display = SELECTION_EVENT_DISPLAY (event); - Window window = SELECTION_EVENT_REQUESTOR (event); - ptrdiff_t bytes_remaining; - int max_bytes = selection_quantum (display); - specpdl_ref count = SPECPDL_INDEX (); - struct selection_data *cs; - struct x_selection_request *frame; + xfree (transfer->data.data); - frame = selection_request_stack; + if (transfer->next) + { + transfer->next->last = transfer->last; + transfer->last->next = transfer->next; + } - reply->type = SelectionNotify; - reply->display = display; - reply->requestor = window; - reply->selection = SELECTION_EVENT_SELECTION (event); - reply->time = SELECTION_EVENT_TIME (event); - reply->target = SELECTION_EVENT_TARGET (event); - reply->property = SELECTION_EVENT_PROPERTY (event); - if (reply->property == None) - reply->property = reply->target; + if (transfer->flags & SELECTED_EVENTS + && !transfer_selecting_event (transfer->dpyinfo, + transfer->requestor) + /* This can be called from x_delete_display. */ + && transfer->dpyinfo->display) + { + /* Ignore errors generated by the change window request in case + the window has gone away. */ + block_input (); + x_ignore_errors_for_next_request (transfer->dpyinfo, 0); + XSelectInput (transfer->dpyinfo->display, + transfer->requestor, NoEventMask); + x_stop_ignoring_errors (transfer->dpyinfo); + unblock_input (); + } - block_input (); - /* The protected block contains wait_for_property_change, which can - run random lisp code (process handlers) or signal. Therefore, we - put the x_uncatch_errors call in an unwind. */ - record_unwind_protect_void (x_catch_errors_unwind); - x_catch_errors (display); + cancel_atimer (transfer->timeout); + xfree (transfer); +} - /* Loop over converted selections, storing them in the requested - properties. If data is large, only store the first N bytes - (section 2.7.2 of ICCCM). Note that we store the data for a - MULTIPLE request in the opposite order; the ICCM says only that - the conversion itself must be done in the same order. */ - for (cs = frame->converted_selections; cs; cs = cs->next) +static void +x_selection_transfer_timeout (struct atimer *atimer) +{ + struct transfer *transfer; + + transfer = atimer->client_data; + x_cancel_selection_transfer (transfer); +} + +/* Start a selection transfer to write the specified selection data to + its requestor. If the data is small enough, write it to the + requestor window and return. Otherwise, start INCR transfer and + begin listening for PropertyNotify events on the requestor. */ + +static void +x_start_selection_transfer (struct x_display_info *dpyinfo, Window requestor, + struct selection_data *data) +{ + struct transfer *transfer; + intmax_t timeout; + intmax_t secs; + int nsecs; + size_t remaining, max_size; + unsigned char *xdata; + unsigned long data_size; + + timeout = max (0, x_selection_timeout); + secs = timeout / 1000; + nsecs = (timeout % 1000) * 1000000; + + transfer = xzalloc (sizeof *transfer); + transfer->requestor = requestor; + transfer->dpyinfo = dpyinfo; + + transfer->timeout = start_atimer (ATIMER_RELATIVE, + make_timespec (secs, nsecs), + x_selection_transfer_timeout, + transfer); + + /* Note that DATA is copied into transfer. DATA->data is then set + to NULL, giving the struct transfer ownership over the selection + data. */ + + transfer->data = *data; + data->data = NULL; + + /* Finally, transfer now holds a reference to data->string, if it is + present. GC cannot be allowed to happen until this function + returns. */ + data->string = Qnil; + + /* Now, try to write the selection data. If it is bigger than + selection_quantum (dpyinfo->display), start incremental transfer + and link the transfer onto the list of pending selections. + Otherwise, write the transfer at once. */ + + max_size = selection_quantum (dpyinfo->display); + + TRACE3 (" x_start_selection_transfer: transferring to 0x%lx. " + "transfer consists of %zu bytes, quantum being %zu", + requestor, selection_data_size (&transfer->data), + max_size); + + if (selection_data_size (&transfer->data) > max_size) { - if (cs->property == None) - continue; + /* Begin incremental selection transfer. First, calculate how + many elements it is ok to write for every ChangeProperty + request. */ + transfer->items_per_request + = (max_size / x_size_for_format (transfer->data.format)); + TRACE1 (" x_start_selection_transfer: starting incremental" + " selection transfer, with %zu items per request", + transfer->items_per_request); + + /* Next, link the transfer onto the list of pending selection + transfers. */ + transfer->next = outstanding_transfers.next; + transfer->last = &outstanding_transfers; + transfer->next->last = transfer; + transfer->last->next = transfer; + + /* Find a valid (non-zero) serial for the selection transfer. + Any asynchronously trapped errors will then cause the + selection transfer to be cancelled. */ + transfer->serial = (++selection_serial + ? selection_serial + : ++selection_serial); + + /* Now, write the INCR property to begin incremental selection + transfer. offset is currently 0. */ + + data_size = selection_data_size (&transfer->data); + + /* Set SELECTED_EVENTS before the actual XSelectInput + request. */ + transfer->flags |= SELECTED_EVENTS; + + x_ignore_errors_for_next_request (dpyinfo, transfer->serial); + XChangeProperty (dpyinfo->display, requestor, + transfer->data.property, + dpyinfo->Xatom_INCR, 32, PropModeReplace, + (unsigned char *) &data_size, 1); + + /* This assumes that Emacs is not selecting for any other events + from the requestor! + + If the holder of some manager selections (i.e. the settings + manager) asks Emacs for selection data, things will subtly go + wrong. */ + XSelectInput (dpyinfo->display, requestor, PropertyChangeMask); + x_stop_ignoring_errors (dpyinfo); + } + else + { + /* Write the property data now. */ + xdata = selection_data_for_offset (&transfer->data, + 0, &remaining); + eassert (remaining <= INT_MAX); + + TRACE1 (" x_start_selection_transfer: writing" + " %zu elements directly to requestor window", + remaining); + + x_ignore_errors_for_next_request (dpyinfo, 0); + XChangeProperty (dpyinfo->display, requestor, + transfer->data.property, + transfer->data.type, + transfer->data.format, + PropModeReplace, xdata, remaining); + x_stop_ignoring_errors (dpyinfo); + + /* Next, get rid of the transfer. */ + x_cancel_selection_transfer (transfer); + } +} - bytes_remaining = cs->size; - bytes_remaining *= cs->format >> 3; - if (bytes_remaining <= max_bytes) - { - /* Send all the data at once, with minimal handshaking. */ - TRACE1 ("Sending all %"pD"d bytes", bytes_remaining); - XChangeProperty (display, window, cs->property, - cs->type, cs->format, PropModeReplace, - cs->data, cs->size); - } - else - { - /* Send an INCR tag to initiate incremental transfer. */ - long value[1]; - - TRACE2 ("Start sending %"pD"d bytes incrementally (%s)", - bytes_remaining, XGetAtomName (display, cs->property)); - cs->wait_object - = expect_property_change (display, window, cs->property, - PropertyDelete); - - /* XChangeProperty expects an array of long even if long is - more than 32 bits. */ - value[0] = min (bytes_remaining, X_LONG_MAX); - XChangeProperty (display, window, cs->property, - dpyinfo->Xatom_INCR, 32, PropModeReplace, - (unsigned char *) value, 1); - XSelectInput (display, window, PropertyChangeMask); - } +/* Write out the next piece of data that is part of the specified + selection transfer. If no more data remains to be written, write + the EOF property and complete the transfer. */ + +static void +x_continue_selection_transfer (struct transfer *transfer) +{ + size_t remaining; + unsigned char *xdata; + + xdata = selection_data_for_offset (&transfer->data, + transfer->offset, + &remaining); + remaining = min (remaining, transfer->items_per_request); + + if (!remaining) + { + /* The transfer is finished. Write zero-length property data to + signal EOF and remove the transfer. */ + TRACE0 (" x_continue_selection_transfer: writing 0 items to" + " indicate EOF"); + x_ignore_errors_for_next_request (transfer->dpyinfo, 0); + XChangeProperty (transfer->dpyinfo->display, + transfer->requestor, + transfer->data.property, + transfer->data.type, + transfer->data.format, + PropModeReplace, + NULL, 0); + x_stop_ignoring_errors (transfer->dpyinfo); + TRACE0 (" x_continue_selection_transfer: done sending incrementally"); + + x_cancel_selection_transfer (transfer); + } + else + { + TRACE2 (" x_continue_selection_transfer: writing %zu items" + "; current offset is %zu", remaining, transfer->offset); + eassert (remaining <= INT_MAX); + + transfer->offset += remaining; + + x_ignore_errors_for_next_request (transfer->dpyinfo, + transfer->serial); + XChangeProperty (transfer->dpyinfo->display, + transfer->requestor, + transfer->data.property, + transfer->data.type, + transfer->data.format, + PropModeReplace, xdata, + remaining); + x_stop_ignoring_errors (transfer->dpyinfo); } +} - /* Now issue the SelectionNotify event. */ - XSendEvent (display, window, False, 0, &reply_base); - XFlush (display); +void +x_remove_selection_transfers (struct x_display_info *dpyinfo) +{ + struct transfer *next, *last; -#ifdef TRACE_SELECTION - { - char *sel = XGetAtomName (display, reply->selection); - char *tgt = XGetAtomName (display, reply->target); - TRACE3 ("Sent SelectionNotify: %s, target %s (%d)", - sel, tgt, ++x_reply_selection_request_cnt); - if (sel) XFree (sel); - if (tgt) XFree (tgt); - } -#endif /* TRACE_SELECTION */ + next = outstanding_transfers.next; + while (next != &outstanding_transfers) + { + last = next; + next = next->next; - /* Finish sending the rest of each of the INCR values. This should - be improved; there's a chance of deadlock if more than one - subtarget in a MULTIPLE selection requires an INCR transfer, and - the requestor and Emacs loop waiting on different transfers. */ - for (cs = frame->converted_selections; cs; cs = cs->next) - if (cs->wait_object) - { - int format_bytes = cs->format / 8; - bool had_errors_p = x_had_errors_p (display); + if (last->dpyinfo == dpyinfo) + x_cancel_selection_transfer (last); + } +} - /* Must set this inside block_input (). unblock_input may read - events and setting property_change_reply in - wait_for_property_change is then too late. */ - set_property_change_object (cs->wait_object); - unblock_input (); +/* Handle an X error generated trying to write to a window. SERIAL + identifies the outstanding incremental selection transfer, which is + immediately removed. */ - bytes_remaining = cs->size; - bytes_remaining *= format_bytes; +void +x_handle_selection_error (unsigned int serial, XErrorEvent *error) +{ + struct transfer *next, *last; - /* Wait for the requestor to ack by deleting the property. - This can run Lisp code (process handlers) or signal. */ - if (! had_errors_p) - { - TRACE1 ("Waiting for ACK (deletion of %s)", - XGetAtomName (display, cs->property)); - wait_for_property_change (cs->wait_object); - } - else - unexpect_property_change (cs->wait_object); + if (error->error_code != BadWindow) + /* The error was not caused by the window going away. As such, + Emacs must deselect for PropertyChangeMask from the requestor + window, which isn't safe here. Return and wait for the timeout + to run. */ + return; - while (bytes_remaining) - { - int i = ((bytes_remaining < max_bytes) - ? bytes_remaining - : max_bytes) / format_bytes; - block_input (); - - cs->wait_object - = expect_property_change (display, window, cs->property, - PropertyDelete); - - TRACE1 ("Sending increment of %d elements", i); - TRACE1 ("Set %s to increment data", - XGetAtomName (display, cs->property)); - - /* Append the next chunk of data to the property. */ - XChangeProperty (display, window, cs->property, - cs->type, cs->format, PropModeAppend, - cs->data, i); - bytes_remaining -= i * format_bytes; - cs->data += i * ((cs->format == 32) ? sizeof (long) - : format_bytes); - XFlush (display); - had_errors_p = x_had_errors_p (display); - /* See comment above about property_change_reply. */ - set_property_change_object (cs->wait_object); - unblock_input (); - - if (had_errors_p) break; - - /* Wait for the requestor to ack this chunk by deleting - the property. This can run Lisp code or signal. */ - TRACE1 ("Waiting for increment ACK (deletion of %s)", - XGetAtomName (display, cs->property)); - wait_for_property_change (cs->wait_object); - } + next = outstanding_transfers.next; + while (next != &outstanding_transfers) + { + last = next; + next = next->next; - /* Now write a zero-length chunk to the property to tell the - requestor that we're done. */ - block_input (); - if (! waiting_for_other_props_on_window (display, window)) - XSelectInput (display, window, 0); - - TRACE1 ("Set %s to a 0-length chunk to indicate EOF", - XGetAtomName (display, cs->property)); - XChangeProperty (display, window, cs->property, - cs->type, cs->format, PropModeReplace, - cs->data, 0); - TRACE0 ("Done sending incrementally"); - } + if (last->serial == serial) + { + /* Clear SELECTED_EVENTS, so x_cancel_selection_transfer + will not make X requests. That is unsafe inside an error + handler, and unnecessary because the window has already + gone. */ + last->flags &= ~SELECTED_EVENTS; + x_cancel_selection_transfer (last); + } + } +} - /* rms, 2003-01-03: I think I have fixed this bug. */ - /* The window we're communicating with may have been deleted - in the meantime (that's a real situation from a bug report). - In this case, there may be events in the event queue still - referring to the deleted window, and we'll get a BadWindow error - in XTread_socket when processing the events. I don't have - an idea how to fix that. gerd, 2001-01-98. */ - /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are - delivered before uncatch errors. */ - XSync (display, False); - unblock_input (); +/* Send the reply to a selection request event EVENT. */ + +static void +x_reply_selection_request (struct selection_input_event *event, + struct x_display_info *dpyinfo) +{ + XEvent message; + struct selection_data *cs; + struct x_selection_request *frame; - /* GTK queues events in addition to the queue in Xlib. So we - UNBLOCK to enter the event loop and get possible errors delivered, - and then BLOCK again because x_uncatch_errors requires it. */ block_input (); - /* This calls x_uncatch_errors. */ - unbind_to (count, Qnil); + frame = selection_request_stack; + + message.xselection.type = SelectionNotify; + message.xselection.display = dpyinfo->display; + message.xselection.requestor = SELECTION_EVENT_REQUESTOR (event); + message.xselection.selection = SELECTION_EVENT_SELECTION (event); + message.xselection.time = SELECTION_EVENT_TIME (event); + message.xselection.target = SELECTION_EVENT_TARGET (event); + message.xselection.property = SELECTION_EVENT_PROPERTY (event); + + if (message.xselection.property == None) + message.xselection.property = message.xselection.target; + + /* For each of the converted selections, start a write transfer from + Emacs to the requestor. */ + for (cs = frame->converted_selections; cs; cs = cs->next) + x_start_selection_transfer (dpyinfo, + SELECTION_EVENT_REQUESTOR (event), + cs); + + + /* Send the SelectionNotify event to the requestor, telling it that + the property data has arrived. */ + x_ignore_errors_for_next_request (dpyinfo, 0); + XSendEvent (dpyinfo->display, SELECTION_EVENT_REQUESTOR (event), + False, NoEventMask, &message); + x_stop_ignoring_errors (dpyinfo); unblock_input (); } - -/* Handle a SelectionRequest event EVENT. - This is called from keyboard.c when such an event is found in the queue. */ + +/* Handle a SelectionRequest event EVENT. This is called from + keyboard.c when such an event is found in the queue. */ static void x_handle_selection_request (struct selection_input_event *event) @@ -892,7 +1182,9 @@ x_handle_selection_request (struct selection_input_event *event) ptrdiff_t j, nselections; struct selection_data cs; - if (property == None) goto DONE; + if (property == None) + goto DONE; + multprop = x_get_window_property_as_lisp_data (dpyinfo, requestor, property, QMULTIPLE, selection, true); @@ -904,23 +1196,24 @@ x_handle_selection_request (struct selection_input_event *event) /* Perform conversions. This can signal. */ for (j = 0; j < nselections; j++) { - Lisp_Object subtarget = AREF (multprop, 2*j); + Lisp_Object subtarget = AREF (multprop, 2 * j); Atom subproperty = symbol_to_x_atom (dpyinfo, AREF (multprop, 2*j+1)); bool subsuccess = false; if (subproperty != None) subsuccess = x_convert_selection (selection_symbol, subtarget, - subproperty, true, dpyinfo, + subproperty, dpyinfo, use_alternate); if (!subsuccess) - ASET (multprop, 2*j+1, Qnil); + ASET (multprop, 2 * j + 1, Qnil); } + /* Save conversion results */ lisp_data_to_selection_data (dpyinfo, multprop, &cs); - /* If cs.type is ATOM, change it to ATOM_PAIR. This is because - the parameters to a MULTIPLE are ATOM_PAIRs. */ + /* If cs.type is ATOM, change it to ATOM_PAIR. This is + because the parameters to a MULTIPLE are ATOM_PAIRs. */ if (cs.type == XA_ATOM) cs.type = dpyinfo->Xatom_ATOM_PAIR; @@ -929,27 +1222,29 @@ x_handle_selection_request (struct selection_input_event *event) cs.type, cs.format, PropModeReplace, cs.data, cs.size); success = true; + + xfree (cs.data); } else { if (property == None) property = SELECTION_EVENT_TARGET (event); + success = x_convert_selection (selection_symbol, target_symbol, property, - false, dpyinfo, - use_alternate); + dpyinfo, use_alternate); } DONE: - if (pushed) - selection_request_stack->converted = true; - if (success) x_reply_selection_request (event, dpyinfo); else x_decline_selection_request (event); + if (pushed) + selection_request_stack->converted = true; + /* Run the `x-sent-selection-functions' abnormal hook. */ if (!NILP (Vx_sent_selection_functions) && !BASE_EQ (Vx_sent_selection_functions, Qunbound)) @@ -960,19 +1255,18 @@ x_handle_selection_request (struct selection_input_event *event) REALLY_DONE: unbind_to (count, Qnil); + return; } /* Perform the requested selection conversion, and write the data to the converted_selections linked list, where it can be accessed by - x_reply_selection_request. If FOR_MULTIPLE, write out - the data even if conversion fails, using conversion_fail_tag. + x_reply_selection_request. Return true if successful. */ static bool -x_convert_selection (Lisp_Object selection_symbol, - Lisp_Object target_symbol, Atom property, - bool for_multiple, struct x_display_info *dpyinfo, +x_convert_selection (Lisp_Object selection_symbol, Lisp_Object target_symbol, + Atom property, struct x_display_info *dpyinfo, bool use_alternate) { Lisp_Object lisp_selection; @@ -988,33 +1282,16 @@ x_convert_selection (Lisp_Object selection_symbol, /* A nil return value means we can't perform the conversion. */ if (NILP (lisp_selection) || (CONSP (lisp_selection) && NILP (XCDR (lisp_selection)))) - { - if (for_multiple) - { - cs = xmalloc (sizeof *cs); - cs->data = ((unsigned char *) - &selection_request_stack->conversion_fail_tag); - cs->size = 1; - cs->format = 32; - cs->type = XA_ATOM; - cs->nofree = true; - cs->property = property; - cs->wait_object = NULL; - cs->next = frame->converted_selections; - frame->converted_selections = cs; - } - - return false; - } + return false; /* Otherwise, record the converted selection to binary. */ cs = xmalloc (sizeof *cs); cs->data = NULL; - cs->nofree = true; + cs->string = Qnil; cs->property = property; - cs->wait_object = NULL; cs->next = frame->converted_selections; frame->converted_selections = cs; + lisp_data_to_selection_data (dpyinfo, lisp_selection, cs); return true; } @@ -1274,6 +1551,10 @@ void x_handle_property_notify (const XPropertyEvent *event) { struct prop_location *rest; + struct transfer *next; +#ifdef TRACE_SELECTION + char *name; +#endif for (rest = property_change_wait_list; rest; rest = rest->next) { @@ -1283,9 +1564,16 @@ x_handle_property_notify (const XPropertyEvent *event) && rest->display == event->display && rest->desired_state == event->state) { +#ifdef TRACE_SELECTION + name = XGetAtomName (event->display, event->atom); + TRACE2 ("Expected %s of property %s", (event->state == PropertyDelete ? "deletion" : "change"), - XGetAtomName (event->display, event->atom)); + name ? name : "unknown"); + + if (name) + XFree (name); +#endif rest->arrived = true; @@ -1297,6 +1585,26 @@ x_handle_property_notify (const XPropertyEvent *event) return; } } + + /* Look for a property change for an outstanding selection + transfer. */ + next = outstanding_transfers.next; + while (next != &outstanding_transfers) + { + if (next->dpyinfo->display == event->display + && next->requestor == event->window + && next->data.property == event->atom + && event->state == PropertyDelete) + { + TRACE1 ("Expected PropertyDelete event arrived from the" + " requestor window %lx", next->requestor); + + x_continue_selection_transfer (next); + return; + } + + next = next->next; + } } static void @@ -1450,10 +1758,10 @@ x_get_window_property (Display *display, Window window, Atom property, /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1 and SIZE_MAX - 1, for an extra byte at the end. And it cannot exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */ - ptrdiff_t total_size_max = - ((min (PTRDIFF_MAX, SIZE_MAX) - 1) / x_long_size < LONG_MAX - ? min (PTRDIFF_MAX, SIZE_MAX) - 1 - : LONG_MAX * x_long_size); + ptrdiff_t total_size_max + = ((min (PTRDIFF_MAX, SIZE_MAX) - 1) / x_long_size < LONG_MAX + ? min (PTRDIFF_MAX, SIZE_MAX) - 1 + : LONG_MAX * x_long_size); block_input (); @@ -1946,10 +2254,14 @@ static void lisp_data_to_selection_data (struct x_display_info *dpyinfo, Lisp_Object obj, struct selection_data *cs) { - Lisp_Object type = Qnil; + Lisp_Object type; + char **name_buffer; + + USE_SAFE_ALLOCA; + + type = Qnil; eassert (cs != NULL); - cs->nofree = false; if (CONSP (obj) && SYMBOLP (XCAR (obj))) { @@ -1959,8 +2271,10 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, obj = XCAR (obj); } + /* This is not the same as declining. */ + if (EQ (obj, QNULL) || (EQ (type, QNULL))) - { /* This is not the same as declining */ + { cs->format = 32; cs->size = 0; cs->data = NULL; @@ -1971,12 +2285,14 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, if (SCHARS (obj) < SBYTES (obj)) /* OBJ is a multibyte string containing a non-ASCII char. */ signal_error ("Non-ASCII string must be encoded in advance", obj); + if (NILP (type)) type = QSTRING; + cs->format = 8; - cs->size = SBYTES (obj); - cs->data = SDATA (obj); - cs->nofree = true; + cs->size = -1; + cs->data = NULL; + cs->string = obj; } else if (SYMBOLP (obj)) { @@ -2048,8 +2364,19 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, x_atoms = data; cs->format = 32; cs->size = size; - for (i = 0; i < size; i++) - x_atoms[i] = symbol_to_x_atom (dpyinfo, AREF (obj, i)); + + if (size == 1) + x_atoms[0] = symbol_to_x_atom (dpyinfo, AREF (obj, i)); + else + { + SAFE_NALLOCA (name_buffer, sizeof *x_atoms, size); + + for (i = 0; i < size; i++) + name_buffer[i] = SSDATA (SYMBOL_NAME (AREF (obj, i))); + + x_intern_atoms (dpyinfo, name_buffer, size, + x_atoms); + } } else /* This vector is an INTEGER set, or something like it */ @@ -2091,6 +2418,8 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, signal_error (/* Qselection_error */ "Unrecognized selection data", obj); cs->type = symbol_to_x_atom (dpyinfo, type); + + SAFE_FREE (); } static Lisp_Object @@ -2618,8 +2947,8 @@ x_check_property_data (Lisp_Object data) XClientMessageEvent). */ void -x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, - int nelements_max, int format) +x_fill_property_data (struct x_display_info *dpyinfo, Lisp_Object data, + void *ret, int nelements_max, int format) { unsigned long val; unsigned long *d32 = (unsigned long *) ret; @@ -2654,7 +2983,7 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, else if (STRINGP (o)) { block_input (); - val = XInternAtom (dpy, SSDATA (o), False); + val = x_intern_cached_atom (dpyinfo, SSDATA (o), false); unblock_input (); } else @@ -2942,7 +3271,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, memset (event.xclient.data.l, 0, sizeof (event.xclient.data.l)); /* event.xclient.data can hold 20 chars, 10 shorts, or 5 longs. */ - x_fill_property_data (dpyinfo->display, values, event.xclient.data.b, + x_fill_property_data (dpyinfo, values, event.xclient.data.b, 5 * 32 / event.xclient.format, event.xclient.format); @@ -3002,10 +3331,11 @@ syms_of_xselect (void) reading_selection_reply = Fcons (Qnil, Qnil); staticpro (&reading_selection_reply); - staticpro (&property_change_reply); - /* FIXME: Duplicate definition in nsselect.c. */ + outstanding_transfers.next = &outstanding_transfers; + outstanding_transfers.last = &outstanding_transfers; + DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist, doc: /* An alist associating X Windows selection-types with functions. These functions are called to convert the selection, with three args: @@ -3120,9 +3450,43 @@ Note that this does not affect setting or owning selections. */); static void syms_of_xselect_for_pdumper (void) { + outstanding_transfers.next = &outstanding_transfers; + outstanding_transfers.last = &outstanding_transfers; + reading_selection_window = 0; reading_which_selection = 0; property_change_wait_list = 0; prop_location_identifier = 0; property_change_reply = Fcons (Qnil, Qnil); } + +void +mark_xselect (void) +{ + struct transfer *next; + struct x_selection_request *frame; + struct selection_data *cs; + + /* Mark all the strings being used as selection data. A string that + is still reachable is always reachable via either the selection + request stack or the list of outstanding transfers. */ + + next = outstanding_transfers.next; + + if (!next) + /* syms_of_xselect has not yet been called. */ + return; + + while (next != &outstanding_transfers) + { + mark_object (next->data.string); + next = next->next; + } + + frame = selection_request_stack; + for (; frame; frame = frame->last) + { + for (cs = frame->converted_selections; cs; cs = cs->next) + mark_object (cs->string); + } +} diff --git a/src/xterm.c b/src/xterm.c index 6a4b84babe4..70bcb67d80d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -26,6 +26,22 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ contains subroutines comprising the redisplay interface, setting up scroll bars and widgets, and handling input. + X WINDOW SYSTEM + + The X Window System is a windowing system for bitmap graphics + displays which originated at MIT in 1984. Version 11, which is + currently supported by Emacs, first appeared in September 1987. + + X has a long history and has been developed by many different + organizations over the years; at present, it is being primarily + developed by the X.Org Foundation. It is the main window system + that Emacs is developed and tested against, and X version 10 was + the first window system that Emacs was ported to. As a consequence + of its age and wide availability, X contains many idiosyncrasies, + but that has not prevented it from becoming the dominant free + window system, and the platform of reference for all GUI code in + Emacs. + Some of what is explained below also applies to the other window systems that Emacs supports, to varying degrees. YMMV. @@ -555,7 +571,56 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ drop happening with the primary selection and synthetic button events (see `x_dnd_do_unsupported_drop'). That function implements the OffiX drag-and-drop protocol by default. See - `x-dnd-handle-unsupported-drop' in `x-dnd.el' for more details. */ + `x-dnd-handle-unsupported-drop' in `x-dnd.el' for more details. + + DISPLAY ERROR HANDLING + + While error handling under X was originally designed solely as a + mechanism for the X server to report fatal errors to clients, most + clients (including Emacs) have adopted a system of "error traps" to + handle or discard these errors as they arrive. Discarding errors is + usually necessary when Emacs performs an X request that might fail: + for example, sending a message to a window that may no longer exist, + or might not exist at all. Handling errors is then necessary when + the detailed error must be reported to another piece of code: for + example, as a Lisp error. + + It is not acceptable for Emacs to crash when it is sent invalid data + by another client, or by Lisp. As a result, errors must be caught + around Xlib functions generating requests containing resource + identifiers that could potentially be invalid, such as window or + atom identifiers provided in a client message from another program, + or a child window ID obtained through XTranslateCoordinates that may + refer to a window that has been deleted in the meantime. + + There are two sets of functions used to perform this "error + trapping". Which one should be used depends on what kind of + processing must be done on the error. The first consists of the + functions `x_ignore_errors_for_next_request' and + `x_stop_ignoring_errors', which ignore errors generated by requests + made in between a call to the first function and a corresponding + call to the second. They should be used for simple asynchronous + requests that do not require a reply from the X server: using them + instead of the second set improves performance, as they simply + record a range of request serials to ignore errors from, instead of + synchronizing with the X server to handle errors. + + The second set consists of the following functions: + + - x_catch_errors_with_handler + - x_catch_errors + - x_uncatch_errors_after_check + - x_uncatch_errors + - x_check_errors + - x_had_errors_p + - x_clear_errors + + Callers using this set should consult the comment(s) on top of the + aformentioned functions. They should not be used when the requests + being made do not require roundtrips to the X server, and obtaining + the details of any error generated is unecessary, as + `x_uncatch_errors' will always synchronize with the X server, which + is a potentially slow operation. */ #include <config.h> #include <stdlib.h> @@ -571,10 +636,13 @@ 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> -#include <xcb/xcb_aux.h> #endif /* If we have Xfixes extension, use it for pointer blanking. */ @@ -1052,6 +1120,20 @@ static const struct x_atom_ref x_atom_refs[] = /* Old OffiX (a.k.a. old KDE) drop protocol support. */ ATOM_REFS_INIT ("DndProtocol", Xatom_DndProtocol) ATOM_REFS_INIT ("_DND_PROTOCOL", Xatom_DND_PROTOCOL) + /* Here are some atoms that are not actually used from C, just + defined to make replying to selection requests fast. */ + ATOM_REFS_INIT ("text/plain;charset=utf-8", Xatom_text_plain_charset_utf_8) + ATOM_REFS_INIT ("LENGTH", Xatom_LENGTH) + ATOM_REFS_INIT ("FILE_NAME", Xatom_FILE_NAME) + ATOM_REFS_INIT ("CHARACTER_POSITION", Xatom_CHARACTER_POSITION) + ATOM_REFS_INIT ("LINE_NUMBER", Xatom_LINE_NUMBER) + ATOM_REFS_INIT ("COLUMN_NUMBER", Xatom_COLUMN_NUMBER) + ATOM_REFS_INIT ("OWNER_OS", Xatom_OWNER_OS) + ATOM_REFS_INIT ("HOST_NAME", Xatom_HOST_NAME) + ATOM_REFS_INIT ("USER", Xatom_USER) + ATOM_REFS_INIT ("CLASS", Xatom_CLASS) + ATOM_REFS_INIT ("NAME", Xatom_NAME) + ATOM_REFS_INIT ("SAVE_TARGETS", Xatom_SAVE_TARGETS) }; enum @@ -2509,7 +2591,7 @@ xm_send_drop_message (struct x_display_info *dpyinfo, Window source, *((uint32_t *) &msg.xclient.data.b[12]) = dmsg->index_atom; *((uint32_t *) &msg.xclient.data.b[16]) = dmsg->source_window; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -2536,7 +2618,7 @@ xm_send_top_level_enter_message (struct x_display_info *dpyinfo, Window source, msg.xclient.data.b[18] = 0; msg.xclient.data.b[19] = 0; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -2567,7 +2649,7 @@ xm_send_drag_motion_message (struct x_display_info *dpyinfo, Window source, msg.xclient.data.b[18] = 0; msg.xclient.data.b[19] = 0; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -2626,7 +2708,7 @@ xm_send_top_level_leave_message (struct x_display_info *dpyinfo, Window source, msg.xclient.data.b[18] = 0; msg.xclient.data.b[19] = 0; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -2921,7 +3003,7 @@ x_dnd_free_toplevels (bool display_alive) if (n_windows) { eassume (dpyinfo); - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); for (i = 0; i < n_windows; ++i) { @@ -3058,7 +3140,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) 0, 0); get_property_cookies[i] = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) toplevels[i], - (xcb_atom_t) dpyinfo->Xatom_wm_state, XCB_ATOM_ANY, + (xcb_atom_t) dpyinfo->Xatom_wm_state, 0, 0, 2); xm_property_cookies[i] = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) toplevels[i], @@ -3069,7 +3151,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) toplevels[i], (xcb_atom_t) dpyinfo->Xatom_net_frame_extents, - XCB_ATOM_CARDINAL, 0, 4); + XA_CARDINAL, 0, 4); get_geometry_cookies[i] = xcb_get_geometry (dpyinfo->xcb_connection, (xcb_window_t) toplevels[i]); @@ -3197,7 +3279,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) { if (xcb_get_property_value_length (extent_property_reply) == 16 && extent_property_reply->format == 32 - && extent_property_reply->type == XCB_ATOM_CARDINAL) + && extent_property_reply->type == XA_CARDINAL) { fextents = xcb_get_property_value (extent_property_reply); frame_extents[0] = fextents[0]; @@ -3291,7 +3373,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) if (dpyinfo->xshape_supported_p) { - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XShapeSelectInput (dpyinfo->display, toplevels[i], ShapeNotifyMask); @@ -3456,7 +3538,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) } #endif - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSelectInput (dpyinfo->display, toplevels[i], (attrs.your_event_mask | StructureNotifyMask @@ -3571,13 +3653,13 @@ x_dnd_get_proxy_proto (struct x_display_info *dpyinfo, Window wdesc, xdnd_proxy_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) wdesc, (xcb_atom_t) dpyinfo->Xatom_XdndProxy, - XCB_ATOM_WINDOW, 0, 1); + XA_WINDOW, 0, 1); if (proto_out) xdnd_proto_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) wdesc, (xcb_atom_t) dpyinfo->Xatom_XdndAware, - XCB_ATOM_ATOM, 0, 1); + XA_ATOM, 0, 1); if (proxy_out) { @@ -3589,7 +3671,7 @@ x_dnd_get_proxy_proto (struct x_display_info *dpyinfo, Window wdesc, else { if (reply->format == 32 - && reply->type == XCB_ATOM_WINDOW + && reply->type == XA_WINDOW && (xcb_get_property_value_length (reply) >= 4)) *proxy_out = *(xcb_window_t *) xcb_get_property_value (reply); @@ -3607,7 +3689,7 @@ x_dnd_get_proxy_proto (struct x_display_info *dpyinfo, Window wdesc, else { if (reply->format == 32 - && reply->type == XCB_ATOM_ATOM + && reply->type == XA_ATOM && (xcb_get_property_value_length (reply) >= 4)) *proto_out = (int) *(xcb_atom_t *) xcb_get_property_value (reply); @@ -3791,15 +3873,15 @@ x_dnd_get_wm_state_and_proto (struct x_display_info *dpyinfo, wmstate_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) window, (xcb_atom_t) dpyinfo->Xatom_wm_state, - XCB_ATOM_ANY, 0, 2); + 0, 0, 2); xdnd_proto_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) window, (xcb_atom_t) dpyinfo->Xatom_XdndAware, - XCB_ATOM_ATOM, 0, 1); + XA_ATOM, 0, 1); xdnd_proxy_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) window, (xcb_atom_t) dpyinfo->Xatom_XdndProxy, - XCB_ATOM_WINDOW, 0, 1); + XA_WINDOW, 0, 1); xm_style_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) window, (xcb_atom_t) dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO, @@ -3846,7 +3928,7 @@ x_dnd_get_wm_state_and_proto (struct x_display_info *dpyinfo, else { if (reply->format == 32 - && reply->type == XCB_ATOM_WINDOW + && reply->type == XA_WINDOW && (xcb_get_property_value_length (reply) >= 4)) *proxy_out = *(xcb_window_t *) xcb_get_property_value (reply); @@ -3962,6 +4044,12 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, if (owner != FRAME_X_WINDOW (f)) return; + /* mouse-drag-and-drop-region will immediately deactivate the mark + after this is set. Make sure the primary selection is not + clobbered in that case by setting `deactivate-mark' to + Qdont_save. */ + Vdeactivate_mark = Qdont_save; + event.xbutton.window = child; event.xbutton.subwindow = None; event.xbutton.x = dest_x; @@ -3975,7 +4063,7 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, event.xbutton.type = ButtonPress; event.xbutton.time = before + 1; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, child, True, ButtonPressMask, &event); @@ -4487,7 +4575,7 @@ x_dnd_send_enter (struct frame *f, Window target, Window toplevel, so we don't have to set it again. */ x_dnd_init_type_lists = true; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -4559,7 +4647,7 @@ x_dnd_send_position (struct frame *f, Window target, Window toplevel, return; } - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); @@ -4586,7 +4674,7 @@ x_dnd_send_leave (struct frame *f, Window target, Window toplevel) x_dnd_waiting_for_status_window = None; x_dnd_pending_send_position.type = 0; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -4619,7 +4707,7 @@ x_dnd_send_drop (struct frame *f, Window target, Window toplevel, if (supported >= 1) msg.xclient.data.l[2] = timestamp; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); return true; @@ -5666,7 +5754,8 @@ xi_device_from_id (struct x_display_info *dpyinfo, int deviceid) static void xi_link_touch_point (struct xi_device_t *device, - int detail, double x, double y) + int detail, double x, double y, + struct frame *frame) { struct xi_touch_point_t *touchpoint; @@ -5675,6 +5764,7 @@ xi_link_touch_point (struct xi_device_t *device, touchpoint->x = x; touchpoint->y = y; touchpoint->number = detail; + touchpoint->frame = frame; device->touchpoints = touchpoint; } @@ -5703,6 +5793,36 @@ xi_unlink_touch_point (int detail, return false; } +/* Unlink all touch points associated with the frame F. + This is done upon unmapping or destroying F's window, because + touch point delivery after that point is undefined. */ + +static void +xi_unlink_touch_points (struct frame *f) +{ + struct xi_device_t *device; + struct xi_touch_point_t **next, *last; + int i; + + for (i = 0; i < FRAME_DISPLAY_INFO (f)->num_devices; ++i) + { + device = &FRAME_DISPLAY_INFO (f)->devices[i]; + + /* Now unlink all touch points on DEVICE matching F. */ + + for (next = &device->touchpoints; (last = *next);) + { + if (last->frame == f) + { + *next = last->next; + xfree (last); + } + else + next = &last->next; + } + } +} + static struct xi_touch_point_t * xi_find_touch_point (struct xi_device_t *device, int detail) { @@ -5830,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 @@ -6731,7 +6853,7 @@ x_set_frame_alpha (struct frame *f) Do this unconditionally as this function is called on reparent when alpha has not changed on the frame. */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); if (!FRAME_PARENT_FRAME (f)) { @@ -6907,6 +7029,7 @@ static void x_sync_wait_for_frame_drawn_event (struct frame *f) { XEvent event; + struct x_display_info *dpyinfo; if (!FRAME_X_WAITING_FOR_DRAW (f) /* The compositing manager can't draw a frame if it is @@ -6914,6 +7037,8 @@ x_sync_wait_for_frame_drawn_event (struct frame *f) || !FRAME_VISIBLE_P (f)) return; + dpyinfo = FRAME_DISPLAY_INFO (f); + /* Wait for the frame drawn message to arrive. */ if (x_if_event (FRAME_X_DISPLAY (f), &event, x_sync_is_frame_drawn_event, (XPointer) f, @@ -6929,6 +7054,11 @@ x_sync_wait_for_frame_drawn_event (struct frame *f) "been disabled\n"); FRAME_X_OUTPUT (f)->use_vsync_p = false; + /* Remove the compositor bypass property from the outer + window. */ + XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_bypass_compositor); + /* Also change the frame parameter to reflect the new state. */ store_frame_param (f, Quse_frame_synchronization, Qnil); @@ -6942,7 +7072,7 @@ x_sync_wait_for_frame_drawn_event (struct frame *f) } } else - x_sync_note_frame_times (FRAME_DISPLAY_INFO (f), f, &event); + x_sync_note_frame_times (dpyinfo, f, &event); FRAME_X_WAITING_FOR_DRAW (f) = false; } @@ -7358,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. @@ -7553,6 +7685,46 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row) #endif } +/* Generate a premultiplied pixel value for COLOR with ALPHA applied + on the given display. COLOR will be modified. The display must + use a visual that supports an alpha channel. + + This is possibly dead code on builds which do not support + XRender. */ + +#ifndef USE_CAIRO + +static unsigned long +x_premultiply_pixel (struct x_display_info *dpyinfo, + XColor *color, double alpha) +{ + unsigned long pixel; + + eassert (dpyinfo->alpha_bits); + + /* Multiply the RGB channels. */ + color->red *= alpha; + color->green *= alpha; + color->blue *= alpha; + + /* First, allocate a fully opaque pixel. */ + pixel = x_make_truecolor_pixel (dpyinfo, color->red, + color->green, + color->blue); + + /* Next, erase the alpha component. */ + pixel &= ~dpyinfo->alpha_mask; + + /* And add an alpha channel. */ + pixel |= (((unsigned long) (alpha * 65535) + >> (16 - dpyinfo->alpha_bits)) + << dpyinfo->alpha_offset); + + return pixel; +} + +#endif + static void x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fringe_bitmap_params *p) @@ -7642,18 +7814,15 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, if (FRAME_DISPLAY_INFO (f)->alpha_bits && f->alpha_background < 1.0) { + /* Extend the background color with an alpha channel + according to f->alpha_background. */ bg.pixel = background; x_query_colors (f, &bg, 1); - bg.red *= f->alpha_background; - bg.green *= f->alpha_background; - bg.blue *= f->alpha_background; - background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), - bg.red, bg.green, bg.blue); - background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; - background |= (((unsigned long) (f->alpha_background * 0xffff) - >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) - << FRAME_DISPLAY_INFO (f)->alpha_offset); + background + = x_premultiply_pixel (FRAME_DISPLAY_INFO (f), + &bg, + f->alpha_background); } /* Draw the bitmap. I believe these small pixmaps can be cached @@ -8802,7 +8971,11 @@ x_color_cells (Display *dpy, int *ncells) /* On frame F, translate pixel colors to RGB values for the NCOLORS - colors in COLORS. Use cached information, if available. */ + colors in COLORS. Use cached information, if available. + + Pixel values are in unsigned normalized format, meaning that + extending missing bits is done straightforwardly without any + complex colorspace conversions. */ void x_query_colors (struct frame *f, XColor *colors, int ncolors) @@ -8850,6 +9023,7 @@ x_query_colors (struct frame *f, XColor *colors, int ncolors) colors[i].green = (g * gmult) >> 16; colors[i].blue = (b * bmult) >> 16; } + return; } @@ -8892,16 +9066,10 @@ x_query_frame_background_color (struct frame *f, XColor *bgcolor) { bg.pixel = background; x_query_colors (f, &bg, 1); - bg.red *= f->alpha_background; - bg.green *= f->alpha_background; - bg.blue *= f->alpha_background; - background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), - bg.red, bg.green, bg.blue); - background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; - background |= (((unsigned long) (f->alpha_background * 0xffff) - >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) - << FRAME_DISPLAY_INFO (f)->alpha_offset); + background + = x_premultiply_pixel (FRAME_DISPLAY_INFO (f), + &bg, f->alpha_background); } #endif } @@ -10991,6 +11159,31 @@ x_clear_frame (struct frame *f) unblock_input (); } +/* Send a message to frame F telling the event loop to track whether + or not an hourglass is being displayed. This is required to ignore + the right events when the hourglass is mapped without callig XSync + after displaying or hiding the hourglass. */ + +static void +x_send_hourglass_message (struct frame *f, bool hourglass_enabled) +{ + struct x_display_info *dpyinfo; + XEvent msg; + + dpyinfo = FRAME_DISPLAY_INFO (f); + memset (&msg, 0, sizeof msg); + + msg.xclient.type = ClientMessage; + msg.xclient.message_type + = dpyinfo->Xatom_EMACS_TMP; + msg.xclient.format = 8; + msg.xclient.window = FRAME_X_WINDOW (f); + msg.xclient.data.b[0] = hourglass_enabled ? 1 : 0; + + XSendEvent (dpyinfo->display, FRAME_X_WINDOW (f), + False, NoEventMask, &msg); +} + /* RIF: Show hourglass cursor on frame F. */ static void @@ -11011,14 +11204,14 @@ x_show_hourglass (struct frame *f) if (popup_activated ()) return; + x_send_hourglass_message (f, true); + #ifdef USE_X_TOOLKIT if (x->widget) #else if (FRAME_OUTER_WINDOW (f)) #endif { - x->hourglass_p = true; - if (!x->hourglass_window) { #ifndef USE_XCB @@ -11085,15 +11278,11 @@ x_hide_hourglass (struct frame *f) { #ifndef USE_XCB XUnmapWindow (FRAME_X_DISPLAY (f), x->hourglass_window); - /* Sync here because XTread_socket looks at the - hourglass_p flag that is reset to zero below. */ - XSync (FRAME_X_DISPLAY (f), False); #else xcb_unmap_window (FRAME_DISPLAY_INFO (f)->xcb_connection, (xcb_window_t) x->hourglass_window); - xcb_aux_sync (FRAME_DISPLAY_INFO (f)->xcb_connection); #endif - x->hourglass_p = false; + x_send_hourglass_message (f, false); } } @@ -11217,21 +11406,32 @@ XTflash (struct frame *f) static void XTring_bell (struct frame *f) { - if (FRAME_X_DISPLAY (f)) + struct x_display_info *dpyinfo; + + if (!FRAME_X_DISPLAY (f)) + return; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (visible_bell) + XTflash (f); + else { - if (visible_bell) - XTflash (f); - else - { - block_input (); + /* When Emacs is untrusted, Bell requests sometimes generate + Access errors. This is not in the security extension + specification but seems to be a bug in the X consortium XKB + implementation. */ + + block_input (); + x_ignore_errors_for_next_request (dpyinfo, 0); #ifdef HAVE_XKB - XkbBell (FRAME_X_DISPLAY (f), None, 0, None); + XkbBell (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 0, None); #else - XBell (FRAME_X_DISPLAY (f), 0); + XBell (FRAME_X_DISPLAY (f), 0); #endif - XFlush (FRAME_X_DISPLAY (f)); - unblock_input (); - } + XFlush (FRAME_X_DISPLAY (f)); + x_stop_ignoring_errors (dpyinfo); + unblock_input (); } } @@ -11477,7 +11677,7 @@ x_frame_highlight (struct frame *f) the window-manager in use, tho something more is at play since I've been using that same window-manager binary for ever. Let's not crash just because of this (bug#9310). */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_pixel); x_stop_ignoring_errors (dpyinfo); @@ -11500,7 +11700,7 @@ x_frame_unhighlight (struct frame *f) block_input (); /* Same as above for XSetWindowBorder (bug#9310). */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetWindowBorderPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_tile); x_stop_ignoring_errors (dpyinfo); @@ -11564,7 +11764,7 @@ x_new_focus_frame (struct x_display_info *dpyinfo, struct frame *frame) x_frame_rehighlight (dpyinfo); } -#ifdef HAVE_XFIXES +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 /* True if the display in DPYINFO supports a version of Xfixes sufficient for pointer blanking. */ @@ -11576,11 +11776,12 @@ x_fixes_pointer_blanking_supported (struct x_display_info *dpyinfo) && dpyinfo->xfixes_major >= 4); } -#endif /* HAVE_XFIXES */ +#endif /* HAVE_XFIXES && XFIXES_VERSION >= 40000 */ /* Toggle mouse pointer visibility on frame F using the XFixes extension. */ -#ifdef HAVE_XFIXES +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 + static void xfixes_toggle_visible_pointer (struct frame *f, bool invisible) @@ -11591,6 +11792,7 @@ xfixes_toggle_visible_pointer (struct frame *f, bool invisible) XFixesShowCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); f->pointer_invisible = invisible; } + #endif /* HAVE_XFIXES */ /* Create invisible cursor on the X display referred by DPYINFO. */ @@ -11639,7 +11841,7 @@ x_toggle_visible_pointer (struct frame *f, bool invisible) if (dpyinfo->invisible_cursor == None) dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); -#ifndef HAVE_XFIXES +#if !defined HAVE_XFIXES || XFIXES_VERSION < 40000 if (dpyinfo->invisible_cursor == None) invisible = false; #else @@ -11672,7 +11874,7 @@ static void XTtoggle_invisible_pointer (struct frame *f, bool invisible) { block_input (); -#ifdef HAVE_XFIXES +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 if (FRAME_DISPLAY_INFO (f)->fixes_pointer_blanking && x_fixes_pointer_blanking_supported (FRAME_DISPLAY_INFO (f))) xfixes_toggle_visible_pointer (f, invisible); @@ -12261,6 +12463,13 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, struct xi_device_t *device; #endif + if (FRAME_DISPLAY_INFO (f)->untrusted) + /* Untrusted clients cannot send messages to trusted clients or + read the window tree, so drag and drop will likely not work at + all. */ + error ("Drag-and-drop is not possible when the client is" + " not trusted by the X server."); + base = SPECPDL_INDEX (); /* Bind this here to avoid juggling bindings and SAFE_FREE in @@ -13366,6 +13575,10 @@ xi_disable_devices (struct x_display_info *dpyinfo, #ifdef HAVE_XINPUT2_2 struct xi_touch_point_t *tem, *last; #endif +#if defined HAVE_XINPUT2_2 && !defined HAVE_EXT_TOOL_BAR + struct x_output *output; + Lisp_Object tail, frame; +#endif /* Don't pointlessly copy dpyinfo->devices if there are no devices to disable. */ @@ -13408,6 +13621,34 @@ xi_disable_devices (struct x_display_info *dpyinfo, tem = tem->next; xfree (last); } + +#ifndef HAVE_EXT_TOOL_BAR + + /* Now look through each frame on DPYINFO. If it has an + outstanding tool bar press for this device, release + the tool bar. */ + + FOR_EACH_FRAME (tail, frame) + { + if (!FRAME_X_P (XFRAME (frame)) + || (FRAME_DISPLAY_INFO (XFRAME (frame)) + != dpyinfo)) + continue; + + output = FRAME_OUTPUT_DATA (XFRAME (frame)); + + if (output->tool_bar_touch_device + == dpyinfo->devices[i].device_id) + { + if (XFRAME (frame)->last_tool_bar_item != -1 + && WINDOWP (XFRAME (frame)->tool_bar_window)) + handle_tool_bar_click (XFRAME (frame), 0, 0, + false, 0); + + output->tool_bar_touch_device = 0; + } + } +#endif #endif goto out; @@ -15032,9 +15273,7 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, XClientMessageEvent *ev = &event.xclient; struct window *w = XWINDOW (window); struct frame *f = XFRAME (w->frame); - intptr_t iw = (intptr_t) w; verify (INTPTR_WIDTH <= 64); - int sign_shift = INTPTR_WIDTH - 32; /* Don't do anything if too many scroll bar events have been sent but not received. */ @@ -15051,15 +15290,11 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, ev->window = FRAME_X_WINDOW (f); ev->format = 32; - /* A 32-bit X client can pass a window pointer through the X server - as-is. - - A 64-bit client is in trouble because a pointer does not fit in - the 32 bits given for ClientMessage data and will be truncated by - Xlib. So use two slots and hope that X12 will resolve such - issues someday. */ - ev->data.l[0] = iw >> 31 >> 1; - ev->data.l[1] = sign_shift <= 0 ? iw : iw << sign_shift >> sign_shift; + /* These messages formerly contained a pointer to the window, but + now that information is kept internally. The following two + fields are thus zero. */ + ev->data.l[0] = 0; + ev->data.l[1] = 0; ev->data.l[2] = part; ev->data.l[3] = portion; ev->data.l[4] = whole; @@ -18490,7 +18725,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_waiting_for_status_window = None; else { - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &x_dnd_pending_send_position); @@ -18604,6 +18839,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } + if (event->xclient.message_type == dpyinfo->Xatom_EMACS_TMP + && event->xclient.format == 8) + { + /* This is actually an hourglass message. Set whether or + not events from here on have the hourglass enabled. */ + + if (any) + FRAME_X_OUTPUT (any)->hourglass_p = event->xclient.data.b[0]; + } + if (event->xclient.message_type == dpyinfo->Xatom_wm_protocols && event->xclient.format == 32) { @@ -19192,7 +19437,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) FRAME_OUTER_WINDOW (f), (xcb_atom_t) dpyinfo->Xatom_net_wm_window_opacity, - XCB_ATOM_CARDINAL, 0, 1); + XA_CARDINAL, 0, 1); opacity_reply = xcb_get_property_reply (dpyinfo->xcb_connection, opacity_cookie, &error); @@ -19201,9 +19446,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, free (error), rc = false; else rc = (opacity_reply->format == 32 - && (opacity_reply->type == XCB_ATOM_CARDINAL - || opacity_reply->type == XCB_ATOM_ATOM - || opacity_reply->type == XCB_ATOM_WINDOW) + && (opacity_reply->type == XA_CARDINAL + || opacity_reply->type == XA_ATOM + || opacity_reply->type == XA_WINDOW) && (xcb_get_property_value_length (opacity_reply) >= 4)); if (rc) @@ -20900,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; } @@ -21349,7 +21596,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf))) { - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), RevertToParent, event->xbutton.time); x_stop_ignoring_errors (dpyinfo); @@ -21570,9 +21817,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, case VisibilityNotify: f = x_top_window_to_frame (dpyinfo, event->xvisibility.window); - if (f && (event->xvisibility.state == VisibilityUnobscured - || event->xvisibility.state == VisibilityPartiallyObscured)) - SET_FRAME_VISIBLE (f, 1); + + if (f) + FRAME_X_OUTPUT (f)->visibility_state = event->xvisibility.state; goto OTHER; @@ -23047,7 +23294,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* This can generate XI_BadDevice if the device's attachment was destroyed server-side. */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XISetFocus (dpyinfo->display, device->attachment, /* Note that the input extension only supports RevertToParent-type @@ -23060,7 +23307,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, events to handle focus. Errors are still caught here in case the window is not viewable. */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), RevertToParent, xev->time); x_stop_ignoring_errors (dpyinfo); @@ -24036,6 +24283,73 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif +#ifndef HAVE_EXT_TOOL_BAR + /* Is this a touch from a direct touch device that is in + the tool-bar? */ + if (device->direct_p + && WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) + { + Lisp_Object window; + int x = xev->event_x; + int y = xev->event_y; + + window = window_from_coordinates (f, x, y, 0, true, true); + /* Ignore button release events if the mouse + wasn't previously pressed on the tool bar. + We do this because otherwise selecting some + text with the mouse and then releasing it on + the tool bar doesn't stop selecting text, + since the tool bar eats the button up + event. */ + tool_bar_p = EQ (window, f->tool_bar_window); + + /* If this touch has started in the tool bar, do not + send it to Lisp. Instead, simulate a tool bar + click, releasing it once it goes away. */ + + if (tool_bar_p) + { + /* Call note_mouse_highlight on the tool bar + item. Otherwise, get_tool_bar_item will + return 1. + + This is not necessary when mouse-highlight is + nil. */ + + if (!NILP (Vmouse_highlight)) + { + note_mouse_highlight (f, x, y); + + /* Always allow future mouse motion to + update the mouse highlight, no matter + where it is. */ + memset (&dpyinfo->last_mouse_glyph, 0, + sizeof dpyinfo->last_mouse_glyph); + dpyinfo->last_mouse_glyph_frame = f; + } + + handle_tool_bar_click_with_device (f, x, y, true, 0, + (source + ? source->name : Qt)); + + /* Flush any changes made by that to the front + buffer. */ + x_flush_dirty_back_buffer_on (f); + + /* Record the device and the touch ID on the + frame. That way, Emacs knows when to dismiss + the tool bar click later. */ + + FRAME_OUTPUT_DATA (f)->tool_bar_touch_device + = device->device_id; + FRAME_OUTPUT_DATA (f)->tool_bar_touch_id = xev->detail; + + goto XI_OTHER; + } + } +#endif + if (!menu_bar_p && !tool_bar_p) { if (f && device->direct_p) @@ -24045,13 +24359,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_catch_errors (dpyinfo->display); if (x_input_grab_touch_events) - XIAllowTouchEvents (dpyinfo->display, xev->deviceid, - xev->detail, xev->event, XIAcceptTouch); + XIAllowTouchEvents (dpyinfo->display, + xev->deviceid, + xev->detail, xev->event, + XIAcceptTouch); if (!x_had_errors_p (dpyinfo->display)) { - xi_link_touch_point (device, xev->detail, xev->event_x, - xev->event_y); + xi_link_touch_point (device, xev->detail, + xev->event_x, + xev->event_y, f); inev.ie.kind = TOUCHSCREEN_BEGIN_EVENT; inev.ie.timestamp = xev->time; @@ -24069,7 +24386,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifndef HAVE_GTK3 else if (x_input_grab_touch_events) { - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XIAllowTouchEvents (dpyinfo->display, xev->deviceid, xev->detail, xev->event, XIRejectTouch); x_stop_ignoring_errors (dpyinfo); @@ -24126,10 +24443,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, for (touchpoint = device->touchpoints; touchpoint; touchpoint = touchpoint->next) { - arg = Fcons (list3i (lrint (touchpoint->x), - lrint (touchpoint->y), - lrint (touchpoint->number)), - arg); + if (touchpoint->frame == f) + arg = Fcons (list3i (lrint (touchpoint->x), + lrint (touchpoint->y), + lrint (touchpoint->number)), + arg); } if (source) @@ -24175,6 +24493,33 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } +#ifndef HAVE_EXT_TOOL_BAR + /* Now see if the touchpoint was previously on the tool bar. + If it was, release the tool bar. */ + + if (!f) + f = x_window_to_frame (dpyinfo, xev->event); + + if (f && (FRAME_OUTPUT_DATA (f)->tool_bar_touch_id + == xev->detail)) + { + if (f->last_tool_bar_item != -1) + handle_tool_bar_click_with_device (f, xev->event_x, + xev->event_y, + false, 0, + (source + ? source->name + : Qnil)); + + /* Cancel any outstanding mouse highlight. */ + note_mouse_highlight (f, -1, -1); + x_flush_dirty_back_buffer_on (f); + + /* Now clear the tool bar device. */ + FRAME_OUTPUT_DATA (f)->tool_bar_touch_device = 0; + } +#endif + goto XI_OTHER; } @@ -25506,10 +25851,17 @@ x_clean_failable_requests (struct x_display_info *dpyinfo) x_uncatch_errors_after_check is that this function does not sync to catch errors if requests were made. It should be used instead of those two functions for catching errors around requests that do not - require a reply. */ + require a reply. + + As a special feature intended to support xselect.c, + SELECTION_SERIAL may be an arbitrary number greater than zero: when + that is the case, x_select_handle_selection_error is called with + the specified number to delete the selection request that + encountered the error. */ void -x_ignore_errors_for_next_request (struct x_display_info *dpyinfo) +x_ignore_errors_for_next_request (struct x_display_info *dpyinfo, + unsigned int selection_serial) { struct x_failable_request *request, *max; unsigned long next_request; @@ -25563,6 +25915,7 @@ x_ignore_errors_for_next_request (struct x_display_info *dpyinfo) request->start = next_request; request->end = 0; + request->selection_serial = selection_serial; dpyinfo->next_failable_request++; } @@ -25984,9 +26337,11 @@ For details, see etc/PROBLEMS.\n", if (!ioerror && dpyinfo) { /* Dump the list of error handlers for debugging - purposes. */ + purposes if the list exists. */ - fprintf (stderr, "X error handlers currently installed:\n"); + if ((dpyinfo->failable_requests + != dpyinfo->next_failable_request) || x_error_message) + fprintf (stderr, "X error handlers currently installed:\n"); for (failable = dpyinfo->failable_requests; failable < dpyinfo->next_failable_request; @@ -26075,6 +26430,12 @@ x_error_handler (Display *display, XErrorEvent *event) + (last - fail)); } + /* If a selection transfer is the cause of this error, + remove the selection transfer now. */ + if (fail->selection_serial) + x_handle_selection_error (fail->selection_serial, + event); + return 0; } } @@ -26111,8 +26472,10 @@ x_error_handler (Display *display, XErrorEvent *event) static void NO_INLINE x_error_quitter (Display *display, XErrorEvent *event) { - char buf[256], buf1[400 + INT_STRLEN_BOUND (int) - + INT_STRLEN_BOUND (unsigned long)]; + char buf[256], buf1[800 + INT_STRLEN_BOUND (int) + + INT_STRLEN_BOUND (unsigned long) + + INT_STRLEN_BOUND (XID) + + INT_STRLEN_BOUND (int)]; /* Ignore BadName errors. They can happen because of fonts or colors that are not defined. */ @@ -26125,8 +26488,12 @@ x_error_quitter (Display *display, XErrorEvent *event) XGetErrorText (display, event->error_code, buf, sizeof (buf)); sprintf (buf1, "X protocol error: %s on protocol request %d\n" - "Serial no: %lu\n", buf, event->request_code, - event->serial); + "Serial no: %lu\n" + "Failing resource ID (if any): 0x%lx\n" + "Minor code: %d\n" + "This is a bug! Please report this to bug-gnu-emacs@gnu.org!\n", + buf, event->request_code, event->serial, event->resourceid, + event->minor_code); x_connection_closed (display, buf1, false); } @@ -26627,38 +26994,43 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) modified_left, modified_top); #endif - /* 'x_sync_with_move' is too costly for dragging child frames. */ - if (!FRAME_PARENT_FRAME (f) - /* If no window manager exists, just calling XSync will be - sufficient to ensure that the window geometry has been - updated. */ - && NILP (Vx_no_window_manager)) - { - x_sync_with_move (f, f->left_pos, f->top_pos, - FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN); - - /* change_gravity is non-zero when this function is called from Lisp to - programmatically move a frame. In that case, we call - x_check_expected_move to discover if we have a "Type A" or "Type B" - window manager, and, for a "Type A" window manager, adjust the position - of the frame. - - We call x_check_expected_move if a programmatic move occurred, and - either the window manager type (A/B) is unknown or it is Type A but we - need to compute the top/left offset adjustment for this frame. */ - - if (change_gravity != 0 - && (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN - || (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_A - && (FRAME_X_OUTPUT (f)->move_offset_left == 0 - && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) - x_check_expected_move (f, modified_left, modified_top); - } - /* Instead, just wait for the last ConfigureWindow request to - complete. No window manager is involved when moving child - frames. */ - else - XSync (FRAME_X_DISPLAY (f), False); + /* The following code is too slow over a latent network + connection. */ + if (NILP (Vx_lax_frame_positioning)) + { + /* 'x_sync_with_move' is too costly for dragging child frames. */ + if (!FRAME_PARENT_FRAME (f) + /* If no window manager exists, just calling XSync will be + sufficient to ensure that the window geometry has been + updated. */ + && NILP (Vx_no_window_manager)) + { + x_sync_with_move (f, f->left_pos, f->top_pos, + FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN); + + /* change_gravity is non-zero when this function is called from Lisp to + programmatically move a frame. In that case, we call + x_check_expected_move to discover if we have a "Type A" or "Type B" + window manager, and, for a "Type A" window manager, adjust the position + of the frame. + + We call x_check_expected_move if a programmatic move occurred, and + either the window manager type (A/B) is unknown or it is Type A but we + need to compute the top/left offset adjustment for this frame. */ + + if (change_gravity != 0 + && (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN + || (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_A + && (FRAME_X_OUTPUT (f)->move_offset_left == 0 + && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) + x_check_expected_move (f, modified_left, modified_top); + } + /* Instead, just wait for the last ConfigureWindow request to + complete. No window manager is involved when moving child + frames. */ + else + XSync (FRAME_X_DISPLAY (f), False); + } unblock_input (); } @@ -26718,6 +27090,12 @@ x_wm_supports_1 (struct x_display_info *dpyinfo, Atom want_atom) if (!NILP (Vx_no_window_manager)) return false; + /* If the window system says Emacs is untrusted, there will be no + way to send any information to the window manager, making any + hints useless. */ + if (dpyinfo->untrusted) + return false; + block_input (); x_catch_errors (dpy); @@ -27188,13 +27566,12 @@ do_ewmh_fullscreen (struct frame *f) static void XTfullscreen_hook (struct frame *f) { - if (FRAME_VISIBLE_P (f)) - { - block_input (); - x_check_fullscreen (f); - x_sync (f); - unblock_input (); - } + if (!FRAME_VISIBLE_P (f)) + return; + + block_input (); + x_check_fullscreen (f); + unblock_input (); } @@ -27288,10 +27665,7 @@ x_check_fullscreen (struct frame *f) if (FRAME_VISIBLE_P (f)) x_wait_for_event (f, ConfigureNotify); else - { - change_frame_size (f, width, height, false, true, false); - x_sync (f); - } + change_frame_size (f, width, height, false, true, false); } /* `x_net_wm_state' might have reset the fullscreen frame parameter, @@ -27465,6 +27839,12 @@ x_set_window_size_1 (struct frame *f, bool change_gravity, we have to make sure to do it here. */ SET_FRAME_GARBAGED (f); + /* The following code is too slow over a latent network + connection, so skip it when the user says so. */ + + if (!NILP (Vx_lax_frame_positioning)) + return; + /* Now, strictly speaking, we can't be sure that this is accurate, but the window manager will get around to dealing with the size change request eventually, and we'll hear how it went when the @@ -27505,8 +27885,6 @@ x_set_window_size_1 (struct frame *f, bool change_gravity, adjust_frame_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, width), FRAME_PIXEL_TO_TEXT_HEIGHT (f, height), 5, 0, Qx_set_window_size_1); - - x_sync (f); } } @@ -27560,7 +27938,7 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) && deviceid != -1) { block_input (); - x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f), 0); XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); @@ -27857,7 +28235,7 @@ x_set_input_focus (struct x_display_info *dpyinfo, Window window, { eassert (device->use == XIMasterPointer); - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XISetFocus (dpyinfo->display, device->attachment, /* Note that the input extension only supports RevertToParent-type @@ -27872,7 +28250,7 @@ x_set_input_focus (struct x_display_info *dpyinfo, Window window, /* Otherwise, use the pointer device that the X server says is the client pointer. */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetInputFocus (dpyinfo->display, window, RevertToParent, time); x_stop_ignoring_errors (dpyinfo); } @@ -27892,12 +28270,17 @@ x_focus_frame (struct frame *f, bool noactivate) struct x_display_info *dpyinfo; Time time; + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (dpyinfo->untrusted) + /* The X server ignores all input focus related requests from + untrusted clients. */ + return; + /* The code below is not reentrant wrt to dpyinfo->x_focus_frame and friends being set. */ block_input (); - dpyinfo = FRAME_DISPLAY_INFO (f); - if (FRAME_X_EMBEDDED_P (f)) /* For Xembedded frames, normally the embedder forwards key events. See XEmbed Protocol Specification at @@ -28009,7 +28392,7 @@ xembed_send_message (struct frame *f, Time t, enum xembed_message msg, but I don't understand why: there is no way for clients to survive the death of the parent anyway. */ - x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f), 0); XSendEvent (FRAME_X_DISPLAY (f), FRAME_X_OUTPUT (f)->parent_desc, False, NoEventMask, &event); x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); @@ -28160,6 +28543,7 @@ x_make_frame_visible (struct frame *f) && !FRAME_ICONIFIED_P (f) && !FRAME_X_EMBEDDED_P (f) && !FRAME_PARENT_FRAME (f) + && NILP (Vx_lax_frame_positioning) && f->win_gravity == NorthWestGravity && previously_visible) { @@ -28188,7 +28572,8 @@ x_make_frame_visible (struct frame *f) } /* Try to wait for a MapNotify event (that is what tells us when a - frame becomes visible). */ + frame becomes visible). Unless `x-lax-frame-positioning' is + non-nil: there, that is a little slow. */ #ifdef CYGWIN /* On Cygwin, which uses input polling, we need to force input to @@ -28206,7 +28591,8 @@ x_make_frame_visible (struct frame *f) poll_suppress_count = old_poll_suppress_count; #endif - if (!FRAME_VISIBLE_P (f)) + if (!FRAME_VISIBLE_P (f) + && NILP (Vx_lax_frame_positioning)) { if (CONSP (frame_size_history)) frame_size_history_plain @@ -28239,6 +28625,11 @@ x_make_frame_invisible (struct frame *f) block_input (); +#ifdef HAVE_XINPUT2_2 + /* Remove any touch points associated with F. */ + xi_unlink_touch_points (f); +#endif + /* Before unmapping the window, update the WM_SIZE_HINTS property to claim that the current position of the window is user-specified, rather than program-specified, so that when the window is mapped again, it will be @@ -28263,7 +28654,10 @@ x_make_frame_invisible (struct frame *f) error ("Can't notify window manager of window withdrawal"); } - x_sync (f); + /* Don't perform the synchronization if the network connection is + slow, and the user says it is unwanted. */ + if (NILP (Vx_lax_frame_positioning)) + XSync (FRAME_X_DISPLAY (f), False); /* We can't distinguish this from iconification just by the event that we get from the server. @@ -28274,8 +28668,7 @@ x_make_frame_invisible (struct frame *f) SET_FRAME_ICONIFIED (f, false); if (CONSP (frame_size_history)) - frame_size_history_plain - (f, build_string ("x_make_frame_invisible")); + frame_size_history_plain (f, build_string ("x_make_frame_invisible")); unblock_input (); } @@ -28442,6 +28835,11 @@ x_free_frame_resources (struct frame *f) xi_handle_delete_frame (dpyinfo, f); #endif +#ifdef HAVE_XINPUT2_2 + /* Remove any touch points associated with F. */ + xi_unlink_touch_points (f); +#endif + /* If a display connection is dead, don't try sending more commands to the X server. */ if (dpyinfo->display) @@ -28625,6 +29023,13 @@ x_free_frame_resources (struct frame *f) if (f == hlinfo->mouse_face_mouse_frame) reset_mouse_highlight (hlinfo); + /* These two need to be freed now that they are used to compute the + mouse position, I think. */ + if (f == dpyinfo->last_mouse_motion_frame) + dpyinfo->last_mouse_motion_frame = NULL; + if (f == dpyinfo->last_mouse_frame) + dpyinfo->last_mouse_frame = NULL; + #ifdef HAVE_XINPUT2 /* Consider a frame being unfocused with no following FocusIn event while an older focus from another seat exists. The client @@ -28861,6 +29266,53 @@ x_get_atom_name (struct x_display_info *dpyinfo, Atom atom, return value; } +/* Intern an array of atoms, and do so quickly, avoiding extraneous + roundtrips to the X server. + + Avoid sending atoms that have already been found to the X server. + This cannot do anything that will end up triggering garbage + collection. */ + +void +x_intern_atoms (struct x_display_info *dpyinfo, char **names, int count, + Atom *atoms_return) +{ + int i, j, indices[256]; + char *new_names[256]; + Atom results[256], candidate; + + if (count > 256) + /* Atoms array too big to inspect reasonably, just send it to the + server and back. */ + XInternAtoms (dpyinfo->display, new_names, count, False, atoms_return); + else + { + for (i = 0, j = 0; i < count; ++i) + { + candidate = x_intern_cached_atom (dpyinfo, names[i], + true); + + if (candidate) + atoms_return[i] = candidate; + else + { + indices[j++] = i; + new_names[j - 1] = names[i]; + } + } + + if (!j) + return; + + /* Now, get the results back from the X server. */ + XInternAtoms (dpyinfo->display, new_names, j, False, + results); + + for (i = 0; i < j; ++i) + atoms_return[indices[i]] = results[i]; + } +} + #ifndef USE_GTK /* Set up XEmbed for F, and change its save set to handle the parent @@ -29409,6 +29861,7 @@ struct x_display_info * x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) { Display *dpy; + XKeyboardState keyboard_state; struct terminal *terminal; struct x_display_info *dpyinfo; XrmDatabase xrdb; @@ -29628,6 +30081,32 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo = xzalloc (sizeof *dpyinfo); terminal = x_create_terminal (dpyinfo); + if (!NILP (Vx_detect_server_trust)) + { + /* Detect whether or not the X server trusts this client, which + is done by making a SetKeyboardControl request and checking + for an Access error. */ + XGrabServer (dpy); + XGetKeyboardControl (dpy, &keyboard_state); + + x_catch_errors (dpy); + + /* At this point, the display is not on x_display_list, so + x_uncatch_errors won't sync. However, that's okay because + x_had_errors_p will. */ + + if (keyboard_state.global_auto_repeat + == AutoRepeatModeOn) + XAutoRepeatOn (dpy); + else + XAutoRepeatOff (dpy); + + if (x_had_errors_p (dpy)) + dpyinfo->untrusted = true; + x_uncatch_errors_after_check (); + XUngrabServer (dpy); + } + dpyinfo->next_failable_request = dpyinfo->failable_requests; { @@ -29648,13 +30127,17 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) { char *vendor = ServerVendor (dpy); - /* Temporarily hide the partially initialized terminal. */ + /* Temporarily hide the partially initialized terminal. + Use safe_call so that if a signal happens, a partially + initialized display (and display connection) is not + kept around. */ terminal_list = terminal->next_terminal; unblock_input (); - kset_system_key_alist - (terminal->kboard, - call1 (Qvendor_specific_keysyms, - vendor ? build_string (vendor) : empty_unibyte_string)); + kset_system_key_alist (terminal->kboard, + safe_call1 (Qvendor_specific_keysyms, + (vendor + ? build_string (vendor) + : empty_unibyte_string))); block_input (); terminal->next_terminal = terminal_list; terminal_list = terminal; @@ -30272,7 +30755,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) 1, 0, 1); dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); -#ifdef HAVE_XFIXES +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 dpyinfo->fixes_pointer_blanking = egetenv ("EMACS_XFIXES"); #endif @@ -30600,8 +31083,13 @@ x_delete_display (struct x_display_info *dpyinfo) last = ie; } + /* Delete selection requests bound for dpyinfo from the keyboard + buffer. */ x_delete_selection_requests (dpyinfo); + /* And remove any outstanding selection transfers. */ + x_remove_selection_transfers (dpyinfo); + if (next_noop_dpyinfo == dpyinfo) next_noop_dpyinfo = dpyinfo->next; @@ -31028,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) { @@ -31042,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) @@ -31107,7 +31628,7 @@ x_catch_errors_for_lisp (struct x_display_info *dpyinfo) if (!x_fast_protocol_requests) x_catch_errors (dpyinfo->display); else - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); } void @@ -31316,6 +31837,8 @@ syms_of_xterm (void) DEFSYM (Qnow, "now"); DEFSYM (Qx_dnd_targets_list, "x-dnd-targets-list"); DEFSYM (Qx_auto_preserve_selections, "x-auto-preserve-selections"); + DEFSYM (Qexpose, "expose"); + DEFSYM (Qdont_save, "dont-save"); #ifdef USE_GTK xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); @@ -31485,7 +32008,6 @@ always uses gtk_window_move and ignores the value of this variable. */); This option is only effective when Emacs is built with XInput 2 support. */); Vx_scroll_event_delta_factor = make_float (1.0); - DEFSYM (Qexpose, "expose"); DEFVAR_BOOL ("x-gtk-use-native-input", x_gtk_use_native_input, doc: /* Non-nil means to use GTK for input method support. @@ -31699,4 +32221,26 @@ select text over slow X connections. If that is still too slow, setting this variable to the symbol `really-fast' will make Emacs return only cached values. */); Vx_use_fast_mouse_position = Qnil; + + DEFVAR_LISP ("x-detect-server-trust", Vx_detect_server_trust, + doc: /* If non-nil, Emacs should detect whether or not it is trusted by X. + +If non-nil, Emacs will make an X request at connection startup that is +prohibited to untrusted clients under the X Security Extension and +check whether or not a resulting Access error is generated by the X +server. If the X server reports the error, Emacs will disable certain +features that do not work for untrusted clients. */); + Vx_detect_server_trust = Qnil; + + DEFVAR_LISP ("x-lax-frame-positioning", Vx_lax_frame_positioning, + doc: /* If non-nil, Emacs won't compensate for WM geometry behavior. + +Setting this to non-nil is useful when the compensation proves to be +too slow, which is usually true when the X server is located over a +network connection with high latency. Doing so will make frame +creation and placement faster at the cost of reducing the accuracy of +frame placement via frame parameters, `set-frame-position', and +`set-frame-size', along with the actual state of a frame after +`x_make_frame_invisible'. */); + Vx_lax_frame_positioning = Qnil; } diff --git a/src/xterm.h b/src/xterm.h index 8834346e7ca..28ae00ca190 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -21,6 +21,22 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #define XTERM_H #include <X11/Xlib.h> + +#ifdef HAVE_XFIXES +#include <X11/extensions/Xfixes.h> + +#if defined HAVE_XINPUT2 && XFIXES_MAJOR < 5 +/* XI2 headers need PointerBarrier, which is not defined in old + versions of the fixes library. Define that type here. */ +typedef XID PointerBarrier; +#endif +#if defined HAVE_XCOMPOSITE && XFIXES_MAJOR < 2 +/* Recent Composite headers need XserverRegion, which is not defined + in old versions of the fixes library. Define that type here. */ +typedef XID XserverRegion; +#endif +#endif + #include <X11/cursorfont.h> /* Include Xutil.h after keysym.h to work around a bug that prevents @@ -241,10 +257,17 @@ struct xi_scroll_valuator_t struct xi_touch_point_t { + /* The next touch point in this list. */ struct xi_touch_point_t *next; + /* The touchpoint detail. */ int number; + + /* The last known X and Y position of the touchpoint. */ double x, y; + + /* The frame associated with this touch point. */ + struct frame *frame; }; #endif @@ -318,6 +341,9 @@ struct x_failable_request /* If this is zero, then the request has not yet been made. Otherwise, this is the request that ends this sequence. */ unsigned long end; + + /* Any selection event serial associated with this error trap. */ + unsigned int selection_serial; }; #ifdef HAVE_XFIXES @@ -360,6 +386,10 @@ struct x_display_info /* Number of frames that are on this display. */ int reference_count; + /* True if this display connection cannot communicate with the + window manager because it is not trusted by the X server. */ + bool untrusted; + /* The Screen this connection is connected to. */ Screen *screen; @@ -406,7 +436,7 @@ struct x_display_info Unused if this display supports Xfixes extension. */ Cursor invisible_cursor; -#ifdef HAVE_XFIXES +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 /* Whether or not to use Xfixes for pointer blanking. */ bool fixes_pointer_blanking; #endif @@ -537,6 +567,12 @@ struct x_display_info KDE" protocol in x-dnd.el). */ Atom Xatom_DndProtocol, Xatom_DND_PROTOCOL; + /* Atoms to make x_intern_cached_atom fast. */ + Atom Xatom_text_plain_charset_utf_8, Xatom_LENGTH, Xatom_FILE_NAME, + Xatom_CHARACTER_POSITION, Xatom_LINE_NUMBER, Xatom_COLUMN_NUMBER, + Xatom_OWNER_OS, Xatom_HOST_NAME, Xatom_USER, Xatom_CLASS, + Xatom_NAME, Xatom_SAVE_TARGETS; + /* The frame (if any) which has the X window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in xfns.c. Note that a mere EnterNotify event can set this; if you need to know the @@ -1261,6 +1297,21 @@ struct x_output strictly an optimization to avoid extraneous synchronizing in some cases. */ int root_x, root_y; + + /* The frame visibility state. This starts out + VisibilityFullyObscured, but is set to something else in + handle_one_xevent. */ + int visibility_state; + +#ifdef HAVE_XINPUT2_2 + /* The touch ID of the last touch point to have touched the tool + bar. */ + int tool_bar_touch_id; + + /* The device that last touched the tool bar. 0 if no device + touched the tool bar. */ + int tool_bar_touch_device; +#endif }; enum @@ -1379,6 +1430,11 @@ extern void x_mark_frame_dirty (struct frame *f); /* And its corresponding visual info. */ #define FRAME_X_VISUAL_INFO(f) (&FRAME_DISPLAY_INFO (f)->visual_info) +/* Whether or not the frame is visible. Do not test this alone. + Instead, use FRAME_REDISPLAY_P. */ +#define FRAME_X_VISIBLE(f) (FRAME_X_OUTPUT (f)->visibility_state \ + != VisibilityFullyObscured) + #ifdef HAVE_XRENDER #define FRAME_X_PICTURE_FORMAT(f) FRAME_DISPLAY_INFO (f)->pict_format #define FRAME_X_PICTURE(f) ((f)->output_data.x->picture) @@ -1644,7 +1700,8 @@ extern bool x_had_errors_p (Display *); extern void x_unwind_errors_to (int); extern void x_uncatch_errors (void); extern void x_uncatch_errors_after_check (void); -extern void x_ignore_errors_for_next_request (struct x_display_info *); +extern void x_ignore_errors_for_next_request (struct x_display_info *, + unsigned int); extern void x_stop_ignoring_errors (struct x_display_info *); extern void x_clear_errors (Display *); extern void x_set_window_size (struct frame *, bool, int, int); @@ -1717,6 +1774,11 @@ extern Lisp_Object x_handle_translate_coordinates (struct frame *, Lisp_Object, extern Bool x_query_pointer (Display *, Window, Window *, Window *, int *, int *, int *, int *, unsigned int *); +extern Atom x_intern_cached_atom (struct x_display_info *, const char *, + bool); +extern void x_intern_atoms (struct x_display_info *, char **, int, Atom *); +extern char *x_get_atom_name (struct x_display_info *, Atom, bool *) + ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; #ifdef HAVE_GTK3 extern void x_scroll_bar_configure (GdkEvent *); @@ -1798,6 +1860,9 @@ extern void x_handle_property_notify (const XPropertyEvent *); extern void x_handle_selection_notify (const XSelectionEvent *); extern void x_handle_selection_event (struct selection_input_event *); extern void x_clear_frame_selections (struct frame *); +extern void x_remove_selection_transfers (struct x_display_info *); +extern void x_handle_selection_error (unsigned int, XErrorEvent *); + extern Lisp_Object x_atom_to_symbol (struct x_display_info *, Atom); extern Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object); @@ -1807,11 +1872,8 @@ extern bool x_handle_dnd_message (struct frame *, struct input_event *, bool, int, int); extern int x_check_property_data (Lisp_Object); -extern void x_fill_property_data (Display *, - Lisp_Object, - void *, - int, - int); +extern void x_fill_property_data (struct x_display_info *, Lisp_Object, + void *, int, int); extern Lisp_Object x_property_data_to_lisp (struct frame *, const unsigned char *, Atom, @@ -1824,10 +1886,10 @@ extern Lisp_Object x_timestamp_for_selection (struct x_display_info *, Lisp_Object); extern void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Time); -extern Atom x_intern_cached_atom (struct x_display_info *, const char *, - bool); -extern char *x_get_atom_name (struct x_display_info *, Atom, bool *) - ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; + +extern void mark_xselect (void); + +/* Misc definitions. */ #ifdef USE_GTK extern bool xg_set_icon (struct frame *, Lisp_Object); 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/Makefile.in b/test/Makefile.in index fd21695f5bc..f4b85e7dfe5 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -264,8 +264,8 @@ endif GMP_H = @GMP_H@ LIBGMP = @LIBGMP@ -LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ -LIB_NANOSLEEP = @LIB_NANOSLEEP@ +CLOCK_TIME_LIB = @CLOCK_TIME_LIB@ +NANOSLEEP_LIB = @NANOSLEEP_LIB@ MODULE_CFLAGS = $(and $(GMP_H),-I.) -I../src -I$(srcdir)/../src \ $(FPIC_CFLAGS) $(PROFILING_CFLAGS) \ @@ -286,7 +286,7 @@ $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h \ $(AM_V_at)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \ -o $@ $< $(LIBGMP) \ $(and $(GMP_H),$(srcdir)/../lib/mini-gmp.c) \ - $(LIB_CLOCK_GETTIME) $(LIB_NANOSLEEP) + $(CLOCK_TIME_LIB) $(NANOSLEEP_LIB) endif src/emacs-tests.log: ../lib-src/seccomp-filter.c diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index c005d872cb8..872591333e6 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -24,7 +24,7 @@ # Maintainer: Ted Zlatanov <tzz@lifelogs.com> # URL: https://emba.gnu.org/emacs/emacs -FROM debian:stretch as emacs-base +FROM debian:bullseye as emacs-base RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ @@ -34,9 +34,10 @@ RUN apt-get update && \ FROM emacs-base as emacs-inotify +# We install clangd for Eglot tests. RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ - inotify-tools \ + inotify-tools clangd \ && rm -rf /var/lib/apt/lists/* COPY . /checkout diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index ecca21df4bc..abac8dd6f0b 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -305,6 +305,22 @@ (should-not (abbrev-table-p translation-table-vector)) (should (abbrev-table-p (make-abbrev-table)))) +(ert-deftest abbrev--possibly-save-test () + "Test that `abbrev--possibly-save' properly resets +`abbrevs-changed'." + (ert-with-temp-file temp-test-file + (let ((abbrev-file-name temp-test-file) + (save-abbrevs t)) + ;; Save + (let ((abbrevs-changed t)) + (should-not (abbrev--possibly-save nil t)) + (should-not abbrevs-changed)) + ;; Don't save + (let ((abbrevs-changed t)) + (ert-simulate-keys '(?n ?\C-m) + (should (abbrev--possibly-save nil))) + (should-not abbrevs-changed))))) + (provide 'abbrev-tests) ;;; abbrev-tests.el ends here 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/elide-head-tests.el b/test/lisp/elide-head-tests.el index d751eee06a0..40a9d365f37 100644 --- a/test/lisp/elide-head-tests.el +++ b/test/lisp/elide-head-tests.el @@ -180,6 +180,90 @@ ;; along with Mentor. If not, see <https://www.gnu.org/licenses>. " "Mentor is distributed in the hope that") +;; from GnuTLS [has a line break in snail mail address] +(elide-head--add-test gpl3-6 "\ +# This file is part of GnuTLS. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 +# USA +" "This program is distributed in the hope that") + +;; from GnuTLS [has a different line break in snail mail address] +(elide-head--add-test gpl3-7 "\ +# This file is part of GnuTLS. +# +# The GnuTLS is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public License +# as published by the Free Software Foundation; either version 2.1 of +# the License, or (at your option) any later version. +# +# The GnuTLS 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 +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with GnuTLS; if not, write to the Free +# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +# MA 02110-1301, USA +" "The GnuTLS is distributed in the hope that") + +;; from GnuTLS [has a typo in the 02111-1301 part] +(elide-head--add-test gpl3-8 "\ +/* nettle, low-level cryptographics library + * + * Copyright (C) 2002 Niels Möller + * Copyright (C) 2014 Red Hat + *\s\s + * The nettle library is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or (at your + * option) any later version. + *\s + * The nettle library 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 Lesser General Public + * License for more details. + *\s + * You should have received a copy of the GNU Lesser General Public License + * along with the nettle library; see the file COPYING.LIB. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, + * MA 02111-1301, USA. + */ +" "The nettle library is distributed in the hope that") + +;; from GnuTLS-EXTRA [has a different line break in snail mail address] +(elide-head--add-test gpl3-9 "\ +# This file is part of GnuTLS-EXTRA. +# +# GnuTLS-extra 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. +# +# GnuTLS-extra 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 GnuTLS-EXTRA; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301, USA. +" "GnuTLS-extra is distributed in the hope that") + ;;; GPLv2 @@ -201,6 +285,28 @@ " "This program is distributed in the hope that") +;;; Apache License + +(elide-head--add-test apache1-1 "\ +/* + * Copyright 2011-2016 The Pkcs11Interop Project + * + * Licensed under the Apache License, Version 2.0 (the \"License\"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * https://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an \"AS IS\" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + */ +" "Unless required by applicable law") + + + ;;; Obsolete (with-suppressed-warnings ((obsolete elide-head) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 7ae10cdea73..2cd4dd75742 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -704,6 +704,68 @@ inner loops respectively." (let ((bytecomp-tests--xx 1)) (set (make-local-variable 'bytecomp-tests--xx) 2) bytecomp-tests--xx) + + ;; Check for-effect optimisation of `condition-case' body form. + ;; With `condition-case' in for-effect context: + (let ((x (bytecomp-test-identity ?A)) + (r nil)) + (condition-case e + (characterp x) ; value (:success, var) + (error (setq r 'bad)) + (:success (setq r (list 'good e)))) + r) + (let ((x (bytecomp-test-identity ?B)) + (r nil)) + (condition-case nil + (characterp x) ; for-effect (:success, no var) + (error (setq r 'bad)) + (:success (setq r 'good))) + r) + (let ((x (bytecomp-test-identity ?C)) + (r nil)) + (condition-case e + (characterp x) ; for-effect (no :success, var) + (error (setq r (list 'bad e)))) + r) + (let ((x (bytecomp-test-identity ?D)) + (r nil)) + (condition-case nil + (characterp x) ; for-effect (no :success, no var) + (error (setq r 'bad))) + r) + ;; With `condition-case' in value context: + (let ((x (bytecomp-test-identity ?E))) + (condition-case e + (characterp x) ; for-effect (:success, var) + (error (list 'bad e)) + (:success (list 'good e)))) + (let ((x (bytecomp-test-identity ?F))) + (condition-case nil + (characterp x) ; for-effect (:success, no var) + (error 'bad) + (:success 'good))) + (let ((x (bytecomp-test-identity ?G))) + (condition-case e + (characterp x) ; value (no :success, var) + (error (list 'bad e)))) + (let ((x (bytecomp-test-identity ?H))) + (condition-case nil + (characterp x) ; value (no :success, no var) + (error 'bad))) + + (condition-case nil + (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.") @@ -833,13 +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 &rest 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)) - (byte-compile ,@form) - (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ") - (should (re-search-forward ,(string-replace " " "[ \n]+" re-warning)))))) + (let ((text-quoting-style 'grave) + (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)))))))) + +(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" @@ -863,6 +940,66 @@ byte-compiled. Run with dynamic binding." (bytecomp--with-warning-test "defvar.*foo.*wider than.*characters" `(defvar foo t ,bytecomp-tests--docstring))) +(ert-deftest bytecomp-warn-quoted-condition () + (bytecomp--with-warning-test + "Warning: `condition-case' condition should not be quoted: 'arith-error" + '(condition-case nil + (abc) + ('arith-error "ugh"))) + (bytecomp--with-warning-test + "Warning: `ignore-error' condition argument should not be quoted: 'error" + '(ignore-error 'error (abc)))) + +(ert-deftest bytecomp-warn-dodgy-args-eq () + (dolist (fn '(eq eql)) + (cl-flet ((msg (type arg) + (format + "`%s' called with literal %s that may never match (arg %d)" + fn type arg))) + (bytecomp--with-warning-test (msg "list" 1) `(,fn '(a) 'x)) + (bytecomp--with-warning-test (msg "string" 2) `(,fn 'x "a")) + (bytecomp--with-warning-test (msg "vector" 2) `(,fn 'x [a])) + (bytecomp--with-warning-test (msg "function" 2) `(,fn 'x (lambda () 1))) + (bytecomp--with-warning-test (msg "function" 2) `(,fn 'x #'(lambda () 1))) + (unless (eq fn 'eql) + (bytecomp--with-warning-test (msg "integer" 2) `(,fn 'x #x10000000000)) + (bytecomp--with-warning-test (msg "float" 2) `(,fn 'x 1.0)))))) + +(ert-deftest bytecomp-warn-dodgy-args-memq () + (dolist (fn '(memq memql remq delq assq rassq)) + (cl-labels + ((msg1 (type) + (format + "`%s' called with literal %s that may never match (arg 1)" + fn type)) + (msg2 (type) + (format + "`%s' called with literal %s that may never match (element 2 of arg 2)" + fn type)) + (lst (elt) + (cond ((eq fn 'assq) `((a . 1) (,elt . 2) (c . 3))) + ((eq fn 'rassq) `((1 . a) (2 . ,elt) (3 . c))) + (t `(a ,elt c)))) + (form2 (elt) + `(,fn 'x ',(lst elt)))) + + (bytecomp--with-warning-test (msg1 "list") `(,fn '(a) '(x))) + (bytecomp--with-warning-test (msg1 "string") `(,fn "a" '(x))) + (bytecomp--with-warning-test (msg1 "vector") `(,fn [a] '(x))) + (bytecomp--with-warning-test (msg1 "function") `(,fn (lambda () 1) '(x))) + (bytecomp--with-warning-test (msg1 "function") `(,fn #'(lambda () 1) '(x))) + (unless (eq fn 'memql) + (bytecomp--with-warning-test (msg1 "integer") `(,fn #x10000000000 '(x))) + (bytecomp--with-warning-test (msg1 "float") `(,fn 1.0 '(x)))) + + (bytecomp--with-warning-test (msg2 "list") (form2 '(b))) + (bytecomp--with-warning-test (msg2 "list") (form2 ''b)) + (bytecomp--with-warning-test (msg2 "string") (form2 "b")) + (bytecomp--with-warning-test (msg2 "vector") (form2 [b])) + (unless (eq fn 'memql) + (bytecomp--with-warning-test (msg2 "integer") (form2 #x10000000000)) + (bytecomp--with-warning-test (msg2 "float") (form2 1.0)))))) + (defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse) `(ert-deftest ,(intern (format "bytecomp/%s" file)) () (with-current-buffer (get-buffer-create "*Compile-Log*") @@ -1094,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 @@ -1213,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 @@ -1314,7 +1453,56 @@ literals (Bug#20852)." (set-buffer (get-buffer-create "foo")) nil)) '((suspicious set-buffer)) - "Warning: Use .with-current-buffer. rather than")) + "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)) + )) + '((empty-body let)) + "Warning: `let' with empty body") + + (test-suppression + '(defun zot () + (let* ((_ 1)) + )) + '((empty-body let*)) + "Warning: `let\\*' with empty body") + + (test-suppression + '(defun zot (x) + (when x + )) + '((empty-body when)) + "Warning: `when' with empty body") + + (test-suppression + '(defun zot (x) + (unless x + )) + '((empty-body unless)) + "Warning: `unless' with empty body") + + (test-suppression + '(defun zot (x) + (ignore-error arith-error + )) + '((empty-body ignore-error)) + "Warning: `ignore-error' with empty body") + + (test-suppression + '(defun zot (x) + (with-suppressed-warnings ((suspicious eq)) + )) + '((empty-body with-suppressed-warnings)) + "Warning: `with-suppressed-warnings' with empty body") + ) (ert-deftest bytecomp-tests--not-writable-directory () "Test that byte compilation works if the output directory isn't @@ -1662,6 +1850,34 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (should (eq (byte-compile-file src-file) 'no-byte-compile)) (should-not (file-exists-p dest-file)))) +(ert-deftest bytecomp--copy-tree () + (should (null (bytecomp--copy-tree nil))) + (let ((print-circle t)) + (let* ((x '(1 2 (3 4))) + (y (bytecomp--copy-tree x))) + (should (equal (prin1-to-string (list x y)) + "((1 2 (3 4)) (1 2 (3 4)))"))) + (let* ((x '#1=(a #1#)) + (y (bytecomp--copy-tree x))) + (should (equal (prin1-to-string (list x y)) + "(#1=(a #1#) #2=(a #2#))"))) + (let* ((x '#1=(#1# a)) + (y (bytecomp--copy-tree x))) + (should (equal (prin1-to-string (list x y)) + "(#1=(#1# a) #2=(#2# a))"))) + (let* ((x '((a . #1=(b)) #1#)) + (y (bytecomp--copy-tree x))) + (should (equal (prin1-to-string (list x y)) + "(((a . #1=(b)) #1#) ((a . #2=(b)) #2#))"))) + (let* ((x '#1=(a #2=(#1# b . #3=(#2# c . #1#)) (#3# d))) + (y (bytecomp--copy-tree x))) + (should (equal (prin1-to-string (list x y)) + (concat + "(" + "#1=(a #2=(#1# b . #3=(#2# c . #1#)) (#3# d))" + " " + "#4=(a #5=(#4# b . #6=(#5# c . #4#)) (#6# d))" + ")")))))) ;; Local Variables: ;; no-byte-compile: t 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/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index d5886626bf1..4e1a0fd63a2 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -404,7 +404,7 @@ (ert-deftest cl-lib-nth-value-test-multiple-values () "While CL multiple values are an alias to list, these won't work." :expected-result :failed - (should (eq (cl-nth-value 0 '(2 3)) '(2 3))) + (should (equal (cl-nth-value 0 '(2 3)) '(2 3))) (should (= (cl-nth-value 0 1) 1)) (should (null (cl-nth-value 1 1))) (should-error (cl-nth-value -1 (cl-values 2 3)) :type 'args-out-of-range) @@ -431,7 +431,8 @@ (should (eq nums (cdr (cl-adjoin 3 nums)))) ;; add only when not already there (should (eq nums (cl-adjoin 2 nums))) - (should (equal '(2 1 (2)) (cl-adjoin 2 '(1 (2))))) + (with-suppressed-warnings ((suspicious memql)) + (should (equal '(2 1 (2)) (cl-adjoin 2 '(1 (2)))))) ;; default test function is eql (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums))) ;; own :test function - returns true if match diff --git a/test/lisp/emacs-lisp/multisession-tests.el b/test/lisp/emacs-lisp/multisession-tests.el index c55db6491cd..639a8ab5219 100644 --- a/test/lisp/emacs-lisp/multisession-tests.el +++ b/test/lisp/emacs-lisp/multisession-tests.el @@ -94,7 +94,7 @@ (dotimes (i 100) (cl-incf (multisession-value multisession--bar)))))))) (while (process-live-p proc) - (ignore-error 'sqlite-locked-error + (ignore-error sqlite-locked-error (message "multisession--bar %s" (multisession-value multisession--bar)) ;;(cl-incf (multisession-value multisession--bar)) ) diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el index 748d42f2120..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)))) @@ -213,8 +219,16 @@ function being an around advice." (should (equal (cl-prin1-to-string (car x)) "#f(advice first :before #f(advice car :after cdr))")))) -;; Local Variables: -;; no-byte-compile: t -;; End: +(ert-deftest advice-test-bug61179 () + (let* ((magic 42) + (ad (lambda (&rest _) + (interactive (lambda (is) + (cons magic (advice-eval-interactive-spec is)))) + nil)) + (sym (make-symbol "adtest"))) + (defalias sym (lambda (&rest args) (interactive (list 'main)) args)) + (should (equal (call-interactively sym) '(main))) + (advice-add sym :before ad) + (should (equal (call-interactively sym) '(42 main))))) ;;; nadvice-tests.el ends here diff --git a/test/lisp/emacs-lisp/shortdoc-tests.el b/test/lisp/emacs-lisp/shortdoc-tests.el index 516d095767f..d2dfbc66864 100644 --- a/test/lisp/emacs-lisp/shortdoc-tests.el +++ b/test/lisp/emacs-lisp/shortdoc-tests.el @@ -65,6 +65,31 @@ (when buf (kill-buffer buf)))))) +(ert-deftest shortdoc-function-examples-test () + "Test the extraction of usage examples of some Elisp functions." + (should (equal '((list . "(delete 2 (list 1 2 3 4))\n => (1 3 4)\n (delete \"a\" (list \"a\" \"b\" \"c\" \"d\"))\n => (\"b\" \"c\" \"d\")")) + (shortdoc-function-examples 'delete))) + (should (equal '((alist . "(assq 'foo '((foo . bar) (zot . baz)))\n => (foo . bar)") + (list . "(assq 'b '((a . 1) (b . 2)))\n => (b . 2)")) + (shortdoc-function-examples 'assq))) + (should (equal '((regexp . "(string-match-p \"^[fo]+\" \"foobar\")\n => 0")) + (shortdoc-function-examples 'string-match-p)))) + +(ert-deftest shortdoc-help-fns-examples-function-test () + "Test that `shortdoc-help-fns-examples-function' correctly prints ELisp function examples." + (with-temp-buffer + (shortdoc-help-fns-examples-function 'string-fill) + (should (equal "\n Examples:\n\n (string-fill \"Three short words\" 12)\n => \"Three short\\nwords\"\n (string-fill \"Long-word\" 3)\n => \"Long-word\"\n\n" + (buffer-substring-no-properties (point-min) (point-max)))) + (erase-buffer) + (shortdoc-help-fns-examples-function 'assq) + (should (equal "\n Examples:\n\n (assq 'foo '((foo . bar) (zot . baz)))\n => (foo . bar)\n\n (assq 'b '((a . 1) (b . 2)))\n => (b . 2)\n\n" + (buffer-substring-no-properties (point-min) (point-max)))) + (erase-buffer) + (shortdoc-help-fns-examples-function 'string-trim) + (should (equal "\n Example:\n\n (string-trim \" foo \")\n => \"foo\"\n\n" + (buffer-substring-no-properties (point-min) (point-max)))))) + (provide 'shortdoc-tests) ;;; shortdoc-tests.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el b/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el index 74d4444ccd2..9275aba2875 100644 --- a/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el +++ b/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-compat-rename-bouncer.el --- compat-rename scenarios -*- lexical-binding: t -*- +;;; erc-scenarios-base-compat-rename-bouncer.el --- Compat-rename scenarios -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -169,4 +169,4 @@ (erc-scenarios-common--base-compat-no-rename-bouncer dialogs 'auto after))))) -;;; erc-scenarios-compat-rename-bouncer.el ends here +;;; erc-scenarios-base-compat-rename-bouncer.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el index 916d105779a..1318207a3bf 100644 --- a/test/lisp/erc/erc-scenarios-base-local-modules.el +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-local-modules.el --- Local modules tests for ERC -*- lexical-binding: t -*- +;;; erc-scenarios-base-local-modules.el --- Local-module tests for ERC -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -22,14 +22,15 @@ ;; A local module doubles as a minor mode whose mode variable and ;; associated local data can withstand service disruptions. ;; Unfortunately, the current implementation is too unwieldy to be -;; made public because it doesn't perform any of the boiler plate -;; needed to save and restore buffer-local and "network-local" copies -;; of user options. Ultimately, a user-friendly framework must fill -;; this void if third-party local modules are ever to become +;; promoted publicly because it doesn't perform any of the boiler +;; plate needed to save and restore buffer-local and "network-local" +;; copies of user options. Ultimately, a user-friendly framework must +;; fill this void if third-party local modules are ever to become ;; practical. ;; ;; The following tests all use `sasl' because, as of ERC 5.5, it's the -;; only local module. +;; only connection-oriented local module. A fictitious +;; target-oriented module is defined below for testing purposes. ;;; Code: @@ -325,4 +326,4 @@ (funcall expect 10 "User modes for tester") (should (eql erc-scenarios-base-local-modules--local-var 1)))))) -;;; erc-scenarios-local-modules.el ends here +;;; erc-scenarios-base-local-modules.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-netid-samenet.el b/test/lisp/erc/erc-scenarios-base-netid-samenet.el index 7304dead44c..997dab93735 100644 --- a/test/lisp/erc/erc-scenarios-base-netid-samenet.el +++ b/test/lisp/erc/erc-scenarios-base-netid-samenet.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-base-network-id-samenet.el --- netid-id samenet scenarios -*- lexical-binding: t -*- +;;; erc-scenarios-base-netid-samenet.el --- One-network net-ID scenarios -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -148,4 +148,4 @@ :server "foonet/chester" :chan "#chan@foonet/chester"))) -;;; erc-scenarios-base-network-id-samenet.el ends here +;;; erc-scenarios-base-netid-samenet.el ends here 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-base-upstream-recon-soju.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el index 28b0db77be6..fc8be982f65 100644 --- a/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el +++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-upstream-recon-soju.el --- Upstream soju -*- lexical-binding: t -*- +;;; erc-scenarios-base-upstream-recon-soju.el --- Bouncer recon scenario -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -19,7 +19,8 @@ ;; Commentary: -;; These concern the loss and recovery of a proxy's IRC-side connection. +;; These concern the loss and recovery of a proxy's IRC-side +;; connection (hence "upstream"). ;;; Code: @@ -41,4 +42,4 @@ 'soju-foonet 'soju-barnet)) -;;; erc-scenarios-upstream-recon-soju.el ends here +;;; erc-scenarios-base-upstream-recon-soju.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el index 79e1349bd95..461dac27b21 100644 --- a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el +++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-upstream-recon-znc.el --- Upstream znc -*- lexical-binding: t -*- +;;; erc-scenarios-base-upstream-recon-znc.el --- Bouncer recon scenario -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -19,7 +19,8 @@ ;; Commentary: -;; These concern the loss and recovery of a proxy's IRC-side connection. +;; These concern the loss and recovery of a proxy's IRC-side +;; connection (hence "upstream"). ;;; Code: @@ -41,4 +42,4 @@ 'znc-foonet 'znc-barnet)) -;;; erc-scenarios-upstream-recon-znc.el ends here +;;; erc-scenarios-base-upstream-recon-znc.el ends here 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-alias-tests.el b/test/lisp/eshell/em-alias-tests.el index 273e19d580b..ec1704545a4 100644 --- a/test/lisp/eshell/em-alias-tests.el +++ b/test/lisp/eshell/em-alias-tests.el @@ -72,6 +72,15 @@ (eshell-match-command-output "show-all-args a" "a\n") (eshell-match-command-output "show-all-args a b c" "a\nb\nc\n"))) +(ert-deftest em-alias-test/alias-all-args-var-splice () + "Test alias with splicing the $* variable" + (with-temp-eshell + (eshell-insert-command "alias show-all-args 'echo args: $@*'") + (eshell-match-command-output "show-all-args" "args:\n") + (eshell-match-command-output "show-all-args a" "(\"args:\" \"a\")\n") + (eshell-match-command-output "show-all-args a b c" + "(\"args:\" \"a\" \"b\" \"c\")\n"))) + (ert-deftest em-alias-test/alias-all-args-var-indices () "Test alias with the $* variable using indices" (with-temp-eshell diff --git a/test/lisp/eshell/em-cmpl-tests.el b/test/lisp/eshell/em-cmpl-tests.el new file mode 100644 index 00000000000..ea907f1945d --- /dev/null +++ b/test/lisp/eshell/em-cmpl-tests.el @@ -0,0 +1,286 @@ +;;; em-cmpl-tests.el --- em-cmpl test suite -*- 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 Eshell's interactive completion. + +;;; Code: + +(require 'ert) +(require 'eshell) +(require 'em-cmpl) +(require 'em-dirs) +(require 'em-hist) +(require 'em-tramp) +(require 'em-unix) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +(defvar eshell-test-value nil) + +(defun eshell-insert-and-complete (input) + "Insert INPUT and invoke completion, returning the result." + (insert input) + (completion-at-point) + (eshell-get-old-input)) + +(defun eshell-arguments-equal (actual expected) + "Return t if ACTUAL and EXPECTED are equal, including properties of strings. +ACTUAL and EXPECTED should both be lists of strings." + (when (length= actual (length expected)) + (catch 'not-equal + (cl-mapc (lambda (i j) + (unless (equal-including-properties i j) + (throw 'not-equal nil))) + actual expected) + t))) + +(defun eshell-arguments-equal--equal-explainer (actual expected) + "Explain the result of `eshell-arguments-equal'." + `(nonequal-result + (actual ,actual) + (expected ,expected))) + +(put 'eshell-arguments-equal 'ert-explainer + #'eshell-arguments-equal--equal-explainer) + +;;; Tests: + +(ert-deftest em-cmpl-test/parse-arguments/pipeline () + "Test that parsing arguments for completion discards earlier commands." + (with-temp-eshell + (let ((eshell-test-value '("foo" "bar"))) + (insert "echo hi | cat") + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + '("cat")))))) + +(ert-deftest em-cmpl-test/parse-arguments/multiple-dots () + "Test parsing arguments with multiple dots like \".../\"." + (with-temp-eshell + (insert "echo .../file.txt") + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + `("echo" ,(propertize "../../file.txt" + 'pcomplete-arg-value + ".../file.txt")))))) + +(ert-deftest em-cmpl-test/parse-arguments/variable/numeric () + "Test parsing arguments with a numeric variable interpolation." + (with-temp-eshell + (let ((eshell-test-value 42)) + (insert "echo $eshell-test-value") + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + `("echo" ,(propertize "42" 'pcomplete-arg-value 42))))))) + +(ert-deftest em-cmpl-test/parse-arguments/variable/nil () + "Test parsing arguments with a nil variable interpolation." + (with-temp-eshell + (let ((eshell-test-value nil)) + (insert "echo $eshell-test-value") + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + `("echo" ,(propertize "" 'pcomplete-arg-value nil))))))) + +(ert-deftest em-cmpl-test/parse-arguments/variable/list () + "Test parsing arguments with a list variable interpolation." + (with-temp-eshell + (let ((eshell-test-value '("foo" "bar"))) + (insert "echo $eshell-test-value") + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + `("echo" ,(propertize "(\"foo\" \"bar\")" + 'pcomplete-arg-value + eshell-test-value))))))) + +(ert-deftest em-cmpl-test/parse-arguments/variable/splice () + "Test parsing arguments with a spliced variable interpolation." + (with-temp-eshell + (let ((eshell-test-value '("foo" "bar"))) + (insert "echo $@eshell-test-value") + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + '("echo" "foo" "bar")))))) + +(ert-deftest em-cmpl-test/file-completion/unique () + "Test completion of file names when there's a unique result." + (with-temp-eshell + (ert-with-temp-directory default-directory + (write-region nil nil (expand-file-name "file.txt")) + (should (equal (eshell-insert-and-complete "echo fi") + "echo file.txt "))))) + +(ert-deftest em-cmpl-test/file-completion/non-unique () + "Test completion of file names when there are multiple results." + (with-temp-eshell + (ert-with-temp-directory default-directory + (write-region nil nil (expand-file-name "file.txt")) + (write-region nil nil (expand-file-name "file.el")) + (should (equal (eshell-insert-and-complete "echo fi") + "echo file.")) + ;; Now try completing again. + (let ((minibuffer-message-timeout 0) + (inhibit-message t)) + (completion-at-point)) + ;; FIXME: We can't use `current-message' here. + (with-current-buffer (messages-buffer) + (save-excursion + (goto-char (point-max)) + (forward-line -1) + (should (looking-at "Complete, but not unique"))))))) + +(ert-deftest em-cmpl-test/file-completion/after-list () + "Test completion of file names after previous list arguments. +See bug#59956." + (with-temp-eshell + (ert-with-temp-directory default-directory + (write-region nil nil (expand-file-name "file.txt")) + (should (equal (eshell-insert-and-complete "echo (list 1 2) fi") + "echo (list 1 2) file.txt "))))) + +(ert-deftest em-cmpl-test/lisp-symbol-completion () + "Test completion of Lisp forms like \"#'symbol\" and \"`symbol\". +See <lisp/eshell/esh-cmd.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/lisp-function-completion () + "Test completion of Lisp forms like \"(func)\". +See <lisp/eshell/esh-cmd.el>." + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo (eshell/ech") + "echo (eshell/echo")))) + +(ert-deftest em-cmpl-test/special-ref-completion/type () + "Test completion of the start of special references like \"#<buffer\". +See <lisp/eshell/esh-arg.el>." + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo hi > #<buf") + "echo hi > #<buffer "))) + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo hi > #<proc") + "echo hi > #<process ")))) + +(ert-deftest em-cmpl-test/special-ref-completion/implicit-buffer () + "Test completion of special references like \"#<buf>\". +See <lisp/eshell/esh-arg.el>." + (let (bufname) + (with-temp-buffer + (setq bufname (rename-buffer "my-buffer" t)) + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo hi > #<my-buf") + (format "echo hi > #<%s> " bufname)))) + (setq bufname (rename-buffer "another buffer" t)) + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo hi > #<anoth") + (format "echo hi > #<%s> " + (string-replace " " "\\ " bufname)))))))) + +(ert-deftest em-cmpl-test/special-ref-completion/buffer () + "Test completion of special references like \"#<buffer buf>\". +See <lisp/eshell/esh-arg.el>." + (let (bufname) + (with-temp-buffer + (setq bufname (rename-buffer "my-buffer" t)) + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo hi > #<buffer my-buf") + (format "echo hi > #<buffer %s> " bufname)))) + (setq bufname (rename-buffer "another buffer" t)) + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo hi > #<buffer anoth") + (format "echo hi > #<buffer %s> " + (string-replace " " "\\ " bufname)))))))) + +(ert-deftest em-cmpl-test/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 ")))) + +(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>." + (with-temp-eshell + (ert-with-temp-directory default-directory + (write-region nil nil (expand-file-name "file.txt")) + (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 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")))))) + (should (equal (eshell-insert-and-complete "echo ~us") + "echo ~user/")))) + ;; Clear the cached user names we set above. + (setq eshell-user-names nil))) + +;;; em-cmpl-tests.el ends here diff --git a/test/lisp/eshell/em-extpipe-tests.el b/test/lisp/eshell/em-extpipe-tests.el index 6d6d4daac9d..1184b5df5f8 100644 --- a/test/lisp/eshell/em-extpipe-tests.el +++ b/test/lisp/eshell/em-extpipe-tests.el @@ -42,7 +42,7 @@ (shell-command-switch "-c")) ;; Strip `eshell-trap-errors'. (should (equal ,expected - (cadr (eshell-parse-command input)))))) + (cadadr (eshell-parse-command input)))))) (with-substitute-for-temp (&rest body) ;; Substitute name of an actual temporary file and/or ;; buffer into `input'. The substitution logic is diff --git a/test/lisp/eshell/em-prompt-tests.el b/test/lisp/eshell/em-prompt-tests.el new file mode 100644 index 00000000000..257549e40fb --- /dev/null +++ b/test/lisp/eshell/em-prompt-tests.el @@ -0,0 +1,120 @@ +;;; em-prompt-tests.el --- em-prompt test suite -*- 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 Eshell's prompt support. + +;;; Code: + +(require 'ert) +(require 'eshell) +(require 'em-prompt) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +;;; Tests: + +(ert-deftest em-prompt-test/field-properties () + "Check that field properties are properly set on Eshell output/prompts." + (with-temp-eshell + (eshell-insert-command "echo hello") + (let ((last-prompt (field-string (1- eshell-last-input-start))) + (last-input (field-string (1+ eshell-last-input-start))) + (last-output (field-string (1+ eshell-last-input-end)))) + (should (equal-including-properties + last-prompt + (propertize + (format "%s %s " (directory-file-name default-directory) + (if (= (file-user-uid) 0) "#" "$")) + 'read-only t + 'field 'prompt + 'font-lock-face 'eshell-prompt + 'front-sticky '(read-only field font-lock-face) + 'rear-nonsticky '(read-only field font-lock-face)))) + (should (equal last-input "echo hello\n")) + (should (equal-including-properties + last-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. +This tests the case when `eshell-highlight-prompt' is nil." + (let ((eshell-highlight-prompt nil)) + (with-temp-eshell + (eshell-insert-command "echo hello") + (let ((last-prompt (field-string (1- eshell-last-input-start))) + (last-input (field-string (1+ eshell-last-input-start))) + (last-output (field-string (1+ eshell-last-input-end)))) + (should (equal-including-properties + last-prompt + (propertize + (format "%s %s " (directory-file-name default-directory) + (if (= (file-user-uid) 0) "#" "$")) + 'field 'prompt + 'front-sticky '(field) + 'rear-nonsticky '(field)))) + (should (equal last-input "echo hello\n")) + (should (equal-including-properties + last-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." + (with-temp-eshell + (eshell-insert-command "echo one") + (eshell-insert-command "echo two") + (eshell-insert-command "echo three") + (insert "echo fou") ; A partially-entered command. + ;; Go back one prompt. + (eshell-previous-prompt 1) + (should (equal (eshell-get-old-input) "echo three")) + ;; Go back two prompts, starting from the end of this line. + (end-of-line) + (eshell-previous-prompt 2) + (should (equal (eshell-get-old-input) "echo one")) + ;; Go forward three prompts. + (eshell-next-prompt 3) + (should (equal (eshell-get-old-input) "echo fou")))) + +(ert-deftest em-prompt-test/forward-backward-matching-input () + "Check that navigating forward/backward via regexps works correctly." + (with-temp-eshell + (eshell-insert-command "echo one") + (eshell-insert-command "printnl something else") + (eshell-insert-command "echo two") + (eshell-insert-command "echo three") + (insert "echo fou") ; A partially-entered command. + ;; Go back one prompt. + (eshell-backward-matching-input "echo" 1) + (should (equal (eshell-get-old-input) "echo three")) + ;; Go back two prompts, starting from the end of this line. + (end-of-line) + (eshell-backward-matching-input "echo" 2) + (should (equal (eshell-get-old-input) "echo one")) + ;; Go forward three prompts. + (eshell-forward-matching-input "echo" 3) + (should (equal (eshell-get-old-input) "echo fou")))) + +;;; em-prompt-tests.el ends here diff --git a/test/lisp/eshell/em-script-tests.el b/test/lisp/eshell/em-script-tests.el index 4e557fada73..74328844778 100644 --- a/test/lisp/eshell/em-script-tests.el +++ b/test/lisp/eshell/em-script-tests.el @@ -35,21 +35,43 @@ ;;; Tests: (ert-deftest em-script-test/source-script () - "Test sourcing script with no argumentss" + "Test sourcing a simple script." (ert-with-temp-file temp-file :text "echo hi" (with-temp-eshell (eshell-match-command-output (format "source %s" temp-file) "hi\n")))) -(ert-deftest em-script-test/source-script-arg-vars () - "Test sourcing script with $0, $1, ... variables" +(ert-deftest em-script-test/source-script/redirect () + "Test sourcing a script and redirecting its output." + (ert-with-temp-file temp-file + :text "echo hi\necho bye" + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "source %s > #<%s>" temp-file bufname) + "\\`\\'")) + (should (equal (buffer-string) "hibye"))))) + +(ert-deftest em-script-test/source-script/redirect/dev-null () + "Test sourcing a script and redirecting its output, including to /dev/null." + (ert-with-temp-file temp-file + :text "echo hi\necho bad > /dev/null\necho bye" + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "source %s > #<%s>" temp-file bufname) + "\\`\\'")) + (should (equal (buffer-string) "hibye"))))) + +(ert-deftest em-script-test/source-script/arg-vars () + "Test sourcing script with $0, $1, ... variables." (ert-with-temp-file temp-file :text "printnl $0 \"$1 $2\"" (with-temp-eshell (eshell-match-command-output (format "source %s one two" temp-file) (format "%s\none two\n" temp-file))))) -(ert-deftest em-script-test/source-script-all-args-var () - "Test sourcing script with the $* variable" +(ert-deftest em-script-test/source-script/all-args-var () + "Test sourcing script with the $* variable." (ert-with-temp-file temp-file :text "printnl $*" (with-temp-eshell (eshell-match-command-output (format "source %s" temp-file) diff --git a/test/lisp/eshell/em-tramp-tests.el b/test/lisp/eshell/em-tramp-tests.el index 1d4ad9dc632..a3bda970b63 100644 --- a/test/lisp/eshell/em-tramp-tests.el +++ b/test/lisp/eshell/em-tramp-tests.el @@ -23,37 +23,41 @@ (require 'em-tramp) (require 'tramp) +(defmacro em-tramp-test/should-replace-command (form replacement) + "Check that calling FORM results in it being replaced with REPLACEMENT." + (declare (indent 1)) + `(should (equal + (catch 'eshell-replace-command ,form) + (list 'eshell-with-copied-handles + (list 'eshell-trap-errors + ,replacement) + t)))) + (ert-deftest em-tramp-test/su-default () "Test Eshell `su' command with no arguments." - (should (equal - (catch 'eshell-replace-command (eshell/su)) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/su:root@%s:%s" - tramp-default-host default-directory))))))) + (em-tramp-test/should-replace-command (eshell/su) + `(eshell-named-command + "cd" + (list ,(format "/su:root@%s:%s" + tramp-default-host default-directory))))) (ert-deftest em-tramp-test/su-user () "Test Eshell `su' command with USER argument." - (should (equal - (catch 'eshell-replace-command (eshell/su "USER")) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/su:USER@%s:%s" - tramp-default-host default-directory))))))) + (em-tramp-test/should-replace-command (eshell/su "USER") + `(eshell-named-command + "cd" + (list ,(format "/su:USER@%s:%s" + tramp-default-host default-directory))))) (ert-deftest em-tramp-test/su-login () "Test Eshell `su' command with -/-l/--login option." (dolist (args '(("--login") ("-l") ("-"))) - (should (equal - (catch 'eshell-replace-command (apply #'eshell/su args)) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/su:root@%s:~/" tramp-default-host)))))))) + (em-tramp-test/should-replace-command (apply #'eshell/su args) + `(eshell-named-command + "cd" + (list ,(format "/su:root@%s:~/" tramp-default-host)))))) (defun mock-eshell-named-command (&rest args) "Dummy function to test Eshell `sudo' command rewriting." @@ -89,23 +93,19 @@ "Test Eshell `sudo' command with -s/--shell option." (dolist (args '(("--shell") ("-s"))) - (should (equal - (catch 'eshell-replace-command (apply #'eshell/sudo args)) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/sudo:root@%s:%s" - tramp-default-host default-directory)))))))) + (em-tramp-test/should-replace-command (apply #'eshell/sudo args) + `(eshell-named-command + "cd" + (list ,(format "/sudo:root@%s:%s" + tramp-default-host default-directory)))))) (ert-deftest em-tramp-test/sudo-user-shell () "Test Eshell `sudo' command with -s and -u options." - (should (equal - (catch 'eshell-replace-command (eshell/sudo "-u" "USER" "-s")) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/sudo:USER@%s:%s" - tramp-default-host default-directory))))))) + (em-tramp-test/should-replace-command (eshell/sudo "-u" "USER" "-s") + `(eshell-named-command + "cd" + (list ,(format "/sudo:USER@%s:%s" + tramp-default-host default-directory))))) (ert-deftest em-tramp-test/doas-basic () "Test Eshell `doas' command with default user." @@ -142,22 +142,18 @@ "Test Eshell `doas' command with -s/--shell option." (dolist (args '(("--shell") ("-s"))) - (should (equal - (catch 'eshell-replace-command (apply #'eshell/doas args)) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/doas:root@%s:%s" - tramp-default-host default-directory)))))))) + (em-tramp-test/should-replace-command (apply #'eshell/doas args) + `(eshell-named-command + "cd" + (list ,(format "/doas:root@%s:%s" + tramp-default-host default-directory)))))) (ert-deftest em-tramp-test/doas-user-shell () "Test Eshell `doas' command with -s and -u options." - (should (equal - (catch 'eshell-replace-command (eshell/doas "-u" "USER" "-s")) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/doas:USER@%s:%s" - tramp-default-host default-directory))))))) + (em-tramp-test/should-replace-command (eshell/doas "-u" "USER" "-s") + `(eshell-named-command + "cd" + (list ,(format "/doas:USER@%s:%s" + tramp-default-host default-directory))))) ;;; em-tramp-tests.el ends here diff --git a/test/lisp/eshell/esh-arg-tests.el b/test/lisp/eshell/esh-arg-tests.el index 918ad3a949f..c883db3907f 100644 --- a/test/lisp/eshell/esh-arg-tests.el +++ b/test/lisp/eshell/esh-arg-tests.el @@ -102,4 +102,34 @@ treated literally, as a backslash and a newline." (eshell-match-command-output "echo \"hi\\\nthere\"" "hithere\n"))) +(ert-deftest esh-arg-test/special-reference/default () + "Test that \"#<buf>\" refers to the buffer \"buf\"." + (with-temp-buffer + (rename-buffer "my-buffer" t) + (eshell-command-result-equal + (format "echo #<%s>" (buffer-name)) + (current-buffer)))) + +(ert-deftest esh-arg-test/special-reference/buffer () + "Test that \"#<buffer buf>\" refers to the buffer \"buf\"." + (with-temp-buffer + (rename-buffer "my-buffer" t) + (eshell-command-result-equal + (format "echo #<buffer %s>" (buffer-name)) + (current-buffer)))) + +(ert-deftest esh-arg-test/special-reference/special () + "Test that \"#<...>\" works correctly when escaping special characters." + (with-temp-buffer + (rename-buffer "<my buffer>" t) + (let ((escaped-bufname (replace-regexp-in-string + (rx (group (or "\\" "<" ">" space))) "\\\\\\1" + (buffer-name)))) + (eshell-command-result-equal + (format "echo #<%s>" escaped-bufname) + (current-buffer)) + (eshell-command-result-equal + (format "echo #<buffer %s>" escaped-bufname) + (current-buffer))))) + ;; esh-arg-tests.el ends here diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index 912822eeddb..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 @@ -148,14 +165,21 @@ e.g. \"{(+ 1 2)} 3\" => 3" "echo $name; for name in 3 { echo $name }; echo $name" "env-value\n3\nenv-value\n")))) +(ert-deftest esh-cmd-test/for-loop-pipe () + "Test invocation of a for loop piped to another command." + (skip-unless (executable-find "rev")) + (with-temp-eshell + (eshell-match-command-output "for i in foo bar baz { echo $i } | rev" + "zabraboof"))) + (ert-deftest esh-cmd-test/while-loop () "Test invocation of a while loop." (with-temp-eshell (let ((eshell-test-value '(0 1 2))) (eshell-match-command-output (concat "while $eshell-test-value " - "{ setq eshell-test-value (cdr eshell-test-value) }") - "(1 2)\n(2)\n")))) + "{ (pop eshell-test-value) }") + "0\n1\n2\n")))) (ert-deftest esh-cmd-test/while-loop-lisp-form () "Test invocation of a while loop using a Lisp form." @@ -176,6 +200,17 @@ e.g. \"{(+ 1 2)} 3\" => 3" "{ setq eshell-test-value (1+ eshell-test-value) }") "1\n2\n3\n")))) +(ert-deftest esh-cmd-test/while-loop-pipe () + "Test invocation of a while loop piped to another command." + (skip-unless (executable-find "rev")) + (with-temp-eshell + (let ((eshell-test-value '("foo" "bar" "baz"))) + (eshell-match-command-output + (concat "while $eshell-test-value " + "{ (pop eshell-test-value) }" + " | rev") + "zabraboof")))) + (ert-deftest esh-cmd-test/until-loop () "Test invocation of an until loop." (with-temp-eshell @@ -253,6 +288,30 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." (eshell-command-result-equal "if {[ foo = bar ]} {echo yes} {echo no}" "no")) +(ert-deftest esh-cmd-test/if-statement-pipe () + "Test invocation of an if statement piped to another command." + (skip-unless (executable-find "rev")) + (with-temp-eshell + (let ((eshell-test-value t)) + (eshell-match-command-output "if $eshell-test-value {echo yes} | rev" + "\\`sey\n?")) + (let ((eshell-test-value nil)) + (eshell-match-command-output "if $eshell-test-value {echo yes} | rev" + "\\`\n?")))) + +(ert-deftest esh-cmd-test/if-else-statement-pipe () + "Test invocation of an if/else statement piped to another command." + (skip-unless (executable-find "rev")) + (with-temp-eshell + (let ((eshell-test-value t)) + (eshell-match-command-output + "if $eshell-test-value {echo yes} {echo no} | rev" + "\\`sey\n?")) + (let ((eshell-test-value nil)) + (eshell-match-command-output + "if $eshell-test-value {echo yes} {echo no} | rev" + "\\`on\n?")))) + (ert-deftest esh-cmd-test/unless-statement () "Test invocation of an unless statement." (let ((eshell-test-value t)) diff --git a/test/lisp/eshell/esh-io-tests.el b/test/lisp/eshell/esh-io-tests.el index b38d6090f13..ed350a9691c 100644 --- a/test/lisp/eshell/esh-io-tests.el +++ b/test/lisp/eshell/esh-io-tests.el @@ -146,6 +146,45 @@ (should (equal (buffer-string) "new")) (should (equal eshell-test-value "new"))))) +(ert-deftest esh-io-test/redirect-subcommands () + "Check that redirecting subcommands applies to all subcommands." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command (format "{echo foo; echo bar} > #<%s>" bufname))) + (should (equal (buffer-string) "foobar")))) + +(ert-deftest esh-io-test/redirect-subcommands/override () + "Check that redirecting subcommands applies to all subcommands. +Include a redirect to another location in the subcommand to +ensure only its statement is redirected." + (eshell-with-temp-buffer bufname "old" + (eshell-with-temp-buffer bufname-2 "also old" + (with-temp-eshell + (eshell-insert-command + (format "{echo foo; echo bar > #<%s>; echo baz} > #<%s>" + bufname-2 bufname))) + (should (equal (buffer-string) "bar"))) + (should (equal (buffer-string) "foobaz")))) + +(ert-deftest esh-io-test/redirect-subcommands/dev-null () + "Check that redirecting subcommands applies to all subcommands. +Include a redirect to /dev/null to ensure it only applies to its +statement." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command + (format "{echo foo; echo bar > /dev/null; echo baz} > #<%s>" + bufname))) + (should (equal (buffer-string) "foobaz")))) + +(ert-deftest esh-io-test/redirect-subcommands/interpolated () + "Check that redirecting interpolated subcommands applies to all subcommands." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command + (format "echo ${echo foo; echo bar} > #<%s>" bufname))) + (should (equal (buffer-string) "foobar")))) + ;; Redirecting specific handles @@ -262,24 +301,56 @@ stdout originally pointed (the terminal)." "stderr\n")) (should (equal (buffer-string) "stdout\n")))) -(ert-deftest esh-io-test/redirect-pipe () - "Check that \"redirecting\" to a pipe works." - ;; `|' should only redirect stdout. + +;; Pipelines + +(ert-deftest esh-io-test/pipeline/default () + "Check that `|' only pipes stdout." + (skip-unless (executable-find "rev")) (eshell-command-result-equal "test-output | rev" - "stderr\ntuodts\n") - ;; `|&' should redirect stdout and stderr. + "stderr\ntuodts\n")) + + +(ert-deftest esh-io-test/pipeline/all () + "Check that `|&' only pipes stdout and stderr." + (skip-unless (executable-find "rev")) (eshell-command-result-equal "test-output |& rev" "tuodts\nrredts\n")) +(ert-deftest esh-io-test/pipeline/subcommands () + "Chek that all commands in a subcommand are properly piped." + (skip-unless (executable-find "rev")) + (with-temp-eshell + (eshell-match-command-output "{echo foo; echo bar} | rev" + "\\`raboof\n?"))) + ;; Virtual targets -(ert-deftest esh-io-test/virtual-dev-eshell () +(ert-deftest esh-io-test/virtual/dev-null () + "Check that redirecting to /dev/null works." + (with-temp-eshell + (eshell-match-command-output "echo hi > /dev/null" "\\`\\'"))) + +(ert-deftest esh-io-test/virtual/dev-null/multiple () + "Check that redirecting to /dev/null works alongside other redirections." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "echo new > /dev/null > #<%s>" bufname) "\\`\\'")) + (should (equal (buffer-string) "new"))) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "echo new > #<%s> > /dev/null" bufname) "\\`\\'")) + (should (equal (buffer-string) "new")))) + +(ert-deftest esh-io-test/virtual/dev-eshell () "Check that redirecting to /dev/eshell works." (with-temp-eshell (eshell-match-command-output "echo hi > /dev/eshell" "hi"))) -(ert-deftest esh-io-test/virtual-dev-kill () +(ert-deftest esh-io-test/virtual/dev-kill () "Check that redirecting to /dev/kill works." (with-temp-eshell (eshell-insert-command "echo one > /dev/kill") diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index ae7b1dddd69..8e02fbb5497 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -19,6 +19,7 @@ ;;; Code: +(require 'tramp) (require 'ert) (require 'esh-mode) (require 'eshell) @@ -85,6 +86,18 @@ "\\`\\'")) (should (equal (buffer-string) "stdout\nstderr\n")))) +(ert-deftest esh-var-test/output/remote-redirect () + "Check that redirecting stdout for a remote process works." + (skip-unless (and (eshell-tests-remote-accessible-p) + (executable-find "echo"))) + (let ((default-directory ert-remote-temporary-file-directory)) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "*echo hello > #<%s>" bufname) + "\\`\\'")) + (should (equal (buffer-string) "hello\n"))))) + ;; Exit status diff --git a/test/lisp/eshell/esh-util-tests.el b/test/lisp/eshell/esh-util-tests.el index afaf1b77f2b..ed841e96c7e 100644 --- a/test/lisp/eshell/esh-util-tests.el +++ b/test/lisp/eshell/esh-util-tests.el @@ -54,4 +54,69 @@ "Test that `eshell-stringify' correctly stringifies complex objects." (should (equal (eshell-stringify (list 'quote 'hello)) "'hello"))) +(ert-deftest esh-util-test/eshell-convert-to-number/integer () + "Test that `eshell-convert-to-number' correctly converts integers." + (should (equal (eshell-convert-to-number "123") 123)) + (should (equal (eshell-convert-to-number "-123") -123)) + ;; These are technially integers, since Emacs Lisp requires at least + ;; one digit after the "." to be a float: + (should (equal (eshell-convert-to-number "123.") 123)) + (should (equal (eshell-convert-to-number "-123.") -123))) + +(ert-deftest esh-util-test/eshell-convert-to-number/floating-point () + "Test that `eshell-convert-to-number' correctly converts floats." + (should (equal (eshell-convert-to-number "1.23") 1.23)) + (should (equal (eshell-convert-to-number "-1.23") -1.23)) + (should (equal (eshell-convert-to-number ".1") 0.1)) + (should (equal (eshell-convert-to-number "-.1") -0.1))) + +(ert-deftest esh-util-test/eshell-convert-to-number/floating-point-exponent () + "Test that `eshell-convert-to-number' correctly converts exponent notation." + ;; Positive exponent: + (dolist (exp '("e2" "e+2" "E2" "E+2")) + (should (equal (eshell-convert-to-number (concat "123" exp)) 12300.0)) + (should (equal (eshell-convert-to-number (concat "-123" exp)) -12300.0)) + (should (equal (eshell-convert-to-number (concat "1.23" exp)) 123.0)) + (should (equal (eshell-convert-to-number (concat "-1.23" exp)) -123.0)) + (should (equal (eshell-convert-to-number (concat "1." exp)) 100.0)) + (should (equal (eshell-convert-to-number (concat "-1." exp)) -100.0)) + (should (equal (eshell-convert-to-number (concat ".1" exp)) 10.0)) + (should (equal (eshell-convert-to-number (concat "-.1" exp)) -10.0))) + ;; Negative exponent: + (dolist (exp '("e-2" "E-2")) + (should (equal (eshell-convert-to-number (concat "123" exp)) 1.23)) + (should (equal (eshell-convert-to-number (concat "-123" exp)) -1.23)) + (should (equal (eshell-convert-to-number (concat "1.23" exp)) 0.0123)) + (should (equal (eshell-convert-to-number (concat "-1.23" exp)) -0.0123)) + (should (equal (eshell-convert-to-number (concat "1." exp)) 0.01)) + (should (equal (eshell-convert-to-number (concat "-1." exp)) -0.01)) + (should (equal (eshell-convert-to-number (concat ".1" exp)) 0.001)) + (should (equal (eshell-convert-to-number (concat "-.1" exp)) -0.001)))) + +(ert-deftest esh-util-test/eshell-convert-to-number/floating-point/infinite () + "Test that `eshell-convert-to-number' correctly converts infinite floats." + (should (equal (eshell-convert-to-number "1.0e+INF") 1.0e+INF)) + (should (equal (eshell-convert-to-number "2.e+INF") 1.0e+INF)) + (should (equal (eshell-convert-to-number "-1.0e+INF") -1.0e+INF)) + (should (equal (eshell-convert-to-number "-2.e+INF") -1.0e+INF))) + +(ert-deftest esh-util-test/eshell-convert-to-number/floating-point/nan () + "Test that `eshell-convert-to-number' correctly converts NaNs." + (should (equal (eshell-convert-to-number "1.0e+NaN") 1.0e+NaN)) + (should (equal (eshell-convert-to-number "2.e+NaN") 2.0e+NaN)) + (should (equal (eshell-convert-to-number "-1.0e+NaN") -1.0e+NaN)) + (should (equal (eshell-convert-to-number "-2.e+NaN") -2.0e+NaN))) + +(ert-deftest esh-util-test/eshell-convert-to-number/non-numeric () + "Test that `eshell-convert-to-number' does nothing to non-numeric values." + (should (equal (eshell-convert-to-number "foo") "foo")) + (should (equal (eshell-convert-to-number "") "")) + (should (equal (eshell-convert-to-number "123foo") "123foo"))) + +(ert-deftest esh-util-test/eshell-convert-to-number/no-convert () + "Test that `eshell-convert-to-number' does nothing when disabled." + (let ((eshell-convert-numeric-arguments nil)) + (should (equal (eshell-convert-to-number "123") "123")) + (should (equal (eshell-convert-to-number "1.23") "1.23")))) + ;;; esh-util-tests.el ends here diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 7ec1731f94e..6767d9289f9 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -60,41 +60,101 @@ (eshell-command-result-equal "echo $\"user-login-name\"-foo" (concat user-login-name "-foo"))) -(ert-deftest esh-var-test/interp-var-indices () - "Interpolate list variable with indices" - (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) +(ert-deftest esh-var-test/interp-list-var () + "Interpolate list variable" + (let ((eshell-test-value '(1 2 3))) + (eshell-command-result-equal "echo $eshell-test-value" + '(1 2 3)))) + +(ert-deftest esh-var-test/interp-list-var-concat () + "Interpolate and concat list variable" + (let ((eshell-test-value '(1 2 3))) + (eshell-command-result-equal "echo a$'eshell-test-value'z" + '("a1" 2 "3z")))) + +(defun esh-var-test/interp-var-indices (function &optional range-function) + "Test interpolation of an indexable value with indices. +FUNCTION is a function that takes a list of elements and returns +the object to test. + +RANGE-FUNCTION is a function that takes a list of elements and +returns the expected result of an index range for the object; if +nil, use FUNCTION instead." + (let ((eshell-test-value + (funcall function '("zero" "one" "two" "three" "four"))) + (range-function (or range-function function))) + ;; Positive indices (eshell-command-result-equal "echo $eshell-test-value[0]" "zero") (eshell-command-result-equal "echo $eshell-test-value[0 2]" '("zero" "two")) (eshell-command-result-equal "echo $eshell-test-value[0 2 4]" - '("zero" "two" "four")))) + '("zero" "two" "four")) + ;; Negative indices + (eshell-command-result-equal "echo $eshell-test-value[-1]" + "four") + (eshell-command-result-equal "echo $eshell-test-value[-1 -3]" + '("four" "two")) + ;; Index ranges + (eshell-command-result-equal + "echo $eshell-test-value[1..4]" + (funcall range-function '("one" "two" "three"))) + (eshell-command-result-equal + "echo $eshell-test-value[..2]" + (funcall range-function '("zero" "one"))) + (eshell-command-result-equal + "echo $eshell-test-value[-2..]" + (funcall range-function '("three" "four"))) + (eshell-command-result-equal + "echo $eshell-test-value[..]" + (funcall range-function '("zero" "one" "two" "three" "four"))) + (eshell-command-result-equal + "echo $eshell-test-value[1..4 -2..]" + (list (funcall range-function '("one" "two" "three")) + (funcall range-function '("three" "four")))))) -(ert-deftest esh-var-test/interp-var-split-indices () - "Interpolate string variable with indices" - (let ((eshell-test-value "zero one two three four")) - (eshell-command-result-equal "echo $eshell-test-value[0]" - "zero") - (eshell-command-result-equal "echo $eshell-test-value[0 2]" - '("zero" "two")) - (eshell-command-result-equal "echo $eshell-test-value[0 2 4]" - '("zero" "two" "four")))) +(ert-deftest esh-var-test/interp-var-indices/list () + "Interpolate list variable with indices." + (esh-var-test/interp-var-indices #'identity)) + +(ert-deftest esh-var-test/interp-var-indices/vector () + "Interpolate vector variable with indices." + (esh-var-test/interp-var-indices #'vconcat)) + +(ert-deftest esh-var-test/interp-var-indices/ring () + "Interpolate ring variable with indices." + (esh-var-test/interp-var-indices #'ring-convert-sequence-to-ring)) + +(ert-deftest esh-var-test/interp-var-indices/split () + "Interpolate string variable with indices." + (esh-var-test/interp-var-indices + (lambda (values) (string-join values " ")) + #'identity)) (ert-deftest esh-var-test/interp-var-string-split-indices () - "Interpolate string variable with string splitter and indices" + "Interpolate string variable with string splitter and indices." + ;; Test using punctuation as a delimiter. (let ((eshell-test-value "zero:one:two:three:four")) (eshell-command-result-equal "echo $eshell-test-value[: 0]" "zero") (eshell-command-result-equal "echo $eshell-test-value[: 0 2]" '("zero" "two"))) + ;; Test using a letter as a delimiter. (let ((eshell-test-value "zeroXoneXtwoXthreeXfour")) (eshell-command-result-equal "echo $eshell-test-value[X 0]" "zero") (eshell-command-result-equal "echo $eshell-test-value[X 0 2]" + '("zero" "two"))) + ;; Test using a number as a delimiter. + (let ((eshell-test-value "zero0one0two0three0four")) + (eshell-command-result-equal "echo $eshell-test-value[\"0\" 0]" + "zero") + (eshell-command-result-equal "echo $eshell-test-value[\"0\" 0 2]" '("zero" "two")))) (ert-deftest esh-var-test/interp-var-regexp-split-indices () - "Interpolate string variable with regexp splitter and indices" + "Interpolate string variable with regexp splitter and indices." + ;; Test using a regexp as a delimiter. (let ((eshell-test-value "zero:one!two:three!four")) (eshell-command-result-equal "echo $eshell-test-value['[:!]' 0]" "zero") @@ -103,18 +163,37 @@ (eshell-command-result-equal "echo $eshell-test-value[\"[:!]\" 0]" "zero") (eshell-command-result-equal "echo $eshell-test-value[\"[:!]\" 0 2]" + '("zero" "two"))) + ;; Test using a regexp that looks like range syntax as a delimiter. + (let ((eshell-test-value "zero0..0one0..0two0..0three0..0four")) + (eshell-command-result-equal "echo $eshell-test-value[\"0..0\" 0]" + "zero") + (eshell-command-result-equal "echo $eshell-test-value[\"0..0\" 0 2]" '("zero" "two")))) (ert-deftest esh-var-test/interp-var-assoc () - "Interpolate alist variable with index" - (let ((eshell-test-value '(("foo" . 1) (bar . 2)))) + "Interpolate alist variable with index." + (let ((eshell-test-value '(("foo" . 1) (bar . 2) ("3" . "three")))) (eshell-command-result-equal "echo $eshell-test-value[foo]" 1) (eshell-command-result-equal "echo $eshell-test-value[#'bar]" - 2))) + 2) + (eshell-command-result-equal "echo $eshell-test-value[\"3\"]" + "three"))) + +(ert-deftest esh-var-test/interp-var-indices-subcommand () + "Interpolate list variable with subcommand expansion for indices." + (skip-unless (executable-find "echo")) + (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) + (eshell-command-result-equal + "echo $eshell-test-value[${*echo 0}]" + "zero") + (eshell-command-result-equal + "echo $eshell-test-value[${*echo 0} ${*echo 2}]" + '("zero" "two")))) (ert-deftest esh-var-test/interp-var-length-list () - "Interpolate length of list variable" + "Interpolate length of list variable." (let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9))))) (eshell-command-result-equal "echo $#eshell-test-value" 3) (eshell-command-result-equal "echo $#eshell-test-value[1]" 1) @@ -126,55 +205,75 @@ (eshell-command-result-equal "echo $#eshell-test-value" 6))) (ert-deftest esh-var-test/interp-var-length-alist () - "Interpolate length of alist variable" + "Interpolate length of alist variable." (let ((eshell-test-value '(("foo" . (1 2 3))))) (eshell-command-result-equal "echo $#eshell-test-value" 1) (eshell-command-result-equal "echo $#eshell-test-value[foo]" 3))) +(ert-deftest esh-var-test/interp-var-splice () + "Splice-interpolate list variable." + (let ((eshell-test-value '(1 2 3))) + (eshell-command-result-equal "echo a $@eshell-test-value z" + '("a" 1 2 3 "z")))) + +(ert-deftest esh-var-test/interp-var-splice-concat () + "Splice-interpolate and concat list variable." + (let ((eshell-test-value '(1 2 3))) + (eshell-command-result-equal "echo it is a$@'eshell-test-value'z" + '("it" "is" "a1" 2 "3z")) + ;; This is a tricky case. We're concatenating a spliced list and + ;; a non-spliced list. The general rule is that splicing should + ;; work as though the user typed "$X[0] $X[1] ... $X[N]". That + ;; means that the last value of our splice should get concatenated + ;; into the first value of the non-spliced list. + (eshell-command-result-equal + "echo it is $@'eshell-test-value'$eshell-test-value" + '("it" "is" 1 2 (31 2 3))))) + (ert-deftest esh-var-test/interp-lisp () - "Interpolate Lisp form evaluation" + "Interpolate Lisp form evaluation." (eshell-command-result-equal "+ $(+ 1 2) 3" 6)) (ert-deftest esh-var-test/interp-lisp-indices () - "Interpolate Lisp form evaluation with index" + "Interpolate Lisp form evaluation with index." (eshell-command-result-equal "+ $(list 1 2)[1] 3" 5)) (ert-deftest esh-var-test/interp-cmd () - "Interpolate command result" + "Interpolate command result." (eshell-command-result-equal "+ ${+ 1 2} 3" 6)) (ert-deftest esh-var-test/interp-cmd-indices () - "Interpolate command result with index" + "Interpolate command result with index." (eshell-command-result-equal "+ ${listify 1 2}[1] 3" 5)) (ert-deftest esh-var-test/interp-cmd-external () - "Interpolate command result from external command" + "Interpolate command result from external command." (skip-unless (executable-find "echo")) (with-temp-eshell (eshell-match-command-output "echo ${*echo hi}" "hi\n"))) (ert-deftest esh-var-test/interp-cmd-external-indices () - "Interpolate command result from external command with index" + "Interpolate command result from external command with index." (skip-unless (executable-find "echo")) (with-temp-eshell (eshell-match-command-output "echo ${*echo \"hi\nbye\"}[1]" "bye\n"))) (ert-deftest esh-var-test/interp-temp-cmd () - "Interpolate command result redirected to temp file" + "Interpolate command result redirected to temp file." (eshell-command-result-equal "cat $<echo hi>" "hi")) (ert-deftest esh-var-test/interp-concat-lisp () - "Interpolate and concat Lisp form" + "Interpolate and concat Lisp form." (eshell-command-result-equal "+ $(+ 1 2)3 3" 36)) (ert-deftest esh-var-test/interp-concat-lisp2 () - "Interpolate and concat two Lisp forms" + "Interpolate and concat two Lisp forms." (eshell-command-result-equal "+ $(+ 1 2)$(+ 1 2) 3" 36)) (ert-deftest esh-var-test/interp-concat-cmd () - "Interpolate and concat command with literal" + "Interpolate and concat command with literal." (eshell-command-result-equal "+ ${+ 1 2}3 3" 36) (eshell-command-result-equal "echo ${*echo \"foo\nbar\"}-baz" '("foo" "bar-baz")) @@ -187,18 +286,21 @@ '("hi" "23"))) (ert-deftest esh-var-test/interp-concat-cmd2 () - "Interpolate and concat two commands" + "Interpolate and concat two commands." (eshell-command-result-equal "+ ${+ 1 2}${+ 1 2} 3" 36)) (ert-deftest esh-var-test/interp-concat-cmd-external () - "Interpolate command result from external command with concatenation" + "Interpolate command result from external command with concatenation." (skip-unless (executable-find "echo")) (with-temp-eshell (eshell-match-command-output "echo ${echo hi}-${*echo there}" "hi-there\n"))) + +;; Quoted variable interpolation + (ert-deftest esh-var-test/quoted-interp-var () - "Interpolate variable inside double-quotes" + "Interpolate variable inside double-quotes." (eshell-command-result-equal "echo \"$user-login-name\"" user-login-name)) @@ -209,8 +311,20 @@ (eshell-command-result-equal "echo \"hi, $\\\"user-login-name\\\"\"" (concat "hi, " user-login-name))) +(ert-deftest esh-var-test/quoted-interp-list-var () + "Interpolate list variable inside double-quotes." + (let ((eshell-test-value '(1 2 3))) + (eshell-command-result-equal "echo \"$eshell-test-value\"" + "(1 2 3)"))) + +(ert-deftest esh-var-test/quoted-interp-list-var-concat () + "Interpolate and concat list variable inside double-quotes" + (let ((eshell-test-value '(1 2 3))) + (eshell-command-result-equal "echo \"a$'eshell-test-value'z\"" + "a(1 2 3)z"))) + (ert-deftest esh-var-test/quoted-interp-var-indices () - "Interpolate string variable with indices inside double-quotes" + "Interpolate string variable with indices inside double-quotes." (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) (eshell-command-result-equal "echo \"$eshell-test-value[0]\"" "zero") @@ -224,8 +338,21 @@ (eshell-command-result-equal "echo \"$eshell-test-value[1 2 4]\"" "(\"one\" \"two\" \"four\")"))) +(ert-deftest esh-var-test/quote-interp-var-indices-subcommand () + "Interpolate list variable with subcommand expansion for indices inside double-quotes." + (skip-unless (executable-find "echo")) + (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) + (eshell-command-result-equal + "echo \"$eshell-test-value[${*echo 0}]\"" + "zero") + ;; FIXME: These tests would use the 0th index like the other tests + ;; here, but see above. + (eshell-command-result-equal + "echo \"$eshell-test-value[${*echo 1} ${*echo 2}]\"" + "(\"one\" \"two\")"))) + (ert-deftest esh-var-test/quoted-interp-var-split-indices () - "Interpolate string variable with indices inside double-quotes" + "Interpolate string variable with indices inside double-quotes." (let ((eshell-test-value "zero one two three four")) (eshell-command-result-equal "echo \"$eshell-test-value[0]\"" "zero") @@ -233,8 +360,7 @@ "(\"zero\" \"two\")"))) (ert-deftest esh-var-test/quoted-interp-var-string-split-indices () - "Interpolate string variable with string splitter and indices -inside double-quotes" + "Interpolate string variable with string splitter and indices inside double-quotes." (let ((eshell-test-value "zero:one:two:three:four")) (eshell-command-result-equal "echo \"$eshell-test-value[: 0]\"" "zero") @@ -247,7 +373,7 @@ inside double-quotes" "(\"zero\" \"two\")"))) (ert-deftest esh-var-test/quoted-interp-var-regexp-split-indices () - "Interpolate string variable with regexp splitter and indices" + "Interpolate string variable with regexp splitter and indices." (let ((eshell-test-value "zero:one!two:three!four")) (eshell-command-result-equal "echo \"$eshell-test-value['[:!]' 0]\"" "zero") @@ -260,7 +386,7 @@ inside double-quotes" "(\"zero\" \"two\")"))) (ert-deftest esh-var-test/quoted-interp-var-assoc () - "Interpolate alist variable with index inside double-quotes" + "Interpolate alist variable with index inside double-quotes." (let ((eshell-test-value '(("foo" . 1) (bar . 2)))) (eshell-command-result-equal "echo \"$eshell-test-value[foo]\"" "1") @@ -268,7 +394,7 @@ inside double-quotes" "2"))) (ert-deftest esh-var-test/quoted-interp-var-length-list () - "Interpolate length of list variable inside double-quotes" + "Interpolate length of list variable inside double-quotes." (let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9))))) (eshell-command-result-equal "echo \"$#eshell-test-value\"" "3") @@ -278,41 +404,53 @@ inside double-quotes" "4"))) (ert-deftest esh-var-test/quoted-interp-var-length-string () - "Interpolate length of string variable inside double-quotes" + "Interpolate length of string variable inside double-quotes." (let ((eshell-test-value "foobar")) (eshell-command-result-equal "echo \"$#eshell-test-value\"" "6"))) (ert-deftest esh-var-test/quoted-interp-var-length-alist () - "Interpolate length of alist variable inside double-quotes" + "Interpolate length of alist variable inside double-quotes." (let ((eshell-test-value '(("foo" . (1 2 3))))) (eshell-command-result-equal "echo \"$#eshell-test-value\"" "1") (eshell-command-result-equal "echo \"$#eshell-test-value[foo]\"" "3"))) +(ert-deftest esh-var-test/quoted-interp-var-splice () + "Splice-interpolate list variable inside double-quotes." + (let ((eshell-test-value '(1 2 3))) + (eshell-command-result-equal "echo a \"$@eshell-test-value\" z" + '("a" "1 2 3" "z")))) + +(ert-deftest esh-var-test/quoted-interp-var-splice-concat () + "Splice-interpolate and concat list variable inside double-quotes" + (let ((eshell-test-value '(1 2 3))) + (eshell-command-result-equal "echo \"a$@'eshell-test-value'z\"" + "a1 2 3z"))) + (ert-deftest esh-var-test/quoted-interp-lisp () - "Interpolate Lisp form evaluation inside double-quotes" + "Interpolate Lisp form evaluation inside double-quotes." (eshell-command-result-equal "echo \"hi $(concat \\\"the\\\" \\\"re\\\")\"" "hi there")) (ert-deftest esh-var-test/quoted-interp-lisp-indices () - "Interpolate Lisp form evaluation with index" + "Interpolate Lisp form evaluation with index." (eshell-command-result-equal "concat \"$(list 1 2)[1]\" cool" "2cool")) (ert-deftest esh-var-test/quoted-interp-cmd () - "Interpolate command result inside double-quotes" + "Interpolate command result inside double-quotes." (eshell-command-result-equal "echo \"hi ${echo \\\"there\\\"}\"" "hi there")) (ert-deftest esh-var-test/quoted-interp-cmd-indices () - "Interpolate command result with index inside double-quotes" + "Interpolate command result with index inside double-quotes." (eshell-command-result-equal "concat \"${listify 1 2}[1]\" cool" "2cool")) (ert-deftest esh-var-test/quoted-interp-temp-cmd () - "Interpolate command result redirected to temp file inside double-quotes" + "Interpolate command result redirected to temp file inside double-quotes." (let ((temporary-file-directory (file-name-as-directory (make-temp-file "esh-vars-tests" t)))) (unwind-protect @@ -320,21 +458,36 @@ inside double-quotes" (delete-directory temporary-file-directory t)))) (ert-deftest esh-var-test/quoted-interp-concat-cmd () - "Interpolate and concat command with literal" + "Interpolate and concat command with literal." (eshell-command-result-equal "echo \"${echo \\\"foo\nbar\\\"} baz\"" "foo\nbar baz")) +;; Interpolating commands + +(ert-deftest esh-var-test/command-interp () + "Interpolate a variable as a command name." + (let ((eshell-test-value "printnl")) + (eshell-command-result-equal "$eshell-test-value hello there" + "hello\nthere\n"))) + +(ert-deftest esh-var-test/command-interp-splice () + "Interpolate a splice variable as a command name with arguments." + (let ((eshell-test-value '("printnl" "hello" "there"))) + (eshell-command-result-equal "$@eshell-test-value" + "hello\nthere\n"))) + + ;; Interpolated variable conversion (ert-deftest esh-var-test/interp-convert-var-number () - "Interpolate numeric variable" + "Interpolate numeric variable." (let ((eshell-test-value 123)) (eshell-command-result-equal "type-of $eshell-test-value" 'integer))) (ert-deftest esh-var-test/interp-convert-var-split-indices () - "Interpolate and convert string variable with indices" + "Interpolate and convert string variable with indices." ;; Check that numeric forms are converted to numbers. (let ((eshell-test-value "000 010 020 030 040")) (eshell-command-result-equal "echo $eshell-test-value[0]" @@ -349,7 +502,7 @@ inside double-quotes" "baz\n"))) (ert-deftest esh-var-test/interp-convert-quoted-var-number () - "Interpolate numeric quoted numeric variable" + "Interpolate numeric quoted numeric variable." (let ((eshell-test-value 123)) (eshell-command-result-equal "type-of $'eshell-test-value'" 'integer) @@ -357,7 +510,7 @@ inside double-quotes" 'integer))) (ert-deftest esh-var-test/interp-convert-quoted-var-split-indices () - "Interpolate and convert quoted string variable with indices" + "Interpolate and convert quoted string variable with indices." (let ((eshell-test-value "000 010 020 030 040")) (eshell-command-result-equal "echo $'eshell-test-value'[0]" 0) @@ -365,11 +518,11 @@ inside double-quotes" '(0 20)))) (ert-deftest esh-var-test/interp-convert-cmd-string-newline () - "Interpolate trailing-newline command result" + "Interpolate trailing-newline command result." (eshell-command-result-equal "echo ${echo \"foo\n\"}" "foo")) (ert-deftest esh-var-test/interp-convert-cmd-multiline () - "Interpolate multi-line command result" + "Interpolate multi-line command result." (eshell-command-result-equal "echo ${echo \"foo\nbar\"}" '("foo" "bar")) ;; Numeric output should be converted to numbers... @@ -380,24 +533,24 @@ inside double-quotes" '("01" "02" "hi"))) (ert-deftest esh-var-test/interp-convert-cmd-number () - "Interpolate numeric command result" + "Interpolate numeric command result." (eshell-command-result-equal "echo ${echo \"1\"}" 1)) (ert-deftest esh-var-test/interp-convert-cmd-split-indices () - "Interpolate command result with indices" + "Interpolate command result with indices." (eshell-command-result-equal "echo ${echo \"000 010 020\"}[0]" 0) (eshell-command-result-equal "echo ${echo \"000 010 020\"}[0 2]" '(0 20))) (ert-deftest esh-var-test/quoted-interp-convert-var-number () - "Interpolate numeric variable inside double-quotes" + "Interpolate numeric variable inside double-quotes." (let ((eshell-test-value 123)) (eshell-command-result-equal "type-of \"$eshell-test-value\"" 'string))) (ert-deftest esh-var-test/quoted-interp-convert-var-split-indices () - "Interpolate string variable with indices inside double-quotes" + "Interpolate string variable with indices inside double-quotes." (let ((eshell-test-value "000 010 020 030 040")) (eshell-command-result-equal "echo \"$eshell-test-value[0]\"" "000") @@ -405,7 +558,7 @@ inside double-quotes" "(\"000\" \"020\")"))) (ert-deftest esh-var-test/quoted-interp-convert-quoted-var-number () - "Interpolate numeric quoted variable inside double-quotes" + "Interpolate numeric quoted variable inside double-quotes." (let ((eshell-test-value 123)) (eshell-command-result-equal "type-of \"$'eshell-test-value'\"" 'string) @@ -413,7 +566,7 @@ inside double-quotes" 'string))) (ert-deftest esh-var-test/quoted-interp-convert-quoted-var-split-indices () - "Interpolate quoted string variable with indices inside double-quotes" + "Interpolate quoted string variable with indices inside double-quotes." (let ((eshell-test-value "000 010 020 030 040")) (eshell-command-result-equal "echo \"$eshell-test-value[0]\"" "000") @@ -421,23 +574,23 @@ inside double-quotes" "(\"000\" \"020\")"))) (ert-deftest esh-var-test/quoted-interp-convert-cmd-string-newline () - "Interpolate trailing-newline command result inside double-quotes" + "Interpolate trailing-newline command result inside double-quotes." (eshell-command-result-equal "echo \"${echo \\\"foo\n\\\"}\"" "foo") (eshell-command-result-equal "echo \"${echo \\\"foo\n\n\\\"}\"" "foo")) (ert-deftest esh-var-test/quoted-interp-convert-cmd-multiline () - "Interpolate multi-line command result inside double-quotes" + "Interpolate multi-line command result inside double-quotes." (eshell-command-result-equal "echo \"${echo \\\"foo\nbar\\\"}\"" "foo\nbar")) (ert-deftest esh-var-test/quoted-interp-convert-cmd-number () - "Interpolate numeric command result inside double-quotes" + "Interpolate numeric command result inside double-quotes." (eshell-command-result-equal "echo \"${echo \\\"1\\\"}\"" "1")) (ert-deftest esh-var-test/quoted-interp-convert-cmd-split-indices () - "Interpolate command result with indices inside double-quotes" + "Interpolate command result with indices inside double-quotes." (eshell-command-result-equal "echo \"${echo \\\"000 010 020\\\"}[0]\"" "000")) @@ -596,19 +749,19 @@ it, since the setter is nil." (window-body-height nil 'remap))) (ert-deftest esh-var-test/columns-var () - "$COLUMNS should equal (window-body-width nil 'remap)" + "$COLUMNS should equal (window-body-width nil 'remap)." (eshell-command-result-equal "echo $COLUMNS" (window-body-width nil 'remap))) (ert-deftest esh-var-test/inside-emacs-var () - "Test presence of \"INSIDE_EMACS\" in subprocesses" + "Test presence of \"INSIDE_EMACS\" in subprocesses." (with-temp-eshell (eshell-match-command-output "env" (format "INSIDE_EMACS=%s,eshell" emacs-version)))) (ert-deftest esh-var-test/inside-emacs-var-split-indices () - "Test using \"INSIDE_EMACS\" with split indices" + "Test using \"INSIDE_EMACS\" with split indices." (with-temp-eshell (eshell-match-command-output "echo $INSIDE_EMACS[, 1]" "eshell"))) @@ -672,8 +825,12 @@ it, since the setter is nil." (format "cd %s" ert-remote-temporary-file-directory)) (eshell-match-command-output "echo $PATH" (regexp-quote remote-path))))) +(ert-deftest esh-var-test/uid-var () + "Test that $UID is equivalent to (user-uid) for local directories." + (eshell-command-result-equal "echo $UID" (user-uid))) + (ert-deftest esh-var-test/last-status-var-lisp-command () - "Test using the \"last exit status\" ($?) variable with a Lisp command" + "Test using the \"last exit status\" ($?) variable with a Lisp command." (with-temp-eshell (eshell-match-command-output "zerop 0; echo $?" "t\n0\n") @@ -683,7 +840,7 @@ it, since the setter is nil." "1\n" nil t))) (ert-deftest esh-var-test/last-status-var-lisp-form () - "Test using the \"last exit status\" ($?) variable with a Lisp form" + "Test using the \"last exit status\" ($?) variable with a Lisp form." (let ((eshell-lisp-form-nil-is-failure t)) (with-temp-eshell (eshell-match-command-output "(zerop 0); echo $?" @@ -706,7 +863,7 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." "1\n" nil t)))) (ert-deftest esh-var-test/last-status-var-ext-cmd () - "Test using the \"last exit status\" ($?) variable with an external command" + "Test using the \"last exit status\" ($?) variable with an external command." (skip-unless (executable-find "[")) (with-temp-eshell (eshell-match-command-output "[ foo = foo ]; echo $?" @@ -715,19 +872,19 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." "1\n"))) (ert-deftest esh-var-test/last-result-var () - "Test using the \"last result\" ($$) variable" + "Test using the \"last result\" ($$) variable." (with-temp-eshell (eshell-match-command-output "+ 1 2; + $$ 2" "3\n5\n"))) (ert-deftest esh-var-test/last-result-var-twice () - "Test using the \"last result\" ($$) variable twice" + "Test using the \"last result\" ($$) variable twice." (with-temp-eshell (eshell-match-command-output "+ 1 2; + $$ $$" "3\n6\n"))) (ert-deftest esh-var-test/last-result-var-ext-cmd () - "Test using the \"last result\" ($$) variable with an external command" + "Test using the \"last result\" ($$) variable with an external command." (skip-unless (executable-find "[")) (with-temp-eshell ;; MS-DOS/MS-Windows have an external command 'format', which we @@ -739,7 +896,7 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." "nil\n")))) (ert-deftest esh-var-test/last-result-var-split-indices () - "Test using the \"last result\" ($$) variable with split indices" + "Test using the \"last result\" ($$) variable with split indices." (with-temp-eshell (eshell-match-command-output "string-join (list \"01\" \"02\") :; + $$[: 1] 3" @@ -749,13 +906,13 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." "01:02\n02\n"))) (ert-deftest esh-var-test/last-arg-var () - "Test using the \"last arg\" ($_) variable" + "Test using the \"last arg\" ($_) variable." (with-temp-eshell (eshell-match-command-output "+ 1 2; + $_ 4" "3\n6\n"))) (ert-deftest esh-var-test/last-arg-var-indices () - "Test using the \"last arg\" ($_) variable with indices" + "Test using the \"last arg\" ($_) variable with indices." (with-temp-eshell (eshell-match-command-output "+ 1 2; + $_[0] 4" "3\n5\n") @@ -763,7 +920,7 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." "3\n6\n"))) (ert-deftest esh-var-test/last-arg-var-split-indices () - "Test using the \"last arg\" ($_) variable with split indices" + "Test using the \"last arg\" ($_) variable with split indices." (with-temp-eshell (eshell-match-command-output "concat 01:02 03:04; + $_[0][: 1] 5" "01:0203:04\n7\n") diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index f1d12dbe9f3..2c913d71cb4 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -33,9 +33,9 @@ (defvar eshell-history-file-name nil) (defvar eshell-last-dir-ring-file-name nil) -(defvar eshell-test--max-subprocess-time 5 - "The maximum amount of time to wait for a subprocess to finish, in seconds. -See `eshell-wait-for-subprocess'.") +(defvar eshell-test--max-wait-time 5 + "The maximum amount of time to wait for a condition to resolve, in seconds. +See `eshell-wait-for'.") (defun eshell-tests-remote-accessible-p () "Return if a test involving remote files can proceed. @@ -73,19 +73,28 @@ BUFNAME will be set to the name of the temporary buffer." (let ((,bufname (buffer-name))) ,@body))) +(defun eshell-wait-for (predicate &optional message) + "Wait until PREDICATE returns non-nil. +If this takes longer than `eshell-test--max-wait-time', raise an +error. MESSAGE is an optional message to use if this times out." + (let ((start (current-time)) + (message (or message "timed out waiting for condition"))) + (while (not (funcall predicate)) + (when (> (float-time (time-since start)) + eshell-test--max-wait-time) + (error message)) + (sit-for 0.1)))) + (defun eshell-wait-for-subprocess (&optional all) "Wait until there is no interactive subprocess running in Eshell. If ALL is non-nil, wait until there are no Eshell subprocesses at all running. -If this takes longer than `eshell-test--max-subprocess-time', +If this takes longer than `eshell-test--max-wait-time', raise an error." - (let ((start (current-time))) - (while (if all eshell-process-list (eshell-interactive-process-p)) - (when (> (float-time (time-since start)) - eshell-test--max-subprocess-time) - (error "timed out waiting for subprocess(es)")) - (sit-for 0.1)))) + (eshell-wait-for + (lambda () + (not (if all eshell-process-list (eshell-interactive-process-p)))))) (defun eshell-insert-command (command &optional func) "Insert a COMMAND at the end of the buffer. 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 3c4a8ec97ea..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 () @@ -117,27 +119,28 @@ (with-temp-eshell (eshell-insert-command "echo $(+ 1 (- 4 3)) \"alpha beta\" file" 'ignore) (let ((here (point)) begin valid) - (eshell-bol) + (beginning-of-line) (setq begin (point)) (eshell-forward-argument 4) (setq valid (= here (point))) (eshell-backward-argument 4) (prog1 (and valid (= begin (point))) - (eshell-bol) + (beginning-of-line) (delete-region (point) (point-max)))))) (ert-deftest eshell-test/queue-input () - "Test queuing command input" + "Test queuing command input. +This should let the current command finish, then automatically +insert the queued one at the next prompt, and finally run it." (with-temp-eshell - (eshell-insert-command "sleep 2") - (eshell-insert-command "echo alpha" 'eshell-queue-input) - (let ((count 10)) - (while (and eshell-current-command - (> count 0)) - (sit-for 1) - (setq count (1- count)))) - (should (eshell-match-output "alpha\n")))) + (eshell-insert-command "sleep 1; echo slept") + (eshell-insert-command "echo alpha" #'eshell-queue-input) + (let ((start (marker-position (eshell-beginning-of-output)))) + (eshell-wait-for (lambda () (not eshell-current-command))) + (should (string-match "^slept\n.*echo alpha\nalpha\n$" + (buffer-substring-no-properties + start (eshell-end-of-output))))))) (ert-deftest eshell-test/flush-output () "Test flushing of previous output" @@ -147,12 +150,43 @@ (should (eshell-match-output (concat "^" (regexp-quote "*** output flushed ***\n") "$"))))) -(ert-deftest eshell-test/run-old-command () - "Re-run an old command" +(ert-deftest eshell-test/get-old-input () + "Test that we can get the input of a previous command." (with-temp-eshell (eshell-insert-command "echo alpha") (goto-char eshell-last-input-start) - (string= (eshell-get-old-input) "echo alpha"))) + (should (string= (eshell-get-old-input) "echo alpha")) + ;; Make sure that `eshell-get-old-input' works even if the point is + ;; inside the prompt. + (let ((inhibit-field-text-motion t)) + (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) diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index f79118fd564..4e14ae68fb8 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -66,7 +66,9 @@ "Test setting connection-local profile variables." ;; Declare (PROFILE VARIABLES) objects. - (let (connection-local-profile-alist connection-local-criteria-alist) + (let ((clpa connection-local-profile-alist) + (clca connection-local-criteria-alist) + connection-local-profile-alist connection-local-criteria-alist) (connection-local-set-profile-variables 'remote-bash files-x-test--variables1) (should @@ -94,13 +96,20 @@ (should (equal (connection-local-get-profile-variables 'remote-nullfile) - files-x-test--variables4)))) + files-x-test--variables4)) + + ;; Cleanup. + (custom-set-variables + `(connection-local-profile-alist ',clpa now) + `(connection-local-criteria-alist ',clca now)))) (ert-deftest files-x-test-connection-local-update-profile-variables () "Test updating connection-local profile variables." ;; Declare (PROFILE VARIABLES) objects. - (let (connection-local-profile-alist connection-local-criteria-alist) + (let ((clpa connection-local-profile-alist) + (clca connection-local-criteria-alist) + connection-local-profile-alist connection-local-criteria-alist) (connection-local-set-profile-variables 'remote-bash (copy-alist files-x-test--variables1)) (should @@ -116,13 +125,20 @@ (equal (connection-local-get-profile-variables 'remote-bash) (cons (car files-x-test--variables2) - (cdr files-x-test--variables1)))))) + (cdr files-x-test--variables1)))) + + ;; Cleanup. + (custom-set-variables + `(connection-local-profile-alist ',clpa now) + `(connection-local-criteria-alist ',clca now)))) (ert-deftest files-x-test-connection-local-set-profiles () "Test setting connection-local profiles." ;; Declare (CRITERIA PROFILES) objects. - (let (connection-local-profile-alist connection-local-criteria-alist) + (let ((clpa connection-local-profile-alist) + (clca connection-local-criteria-alist) + connection-local-profile-alist connection-local-criteria-alist) (connection-local-set-profile-variables 'remote-bash files-x-test--variables1) (connection-local-set-profile-variables @@ -205,12 +221,19 @@ '(remote-bash remote-ksh remote-nullfile))) ;; A criteria other than plist is wrong. - (should-error (connection-local-set-profiles 'dummy)))) + (should-error (connection-local-set-profiles 'dummy)) + + ;; Cleanup. + (custom-set-variables + `(connection-local-profile-alist ',clpa now) + `(connection-local-criteria-alist ',clca now)))) (ert-deftest files-x-test-hack-connection-local-variables-apply () "Test setting connection-local variables." - (let (connection-local-profile-alist connection-local-criteria-alist) + (let ((clpa connection-local-profile-alist) + (clca connection-local-criteria-alist) + connection-local-profile-alist connection-local-criteria-alist) (connection-local-set-profile-variables 'remote-bash files-x-test--variables1) @@ -302,13 +325,18 @@ (hack-connection-local-variables-apply nil) (should-not connection-local-variables-alist) (should-not (local-variable-p 'remote-shell-file-name)) - (should-not (boundp 'remote-shell-file-name)))))) + (should-not (boundp 'remote-shell-file-name)))) + + ;; Cleanup. + (custom-set-variables + `(connection-local-profile-alist ',clpa now) + `(connection-local-criteria-alist ',clca now)))) (ert-deftest files-x-test-with-connection-local-variables () "Test setting connection-local variables." - (let ((connection-local-profile-alist connection-local-profile-alist) - (connection-local-criteria-alist connection-local-criteria-alist)) + (let ((clpa connection-local-profile-alist) + (clca connection-local-criteria-alist)) (connection-local-set-profile-variables 'remote-bash files-x-test--variables1) (connection-local-set-profile-variables @@ -385,7 +413,12 @@ (should-not (local-variable-p 'remote-null-device)) ;; The variable values are reset. (should-not (boundp 'remote-shell-file-name)) - (should (string-equal (symbol-value 'remote-null-device) "null")))))) + (should (string-equal (symbol-value 'remote-null-device) "null")))) + + ;; Cleanup. + (custom-set-variables + `(connection-local-profile-alist ',clpa now) + `(connection-local-criteria-alist ',clca now)))) (defun files-x-test--get-lazy-var () "Get the connection-local value of `remote-lazy-var'. @@ -405,7 +438,9 @@ If it's not initialized yet, initialize it." (ert-deftest files-x-test-setq-connection-local () "Test dynamically setting connection local variables." - (let (connection-local-profile-alist connection-local-criteria-alist) + (let ((clpa connection-local-profile-alist) + (clca connection-local-criteria-alist) + connection-local-profile-alist connection-local-criteria-alist) (connection-local-set-profile-variables 'remote-lazy files-x-test--variables5) (connection-local-set-profiles @@ -440,7 +475,12 @@ If it's not initialized yet, initialize it." (should (equal (files-x-test--get-lazy-var) "there")) (with-connection-local-application-variables (cadr files-x-test--application) - (should (equal remote-null-device "null")))))) + (should (equal remote-null-device "null")))) + + ;; Cleanup. + (custom-set-variables + `(connection-local-profile-alist ',clpa now) + `(connection-local-criteria-alist ',clca now)))) (provide 'files-x-tests) ;;; files-x-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 @@ -181,10 +181,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)))) ;;; help-fns-tests.el ends here 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/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el index a595167d130..85ac96a931c 100644 --- a/test/lisp/jsonrpc-tests.el +++ b/test/lisp/jsonrpc-tests.el @@ -124,7 +124,7 @@ "Signals an -32603 JSONRPC error." (jsonrpc--with-emacsrpc-fixture (conn) (condition-case err - (progn + (let ((jsonrpc-inhibit-debug-on-error t)) (jsonrpc-request conn '+ ["a" 2]) (ert-fail "A `jsonrpc-error' should have been signaled!")) (jsonrpc-error 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-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index b28b32bc7d3..94ef40a1116 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -121,12 +121,6 @@ the origin of the temporary TMPFILE, have no write permissions." (directory-files tmpfile 'full directory-files-no-dot-files-regexp)) (delete-directory tmpfile))) -(defun tramp-archive--test-emacs27-p () - "Check for Emacs version >= 27.1. -Some semantics has been changed for there, without new functions or -variables, so we check the Emacs version directly." - (>= emacs-major-version 27)) - (ert-deftest tramp-archive-test00-availability () "Test availability of archive file name functions." :expected-result (if tramp-archive-enabled :passed :failed) @@ -615,16 +609,13 @@ This checks also `file-name-as-directory', `file-name-directory', (with-temp-buffer (insert-directory tramp-archive-test-archive nil) (goto-char (point-min)) - (should - (looking-at-p - (tramp-compat-rx (literal tramp-archive-test-archive))))) + (should (looking-at-p (rx (literal tramp-archive-test-archive))))) (with-temp-buffer (insert-directory tramp-archive-test-archive "-al") (goto-char (point-min)) (should (looking-at-p - (tramp-compat-rx - bol (+ nonl) blank (literal tramp-archive-test-archive) eol)))) + (rx bol (+ nonl) blank (literal tramp-archive-test-archive) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tramp-archive-test-archive) @@ -880,26 +871,31 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (ert-deftest tramp-archive-test43-file-system-info () "Check that `file-system-info' returns proper values." (skip-unless tramp-archive-enabled) - ;; Since Emacs 27.1. - (skip-unless (fboundp 'file-system-info)) - ;; `file-system-info' exists since Emacs 27. We don't want to see - ;; compiler warnings for older Emacsen. - (let ((fsi (with-no-warnings (file-system-info tramp-archive-test-archive)))) + (let ((fsi (file-system-info tramp-archive-test-archive))) (skip-unless fsi) (should (and (consp fsi) - (= (length fsi) 3) + (tramp-compat-length= fsi 3) (numberp (nth 0 fsi)) ;; FREE and AVAIL are always 0. (zerop (nth 1 fsi)) (zerop (nth 2 fsi)))))) -(ert-deftest tramp-archive-test47-auto-load () +;; `file-user-uid' was introduced in Emacs 30.1. +(ert-deftest tramp-archive-test44-file-user-uid () + "Check that `file-user-uid' returns proper values." + (skip-unless tramp-archive-enabled) + (skip-unless (fboundp 'file-user-uid)) + + (let ((default-directory tramp-archive-test-archive)) + ;; `file-user-uid' exists since Emacs 30.1. We don't want to see + ;; compiler warnings for older Emacsen. + (should (integerp (with-no-warnings (file-user-uid)))))) + +(ert-deftest tramp-archive-test48-auto-load () "Check that `tramp-archive' autoloads properly." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) - ;; Autoloading tramp-archive works since Emacs 27.1. - (skip-unless (tramp-archive--test-emacs27-p)) ;; tramp-archive is neither loaded at Emacs startup, nor when ;; loading a file like "/mock::foo" (which loads Tramp). @@ -922,7 +918,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) (should (string-match - (tramp-compat-rx + (rx "tramp-archive loaded: " (literal (symbol-name (tramp-archive-file-name-p default-directory))) @@ -941,12 +937,10 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (format "(setq tramp-archive-enabled %s)" enabled)) (shell-quote-argument (format code file))))))))))) -(ert-deftest tramp-archive-test47-delay-load () +(ert-deftest tramp-archive-test48-delay-load () "Check that `tramp-archive' is loaded lazily, only when needed." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) - ;; Autoloading tramp-archive works since Emacs 27.1. - (skip-unless (tramp-archive--test-emacs27-p)) ;; tramp-archive is neither loaded at Emacs startup, nor when ;; loading a file like "/foo.tar". It is loaded only when @@ -967,7 +961,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (dolist (tae '(t nil)) (should (string-match - (tramp-compat-rx + (rx "tramp-archive loaded: nil" (+ ascii) "tramp-archive loaded: nil" (+ ascii) "tramp-archive loaded: " (literal (symbol-name tae))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index ff0fc56043e..677dd35d796 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -33,7 +33,7 @@ ;; remote host, set this environment variable to "/dev/null" or ;; whatever is appropriate on your system. -;; For slow remote connections, `tramp-test44-asynchronous-requests' +;; For slow remote connections, `tramp-test45-asynchronous-requests' ;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper ;; value less than 10 could help. @@ -74,16 +74,15 @@ (defvar tramp-remote-path) (defvar tramp-remote-process-environment) -;; Needed for Emacs 26. -(declare-function with-connection-local-variables "files-x") ;; Needed for Emacs 27. (defvar lock-file-name-transforms) (defvar process-file-return-signal-string) (defvar remote-file-name-inhibit-locks) -(defvar shell-command-dont-erase-buffer) -;; Needed for Emacs 28. (defvar dired-copy-dereference) +;; Declared in Emacs 30. +(defvar remote-file-name-inhibit-delete-by-moving-to-trash) + ;; `ert-resource-file' was introduced in Emacs 28.1. (unless (macrop 'ert-resource-file) (eval-and-compile @@ -166,6 +165,9 @@ A resource file is in the resource directory as per ;; Suppress nasty messages. (fset #'shell-command-sentinel #'ignore) ;; We do not want to be interrupted. + (fset #'tramp-action-yesno + (lambda (_proc vec) + (tramp-send-string vec (concat "yes" tramp-local-end-of-line)) t)) (eval-after-load 'tramp-gvfs '(fset 'tramp-gvfs-handler-askquestion (lambda (_message _choices) '(t nil 0))))) @@ -224,7 +226,7 @@ If LOCAL is non-nil, a local file name is returned. If QUOTED is non-nil, the local part of the file name is quoted. The temporary file is not created." (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (expand-file-name (make-temp-name "tramp-test") (if local temporary-file-directory ert-remote-temporary-file-directory)))) @@ -2296,10 +2298,9 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Check `directory-abbrev-alist' abbreviation. (let ((directory-abbrev-alist - `((,(tramp-compat-rx bos (literal home-dir) "/foo") - . ,(concat home-dir "/f")) - (,(tramp-compat-rx bos (literal remote-host) "/nowhere") - . ,(concat remote-host "/nw"))))) + `((,(rx bos (literal home-dir) "/foo") . ,(concat home-dir "/f")) + (,(rx bos (literal remote-host) "/nowhere") + . ,(concat remote-host "/nw"))))) (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) (concat remote-host-nohop "~/f/bar"))) (should (equal (abbreviate-file-name @@ -2350,7 +2351,24 @@ This checks also `file-name-as-directory', `file-name-directory', (expand-file-name (file-name-nondirectory tmp-name) trash-directory)))) (delete-directory trash-directory 'recursive) - (should-not (file-exists-p trash-directory))))))) + (should-not (file-exists-p trash-directory)))) + + ;; Setting `remote-file-name-inhibit-delete-by-moving-to-trash' + ;; prevents trashing remote files. + (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) + (delete-by-moving-to-trash t) + (remote-file-name-inhibit-delete-by-moving-to-trash t)) + (make-directory trash-directory) + (should-not (file-exists-p tmp-name)) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (delete-file tmp-name 'trash) + (should-not (file-exists-p tmp-name)) + (should-not + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name) trash-directory))) + (delete-directory trash-directory 'recursive) + (should-not (file-exists-p trash-directory)))))) (ert-deftest tramp-test08-file-local-copy () "Check `file-local-copy'." @@ -2479,17 +2497,14 @@ This checks also `file-name-as-directory', `file-name-directory', (should (string-equal (buffer-string) "foo"))) ;; Write empty string. Used for creation of temporary files. - ;; Since Emacs 27.1. - (when (fboundp 'make-empty-file) - (with-no-warnings - (should-error - (make-empty-file tmp-name) - :type 'file-already-exists) - (delete-file tmp-name) - (make-empty-file tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) ""))))) + (should-error + (make-empty-file tmp-name) + :type 'file-already-exists) + (delete-file tmp-name) + (make-empty-file tmp-name) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) ""))) ;; Write partly. (with-temp-buffer @@ -2511,12 +2526,11 @@ This checks also `file-name-as-directory', `file-name-directory', (string-match-p (if (and (null noninteractive) (or (eq visit t) (null visit) (stringp visit))) - (tramp-compat-rx - bol "Wrote " (literal tmp-name) "\n" eos) + (rx bol "Wrote " (literal tmp-name) "\n" eos) (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. @@ -2542,8 +2556,6 @@ This checks also `file-name-as-directory', `file-name-directory', "Check that `file-precious-flag' is respected with Tramp in use." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - ;; The bug is fixed in Emacs 27.1. - (skip-unless (tramp--test-emacs27-p)) (let* ((tmp-name (tramp--test-make-temp-name)) (inhibit-message t) @@ -2626,10 +2638,7 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `copy-file'." (skip-unless (tramp--test-enabled)) - ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted - (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) - '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name 'local quoted))) @@ -2738,10 +2747,7 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `rename-file'." (skip-unless (tramp--test-enabled)) - ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted - (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) - '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name 'local quoted))) @@ -2857,6 +2863,7 @@ This checks also `file-name-as-directory', `file-name-directory', This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (tramp--test-enabled)) + ;; Since Emacs 29.1, `make-directory' has defined return values. (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "foo/bar" tmp-name1)) @@ -2865,7 +2872,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (unwind-protect (progn (with-file-modes unusual-file-mode-1 - (make-directory tmp-name1)) + (if (tramp--test-emacs29-p) + (should-not (make-directory tmp-name1)) + (make-directory tmp-name1))) (should-error (make-directory tmp-name1) :type 'file-already-exists) @@ -2878,15 +2887,19 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (make-directory tmp-name2) :type 'file-error) (with-file-modes unusual-file-mode-2 - (make-directory tmp-name2 'parents)) + (if (tramp--test-emacs29-p) + (should-not (make-directory tmp-name2 'parents)) + (make-directory tmp-name2 'parents))) (should (file-directory-p tmp-name2)) (should (file-accessible-directory-p tmp-name2)) (when (tramp--test-supports-set-file-modes-p) (should (equal (format "%#o" unusual-file-mode-2) (format "%#o" (file-modes tmp-name2))))) ;; If PARENTS is non-nil, `make-directory' shall not - ;; signal an error when DIR exists already. - (make-directory tmp-name2 'parents)) + ;; signal an error when DIR exists already. It returns t. + (if (tramp--test-emacs29-p) + (should (make-directory tmp-name2 'parents)) + (make-directory tmp-name2 'parents))) ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) @@ -2918,13 +2931,11 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (delete-directory tmp-name1 'recursive) (should-not (file-directory-p tmp-name1)) - ;; Trashing directories works only since Emacs 27.1. It doesn't - ;; work when `system-move-file-to-trash' is defined (on MS - ;; Windows and macOS), for encrypted remote directories and for - ;; ange-ftp. + ;; Trashing directories doesn't work when + ;; `system-move-file-to-trash' is defined (on MS Windows and + ;; macOS), for encrypted remote directories and for ange-ftp. (when (and (not (fboundp 'system-move-file-to-trash)) - (not (tramp--test-crypt-p)) (not (tramp--test-ftp-p)) - (tramp--test-emacs27-p)) + (not (tramp--test-crypt-p)) (not (tramp--test-ftp-p))) (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) (delete-by-moving-to-trash t)) (make-directory trash-directory) @@ -2965,7 +2976,23 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." "%s/%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1) (file-name-nondirectory tmp-name2)))) (delete-directory trash-directory 'recursive) - (should-not (file-exists-p trash-directory))))))) + (should-not (file-exists-p trash-directory)))) + + ;; Setting `remote-file-name-inhibit-delete-by-moving-to-trash' + ;; prevents trashing remote files. + (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) + (delete-by-moving-to-trash t) + (remote-file-name-inhibit-delete-by-moving-to-trash t)) + (make-directory trash-directory) + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (delete-directory tmp-name1 nil 'trash) + (should-not (file-exists-p tmp-name1)) + (should-not + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) trash-directory))) + (delete-directory trash-directory 'recursive) + (should-not (file-exists-p trash-directory)))))) (ert-deftest tramp-test15-copy-directory () "Check `copy-directory'." @@ -3193,9 +3220,6 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; (this is performed by `dired'). If FULL is nil, it shows just ;; one file. So we refrain from testing. (skip-unless (not (tramp--test-ange-ftp-p))) - ;; `insert-directory' of encrypted remote directories works only - ;; since Emacs 27.1. - (skip-unless (or (not (tramp--test-crypt-p)) (tramp--test-emacs27-p))) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 @@ -3213,26 +3237,23 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (with-temp-buffer (insert-directory tmp-name1 nil) (goto-char (point-min)) - (should (looking-at-p (tramp-compat-rx (literal tmp-name1))))) + (should (looking-at-p (rx (literal tmp-name1))))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) nil) (goto-char (point-min)) (should - (looking-at-p - (tramp-compat-rx (literal (file-name-as-directory tmp-name1)))))) + (looking-at-p (rx (literal (file-name-as-directory tmp-name1)))))) (with-temp-buffer (insert-directory tmp-name1 "-al") (goto-char (point-min)) (should - (looking-at-p - (tramp-compat-rx bol (+ nonl) blank (literal tmp-name1) eol)))) + (looking-at-p (rx bol (+ nonl) blank (literal tmp-name1) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al") (goto-char (point-min)) (should (looking-at-p - (tramp-compat-rx - bol (+ nonl) blank (literal tmp-name1) "/" eol)))) + (rx bol (+ nonl) blank (literal tmp-name1) "/" eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) @@ -3293,7 +3314,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (tmp-name4 (expand-file-name "bar" tmp-name2)) (ert-remote-temporary-file-directory (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) ert-remote-temporary-file-directory)) buffer) (unwind-protect @@ -3316,14 +3337,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (tramp-compat-rx + (rx (literal (file-relative-name tmp-name1 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (tramp-compat-rx + (rx (literal (file-relative-name tmp-name2 ert-remote-temporary-file-directory)))))) @@ -3338,14 +3359,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (tramp-compat-rx + (rx (literal (file-relative-name tmp-name3 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (tramp-compat-rx + (rx (literal (file-relative-name tmp-name4 @@ -3368,14 +3389,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (tramp-compat-rx + (rx (literal (file-relative-name tmp-name3 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (tramp-compat-rx + (rx (literal (file-relative-name tmp-name4 @@ -3548,7 +3569,7 @@ This tests also `access-file', `file-readable-p', (should (string-equal (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (file-attribute-type attr)) (file-remote-p (file-truename tmp-name1) 'localname))) (delete-file tmp-name2)) @@ -3612,9 +3633,6 @@ This tests also `access-file', `file-readable-p', (cons '(nil "perl" nil) tramp-connection-properties))) (progn - ;; `ert-test-result-duration' exists since Emacs 27. It - ;; doesn't hurt to call it unconditionally, because - ;; `skip-unless' hides the error. (skip-unless (< (ert-test-result-duration result) 300)) (funcall (ert-test-body ert-test))) (ert-skip (format "Test `%s' must run before" ',test))))) @@ -3643,9 +3661,6 @@ This tests also `access-file', `file-readable-p', (nil "id" nil)) tramp-connection-properties))) (progn - ;; `ert-test-result-duration' exists since Emacs 27. It - ;; doesn't hurt to call it unconditionally, because - ;; `skip-unless' hides the error. (skip-unless (< (ert-test-result-duration result) 300)) (funcall (ert-test-body ert-test))) (ert-skip (format "Test `%s' must run before" ',test))))) @@ -3672,9 +3687,6 @@ This tests also `access-file', `file-readable-p', (nil "readlink" nil)) tramp-connection-properties))) (progn - ;; `ert-test-result-duration' exists since Emacs 27. It - ;; doesn't hurt to call it unconditionally, because - ;; `skip-unless' hides the error. (skip-unless (< (ert-test-result-duration result) 300)) (funcall (ert-test-body ert-test))) (ert-skip (format "Test `%s' must run before" ',test))))) @@ -3710,9 +3722,9 @@ They might differ only in time attributes or directory size." ;; few seconds). We use a test start time minus 10 seconds, in ;; order to compensate a possible timestamp resolution higher than ;; a second on the remote machine. - (when (or (tramp-compat-time-equal-p + (when (or (time-equal-p (file-attribute-modification-time attr1) tramp-time-dont-know) - (tramp-compat-time-equal-p + (time-equal-p (file-attribute-modification-time attr2) tramp-time-dont-know)) (setcar (nthcdr 5 attr1) tramp-time-dont-know) (setcar (nthcdr 5 attr2) tramp-time-dont-know)) @@ -3723,9 +3735,9 @@ They might differ only in time attributes or directory size." (float-time (file-attribute-modification-time attr2))) (setcar (nthcdr 5 attr2) tramp-time-dont-know)) ;; Status change time. Ditto. - (when (or (tramp-compat-time-equal-p + (when (or (time-equal-p (file-attribute-status-change-time attr1) tramp-time-dont-know) - (tramp-compat-time-equal-p + (time-equal-p (file-attribute-status-change-time attr2) tramp-time-dont-know)) (setcar (nthcdr 6 attr1) tramp-time-dont-know) (setcar (nthcdr 6 attr2) tramp-time-dont-know)) @@ -3864,7 +3876,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (should (string-equal (funcall - (if quoted #'tramp-compat-file-name-unquote #'identity) + (if quoted #'file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2))) ;; Both report the modes of `tmp-name1'. @@ -3937,7 +3949,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (funcall - (if quoted #'tramp-compat-file-name-unquote #'identity) + (if quoted #'file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2))) (when (tramp--test-expensive-test-p) @@ -3955,14 +3967,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (funcall - (if quoted #'tramp-compat-file-name-unquote #'identity) + (if quoted #'file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2)))) (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) (should (string-equal (funcall - (if quoted #'tramp-compat-file-name-unquote #'identity) + (if quoted #'file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2))) ;; If we use the local part of `tmp-name1', it shall still work. @@ -3972,7 +3984,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (funcall - (if quoted #'tramp-compat-file-name-unquote #'identity) + (if quoted #'file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2))) ;; `tmp-name3' is a local file name. Therefore, the link @@ -3994,7 +4006,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (funcall - (if quoted #'tramp-compat-file-name-unquote #'identity) + (if quoted #'file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name5))) ;; Check, that files in symlinked directories still work. @@ -4088,16 +4100,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "/[penguin/motd]" "/penguin:motd:"))) (delete-file tmp-name2) (make-symbolic-link - (funcall - (if quoted #'tramp-compat-file-name-unquote #'identity) penguin) + (funcall (if quoted #'file-name-unquote #'identity) penguin) tmp-name2) (should (file-symlink-p tmp-name2)) (should-not (file-regular-p tmp-name2)) (should (string-equal (file-truename tmp-name2) - (tramp-compat-file-name-quote - (concat (file-remote-p tmp-name2) penguin))))) + (file-name-quote (concat (file-remote-p tmp-name2) penguin))))) ;; `tmp-name3' is a local file name. ;; `make-symbolic-link' might not be permitted on w32 systems. (unless (tramp--test-windows-nt-p) @@ -4110,7 +4120,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (file-truename tmp-name1) - (tramp-compat-file-name-unquote (file-truename tmp-name3)))))) + (file-name-unquote (file-truename tmp-name3)))))) ;; Cleanup. (ignore-errors @@ -4166,6 +4176,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-symlink-p tmp-name1)) (should-not (file-regular-p tmp-name1)) (should-not (file-regular-p tmp-name2)) + (should + (string-equal + (file-truename tmp-name1) + (file-truename tmp-name2))) (if (tramp--test-smb-p) ;; The symlink command of "smbclient" detects the ;; cycle already. @@ -4173,10 +4187,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (make-symbolic-link tmp-name1 tmp-name2) :type 'file-error) (make-symbolic-link tmp-name1 tmp-name2) + (should (file-symlink-p tmp-name1)) (should (file-symlink-p tmp-name2)) + (should-not (file-regular-p tmp-name1)) (should-not (file-regular-p tmp-name2)) (should-error (file-truename tmp-name1) + :type 'file-error) + (should-error + (file-truename tmp-name2) :type 'file-error)))) ;; Cleanup. @@ -4188,7 +4207,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let* ((dir1 (directory-file-name (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) ert-remote-temporary-file-directory))) (dir2 (file-name-as-directory dir1))) (should (string-equal (file-truename dir1) (expand-file-name dir1))) @@ -4217,12 +4236,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (set-file-times tmp-name1 (seconds-to-time 60))) ;; Dumb remote shells without perl(1) or stat(1) are not ;; able to return the date correctly. They say "don't know". - (unless (tramp-compat-time-equal-p + (unless (time-equal-p (file-attribute-modification-time (file-attributes tmp-name1)) tramp-time-dont-know) (should - (tramp-compat-time-equal-p + (time-equal-p (file-attribute-modification-time (file-attributes tmp-name1)) (seconds-to-time 60))) ;; Setting the time for not existing files shall fail. @@ -4241,7 +4260,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-no-warnings (set-file-times tmp-name1 (seconds-to-time 60) 'nofollow) (should - (tramp-compat-time-equal-p + (time-equal-p (file-attribute-modification-time (file-attributes tmp-name1)) (seconds-to-time 60))))))) @@ -4287,10 +4306,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (file-acl ert-remote-temporary-file-directory)) (skip-unless (not (tramp--test-crypt-p))) - ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted - (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) - '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name 'local quoted))) @@ -4367,10 +4383,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." '(nil nil nil nil)))) (skip-unless (not (tramp--test-crypt-p))) - ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted - (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) - '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name 'local quoted))) @@ -4511,42 +4524,40 @@ 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 (zerop (length method)) - (zerop (length tramp-method-regexp))) + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp)) (should (member (concat prefix-format method tramp-postfix-method-format) (file-name-all-completions (concat prefix-format (substring method 0 1)) "/")))) ;; Complete host name. - (unless (or (zerop (length method)) - (zerop (length tramp-method-regexp)) - (zerop (length host)) - (tramp--test-gvfs-p method)) + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp) + (tramp-string-empty-or-nil-p host)) (should (member (concat @@ -4579,6 +4590,13 @@ 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) + ;; Ange-FTP does not support this. + (unless (tramp--test-ange-ftp-p) + (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 @@ -4624,6 +4642,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)) @@ -4871,13 +5073,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Disabled process filter. "sshfs" does not cooperate. - (unless (tramp--test-sshfs-p) + ;; Disabled process filter. It doesn't work reliable. + (unless t (unwind-protect (with-temp-buffer - (setq command '("cat") - proc - (apply #'start-file-process "test4" (current-buffer) command)) + (setq command '("cat") + proc + (apply + #'start-file-process "test4" (current-buffer) command)) (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) @@ -4897,12 +5100,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Process connection type. (when (and (tramp--test-sh-p) (not (tramp-direct-async-process-p)) - ;; `executable-find' has changed the number of - ;; parameters in Emacs 27.1, so we use `apply' for - ;; older Emacsen. - (ignore-errors - (with-no-warnings - (apply #'executable-find '("hexdump" remote))))) + (executable-find "hexdump" 'remote)) (dolist (process-connection-type '(nil pipe t pty)) (unwind-protect (with-temp-buffer @@ -4914,23 +5112,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) + ;; Give the pipe process a chance to start. + (when (memq process-connection-type '(nil pipe)) + (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 - (if (and (memq process-connection-type '(nil pipe)) - (not (tramp--test-macos-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\n6F\n6F\n0D" (? "\n00") "\n0A\n") - (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\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))))) @@ -4959,33 +5155,29 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Define ert test `TEST-direct-async' for direct async processes. If UNSTABLE is non-nil, the test is tagged as `:unstable'." (declare (indent 1)) - ;; `make-process' supports file name handlers since Emacs 27. We - ;; cannot use `tramp--test-always' during compilation of the macro. - (when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t))))) - (ignore-errors (make-process :file-handler t))) - `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse direct async process.") - :tags (append '(:expensive-test :tramp-asynchronous-processes) - (and ,unstable '(:unstable))) - (skip-unless (tramp--test-enabled)) - (let ((default-directory ert-remote-temporary-file-directory) - (ert-test (ert-get-test ',test)) - (tramp-connection-properties - (cons '(nil "direct-async-process" t) - tramp-connection-properties))) - (skip-unless (tramp-direct-async-process-p)) - ;; We do expect an established connection already, - ;; `file-truename' does it by side-effect. Suppress - ;; `tramp--test-enabled', in order to keep the connection. - ;; Suppress "Process ... finished" messages. - (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always) - ((symbol-function #'internal-default-process-sentinel) - #'ignore)) - (file-truename ert-remote-temporary-file-directory) - (funcall (ert-test-body ert-test))))))) + `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) () + ;; This is the docstring. However, it must be expanded to a + ;; string inside the macro. No idea. + ;; (concat (ert-test-documentation (get ',test 'ert--test)) + ;; "\nUse direct async process.") + :tags (append '(:expensive-test :tramp-asynchronous-processes) + (and ,unstable '(:unstable))) + (skip-unless (tramp--test-enabled)) + (let ((default-directory ert-remote-temporary-file-directory) + (ert-test (ert-get-test ',test)) + (tramp-connection-properties + (cons '(nil "direct-async-process" t) + tramp-connection-properties))) + (skip-unless (tramp-direct-async-process-p)) + ;; We do expect an established connection already, + ;; `file-truename' does it by side-effect. Suppress + ;; `tramp--test-enabled', in order to keep the connection. + ;; Suppress "Process ... finished" messages. + (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always) + ((symbol-function #'internal-default-process-sentinel) + #'ignore)) + (file-truename ert-remote-temporary-file-directory) + (funcall (ert-test-body ert-test)))))) (tramp--test-deftest-direct-async-process tramp-test29-start-file-process) @@ -4996,24 +5188,21 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." '(:unstable))) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) - ;; `make-process' supports file name handlers since Emacs 27. - (skip-unless (tramp--test-emacs27-p)) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((default-directory ert-remote-temporary-file-directory) (tmp-name (tramp--test-make-temp-name nil quoted)) kill-buffer-query-functions command proc) - (with-no-warnings (should-not (make-process))) + (should-not (make-process)) ;; Simple process. (unwind-protect (with-temp-buffer (setq command '("cat") proc - (with-no-warnings - (make-process - :name "test1" :buffer (current-buffer) :command command - :file-handler t))) + (make-process + :name "test1" :buffer (current-buffer) :command command + :file-handler t)) (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) @@ -5035,10 +5224,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (should (file-exists-p tmp-name)) (setq command `("cat" ,(file-name-nondirectory tmp-name)) proc - (with-no-warnings - (make-process - :name "test2" :buffer (current-buffer) :command command - :file-handler t))) + (make-process + :name "test2" :buffer (current-buffer) :command command + :file-handler t)) (should (processp proc)) (should (equal (process-get proc 'remote-command) command)) ;; Read output. @@ -5057,13 +5245,12 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (with-temp-buffer (setq command '("cat") proc - (with-no-warnings - (make-process - :name "test3" :buffer (current-buffer) :command command - :filter - (lambda (p s) - (with-current-buffer (process-buffer p) (insert s))) - :file-handler t))) + (make-process + :name "test3" :buffer (current-buffer) :command command + :filter + (lambda (p s) + (with-current-buffer (process-buffer p) (insert s))) + :file-handler t)) (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) @@ -5078,17 +5265,15 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Disabled process filter. "sshfs" does not cooperate. - (unless (tramp--test-sshfs-p) + ;; Disabled process filter. It doesn't work reliable. + (unless t (unwind-protect (with-temp-buffer (setq command '("cat") proc - (with-no-warnings - (make-process - :name "test4" :buffer (current-buffer) :command command - :filter t - :file-handler t))) + (make-process + :name "test4" :buffer (current-buffer) :command command + :filter t :file-handler t)) (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) @@ -5109,13 +5294,12 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (with-temp-buffer (setq command '("cat") proc - (with-no-warnings - (make-process - :name "test5" :buffer (current-buffer) :command command - :sentinel - (lambda (p s) - (with-current-buffer (process-buffer p) (insert s))) - :file-handler t))) + (make-process + :name "test5" :buffer (current-buffer) :command command + :sentinel + (lambda (p s) + (with-current-buffer (process-buffer p) (insert s))) + :file-handler t)) (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) @@ -5141,11 +5325,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (with-temp-buffer (setq command '("cat" "/does-not-exist") proc - (with-no-warnings - (make-process - :name "test6" :buffer (current-buffer) :command command - :stderr stderr - :file-handler t))) + (make-process + :name "test6" :buffer (current-buffer) :command command + :stderr stderr :file-handler t)) (should (processp proc)) (should (equal (process-get proc 'remote-command) command)) ;; Read output. @@ -5174,11 +5356,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (with-temp-buffer (setq command '("cat" "/does-not-exist") proc - (with-no-warnings - (make-process - :name "test7" :buffer (current-buffer) :command command - :stderr tmp-name - :file-handler t))) + (make-process + :name "test7" :buffer (current-buffer) :command command + :stderr tmp-name :file-handler t)) (should (processp proc)) (should (equal (process-get proc 'remote-command) command)) ;; Read stderr. @@ -5199,51 +5379,43 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Process connection type. (when (and (tramp--test-sh-p) (not (tramp-direct-async-process-p)) - ;; `executable-find' has changed the number of - ;; parameters in Emacs 27.1, so we use `apply' for - ;; older Emacsen. - (ignore-errors - (with-no-warnings - (apply #'executable-find '("hexdump" remote))))) + (executable-find "hexdump" 'remote)) (dolist (connection-type '(nil pipe t pty)) ;; `process-connection-type' is taken when ;; `:connection-type' is nil. (dolist (process-connection-type - (unless connection-type '(nil pipe t pty))) + (if connection-type '(nil pipe t pty) '(nil))) (unwind-protect (with-temp-buffer (setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"") proc - (with-no-warnings - (make-process - :name - (format "test8-%s-%s" - connection-type process-connection-type) - :buffer (current-buffer) - :connection-type connection-type - :command command - :file-handler t))) + (make-process + :name + (format "test8-%s-%s" + connection-type process-connection-type) + :buffer (current-buffer) + :connection-type connection-type + :command command + :file-handler t)) (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) + ;; Give the pipe process a chance to start. + (when (or (eq connection-type 'pipe) + (memq process-connection-type '(nil pipe))) + (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 - (if (and (memq (or connection-type process-connection-type) - '(nil pipe)) - (not (tramp--test-macos-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\n6F\n6F\n0D" (? "\n00") "\n0A\n") - (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\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))))))))) @@ -5258,8 +5430,6 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-windows-nt-p))) (skip-unless (not (tramp--test-crypt-p))) - ;; Since Emacs 27.1. - (skip-unless (macrop 'with-connection-local-variables)) ;; We must use `file-truename' for the temporary directory, in ;; order to establish the connection prior running an asynchronous @@ -5301,8 +5471,6 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-windows-nt-p))) (skip-unless (not (tramp--test-crypt-p))) - ;; Since Emacs 27.1. - (skip-unless (macrop 'with-connection-local-variables)) ;; Since Emacs 29.1. (skip-unless (boundp 'signal-process-functions)) @@ -5403,7 +5571,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))))) @@ -5419,7 +5587,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (when-let ((default-directory ert-remote-temporary-file-directory) (mi (memory-info))) (should (consp mi)) - (should (= (length mi) 4)) + (should (tramp-compat-length= mi 4)) (dotimes (i (length mi)) (should (natnump (nth i mi)))))) @@ -5429,11 +5597,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." INPUT, if non-nil, is a string sent to the process." (let ((proc (async-shell-command command output-buffer error-buffer)) (delete-exited-processes t)) - ;; Since Emacs 27.1. - (when (macrop 'with-connection-local-variables) - (should (equal (process-get proc 'remote-command) - (with-connection-local-variables - `(,shell-file-name ,shell-command-switch ,command))))) + (should (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command)))) (cl-letf (((symbol-function #'shell-command-sentinel) #'ignore)) (when (stringp input) (process-send-string proc input)) @@ -5454,10 +5620,6 @@ INPUT, if non-nil, is a string sent to the process." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) - ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for - ;; remote processes in Emacs. That doesn't work for tramp-adb.el. - (when (tramp--test-adb-p) - (skip-unless (tramp--test-emacs27-p))) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted)) @@ -5525,7 +5687,7 @@ INPUT, if non-nil, is a string sent to the process." (should (string-match-p ;; Some shells echo, for example the "adb" or container methods. - (tramp-compat-rx + (rx bos (** 1 2 (literal (file-name-nondirectory tmp-name)) "\n") eos) (buffer-string)))) @@ -5533,10 +5695,8 @@ INPUT, if non-nil, is a string sent to the process." ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) - ;; Test `async-shell-command-width'. It exists since Emacs 26.1, - ;; but seems to work since Emacs 27.1 only. - (when (and (tramp--test-asynchronous-processes-p) - (tramp--test-sh-p) (tramp--test-emacs27-p)) + ;; Test `async-shell-command-width'. + (when (and (tramp--test-asynchronous-processes-p) (tramp--test-sh-p)) (let* ((async-shell-command-width 1024) (default-directory ert-remote-temporary-file-directory) (cols (ignore-errors @@ -5556,8 +5716,6 @@ INPUT, if non-nil, is a string sent to the process." (skip-unless (tramp--test-enabled)) (skip-unless nil) (skip-unless (tramp--test-supports-processes-p)) - ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. - (skip-unless (tramp--test-emacs27-p)) ;; (message " s-c-d-e-b current-buffer buffer-string point") ;; (message "===============================================") @@ -5732,8 +5890,7 @@ INPUT, if non-nil, is a string sent to the process." ;; Variable is set. (should (string-match-p - (tramp-compat-rx (literal envvar)) - (funcall this-shell-command-to-string "set")))) + (rx (literal envvar)) (funcall this-shell-command-to-string "set")))) (unless (tramp-direct-async-process-p) ;; We force a reconnect, in order to have a clean environment. @@ -5759,7 +5916,7 @@ INPUT, if non-nil, is a string sent to the process." ;; Variable is unset. (should-not (string-match-p - (tramp-compat-rx (literal envvar)) + (rx (literal envvar)) ;; We must remove PS1, the output is truncated otherwise. ;; We must suppress "_=VAR...". (funcall @@ -5804,13 +5961,10 @@ INPUT, if non-nil, is a string sent to the process." (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:")) (tramp-cleanup-connection (tramp-dissect-file-name dir))))) -;; Connection-local variables are enabled per default since Emacs 27.1. (ert-deftest tramp-test34-connection-local-variables () "Check that connection-local variables are enabled." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - ;; Since Emacs 27.1. - (skip-unless (macrop 'with-connection-local-variables)) (let* ((default-directory ert-remote-temporary-file-directory) (tmp-name1 (tramp--test-make-temp-name)) @@ -5819,6 +5973,8 @@ INPUT, if non-nil, is a string sent to the process." (enable-remote-dir-locals t) (inhibit-message t) kill-buffer-query-functions + (clpa connection-local-profile-alist) + (clca connection-local-criteria-alist) connection-local-profile-alist connection-local-criteria-alist) (unwind-protect (progn @@ -5867,6 +6023,9 @@ INPUT, if non-nil, is a string sent to the process." (kill-buffer (current-buffer)))) ;; Cleanup. + (custom-set-variables + `(connection-local-profile-alist ',clpa now) + `(connection-local-criteria-alist ',clca now)) (ignore-errors (delete-directory tmp-name1 'recursive))))) (ert-deftest tramp-test34-explicit-shell-file-name () @@ -5874,19 +6033,14 @@ INPUT, if non-nil, is a string sent to the process." :tags '(:expensive-test :tramp-asynchronous-processes) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) - ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for - ;; remote processes in Emacs. That doesn't work for tramp-adb.el. - (when (tramp--test-adb-p) - (skip-unless (tramp--test-emacs27-p))) (let ((default-directory ert-remote-temporary-file-directory) explicit-shell-file-name kill-buffer-query-functions + (clpa connection-local-profile-alist) + (clca connection-local-criteria-alist) connection-local-profile-alist connection-local-criteria-alist) (unwind-protect (progn - ;; `shell-mode' would ruin our test, because it deletes all - ;; buffer local variables. Not needed in Emacs 27.1. - (put 'explicit-shell-file-name 'permanent-local t) (connection-local-set-profile-variables 'remote-sh `((explicit-shell-file-name . ,(tramp--test-shell-file-name)) @@ -5915,31 +6069,29 @@ INPUT, if non-nil, is a string sent to the process." ;; Cleanup. (put 'explicit-shell-file-name 'permanent-local nil) + (custom-set-variables + `(connection-local-profile-alist ',clpa now) + `(connection-local-criteria-alist ',clca now)) (kill-buffer "*shell*")))) -;; `exec-path' was introduced in Emacs 27.1. `executable-find' has -;; changed the number of parameters, so we use `apply' for older -;; Emacsen. (ert-deftest tramp-test35-exec-path () "Check `exec-path' and `executable-find'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) (skip-unless (tramp--test-supports-set-file-modes-p)) - ;; Since Emacs 27.1. - (skip-unless (fboundp 'exec-path)) (let ((tmp-name (tramp--test-make-temp-name)) (default-directory ert-remote-temporary-file-directory)) (unwind-protect (progn - (should (consp (with-no-warnings (exec-path)))) + (should (consp (exec-path))) ;; Last element is the `exec-directory'. (should (string-equal - (car (last (with-no-warnings (exec-path)))) + (car (last (exec-path))) (file-remote-p default-directory 'localname))) ;; The shell "sh" shall always exist. - (should (apply #'executable-find '("sh" remote))) + (should (executable-find "sh" 'remote)) ;; Since the last element in `exec-path' is the current ;; directory, an executable file in that directory will be ;; found. @@ -5950,32 +6102,25 @@ INPUT, if non-nil, is a string sent to the process." (should (file-executable-p tmp-name)) (should (string-equal - (apply - #'executable-find `(,(file-name-nondirectory tmp-name) remote)) + (executable-find (file-name-nondirectory tmp-name) 'remote) (file-remote-p tmp-name 'localname))) (should-not - (apply - #'executable-find - `(,(concat (file-name-nondirectory tmp-name) "foo") remote)))) + (executable-find + (concat (file-name-nondirectory tmp-name) "foo") 'remote))) ;; Cleanup. (ignore-errors (delete-file tmp-name))))) ;; This test is inspired by Bug#33781. -;; `exec-path' was introduced in Emacs 27.1. `executable-find' has -;; changed the number of parameters, so we use `apply' for older -;; Emacsen. (ert-deftest tramp-test35-remote-path () "Check loooong `tramp-remote-path'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) - ;; Since Emacs 27.1. - (skip-unless (fboundp 'exec-path)) (let* ((tmp-name (tramp--test-make-temp-name)) (default-directory ert-remote-temporary-file-directory) - (orig-exec-path (with-no-warnings (exec-path))) + (orig-exec-path (exec-path)) (tramp-remote-path tramp-remote-path) (orig-tramp-remote-path tramp-remote-path) path) @@ -5985,20 +6130,19 @@ INPUT, if non-nil, is a string sent to the process." (setq tramp-remote-path (cons (file-remote-p tmp-name 'localname) tramp-remote-path)) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should (equal (with-no-warnings (exec-path)) orig-exec-path)) + (should (equal (exec-path) orig-exec-path)) (setq tramp-remote-path orig-tramp-remote-path) ;; Double entries are removed. (setq tramp-remote-path (append '("/" "/") tramp-remote-path)) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should - (equal (with-no-warnings (exec-path)) (cons "/" orig-exec-path))) + (should (equal (exec-path) (cons "/" orig-exec-path))) (setq tramp-remote-path orig-tramp-remote-path) ;; We make a super long `tramp-remote-path'. (make-directory tmp-name) (should (file-directory-p tmp-name)) - (while (< (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 @@ -6010,19 +6154,19 @@ INPUT, if non-nil, is a string sent to the process." `(,(file-remote-p dir 'localname)) (last orig-exec-path))))) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should (equal (with-no-warnings (exec-path)) orig-exec-path)) + (should (equal (exec-path) orig-exec-path)) ;; Ignore trailing newline. (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) ;; The shell doesn't handle such long strings. - (when (<= (length path) - (tramp-get-connection-property - tramp-test-vec "pipe-buf" 4096)) + (unless (tramp-compat-length> + path + (tramp-get-connection-property + tramp-test-vec "pipe-buf" 4096)) ;; The last element of `exec-path' is `exec-directory'. (should - (string-equal - path (mapconcat #'identity (butlast orig-exec-path) ":")))) + (string-equal path (string-join (butlast orig-exec-path) ":")))) ;; The shell "sh" shall always exist. - (should (apply #'executable-find '("sh" remote)))) + (should (executable-find "sh" 'remote))) ;; Cleanup. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) @@ -6142,7 +6286,7 @@ INPUT, if non-nil, is a string sent to the process." (string-equal (make-auto-save-file-name) (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (expand-file-name (format "#%s#" (file-name-nondirectory tmp-name1)) ert-remote-temporary-file-directory)))))) @@ -6167,7 +6311,7 @@ INPUT, if non-nil, is a string sent to the process." ("|" . "__") ("[" . "_l") ("]" . "_r")) - (tramp-compat-file-name-unquote tmp-name1))) + (file-name-unquote tmp-name1))) tmp-name2))) (should (file-directory-p tmp-name2))))) @@ -6191,7 +6335,7 @@ INPUT, if non-nil, is a string sent to the process." ("|" . "__") ("[" . "_l") ("]" . "_r")) - (tramp-compat-file-name-unquote tmp-name1))) + (file-name-unquote tmp-name1))) tmp-name2))) (should (file-directory-p tmp-name2))))) @@ -6247,7 +6391,7 @@ INPUT, if non-nil, is a string sent to the process." (find-backup-file-name tmp-name1) (list (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (expand-file-name (format "%s~" (file-name-nondirectory tmp-name1)) ert-remote-temporary-file-directory))))))) @@ -6261,7 +6405,7 @@ INPUT, if non-nil, is a string sent to the process." (find-backup-file-name tmp-name1) (list (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (expand-file-name (format "%s~" @@ -6290,7 +6434,7 @@ INPUT, if non-nil, is a string sent to the process." (find-backup-file-name tmp-name1) (list (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (expand-file-name (format "%s~" @@ -6321,7 +6465,7 @@ INPUT, if non-nil, is a string sent to the process." (find-backup-file-name tmp-name1) (list (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (expand-file-name (format "%s~" @@ -6378,7 +6522,7 @@ INPUT, if non-nil, is a string sent to the process." (skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name))) ;; `lock-file', `unlock-file', `file-locked-p' and - ;; `make-lock-file-name' exists since Emacs 28.1. We don't want to + ;; `make-lock-file-name' exist since Emacs 28.1. We don't want to ;; see compiler warnings for older Emacsen. (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) @@ -6412,11 +6556,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)))) @@ -6579,7 +6745,6 @@ INPUT, if non-nil, is a string sent to the process." (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))))) -;; The functions were introduced in Emacs 26.1. (ert-deftest tramp-test40-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless (tramp--test-enabled)) @@ -6611,12 +6776,6 @@ INPUT, if non-nil, is a string sent to the process." (delete-directory tmp-file) (should-not (file-exists-p tmp-file)))) -(defun tramp--test-emacs27-p () - "Check for Emacs version >= 27.1. -Some semantics has been changed for there, without new functions -or variables, so we check the Emacs version directly." - (>= emacs-major-version 27)) - (defun tramp--test-emacs28-p () "Check for Emacs version >= 28.1. Some semantics has been changed for there, without new functions @@ -6651,7 +6810,7 @@ This is used in tests which we don't want to tag :body nil :tags '(:tramp-asynchronous-processes)))) ;; tramp-adb.el cannot apply multi-byte commands. (not (and (tramp--test-adb-p) - (string-match-p (tramp-compat-rx multibyte) default-directory))))) + (string-match-p (rx multibyte) default-directory))))) (defun tramp--test-crypt-p () "Check, whether the remote directory is encrypted." @@ -6816,10 +6975,7 @@ This requires restrictions of file name syntax." (defun tramp--test-check-files (&rest files) "Run a simple but comprehensive test over every file in FILES." - ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted - (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) - '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, ;; because it could be located on a symlinked directory. This ;; would let the test fail. @@ -6869,7 +7025,7 @@ This requires restrictions of file name syntax." (should (string-equal (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (file-attribute-type (file-attributes file3))) (file-remote-p (file-truename file1) 'localname))) ;; Check file contents. @@ -6960,14 +7116,14 @@ This requires restrictions of file name syntax." (should (string-equal (caar (directory-files-and-attributes - file1 nil (tramp-compat-rx (literal elt1)))) + file1 nil (rx (literal elt1)))) elt1)) (should (string-equal (funcall - (if quoted #'tramp-compat-file-name-quote #'identity) + (if quoted #'file-name-quote #'identity) (cadr (car (directory-files-and-attributes - file1 nil (tramp-compat-rx (literal elt1)))))) + file1 nil (rx (literal elt1)))))) (file-remote-p (file-truename file2) 'localname))) (delete-file file3) (should-not (file-exists-p file3)))) @@ -6976,15 +7132,7 @@ This requires restrictions of file name syntax." ;; `default-directory' with special characters. See ;; Bug#53846. (when (and (tramp--test-expensive-test-p) - (tramp--test-supports-processes-p) - ;; Prior Emacs 27, `shell-file-name' was - ;; hard coded as "/bin/sh" for remote - ;; processes in Emacs. That doesn't work - ;; for tramp-adb.el. tramp-sshfs.el times - ;; out for older Emacsen, reason unknown. - (or (and (not (tramp--test-adb-p)) - (not (tramp--test-sshfs-p))) - (tramp--test-emacs27-p))) + (tramp--test-supports-processes-p)) (let ((default-directory file1)) (dolist (this-shell-command (append @@ -7022,7 +7170,7 @@ This requires restrictions of file name syntax." (goto-char (point-min)) (should (re-search-forward - (tramp-compat-rx + (rx bol (literal envvar) "=" (literal (getenv envvar)) eol)))))))) @@ -7093,7 +7241,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) @@ -7142,6 +7290,9 @@ This requires restrictions of file name syntax." ;; Use all available language specific snippets. (lambda (x) (and + ;; The "Oriya" and "Odia" languages use some problematic + ;; composition characters. + (not (member (car x) '("Oriya" "Odia"))) (stringp (setq x (eval (get-language-info (car x) 'sample-text) t))) ;; Filter out strings which use unencodable characters. (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p)) @@ -7168,23 +7319,47 @@ This requires restrictions of file name syntax." (ert-deftest tramp-test43-file-system-info () "Check that `file-system-info' returns proper values." (skip-unless (tramp--test-enabled)) - ;; Since Emacs 27.1. - (skip-unless (fboundp 'file-system-info)) - ;; `file-system-info' exists since Emacs 27.1. We don't want to see - ;; compiler warnings for older Emacsen. - (when-let ((fsi (with-no-warnings - (file-system-info ert-remote-temporary-file-directory)))) + (when-let ((fsi (file-system-info ert-remote-temporary-file-directory))) (should (consp fsi)) - (should (= (length fsi) 3)) + (should (tramp-compat-length= fsi 3)) (dotimes (i (length fsi)) (should (natnump (or (nth i fsi) 0)))))) -;; `tramp-test44-asynchronous-requests' could be blocked. So we set a +;; `file-user-uid' was introduced in Emacs 30.1. +(ert-deftest tramp-test44-file-user-uid () + "Check that `file-user-uid' and `tramp-get-remote-*' return proper values." + (skip-unless (tramp--test-enabled)) + + (let ((default-directory ert-remote-temporary-file-directory)) + ;; `file-user-uid' exists since Emacs 30.1. We don't want to see + ;; compiler warnings for older Emacsen. + (when (fboundp 'file-user-uid) + (should (integerp (with-no-warnings (file-user-uid))))) + + (with-parsed-tramp-file-name default-directory nil + (should (or (integerp (tramp-get-remote-uid v 'integer)) + (null (tramp-get-remote-uid v 'integer)))) + (should (or (stringp (tramp-get-remote-uid v 'string)) + (null (tramp-get-remote-uid v 'string)))) + + (should (or (integerp (tramp-get-remote-gid v 'integer)) + (null (tramp-get-remote-gid v 'integer)))) + (should (or (stringp (tramp-get-remote-gid v 'string)) + (null (tramp-get-remote-gid v 'string)))) + + (when-let ((groups (tramp-get-remote-groups v 'integer))) + (should (consp groups)) + (dolist (group groups) (should (integerp group)))) + (when-let ((groups (tramp-get-remote-groups v 'string))) + (should (consp groups)) + (dolist (group groups) (should (stringp group))))))) + +;; `tramp-test45-asynchronous-requests' could be blocked. So we set a ;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300 ;; seconds. Similar check is performed in the timer function. (defconst tramp--test-asynchronous-requests-timeout 300 - "Timeout for `tramp-test44-asynchronous-requests'.") + "Timeout for `tramp-test45-asynchronous-requests'.") (defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body) "Set \"process-name\" and \"process-buffer\" connection properties. @@ -7220,20 +7395,18 @@ This is needed in timer functions as well as process filters and sentinels." (tramp-flush-connection-property v "process-buffer"))))) ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test44-asynchronous-requests () +(ert-deftest tramp-test45-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." - :tags (append '(:expensive-test :tramp-asynchronous-processes) - (and (or (getenv "EMACS_HYDRA_CI") - (getenv "EMACS_EMBA_CI")) - '(:unstable))) + ;; :tags (append '(:expensive-test :tramp-asynchronous-processes) + ;; (and (or (getenv "EMACS_HYDRA_CI") + ;; (getenv "EMACS_EMBA_CI")) + ;; '(:unstable))) + ;; It doesn't work sufficiently. + :tags '(:expensive-test :tramp-asynchronous-processes :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) - ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for - ;; remote processes in Emacs. That doesn't work for tramp-adb.el. - (when (tramp--test-adb-p) - (skip-unless (tramp--test-emacs27-p))) (skip-unless (not (tramp--test-container-p))) (skip-unless (not (tramp--test-telnet-p))) (skip-unless (not (tramp--test-sshfs-p))) @@ -7391,7 +7564,7 @@ process sentinels. They shall not disturb each other." (unless (process-live-p proc) (setq buffers (delq buf buffers)))))) - ;; Checks. All process output shall exists in the + ;; Checks. All process output shall exist in the ;; respective buffers. All created files shall be ;; deleted. (tramp--test-message "Check %s" (current-time-string)) @@ -7417,10 +7590,10 @@ process sentinels. They shall not disturb each other." (ignore-errors (cancel-timer timer)) (ignore-errors (delete-directory tmp-name 'recursive)))))) -;; (tramp--test-deftest-direct-async-process tramp-test44-asynchronous-requests +;; (tramp--test-deftest-direct-async-process tramp-test45-asynchronous-requests ;; 'unstable) -(ert-deftest tramp-test45-dired-compress-file () +(ert-deftest tramp-test46-dired-compress-file () "Check that Tramp (un)compresses normal files." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) @@ -7441,7 +7614,7 @@ process sentinels. They shall not disturb each other." (should (string= tmp-name (dired-get-filename))) (delete-file tmp-name))) -(ert-deftest tramp-test45-dired-compress-dir () +(ert-deftest tramp-test46-dired-compress-dir () "Check that Tramp (un)compresses directories." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) @@ -7463,7 +7636,7 @@ process sentinels. They shall not disturb each other." (delete-directory tmp-name) (delete-file (concat tmp-name ".tar.gz")))) -(ert-deftest tramp-test46-read-password () +(ert-deftest tramp-test47-read-password () "Check Tramp password handling." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -7523,7 +7696,7 @@ process sentinels. They shall not disturb each other." (should (file-exists-p ert-remote-temporary-file-directory))))))))) ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test47-auto-load () +(ert-deftest tramp-test48-auto-load () "Check that Tramp autoloads properly." ;; If we use another syntax but `default', Tramp is already loaded ;; due to the `tramp-change-syntax' call. @@ -7539,7 +7712,7 @@ process sentinels. They shall not disturb each other." ert-remote-temporary-file-directory))) (should (string-match-p - (rx "Tramp loaded: t" (+ (any "\n\r"))) + (rx "Tramp loaded: t" (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7548,7 +7721,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test47-delay-load () +(ert-deftest tramp-test48-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; Tramp is neither loaded at Emacs startup, nor when completing a ;; non-Tramp file name like "/foo". Completing a Tramp-alike file @@ -7566,10 +7739,10 @@ process sentinels. They shall not disturb each other." (dolist (tm '(t nil)) (should (string-match-p - (tramp-compat-rx - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r"))) + (rx + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7578,7 +7751,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test47-recursive-load () +(ert-deftest tramp-test48-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -7602,7 +7775,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test47-remote-load-path () +(ert-deftest tramp-test48-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the @@ -7614,7 +7787,7 @@ process sentinels. They shall not disturb each other." (tramp-cleanup-all-connections))")) (should (string-match-p - (tramp-compat-rx + (rx "Loading " (literal (expand-file-name @@ -7627,7 +7800,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test48-unload () +(ert-deftest tramp-test49-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@ -7665,6 +7838,8 @@ Since it unloads Tramp, it shall be the last test to run." ;; `tramp-register-archive-file-name-handler' is autoloaded ;; in Emacs < 29.1. (not (eq 'tramp-register-archive-file-name-handler x)) + ;; `tramp-compat-rx' is autoloaded in Emacs 29.1. + (not (eq 'tramp-compat-rx x)) (not (string-match-p (rx bol "tramp" (? "-archive") (** 1 2 "-") "test") (symbol-name x))) @@ -7726,19 +7901,19 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * file-name-case-insensitive-p ;; * memory-info ;; * tramp-get-home-directory -;; * tramp-get-remote-gid -;; * tramp-get-remote-groups -;; * tramp-get-remote-uid ;; * tramp-set-file-uid-gid ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". +;; * Check, why a process filter t doesn't work in +;; `tramp-test29-start-file-process' and +;; `tramp-test30-make-process'. ;; * Implement `tramp-test31-interrupt-process' and ;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct ;; async processes. Check, why they don't run stable. ;; * Check, why direct async processes do not work for -;; `tramp-test44-asynchronous-requests'. +;; `tramp-test45-asynchronous-requests'. (provide 'tramp-tests) diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el new file mode 100644 index 00000000000..1f475665298 --- /dev/null +++ b/test/lisp/proced-tests.el @@ -0,0 +1,122 @@ +;;; proced-tests.el --- Test suite for proced.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: +(require 'ert) +(require 'proced) +(require 'thingatpt) + +(cl-defmacro proced--within-buffer (format filter &body body) + "Execute BODY within a proced buffer using format FORMAT and filter FILTER." + `(let ((proced-format ,format) + (proced-filter ,filter) + (proced-auto-update-flag nil) + (inhibit-message t)) + (proced) + (unwind-protect + (with-current-buffer "*Proced*" + ,@body) + (kill-buffer "*Proced*")))) + +(defun proced--assert-emacs-pid-in-buffer () + "Fail unless the process ID of the current Emacs process exists in buffer." + (should (string-match-p + (number-to-string (emacs-pid)) + (buffer-substring-no-properties (point-min) (point-max))))) + +(defun proced--move-to-column (attribute) + "Move to the column under ATTRIBUTE in the current proced buffer." + (move-to-column (string-match attribute proced-header-line))) + +(ert-deftest proced-format-test () + (dolist (format '(short medium long verbose)) + (proced--within-buffer + format + 'user + (proced--assert-emacs-pid-in-buffer)))) + +(ert-deftest proced-update-test () + (proced--within-buffer + 'short + 'user + (proced-update) + (proced--assert-emacs-pid-in-buffer))) + +(ert-deftest proced-revert-test () + (proced--within-buffer + 'short + 'user + (proced-revert) + (proced--assert-emacs-pid-in-buffer))) + +(ert-deftest proced-color-test () + (let ((proced-enable-color-flag t)) + (proced--within-buffer + 'short + 'user + (proced--assert-emacs-pid-in-buffer)))) + +(ert-deftest proced-refine-test () + ;;(skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) + (proced--within-buffer + 'medium + 'user + ;; When refining on PID for process A, a process is kept if and only + ;; if its PID are the same as process A, which more or less guarentees + ;; the refinement will remove some processes. + (proced--move-to-column "PID") + (let ((pid (word-at-point))) + (proced-refine) + (while (not (eobp)) + (proced--move-to-column "PID") + (should (string= pid (word-at-point))) + (forward-line))))) + +(ert-deftest proced-refine-with-update-test () + (proced--within-buffer + 'medium + 'user + (proced--move-to-column "PID") + (let ((pid (word-at-point))) + (proced-refine) + (proced-update t) + (while (not (eobp)) + (proced--move-to-column "PID") + (should (string= pid (word-at-point))) + (forward-line))))) + +(ert-deftest proced-update-preserves-pid-at-point-test () + (proced--within-buffer + 'medium + 'user + (goto-char (point-min)) + (search-forward (number-to-string (emacs-pid))) + (proced--move-to-column "PID") + (save-window-excursion + (let ((pid (proced-pid-at-point)) + (new-window (split-window)) + (old-window (get-buffer-window))) + (select-window new-window) + (with-current-buffer "*Proced*" + (proced-update t t)) + (select-window old-window) + (should (= pid (proced-pid-at-point))))))) + +(provide 'proced-tests) +;;; proced-tests.el ends here 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 07698077ffc..74e34fe821b 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts @@ -1,9 +1,9 @@ Code: (lambda () - (setq indent-tabs-mode nil) - (setq c-ts-mode-indent-offset 2) - (setq c-ts-mode-indent-style 'bsd) (c-ts-mode) + (setq-local indent-tabs-mode nil) + (setq-local c-ts-mode-indent-offset 2) + (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 b8524432d02..9e28ef203fd 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -1,9 +1,9 @@ Code: (lambda () - (setq indent-tabs-mode nil) - (setq c-ts-mode-indent-offset 2) - (setq c-ts-mode-indent-style 'gnu) (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))) Point-Char: | @@ -84,14 +84,6 @@ int main() } =-=-= -Name: Empty Line -=-= -int main() -{ - | -} -=-=-= - Name: Concecutive blocks (GNU Style) (bug#60873) =-= @@ -105,6 +97,36 @@ main (int argc, } =-=-= +Name: Bracket-less Block-Statement (GNU Style) (bug#61026) + +=-= +int main() { + while (true) + if (true) + { + puts ("Hello"); + } + for (int i=0; + i<5; + i++) + if (true) + { + puts ("Hello"); + } + do + if (true) + { + puts ("Hello"); + } + while (true); + if (true) + if (true) + { + puts ("Hello"); + } +} +=-=-= + Name: Multiline Parameter List (bug#60398) =-= @@ -114,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) =-= @@ -160,13 +234,28 @@ line 2 */ =-=-= +Name: Block Comment prefixes (Bug#61314) + +=-=-= +/* +- item1 +- item2 +- item3 +*/ +=-=-= +/* + - item1 + - item2 + - item3 + */ +=-=-= Code: (lambda () - (setq indent-tabs-mode nil) - (setq c-ts-mode-indent-offset 8) - (setq c-ts-mode-indent-style 'linux) (c-ts-mode) + (setq-local indent-tabs-mode nil) + (setq-local c-ts-mode-indent-offset 8) + (c-ts-mode-set-style 'linux) (indent-region (point-min) (point-max))) Name: Labels (Linux Style) @@ -188,3 +277,160 @@ label: } } =-=-= + +Name: Bracket-less Block-Statement (Linux Style) (bug#61026) + +=-=-= +int main() { + while (true) + if (true) { + puts ("Hello"); + } + for (int i=0; + i<5; + i++) + if (true) { + puts ("Hello"); + } + do + if (true) { + puts ("Hello"); + } + while (true); + if (true) + if (true) { + puts ("Hello"); + } +} +=-=-= + +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..7ac26732737 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -31,23 +31,20 @@ ;; Some of these tests rely on the GNU ELPA package company.el and ;; yasnippet.el being available. -;; Some of the tests require access to a remote host files. Since -;; this could be problematic, a mock-up connection method "mock" is -;; used. Emulating a remote connection, it simply calls "sh -i". -;; Tramp's file name handlers still run, so this test is sufficient -;; except for connection establishing. - -;; If you want to test a real Tramp connection, set -;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to -;; overwrite the default value. If you want to skip tests accessing a -;; remote host, set this environment variable to "/dev/null" or -;; whatever is appropriate on your system. +;; Some of the tests require access to a remote host files, which is +;; mocked in the simplest case. If you want to test a real Tramp +;; connection, override $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable +;; value (FIXME: like what?) in order to overwrite the default value. +;; +;; IMPORTANT: Since Eglot is a :core ELPA package, these tests are + ;;supposed to run on Emacsen down to 26.3. Do not use bleeding-edge + ;;functionality not compatible with that Emacs version. ;;; Code: (require 'eglot) (require 'cl-lib) (require 'ert) -(require 'tramp) ; must be prior ert-x +(require 'tramp) (require 'ert-x) ; ert-simulate-command (require 'edebug) (require 'python) ; some tests use pylsp @@ -59,6 +56,11 @@ ;;; Helpers +(defun eglot--test-message (format &rest args) + "Message out with FORMAT with ARGS." + (message "[eglot-tests] %s" + (apply #'format format args))) + (defmacro eglot--with-fixture (fixture &rest body) "Setup FIXTURE, call BODY, teardown FIXTURE. FIXTURE is a list. Its elements are of the form (FILE . CONTENT) @@ -102,23 +104,23 @@ then restored." (push (cons (car spec) (symbol-value (car spec))) syms-to-restore) (set (car spec) (cadr spec))) ((stringp (car spec)) (push spec file-specs)))) + (eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test))) (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) @@ -127,8 +129,8 @@ then restored." (setq created-files (mapcan #'eglot--make-file-or-dir file-specs)) (prog1 (funcall fn) (setq test-body-successful-p t))) - (eglot--message - "Test body was %s" (if test-body-successful-p "OK" "A FAILURE")) + (eglot--test-message "[%s]: %s" (ert-test-name (ert-running-test)) + (if test-body-successful-p "OK" "FAILED")) (unwind-protect (let ((eglot-autoreconnect nil)) (dolist (server new-servers) @@ -137,8 +139,7 @@ then restored." (eglot-shutdown server nil 3 (not test-body-successful-p)) (error - (eglot--message "Non-critical shutdown error after test: %S" - oops)))) + (eglot--test-message "Non-critical cleanup error: %S" oops)))) (when (not test-body-successful-p) ;; We want to do this after the sockets have ;; shut down such that any pending data has been @@ -151,21 +152,21 @@ then restored." (jsonrpc-events-buffer server))))) (cond (noninteractive (dolist (buffer buffers) - (eglot--message "%s:" (buffer-name buffer)) + (eglot--test-message "contents of `%s':" (buffer-name buffer)) (princ (with-current-buffer buffer (buffer-string)) 'external-debugging-output))) (t - (eglot--message "Preserved for inspection: %s" - (mapconcat #'buffer-name buffers ", ")))))))) + (eglot--test-message "Preserved for inspection: %s" + (mapconcat #'buffer-name buffers ", ")))))))) (eglot--cleanup-after-test fixture-directory created-files syms-to-restore))))) (defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore) (let ((buffers-to-delete (delete nil (mapcar #'find-buffer-visiting created-files)))) - (eglot--message "Killing %s, wiping %s, restoring %s" - buffers-to-delete - fixture-directory - (mapcar #'car syms-to-restore)) + (eglot--test-message "Killing %s, wiping %s, restoring %s" + buffers-to-delete + fixture-directory + (mapcar #'car syms-to-restore)) (cl-loop for (sym . val) in syms-to-restore do (set sym val)) (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted @@ -253,12 +254,12 @@ then restored." (advice-remove #'jsonrpc--log-event ',log-event-ad-sym)))) (cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args &body body) - "Spin until FN match in EVENTS-SYM, flush events after it. -Pass TIMEOUT to `eglot--with-timeout'." (declare (indent 2) (debug (sexp sexp sexp &rest form))) `(eglot--with-timeout '(,timeout ,(or message (format "waiting for:\n%s" (pp-to-string body)))) - (let ((event + (eglot--test-message "waiting for `%s'" (with-output-to-string + (mapc #'princ ',body))) + (let ((events (cl-loop thereis (cl-loop for json in ,events-sym for method = (plist-get json :method) when (keywordp method) @@ -272,16 +273,21 @@ Pass TIMEOUT to `eglot--with-timeout'." collect json into before) for i from 0 when (zerop (mod i 5)) - ;; do (eglot--message "still struggling to find in %s" - ;; ,events-sym) + ;; do (eglot--test-message "still struggling to find in %s" + ;; ,events-sym) do ;; `read-event' is essential to have the file ;; watchers come through. - (read-event "[eglot] Waiting a bit..." nil 0.1) + (cond ((fboundp 'flush-standard-output) + (read-event nil nil 0.1) (princ ".") + (flush-standard-output)) + (t + (read-event "." nil 0.1))) (accept-process-output nil 0.1)))) - (setq ,events-sym (cdr event)) - (eglot--message "Event detected:\n%s" - (pp-to-string (car event)))))) + (setq ,events-sym (cdr events)) + (cl-destructuring-bind (&key method id &allow-other-keys) (car events) + (eglot--test-message "detected: %s" + (or method (and id (format "id=%s" id)))))))) ;; `rust-mode' is not a part of Emacs, so we define these two shims ;; which should be more than enough for testing. @@ -408,7 +414,7 @@ Pass TIMEOUT to `eglot--with-timeout'." ) (should (eglot--tests-connect)) (let (register-id) - (eglot--wait-for (s-requests 1) + (eglot--wait-for (s-requests 3) (&key id method &allow-other-keys) (setq register-id id) (string= method "client/registerCapability")) @@ -435,7 +441,7 @@ Pass TIMEOUT to `eglot--with-timeout'." (eglot--find-file-noselect "diag-project/main.c") (eglot--sniffing (:server-notifications s-notifs) (eglot--tests-connect) - (eglot--wait-for (s-notifs 2) + (eglot--wait-for (s-notifs 10) (&key _id method &allow-other-keys) (string= method "textDocument/publishDiagnostics")) (flymake-start) @@ -445,16 +451,19 @@ Pass TIMEOUT to `eglot--with-timeout'." (ert-deftest eglot-test-diagnostic-tags-unnecessary-code () "Test rendering of diagnostics tagged \"unnecessary\"." - (skip-unless (executable-find "rust-analyzer")) - (skip-unless (executable-find "cargo")) + (skip-unless (executable-find "clangd")) (eglot--with-fixture - '(("diagnostic-tag-project" . - (("main.rs" . - "fn main() -> () { let test=3; }")))) + `(("diag-project" . + (("main.cpp" . "int main(){float a = 42.2; return 0;}")))) (with-current-buffer - (eglot--find-file-noselect "diagnostic-tag-project/main.rs") - (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) - (should (zerop (shell-command "cargo init"))) + (eglot--find-file-noselect "diag-project/main.cpp") + (eglot--make-file-or-dir '(".git")) + (eglot--make-file-or-dir + `("compile_commands.json" . + ,(jsonrpc--json-encode + `[(:directory ,default-directory :command "/usr/bin/c++ -Wall -c main.cpp" + :file ,(expand-file-name "main.cpp"))]))) + (let ((eglot-server-programs '((c++-mode . ("clangd"))))) (eglot--sniffing (:server-notifications s-notifs) (eglot--tests-connect) (eglot--wait-for (s-notifs 10) @@ -732,7 +741,7 @@ pylsp prefers autopep over yafp, despite its README stating the contrary." (should (zerop (shell-command "cargo init"))) (eglot--sniffing (:server-notifications s-notifs) (should (eglot--tests-connect)) - (eglot--wait-for (s-notifs 10) (&key method &allow-other-keys) + (eglot--wait-for (s-notifs 20) (&key method &allow-other-keys) (string= method "textDocument/publishDiagnostics"))) (goto-char (point-max)) (eglot--simulate-key-event ?.) @@ -798,33 +807,35 @@ pylsp prefers autopep over yafp, despite its README stating the contrary." (should (= 4 (length (flymake--project-diagnostics)))))))))) (ert-deftest eglot-test-project-wide-diagnostics-rust-analyzer () - "Test diagnostics through multiple files in a TypeScript LSP." + "Test diagnostics through multiple files in rust-analyzer." (skip-unless (executable-find "rust-analyzer")) (skip-unless (executable-find "cargo")) + (skip-unless (executable-find "git")) (eglot--with-fixture '(("project" . (("main.rs" . - "fn main() -> () { let test=3; }") + "fn main() -> i32 { return 42.2;}") ("other-file.rs" . "fn foo() -> () { let hi=3; }")))) - (eglot--make-file-or-dir '(".git")) (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) - ;; Open other-file, and see diagnostics arrive for main.rs + ;; Open other-file.rs, and see diagnostics arrive for main.rs, + ;; which we didn't open. (with-current-buffer (eglot--find-file-noselect "project/other-file.rs") + (should (zerop (shell-command "git init"))) (should (zerop (shell-command "cargo init"))) (eglot--sniffing (:server-notifications s-notifs) (eglot--tests-connect) (flymake-start) - (eglot--wait-for (s-notifs 10) - (&key _id method &allow-other-keys) - (string= method "textDocument/publishDiagnostics")) - (let ((diags (flymake--project-diagnostics))) - (should (= 2 (length diags))) - ;; Check that we really get a diagnostic from main.rs, and - ;; not from other-file.rs - (should (string-suffix-p - "main.rs" - (flymake-diagnostic-buffer (car diags)))))))))) + (eglot--wait-for (s-notifs 20) + (&key _id method params &allow-other-keys) + (and (string= method "textDocument/publishDiagnostics") + (string-suffix-p "main.rs" (plist-get params :uri)))) + (let* ((diags (flymake--project-diagnostics))) + (should (cl-some (lambda (diag) + (let ((locus (flymake-diagnostic-buffer diag))) + (and (stringp (flymake-diagnostic-buffer diag)) + (string-suffix-p "main.rs" locus)))) + diags)))))))) (ert-deftest eglot-test-json-basic () "Test basic autocompletion in vscode-json-languageserver." @@ -856,8 +867,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 +877,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)) @@ -1258,16 +1269,28 @@ macro will assume it exists." (defvar tramp-histfile-override) (defun eglot--call-with-tramp-test (fn) + (unless (>= emacs-major-version 27) + (ert-skip "Eglot Tramp support only on Emacs >= 27")) ;; Set up a Tramp method that’s just a shell so the remote host is ;; really just the local host. - (let* ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path)) + (let* ((tramp-remote-path (cons 'tramp-own-remote-path + tramp-remote-path)) (tramp-histfile-override t) (tramp-verbose 1) - (temporary-file-directory ert-remote-temporary-file-directory) + (temporary-file-directory + (or (bound-and-true-p ert-remote-temporary-file-directory) + (prog1 (format "/mock::%s" temporary-file-directory) + (add-to-list + 'tramp-methods + '("mock" + (tramp-login-program "sh") (tramp-login-args (("-i"))) + (tramp-direct-async ("-c")) (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10))) + (add-to-list 'tramp-default-host-alist + `("\\`mock\\'" nil ,(system-name))) + (when (and noninteractive (not (file-directory-p "~/"))) + (setenv "HOME" temporary-file-directory))))) (default-directory temporary-file-directory)) - ;; We must check the remote LSP server. So far, just "clangd" is used. - (unless (executable-find "clangd" 'remote) - (ert-skip "Remote clangd not found")) (funcall fn))) (ert-deftest eglot-test-tramp-test () 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 @@ -1004,6 +1004,11 @@ evaluation of BODY." (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" "(boundp '{p3}gamma)\n" diff --git a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..748455cc3f2 --- /dev/null +++ b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts @@ -0,0 +1,308 @@ +Code: + (lambda () + (setq indent-tabs-mode nil) + (elixir-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: $ + +Name: Basic modules + +=-= + defmodule Foobar do +def bar() do +"one" + end + end +=-= +defmodule Foobar do + def bar() do + "one" + end +end +=-=-= + +Name: Map + +=-= +map = %{ + "a" => 1, + "b" => 2 +} +=-=-= + +Name: Map in function def + +=-= +def foobar() do + %{ + one: "one", + two: "two", + three: "three", + four: "four" + } +end +=-=-= + +Name: Map in tuple + +=-= +def foo() do + {:ok, + %{ + state + | extra_arguments: extra_arguments, + max_children: max_children, + max_restarts: max_restarts, + max_seconds: max_seconds, + strategy: strategy + }} +end +=-=-= + +Name: Nested maps + +=-= +%{ + foo: "bar", + bar: %{ + foo: "bar" + } +} + +def foo() do + %{ + foo: "bar", + bar: %{ + foo: "bar" + } + } +end +=-=-= + +Name: Block assignments + +=-= +foo = + if true do + "yes" + else + "no" + end +=-=-= + +Name: Function rescue + +=-= +def foo do + "bar" +rescue + e -> + "bar" +end +=-=-= + +Name: With statement +=-= +with one <- one(), + two <- two(), + {:ok, value} <- get_value(one, two) do + {:ok, value} +else + {:error, %{"Message" => message}} -> + {:error, message} +end +=-=-= + +Name: Pipe statements with fn + +=-= +[1, 2] +|> Enum.map(fn num -> + num + 1 +end) +=-=-= + +Name: Pipe statements stab clases + +=-= +[1, 2] +|> Enum.map(fn + x when x < 10 -> x * 2 + x -> x * 3 +end) +=-=-= + +Name: Pipe statements params + +=-= +[1, 2] +|> foobar( + :one, + :two, + :three, + :four +) +=-=-= + +Name: Parameter maps + +=-= +def something(%{ + one: :one, + two: :two + }) do + {:ok, "done"} +end +=-=-= + +Name: Binary operator in else block + +=-= +defp foobar() do + if false do + :foo + else + :bar |> foo + end +end +=-=-= + +Name: Tuple indentation + +=-= +tuple = { + :one, + :two +} + +{ + :one, + :two +} +=-=-= + +Name: Spec and method + +=-= +@spec foobar( + t, + acc, + (one, something -> :bar | far), + (two -> :bar | far) + ) :: any() + when chunk: any +def foobar(enumerable, acc, chunk_fun, after_fun) do + {_, {res, acc}} = + case after_fun.(acc) do + {:one, "one"} -> + "one" + + {:two, "two"} -> + "two" + end +end +=-=-= + +Name: Spec with multi-line result + +=-= +@type result :: + {:done, term} + | {:two} + | {:one} + +@type result :: + { + :done, + term + } + | {:two} + | {:one} + +@type boo_bar :: + (foo :: pos_integer, bar :: pos_integer -> any()) + +@spec foo_bar( + t, + (foo -> any), + (() -> any) | (foo, foo -> boolean) | module() + ) :: any + when foo: any +def foo(one, fun, other) +=-=-= + +Name: String concatenation in call + +=-= +IO.warn( + "one" <> + "two" <> + "bar" +) + +IO.warn( + "foo" <> + "bar" +) +=-=-= + +Name: Incomplete tuple + +=-= +map = { +:foo + +=-= +map = { + :foo + +=-=-= + +Name: Incomplete map + +=-= +map = %{ + "a" => "a", +=-=-= + +Name: Incomplete list + +=-= +map = [ +:foo + +=-= +map = [ + :foo + +=-=-= + +Name: String concatenation + +=-= +"one" <> + "two" <> + "three" <> + "four" +=-=-= + +Name: Tuple with same line first node + +=-= +{:one, + :two} + +{:ok, + fn one -> + one + |> String.upcase(one) + end} +=-=-= + +Name: Long tuple + +=-= +{"January", "February", "March", "April", "May", "June", "July", "August", "September", + "October", "November", "December"} +=-=-= diff --git a/test/lisp/progmodes/elixir-ts-mode-tests.el b/test/lisp/progmodes/elixir-ts-mode-tests.el new file mode 100644 index 00000000000..488fc1b646f --- /dev/null +++ b/test/lisp/progmodes/elixir-ts-mode-tests.el @@ -0,0 +1,31 @@ +;;; elixir-ts-mode-tests.el --- Tests for elixir-ts-mode -*- 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/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'treesit) + +(ert-deftest elixir-ts-mode-test-indentation () + (skip-unless (and (treesit-ready-p 'elixir) (treesit-ready-p 'heex))) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'elixir-ts-mode-tests) +;;; elixir-ts-mode-tests.el ends here 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/progmodes/go-ts-mode-tests.el b/test/lisp/progmodes/go-ts-mode-tests.el new file mode 100644 index 00000000000..548465208f9 --- /dev/null +++ b/test/lisp/progmodes/go-ts-mode-tests.el @@ -0,0 +1,31 @@ +;;; go-ts-mode-tests.el --- Tests for Tree-sitter-based Go mode -*- 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/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'treesit) + +(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/heex-ts-mode-resources/indent.erts b/test/lisp/progmodes/heex-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..500ddb2b536 --- /dev/null +++ b/test/lisp/progmodes/heex-ts-mode-resources/indent.erts @@ -0,0 +1,47 @@ +Code: + (lambda () + (setq indent-tabs-mode nil) + (heex-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: $ + +Name: Tag + +=-= + <div> + div + </div> +=-= +<div> + div +</div> +=-=-= + +Name: Component + +=-= + <Foo> + foobar + </Foo> +=-= +<Foo> + foobar +</Foo> +=-=-= + +Name: Slots + +=-= + <Foo> + <:bar> + foobar + </:bar> + </Foo> +=-= +<Foo> + <:bar> + foobar + </:bar> +</Foo> +=-=-= diff --git a/test/lisp/progmodes/heex-ts-mode-tests.el b/test/lisp/progmodes/heex-ts-mode-tests.el new file mode 100644 index 00000000000..def6d845de9 --- /dev/null +++ b/test/lisp/progmodes/heex-ts-mode-tests.el @@ -0,0 +1,31 @@ +;;; heex-ts-mode-tests.el --- Tests for heex-ts-mode -*- 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/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'treesit) + +(ert-deftest heex-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'heex)) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'heex-ts-mode-tests) +;;; heex-ts-mode-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 new file mode 100644 index 00000000000..4fca74dd2e1 --- /dev/null +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -0,0 +1,112 @@ +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq java-ts-mode-indent-offset 4) + (java-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Basic + +=-= +public class Basic { + public void basic() { + return; + } +} +=-=-= + +Name: Empty Line + +=-= +public class EmptyLine { + public void emptyLine() { + | + } +} +=-=-= + +Name: Statements + +=-= +if (x) { + for (var foo : foos) { + | + } +} else if (y) { + for (int i = 0; x < foos.size(); i++) { + return; + } +} else { + return; +} +=-=-= + +Name: Field declaration without access modifier (bug#61115) + +=-= +public class T { + @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/java-ts-mode-resources/movement.erts b/test/lisp/progmodes/java-ts-mode-resources/movement.erts new file mode 100644 index 00000000000..23639b1f5ff --- /dev/null +++ b/test/lisp/progmodes/java-ts-mode-resources/movement.erts @@ -0,0 +1,154 @@ +Code: + (lambda () + (java-ts-mode) + (forward-sentence 1)) + +Point-Char: | + +Name: forward-sentence moves over if + +=-= +public class Basic { + public void basic() { + |if (x) { + + } + log.info("some text: {}", text); + return; + } +} +=-= +public class Basic { + public void basic() { + if (x) { + + }| + log.info("some text: {}", text); + return; + } +} +=-=-= + +Name: forward-sentence moves over method invocation + +=-= +public class Basic { + public void basic() { + |log.info("some text: {}", text); + } +} +=-= +public class Basic { + public void basic() { + log.info("some text: {}", text);| + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (forward-sentence 2)) + +Name: forward-sentence moves over multiple statements + +=-= +public class Basic { + public void basic() { + |return; + return; + } +} +=-= +public class Basic { + public void basic() { + return; + return;| + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (backward-sentence 1)) + +Name: backward-sentence moves over one statement + +=-= +public class Basic { + public void basic() { + return;| + } +} +=-= +public class Basic { + public void basic() { + |return; + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (beginning-of-defun)) + +Name: beginning-of-defun moves to defun start + +=-= +public class Basic { + public void basic() { + return;| + } +} +=-= +public class Basic { +| public void basic() { + return; + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (beginning-of-defun) + (beginning-of-defun)) + +Name: beginning-of-defun moves to class + +=-= +public class Basic { + public void basic() { + return;| + } +} +=-= +|public class Basic { + public void basic() { + return; + } +} +=-=-= + +Code: + (lambda () + (java-ts-mode) + (end-of-defun)) + +Name: end-of-defun moves to defun end + +=-= +public class Basic { + public void basic() { + return;| + } +} +=-= +public class Basic { + public void basic() { + return; + } +|} +=-=-= diff --git a/test/lisp/progmodes/java-ts-mode-tests.el b/test/lisp/progmodes/java-ts-mode-tests.el new file mode 100644 index 00000000000..4fd8fc3019f --- /dev/null +++ b/test/lisp/progmodes/java-ts-mode-tests.el @@ -0,0 +1,35 @@ +;;; java-ts-mode-tests.el --- Tests for Tree-sitter-based Java mode -*- 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/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'treesit) + +(ert-deftest java-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'java)) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(ert-deftest java-ts-mode-test-movement () + (skip-unless (treesit-ready-p 'java)) + (ert-test-erts-file (ert-resource-file "movement.erts"))) + +(provide 'java-ts-mode-tests) +;;; java-ts-mode-tests.el ends here diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index aea0666629d..5a206b67db1 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -152,4 +152,14 @@ When `project-ignores' includes a name matching project dir." (should (equal '(".dir-locals.el" "foo") (mapcar #'file-name-nondirectory (project-files project)))))) +(ert-deftest project-vc-nonexistent-directory-no-error () + "Check that is doesn't error out when the current dir does not exist." + (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) + (let* ((dir (expand-file-name "foo-456/bar/" (ert-resource-directory))) + (_ (vc-file-clearprops dir)) + (project-vc-extra-root-markers '(".dir-locals.el")) + (project (project-current nil dir))) + (should-not (null project)) + (should (string-match-p "/test/lisp/progmodes/project-resources/\\'" (project-root project))))) + ;;; project-tests.el ends here diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index df71990278e..ed4a08da6ab 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'. @@ -247,6 +255,27 @@ aliqua." ;;; Font-lock and syntax +(ert-deftest python-syntax-context-1 () + (python-tests-with-temp-buffer + " +# Comment +s = 'Single Quoted String' +t = '''Triple Quoted String''' +p = (1 + 2) +" + (python-tests-look-at "Comment") + (should (= (python-syntax-context 'comment) (pos-bol))) + (python-tests-look-at "Single") + (should (= (python-syntax-context 'string) (1- (point)))) + (should (= (python-syntax-context 'single-quoted-string) (1- (point)))) + (should-not (python-syntax-context 'triple-quoted-string)) + (python-tests-look-at "Triple") + (should (= (python-syntax-context 'string) (1- (point)))) + (should-not (python-syntax-context 'single-quoted-string)) + (should (= (python-syntax-context 'triple-quoted-string) (1- (point)))) + (python-tests-look-at "1 + 2") + (should (= (python-syntax-context 'paren) (1- (point)))))) + (ert-deftest python-syntax-after-python-backspace () ;; `python-indent-dedent-line-backspace' garbles syntax (python-tests-with-temp-buffer @@ -1650,6 +1679,21 @@ a == 4): (python-indent-line t) (should (= (python-indent-calculate-indentation t) 6)))) +(ert-deftest python-indent-dedenters-9 () + "Test de-indentation for the case keyword." + (python-tests-with-temp-buffer + " +match a: + case 1: + print(1) + case 2 +" + (python-tests-look-at "case 2") + (should (eq (car (python-indent-context)) :at-dedenter-block-start)) + (should (= (python-indent-calculate-indentation) 4)) + (python-indent-line t) + (should (= (python-indent-calculate-indentation t) 4)))) + (ert-deftest python-indent-inside-string-1 () "Test indentation for strings." (python-tests-with-temp-buffer @@ -1974,6 +2018,32 @@ match foo: (should (eq (car (python-indent-context)) :after-block-start)) (should (= (python-indent-calculate-indentation) 8)))) +(ert-deftest python-indent-after-re-match () + "Test BUG 62031 regression." + (python-tests-with-temp-buffer + " +def test_re(string): + if re.match('^[a-c]+$', string): + print('yes') + else: + " + (python-tests-look-at "else:") + (should (= (python-indent-calculate-indentation) 4)))) + +(ert-deftest python-indent-after-bare-match () + "Test BUG 62031 regression." + (python-tests-with-temp-buffer + " +from re import match + +def test_re(string): + if match('^[a-c]+$', string): + print('yes') + else: + " + (python-tests-look-at "else:") + (should (= (python-indent-calculate-indentation) 4)))) + ;;; Filling @@ -2003,6 +2073,54 @@ this is a test this is a test this is a test this is a test this is a test this (fill-paragraph) (should (= (current-indentation) 0)))) +(ert-deftest python-fill-paragraph-single-quoted-string-1 () + "Single quoted string should not be filled." + (let ((contents " +s = 'abc def ghi jkl mno pqr stu vwx yz' +") + (fill-column 20)) + (python-tests-with-temp-buffer + contents + (python-tests-look-at "abc") + (fill-paragraph) + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + contents))))) + +(ert-deftest python-fill-paragraph-single-quoted-string-2 () + "Ensure no fill is performed after the end of the single quoted string." + (let ((contents " +s1 = 'abc' +s2 = 'def' +")) + (python-tests-with-temp-buffer + contents + (python-tests-look-at "abc") + (fill-paragraph) + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + contents))))) + +(ert-deftest python-fill-paragraph-triple-quoted-string-1 () + "Triple quoted string should be filled." + (let ((contents " +s = '''abc def ghi jkl mno pqr stu vwx yz''' +") + (expected " +s = '''abc def ghi +jkl mno pqr stu vwx +yz''' +") + (fill-column 20)) + (dolist (look-at '("'''abc" "z'''")) + (dolist (offset '(0 1 2 3)) + (python-tests-with-temp-buffer + contents + (python-tests-look-at look-at) + (forward-char offset) + (fill-paragraph) + (should (string= + (buffer-substring-no-properties (point-min) (point-max)) + expected))))))) + ;;; Mark @@ -2935,6 +3053,36 @@ string "'\n''\n" (python-nav-end-of-statement))) +(ert-deftest python-nav-end-of-statement-3 () + "Test unmatched quotes (Bug#58780)." + (python-tests-with-temp-buffer + " +' \"\"\" +v = 1 +" + (python-tests-look-at "v =") + (should (= (save-excursion + (python-nav-end-of-statement) + (point)) + (save-excursion + (point-max)))))) + +(ert-deftest python-nav-end-of-statement-4 () + (python-tests-with-temp-buffer + " +abc = 'a\\ +b\\ +c' +d = '''d''' +" + (python-tests-look-at "b\\") + (should (= (save-excursion + (python-nav-end-of-statement) + (point)) + (save-excursion + (python-tests-look-at "c'") + (pos-eol)))))) + (ert-deftest python-nav-forward-statement-1 () (python-tests-with-temp-buffer " @@ -4213,7 +4361,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 +4378,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 +4406,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 +4435,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 +4459,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 +4491,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 +4519,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 +4540,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 +4560,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 +4578,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 +4591,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 +4610,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 +4623,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 +4637,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 +4650,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 +4663,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 +4679,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 +4690,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'")))) @@ -5183,6 +5349,20 @@ def decoratorFunctionWithArguments(arg1, arg2, arg3): (should (string= (python-info-current-defun t) "def decoratorFunctionWithArguments")))) +(ert-deftest python-info-current-defun-4 () + "Ensure unmatched quotes do not cause hang (Bug#58780)." + (python-tests-with-temp-buffer + " +def func(): + ' \"\"\" + v = 1 +" + (python-tests-look-at "v = 1") + (should (string= (python-info-current-defun) + "func")) + (should (string= (python-info-current-defun t) + "def func")))) + (ert-deftest python-info-current-symbol-1 () (python-tests-with-temp-buffer " @@ -6380,6 +6560,56 @@ class Class: (python-tests-look-at "'''Not a method docstring.'''") (should (not (python-info-docstring-p))))) +(ert-deftest python-info-triple-quoted-string-p-1 () + "Test triple quoted string." + (python-tests-with-temp-buffer + " +t = '''Triple''' +" + (python-tests-look-at " '''Triple") + (should-not + (python-tests-should-not-move + #'python-info-triple-quoted-string-p)) + (forward-char) + (let ((start-pos (+ (point) 2)) + (eol (pos-eol))) + (while (< (point) eol) + (should (= (python-tests-should-not-move + #'python-info-triple-quoted-string-p) + start-pos)) + (forward-char))) + (dolist (pos `(,(point) ,(point-min) ,(point-max))) + (goto-char pos) + (should-not + (python-tests-should-not-move + #'python-info-triple-quoted-string-p))))) + +(ert-deftest python-info-triple-quoted-string-p-2 () + "Test empty triple quoted string." + (python-tests-with-temp-buffer + " +e = '''''' +" + (python-tests-look-at "''''''") + (let ((start-pos (+ (point) 2)) + (eol (pos-eol))) + (while (< (point) eol) + (should (= (python-tests-should-not-move + #'python-info-triple-quoted-string-p) + start-pos)) + (forward-char))))) + +(ert-deftest python-info-triple-quoted-string-p-3 () + "Test single quoted string." + (python-tests-with-temp-buffer + " +s = 'Single' +" + (while (< (point) (point-max)) + (should-not (python-tests-should-not-move + #'python-info-triple-quoted-string-p)) + (forward-char)))) + (ert-deftest python-info-encoding-from-cookie-1 () "Should detect it on first line." (python-tests-with-temp-buffer 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..e0d9f1b5c50 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") @@ -242,6 +258,22 @@ The whitespace before and including \"|\" on each line is removed." (delete-char 1) (should (string= (ruby-ts-add-log-current-function) "M::C#foo")))) +(ert-deftest ruby-ts-syntax-propertize-symbol () + (skip-unless (treesit-ready-p 'ruby t)) + (pcase-dolist (`(,str . ,expected) + '((":abc" . ":abc") + (":foo?" . #(":foo?" 4 5 (syntax-table (3)))) + (":<=>" . #(":<=>" 1 4 (syntax-table (3)))))) + (ruby-ts-with-temp-buffer str + (syntax-propertize (point-max)) + (let ((text (buffer-string))) + (remove-text-properties 0 (1- (point-max)) + '(fontified) + text) + (should (equal-including-properties + text + expected)))))) + (defmacro ruby-ts-resource-file (file) `(when-let ((testfile ,(or (macroexp-file-name) buffer-file-name))) 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/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..146ee76574e --- /dev/null +++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts @@ -0,0 +1,73 @@ +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq typescript-ts-mode-indent-offset 2) + (typescript-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Basic indentation + +=-= +const foo = () => { + console.log("bar"); + if (x) { + return y; + } else if (y) { + return u; + } + return baz.x() + ? true + : false; +} +=-=-= + +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq tsx-ts-mode-indent-offset 2) + (tsx-ts-mode) + (indent-region (point-min) (point-max))) + +Name: JSX indentation + +=-= +const foo = (props) => { + return ( + <div> + <div> + <div> + <div> + { + props.foo + ? Hello, foo! + : Hello, World!; + } + </div> + </div> + </div> + </div> + ); +} +=-=-= + +Name: JSX indentation with attributes + +=-= +const foo = (props) => { + return ( + <div + className={foo} + onClick={() => { + alert('???'); + return () => { + return 5+5; + }; + }} + > + <p>Some text</p> + </div> + ); +} +=-=-= diff --git a/test/lisp/progmodes/typescript-ts-mode-tests.el b/test/lisp/progmodes/typescript-ts-mode-tests.el new file mode 100644 index 00000000000..126f5e3298f --- /dev/null +++ b/test/lisp/progmodes/typescript-ts-mode-tests.el @@ -0,0 +1,31 @@ +;;; typescript-ts-mode-tests.el --- Tests for Tree-sitter-based TypeScript mode -*- 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/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'treesit) + +(ert-deftest typescript-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'typescript)) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'typescript-ts-mode-tests) +;;; typescript-ts-mode-tests.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 1abd3be4ea1..050ee22ac18 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,39 @@ 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)))) + (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 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/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index 0daf27f32ec..7cf41d2817b 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -72,7 +72,38 @@ ("<url:ftp.example.net/abc/>" 1 url "ftp://ftp.example.net/abc/") ;; UUID, only hex is allowed ("01234567-89ab-cdef-ABCD-EF0123456789" 1 uuid "01234567-89ab-cdef-ABCD-EF0123456789") - ("01234567-89ab-cdef-ABCD-EF012345678G" 1 uuid nil)) + ("01234567-89ab-cdef-ABCD-EF012345678G" 1 uuid nil) + ;; email addresses + ("foo@example.com" 1 email "foo@example.com") + ("f@example.com" 1 email "f@example.com") + ("foo@example.com" 4 email "foo@example.com") + ("foo@example.com" 5 email "foo@example.com") + ("foo@example.com" 15 email "foo@example.com") + ("foo@example.com" 16 email "foo@example.com") + ("<foo@example.com>" 1 email "<foo@example.com>") + ("<foo@example.com>" 4 email "<foo@example.com>") + ("<foo@example.com>" 5 email "<foo@example.com>") + ("<foo@example.com>" 16 email "<foo@example.com>") + ("<foo@example.com>" 17 email "<foo@example.com>") + ;; email adresses containing numbers + ("foo1@example.com" 1 email "foo1@example.com") + ("1foo@example.com" 1 email "1foo@example.com") + ("11@example.com" 1 email "11@example.com") + ("1@example.com" 1 email "1@example.com") + ;; email adresses user portion containing dots + ("foo.bar@example.com" 1 email "foo.bar@example.com") + (".foobar@example.com" 1 email nil) + (".foobar@example.com" 2 email "foobar@example.com") + ;; email adresses domain portion containing dots and dashes + ("foobar@.example.com" 1 email nil) + ("foobar@-example.com" 1 email "foobar@-example.com") + ;; These are illegal, but thingatpt doesn't yet handle them + ;; ("foo..bar@example.com" 1 email nil) + ;; ("foobar@.example.com" 1 email nil) + ;; ("foobar@example..com" 1 email nil) + ;; ("foobar.@example.com" 1 email nil) + + ) "List of `thing-at-point' tests. Each list element should have the form 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/url/url-future-tests.el b/test/lisp/url/url-future-tests.el index 5c5802ef3e4..18e6e31c8ce 100644 --- a/test/lisp/url/url-future-tests.el +++ b/test/lisp/url/url-future-tests.el @@ -52,7 +52,7 @@ (should (equal (url-future-cancel tocancel) tocancel)) (should-error (url-future-call tocancel)) (should (null url-future-tests--saver)) - (should (url-future-cancelled-p tocancel)))) + (should (url-future-canceled-p tocancel)))) (provide 'url-future-tests) 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/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el index 7b76ac87129..f059104cdb9 100644 --- a/test/lisp/whitespace-tests.el +++ b/test/lisp/whitespace-tests.el @@ -57,6 +57,24 @@ buffer's content." (whitespace-cleanup) (buffer-string))) +(ert-deftest whitespace-tests--global () + (let ((backup global-whitespace-mode) + (noninteractive nil) + (whitespace-enable-predicate (lambda () t))) + (unwind-protect + (progn + (global-whitespace-mode 1) + (ert-with-test-buffer-selected () + (normal-mode) + (should whitespace-mode) + (global-whitespace-mode -1) + (should (null whitespace-mode)) + (whitespace-mode 1) + (should whitespace-mode) + (global-whitespace-mode 1) + (should whitespace-mode))) + (global-whitespace-mode (if backup 1 -1))))) + (ert-deftest whitespace-cleanup-eob () (let ((whitespace-style '(empty))) (should (equal (whitespace-tests--cleanup-string "a\n") 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/manual/noverlay/itree-tests.c b/test/manual/noverlay/itree-tests.c index 1fef87ea98d..0f1e4138954 100644 --- a/test/manual/noverlay/itree-tests.c +++ b/test/manual/noverlay/itree-tests.c @@ -26,7 +26,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "emacs-compat.h" #define EMACS_LISP_H /* lisp.h inclusion guard */ -#define ITREE_DEBUG 1 #define ITREE_TESTING #include "itree.c" @@ -53,7 +52,7 @@ test_insert1_setup (void) enum { N = 6 }; const int values[N] = {50, 30, 20, 10, 15, 5}; struct itree_node *nodes[N] = {&N_50, &N_30, &N_20, &N_10, &N_15, &N_05}; - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < N; ++i) { nodes[i]->begin = nodes[i]->end = values[i]; @@ -67,7 +66,7 @@ START_TEST (test_insert_1) * [50] */ - interval_tree_insert (&tree, &N_50); + itree_insert_node (&tree, &N_50); ck_assert (! N_50.red); ck_assert_ptr_eq (&N_50, tree.root); } @@ -81,8 +80,8 @@ START_TEST (test_insert_2) * (30) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); ck_assert (! N_50.red); ck_assert (N_30.red); ck_assert_ptr_eq (&N_50, tree.root); @@ -102,9 +101,9 @@ START_TEST (test_insert_3) * (20) (50) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); - interval_tree_insert (&tree, &N_20); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); + itree_insert_node (&tree, &N_20); ck_assert (N_50.red); ck_assert (! N_30.red); ck_assert (N_20.red); @@ -128,10 +127,10 @@ START_TEST (test_insert_4) * (10) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); - interval_tree_insert (&tree, &N_20); - interval_tree_insert (&tree, &N_10); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); + itree_insert_node (&tree, &N_20); + itree_insert_node (&tree, &N_10); ck_assert (! N_50.red); ck_assert (! N_30.red); ck_assert (! N_20.red); @@ -159,11 +158,11 @@ START_TEST (test_insert_5) * (10) (20) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); - interval_tree_insert (&tree, &N_20); - interval_tree_insert (&tree, &N_10); - interval_tree_insert (&tree, &N_15); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); + itree_insert_node (&tree, &N_20); + itree_insert_node (&tree, &N_10); + itree_insert_node (&tree, &N_15); ck_assert (! N_50.red); ck_assert (! N_30.red); ck_assert (N_20.red); @@ -197,12 +196,12 @@ START_TEST (test_insert_6) * (5) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); - interval_tree_insert (&tree, &N_20); - interval_tree_insert (&tree, &N_10); - interval_tree_insert (&tree, &N_15); - interval_tree_insert (&tree, &N_05); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); + itree_insert_node (&tree, &N_20); + itree_insert_node (&tree, &N_10); + itree_insert_node (&tree, &N_15); + itree_insert_node (&tree, &N_05); ck_assert (! N_50.red); ck_assert (! N_30.red); ck_assert (! N_20.red); @@ -238,7 +237,7 @@ test_insert2_setup (void) enum { N = 6 }; const int values[] = {50, 70, 80, 90, 85, 95}; struct itree_node *nodes[N] = {&N_50, &N_70, &N_80, &N_90, &N_85, &N_95}; - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < N; ++i) { nodes[i]->begin = nodes[i]->end = values[i]; @@ -252,7 +251,7 @@ START_TEST (test_insert_7) * [50] */ - interval_tree_insert (&tree, &N_50); + itree_insert_node (&tree, &N_50); ck_assert (! N_50.red); ck_assert_ptr_eq (&N_50, tree.root); } @@ -266,8 +265,8 @@ START_TEST (test_insert_8) * (70) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); ck_assert (! N_50.red); ck_assert (N_70.red); ck_assert_ptr_eq (&N_50, tree.root); @@ -287,9 +286,9 @@ START_TEST (test_insert_9) * (50) (80) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); - interval_tree_insert (&tree, &N_80); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); + itree_insert_node (&tree, &N_80); ck_assert (N_50.red); ck_assert (! N_70.red); ck_assert (N_80.red); @@ -313,10 +312,10 @@ START_TEST (test_insert_10) * (90) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); - interval_tree_insert (&tree, &N_80); - interval_tree_insert (&tree, &N_90); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); + itree_insert_node (&tree, &N_80); + itree_insert_node (&tree, &N_90); ck_assert (! N_50.red); ck_assert (! N_70.red); ck_assert (! N_80.red); @@ -344,11 +343,11 @@ START_TEST (test_insert_11) * (80) (90) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); - interval_tree_insert (&tree, &N_80); - interval_tree_insert (&tree, &N_90); - interval_tree_insert (&tree, &N_85); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); + itree_insert_node (&tree, &N_80); + itree_insert_node (&tree, &N_90); + itree_insert_node (&tree, &N_85); ck_assert (! N_50.red); ck_assert (! N_70.red); ck_assert (N_80.red); @@ -383,12 +382,12 @@ START_TEST (test_insert_12) * (95) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); - interval_tree_insert (&tree, &N_80); - interval_tree_insert (&tree, &N_90); - interval_tree_insert (&tree, &N_85); - interval_tree_insert (&tree, &N_95); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); + itree_insert_node (&tree, &N_80); + itree_insert_node (&tree, &N_90); + itree_insert_node (&tree, &N_85); + itree_insert_node (&tree, &N_95); ck_assert (! N_50.red); ck_assert (! N_70.red); ck_assert (! N_80.red); @@ -419,7 +418,7 @@ START_TEST (test_insert_13) enum { N = 4 }; const int values[N] = {10, 20, 30, 40}; struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40}; - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < N; ++i) itree_insert (&tree, nodes[i], values[i], values[i]); @@ -437,13 +436,13 @@ END_TEST START_TEST (test_insert_14) { enum { N = 3 }; - struct itree_node nodes[N]; - interval_tree_init (&tree); + struct itree_node nodes[N] = {0}; + itree_init (&tree); for (int i = 0; i < N; ++i) itree_insert (&tree, &nodes[i], 10, 10); for (int i = 0; i < N; ++i) - ck_assert (interval_tree_contains (&tree, &nodes[i])); + ck_assert (itree_contains (&tree, &nodes[i])); } END_TEST @@ -458,7 +457,7 @@ END_TEST static void test_remove1_setup (void) { - interval_tree_init (&tree); + itree_init (&tree); tree.root = &B; A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D; A.left = A.right = C.left = C.right = E.left = E.right = NULL; @@ -480,7 +479,7 @@ START_TEST (test_remove_1) { B.red = A.red = C.red = E.red = false; D.red = true; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -502,7 +501,7 @@ END_TEST START_TEST (test_remove_2) { B.red = D.red = A.red = C.red = E.red = false; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -523,7 +522,7 @@ START_TEST (test_remove_3) { D.red = A.red = E.red = false; B.red = C.red = true; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -546,7 +545,7 @@ START_TEST (test_remove_4) { B.red = C.red = E.red = true; A.red = D.red = false; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -569,7 +568,7 @@ END_TEST static void test_remove2_setup (void) { - interval_tree_init (&tree); + itree_init (&tree); tree.root = &B; A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D; A.right = A.left = C.right = C.left = E.right = E.left = NULL; @@ -589,7 +588,7 @@ START_TEST (test_remove_5) { B.red = A.red = C.red = E.red = false; D.red = true; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -611,7 +610,7 @@ END_TEST START_TEST (test_remove_6) { B.red = D.red = A.red = C.red = E.red = false; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -632,7 +631,7 @@ START_TEST (test_remove_7) { D.red = A.red = E.red = false; B.red = C.red = true; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -655,7 +654,7 @@ START_TEST (test_remove_8) { B.red = C.red = E.red = true; A.red = D.red = false; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -676,7 +675,7 @@ START_TEST (test_remove_9) enum { N = 4 }; const int values[N] = {10, 20, 30, 40}; struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40}; - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < N; ++i) itree_insert (&tree, nodes[i], values[i], values[i]); @@ -722,8 +721,8 @@ START_TEST (test_remove_10) srand (42); shuffle (index, N); - interval_tree_init (&tree); - struct itree_node nodes[N]; + itree_init (&tree); + struct itree_node nodes[N] = {0}; for (int i = 0; i < N; ++i) { ptrdiff_t pos = (i + 1) * 10; @@ -733,10 +732,10 @@ START_TEST (test_remove_10) shuffle (index, N); for (int i = 0; i < N; ++i) { - ck_assert (interval_tree_contains (&tree, &nodes[index[i]])); + ck_assert (itree_contains (&tree, &nodes[index[i]])); itree_remove (&tree, &nodes[index[i]]); } - ck_assert_ptr_null (tree.root); + ck_assert (itree_empty_p (&tree)); ck_assert_int_eq (tree.size, 0); } END_TEST @@ -748,12 +747,12 @@ END_TEST START_TEST (test_generator_1) { - struct itree_node node, *n; - struct itree_iterator *g; - interval_tree_init (&tree); + struct itree_node node = {0}, *n; + struct itree_iterator it, *g; + itree_init (&tree); itree_insert (&tree, &node, 10, 20); - g = itree_iterator_start (&tree, 0, 30, ITREE_ASCENDING, NULL, 0); + g = itree_iterator_start (&it, &tree, 0, 30, ITREE_ASCENDING); n = itree_iterator_next (g); ck_assert_ptr_eq (n, &node); ck_assert_int_eq (n->begin, 10); @@ -761,13 +760,11 @@ START_TEST (test_generator_1) ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); - itree_iterator_finish (g); - g = itree_iterator_start (&tree, 30, 50, ITREE_ASCENDING, NULL, 0); + g = itree_iterator_start (&it, &tree, 30, 50, ITREE_ASCENDING); ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); - itree_iterator_finish (g); } END_TEST @@ -777,8 +774,8 @@ test_check_generator (struct itree_tree *tree, int n, ...) { va_list ap; - struct itree_iterator *g = - itree_iterator_start (tree, begin, end, ITREE_ASCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, tree, begin, end, ITREE_ASCENDING); va_start (ap, n); for (int i = 0; i < n; ++i) @@ -790,13 +787,12 @@ test_check_generator (struct itree_tree *tree, va_end (ap); ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); - itree_iterator_finish (g); } START_TEST (test_generator_2) { - interval_tree_init (&tree); - struct itree_node nodes[3]; + itree_init (&tree); + struct itree_node nodes[3] = {0}; for (int i = 0; i < 3; ++i) itree_insert (&tree, &nodes[i], 10 * (i + 1), 10 * (i + 2)); @@ -830,7 +826,7 @@ test_create_tree (struct itree_node *nodes, int n, bool doshuffle) shuffle (index, n); } - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < n; ++i) { struct itree_node *node = &nodes[index[i]]; @@ -862,8 +858,8 @@ START_TEST (test_generator_5) {.begin = 30, .end = 50}, {.begin = 40, .end = 60}}; test_create_tree (nodes, N, false); - struct itree_iterator *g = - itree_iterator_start (&tree, 0, 100, ITREE_PRE_ORDER, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 0, 100, ITREE_PRE_ORDER); for (int i = 0; i < N; ++i) { struct itree_node *n = itree_iterator_next (g); @@ -876,7 +872,6 @@ START_TEST (test_generator_5) case 3: ck_assert_int_eq (40, n->begin); break; } } - itree_iterator_finish (g); } END_TEST @@ -888,8 +883,8 @@ START_TEST (test_generator_6) {.begin = 30, .end = 50}, {.begin = 40, .end = 60}}; test_create_tree (nodes, N, true); - struct itree_iterator *g = - itree_iterator_start (&tree, 0, 100, ITREE_ASCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 0, 100, ITREE_ASCENDING); for (int i = 0; i < N; ++i) { struct itree_node *n = itree_iterator_next (g); @@ -902,7 +897,6 @@ START_TEST (test_generator_6) case 3: ck_assert_int_eq (40, n->begin); break; } } - itree_iterator_finish (g); } END_TEST @@ -914,8 +908,8 @@ START_TEST (test_generator_7) {.begin = 30, .end = 50}, {.begin = 40, .end = 60}}; test_create_tree (nodes, N, true); - struct itree_iterator *g = - itree_iterator_start (&tree, 0, 100, ITREE_DESCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 0, 100, ITREE_DESCENDING); for (int i = 0; i < N; ++i) { struct itree_node *n = itree_iterator_next (g); @@ -928,7 +922,6 @@ START_TEST (test_generator_7) case 3: ck_assert_int_eq (10, n->begin); break; } } - itree_iterator_finish (g); } END_TEST @@ -938,14 +931,13 @@ START_TEST (test_generator_8) struct itree_node nodes[N] = {{.begin = 20, .end = 30}, {.begin = 40, .end = 50}}; test_create_tree (nodes, N, false); - struct itree_iterator *g = - itree_iterator_start (&tree, 1, 60, ITREE_DESCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 1, 60, ITREE_DESCENDING); struct itree_node *n = itree_iterator_next (g); ck_assert_int_eq (n->begin, 40); itree_iterator_narrow (g, 50, 60); n = itree_iterator_next (g); ck_assert_ptr_null (n); - itree_iterator_finish (g); } END_TEST @@ -955,14 +947,13 @@ START_TEST (test_generator_9) struct itree_node nodes[N] = {{.begin = 25, .end = 25}, {.begin = 20, .end = 30}}; test_create_tree (nodes, N, false); - struct itree_iterator *g = - itree_iterator_start (&tree, 1, 30, ITREE_DESCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 1, 30, ITREE_DESCENDING); struct itree_node *n = itree_iterator_next (g); ck_assert_int_eq (n->begin, 25); itree_iterator_narrow (g, 25, 30); n = itree_iterator_next (g); ck_assert_int_eq (n->begin, 20); - itree_iterator_finish (g); } END_TEST @@ -981,7 +972,7 @@ static void test_setup_gap_node (ptrdiff_t begin, ptrdiff_t end, bool front_advance, bool rear_advance) { - interval_tree_init (&gap_tree); + itree_init (&gap_tree); gap_node.front_advance = front_advance; gap_node.rear_advance = rear_advance; itree_insert (&gap_tree, &gap_node, begin, end); @@ -1281,9 +1272,8 @@ main (void) Suite *s = basic_suite (); SRunner *sr = srunner_create (s); - init_itree (); srunner_run_all (sr, CK_ENV); - int nfailed = srunner_ntests_failed (sr); + int failed = srunner_ntests_failed (sr); srunner_free (sr); - return (nfailed == 0) ? EXIT_SUCCESS : EXIT_FAILURE; + return failed ? EXIT_FAILURE : EXIT_SUCCESS; } 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/keymap-tests.el b/test/src/keymap-tests.el index aa710519825..29220c95395 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -475,6 +475,24 @@ g .. h foo "a" #'next-line "a" #'previous-line))) +(ert-deftest keymap-unset-test-remove-and-inheritance () + "Check various behaviors of keymap-unset. (Bug#62207)" + (let ((map (make-sparse-keymap)) + (parent (make-sparse-keymap))) + (set-keymap-parent map parent) + ;; Removing an unset key should not add a key. + (keymap-set parent "u" #'undo) + (keymap-unset map "u" t) + (should (equal (keymap-lookup map "u") #'undo)) + ;; Non-removed child bindings should shadow parent + (keymap-set map "u" #'identity) + (keymap-unset map "u") + ;; From the child, but nil. + (should-not (keymap-lookup map "u")) + (keymap-unset map "u" t) + ;; From the parent this time/ + (should (equal (keymap-lookup map "u") #'undo)))) + (provide 'keymap-tests) ;;; keymap-tests.el ends here diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 459a06a39b6..fc00204ce7b 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -116,8 +116,27 @@ (should-error (read "#") :type 'invalid-read-syntax)) (ert-deftest lread-char-modifiers () - (should (eq ?\C-\M-é (+ (- ?\M-a ?a) ?\C-é))) - (should (eq (- ?\C-ŗ ?ŗ) (- ?\C-é ?é)))) + (should (equal ?\C-\M-é (+ (- ?\M-a ?a) ?\C-é))) + (should (equal (- ?\C-ŗ ?ŗ) (- ?\C-é ?é))) + (should (equal ?\C-\C-c #x4000003)) + (should (equal ?\C-\M-\C-c #xc000003)) + (should (equal ?\M-\C-\C-c #xc000003)) + (should (equal ?\C-\C-\M-c #xc000003)) + (should (equal ?\M-\S-\H-\A-\C-\s-x #xbc00018)) + + (should (equal "\s-x" " -x")) + (should (equal "\C-x" "\x18")) + (should (equal "\^x" "\x18")) + (should (equal "\M-x" "\xf8"))) + +(ert-deftest lread-many-modifiers () + ;; The string literal "\M-\M-...\M-a" should be equivalent to "\M-a", + ;; and we should not run out of stack space parsing it. + (let* ((n 500000) + (s (concat "\"" + (apply #'concat (make-list n "\\M-")) + "a\""))) + (should (equal (read-from-string s) (cons "\M-a" (+ (* n 3) 3)))))) (ert-deftest lread-record-1 () (should (equal '(#s(foo) #s(foo)) @@ -137,11 +156,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/process-tests.el b/test/src/process-tests.el index c3b4e17dbc0..e17e1c0d833 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -830,7 +830,7 @@ Return nil if that can't be determined." (when (eq process-tests--EMFILE-message :unknown) (setq process-tests--EMFILE-message (with-temp-buffer - (when (eql (ignore-error 'file-error + (when (eql (ignore-error file-error (call-process "errno" nil t nil "EMFILE")) 0) (goto-char (point-min)) diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el index cd4924f9785..52d43775b8e 100644 --- a/test/src/regex-emacs-tests.el +++ b/test/src/regex-emacs-tests.el @@ -273,7 +273,7 @@ on success" string (condition-case nil (if (string-match pattern string) nil 'search-failed) - ('invalid-regexp 'compilation-failed)) + (invalid-regexp 'compilation-failed)) bounds-ref substring-ref))) @@ -518,7 +518,7 @@ known/benign differences in behavior.") what-failed (condition-case nil (if (string-match pattern string) nil 'search-failed) - ('invalid-regexp 'compilation-failed)) + (invalid-regexp 'compilation-failed)) matches-observed (cl-loop for x from 0 to 20 @@ -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.") diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el index 84151d3b5db..fd45a9101fa 100644 --- a/test/src/undo-tests.el +++ b/test/src/undo-tests.el @@ -439,6 +439,78 @@ Demonstrates bug 16818." (should (string= (buffer-string) "aaaFirst line\nSecond line\nbbb")))) +(ert-deftest undo-test-combine-change-calls-1 () + "Test how `combine-change-calls' updates `buffer-undo-list'. +Case 1: a file-visiting buffer with `buffer-undo-list' non-nil +and `buffer-modified-p' non-nil when `combine-change-calls' is +called." + (ert-with-temp-file tempfile + (with-current-buffer (find-file tempfile) + (insert "A") + (undo-boundary) + (insert "B") + (undo-boundary) + (insert "C") + (undo-boundary) + (insert " ") + (undo-boundary) + (insert "D") + (undo-boundary) + (insert "E") + (undo-boundary) + (insert "F") + (should (= (length buffer-undo-list) 14)) + (goto-char (point-min)) + (combine-change-calls (point-min) (point-max) + (re-search-forward "ABC ") + (replace-match "Z ")) + (should (= (length buffer-undo-list) 15))))) + +(ert-deftest undo-test-combine-change-calls-2 () + "Test how `combine-change-calls' updates `buffer-undo-list'. +Case 2: a file-visiting buffer with `buffer-undo-list' non-nil +and `buffer-modified-p' nil when `combine-change-calls' is +called." + (ert-with-temp-file tempfile + (with-current-buffer (find-file tempfile) + (insert "A") + (undo-boundary) + (insert "B") + (undo-boundary) + (insert "C") + (undo-boundary) + (insert " ") + (undo-boundary) + (insert "D") + (undo-boundary) + (insert "E") + (undo-boundary) + (insert "F") + (should (= (length buffer-undo-list) 14)) + (save-buffer) + (goto-char (point-min)) + (combine-change-calls (point-min) (point-max) + (re-search-forward "ABC ") + (replace-match "Z ")) + (should (= (length buffer-undo-list) 15))))) + +(ert-deftest undo-test-combine-change-calls-3 () + "Test how `combine-change-calls' updates `buffer-undo-list'. +Case 3: a file-visiting buffer with `buffer-undo-list' nil and +`buffer-modified-p' nil when `combine-change-calls' is called." + (ert-with-temp-file tempfile + (with-current-buffer (find-file tempfile) + (insert "ABC DEF") + (save-buffer) + (kill-buffer)) + (with-current-buffer (find-file tempfile) + (should (= (length buffer-undo-list) 0)) + (goto-char (point-min)) + (combine-change-calls (point-min) (point-max) + (re-search-forward "ABC ") + (replace-match "Z ")) + (should (= (length buffer-undo-list) 1))))) + (defun undo-test-all (&optional interactive) "Run all tests for \\[undo]." (interactive "p") |