diff --git a/CONTRIBUTE b/CONTRIBUTE index eda300f01bc..be10dbda8b3 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -234,7 +234,9 @@ formatting them: - Lines in ChangeLog entries should preferably be not longer than 63 characters, and must not exceed 78 characters, unless they consist of a single word of at most 140 characters; this 78/140 limit is - enforced by a commit hook. + enforced by a commit hook. (The 63-character preference is to + avoid too-long lines in the ChangeLog file generated from Git logs, + where each entry line is indented by a TAB.) - If only a single file is changed, the summary line can be the normal first line of a ChangeLog entry (starting with the asterisk). Then diff --git a/ChangeLog.5 b/ChangeLog.5 index af0dc0e5f10..c74daeb3aed 100644 --- a/ChangeLog.5 +++ b/ChangeLog.5 @@ -1,10 +1,1163 @@ +2025-05-17 Eli Zaretskii + + Fix saving abbrevs by 'abbrev-edit-save-buffer' + + * lisp/abbrev.el (abbrev-edit-save-buffer): Reset + 'abbrevs-changed'. Suggested by Rick . + (Bug#78435) + +2025-05-15 Konstantin Kharlamov + + typescript-ts-mode: align ternary-chain branches (bug#78187) + + * lisp/progmodes/typescript-ts-mode.el: + (typescript-ts-mode--indent-rules): Make sure each new ternary + branch is aligned with the previous one. + * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts: + (Chained ternary expressions): New test. + +2025-05-11 Michael Albinus + + Improve Tramp test + + * test/lisp/net/tramp-tests.el + (tramp-test26-interactive-file-name-completion): Adapt test. + +2025-05-11 Michael Albinus + + * lisp/autorevert.el (auto-revert-remote-files): Adapt docstring. + +2025-05-10 Stephen Berman + + Improve Electric Pair mode documentation (bug#78021) + + * doc/emacs/programs.texi (Matching): Clarify and improve + documentation of Electric Pair mode. + + * lisp/elec-pair.el: Improve description in header line. Add text + and a reference to the Emacs user manual in the Commentary section. + (electric-pair-skip-self, electric-pair-inhibit-predicate) + (electric-pair-preserve-balance) + (electric-pair-delete-adjacent-pairs) + (electric-pair-open-newline-between-pairs) + (electric-pair-skip-whitespace) + (electric-pair-skip-whitespace-function) + (electric-pair-analyze-conversion) + (electric-pair--skip-whitespace) + (electric-pair-text-syntax-table, electric-pair--with-syntax) + (electric-pair-syntax-info, electric-pair--insert) + (electric-pair--syntax-ppss, electric-pair--balance-info) + (electric-pair-inhibit-if-helps-balance) + (electric-pair-skip-if-helps-balance) + (electric-pair-open-newline-between-pairs-psif) + (electric-pair-mode): Clarify and improve doc strings and some comments. + (electric-pair-post-self-insert-function): Restructure doc string + to shorten overlong first line, and reformat overlong lines of code. + +2025-05-10 Eli Zaretskii + + Fix indentation of XML comments + + * lisp/nxml/nxml-mode.el (nxml-compute-indent-in-delimited-token): + Fix indentation in XML comments with empty lines. Patch by John + Ciolfi . (Bug#73206) + +2025-05-10 Michael Albinus + + Improve Tramp's make-process handling for Solaris + + * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): + Disable buffering also for remote Solaris hosts. + Reported by Stacey Marshall . + +2025-05-08 Stephen Gildea + + Document 'time-stamp-time-zone' in Emacs Manual + + * doc/emacs/files.texi (Time Stamp Customization): Document + time-stamp-time-zone. + +2025-05-07 Yuan Fu + + Make treesit--simple-indent-eval more permissive (bug#78065) + + * lisp/treesit.el (treesit--simple-indent-eval): Allow EXP to be + anything, so higher-order indent presets can take anything as an + argument: t, nil, symbols, keywords, etc. + +2025-05-06 Michael Albinus + + Adapt Tramp tests + + * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process) + (tramp-test30-make-process): Adapt tests. + +2025-05-03 Michael Albinus + + Fix quoted local file name parts in Tramp + + * lisp/net/tramp.el (tramp-handle-directory-file-name): + * lisp/net/tramp-integration.el (tramp-rfn-eshadow-update-overlay): + Handle quoted local file name part. + +2025-05-01 Jostein Kjønigsen + + Fix compilation-mode matches for csharp-mode (bug#78128) + + * lisp/progmodes/csharp-mode.el: + (csharp-compilation-re-dotnet-error): + (csharp-compilation-re-dotnet-warning): Ignore leading whitespace. + +2025-04-30 Eli Zaretskii + + Add 3 scripts to fontset setup + + * lisp/international/fontset.el (setup-default-fontset) + (script-representative-chars): Add support for Avestan, Old Turkic + and Chakma. Patch by Werner Lemberg . Do not merge + to master. + +2025-04-30 Eli Zaretskii + + Fix compilation errors in emacsclient.c with MinGW GCC 15 + + * lib-src/emacsclient.c (set_fg, get_wc): Declare using actual + function signatures. + (w32_give_focus): Cast return value of 'GetProcAddress' to correct + pointer types. (Bug#78160) + +2025-04-27 Po Lu + + Fix the Android build + + * java/README.res: Move from java/res/README, as the AAPT does + not permit non-resource files in resource directories. + +2025-04-27 Eli Zaretskii + + Avoid infinite recursion under 'rectangle-mark-mode' + + * lisp/rect.el (rectangle--region-beginning) + (rectangle--region-end): Avoid infinite recursion. Patch by Alcor + . Do not merge to master. (Bug#77973) + +2025-04-26 Sean Bright (tiny change) + + Include additional version metadata during Windows install + + * admin/nt/dist-build/emacs.nsi: Add DisplayIcon, DisplayVersion, and + Publisher values to the Uninstall registry key. + +2025-04-25 Stephen Gildea + + * doc/emacs/files.texi (Time Stamp Customization): Typo. + +2025-04-19 Spencer Baugh + + Backport: fix flymake margin indicator fallback logic + + Backport 861e7f8b60e4bf076bf5991d25a22b3a012746bd to fix bug#77313, so + that fringe indicators are once again reliably the default on frames + that support them. + + Do not merge to master. + + * lisp/progmodes/flymake.el (flymake-indicator-type) + (flymake-mode): Fix margin fallback behavior. + +2025-04-19 Michael Albinus + + * lisp/progmodes/heex-ts-mode.el (heex-ts): Fix :group name. + +2025-04-18 Konstantin Kharlamov + + Fix typescript-ts-mode indentation (bug#77803) + + Don't align variable names to their declaratory expression. + + Before this commit in code like: + + const a = 1, + b = 2; + + the b would get indented to `const'. Similarly for `var' and + `let'. The expected behavior instead is getting indented to + `typescript-ts-mode-indent-offset'. + + * lisp/progmodes/typescript-ts-mode.el + (typescript-ts-mode--indent-rules): Indent identifiers declarations to + `typescript-ts-mode-indent-offset'. + * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts + (Lexical and variable declarations): Update test accordingly. + +2025-04-18 Yuan Fu + + Handle offset in treesit--update-ranges-local (bug#77848) + + * lisp/treesit.el: + (treesit--update-ranges-local): Add OFFSET parameter. + (treesit-update-ranges): Pass offset to + treesit--update-ranges-local. + +2025-04-18 kobarity + + Disable echo back instead of setting tty to raw in Inferior Python + + * lisp/progmodes/python.el (python-shell-setup-code): Change the + Python setup code. (Bug#76943) + + (cherry picked from commit 4c5c20ddc2cdde570ccf54c4aa60644828ee213d) + +2025-04-18 Michael Albinus + + * admin/notes/emba: Fix docker build instruction. + +2025-04-16 Michael Albinus + + Backport: Fix tree-sitter tests on Emba + + * test/infra/Dockerfile.emba: Use tree-sitter-rust v0.23.3 in + order to match ABI version of libtree-sitter0. + + (cherry picked from commit 788c9cfb62c7fd50b171a9209dd7453bd03f14bf) + +2025-04-15 Wojciech Siewierski + + Fix deleting the first line of calc trail + + * lisp/calc/calc-trail.el (calc-trail-kill): Remove the check + preventing the removal of the first trail line, which is no + longer relevant since commit 8e1376a3912. (Bug#77816) + +2025-04-13 Po Lu + + Fix file descriptor leaks on arm Android + + * exec/loader-aarch64.s (_start): + + * exec/loader-armeabi.s (_start): Fix thinko. + Do not merge to master. + +2025-04-12 Stefan Monnier + + lisp/help.el (help-form-show): Improve last change (bug#77118) + + Fill the buffer from within the `with-output-to-temp-buffer`, as before. + +2025-04-12 Stephen Berman + + Fix display of keys in 'help-form' buffers (bug#77118) + + * lisp/help.el (help-form-show): Use 'insert' instead of 'princ' + so that keys in 'help-form' are displayed with 'help-key-binding' face. + +2025-04-12 Eli Zaretskii + + Improve documentation of 'user-emacs-directory' + + * doc/emacs/custom.texi (Find Init): Document the effect of + 'user-emacs-directory' on native compilation. Advise against + changing the value of 'user-emacs-directory' in init files. + (Bug#77745) + +2025-04-11 Sean Whitton + + Update remarks on name prefixes in coding conventions + + * doc/lispref/tips.texi (Coding Conventions): Say that it's okay + to put the name prefix later for defining constructs, rather + than explicitly instructing the reader to do so. Condense the + recommendation to err on the side of prepending the name prefix. + +2025-04-04 Michael Albinus + + Fix Tramp problem with loooongish file names + + * lisp/net/tramp-sh.el (tramp-readlink-file-truename): New defconst. + (tramp-bundle-read-file-names): Use new %m and %q format specifiers. + (tramp-sh-handle-file-truename): Use `tramp-readlink-file-truename'. + (tramp-bundle-read-file-names, tramp-get-remote-readlink): Simplify. + (tramp-expand-script): Add format specifiers %m and %q for test + commands. Addapt readlink call. + Reported by Stacey Marshall . + +2025-04-03 Yuan Fu + + Tighten the criteria for a defun in typescript-ts-mode (bug#77369) + + * lisp/progmodes/typescript-ts-mode.el: + (typescript-ts-mode--defun-type-regexp): New + variable (backported from master). + (typescript-ts-mode--defun-predicate): New function. + (typescript-ts-base-mode): Use new predicate. + +2025-04-03 Stephen Berman + + Fix obsolete documentation of desktop library + + * doc/emacs/misc.texi (Saving Emacs Sessions): Replace + documentation of the long-deleted user option + 'desktop-clear-preserve-buffers-regexp' with documentation of + 'desktop-clear-preserve-buffers'. + +2025-04-03 Michael Albinus + + Improve Tramp's initial warnings + + * lisp/net/tramp-cache.el (tramp-dump-connection-properties): + Adapt comment. + + * lisp/net/tramp-compat.el (tramp-warning): Declare and use it. + + * lisp/net/tramp-message.el (tramp-warning): Declare `indent'. + +2025-04-02 Michael Albinus + + Explain, how to suppress Tramp warnings + + * doc/misc/tramp.texi (Frequently Asked Questions): Remove double item. + (Traces and Profiles): Mention `warning-suppress-types'. (Bug#77422) + +2025-04-01 Stephen Gildea + + printed manuals: xrefs in and out of "Preparing Patches" + + Fix two cases of links where the on-line manual is one document but the + manual is split into separate documents for printing: + + * doc/emacs/package.texi (Fetching Package Sources): fix printed link to + "Preparing Patches" to point to separate document. + * doc/emacs/vc1-xtra.texi (Preparing Patches): fix printed link to + "Directory Variables" to point to separate document. + +2025-04-01 Michael Albinus + + Fix Tramp's file-attributes cache + + * lisp/net/tramp-adb.el (tramp-adb-handle-file-executable-p): + Check also for sticky bit. + (tramp-adb-handle-file-readable-p): Simplify. + + * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-executable-p): + Check also for sticky bit. Force `file-attributes' check. + + * lisp/net/tramp-sh.el (tramp-sh-handle-file-executable-p): + Check also for sticky bit. + (tramp-sh-handle-file-readable-p) + (tramp-sh-handle-file-writable-p): Simplify. + + * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-executable-p): + Check also for sticky bit. + (tramp-sudoedit-handle-file-readable-p) + (tramp-sudoedit-handle-file-writable-p): Simplify. + + * lisp/net/tramp.el (tramp-use-file-attributes): Fix docstring. + (tramp-handle-file-readable-p, tramp-handle-file-writable-p): + Force `file-attributes' check. Use `file-truename' for symbolic links. + (tramp-check-cached-permissions): New optional argument FORCE. + Fix symlink check. Check also for sticky bit. (Bug#77402) + + * test/lisp/net/tramp-tests.el + (tramp-test20-file-modes-without-file-attributes) + (tramp-test21-file-links-without-file-attributes): New tests. + +2025-04-01 Pip Cet + + Fix compilation errors due to insufficient compiler safety (bug#63288) + + The default safety level is 1. Restoring the default safety level to + 1 after it was temporarily 0 should reset byte-compile-delete-errors + to nil, its default level. Failing to do that resulted in + miscompilation of code in highly-parallel builds. + + * lisp/emacs-lisp/cl-macs.el (cl--do-proclaim): Change + 'byte-compile-delete-errors' to become t only at 'safety' level 0, not + levels 1 or 2. + + (cherry picked from commit 53a5dada413662389a17c551a00d215e51f5049f) + +2025-03-30 Stephen Gildea + + Backport expansion of Time Stamp documentation + + * doc/emacs/files.texi (Time Stamps): Add examples of enabling + time stamping with add-hook, setting time-stamp-pattern as a + file-local variable, and showing a time stamp at the end of a + file. Divide into three sections. + * doc/emacs/emacs.texi: Add new nodes to menu. + * lisp/info.el (Info-file-list-for-emacs): Remove entry that + points Info at time-stamp discussion in the Autotype document. + * lisp/time-stamp.el (time-stamp-format, time-stamp-active, + time-stamp-count, time-stamp-pattern, time-stamp, time-stamp-string): + Expand doc strings. Include Info cross-references. + + Cherry picked from commits on the main branch. + Do not merge to master. + +2025-03-30 Michael Albinus + + Sync with Tramp 2.7.3-pre + + * doc/misc/tramp.texi: Use @dots{} where appropriate. + (External methods): Precise remark on rsync speed. + (Customizing Methods): Add incus-tramp. + (Password handling): Mention expiration of cached passwords when a + session timeout happens. + (Predefined connection information): Mention also "androidsu" as + special case of "tmpdir". + (Ad-hoc multi-hops, Frequently Asked Questions): + Improve description how ad-hoc multi-hop file names can be made + persistent. (Bug#65039, Bug#76457) + (Remote processes): Signals are not delivered to remote direct + async processes. Say, that there are restrictions for transfer of + binary data to remote direct async processes. + (Bug Reports): Explain bisecting. + (Frequently Asked Questions): Improve index. Speak about + fingerprint readers. Recommend `small-temporary-file-directory' + for ssh sockets. + (External packages): Rename subsection "Timers, process filters, + process sentinels, redisplay". + (Extension packages): New node. + (Top, Files directories and localnames): Add it to @menu. + + * doc/misc/trampver.texi: + * lisp/net/trampver.el (tramp-version): Adapt Tramp versions. + (tramp-repository-branch, tramp-repository-version): + Remove ;;;###tramp-autoload cookie. + + * lisp/net/tramp-adb.el: + * lisp/net/tramp-androidsu.el: + * lisp/net/tramp-cache.el: + * lisp/net/tramp-cmds.el: + * lisp/net/tramp-compat.el: + * lisp/net/tramp-container.el: + * lisp/net/tramp-crypt.el: + * lisp/net/tramp-ftp.el: + * lisp/net/tramp-fuse.el: + * lisp/net/tramp-gvfs.el: + * lisp/net/tramp-integration.el: + * lisp/net/tramp-message.el: + * lisp/net/tramp-rclone.el: + * lisp/net/tramp-sh.el: + * lisp/net/tramp-smb.el: + * lisp/net/tramp-sshfs.el: + * lisp/net/tramp-sudoedit.el: + * lisp/net/tramp.el: Use `when-let*', `if-let*' and `and-let*' + consequently. (Bug#73441) + + * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): + Move setting of sentinel up. + + * lisp/net/tramp-archive.el (tramp-archive-file-name-p): + Add ;;;###tramp-autoload cookie. + (tramp-archive-local-file-name): New defun. + + * lisp/net/tramp-cache.el (tramp-connection-properties): Add link + to the Tramp manual in the docstring. + (tramp-get-connection-property, tramp-set-connection-property): + Don't raise a debug message for the `tramp-cache-version' key. + (with-tramp-saved-connection-property) + (with-tramp-saved-connection-properties): Add traces. + (tramp-dump-connection-properties): Don't save connection property + "pw-spec". + + * lisp/net/tramp-cmds.el (tramp-repository-branch) + (tramp-repository-version): Declare. + + * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file): + (tramp-gvfs-do-copy-or-rename-file): Don't use the truename. + Handle symlinks. + (tramp-gvfs-local-file-name): New defun. + + * lisp/net/tramp-message.el (tramp-repository-branch) + (tramp-repository-version): Declare. + (tramp-error-with-buffer, tramp-user-error): Don't redisplay in + `sit-for'. (Bug#73718) + (tramp-warning): Fix `lwarn' call. + + * lisp/net/tramp.el (tramp-read-passwd): + * lisp/net/tramp-sh.el (tramp-maybe-open-connection): + * lisp/net/tramp-sudoedit.el (tramp-sudoedit-send-command): + Rename connection property "password-vector" to "pw-vector". + + * lisp/net/tramp-sh.el (tramp-methods) : + Adapt `tramp-copy-args' argument. + (tramp-get-remote-pipe-buf, tramp-actions-before-shell): + Use `tramp-fingerprint-prompt-regexp'. + (tramp-sh-handle-copy-directory): + Apply `tramp-do-copy-or-rename-file-directly' if possible. + (tramp-do-copy-or-rename-file): Refactor. Handle symlinks. + (Bug#76678) + (tramp-plink-option-exists-p): New defun. + (tramp-ssh-or-plink-options): Rename from + `tramp-ssh-controlmaster-options'. Adapt further plink options. + (tramp-do-copy-or-rename-file-out-of-band) + (tramp-maybe-open-connection): Adapt calls. + (tramp-sh-handle-make-process): Don't set connection property + "remote-pid", it's unused. + (tramp-sh-handle-process-file): Do proper quoting. + (tramp-vc-file-name-handler): Add `file-directory-p', which is + used in `vc-find-root'. (Bug#74026) + (tramp-maybe-open-connection): Use connection property "hop-vector". + (tramp-get-remote-pipe-buf): Make it more robust. + + * lisp/net/tramp-smb.el (tramp-smb-errors): Add string. + (tramp-smb-handle-copy-directory): Don't check existence of + DIRNAME, this is done in `tramp-skeleton-copy-directory' already. + (tramp-smb-handle-copy-file, tramp-smb-handle-rename-file): Refactor. + + * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file): + STDERR is not implemented. + + * lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file): + Don't use the truename. Handle symlinks. + + * lisp/net/tramp.el (tramp-mode): Set to nil on MS-DOS. + (tramp-otp-password-prompt-regexp): Add TACC HPC prompt. + (tramp-wrong-passwd-regexp): Add fingerprint messages. + (tramp-fingerprint-prompt-regexp, tramp-use-fingerprint): + New defcustoms. + (tramp-string-empty-or-nil-p): + Declare `tramp-suppress-trace' property. + (tramp-barf-if-file-missing): Accept also symlinks. + (tramp-skeleton-file-exists-p) + (tramp-handle-file-directory-p): Protect against cyclic symlinks. + (tramp-skeleton-make-symbolic-link): Drop volume letter when flushing. + (tramp-skeleton-process-file): Raise a warning if STDERR is not + implemented. + (tramp-skeleton-set-file-modes-times-uid-gid): Fix typo. + (tramp-compute-multi-hops): Check for + `tramp-sh-file-name-handler-p', it works only for this. + (tramp-handle-shell-command): + Respect `async-shell-command-display-buffer'. + (tramp-action-password, tramp-process-actions): Use connection + property "hop-vector". + (tramp-action-fingerprint, tramp-action-show-message): New defuns. + (tramp-action-show-and-confirm-message): Start check at (point-min). + (tramp-wait-for-regexp): Don't redisplay in `sit-for'. (Bug#73718) + (tramp-convert-file-attributes): Don't cache + "file-attributes-ID-FORMAT". + (tramp-read-passwd, tramp-clear-passwd): Rewrite. (Bug#74105) + + * test/lisp/net/tramp-tests.el (auth-source-cache-expiry) + (ert-batch-backtrace-right-margin): Set them to nil. + (vc-handled-backends): Suppress if noninteractive. + (tramp--test-enabled): Cleanup also + `tramp-compat-temporary-file-directory'. + (tramp-test11-copy-file, tramp-test12-rename-file) + (tramp-test18-file-attributes, tramp--test-deftest-with-stat) + (tramp--test-deftest-with-perl, tramp--test-deftest-with-ls) + (tramp--test-deftest-without-file-attributes) + (tramp-test21-file-links, tramp-test28-process-file) + (tramp-test32-shell-command, tramp-test36-vc-registered) + (tramp-test39-make-lock-file-name, tramp--test-check-files) + (tramp-test42-utf8, tramp-test43-file-system-info) + (tramp-test44-file-user-group-ids, tramp-test47-read-password): + Adapt tests. + (tramp-test47-read-fingerprint): New test. + +2025-03-30 Stefan Monnier + + lisp/emacs-lisp/cl-macs.el (cl-labels): Fix docstring (bug#77348) + +2025-03-29 Dominik Schrempf (tiny change) + + Fix minor issues in documentation of `use-package' + + (Bug#77311) + +2025-03-29 Vincenzo Pupillo + + PHP should be in the PATH, either locally or remotely. (bug#76242). + + * lisp/progmodes/php-ts-mode.el + (php-ts-mode-php-default-executable): Renamed from + 'php-ts-mode-php-executable'. + (php-ts-mode--executable): New function that returns the absolute + filename of the PHP executable, local or remote, based on + 'default-directory'. + (php-ts-mode--anchor-prev-sibling): Replaced 'when-let' with + “when-let*.” + (php-ts-mode--indent-defun): Replaced 'when-let' with + 'when-let*'. + (php-ts-mode-run-php-webserver): Use the new function + (php-ts-mode-php-default-executable). + (run-php): Use the new function (php-ts-mode-php-default-executable). + +2025-03-29 Eli Zaretskii + + Avoid warning when loading 'go-ts-mode' + + * lisp/progmodes/go-ts-mode.el (treesit-ready-p): Silence the + warning if the gomod language library is not installed. + (Bug#77213) + +2025-03-25 Yue Yi + + peg.texi: Fix bug#76555 even a bit more + + * doc/lispref/peg.texi (Parsing Expression Grammars): + Fix other part of the grammar of `define-peg-ruleset` example. + +2025-03-25 Yue Yi + + peg.texi: Fix bug#76555 even a bit more + + * doc/lispref/peg.texi (Parsing Expression Grammars): + Fix grammar of `define-peg-ruleset` example. + +2025-03-25 Stefan Monnier + + PEG: Fix bug#76555 + + * doc/lispref/peg.texi (Parsing Expression Grammars): + Fix `define-peg-ruleset` example. + + * lisp/progmodes/peg.el (define-peg-rule): Fix indent rule. + +2025-03-23 Juri Linkov + + Add a choice to 'dired-movement-style' to restore the previous behavior + + * lisp/dired.el (dired-movement-style): Add new values + 'bounded-files' and 'cycle-files' (bug#76596). + (dired--move-to-next-line): Use new values for users + who prefer the default behavior of Emacs 30.1. + +2025-03-23 Stefan Kangas + + Improve docstring of should-error + + * lisp/emacs-lisp/ert.el (should-error): Improve docstring. + +2025-03-23 Michael Albinus + + Use debian:bookworm for emba tests (don't merge) + + There are problems with treesitter installation from debian:sid. + + * test/infra/Dockerfile.emba (emacs-base): Use debian:bookworm. + (emacs-eglot, emacs-tree-sitter): Use emacs-base. + (emacs-native-comp): Install libgccjit-12-dev. + +2025-03-22 Juri Linkov + + * lisp/treesit.el (treesit-indent-region): Handle markers (bug#77077). + + Ensure that markers are converted to integers for 'beg' and 'end'. + +2025-03-20 Jindrich Makovicka (tiny change) + + Fix OSX build without pdumper + + * Makefile.in (install-arch-dep) [ns_self_contained]: Add missing + DUMPING = pdumper check. + +2025-03-16 Po Lu + + Fix clipboard object handle leak on Android 3.1 to 11.0 + + * src/androidselect.c (extract_fd_offsets): Release retrieved + ParcelFileDescriptor objects on APIs 12 through 30. + +2025-03-16 Eshel Yaron + + Only disable 'completion-preview-active-mode' when it is on + + * lisp/completion-preview.el + (completion-preview--post-command): Avoid calling + 'completion-preview-active-mode' to disable the mode when + already off, since it forces a costly redisplay. (Bug#76964) + +2025-03-15 Jonas Bernoulli + + Backport Transient commit f69e1286 + + 2025-03-12 f69e128654627275e7483a735f670bd53501999d + transient-suffix-object: Handle duplicated command invoked using mouse + + Fixes bug#76680. + +2025-03-15 Eli Zaretskii + + Fix 'whitespace-mode' in CJK locales + + * lisp/international/characters.el (ambiguous-width-chars): Remove + U+00A4 and U+00B7 from the list of ambiguous-width characters. + (cjk-ambiguous-chars-are-wide): Doc fix. (Bug#76852) + +2025-03-13 Yuan Fu + + Fix treesit-parser-create behavior regarding indirect buffers + + The previous fix fixed the problem that treesit-parser-create + always use the current buffer, but that introduce another subtle + problem: if an indirect buffer creates a parser, the parser + saves the base buffer rather than the indirect buffer. In Emacs + 29, if you create a parser in an indirect buffer, the parser + saves the indirect buffer. This change of behavior breaks some + existing use-cases for people using indirect buffer with + tree-sitter. + + In Emacs 31, indirect buffers and base buffer get their own + parser list, so this problem doesn't exist anymore. The fix is + only for Emacs 30. + + * src/treesit.c (Ftreesit_parser_create): Use the buffer that's + given to treesit-parser-create, even if it's an indirect buffer. + +2025-03-13 Eli Zaretskii + + Fix 'dired-movement-style' in Dired when subdirs are shown + + * lisp/dired.el (dired--move-to-next-line): Don't consider + sub-directory lines as empty. (Bug#76596) + +2025-03-11 Sean Whitton + + Correct some outdated docs for hack-local-variables + + * doc/lispref/variables.texi (File Local Variables): + : Say that it applies directory-local + variables too. Add a cross-reference. + (Directory Local Variables): Document dir-local-variables-alist. + * lisp/files.el (hack-local-variables): Say that it always puts + into effect directory-local variables. + +2025-03-10 Michael Albinus + + Add keyword placeholder to tramp.el + + * lisp/net/tramp.el: Add Version, Package-Requires, Package-Type + and URL keywords. + +2025-03-09 Stefan Kangas + + Rewrite ERT manual introduction + + * doc/misc/ert.texi (Top): Rewrite for clarity. Don't give such + prominent mention to to TDD or JUnit, references which now seem dated. + +2025-03-09 Eli Zaretskii + + Document return values of the various read-* functions + + * lisp/textmodes/string-edit.el (read-string-from-buffer): + * lisp/simple.el (read-from-kill-ring, read-shell-command) + (read-signal-name): + * lisp/replace.el (read-regexp-case-fold-search): + * lisp/auth-source.el (read-passwd): + * lisp/subr.el (read-key, read-number): + * lisp/minibuffer.el (read-file-name, read-no-blanks-input): + * lisp/international/mule-cmds.el (read-multilingual-string): + * lisp/language/japan-util.el (read-hiragana-string): + * lisp/files-x.el (read-file-local-variable) + (read-file-local-variable-mode, read-file-local-variable-value): + * lisp/faces.el (read-face-font, read-face-name): + * lisp/simple.el (read-extended-command): + * lisp/env.el (read-envvar-name): + * lisp/files.el (read-directory-name): + * lisp/faces.el (read-color): + * lisp/international/mule-diag.el (read-charset): + * lisp/emacs-lisp/map-ynp.el (read-answer): + * src/coding.c (Fread_coding_system) + (Fread_non_nil_coding_system): + * src/minibuf.c (Fread_command, Fread_from_minibuffer): + * src/lread.c (Fread_char, Fread_char_exclusive, Fread_event): Doc + fixes. + +2025-03-09 Ben Scuron (tiny change) + + Fix TAGS regeneration with Universal Ctags + + * lisp/progmodes/etags-regen.el (etags-regen--append-tags): Move + the "-o" option to before the filename, as Ctags doesn't allow + it to follow the file name. (Bug#76855) + +2025-03-08 Eli Zaretskii + + Fix crash in daemon when "C-x C-c" while a client frame shows tooltip + + * src/frame.c (delete_frame): Ignore tooltip frames when looking + for other frames on the same terminal. (Bug#76842) + + (cherry picked from commit d2445c8c23595efdd444fce6f0c33ba66b596812) + +2025-03-07 Stefan Kangas + + Explicitly document read-string return value + + * src/minibuf.c (Fread_string): Document return value explicitly. + Better document PROMPT argument, and reflow docstring. (Bug#76797) + +2025-03-07 kobarity + + Improve docstrings of python.el import management + + Added notes that when adding import statements for a file that + does not belong to a project, it may take some time to find + candidate import statements in the default directory. + + * lisp/progmodes/python.el (python-add-import) + (python-fix-imports): Improve docstring. (Bug#74894) + +2025-03-06 Eli Zaretskii + + Avoid warnings about 'image-scaling-factor' in builds --without-x + + * lisp/cus-start.el (standard): Exclude 'image-*' options if Emacs + was built without GUI support. (Bug#76716) + +2025-03-06 Eli Zaretskii + + Fix etags tests broken by updating Copyright years + + * test/manual/etags/ETAGS.good_1: + * test/manual/etags/ETAGS.good_2: + * test/manual/etags/ETAGS.good_3: + * test/manual/etags/ETAGS.good_4: + * test/manual/etags/ETAGS.good_5: + * test/manual/etags/ETAGS.good_6: + * test/manual/etags/CTAGS.good: + * test/manual/etags/CTAGS.good_crlf: + * test/manual/etags/CTAGS.good_update: Update. (Bug#76744) + +2025-03-06 Mauro Aranda + + Fix some widgets in customize-dirlocals + + * lisp/cus-edit.el (custom-dynamic-cons-value-create): Make sure + to eval the keymap property. (Bug#76756) + +2025-03-05 Thierry Volpiatto + + Fix register-use-preview behavior with never value + + Allow popping up preview when pressing C-h. + + Don't exit the minibuffer when the call to + register-read-with-preview-fancy is triggered by C-h. + + * lisp/register.el (register-read-with-preview-fancy): Do it. + +2025-03-05 Po Lu + + Move java/incrementing-version-code to AndroidManifest.xml.in + + * admin/admin.el (admin-android-version-code-regexp): New + variable. + (set-version): Modify AndroidManifest.xml.in instead. + + * java/AndroidManifest.xml.in (Version-code): Define version + code. + + * java/incrementing-version-code: Delete file. + +2025-03-05 Peter Oliver + + Provide an Android version code derived from the Emacs version + + The version code is intended to be an integer that increments + for each Android package release + (https://developer.android.com/studio/publish/versioning#versioningsettings). + + If we keep this updated under version control, then F-Droid (a + third-party Android package repository), can watch for that, and + use it to automatically build Emacs packages for Android each + time a new Emacs release is tagged + (https://f-droid.org/en/docs/Build_Metadata_Reference/#UpdateCheckData). + + * admin/admin.el (set-version): Update version code in + java/incrementing-version-code + * java/incrementing-version-code: New file containing an Android + version code corresponding to the current Emacs version. + (bug#75809) + +2025-03-04 Vitaliy Chepelev (tiny change) + + image-dired: Don't croak on file names with regexp characters + + * lisp/image/image-dired-dired.el (image-dired-mark-tagged-files): + * lisp/image/image-dired-tags.el (image-dired-get-comment) + (image-dired-write-comments, image-dired-list-tags) + (image-dired-remove-tag, image-dired-write-tags): Quote file name + for search-forward-regexp. (Bug#73445) + + (cherry picked from commit 7930fe2f44f50b6a7abf5fbe1218dcc15e85b28d) + +2025-03-04 Po Lu + + Document requirements respecting XDG MIME databases on Android + + * doc/emacs/android.texi (Android Software): State that librsvg + requires a MIME database to display embedded images, and how to + acquire such a database. + +2025-03-02 Pip Cet + + Improve instructions for running with -fsanitize=address (bug#76393) + + * etc/DEBUG (ASAN_OPTIONS): Add 'detect_stack_use_after_return=0' + requirement. Remove obsolete unexec commentary. + + (cherry picked from commit 1e84a8767692f9f3a3bc37eba8eeb8f9d537322d) + +2025-03-01 Dmitry Gutov + + Fix the use of xref-window-local-history together with Xref buffer + + * lisp/progmodes/xref.el (xref--push-markers): Temporarily + restore the selected window as well, using the value from the + new argument (bug#76565). Update both callers. + +2025-03-01 Dmitry Gutov + + completing-read-multiple: Fix support for ":" as separator + + * lisp/emacs-lisp/crm.el (completing-read-multiple): + Do not search for separators inside the prompt (bug#76461). + +2025-03-01 Eli Zaretskii + + Fix 'M-q' in 'makefile-mode' + + * lisp/progmodes/make-mode.el (makefile-mode-map): Bind 'M-q' to + 'fill-paragraph', as 'prog-mode's default binding is not + appropriate for Makefile's syntax. (Bug#76641) + +2025-03-01 Randy Taylor + + Fix go-ts-mode const_spec highlighting (Bug#76330) + + * lisp/progmodes/go-ts-mode.el (go-ts-mode--font-lock-settings): + Handle multiple const_spec identifiers. + * test/lisp/progmodes/go-ts-mode-resources/font-lock.go: + Add test case. + +2025-03-01 Stefan Kangas + + keymaps.texi: Move "Changing Key Bindings" section up + + * doc/lispref/keymaps.texi (Changing Key Bindings): Move section + up. (Bug#52821) + +2025-03-01 Stefan Kangas + + keymaps.texi: Move "Key Sequences" section down + + * doc/lispref/keymaps.texi (Key Sequences): Move section + down. (Bug#52821) + +2025-03-01 Stefan Kangas + + Improve process-get/process-put docstrings + + * lisp/subr.el (process-get, process-put): Explain the purpose of these + functions in the docstring. + +2025-02-28 Michael Albinus + + Fix recent change in diff-no-select + + * lisp/vc/diff.el (diff-no-select): Keep initial default directory + in *Diff* buffer. + +2025-02-28 Po Lu + + Prevent rare freeze on Android 4.2 through 4.4 + + * src/android.c (android_run_select_thread, android_init_events) + (android_select): Enable self-pipes on all Android versions <= 21. + The Android C library provides a functioning pselect on these + systems, but it does not apply the signal mask atomically. + (android_run_select_thread): Correct typo. This never produced + any adverse consequences, as the relevant signals would already + have been blocked by `setupSystemThread'. + + Do not merge to master. + +2025-02-28 Michael Albinus + + * lisp/proced.el (proced-<): Check, that NUM1 and NUM2 are numbers. + + (Bug#76549) + +2025-02-28 Eli Zaretskii + + Fix mouse-2 clicks on mode line and header line + + * src/keymap.c (Fcurrent_active_maps): For clicks on mode-line and + header-line, always override the keymaps at buffer position. + (Bug#75219) + + (cherry picked from commit c41ea047a434710c4b7bc8280695c83fbe5fff35) + +2025-02-27 Stefan Kangas + + Recommend secure-hash in md5 docstring + + * src/fns.c (Fmd5): Repeat explanation from manual about md5 being + "semi-obsolete", and recommend using secure-hash instead. + +2025-02-27 Tomas Nordin + + Improve docstring of add-hook and remove-hook + + * lisp/subr.el (add-hook, remove-hook): Remove detail about setting to + nil and talk about functions instead of hooks. (Bug#72915) + +2025-02-27 Jared Finder + + * lisp/subr.el (read-key): Add 'tab-line' (bug#76408). + + Backport: + (cherry picked from commit 0c8abe8bb5072c46a93585cb325c249f85f3d9c2) + +2025-02-27 Paul Eggert + + Fix fns-tests-collate-strings failure with musl + + * test/src/fns-tests.el (fns-tests-collate-strings): + Don’t assume "en_XY.UTF-8", or any particular string, + is an invalid locale, as they all seem to be valid in musl. + Instead, simply test that a non-string is invalid. + (Bug#76550) + +2025-02-26 Eli Zaretskii + + Fix setup of coding-systems on MS-Windows + + * src/emacs.c (main) [HAVE_PDUMPER] [WINDOWSNT]: Call + 'w32_init_file_name_codepage' again after loading the pdumper + file. + * src/w32.c (w32_init_file_name_codepage) [HAVE_PDUMPER]: + Reinitialize additional variables. (Bug#75207) + + (cherry picked from commit cc5cd4de93d1e5ba205cbf0c370aef4559bc342b) + +2025-02-25 Basil L. Contovounesios + + Fix ert-font-lock macro signatures + + * doc/misc/ert.texi (Syntax Highlighting Tests): + * test/lisp/emacs-lisp/ert-font-lock-tests.el + (test-line-comment-p--emacs-lisp, test-line-comment-p--shell-script) + (test-line-comment-p--javascript, test-line-comment-p--python) + (test-line-comment-p--c, test-macro-test--correct-highlighting) + (test-macro-test--docstring, test-macro-test--failing) + (test-macro-test--file, test-macro-test--file-no-asserts) + (test-macro-test--file-failing): Reindent macro calls. + (with-temp-buffer-str-mode): Evaluate macro arguments left-to-right. + (ert-font-lock--wrap-begin-end): Use rx for more robust composition. + (test-line-comment-p--php): Require that php-mode is callable, not + already loaded. + + * lisp/emacs-lisp/ert-font-lock.el (ert-font-lock-deftest) + (ert-font-lock-deftest-file): NAME is not followed by an empty list + like in ert-deftest, so the optional DOCSTRING is actually the + second argument. Adapt calling convention in docstring, and debug, + doc-string, and indent properties accordingly (bug#76372). Fix + docstring grammar, document MAJOR-MODE, and avoid referring to a + file name as a path. + +2025-02-24 Eli Zaretskii + + Fix a typo in 'window_text_pixel_size' + + This typo caused strange mis-behaviors in buffers + with non-ASCII characters. + * src/xdisp.c (window_text_pixel_size): Fix typo. (Bug#76519) + +2025-02-24 Ulrich Müller + + * doc/misc/efaq.texi (New in Emacs 30): Fix typo. (Bug#76518) + +2025-02-23 Joseph Turner + + Upgrade out-of-date VC package dependencies + + * lisp/emacs-lisp/package-vc.el (package-vc-install-dependencies): Pass + the specified package version when checking if a package is installed. + + (Bug#73781) + + (cherry picked from commit 71a4670a9fa238f920ce88b938f703b605ad2f48) + +2025-02-23 Vincenzo Pupillo + + Constant highlighting no longer captures Java annotations + + * lisp/progmodes/java-ts-mode.el + (java-ts-mode--fontify-constant): New function. + (java-ts-mode--font-lock-settings): Use it. + +2025-02-23 Stefan Kangas + + Improve wording of lsh docstring + + * lisp/subr.el (lsh): Improve wording of docstring. + +2025-02-23 Stefan Kangas + + Don't document deleted xwidget functions + + * doc/lispref/display.texi (Xwidgets): Don't document deleted function + xwidget-webkit-execute-script-rv. Fix name of deleted and then re-added + function xwidget-webkit-title. + +2025-02-23 Michael Albinus + + Use a persistent directory as default directory in diff + + * lisp/vc/diff.el (diff-no-select): Use `temporary-file-directory' + as default directory. Set default file permissions temporarily to + #o600. (Bug#69606) + + (cherry picked from commit ae439cc1b9f428a8247548f4ef3b992608a3c09b) + +2025-02-23 Stefan Kangas + + Sync build-aux/update-copyright from Gnulib + + * build-aux/update-copyright: Copy from Gnulib. This fixes a bug + where troff markers were introduced in ChangeLog files. + (Do not merge to master.) + +2025-02-23 Stefan Kangas + + Minor refactoring in admin/admin.el + + * admin/admin.el (admin--read-root-directory): + (admin--read-version): New functions. + (add-release-logs, set-version, set-copyright, make-manuals) + (make-manuals-dist, make-news-html-file): Use above new function. + +2025-02-23 Stefan Kangas + + Bump Emacs version to 30.1.50 + + * README: + * configure.ac: + * etc/NEWS: + * exec/configure.ac: + * msdos/sed2v2.inp: + * nt/README.W32: Bump Emacs version to 30.1.50. + +2025-02-23 Stefan Kangas + + Release Emacs 30.1 + + * ChangeLog.5: New file. + * Makefile.in (CHANGELOG_HISTORY_INDEX_MAX): Bump. + * etc/HISTORY: Add Emacs 30.1. + 2025-02-23 Stefan Kangas * Version 30.1 released. This file records repository revisions from commit 1cda0967b4d3c815fc610794ad6a8fc2b913a3c5 (exclusive) to -commit bcba098505e4f80eef41e4be9726f1f9868223f3 (inclusive). +commit 299d3a440121ff6692a85615ff97e6ad4dde91db (inclusive). See ChangeLog.4 for earlier changes. ;; Local Variables: diff --git a/configure.ac b/configure.ac index f98974bc5aa..0b191312bd3 100644 --- a/configure.ac +++ b/configure.ac @@ -1885,6 +1885,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-format-signedness]) gl_WARN_ADD([-Wno-missing-braces]) gl_WARN_ADD([-Wno-null-pointer-arithmetic]) gl_WARN_ADD([-Wno-implicit-const-int-float-conversion]) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 0ad4f52bfc0..7f14e002892 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2808,6 +2808,9 @@ Note that a frame cannot be deleted as long as its minibuffer serves as surrogate minibuffer for another frame (@pxref{Minibuffers and Frames}). Normally, you cannot delete a frame if all other frames are invisible, but if @var{force} is non-@code{nil}, then you are allowed to do so. +Also, the initial terminal frame of an Emacs process running as daemon +(@pxref{Initial Options, daemon,, emacs, The GNU Emacs Manual}) can be +deleted if and only if @var{force} is non-@code{nil}. @end deffn @defun frame-live-p frame diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 87ebb787250..7fa64b72999 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -221,6 +221,26 @@ Functions}. Instead of using this variable, it is cleaner to use another, newer feature: to pass the function as the @var{read-function} argument to @code{eval-region}. @xref{Definition of eval-region,, Eval}. +@end defvar + +@defun load-path-filter-cache-directory-files path filename suffixes +This function filters @var{path} to remove any directories that could +not hold @var{filename} with any of @var{suffixes}, and returns the +filtered list of directories. The function caches the directories it +scans and the files inside them, and uses the cache in subsequent calls, +which speeds up repeated lookups of files in @var{path}. +@end defun + +@defvar load-path-filter-function +If this variable names a function, @code{load} will call that function +when it scans @code{load-path} to find files. The function will be +called with 3 arguments: the value of @code{load-path}, @var{filename}, +the name of a file being looked up as passed to @code{load}, and a list +of suffixes to append to @var{filename}. It should return a shorter +list of directories where @var{filename} can reside, thus making the +lookup faster. The function +@code{load-path-filter-cache-directory-files} is a good candidate to be +such a function. @end defvar For information about how @code{load} is used in building Emacs, see diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index aa321785460..2ff2e5f6160 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -644,6 +644,14 @@ 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} error. +@cindex printed representation, of treesit nodes +The printed representation of a tree-sitter node uses the hash notation +described in @ref{Printed Representation}. It looks like +@w{@samp{#}}, where +@var{type} is the type of the node (which comes from the tree-sitter +grammar used by the buffer), and @var{pos1} and @var{pos2} are buffer +positions of the node's span. Tree-sitter nodes have no read syntax. + @heading Retrieving nodes from syntax tree @cindex retrieving tree-sitter nodes @cindex syntax tree, retrieving nodes @@ -684,7 +692,7 @@ Example: @group ;; Find the node at point in a C parser's syntax tree. (treesit-node-at (point) 'c) - @result{} # + @result{} # @end group @end example @end defun @@ -791,7 +799,7 @@ This function finds the child of @var{node} whose field name is @group ;; Get the child that has "body" as its field name. (treesit-node-child-by-field-name node "body") - @result{} # + @result{} # @end group @end example @end defun @@ -1619,14 +1627,16 @@ documentation about pattern-matching. The documentation can be found at It's often useful to be able to identify and find certain @dfn{things} in a buffer, like function and class definitions, statements, code blocks, -strings, comments, etc. Emacs allows users to define what kind of -tree-sitter node corresponds to a ``thing''. This enables handy -features like jumping to the next function, marking the code block at -point, or transposing two function arguments. +strings, comments, etc., in terms of node types defined by the +tree-sitter grammar used in the buffer. Emacs allows Lisp programs to +define what kinds of tree-sitter nodes corresponds to each ``thing''. +This enables handy features like jumping to the next function, marking +the code block at point, transposing two function arguments, etc. The ``things'' feature in Emacs is independent of the pattern matching -feature of tree-sitter, and comparatively less powerful, but more -suitable for navigation and traversing the parse tree. +feature of tree-sitter (@pxref{Pattern Matching}), and comparatively +less powerful, but more suitable for navigation and traversing the +buffer text in terms of the tree-sitter parse tree. @findex treesit-thing-definition @findex treesit-thing-defined-p @@ -1635,12 +1645,22 @@ predicate of a defined thing with @code{treesit-thing-definition}, and test if a thing is defined with @code{treesit-thing-defined-p}. @defvar treesit-thing-settings -This is an alist of thing definitions for each language. The key of -each entry is a language symbol, and the value is a list of thing -definitions of the form @w{@code{(@var{thing} @var{pred})}}, where -@var{thing} is a symbol representing the thing, like @code{defun}, -@code{sexp}, or @code{sentence}; and @var{pred} specifies what kind of -tree-sitter node is this @var{thing}. +This is an alist of thing definitions for each language supported by the +grammar used in a buffer; it should be defined by the buffer's major +mode (the default value is @code{nil}). The key of each entry is a +language symbol (e.g., @code{c} for C, @code{cpp} for C@t{++}, etc.), +and the value is a list of thing definitions of the form +@w{@code{(@var{thing} @var{pred})}}, where @var{thing} is a symbol +representing the thing, and @var{pred} specifies what kinds of +tree-sitter nodes are considered as this @var{thing}. + +@cindex @code{sexp}, treesit-defined thing +@cindex @code{list}, treesit-defined thing +The symbol used to define the @var{thing} can be anything meaningful for +the major mode: @code{defun}, @code{defclass}, @code{sentence}, +@code{comment}, @code{string}, etc. To support tree-sitter based +navigation commands (@pxref{List Motion}), the mode should define two +things: @code{list} and @code{sexp}. @var{pred} can be a regexp string that matches the type of the node; it can be a function that takes a node as the argument and returns a @@ -1660,13 +1680,16 @@ meaning that not satisfying @var{pred} qualifies the node. Finally, @var{pred} can refer to other @var{thing}s defined in this list. For example, @w{@code{(or sexp sentence)}} defines something that's either a @code{sexp} thing or a @code{sentence} thing, as defined -by some other rule in the alist. +by some other rules in the alist. +@cindex @code{named}, treesit-defined thing +@cindex @code{anonymous}, treesit-defined thing There are two pre-defined predicates: @code{named} and @code{anonymous}, -which qualify, respectively, named and anonymous nodes. They can be -combined with @code{and} to narrow down the match. +which qualify, respectively, named and anonymous nodes of the +tree-sitter grammar. They can be combined with @code{and} to narrow +down the match. -Here's an example @code{treesit-thing-settings} for C and C++: +Here's an example @code{treesit-thing-settings} for C and C@t{++}: @example @group @@ -1676,6 +1699,8 @@ Here's an example @code{treesit-thing-settings} for C and C++: (comment "comment") (string "raw_string_literal") (text (or comment string))) +@end group +@group (cpp (defun ("function_definition" . cpp-ts-mode-defun-valid-p)) (defclass "class_specifier") @@ -1685,12 +1710,12 @@ Here's an example @code{treesit-thing-settings} for C and C++: @noindent Note that this example is modified for didactic purposes, and isn't -exactly how C and C@t{++} modes define things. +exactly how tree-sitter based C and C@t{++} modes define things. @end defvar -Emacs builtin functions already make use some thing definitions. +Emacs builtin functions already make use of some thing definitions. Command @code{treesit-forward-sexp} uses the @code{sexp} definition if -major mode defines it; @code{treesit-forward-list}, +major mode defines it (@pxref{List Motion}); @code{treesit-forward-list}, @code{treesit-down-list}, @code{treesit-up-list}, @code{treesit-show-paren-data} use the @code{list} definition (its symbol @code{list} has the symbol property @code{treesit-thing-symbol} @@ -1699,8 +1724,8 @@ to avoid ambiguity with the function that has the same name); Defun movement functions like @code{treesit-end-of-defun} uses the @code{defun} definition (@code{defun} definition is overridden by @var{treesit-defun-type-regexp} for backward compatibility). Major -modes can also define @code{comment}, @code{string}, @code{text} -(generally comments and strings). +modes can also define @code{comment}, @code{string}, and @code{text} +things (to match comments and strings). The rest of this section lists a few functions that take advantage of the thing definitions. Besides the functions below, some other @@ -1709,10 +1734,10 @@ tree-traversing functions like @code{treesit-search-forward}, @code{treesit-induce-sparse-tree}, etc. @xref{Retrieving Nodes}. @defun treesit-node-match-p node thing &optional ignore-missing -This function checks whether @var{node} is a @var{thing}. +This function checks whether @var{node} represents a @var{thing}. -If @var{node} is a @var{thing}, return non-@code{nil}, otherwise return -@code{nil}. For convenience, if @code{node} is @code{nil}, this +If @var{node} represents @var{thing}, return non-@code{nil}, otherwise +return @code{nil}. For convenience, if @code{node} is @code{nil}, this function just returns @code{nil}. The @var{thing} can be either a thing symbol like @code{defun}, or @@ -1727,8 +1752,9 @@ undefined and just returns @code{nil}; but it still signals the error if @end defun @defun treesit-thing-prev position thing -This function returns the first node before @var{position} that is the -specified @var{thing}. If no such node exists, it returns @code{nil}. +This function returns the first node before @var{position} in the +current buffer that is the specified @var{thing}. If no such node +exists, it returns @code{nil}. It's guaranteed that, if a node is returned, the node's end position is less or equal to @var{position}. In other words, this function never returns a node that encloses @var{position}. @@ -1753,8 +1779,9 @@ function doesn't move point. A positive @var{arg} means moving forward that many instances of @var{thing}; negative @var{arg} means moving backward. If @var{side} is -@code{beg}, this function stops at the beginning of @var{thing}; if -@code{end}, stop at the end of @var{thing}. +@code{beg}, this function returns the position of the beginning of +@var{thing}; if it's @code{end}, it returns the position at the end of +@var{thing}. Like in @code{treesit-thing-prev}, @var{thing} can be a thing symbol defined in @code{treesit-thing-settings}, or a predicate. @@ -1780,8 +1807,8 @@ less or equal to @var{position}, and it's end position is greater or equal to @var{position}. If @var{strict} is non-@code{nil}, this function uses strict comparison, -i.e., start position must be strictly greater than @var{position}, and end -position must be strictly less than @var{position}. +i.e., start position must be strictly smaller than @var{position}, and end +position must be strictly greater than @var{position}. @var{thing} can be either a thing symbol defined in @code{treesit-thing-settings}, or a predicate. diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 9e498b56bb4..9481782d552 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -616,7 +616,10 @@ This matches horizontal whitespace, as defined by Annex C of the Unicode Technical Standard #18. In particular, it matches spaces, tabs, and other characters whose Unicode @samp{general-category} property (@pxref{Character Properties}) indicates they are spacing -separators. +separators. (If you only need to look for ASCII whitespace characters, +we suggest using an explicit set of character alternatives, such as +@w{@samp{[ \t]}}, instead, as it will be faster than +@code{[[:blank:]]}.) @item [:cntrl:] This matches any character whose code is in the range 0--31. @item [:digit:] diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index 4dcadb29dfa..3bb8beddcd3 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -31,7 +31,7 @@ General Public License for more details. @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.8.6 +@subtitle for version 0.9.1 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial, available at @uref{https://github.com/positron-solutions/transient-showcase}. @noindent -This manual is for Transient version 0.8.6. +This manual is for Transient version 0.9.1. @insertcopying @end ifnottex @@ -216,13 +216,14 @@ A transient prefix command is invoked like any other command by pressing the key that is bound to that command. The main difference to other commands is that a transient prefix command activates a transient keymap, which temporarily binds the transient's infix and -suffix commands, and that those bindings are displayed in a transient -menu, displayed in a popup buffer. Bindings from other keymaps may, -or may not, be disabled while the transient state is in effect. +suffix commands, and that those bindings are shown in menu buffer, +which is displayed in a new window, until the menu is exited. +Bindings from other keymaps may, or may not, be disabled while the +transient state is in effect. There are two kinds of commands that are available after invoking a transient prefix command; infix and suffix commands. Infix commands -set some value (which is then shown in the popup buffer), without +set some value (which is then shown in the menu buffer), without leaving the transient. Suffix commands, on the other hand, usually quit the transient and they may use the values set by the infix commands, i.e., the infix @strong{arguments}. @@ -249,7 +250,7 @@ prefix key, but not the complete transient). A transient prefix command can be bound as a suffix of another transient. Invoking such a suffix replaces the current transient state with a new transient state, i.e., the available bindings change -and the information displayed in the popup buffer is updated +and the information displayed in the menu buffer is updated accordingly. Pressing @kbd{C-g} while a nested transient is active only quits the innermost transient, causing a return to the previous transient. @@ -308,37 +309,60 @@ if any. @cindex common suffix commands A few shared suffix commands are available in all transients. These -suffix commands are not shown in the popup buffer by default. +suffix commands are not shown permanently in every menu by default. +Most of these commands share a common prefix key and pressing that key +causes the common commands to be temporarily shown in the active menu. -This includes the aborting commands mentioned in the previous section, -as well as some other commands that are all bound to @kbd{C-x @var{KEY}}. After -@kbd{C-x} is pressed, a section featuring all these common commands is -temporarily shown in the popup buffer. After invoking one of them, -the section disappears again. Note, however, that one of these -commands is described as ``Show common permanently''; invoke that if you -want the common commands to always be shown for all transients. +@defopt transient-show-common-commands +This option controls whether shared suffix commands are permanently +shown alongside the menu-specific infix and suffix commands. By +default, the shared commands are not permanently shown to avoid +wasting precious space and overwhelming the user with too many +choices. + +If you prefer to always see these commands, then set this option to +a non-@code{nil} value. Alternatively the value can be toggled for the +current Emacs session only, using @code{transient-toggle-common}, described +below. +@end defopt + +@defopt transient-common-command-prefix +This option specifies the prefix key used in all transient menus +to invoke most of the shared commands, which are available in all +transient menus. By default these bindings are only shown after +pressing that prefix key and before following that up with a valid +key binding (but see the previous option). + +For historic reasons @kbd{C-x} is used by default, but users are +encouraged to pick another key, preferably one that is not commonly +used in Emacs but is still convenient to them. + +Usually, while a transient menu is active, the user cannot invoke +commands that are not bound in the menu itself. For those menus it +does not matter, if @kbd{C-x} or another commonly used prefix key is used +for common menu commands. However, certain other, newer menus do +not suppress key bindings established outside the menu itself, and +in those cases a binding for a common menu command could shadow an +external binding. For example, @kbd{C-x C-s} could not be used to invoke +@code{save-buffer}, if that binding is shadowed by the menu binding for +@code{transient-save}. + +Which key is most suitable depends on the user's preferences, but +good choices may include function keys and @kbd{C-z} (for many keyboard +layouts @kbd{z} is right next to @kbd{x}, and invoking @code{suspend-frame}, while a +transient menu is active, would not be a good idea anyway). +@end defopt @table @asis @item @kbd{C-x t} (@code{transient-toggle-common}) @kindex C-x t @findex transient-toggle-common -This command toggles whether the generic commands that are common to -all transients are always displayed or only after typing the -incomplete prefix key sequence @kbd{C-x}. This only affects the current +This command toggles whether the generic commands, that are common +to all transients, are permanently displayed or only after typing +the incomplete prefix key sequence@kbd{}. This only affects the current Emacs session. @end table -@defopt transient-show-common-commands -This option controls whether shared suffix commands are shown -alongside the transient-specific infix and suffix commands. By -default, the shared commands are not shown to avoid overwhelming -the user with too many options. - -While a transient is active, pressing @kbd{C-x} always shows the common -commands. The value of this option can be changed for the current -Emacs session by typing @kbd{C-x t} while a transient is active. -@end defopt - The other common commands are described in either the previous or in one of the following sections. @@ -363,6 +387,10 @@ suffix command, then the value is merely saved to the transient's history. That value won't be used when the transient is next invoked, but it is easily accessible (@pxref{Using History}). +Option @code{transient-common-command-prefix} controls the prefix key used +in the following bindings. For simplicity's sake the default, @kbd{C-x}, +is shown below. + @table @asis @item @kbd{C-x s} (@code{transient-set}) @kindex C-x s @@ -397,6 +425,10 @@ value is saved to its history. These values can be cycled through, the same way one can cycle through the history of commands that read user-input in the minibuffer. +Option @code{transient-common-command-prefix} controls the prefix key used +in the following bindings. For simplicity's sake the default, @kbd{C-x}, +is shown below. + @table @asis @item @kbd{C-M-p} (@code{transient-history-prev}) @itemx @kbd{C-x p} @@ -496,8 +528,8 @@ For suffixes, 0 is also valid; it means that the suffix is not displayed at any level. The levels of individual transients and/or their individual suffixes -can be changed interactively, by invoking the transient and then -pressing @kbd{C-x l} to enter the ``edit'' mode, see below. +can be changed interactively, by invoking the menu and entering its +``edit'' mode using the command @code{transient-set-level}, as described below. The default level for both transients and their suffixes is 4. The @code{transient-default-level} option only controls the default for @@ -518,6 +550,10 @@ This option names the file that is used to persist the levels of transients and their suffixes between Emacs sessions. @end defopt +Option @code{transient-common-command-prefix} controls the prefix key used +in the following bindings. For simplicity's sake the default, @kbd{C-x}, +is shown below. + @table @asis @item @kbd{C-x l} (@code{transient-set-level}) @kindex C-x l @@ -606,13 +642,13 @@ window, and the key bindings are the same as for @code{scroll-up-command} and @code{scroll-down-command} in other buffers. @deffn Command transient-scroll-up arg -This command scrolls text of transient popup window upward @var{ARG} +This command scrolls text of transient's menu window upward @var{ARG} lines. If @var{ARG} is @code{nil}, then it scrolls near full screen. This is a wrapper around @code{scroll-up-command} (which see). @end deffn @deffn Command transient-scroll-down arg -This command scrolls text of transient popup window down @var{ARG} +This command scrolls text of transient's menu window down @var{ARG} lines. If @var{ARG} is @code{nil}, then it scrolls near full screen. This is a wrapper around @code{scroll-down-command} (which see). @end deffn @@ -642,45 +678,33 @@ More options are described in @ref{Common Suffix Commands}, in @ref{Saving Value @anchor{Essential Options} @subheading Essential Options -Also see @ref{Common Suffix Commands}. +Two more essential options are documented in @ref{Common Suffix Commands}. @defopt transient-show-popup -This option controls whether the current transient's infix and -suffix commands are shown in the popup buffer. +This option controls whether and when transient's menu buffer is +shown. @itemize @item -If @code{t} (the default) then the popup buffer is shown as soon as a +If @code{t} (the default), then the buffer is shown as soon as a transient prefix command is invoked. @item -If @code{nil}, then the popup buffer is not shown unless the user -explicitly requests it, by pressing an incomplete prefix key -sequence. +If @code{nil}, then the buffer is not shown unless the user explicitly +requests it, by pressing an incomplete prefix key sequence. @item If a number, then the a brief one-line summary is shown instead of -the popup buffer. If zero or negative, then not even that summary +the menu buffer. If zero or negative, then not even that summary is shown; only the pressed key itself is shown. -The popup is shown when the user explicitly requests it by +The buffer is shown once the user explicitly requests it by pressing an incomplete prefix key sequence. Unless this is zero, -the popup is shown after that many seconds of inactivity (using -the absolute value). +the menu is shown after that many seconds of inactivity (using the +absolute value). @end itemize @end defopt -@defopt transient-show-common-commands -This option controls whether shared suffix commands are shown -alongside the transient-specific infix and suffix commands. By -default, the shared commands are not shown to avoid overwhelming -the user with too many options. - -While a transient is active, pressing @kbd{C-x} always shows the common -commands. The value of this option can be changed for the current -Emacs session by typing @kbd{C-x t} while a transient is active. -@end defopt - @defopt transient-show-during-minibuffer-read This option controls whether the transient menu continues to be displayed while the minibuffer is used to read user input. @@ -724,15 +748,15 @@ element has to be accessed the same way as the older elements. @end defopt @defopt transient-enable-popup-navigation -This option controls whether navigation commands are enabled in the -transient popup buffer. If the value is @code{verbose} (the default), +This option controls whether navigation commands are enabled in +transient's menu buffer. If the value is @code{verbose} (the default), brief documentation about the command under point is additionally show in the echo area. -While a transient is active the transient popup buffer is not the -current buffer, making it necessary to use dedicated commands to act -on that buffer itself. If this option is non-@code{nil}, then the -following features are available: +While a transient is active the menu buffer is not the current +buffer, making it necessary to use dedicated commands to act on that +buffer itself. If this option is non-@code{nil}, then the following +features are available: @itemize @item @@ -744,7 +768,7 @@ following features are available: @item @kbd{mouse-1} invokes the clicked on suffix. @item -@kbd{C-s} and @kbd{C-r} start isearch in the popup buffer. +@kbd{C-s} and @kbd{C-r} start isearch in the menu buffer. @end itemize By default @kbd{M-@key{RET}} is bound to @code{transient-push-button}, instead of @@ -754,8 +778,8 @@ if no transient were active." @end defopt @defopt transient-display-buffer-action -This option specifies the action used to display the transient popup -buffer. The transient popup buffer is displayed in a window using +This option specifies the action used to display the transient's +menu buffer. The menu buffer is displayed in a window using @code{(display-buffer @var{BUFFER} transient-display-buffer-action)}. The value of this option has the form @code{(@var{FUNCTION} . @var{ALIST})}, @@ -815,7 +839,7 @@ dimensions. @subheading Auxiliary Options @defopt transient-mode-line-format -This option controls whether the transient popup buffer has a +This option controls whether transient's menu buffer has a mode-line, separator line, or neither. If @code{nil}, then the buffer has no mode-line. If the buffer is not @@ -895,7 +919,7 @@ optimized for lisp. @defopt transient-align-variable-pitch This option controls whether columns are aligned pixel-wise in the -popup buffer. +menu buffer. If this is non-@code{nil}, then columns are aligned pixel-wise to support variable-pitch fonts. Keys are not aligned, so you should use a @@ -909,10 +933,10 @@ the @code{default} face. @defopt transient-force-fixed-pitch This option controls whether to force the use of a monospaced font -in popup buffer. Even if you use a proportional font for the -@code{default} face, you might still want to use a monospaced font in -transient's popup buffer. Setting this option to @code{t} causes @code{default} -to be remapped to @code{fixed-pitch} in that buffer. +in menu buffer. Even if you use a proportional font for the @code{default} +face, you might still want to use a monospaced font in the menu +buffer. Setting this option to @code{t} causes @code{default} to be remapped to +@code{fixed-pitch} in that buffer. @end defopt @anchor{Developer Options} @@ -934,6 +958,13 @@ predicates of those suffixes prevent that more than one of them is enabled at a time. @end defopt +@defopt transient-error-on-insert-failure +This option controls whether to signal an error when +@code{transient-insert-suffix} or @code{transient-append-suffix} failed to insert +a suffix into an existing prefix. By default a warning is shown +instead. +@end defopt + @defopt transient-highlight-higher-levels This option controls whether suffixes that would not be available by default are highlighted. @@ -949,7 +980,13 @@ same customization. @subheading Hook Variables @defvar transient-exit-hook -This hook is run after a transient is exited. +This hook is run after a transient menu is exited, even if another +transient menu becomes active at the same time. +@end defvar + +@defvar transient-post-exit-hook +This hook is run after a transient menu is exited, provided no other +transient menu becomes active at the same time. @end defvar @defvar transient-setup-buffer-hook @@ -973,7 +1010,7 @@ with an example: @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}. +after the infix argument that is bound to @code{-3} in @code{magit-patch-apply}. The following functions share a few arguments: @@ -981,6 +1018,9 @@ The following functions share a few arguments: @item @var{PREFIX} is a transient prefix command, a symbol. +PREFIX may also by a symbol identifying a separately defined group, +which can be included in multiple prefixes. See TODO@. + @item @var{SUFFIX} is a transient infix or suffix specification in the same form as expected by @code{transient-define-prefix}. Note that an infix is a @@ -992,25 +1032,33 @@ means the former. @xref{Suffix Specifications}. @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 -last element may also be a command or key). For example @code{(1 0 -1)} +@var{LOC} is a key description (a string as returned by @code{key-description} +and understood by @code{kbd}), a command, a symbol identifying an included +group, or a vector specifying coordinates. For example, @code{[1 0 -1]} identifies the last suffix (@code{-1}) of the first subgroup (@code{0}) of the second group (@code{1}). -If @var{LOC} is a list of coordinates, then it can be used to identify a -group, not just an individual suffix command. +If @var{LOC} is a vector, then it can be used to identify a group, not +just an individual suffix command. The last element in a vector may +also be a symbol or key, in which case the preceding elements must +match a group and the last element is looked up within that group. The function @code{transient-get-suffix} can be useful to determine whether -a certain coordination list identifies the suffix or group that you +a certain coordinate vector identifies the suffix or group that you expect it to identify. In hairy cases it may be necessary to look -at the definition of the transient prefix command. +at the internal layout representation, which you can access using +the function @code{transient--get-layout}. @end itemize These functions operate on the information stored in the -@code{transient--layout} property of the @var{PREFIX} symbol. Suffix entries in -that tree are not objects but have the form @code{(@var{LEVEL} @var{CLASS} @var{PLIST})}, where -@var{PLIST} should set at least @code{:key}, @code{:description} and @code{:command}. +@code{transient--layout} property of the @var{PREFIX} symbol. Elements in that +tree are not objects but have the form @code{(@var{CLASS} @var{PLIST}) for suffixes} and +[CLASS PLIST CHILDREN] for groups. At the root of the tree is an +element [N nil CHILDREN], where N is the version of the layout format, +currently and hopefully for a long time 2. While that element looks +like a group vector, that element does not count when identifying a +group using a coordinate vector, i.e., [0] is its first child, not the +root element itself. @defun transient-insert-suffix prefix loc suffix &optional keep-other @end defun @@ -1024,8 +1072,8 @@ that multiple suffix commands can be bound to the same key, provided they are never active at the same time, see @ref{Predicate Slots}. Unfortunately both false-positives and false-negatives are possible. -To deal with the former use non-@code{nil} @var{KEEP-OTHER@.} The symbol @code{always} -prevents the removal of a false-positive in some cases where other +To deal with the former, use non-@code{nil} @var{KEEP-OTHER@.} The symbol @code{always} +prevents the removal of a false-positive, in some cases where other non-@code{nil} values would fail. To deal with false-negatives remove the conflicting binding separately, using @code{transient-remove-suffix}. @end defun @@ -1049,14 +1097,28 @@ This function edits the suffix or group at @var{LOC} in @var{PREFIX}, by setting the @var{PROP} of its plist to @var{VALUE}. @end defun +Some prefix commands share suffixes, which are separately and then +included in each prefix when it is defined. The inclusion is done by +reference, the included suffix groups are not inlined by default. So +if you change, for example, the key binding for an argument in +@code{magit-diff} (@code{d}) the same change also applies to @code{magit-diff-refresh} (@code{D}). +In the rare case that this is not desirable use @code{transient-inline-group} +before making changes to included suffixes. + +@defun transient-inline-group PREFIX GROUP +This function inlines the included GROUP into PREFIX, by replacing +the symbol GROUP with its expanded layout in the layout of PREFIX@. +@end defun + Most of these functions do not signal an error if they cannot perform the requested modification. The functions that insert new suffixes show a warning if @var{LOC} cannot be found in @var{PREFIX} without signaling an error. The reason for doing it like this is that establishing a key binding (and that is what we essentially are trying to do here) should not prevent the rest of the configuration from loading. Among these -functions only @code{transient-get-suffix} and @code{transient-suffix-put} may -signal an error. +functions only @code{transient-get-suffix} and @code{transient-suffix-put} signal +an error by default. If you really want the insert functions to also +signal an error, set @code{transient-error-on-insert-failure} to @code{t}. @node Defining New Commands @chapter Defining New Commands @@ -1084,7 +1146,7 @@ When the user calls a transient prefix command, a transient (temporary) keymap is activated, which binds the transient's infix and suffix commands, and functions that control the transient state are added to @code{pre-command-hook} and @code{post-command-hook}. The available suffix -and infix commands and their state are shown in a popup buffer until +and infix commands and their state are shown in a menu buffer until the transient state is exited by invoking a suffix command. Calling an infix command causes its value to be changed. How that is @@ -1095,7 +1157,7 @@ toggled on or off. More complex infix commands may read a value from the user, using the minibuffer. Calling a suffix command usually causes the transient to be exited; -the transient keymaps and hook functions are removed, the popup buffer +the transient keymaps and hook functions are removed, the menu buffer no longer shows information about the (no longer bound) suffix commands, the values of some public global variables are set, while some internal global variables are unset, and finally the command is @@ -1113,11 +1175,11 @@ arguments have been set using a command such as @code{universal-argument}. @cindex command dispatchers Transient can be used to implement simple ``command dispatchers''. The main benefit then is that the user can see all the available commands -in a popup buffer, which can be thought of as a ``menu''. That is -useful by itself because it frees the user from having to remember all -the keys that are valid after a certain prefix key or command. -Magit's @code{magit-dispatch} (on @kbd{C-x M-g}) command is an example of using -Transient to merely implement a command dispatcher. +in a temporarily shown buffer, which can be thought of as a ``menu''. +That is useful by itself because it frees the user from having to +remember all the keys that are valid after a certain prefix key or +command. Magit's @code{magit-dispatch} (on @kbd{C-x M-g}) command is an example of +using Transient to merely implement a command dispatcher. In addition to that, Transient also allows users to interactively pass arguments to commands. These arguments can be much more complex than @@ -1197,7 +1259,7 @@ argument supported by the constructor of that class. The explicitly. @var{GROUP}s add key bindings for infix and suffix commands and specify -how these bindings are presented in the popup buffer. At least one +how these bindings are presented in the menu buffer. At least one @var{GROUP} has to be specified. @xref{Binding Suffix and Infix Commands}. The @var{BODY} is optional. If it is omitted, then @var{ARGLIST} is ignored and @@ -1229,6 +1291,22 @@ For example, the scope of the @code{magit-branch-configure} transient is the branch whose variables are being configured. @end defmac +Sometimes multiple prefix commands share a common set of suffixes. +For example, while @code{magit-diff} (@code{d}) and @code{magit-diff-refresh} (@code{D}) offer +different suffixes to actually create or update a diff, they both +offer the same infix arguments to control how that diff is formatted. +Such shared groups should be defined using @code{transient-define-group} +and then included in multiple prefixes, by using the symbol that +identifies the group in the prefix definition, in a location where +you would otherwise use a group vector. If an included group is +placed at the top-level of a prefix (as opposed of inside inside +a vector as a child group), then the symbol should be quoted. + +@defmac transient-define-group name group@dots{} +This macro define one or more groups and stores them in symbol NAME@. +GROUPs have the same form as for @code{transient-define-prefix}. +@end defmac + @node Binding Suffix and Infix Commands @section Binding Suffix and Infix Commands @@ -1439,7 +1517,15 @@ the object's values just for the binding inside this transient. @xref{Enabling and Disabling Suffixes}. @item -@var{KEY} is the key binding, either a vector or key description string. +KEY is the key binding, a string in the format returned by +@code{describe-key} and understood by @code{kbd}. + +That format is more permissive than the one accepted by @code{key-valid-p}. +Being more permissive makes it possible, for example, to write the +key binding, which toggles the @code{-a} command line argument, as "-a", +instead of having to write "- a". Likewise additional spaces can be +added, which is not removed when displaying the binding in the menu, +which is useful for alignment purposes. @item @var{DESCRIPTION} is the description, either a string or a function that @@ -1490,7 +1576,7 @@ which case the first string is used as the short argument (which can also be specified using @code{:shortarg}) and the second as the long argument (which can also be specified using @code{:argument}). -Only the long argument is displayed in the popup buffer. See +Only the long argument is displayed in the menu buffer. See @code{transient-detect-key-conflicts} for how the short argument may be used. @@ -2151,7 +2237,7 @@ children from scratch. @defun transient--insert-group group This generic function formats the group and its elements and inserts the result into the current buffer, which is a temporary buffer. -The contents of that buffer are later inserted into the popup buffer. +The contents of that buffer are later inserted into the menu buffer. Functions that are called by this function may need to operate in the buffer from which the transient was called. To do so they can @@ -2231,8 +2317,8 @@ anywhere a suffix can appear. Display-only suffix specifications take these form: @lisp -([LEVEL] :info DESCRIPTION [KEYWORD VALUE]...) -([LEVEL] :info* DESCRIPTION [KEYWORD VALUE]...) +(:info DESCRIPTION [KEYWORD VALUE]...) +(:info* DESCRIPTION [KEYWORD VALUE]...) @end lisp The @code{:info} and @code{:info*} keyword arguments replaces the @code{:description} @@ -2253,6 +2339,26 @@ value of lisp variables. This class is not fully featured yet and it is somewhat likely that future improvements won't be fully backward compatible. +@item +The @code{transient-cons-option} class is intended for situations where +@code{transient-args} should return an alist, instead of a list of strings +(arguments). Such suffixes can be specified in prefix definitions +like so: + +@lisp +(:cons OPTION :key KEY [KEYWORD VALUE]...) +@end lisp + +OPTION may be something other than a string, likely a keyword or +some other symbol, it is used as the @code{car} of the cons-cell. When +using such an inline definition @code{:key} has to be specified. In most +cases @code{:reader} should also be specified. When defining such a suffix +separately, the "alist key" has to be specified using the @code{:variable} +keyword argument. + +This class is still experimental it is somewhat likely that future +improvements won't be fully backward compatible. + @item The @code{transient-describe-target} class is used by the command @code{transient-describe}. @@ -2656,7 +2762,15 @@ and @code{advice*} slots (see @ref{Slots of @code{transient-suffix}}) are define @itemize @item -@code{key} The key, a key vector or a key description string. +@code{key} is the key binding, a string in the format returned by +@code{describe-key} and understood by @code{kbd}. + +That format is more permissive than the one accepted by @code{key-valid-p}. +Being more permissive makes it possible, for example, to write the +key binding, which toggles the @code{-a} command line argument, as "-a", +instead of having to write "- a". Likewise additional spaces can be +added, which is not removed when displaying the binding in the menu, +which is useful for alignment purposes. @item @code{command} The command, a symbol. @@ -2665,7 +2779,7 @@ and @code{advice*} slots (see @ref{Slots of @code{transient-suffix}}) are define @code{transient} Whether to stay transient. @xref{Transient State}. @item -@code{format} The format used to display the suffix in the popup buffer. +@code{format} The format used to display the suffix in the menu buffer. It must contain the following %-placeholders: @itemize @@ -2898,20 +3012,20 @@ available depending on user preference. @node FAQ @appendix FAQ -@anchor{Can I control how the popup buffer is displayed?} -@appendixsec Can I control how the popup buffer is displayed? +@anchor{Can I control how the menu buffer is displayed?} +@appendixsec Can I control how the menu buffer is displayed? Yes, see @code{transient-display-buffer-action} in @ref{Configuration}. You can -also control how the popup buffer is displayed on a case-by-case basis +also control how the menu buffer is displayed on a case-by-case basis by passing @code{:display-action} to @code{transient-define-prefix}. -@anchor{How can I copy text from the popup buffer?} -@appendixsec How can I copy text from the popup buffer? +@anchor{How can I copy text from the menu buffer?} +@appendixsec How can I copy text from the menu buffer? -To be able to mark text in Transient's popup buffer using the mouse, +To be able to mark text in Transient's menu buffer using the mouse, you have to add the below binding. Note that for technical reasons, the region won't be visualized, while doing so. After you have quit -the transient popup, you will be able to yank it in another buffer. +the transient menu, you will be able to yank it in another buffer. @lisp (keymap-set transient-predicate-map @@ -2943,49 +3057,6 @@ See @uref{https://github.com/magit/transient/wiki/Comparison-with-prefix-keys-an See @uref{https://github.com/magit/transient/wiki/Comparison-with-other-packages}. -@anchor{Why did some of the key bindings change?} -@appendixsec Why did some of the key bindings change? - -You may have noticed that the bindings for some of the common commands -do @strong{not} have the prefix @kbd{C-x} and that furthermore some of these commands -are grayed out while others are not. That unfortunately is a bit -confusing if the section of common commands is not shown permanently, -making the following explanation necessary. - -The purpose of usually hiding that section but showing it after the -user pressed the respective prefix key is to conserve space and not -overwhelm users with too much noise, while allowing the user to -quickly list common bindings on demand. - -That however should not keep us from using the best possible key -bindings. The bindings that do use a prefix do so to avoid wasting -too many non-prefix bindings, keeping them available for use in -individual transients. The bindings that do not use a prefix and that -are @strong{not} grayed out are very important bindings that are @strong{always} -available, even when invoking the ``common command key prefix'' or @strong{any -other} transient-specific prefix. The non-prefix keys that @strong{are} grayed -out however, are not available when any incomplete prefix key sequence -is active. They do not use the ``common command key prefix'' because it -is likely that users want to invoke them several times in a row and -e.g., @kbd{M-p M-p M-p} is much more convenient than @kbd{C-x M-p C-x M-p C-x M-p}. - -You may also have noticed that the ``Set'' command is bound to @kbd{C-x s}, -while Magit-Popup used to bind @kbd{C-c C-c} instead. I have seen several -users praise the latter binding (sic), so I did not change it -willy-nilly. The reason that I changed it is that using different -prefix keys for different common commands, would have made the -temporary display of the common commands even more confusing, i.e., -after pressing @kbd{C-c} all the bindings that begin with the @kbd{C-x} prefix -would be grayed out. - -Using a single prefix for common commands key means that all other -potential prefix keys can be used for transient-specific commands -@strong{without} the section of common commands also popping up. @kbd{C-c} in -particular is a prefix that I want to (and already do) use for Magit, and -also using that for a common command would prevent me from doing so. - -(See also the next question.) - @anchor{Why does @kbd{q} not quit popups anymore?} @appendixsec Why does @kbd{q} not quit popups anymore? diff --git a/doc/misc/use-package.texi b/doc/misc/use-package.texi index 2f980df9f45..7fae93bbb88 100644 --- a/doc/misc/use-package.texi +++ b/doc/misc/use-package.texi @@ -1220,7 +1220,6 @@ keybindings you've set using either the @code{:bind} keyword or the @cindex hooks @findex :hook The @code{:hook} keyword allows adding functions to hooks. It takes -@c FIXME: The actual forms accepted by :hook are different, see below! one argument of the form @var{hooks}, specifying one or more functions to add to one or more hooks. For the purposes of @code{:hook}, the name of hook variables should always exclude the @samp{-hook} suffix. @@ -1294,6 +1293,17 @@ applied, the following examples are all equivalent: @end group @end lisp +To add more than one function to the same hook, add them separately, +like this: + +@lisp +@group +(use-package company + :hook ((prog-mode . company-mode) + (prog-mode . some-other-function))) +@end group +@end lisp + One common mistake when using @code{:hook} is to forget to omit the @samp{-hook} suffix, which, as already explained, is appended automatically. Therefore, the following will not work, as it attempts diff --git a/etc/AUTHORS b/etc/AUTHORS index 5ce0044e778..9d289f0edf8 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -75,7 +75,7 @@ Adrian Robert: co-wrote ns-win.el and changed nsterm.m nsfns.m nsfont.m nsterm.h nsmenu.m configure.ac src/Makefile.in macos.texi README config.in emacs.c font.c keyboard.c nsgui.h nsimage.m xdisp.c image.c lib-src/Makefile.in lisp.h menu.c - Makefile.in and 78 other files + Makefile.in and 79 other files Ævar Arnfjörð Bjarmason: changed rcirc.el @@ -474,11 +474,11 @@ Antoine Beaupré: changed vc-git.el Antoine Kalmbach: changed README.md eglot.el -Antoine Levitt: changed gnus-group.el gnus-sum.el message.texi +Antoine Levitt: changed gnus-group.el gnus-sum.el message.texi ada-prj.el ange-ftp.el cus-edit.el dired-x.el ebnf2ps.el emerge.el erc-button.el erc-goodies.el erc-stamp.el erc-track.el files.el find-file.el gnus-art.el gnus-uu.el gnus.el gnus.texi message.el mh-funcs.el - mh-mime.el and 8 other files + and 9 other files Antonin Houska: changed newcomment.el @@ -607,7 +607,7 @@ Basil L. Contovounesios: changed simple.el subr.el message.el eww.el modes.texi custom.el text.texi bibtex.el eglot-tests.el js.el gnus-sum.el internals.texi subr-tests.el customize.texi display.texi files.texi gnus-art.el gnus-group.el gnus-win.el gnus.texi gravatar.el - and 369 other files + and 371 other files Bastian Beischer: changed semantic/complete.el calc-yank.el include.el mru-bookmark.el refs.el senator.el @@ -661,6 +661,8 @@ Ben Menasha: changed nnmh.el Ben North: changed outline.el buffer.c fill.el isearch.el lisp-mode.el paren.el w32term.c xfaces.c +Ben Scuron: changed etags-regen.el + Benson Chu: changed font-lock.el tab-bar.el tramp-sh.el Bernhard Herzog: changed vc-hg.el menu.c xsmfns.c @@ -932,7 +934,7 @@ and co-wrote longlines.el tango-dark-theme.el tango-theme.el and changed simple.el display.texi xdisp.c files.el frames.texi cus-edit.el files.texi custom.el subr.el text.texi faces.el keyboard.c startup.el package.el misc.texi emacs.texi modes.texi mouse.el - custom.texi image.c window.el and 932 other files + custom.texi image.c window.el and 934 other files Chris Chase: co-wrote idlw-shell.el idlwave.el @@ -1289,7 +1291,7 @@ and co-wrote hideshow.el and changed vc.el configure.ac vc-hg.el vc-git.el src/Makefile.in vc-bzr.el sysdep.c emacs.c process.c vc-cvs.el lisp.h term.c vc-hooks.el xterm.c keyboard.c vc-svn.el xterm.el callproc.c darwin.h - term.el gnu-linux.h and 919 other files + term.el gnu-linux.h and 920 other files Danny Freeman: changed treesit-tests.el treesit.el @@ -1329,7 +1331,7 @@ and co-wrote latin-ltx.el socks.el and changed configure.ac help.el mule-cmds.el fortran.el mule-conf.el xterm.c browse-url.el mule.el coding.c src/Makefile.in european.el fns.c mule-diag.el simple.el wid-edit.el cus-edit.el cus-start.el - files.el keyboard.c byte-opt.el info.el and 770 other files + files.el keyboard.c byte-opt.el info.el and 771 other files Dave Pearson: wrote 5x5.el quickurl.el @@ -1510,10 +1512,10 @@ Debarshi Ray: changed erc-backend.el erc.el Decklin Foster: changed nngateway.el -Deepak Goel: changed idlw-shell.el feedmail.el files.el find-func.el - flymake.el mh-search.el mh-seq.el mh-thread.el mh-xface.el org.el - simple.el vc.el vhdl-mode.el wdired.el README allout.el appt.el - apropos.el artist.el bibtex.el bindings.el and 82 other files +Deepak Goel: changed idlw-shell.el ada-xref.el feedmail.el files.el + find-func.el flymake.el mh-search.el mh-seq.el mh-thread.el mh-xface.el + org.el simple.el vc.el vhdl-mode.el wdired.el README ada-mode.el + allout.el appt.el apropos.el artist.el and 85 other files D. E. Evans: changed basic.texi @@ -1736,9 +1738,9 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c] chartab-tests.el coding-tests.el etags-tests.el rxvt.el tty-colors.el and co-wrote help-tests.el and changed xdisp.c display.texi w32.c msdos.c simple.el w32fns.c - files.el fileio.c keyboard.c emacs.c configure.ac text.texi w32term.c + files.el fileio.c keyboard.c configure.ac emacs.c text.texi w32term.c dispnew.c frames.texi files.texi w32proc.c xfaces.c window.c - dispextern.h lisp.h and 1401 other files + dispextern.h lisp.h and 1407 other files Eliza Velasquez: changed server.el simple.el @@ -1764,7 +1766,7 @@ Emilio C. Lopes: changed woman.el cmuscheme.el help.el vc.el advice.el and 58 other files Emmanuel Briot: wrote xml.el -and changed ada-stmt.el +and changed ada-mode.el ada-stmt.el ada-prj.el ada-xref.el Era Eriksson: changed bibtex.el dired.el json.el ses.el ses.texi shell.el tramp.el tramp.texi @@ -2193,7 +2195,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 term.c configure.ac simple.el frame.c xmenu.c emacs.c - and 623 other files + and 626 other files Gergely Nagy: changed erc.el @@ -2223,7 +2225,7 @@ and changed configure.ac Makefile.in src/Makefile.in calendar.el lisp/Makefile.in diary-lib.el files.el make-dist rmail.el progmodes/f90.el bytecomp.el admin.el misc/Makefile.in simple.el authors.el startup.el emacs.texi lib-src/Makefile.in display.texi - ack.texi subr.el and 1791 other files + ack.texi subr.el and 1796 other files Glynn Clements: wrote gamegrid.el snake.el tetris.el @@ -2522,7 +2524,8 @@ Itai Y. Efrat: changed browse-url.el Itai Zukerman: changed mm-decode.el Ivan Andrus: changed editfns.c epg.el ffap.el find-file.el ibuf-ext.el - ibuffer.el newcomment.el nxml-mode.el progmodes/python.el + ibuffer.el newcomment.el nextstep/templates/Info.plist.in nxml-mode.el + progmodes/python.el Ivan Boldyrev: changed mml1991.el @@ -2673,9 +2676,9 @@ Jan Vroonhof: changed gnus-cite.el gnus-msg.el nntp.el Jared Finder: wrote window-tool-bar.el and changed commands.texi menu-bar.el term.c tab-line.el xt-mouse.el - frame.c frames.texi isearch.el modes.texi mouse.el tmm.el tool-bar.el - wid-edit.el windows.texi artist.el dired.el dispnew.c ediff-wind.el - ediff.el elisp.texi emacs.texi and 16 other files + frame.c frames.texi isearch.el modes.texi mouse.el subr.el tmm.el + tool-bar.el wid-edit.el windows.texi artist.el dired.el dispnew.c + ediff-wind.el ediff.el elisp.texi and 16 other files Jarek Czekalski: changed keyboard.c callproc.c mini.texi minibuf.c misc.texi server.el shell.el w32fns.c xgselect.c @@ -2902,8 +2905,8 @@ Jim Wilson: changed alloca.c oldXMenu/Makefile.in Jin Choi: changed progmodes/python.el -Jindřich Makovička: changed eval.c fns.c pgtkfns.c pgtkselect.c - pgtkterm.c +Jindřich Makovička: changed Makefile.in eval.c fns.c pgtkfns.c + pgtkselect.c pgtkterm.c Jirka Kosek: changed mule.el @@ -3163,7 +3166,7 @@ Jorge P. De Morais Neto: changed TUTORIAL cl.texi Jose A. Ortega Ruiz: changed doc-view.el misc.texi mixal-mode.el gnus-sum.el imenu.el url-http.el -Jose E. Marchesi: changed gomoku.el simple.el smtpmail.el +Jose E. Marchesi: changed ada-mode.el gomoku.el simple.el smtpmail.el José L. Doménech: changed dired-aux.el @@ -3216,7 +3219,7 @@ and co-wrote help-tests.el keymap-tests.el and changed subr.el desktop.el w32fns.c bs.el faces.el simple.el emacsclient.c files.el server.el help-fns.el xdisp.c org.el w32term.c w32.c buffer.c keyboard.c ido.el image.c window.c eval.c allout.el - and 1224 other files + and 1228 other files Juan Pechiar: changed ob-octave.el @@ -3267,7 +3270,7 @@ Juri Linkov: wrote compose.el emoji.el files-x.el misearch.el and changed isearch.el simple.el info.el replace.el dired.el dired-aux.el minibuffer.el window.el progmodes/grep.el outline.el subr.el vc.el mouse.el diff-mode.el repeat.el files.el image-mode.el menu-bar.el - vc-git.el project.el search.texi and 490 other files + vc-git.el project.el search.texi and 491 other files Jussi Lahdenniemi: changed w32fns.c ms-w32.h msdos.texi w32.c w32.h w32console.c w32heap.c w32inevt.c w32term.h @@ -3343,7 +3346,7 @@ and changed simple.el files.el CONTRIBUTE doc-view.el image-mode.el Karl Heuer: changed keyboard.c lisp.h xdisp.c buffer.c xfns.c xterm.c alloc.c files.el frame.c configure.ac window.c data.c minibuf.c editfns.c fns.c process.c Makefile.in fileio.c simple.el keymap.c - indent.c and 446 other files + indent.c and 447 other files Karl Kleinpaste: changed gnus-sum.el gnus-art.el gnus-picon.el gnus-score.el gnus-uu.el gnus-xmas.el gnus.el mm-uu.el mml.el nnmail.el @@ -3510,7 +3513,7 @@ Kim F. Storm: wrote bindat.el cua-base.el cua-gmrk.el cua-rect.el ido.el and changed xdisp.c dispextern.h process.c simple.el window.c keyboard.c xterm.c dispnew.c subr.el w32term.c lisp.h fringe.c display.texi macterm.c alloc.c fns.c xfaces.c keymap.c xfns.c xterm.h .gdbinit - and 248 other files + and 249 other files Kimit Yada: changed copyright.el @@ -3562,10 +3565,10 @@ Konrad Hinsen: wrote ol-eshell.el and changed ob-python.el Konstantin Kharlamov: changed smerge-mode.el diff-mode.el files.el - alloc.c autorevert.el calc-aent.el calc-ext.el calc-lang.el cc-mode.el - cperl-mode.el css-mode.el cua-rect.el dnd.el ebnf-abn.el ebnf-dtd.el - ebnf-ebx.el emacs-module-tests.el epg.el faces.el gnus-art.el gtkutil.c - and 30 other files + indent.erts typescript-ts-mode.el ada-mode.el alloc.c autorevert.el + calc-aent.el calc-ext.el calc-lang.el cc-mode.el cperl-mode.el + css-mode.el cua-rect.el dnd.el ebnf-abn.el ebnf-dtd.el ebnf-ebx.el + emacs-module-tests.el epg.el and 33 other files Konstantin Kliakhandler: changed org-agenda.el @@ -3686,11 +3689,11 @@ Lele Gaifax: changed progmodes/python.el TUTORIAL.it python-tests.el flymake-proc.el flymake.texi isearch.el pgtkfns.c xterm.c Lennart Borgman: co-wrote ert-x.el -and changed nxml-mode.el tutorial.el re-builder.el window.el buff-menu.el - emacs-lisp/debug.el emacsclient.c filesets.el flymake.el help-fns.el - isearch.el linum.el lisp-mode.el lisp.el mouse.el progmodes/grep.el - recentf.el remember.el replace.el reveal.el ruby-mode.el - and 5 other files +and changed nxml-mode.el tutorial.el re-builder.el window.el ada-xref.el + buff-menu.el emacs-lisp/debug.el emacsclient.c filesets.el flymake.el + help-fns.el isearch.el linum.el lisp-mode.el lisp.el mouse.el + progmodes/grep.el recentf.el remember.el replace.el reveal.el + and 6 other files Lennart Staflin: changed dired.el diary-ins.el diary-lib.el tq.el xdisp.c @@ -3793,7 +3796,7 @@ Lute Kamstra: changed modes.texi emacs-lisp/debug.el generic-x.el generic.el font-lock.el simple.el subr.el battery.el debugging.texi easy-mmode.el elisp.texi emacs-lisp/generic.el hl-line.el info.el octave.el basic.texi bindings.el calc.el cmdargs.texi diff-mode.el - doclicense.texi and 288 other files + doclicense.texi and 289 other files Lynn Slater: wrote help-macro.el @@ -3930,7 +3933,7 @@ Mark Oteiza: wrote mailcap-tests.el md4-tests.el xdg-tests.el xdg.el and changed image-dired.el dunnet.el mpc.el eww.el json.el calc-units.el lcms.c subr-x.el subr.el message.el tex-mode.el cl-macs.el cl.texi ibuffer.el lcms-tests.el mailcap.el progmodes/python.el cl-print.el - eldoc.el emacs-lisp/chart.el files.el and 173 other files + eldoc.el emacs-lisp/chart.el files.el and 172 other files Mark Plaksin: changed nnrss.el term.el @@ -3955,7 +3958,7 @@ and changed cus-edit.el files.el progmodes/compile.el rmail.el tex-mode.el find-func.el rmailsum.el simple.el cus-dep.el dired.el mule-cmds.el rmailout.el checkdoc.el configure.ac custom.el emacsbug.el gnus.el help-fns.el ls-lisp.el mwheel.el sendmail.el - and 125 other files + and 126 other files Markus Sauermann: changed lisp-mode.el @@ -4004,7 +4007,7 @@ Martin Pohlack: changed iimage.el pc-select.el Martin Rudalics: changed window.el window.c windows.texi frame.c xdisp.c xterm.c frames.texi w32fns.c w32term.c xfns.c frame.el display.texi frame.h help.el cus-start.el buffer.c window.h mouse.el dispnew.c - keyboard.c nsfns.m and 215 other files + keyboard.c nsfns.m and 216 other files Martin Stjernholm: wrote cc-bytecomp.el and co-wrote cc-align.el cc-cmds.el cc-compat.el cc-defs.el cc-engine.el @@ -4128,7 +4131,7 @@ Mattias Engdegård: changed byte-opt.el bytecomp.el bytecomp-tests.el fns.c subr.el rx.el lisp.h rx-tests.el lread.c searching.texi eval.c bytecode.c print.c alloc.c calc-tests.el progmodes/compile.el fns-tests.el macroexp.el subr-tests.el cconv.el data.c - and 790 other files + and 789 other files Mattias M: changed asm-mode-tests.el asm-mode.el @@ -4178,7 +4181,7 @@ and changed tramp.texi tramp-adb.el trampver.el trampver.texi files.el dbusbind.c gitlab-ci.yml files.texi ange-ftp.el dbus.texi file-notify-tests.el Dockerfile.emba autorevert.el tramp-container.el tramp-fish.el kqueue.c os.texi files-x.el shell.el simple.el README - and 331 other files + and 333 other files Michael Ben-Gershon: changed acorn.h configure.ac riscix1-1.h riscix1-2.h unexec.c @@ -4394,7 +4397,7 @@ Miles Bader: wrote button.el face-remap.el image-file.el macroexp.el and changed comint.el faces.el simple.el editfns.c xfaces.c xdisp.c info.el minibuf.c display.texi quick-install-emacs wid-edit.el xterm.c dispextern.h subr.el window.el cus-edit.el diff-mode.el xfns.c - bytecomp.el help.el lisp.h and 271 other files + bytecomp.el help.el lisp.h and 272 other files Milton Wulei: changed gdb-ui.el @@ -4776,7 +4779,7 @@ and co-wrote cal-dst.el and changed lisp.h configure.ac alloc.c fileio.c process.c editfns.c sysdep.c xdisp.c fns.c image.c data.c emacs.c keyboard.c lread.c xterm.c eval.c gnulib-comp.m4 merge-gnulib callproc.c Makefile.in - buffer.c and 1889 other files + buffer.c and 1892 other files Paul Fisher: changed fns.c @@ -4804,7 +4807,7 @@ Paul Reilly: changed dgux.h lwlib-Xm.c lwlib.c xlwmenu.c configure.ac lwlib/Makefile.in mail/rmailmm.el rmailedit.el rmailkwd.el and 10 other files -Paul Rivier: changed mixal-mode.el reftex-vars.el reftex.el +Paul Rivier: changed ada-mode.el mixal-mode.el reftex-vars.el reftex.el Paul Rubin: changed config.h sun2.h texinfmt.el window.c @@ -4826,7 +4829,7 @@ Pavel Janík: co-wrote eudc-bob.el eudc-export.el eudc-hotlist.el and changed keyboard.c xterm.c COPYING xdisp.c process.c emacs.c lisp.h menu-bar.el ldap.el make-dist xfns.c buffer.c coding.c eval.c fileio.c flyspell.el fns.c indent.c Makefile.in callint.c cus-start.el - and 699 other files + and 702 other files Pavel Kobiakov: wrote flymake-proc.el flymake.el and changed flymake.texi @@ -4908,9 +4911,9 @@ Peter O'Gorman: changed configure.ac frame.h hpux10-20.h termhooks.h Peter Oliver: changed emacsclient.desktop emacsclient-mail.desktop Makefile.in emacs-mail.desktop configure.ac misc.texi server.el - dired-tests.el ediff-diff.el emacs.c emacs.desktop emacs.metainfo.xml - emacsclient.1 perl-mode.el ruby-mode-tests.el vc-sccs.el - wdired-tests.el + admin.el dired-tests.el ediff-diff.el emacs.c emacs.desktop + emacs.metainfo.xml emacsclient.1 incrementing-version-code perl-mode.el + ruby-mode-tests.el vc-sccs.el wdired-tests.el Peter Povinec: changed term.el @@ -5055,9 +5058,9 @@ Piotr Zieliński: wrote org-mouse.el Pip Cet: wrote image-circular-tests.el and changed xdisp.c comp.c byte-opt.el fns.c pdumper.c alloc.c - display.texi ftcrfont.c image.c sfnt.c xterm.c bytecomp-tests.el - bytecomp.el ccl-tests.el ccl.c ccl.el cmds.c comint.el - comp-test-funcs.el comp-tests.el comp.el and 32 other files + display.texi ftcrfont.c image.c sfnt.c xterm.c DEBUG bytecomp-tests.el + bytecomp.el ccl-tests.el ccl.c ccl.el cl-macs.el cmds.c comint.el + comp-test-funcs.el and 34 other files Platon Pronko: changed tramp.el @@ -5066,7 +5069,7 @@ and changed xterm.c haikuterm.c xfns.c haiku_support.cc android.c xterm.h configure.ac xwidget.c sfnt.c EmacsService.java haiku_support.h androidterm.c haikufns.c android.texi keyboard.c pgtkterm.c frames.texi nsterm.m pixel-scroll.el sfntfont.c EmacsWindow.java - and 532 other files + and 535 other files Pontus Michael: changed simple.el @@ -5153,10 +5156,10 @@ Randall Smith: changed dired.el Randal Schwartz: wrote pp.el -Randy Taylor: changed build.sh dockerfile-ts-mode.el eglot.el - go-ts-mode.el batch.sh cmake-ts-mode.el rust-ts-mode.el c-ts-mode.el - cus-theme.el font-lock.el java-ts-mode.el js.el json-ts-mode.el - modes.texi progmodes/python.el project.el sh-script.el +Randy Taylor: changed go-ts-mode.el build.sh dockerfile-ts-mode.el + eglot.el batch.sh cmake-ts-mode.el rust-ts-mode.el c-ts-mode.el + cus-theme.el font-lock.el font-lock.go java-ts-mode.el js.el + json-ts-mode.el modes.texi progmodes/python.el project.el sh-script.el typescript-ts-mode.el yaml-ts-mode.el Ransom Williams: changed files.el @@ -5202,9 +5205,9 @@ and changed vhdl-mode.texi Reuben Thomas: changed ispell.el whitespace.el dired-x.el files.el sh-script.el emacsclient-tests.el remember.el README emacsclient.c - misc.texi msdos.c simple.el INSTALL alloc.c arc-mode.el authors.el - config.bat copyright cperl-mode.el dired-x.texi dired.el - and 36 other files + misc.texi msdos.c simple.el INSTALL ada-mode.el ada-xref.el alloc.c + arc-mode.el authors.el config.bat copyright cperl-mode.el + and 38 other files Ricardo Martins: changed eglot.el @@ -5253,7 +5256,7 @@ and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-langs.el and changed files.el keyboard.c simple.el xterm.c xdisp.c rmail.el fileio.c process.c sysdep.c buffer.c xfns.c window.c subr.el configure.ac startup.el sendmail.el emacs.c Makefile.in editfns.c - info.el dired.el and 1337 other files + info.el dired.el and 1339 other files Richard Ryniker: changed sendmail.el @@ -5386,17 +5389,16 @@ R Primus: changed eglot.el Rüdiger Sonderfeld: wrote inotify-tests.el reftex-tests.el and changed eww.el octave.el shr.el bibtex.el configure.ac - misc/Makefile.in reftex-vars.el vc-git.el TUTORIAL.de autoinsert.el - building.texi bytecomp.el calc-lang.el cc-langs.el dired.texi editfns.c - emacs.c emacs.texi epa.el erc.el eww.texi and 39 other files - -Rudi Schlatte: changed iso-transl.el + misc/Makefile.in reftex-vars.el vc-git.el TUTORIAL.de ada-mode.el + autoinsert.el building.texi bytecomp.el calc-lang.el cc-langs.el + dired.texi editfns.c emacs.c emacs.texi epa.el erc.el + and 40 other files Rudolf Adamkovič: co-wrote quail/slovak.el and changed compilation.txt compile-tests.el progmodes/compile.el calc-units.el files.el ispell.el scheme.el -Rudolf Schlatte: changed README.md eglot.el +Rudolf Schlatte: changed README.md eglot.el iso-transl.el Ruijie Yu: changed TUTORIAL.cn arc-mode-tests.el arc-mode.el @@ -5461,7 +5463,7 @@ Sam Steingold: wrote gulp.el midnight.el and changed progmodes/compile.el cl-indent.el simple.el vc-cvs.el vc.el mouse.el vc-hg.el files.el gnus-sum.el tex-mode.el etags.el font-lock.el sgml-mode.el subr.el window.el ange-ftp.el inf-lisp.el - message.el package.el rcirc.el shell.el and 214 other files + message.el package.el rcirc.el shell.el and 216 other files Samuel Bronson: changed custom.el emacsclient.c keyboard.c progmodes/grep.el semantic/format.el unexmacosx.c @@ -5522,6 +5524,8 @@ Scott Frazer: wrote deeper-blue-theme.el whiteboard-theme.el Scott M. Meyers: changed cmacexp.el +Sean Bright: changed emacs.nsi + Sean Connor: changed gnus-sum.el Sean Neakums: changed gnus-msg.el gnus-uu.el supercite.el @@ -5537,7 +5541,7 @@ Sean Whitton: wrote em-elecslash.el em-extpipe-tests.el em-extpipe.el and changed vc-git.el project.el bindings.el server.el simple.el subr.el vc-dispatcher.el vc.el window.el eshell-tests.el eshell.texi subr-x.el .dir-locals.el cl-macs.el eshell-tests-helpers.el files.texi ftfont.c - remember.el startup.el term.el INSTALL and 34 other files + remember.el startup.el term.el INSTALL and 38 other files Sebastian Fieber: changed gnus-art.el mm-decode.el mm-view.el @@ -5576,8 +5580,9 @@ Sébastien Vauban: changed org.el org-agenda.el ox-latex.el ob-core.el org-clock.el ox-ascii.el ox-html.el Seiji Zenitani: changed nsfns.m frame.c xterm.c PkgInfo document.icns - find-func.el frame.h help-fns.el macfns.c nsfont.m nsterm.m w32fns.c - xdisp.c xfns.c + find-func.el frame.h help-fns.el macfns.c + nextstep/templates/Info.plist.in nsfont.m nsterm.m w32fns.c xdisp.c + xfns.c Sen Nagata: wrote crm.el rfc2368.el @@ -5722,9 +5727,9 @@ Sławomir Nowaczyk: changed emacs.py progmodes/python.el TUTORIAL.pl flyspell.el ls-lisp.el w32proc.c Spencer Baugh: wrote uniquify-tests.el which-func-tests.el -and changed project.el minibuffer.el simple.el progmodes/grep.el vc-hg.el - data-tests.el flymake.el mini.texi minibuffer-tests.el startup.el - uniquify.el which-func.el alloc.c autorevert.el bindings.el +and changed project.el minibuffer.el simple.el flymake.el + progmodes/grep.el vc-hg.el data-tests.el mini.texi minibuffer-tests.el + startup.el uniquify.el which-func.el alloc.c autorevert.el bindings.el casefiddle-tests.el casefiddle.c comint.el crm.el dired-aux.el dired-x.el and 22 other files @@ -5756,7 +5761,7 @@ and co-wrote help-tests.el keymap-tests.el and changed image-dired.el efaq.texi package.el cperl-mode.el checkdoc.el subr.el help.el simple.el bookmark.el dired.el files.el gnus.texi dired-x.el browse-url.el erc.el keymap.c image-mode.el ediff-util.el - eglot.el speedbar.el woman.el and 1810 other files + eglot.el speedbar.el woman.el and 1811 other files Stefan Merten: co-wrote rst.el @@ -5773,7 +5778,7 @@ and co-wrote font-lock.el gitmerge.el pcvs.el visual-wrap.el and changed subr.el simple.el cl-macs.el bytecomp.el keyboard.c files.el lisp.h vc.el eval.c xdisp.c alloc.c buffer.c sh-script.el help-fns.el progmodes/compile.el tex-mode.el lread.c keymap.c package.el window.c - edebug.el and 1724 other files + edebug.el and 1728 other files Stefano Facchini: changed gtkutil.c @@ -5810,7 +5815,7 @@ and changed wid-edit.el wdired.el todo-mode.texi wdired-tests.el dabbrev-tests.el diary-lib.el dired.el dired-tests.el doc-view.el files.el info.el minibuffer.el outline.el todo-test-1.todo widget.texi allout.el dabbrev.el eww.el find-dired.el frames.texi hl-line.el - and 75 other files + and 78 other files Stephen C. Gilardi: changed configure.ac @@ -5825,19 +5830,19 @@ and changed diary-lib.el octave.el org-agenda.el locate.el replace.el Stephen Gildea: wrote refcard.tex and co-wrote mh-funcs.el mh-search.el and changed time-stamp.el time-stamp-tests.el mh-e.el mh-utils-tests.el - mh-junk.el mh-utils.el mh-comp.el mh-show.el mh-e.texi + mh-junk.el mh-utils.el mh-comp.el files.texi mh-show.el mh-e.texi test-all-mh-variants.sh files.el mh-customize.el mh-folder.el mh-scan.el mh-xface-tests.el backups.texi comp-tests.el compile.texi - dns-mode.el fileio.c files.texi and 20 other files + dns-mode.el emacs.texi and 24 other files Stephen J. Turnbull: changed ediff-init.el strings.texi subr.el Stephen Leake: wrote elisp-mode-tests.el -and changed elisp-mode.el xref.el eglot.el window.el mode-local.el - project.el CONTRIBUTE vc-mtn.el ada-stmt.el cedet-global.el - ede/generic.el simple.el autoload.el bytecomp.el cl-generic.el - ede/locate.el files.texi functions.texi package.el progmodes/grep.el - windows.texi and 33 other files +and changed ada-mode.el ada-xref.el elisp-mode.el xref.el eglot.el + window.el mode-local.el project.el CONTRIBUTE ada-prj.el vc-mtn.el + ada-stmt.el cedet-global.el ede/generic.el simple.el autoload.el + bytecomp.el cl-generic.el ede/locate.el files.texi functions.texi + and 36 other files Stephen Pegoraro: changed xterm.c @@ -6038,7 +6043,7 @@ and co-wrote hideshow.el and changed ewoc.el vc.el info.el processes.texi zone.el lisp-mode.el scheme.el text.texi vc-rcs.el display.texi fileio.c files.el vc-git.el TUTORIAL.it bindat.el cc-vars.el configure.ac dcl-mode.el diff-mode.el - dired.el elisp.texi and 168 other files + dired.el elisp.texi and 169 other files Thierry Banel: co-wrote ob-C.el and changed calc-arith.el @@ -6185,7 +6190,7 @@ Tomas Abrahamsson: wrote artist.el Tomas Fabrizio Orsi: changed net-utils.el -Tomas Nordin: changed progmodes/python.el +Tomas Nordin: changed progmodes/python.el subr.el Tomas Volf: changed esh-mode.el @@ -6332,7 +6337,7 @@ Ulrich Müller: changed configure.ac calc-units.el Makefile.in emacsclient-mail.desktop lib-src/Makefile.in src/Makefile.in version.el bindings.el doctor.el emacs.1 files.el gamegrid.el gud.el language/cyrillic.el server.el strings.texi ChgPane.c ChgSel.c HELLO - INSTALL XMakeAssoc.c and 55 other files + INSTALL XMakeAssoc.c and 56 other files Ulrich Neumerkel: changed xterm.c @@ -6412,7 +6417,7 @@ Vincent Del Vecchio: changed info.el mh-utils.el Vincenzo Pupillo: wrote php-ts-mode.el and changed js.el cmake-ts-mode.el typescript-ts-mode.el c-ts-mode.el - c-ts-common.el Makefile.in java-ts-mode.el + c-ts-common.el java-ts-mode.el Makefile.in Vince Salvino: changed msdos.texi w32.c w32fns.c @@ -6428,6 +6433,8 @@ and changed ps-prin1.ps ps-bdf.el ps-prin0.ps blank-mode.el ps-prin3.ps Vitalie Spinu: changed comint.el eieio-base.el message.el ob-R.el ob-core.el ob-tangle.el subr.el +Vitaliy Chepelev: changed image-dired-dired.el image-dired-tags.el + Vitaly Takmazov: changed emacs-x64.manifest emacs-x86.manifest Vitorio Miguel: changed TUTORIAL.pt_BR @@ -6545,6 +6552,8 @@ Wojciech Gac: changed latin-pre.el quail/cyrillic.el Wojciech S. Gac: wrote sami.el +Wojciech Siewierski: changed calc-trail.el + Wolfgang Glas: changed unexsgi.c Wolfgang Jenkner: wrote man-tests.el textprop-tests.el @@ -6666,6 +6675,8 @@ Yuchen Pei: changed calendar.texi diary-lib.el icalendar-tests.el Yue Daian: wrote cl-font-lock.el +Yue Yi: changed peg.texi + Yu-ji Hosokawa: changed README.W32 Yukihiro Matsumoto: co-wrote ruby-mode.el diff --git a/etc/NEWS b/etc/NEWS index 4ad6c48d78a..0ecd911633c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -389,6 +389,10 @@ Together with the new command 'tab-line-move-tab-backward' ('C-x M-') it can be used to move the current tab on the tab line to a different position. +--- +*** New command 'tab-line-close-other-tabs'. +It's bound to the tab's context menu item "Close other tabs". + ** Project --- @@ -425,6 +429,8 @@ This user option describes projects that should always be skipped by *** New command 'project-save-some-buffers' bound to 'C-x p C-x s'. This is like 'C-x s', but only for this project's buffers. +*** 'project-remember-project' can now be called interactively. + ** Registers *** New functions 'buffer-to-register' and 'file-to-register'. @@ -1769,6 +1775,13 @@ were added, removed or edited, Emacs would refuse to proceed. Now Emacs prompts to first register the unregistered files, so that all files in the fileset are in a compatible state for a checkin. +--- +*** New user option 'vc-dir-hide-up-to-date-on-revert'. +If you customize this variable to non-nil, the 'g' command to refresh +the VC Directory buffer also has the effect of the 'x' command. +That is, typing 'g' refreshes the buffer and also hides items in the +'up-to-date' and 'ignored' states. + +++ *** New user option 'vc-async-checkin' to enable async checkin operations. Currently only supported by the Git and Mercurial backends. @@ -1796,6 +1809,12 @@ This replaces and generalizes the old 'vc-annotate-parent-rev'. --- *** vc-dav.el is now obsolete. +--- +*** The 'log-incoming' and 'log-outgoing' functions are deprecated. +Backend authors should implement the 'incoming-revision' and 'mergebase' +backend functions instead. These are jointly sufficient to support the +'C-x v I' and 'C-x v O' commands. + ** Diff mode +++ @@ -2191,6 +2210,22 @@ The unused variables 'block-comment-start' and 'block-comment-end', which never actually had any effect when set by major modes, have been removed. ++++ +** 'delete-frame' now needs non-nil FORCE argument to delete daemon frame. +The initial terminal frame of an Emacs process running as daemon can be +deleted via 'delete-frame' if and only if its optional FORCE argument is +non-nil. + +--- +** 'date-to-time' no longer accepts malformed times with time zone like "EDT". +Time strings like "2025-06-04T13:21:00 EDT" are not in valid ISO 8601 +time format, and 'date-to-time' now signals an error for them. Use a +numerical time-zone specification, like "2025-06-04T13:21:00-0400", +instead, which gives the time offset as +/-hh or +/-hh:mm. A designator +"Z" for UTC time is also supported. Less formal space-separated time +formats, like "2025-06-04 13:21:00 EDT", without the ISO 8601 "T" +separator, are also supported. + * Lisp Changes in Emacs 31.1 @@ -2213,6 +2248,13 @@ Like 'static-if', these macros evaluate their condition at macro-expansion time and are useful for writing code that can work across different Emacs versions. ++++ +** New feature to speed up repeated lookup of Lisp files in 'load-path'. +If the new variable 'load-path-filter-function' is set to the new +function 'load-path-filter-cache-directory-files', calling 'load' will +cache the directories it scans and their files, and the following +lookups should be faster. + ** Lexical binding --- diff --git a/etc/compilation.txt b/etc/compilation.txt index 67c7000ae09..39d9c3a923c 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -487,6 +487,17 @@ symbol: php Parse error: parse error, unexpected $ in main.php on line 59 Fatal error: Call to undefined function: mysql_pconnect() in db.inc on line 66 +* Rust + +symbol: rust + +error[E0277]: `Foo` is not an iterator + --> src/main.rs:4:16 +warning: borrow of packed field is unsafe and requires unsafe function or block (error E0133) + --> lint_example.rs:11:13 +note: required by a bound in `Trait` + --> src/auxiliary/trait-debuginfo.rs:23:18 + * Ruby symbol: ruby diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el index 97d6f6c8754..06359779823 100644 --- a/lisp/ansi-osc.el +++ b/lisp/ansi-osc.el @@ -35,18 +35,32 @@ ;;; Code: -(defconst ansi-osc-control-seq-regexp - ;; See ECMA 48, section 8.3.89 "OSC - OPERATING SYSTEM COMMAND". - "\e\\][\x08-\x0D]*[\x20-\x7E]*\\(\a\\|\e\\\\\\)" - "Regexp matching an OSC control sequence.") +;; According to ECMA 48, section 8.3.89 "OSC - OPERATING SYSTEM COMMAND" +;; OSC control sequences match: +;; "\e\\][\x08-\x0D]*[\x20-\x7E]*\\(\a\\|\e\\\\\\)" + +(defvar-local ansi-osc--marker nil + "Marker pointing to the start of an escape sequence. +Used by `ansi-osc-filter-region' and `ansi-osc-apply-on-region' to store +position of an unfinished escape sequence, for the complete sequence to +be handled in next call.") (defun ansi-osc-filter-region (begin end) - "Filter out all OSC control sequences from region between BEGIN and END." - (save-excursion - (goto-char begin) - ;; Delete escape sequences. - (while (re-search-forward ansi-osc-control-seq-regexp end t) - (delete-region (match-beginning 0) (match-end 0))))) + "Filter out all OSC control sequences from region between BEGIN and END. +When an unfinished escape sequence is found, the start position is saved +to `ansi-osc--marker'. Later call will override BEGIN with the position +pointed by `ansi-osc--marker'." + (let ((end-marker (copy-marker end))) + (save-excursion + (goto-char (or ansi-osc--marker begin)) + (when (eq (char-before) ?\e) (backward-char)) + (while (re-search-forward "\e]" end-marker t) + (let ((pos0 (match-beginning 0))) + (if (re-search-forward + "\\=[\x08-\x0D]*[\x20-\x7E]*\\(\a\\|\e\\\\\\)" + end-marker t) + (delete-region pos0 (point)) + (setq ansi-osc--marker (copy-marker pos0)))))))) (defvar-local ansi-osc-handlers '(("2" . ansi-osc-window-title-handler) ("7" . ansi-osc-directory-tracker) @@ -54,10 +68,6 @@ "Alist of handlers for OSC escape sequences. See `ansi-osc-apply-on-region' for details.") -(defvar-local ansi-osc--marker nil) -;; The function `ansi-osc-apply-on-region' can set `ansi-osc--marker' -;; to the start position of an escape sequence without termination. - (defun ansi-osc-apply-on-region (begin end) "Interpret OSC escape sequences in region between BEGIN and END. This function searches for escape sequences of the forms @@ -65,29 +75,33 @@ This function searches for escape sequences of the forms ESC ] command ; text BEL ESC ] command ; text ESC \\ -Every occurrence of such escape sequences is removed from the -buffer. Then, if `command' is a key in the alist that is the -value of the local variable `ansi-osc-handlers', that key's -value, which should be a function, is called with `command' and -`text' as arguments, with point where the escape sequence was -located." - (save-excursion - (goto-char (or ansi-osc--marker begin)) - (when (eq (char-before) ?\e) (backward-char)) - (while (re-search-forward "\e]" end t) - (let ((pos0 (match-beginning 0)) - (code (and (re-search-forward "\\=\\([0-9A-Za-z]*\\);" end t) - (match-string 1))) - (pos1 (point))) - (if (re-search-forward "\a\\|\e\\\\" end t) - (let ((text (buffer-substring-no-properties - pos1 (match-beginning 0)))) - (setq ansi-osc--marker nil) - (delete-region pos0 (point)) - (when-let* ((fun (cdr (assoc-string code ansi-osc-handlers)))) - (funcall fun code text))) - (put-text-property pos0 end 'invisible t) - (setq ansi-osc--marker (copy-marker pos0))))))) +Every occurrence of such escape sequences is removed from the buffer. +Then, if `command' is a key in the alist that is the value of the local +variable `ansi-osc-handlers', that key's value, which should be a +function, is called with `command' and `text' as arguments, with point +where the escape sequence was located. When an unfinished escape +sequence is identified, it's hidden and the start position is saved to +`ansi-osc--marker'. Later call will override BEGIN with the position +pointed by `ansi-osc--marker'." + (let ((end-marker (copy-marker end))) + (save-excursion + (goto-char (or ansi-osc--marker begin)) + (when (eq (char-before) ?\e) (backward-char)) + (while (re-search-forward "\e]" end-marker t) + (let ((pos0 (match-beginning 0)) + (code (and + (re-search-forward "\\=\\([0-9A-Za-z]*\\);" end-marker t) + (match-string 1))) + (pos1 (point))) + (if (re-search-forward "\a\\|\e\\\\" end-marker t) + (let ((text (buffer-substring-no-properties + pos1 (match-beginning 0)))) + (setq ansi-osc--marker nil) + (delete-region pos0 (point)) + (when-let* ((fun (cdr (assoc-string code ansi-osc-handlers)))) + (funcall fun code text))) + (put-text-property pos0 end-marker 'invisible t) + (setq ansi-osc--marker (copy-marker pos0)))))))) ;; Window title handling (OSC 2) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 445f37287c3..ab5e61a0787 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -952,12 +952,9 @@ Categories mode." todo-current-todo-file) ".toda") ;; Otherwise, jump to the category in the todo file. todo-current-todo-file))) - (len (length todo-categories)) (cat+file (unless cat (todo-read-category "Jump to category: " (if archive 'archive) file))) - (add-item (and todo-add-item-if-new-category - (> (length todo-categories) len))) (category (or cat (car cat+file)))) (unless cat (setq file0 (cdr cat+file))) (with-current-buffer (find-file-noselect file0 'nowarn) @@ -971,7 +968,10 @@ Categories mode." (todo-category-select) (goto-char (point-min)) (if (bound-and-true-p hl-line-mode) (hl-line-highlight)) - (when add-item (todo-insert-item--basic)))))) + (when (and todo-add-item-if-new-category + ;; A new category is empty on creation. + (seq-every-p #'zerop (cdr (assoc category todo-categories)))) + (todo-insert-item--basic)))))) (defun todo-next-item (&optional count) "Move point down to the beginning of the next item. @@ -5821,7 +5821,13 @@ keys already entered and those still available." (if (memq last '(default copy)) (progn (setq params0 nil) - (funcall gen-and-exec)) + (funcall gen-and-exec) + ;; Since the item insertion command is now done, unset + ;; transient keymap to ensure the next Todo mode key is + ;; recognized (bug#78506). (Only for "default" and "copy" + ;; parameters: for others, `last' may not yet be the final + ;; parameter, so the map must still be evaluated.) + (setq map nil)) (let ((key (funcall key-of last))) (funcall add-to-prompt key (make-symbol (concat (symbol-name last) ":GO!"))) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index c0caa342865..542fea3df2a 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -1075,11 +1075,13 @@ Semantic mode. ;; re-activated. (setq semantic-new-buffer-fcn-was-run nil) ;; restore the original `imenu-create-index-function' - (unless (eq semantic--create-index-function-origin - imenu-create-index-function) - (setq imenu-create-index-function - (or semantic--create-index-function-origin - (default-value 'imenu-create-index-function)))))) + (dolist (b (buffer-list)) + (with-current-buffer b + (unless (eq semantic--create-index-function-origin + imenu-create-index-function) + (setq imenu-create-index-function + (or semantic--create-index-function-origin + (default-value 'imenu-create-index-function)))))))) ;;; Autoload some functions that are not in semantic/loaddefs diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index fddb1884c9d..4a5ec41439a 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -396,6 +396,7 @@ Return a bovination list to use." ))) defstruct cl-defstruct + oclosure-define ) (semantic-elisp-setup-form-parser diff --git a/lisp/comint.el b/lisp/comint.el index bb718f25ee0..56a28f6ae99 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -404,6 +404,8 @@ This variable is buffer-local." (regexp-opt '("Enter" "enter" "Enter same" "enter same" "Enter the" "enter the" "Current" + ;; Ansible. (Bug#78442) + "Vault" "SSH" "BECOME" "Enter Auth" "enter auth" "Old" "old" "New" "new" "login" "Kerberos" "CVS" "UNIX" " SMB" "LDAP" "PEM" "SUDO" "[sudo]" "doas" "Repeat" "Bad" "Retype" "Verify") @@ -418,6 +420,8 @@ This variable is buffer-local." ;; The ccrypt encryption dialog doesn't end with a colon, so ;; treat it specially. "\\|^Enter encryption key: (repeat) *\\'" + ;; Ansible. The vault-id syntax is a guess. (Bug#78442) + "\\|^Vault password ([^@-][^@]*): \\'" ;; Default openssh format: "user@host's password:". "\\|^[^@ \t\n]+@[^@ \t\n]+'s password: *\\'" ;; openssh-8.6p1 format: "(user@host) Password:". diff --git a/lisp/dired.el b/lisp/dired.el index 63d373a63dc..4ae3eaf0d98 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3721,7 +3721,13 @@ instead of `dired-actual-switches'." ;; ange-ftp listings. (and (dired-switches-recursive-p switches) (string-match "\\`/.*:\\(/.*\\)" default-directory) - (concat "\\`" (match-string 1 default-directory))))) + (concat "\\`" (match-string 1 default-directory)))) + ;; Regexp that describes the beginning of line of a + ;; file/directory entry (as opposed to a subdirectory + ;; heading), including the optional mark, inode, and size. + (file-entry-beg-re (concat dired-re-maybe-mark + dired-re-inode-size + dired-re-perms))) (goto-char (point-min)) (setq dired-subdir-alist nil) (while (re-search-forward dired-subdir-regexp nil t) @@ -3730,8 +3736,7 @@ instead of `dired-actual-switches'." (unless (save-excursion (goto-char (match-beginning 0)) (beginning-of-line) - (forward-char 2) - (looking-at-p dired-re-perms)) + (looking-at-p file-entry-beg-re)) (save-excursion (goto-char (match-beginning 1)) (setq new-dir-name diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f774790acf1..966494ea0ea 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1456,10 +1456,7 @@ when printing the error message." (let ((fn name)) (while (and (symbolp fn) (fboundp fn) - (or (symbolp (symbol-function fn)) - (consp (symbol-function fn)) - (and (not macro-p) - (compiled-function-p (symbol-function fn))))) + (functionp (symbol-function fn))) (setq fn (symbol-function fn))) (let ((advertised (get-advertised-calling-convention (if (and (symbolp fn) (fboundp fn)) @@ -1471,7 +1468,7 @@ when printing the error message." (if macro-p `(macro lambda ,advertised) `(lambda ,advertised))) - ((and (not macro-p) (compiled-function-p fn)) fn) + ((and (not macro-p) (functionp fn)) fn) ((not (consp fn)) nil) ((eq 'macro (car fn)) (cdr fn)) (macro-p nil) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 355a0c5e98a..d32a9b6389d 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1761,24 +1761,31 @@ function,command,variable,option or symbol." ms1)))))) ;; Addendum: Make sure they appear in the doc in the same ;; order that they are found in the arg list. - (let ((args (nthcdr 4 fp)) - (last-pos 0) - (found 1) - (order (and (nth 3 fp) (car (nth 3 fp)))) - (nocheck (append '("&optional" "&rest" "&key" "&aux" - "&context" "&environment" "&whole" - "&body" "&allow-other-keys" "nil") - (nth 3 fp))) + (let* ((args (nthcdr 4 fp)) + (this-arg (car args)) + (this-arg (if (string-prefix-p ":" this-arg) + (substring this-arg 1) + this-arg)) + (last-pos 0) + (found 1) + (order (and (nth 3 fp) (car (nth 3 fp)))) + (nocheck (append '("&optional" "&rest" "&key" "&aux" + "&context" "&environment" "&whole" + "&body" "&allow-other-keys" "nil") + (nth 3 fp))) (inopts nil)) (while (and args found (> found last-pos)) (if (or (member (car args) nocheck) - (string-match "\\`_" (car args))) + (string-match "\\`_" this-arg)) (setq args (cdr args) + this-arg (if (string-prefix-p ":" (car args)) + (substring (car args) 1) + (car args)) inopts t) (setq last-pos found found (save-excursion (re-search-forward - (concat "\\<" (upcase (car args)) + (concat "\\<" (upcase this-arg) ;; Require whitespace OR ;; ITEMth OR ;; ITEMs @@ -1791,7 +1798,7 @@ function,command,variable,option or symbol." ms1)))))) ;; and see if the user wants to capitalize it. (if (save-excursion (re-search-forward - (concat "\\<\\(" (car args) + (concat "\\<\\(" this-arg ;; Require whitespace OR ;; ITEMth OR ;; ITEMs @@ -1801,10 +1808,15 @@ function,command,variable,option or symbol." ms1)))))) (match-beginning 1) (match-end 1) (format-message "If this is the argument `%s', it should appear as %s. Fix?" - (car args) (upcase (car args))) - (upcase (car args)) t) + this-arg (upcase this-arg)) + (upcase this-arg) t) (setq found (match-beginning 1)))))) - (if found (setq args (cdr args))))) + (if found (setq args + (cdr args) + this-arg (if (string-prefix-p ":" + (car args)) + (substring (car args) 1) + (car args)))))) (if (not found) ;; It wasn't found at all! Offer to attach this new symbol ;; to the end of the documentation string. @@ -1817,7 +1829,7 @@ function,command,variable,option or symbol." ms1)))))) (goto-char e) (forward-char -1) (insert "\n" (if inopts "Optional a" "A") - "rgument " (upcase (car args)) + "rgument " (upcase this-arg) " ") (insert (read-string "Describe: ")) (if (not (save-excursion (forward-char -1) @@ -1828,7 +1840,7 @@ function,command,variable,option or symbol." ms1)))))) (checkdoc-create-error (format-message "Argument `%s' should appear (as %s) in the doc string" - (car args) (upcase (car args))) + (car args) (upcase this-arg)) s (marker-position e)))) (if (or (and order (eq order 'yes)) (and (not order) checkdoc-arguments-in-order-flag)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index d594b3cb233..a076012cd30 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3807,7 +3807,7 @@ If PARENTS is non-nil, ARGLIST must be nil." (pcase specifier (`(satisfies ,f) `#',f) ('nil nil) - (type `(lambda (x) (cl-typep x ',type)))))) + (type `(lambda (x) (ignore x) (cl-typep x ',type)))))) `(eval-and-compile (cl--define-derived-type ',name ,expander ,predicate ',parents))))) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index f05bc5f5c2a..8cc9455752f 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -669,14 +669,17 @@ Set mark before moving, if the buffer already existed." ;;;###autoload (defun find-function (function) - "Find the definition of the FUNCTION near point. + "Find the definition of the Emacs Lisp FUNCTION near point. Finds the source file containing the definition of the function near point (selected by `function-called-at-point') in a buffer and places point before the definition. Set mark before moving, if the buffer already existed. -See also `find-function-recenter-line' and `find-function-after-hook'." +See also `find-function-recenter-line' and `find-function-after-hook'. + +Use \\[xref-find-definitions] to find definitions of functions and variables +that are not part of Emacs." (interactive (find-function-read)) (find-function-do-it function nil 'switch-to-buffer)) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 006b713ae6e..e4dfc7c2f78 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -147,7 +147,7 @@ '(;; Elisp "defgroup" "deftheme" "define-widget" "define-error" - "defface" "cl-deftype" "cl-defstruct" + "defface" "cl-deftype" "cl-defstruct" "oclosure-define" ;; CL "deftype" "defstruct" "define-condition" "defpackage" diff --git a/lisp/frame.el b/lisp/frame.el index 6a746023902..ec582096110 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2837,12 +2837,14 @@ deleting them." (interactive "i\nP") (setq frame (window-normalize-frame frame)) (let ((minibuffer-frame (window-frame (minibuffer-window frame))) + (terminal (frame-terminal frame)) (parent (frame-parent frame)) (frames (frame-list))) ;; In a first round consider minibuffer-less frames only. (dolist (this frames) (unless (or (eq this frame) (eq this minibuffer-frame) + (not (eq (frame-terminal this) terminal)) (eq (window-frame (minibuffer-window this)) this) ;; When FRAME is a child frame, delete its siblings ;; only. @@ -2854,6 +2856,7 @@ deleting them." (dolist (this frames) (unless (or (eq this frame) (eq this minibuffer-frame) + (not (eq (frame-terminal this) terminal)) ;; When FRAME is a child frame, delete its siblings ;; only. (and parent (not (eq (frame-parent this) parent))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 7e0595740e5..481360b5d3c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1587,7 +1587,7 @@ by this command." (lambda () (exit-recursive-edit) (error "Aborted edit, variable unchanged")) - :major-mode #'emacs-lisp-mode + :major-mode-sym #'emacs-lisp-mode :read #'read) (recursive-edit) (revert-buffer))) diff --git a/lisp/help.el b/lisp/help.el index 49394fea2cd..8b29a10e0cf 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -793,7 +793,6 @@ or a buffer name." (when describe-bindings-outline (setq-local outline-regexp ".*:$") - (setq-local outline-heading-end-regexp ":\n") (setq-local outline-level (lambda () 1)) (setq-local outline-minor-mode-cycle t outline-minor-mode-highlight t diff --git a/lisp/isearch.el b/lisp/isearch.el index 6b759f4ad3e..68519b7a820 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -4610,9 +4610,7 @@ defaults to the value of `isearch-search-fun-default' when nil." (defun search-within-boundaries ( search-fun get-fun next-fun string &optional bound noerror count) (let* ((old (point)) - ;; Check if point is already on the property. - (beg (when (funcall get-fun old) old)) - end found (i 0) + beg end found skip (i 0) (subregexp (and isearch-regexp (save-match-data @@ -4622,18 +4620,33 @@ defaults to the value of `isearch-search-fun-default' when nil." (when (subregexp-context-p string (match-beginning 0)) ;; The ^/$ is not inside a char-range or escaped. (throw 'subregexp t)))))))) - ;; Otherwise, try to search for the next property. - (unless beg - (setq beg (funcall next-fun old)) - (when beg - (if (or (null bound) - (if isearch-forward - (< beg bound) - (> beg bound))) - (goto-char beg) - (setq beg nil)))) + + ;; Optimization for non-subregexp case to set the initial position + ;; on the first match assuming there is no need to check boundaries + ;; for a search string/regexp without anchors (bug#78520). + (unless subregexp + (save-match-data + (if (funcall (or search-fun (isearch-search-fun-default)) + string bound noerror count) + (goto-char (if isearch-forward (match-beginning 0) (match-end 0))) + (setq skip t)))) + + (unless skip + ;; Check if point is already on the property. + (setq beg (when (funcall get-fun (point)) (point))) + ;; Otherwise, try to search for the next property. + (unless beg + (setq beg (funcall next-fun (point))) + (when beg + (if (or (null bound) + (if isearch-forward + (< beg bound) + (> beg bound))) + (goto-char beg) + (setq beg nil))))) + ;; Non-nil `beg' means there are more properties. - (while (and beg (not found)) + (while (and beg (not found) (not skip)) ;; Search for the end of the current property. (setq end (funcall next-fun beg)) ;; Handle ^/$ specially by matching in a temporary buffer. diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 9337ee9401a..2461ddcfd0d 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -642,11 +642,21 @@ USER and PASSWORD should be non-nil." (cl-defmethod smtpmail-try-auth-method (process (_mech (eql 'xoauth2)) user password) - (smtpmail-command-or-throw - process - (concat "AUTH XOAUTH2 " - (base64-encode-string - (concat "user=" user "\1auth=Bearer " password "\1\1") t)))) + (let ((ret (smtpmail-command-or-throw + process + (concat "AUTH XOAUTH2 " + (base64-encode-string + (concat "user=" user "\1auth=Bearer " password "\1\1") + t))))) + (if (eq (car ret) 334) + ;; When a server returns 334 server challenge, it usually means + ;; the credentials it received were wrong (e.g. was an actual + ;; password instead of an access token). In such a case, we + ;; should return a string with 535 to indicate a failure so that + ;; smtpmail will try other authentication mechanisms. See also + ;; https://debbugs.gnu.org/78366. + (throw 'done "535 5.7.8 Authentication credentials invalid") + ret))) (defun smtpmail-response-code (string) (when string diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index cbdaa48fc0e..721b7be123f 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -713,5 +713,7 @@ for all methods. Resulting data are derived from connection history." ;;; TODO: ;; ;; * Use multisession.el, starting with Emacs 29.1. +;; +;; Use `with-memoization', 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 098e39ccf7c..62dff3d8d46 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -177,7 +177,7 @@ interactively, a Tramp connection has to be selected." ;; Cancel timer. (dolist (timer timer-list) - (when (and (eq (timer--function timer) 'tramp-timeout-session) + (when (and (eq (timer--function timer) #'tramp-timeout-session) (tramp-file-name-equal-p vec (car (timer--args timer)))) (cancel-timer timer))) diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 8429208b44b..6e82bc67be1 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -551,6 +551,7 @@ see its function help for a description of the format." (tramp-login-args (("exec") ("-it") ("-u" "%u") + ("-e" ,(format "TERM=%s" tramp-terminal-type)) ("%h") ("%l"))) (tramp-direct-async (,tramp-default-remote-shell "-c")) @@ -565,6 +566,7 @@ see its function help for a description of the format." (tramp-login-args (("exec") ("-it") ("-u" "%u") + ("-e" ,(format "TERM=%s" tramp-terminal-type)) ("%h") ("%l"))) (tramp-direct-async (,tramp-default-remote-shell "-c")) @@ -583,6 +585,7 @@ see its function help for a description of the format." (tramp-login-args (("exec") ("-it") ("-u" "%u") + ("-e" ,(format "TERM=%s" tramp-terminal-type)) ("%h") ("%l"))) (tramp-direct-async (,tramp-default-remote-shell "-c")) @@ -597,6 +600,7 @@ see its function help for a description of the format." (tramp-login-args (("exec") ("-it") ("-u" "%u") + ("-e" ,(format "TERM=%s" tramp-terminal-type)) ("%h") ("%l"))) (tramp-direct-async (,tramp-default-remote-shell "-c")) @@ -754,6 +758,8 @@ see its function help for a description of the format." `(,tramp-apptainer-method (tramp-login-program ,tramp-apptainer-program) (tramp-login-args (("shell") + ("--env" + ,(format "TERM=%s" tramp-terminal-type)) ("instance://%h") ("%h"))) ; Needed for multi-hop check. (tramp-remote-shell ,tramp-default-remote-shell) @@ -777,6 +783,8 @@ see its function help for a description of the format." (tramp-login-args (("shell") ("-q") ("--uid" "%u") + ("-E" + ,(format "TERM=%s" tramp-terminal-type)) ("%h"))) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 65a1595c29e..3dba7b1bad6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2347,11 +2347,11 @@ connection if a previous connection has died for some reason." ;; Save the password. (ignore-errors (and (functionp tramp-password-save-function) - (funcall tramp-password-save-function))) + (funcall tramp-password-save-function)))))) - ;; Mark it as connected. - (tramp-set-connection-property - (tramp-get-connection-process vec) "connected" t)))))) + ;; Mark it as connected. + (tramp-set-connection-property + (tramp-get-connection-process vec) "connected" t))) (defun tramp-gvfs-gio-tool-p (vec) "Check, whether the gio tool is available." diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 5ad5c8f5c27..e4008c197fb 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -412,11 +412,11 @@ connection if a previous connection has died for some reason." (tramp-get-method-parameter vec 'tramp-mount-args)) (while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc))) (tramp-cleanup-connection vec 'keep-debug 'keep-password)) + (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))) - ;; Mark it as connected. - (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec)) - (tramp-set-connection-property - (tramp-get-connection-process vec) "connected" t)))) + ;; Mark it as connected. + (tramp-set-connection-property + (tramp-get-connection-process vec) "connected" t))) ;; In `tramp-check-cached-permissions', the connection properties ;; "{uid,gid}-{integer,string}" are used. We set them to proper values. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 64ad3d4996e..46666b8657e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -190,7 +190,10 @@ The string is used in `tramp-methods'.") `("scp" (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") - ("-e" "none") ("%h"))) + ("-e" "none") + ("-o" ,(format "SetEnv=\"TERM=%s\"" + tramp-terminal-type)) + ("%h"))) (tramp-async-args (("-q"))) (tramp-direct-async ("-t" "-t")) (tramp-remote-shell ,tramp-default-remote-shell) @@ -208,6 +211,8 @@ The string is used in `tramp-methods'.") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("-t" "-t") ("-o" "RemoteCommand=\"%l\"") + ("-o" ,(format "SetEnv=\"TERM=%s\"" + tramp-terminal-type)) ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-shell ,tramp-default-remote-shell) @@ -223,7 +228,10 @@ The string is used in `tramp-methods'.") `("rsync" (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") - ("-e" "none") ("%h"))) + ("-e" "none") + ("-o" ,(format "SetEnv=\"TERM=%s\"" + tramp-terminal-type)) + ("%h"))) (tramp-async-args (("-q"))) (tramp-direct-async t) (tramp-remote-shell ,tramp-default-remote-shell) @@ -254,7 +262,10 @@ The string is used in `tramp-methods'.") `("ssh" (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") - ("-e" "none") ("%h"))) + ("-e" "none") + ("-o" ,(format "SetEnv=\"TERM=%s\"" + tramp-terminal-type)) + ("%h"))) (tramp-async-args (("-q"))) (tramp-direct-async ("-t" "-t")) (tramp-remote-shell ,tramp-default-remote-shell) @@ -265,6 +276,8 @@ The string is used in `tramp-methods'.") (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("-t" "-t") + ("-o" ,(format "SetEnv=\"TERM=%s\"" + tramp-terminal-type)) ("-o" "RemoteCommand=\"%l\"") ("%h"))) (tramp-async-args (("-q"))) @@ -301,6 +314,7 @@ The string is used in `tramp-methods'.") ;; remote host echoes the command. ;; The "-p" argument doesn't work reliably, see Bug#50594. (tramp-login-args (("SUDO_PROMPT=P\"\"a\"\"s\"\"s\"\"w\"\"o\"\"r\"\"d\"\":") + (,(format "TERM=%s" tramp-terminal-type)) ("sudo") ("-u" "%u") ("-s") ("-H") ("%l"))) (tramp-remote-shell ,tramp-default-remote-shell) @@ -4123,12 +4137,33 @@ This function expects to be in the right *tramp* buffer." (unless (char-equal ?~ (aref d 0)) (setq newdl (cons d newdl)))) (setq dirlist (nreverse newdl)))) - (when (tramp-send-command-and-check - vec (format "(unalias %s; %s command -pv %s)" - progname - (if dirlist (concat "PATH=" (string-join dirlist ":")) "") - progname)) - (string-trim (tramp-get-buffer-string (tramp-get-connection-buffer vec))))) + (let ((command + (concat + (when dirlist (format "PATH=%s " (string-join dirlist ":"))) + "command -v " progname)) + (pipe-buf (tramp-get-remote-pipe-buf vec)) + tmpfile chunk chunksize) + (when (if (length< command pipe-buf) + (tramp-send-command-and-check vec command) + ;; Use a temporary file. We cannot use `write-region' + ;; because setting the remote path happens in the early + ;; connection handshake, and not all external tools are + ;; determined yet. + (setq command (concat command "\n") + tmpfile (tramp-make-tramp-temp-file vec)) + (while (not (string-empty-p command)) + (setq chunksize (min (length command) (/ pipe-buf 2)) + chunk (substring command 0 chunksize) + command (substring command chunksize)) + (tramp-send-command + vec (format "printf \"%%b\" \"$*\" %s >>%s" + (tramp-shell-quote-argument chunk) + (tramp-shell-quote-argument tmpfile)))) + (tramp-send-command-and-check + vec (format ". %s && rm -f %s" tmpfile tmpfile))) + + (string-trim + (tramp-get-buffer-string (tramp-get-connection-buffer vec)))))) ;; On hydra.nixos.org, the $PATH environment variable is too long to ;; send it. This is likely not due to PATH_MAX, but PIPE_BUF. We @@ -4162,12 +4197,11 @@ variable PATH." (setq chunksize (min (length command) (/ pipe-buf 2)) chunk (substring command 0 chunksize) command (substring command chunksize)) - (tramp-send-command vec (format - "printf \"%%b\" \"$*\" %s >>%s" - (tramp-shell-quote-argument chunk) - (tramp-shell-quote-argument tmpfile)))) - (tramp-send-command vec (format ". %s" tmpfile)) - (tramp-send-command vec (format "rm -f %s" tmpfile)))))) + (tramp-send-command + vec (format "printf \"%%b\" \"$*\" %s >>%s" + (tramp-shell-quote-argument chunk) + (tramp-shell-quote-argument tmpfile)))) + (tramp-send-command vec (format ". %s && rm -f %s" tmpfile tmpfile)))))) ;; ------------------------------------------------------------ ;; -- Communication with external shell -- @@ -5108,6 +5142,7 @@ Goes through the list `tramp-inline-compress-commands'." (t "-3"))) +;;;###tramp-autoload (defun tramp-timeout-session (vec) "Close the connection VEC after a session timeout. If there is just some editing, retry it after 5 seconds." @@ -5127,6 +5162,7 @@ If there is just some editing, retry it after 5 seconds." Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." ;; During completion, don't reopen a new connection. + ;; Same for slide-in timer or process-{filter,sentinel}. (unless (tramp-connectable-p vec) (throw 'non-essential 'non-essential)) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index aeb7c01c03f..db961c97523 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -162,6 +162,7 @@ this variable \"client min protocol=NT1\"." "NT_STATUS_PASSWORD_MUST_CHANGE" "NT_STATUS_RESOURCE_NAME_NOT_FOUND" "NT_STATUS_REVISION_MISMATCH" + "NT_STATUS_RPC_SS_CONTEXT_MISMATCH" "NT_STATUS_SHARING_VIOLATION" "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" "NT_STATUS_UNSUCCESSFUL" @@ -316,7 +317,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.") ;; Options for remote processes via winexe. (defcustom tramp-smb-winexe-program "winexe" "Name of winexe client to run. -If it isn't found in the local $PATH, the absolute path of winexe +If it isn't found in the local $PATH, the absolute path of \"winexe\" shall be given. This is needed for remote processes." :group 'tramp :version "24.3" @@ -488,12 +489,13 @@ arguments to pass to the OPERATION." (args (list (concat "//" host "/" share) "-E")) (options tramp-smb-options)) - (if (tramp-string-empty-or-nil-p user) - (setq args (append args (list "-N"))) - (setq args (append args (list "-U" user)))) + (setq args + (append args + (if (tramp-string-empty-or-nil-p user) + (list "-N") + (list "-U" (if domain (concat domain "/" user) user))) + (when port (list "-p" port)))) - (when domain (setq args (append args (list "-W" domain)))) - (when port (setq args (append args (list "-p" port)))) (when tramp-smb-conf (setq args (append args (list "-s" tramp-smb-conf)))) (while options @@ -779,12 +781,13 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (args (list (concat "//" host "/" share) "-E")) (options tramp-smb-options)) - (if (tramp-string-empty-or-nil-p user) - (setq args (append args (list "-N"))) - (setq args (append args (list "-U" user)))) + (setq args + (append args + (if (tramp-string-empty-or-nil-p user) + (list "-N") + (list "-U" (if domain (concat domain "/" user) user))) + (when port (list "-p" port)))) - (when domain (setq args (append args (list "-W" domain)))) - (when port (setq args (append args (list "-p" port)))) (when tramp-smb-conf (setq args (append args (list "-s" tramp-smb-conf)))) (while options @@ -1251,6 +1254,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-set-connection-property v " process-buffer" (or outbuf (generate-new-buffer tramp-temp-buffer-name))) + (tramp-flush-connection-property v " process-exit-status") (with-current-buffer (tramp-get-connection-buffer v) ;; Preserve buffer contents. (narrow-to-region (point-max) (point-max)) @@ -1366,12 +1370,13 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-replace "\n" "," acl-string))) (options tramp-smb-options)) - (if (tramp-string-empty-or-nil-p user) - (setq args (append args (list "-N"))) - (setq args (append args (list "-U" user)))) + (setq args + (append args + (if (tramp-string-empty-or-nil-p user) + (list "-N") + (list "-U" (if domain (concat domain "/" user) user))) + (when port (list "-p" port)))) - (when domain (setq args (append args (list "-W" domain)))) - (when port (setq args (append args (list "-p" port)))) (when tramp-smb-conf (setq args (append args (list "-s" tramp-smb-conf)))) (while options @@ -1906,16 +1911,19 @@ If ARGUMENT is non-nil, use it as argument for (share (setq args (list (concat "//" host "/" share)))) (t (setq args (list "-g" "-L" host )))) - (if (tramp-string-empty-or-nil-p user) - (setq args (append args (list "-N"))) - (setq args (append args (list "-U" user)))) + (setq args + (append args + (if (tramp-string-empty-or-nil-p user) + (list "-N") + (list "-U" (if domain (concat domain "/" user) user))) + (when port (list "-p" port)))) - (when domain (setq args (append args (list "-W" domain)))) - (when port (setq args (append args (list "-p" port)))) (when tramp-smb-conf (setq args (append args (list "-s" tramp-smb-conf)))) (dolist (option options) (setq args (append args (list "--option" option)))) + ;; For debugging. + (setq args (append args (list "-d" "1"))) (when argument (setq args (append args (list argument)))) @@ -2026,6 +2034,8 @@ Removes smb prompt. Returns nil if an error message has appeared." (when (tramp-file-name-port vec) (tramp-error vec 'file-error "Port not supported for remote processes")) + ;; In case of "NT_STATUS_RPC_SS_CONTEXT_MISMATCH", the remote server + ;; is a Samba server. winexe cannot install the respective service there. (tramp-smb-maybe-open-connection vec (format @@ -2037,12 +2047,14 @@ Removes smb prompt. Returns nil if an error message has appeared." ;; Suppress "^M". Shouldn't we specify utf8? (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos) - ;; Set width to 128. This avoids mixing prompt and long error messages. + ;; Set width to 128 ($bufsize.Width) or 102 ($winsize.Width), + ;; respectively. $winsize.Width cannot be larger. This avoids + ;; mixing prompt and long error messages. (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI") (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize") (tramp-smb-send-command vec "$winsize = $rawui.WindowSize") (tramp-smb-send-command vec "$bufsize.Width = 128") - (tramp-smb-send-command vec "$winsize.Width = 128") + (tramp-smb-send-command vec "$winsize.Width = 102") (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize") (tramp-smb-send-command vec "$rawui.WindowSize = $winsize")) @@ -2069,5 +2081,7 @@ Removes smb prompt. Returns nil if an error message has appeared." ;; several places, especially in `tramp-smb-handle-insert-directory'. ;; ;; * Keep a separate connection process per share. +;; +;; * Keep a permanent connection process for `process-file'. ;;; tramp-smb.el ends here diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 3176236128a..cbc083a1fe0 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -62,6 +62,8 @@ (tramp-login-program "ssh") (tramp-login-args (("-q") ("-l" "%u") ("-p" "%p") ("-e" "none") ("%a" "%a") + ("-o" ,(format "SetEnv=\"TERM=%s\"" + tramp-terminal-type)) ("%h") ("%l"))) (tramp-direct-async t) (tramp-remote-shell ,tramp-default-remote-shell) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 67aa2cd0fdb..0f7b945f84a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2105,10 +2105,11 @@ does not exist, otherwise propagate the error." (declare (indent 2) (debug (symbolp form body))) (let ((err (make-symbol "err"))) `(condition-case ,err - (progn ,@body) + (let (signal-hook-function) ,@body) (error (if (not (or (file-exists-p ,filename) (file-symlink-p ,filename))) - (tramp-error ,vec 'file-missing ,filename) + (when (tramp-connectable-p ,vec) + (tramp-error ,vec 'file-missing ,filename)) (signal (car ,err) (cdr ,err))))))) ;; This function provides traces in case of errors not triggered by @@ -2561,7 +2562,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." (tramp-message v 5 "Non-essential received in operation %s" (cons operation args)) - (let ((tramp-verbose 10)) (tramp-backtrace v)) + (tramp-backtrace v) (tramp-run-real-handler operation args)) ((eq result 'suppress) (let ((inhibit-message t)) @@ -2793,13 +2794,15 @@ They are completed by `M-x TAB' only if there's an active connection or buffer." "Check if it is possible to connect the remote host without side-effects. This is true, if either the remote host is already connected, or if we are not in completion mode." - (let ((tramp-verbose 0) - (vec (tramp-ensure-dissected-file-name vec-or-filename))) - (or ;; We check this for the process related to - ;; `tramp-buffer-name'; otherwise `make-process' wouldn't run - ;; ever when `non-essential' is non-nil. - (process-live-p (tramp-get-process vec)) - (not non-essential)))) + (or (not non-essential) + ;; We check this for the process related to `tramp-buffer-name'; + ;; otherwise `make-process' wouldn't run ever when + ;; `non-essential' is non-nil. + (and-let* ((tramp-verbose 0) + (vec (tramp-ensure-dissected-file-name vec-or-filename)) + (p (tramp-get-process vec)) + ((process-live-p p)) + ((tramp-get-connection-property p "connected")))))) (defun tramp-completion-handle-expand-file-name (filename &optional directory) "Like `expand-file-name' for partial Tramp files." @@ -3470,79 +3473,69 @@ BODY is the backend specific code." "Skeleton for `tramp-*-handle-directory-files'. BODY is the backend specific code." (declare (indent 5) (debug t)) - `(or - (with-parsed-tramp-file-name (expand-file-name ,directory) nil - (tramp-barf-if-file-missing v ,directory - (when (file-directory-p ,directory) - (setf ,directory - (file-name-as-directory (expand-file-name ,directory))) - (let ((temp - (with-tramp-file-property v localname "directory-files" ,@body)) - 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)))) - - ;; Error handling. - (if (not (file-exists-p ,directory)) - (tramp-error - (tramp-dissect-file-name ,directory) 'file-missing ,directory) - nil))) + `(with-parsed-tramp-file-name (expand-file-name ,directory) nil + (tramp-barf-if-file-missing v ,directory + (if (not (file-directory-p ,directory)) + ;; Trigger the `file-missing' error. + (signal 'error nil) + (setf ,directory + (file-name-as-directory (expand-file-name ,directory))) + (let ((temp + (with-tramp-file-property v localname "directory-files" ,@body)) + 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))))) (defmacro tramp-skeleton-directory-files-and-attributes (directory &optional full match nosort id-format count &rest body) "Skeleton for `tramp-*-handle-directory-files-and-attributes'. BODY is the backend specific code." (declare (indent 6) (debug t)) - `(or - (with-parsed-tramp-file-name (expand-file-name ,directory) nil - (tramp-barf-if-file-missing v ,directory - (when (file-directory-p ,directory) - (let ((temp - (copy-tree - (mapcar - (lambda (x) - (cons - (car x) - (tramp-convert-file-attributes - v (expand-file-name (car x) localname) - ,id-format (cdr x)))) - (with-tramp-file-property - v localname "directory-files-and-attributes" - ,@body)))) - result item) + `(with-parsed-tramp-file-name (expand-file-name ,directory) nil + (tramp-barf-if-file-missing v ,directory + (if (not (file-directory-p ,directory)) + ;; Trigger the `file-missing' error. + (signal 'error nil) + (let ((temp + (copy-tree + (mapcar + (lambda (x) + (cons + (car x) + (tramp-convert-file-attributes + v (expand-file-name (car x) localname) + ,id-format (cdr x)))) + (with-tramp-file-property + v localname "directory-files-and-attributes" + ,@body)))) + result item) - (while temp - (setq item (pop temp)) - (when (or (null ,match) (string-match-p ,match (car item))) - (when ,full - (setcar item (expand-file-name (car item) ,directory))) - (push item result))) + (while temp + (setq item (pop temp)) + (when (or (null ,match) (string-match-p ,match (car item))) + (when ,full + (setcar item (expand-file-name (car item) ,directory))) + (push item result))) - (unless ,nosort - (setq result - (sort result (lambda (x y) (string< (car x) (car y)))))) + (unless ,nosort + (setq result + (sort result (lambda (x y) (string< (car x) (car y)))))) - (when (and (natnump ,count) (> ,count 0)) - (setq result (tramp-compat-ntake ,count result))) + (when (and (natnump ,count) (> ,count 0)) + (setq result (tramp-compat-ntake ,count result))) - (or result - ;; The scripts could fail, for example with huge file size. - (tramp-handle-directory-files-and-attributes - ,directory ,full ,match ,nosort ,id-format ,count)))))) - - ;; Error handling. - (if (not (file-exists-p ,directory)) - (tramp-error - (tramp-dissect-file-name ,directory) 'file-missing ,directory) - nil))) + (or result + ;; The scripts could fail, for example with huge file size. + (tramp-handle-directory-files-and-attributes + ,directory ,full ,match ,nosort ,id-format ,count))))))) (defcustom tramp-use-file-attributes t "Whether to use \"file-attributes\" connection property for check. @@ -3850,20 +3843,23 @@ BODY is the backend specific code." BODY is the backend specific code." (declare (indent 1) (debug t)) `(with-parsed-tramp-file-name (expand-file-name ,filename) nil - (when (not (file-exists-p ,filename)) - (tramp-error v 'file-missing ,filename)) - (with-tramp-saved-file-properties - v localname - ;; We cannot add "file-attributes", "file-executable-p", - ;; "file-ownership-preserved-p", "file-readable-p", - ;; "file-writable-p". - '("file-directory-p" "file-exists-p" "file-symlink-p" "file-truename") - (tramp-flush-file-properties v localname)) - (condition-case err - (progn ,@body) - (error (if tramp-inhibit-errors-if-setting-file-attributes-fail - (display-warning 'tramp (error-message-string err)) - (signal (car err) (cdr err))))))) + (tramp-barf-if-file-missing v ,filename + (if (not (file-exists-p ,filename)) + ;; Trigger the `file-missing' error. + (signal 'error nil) + (with-tramp-saved-file-properties + v localname + ;; We cannot add "file-attributes", "file-executable-p", + ;; "file-ownership-preserved-p", "file-readable-p", + ;; "file-writable-p". + '("file-directory-p" "file-exists-p" + "file-symlink-p" "file-truename") + (tramp-flush-file-properties v localname)) + (condition-case err + (progn ,@body) + (error (if tramp-inhibit-errors-if-setting-file-attributes-fail + (display-warning 'tramp (error-message-string err)) + (signal (car err) (cdr err))))))))) (defmacro tramp-skeleton-write-region (start end filename append visit lockname mustbenew &rest body) @@ -4051,9 +4047,7 @@ Let-bind it when necessary.") (tramp-dont-suspend-timers t)) (with-tramp-timeout (timeout - (unless (and-let* ((p (tramp-get-connection-process v)) - ((process-live-p p)) - ((tramp-get-connection-property p "connected")))) + (unless (and (not non-essential) (tramp-connectable-p v)) (tramp-cleanup-connection v 'keep-debug 'keep-password)) (tramp-error v 'file-error @@ -4939,6 +4933,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") ;; functions like `kill-buffer' would try to reestablish the ;; connection. See Bug#61663. (if-let* ((v (tramp-dissect-file-name file)) + ((tramp-connectable-p v)) ((process-live-p (tramp-get-process v))) (lockname (make-lock-file-name file))) (delete-file lockname) @@ -6255,15 +6250,22 @@ the remote host use line-endings as defined in the variable (process-send-string p string))))))) (defun tramp-process-sentinel (proc event) - "Flush file caches and remove shell prompt." + "Flush file caches and remove shell prompt. +Set exit status of PROC as connection property \" process-exit-status\"." (unless (process-live-p proc) (let ((vec (process-get proc 'tramp-vector)) (buf (process-buffer proc)) (prompt (tramp-get-connection-property proc "prompt"))) (when vec - (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event) + (tramp-message + vec 5 "Sentinel called: `%S' event: `%s' status: %s" + proc event (process-exit-status proc)) (tramp-flush-connection-properties proc) - (tramp-flush-directory-properties vec "/")) + (tramp-flush-directory-properties vec "/") + ;; Sometimes, the process has been deleted already before we + ;; can retrieve the exit status. + (tramp-set-connection-property + vec " process-exit-status" (process-exit-status proc))) (when (buffer-live-p buf) (with-current-buffer buf (when (and prompt (tramp-search-regexp (rx (literal prompt)))) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index c850718ed49..1100b349283 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -105,7 +105,7 @@ ("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") ("2.6.2.29.2" . "29.2") ("2.6.3-pre" . "29.3") ("2.6.3" . "29.4") - ("2.7.1.30.1" . "30.1"))) + ("2.7.1.30.1" . "30.1") ("2.7.3.30.2" . "30.2"))) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/outline.el b/lisp/outline.el index 61e9b0f3289..dc2b5b32685 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -235,10 +235,10 @@ The argument MAP is optional and defaults to `outline-minor-mode-cycle-map'." (let ((map (make-sparse-keymap))) (outline-minor-mode-cycle--bind map (kbd "TAB") #'outline-cycle) (outline-minor-mode-cycle--bind map (kbd "") #'outline-cycle-buffer) - (keymap-set map " " 'outline-cycle) - (keymap-set map " " 'outline-cycle) - (keymap-set map " S-" 'outline-cycle-buffer) - (keymap-set map " S-" 'outline-cycle-buffer) + (keymap-set map " " #'outline-cycle) + (keymap-set map " " #'outline-cycle) + (keymap-set map " S-" #'outline-cycle-buffer) + (keymap-set map " S-" #'outline-cycle-buffer) map) "Keymap used as a parent of the `outline-minor-mode' keymap. It contains key bindings that can be used to cycle visibility. @@ -259,14 +259,19 @@ non-nil and point is located on the heading line.") map)) (defvar outline-font-lock-keywords - '( + `( ;; Highlight headings according to the level. (eval . (list (or (when outline-search-function - (lambda (limit) - (when-let* ((ret (funcall outline-search-function limit))) - ;; This is equivalent to adding ".*" in the regexp below. - (set-match-data (list (match-beginning 0) (pos-eol))) - ret))) + ,(lambda (limit) + (when-let* ((ret (funcall outline-search-function limit))) + ;; This is equivalent to adding ".*" in the regexp below. + (set-match-data + (list (match-beginning 0) + (save-excursion + (save-match-data + (re-search-forward + (concat ".*" outline-heading-end-regexp) nil t))))) + ret))) (concat "^\\(?:" outline-regexp "\\).*" outline-heading-end-regexp)) 0 '(if outline-minor-mode (if outline-minor-mode-highlight @@ -478,7 +483,7 @@ Turning on outline mode calls the value of `text-mode-hook' and then of The value of this variable is checked as part of loading Outline mode. After that, changing the prefix key requires manipulating keymaps." :type 'key-sequence - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (define-key outline-minor-mode-map outline-minor-mode-prefix nil) (define-key outline-minor-mode-map val outline-mode-prefix-map) @@ -520,11 +525,16 @@ outline font-lock faces to those of major mode." (save-excursion (goto-char (point-min)) (let ((regexp (unless outline-search-function - (concat "^\\(?:" outline-regexp "\\).*$")))) + (concat "^\\(?:" outline-regexp "\\).*" outline-heading-end-regexp)))) (while (if outline-search-function (when-let* ((ret (funcall outline-search-function))) ;; This is equivalent to adding ".*" in the regexp above. - (set-match-data (list (match-beginning 0) (pos-eol))) + (set-match-data + (list (match-beginning 0) + (save-excursion + (save-match-data + (re-search-forward + (concat ".*" outline-heading-end-regexp) nil t))))) ret) (re-search-forward regexp nil t)) (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) @@ -675,6 +685,7 @@ at the end of the buffer." (goto-char (match-beginning 0)) ;; Compensate "\n" from the beginning of regexp (when (and outline-search-function (not (bobp))) (forward-char -1))) + ;; FIXME: Use `outline--end-of-previous'. (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) (forward-char -1))) @@ -1277,6 +1288,16 @@ This also unhides the top heading-less body, if any." (progn (outline-end-of-subtree) (point)) flag))) +(defun outline--end-of-previous () + "Go back from BOH (or EOB) to end of previous element." + (if (eobp) + (if (bolp) (forward-char -1)) + ;; Go to end of line before heading + (forward-char -1) + (if (and outline-blank-line (bolp)) + ;; leave blank line before heading + (forward-char -1)))) + (defun outline-end-of-subtree () "Move to the end of the current subtree." (outline-back-to-heading) @@ -1288,12 +1309,7 @@ This also unhides the top heading-less body, if any." (outline-next-heading)) (if (and (bolp) (not (eolp))) ;; We stopped at a nonempty line (the next heading). - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (and outline-blank-line (bolp)) - ;; leave blank line before heading - (forward-char -1)))))) + (outline--end-of-previous)))) (defun outline-show-branches () "Show all subheadings of this heading, but not their bodies." @@ -1707,12 +1723,17 @@ LEVEL, decides of subtree visibility according to (run-hooks 'outline-view-change-hook)) (defun outline--hidden-headings-paths () - "Return a hash with headings of currently hidden outlines. -Every hash key is a list whose elements compose a complete path + "Return (HASH-TABLE CURRENT-HEADING). +HASH-TABLE holds the headings of currently hidden outlines. +Every key is a list whose elements compose a complete path of headings descending from the top level down to the bottom level. +Every entry's value is non-nil if that entry should be hidden. +The specific non-nil vale can be t to hide just the entry, or a number +LEVEL to mean that not just the entry should be hidden but also all the +subsequent elements of level higher or equal to LEVEL. This is useful to save the hidden outlines and restore them later -after reverting the buffer. Also return the outline where point -was located before reverting the buffer." +after reverting the buffer. +CURRENT-HEADING is the heading where point is located." (let* ((paths (make-hash-table :test #'equal)) path current-path (current-heading-p (outline-on-heading-p)) @@ -1720,40 +1741,60 @@ was located before reverting the buffer." (current-end (when current-heading-p (pos-eol)))) (outline-map-region (lambda () - (let* ((level (funcall outline-level)) - (heading (buffer-substring-no-properties (pos-bol) (pos-eol)))) - (while (and path (>= (cdar path) level)) - (pop path)) - (push (cons heading level) path) - (when (save-excursion - (outline-end-of-heading) - (seq-some (lambda (o) (eq (overlay-get o 'invisible) - 'outline)) - (overlays-at (point)))) - (setf (gethash (mapcar #'car path) paths) t)) + (let ((level (funcall outline-level))) + (if (outline-invisible-p) + ;; Covered by "the" previous heading. + (cl-callf (lambda (l) (if (numberp l) (min l level) level)) + (gethash (mapcar #'car path) paths)) + (let ((heading (buffer-substring-no-properties (pos-bol) (pos-eol)))) + (while (and path (>= (cdar path) level)) + (pop path)) + (push (cons heading level) path) + (when (save-excursion + (outline-end-of-heading) + (outline-invisible-p)) + (setf (gethash (mapcar #'car path) paths) t)))) (when (and current-heading-p (<= current-beg (point) current-end)) (setq current-path (mapcar #'car path))))) (point-min) (point-max)) (list paths current-path))) (defun outline--hidden-headings-restore-paths (paths current-path) - "Restore hidden outlines from a hash of hidden headings. + "Restore hidden outlines from a hash-table of hidden headings. This is useful after reverting the buffer to restore the outlines hidden by `outline--hidden-headings-paths'. Also restore point on the same outline where point was before reverting the buffer." - (let (path current-point outline-view-change-hook) + (let ((hidelevel nil) (hidestart nil) + path current-point outline-view-change-hook) (outline-map-region (lambda () - (let* ((level (funcall outline-level)) - (heading (buffer-substring (pos-bol) (pos-eol)))) - (while (and path (>= (cdar path) level)) - (pop path)) - (push (cons heading level) path) - (when (gethash (mapcar #'car path) paths) - (outline-hide-subtree)) + (let ((level (funcall outline-level))) + (if (and (numberp hidelevel) (<= hidelevel level)) + nil + (when hidestart + (outline-flag-region hidestart + (save-excursion (outline--end-of-previous) + (point)) + t) + (setq hidestart nil)) + (let* ((heading (buffer-substring-no-properties + (pos-bol) (pos-eol)))) + (while (and path (>= (cdar path) level)) + (pop path)) + (push (cons heading level) path) + (when (setq hidelevel (gethash (mapcar #'car path) paths)) + (setq hidestart (save-excursion (outline-end-of-heading) + (point)))))) (when (and current-path (equal current-path (mapcar #'car path))) (setq current-point (point))))) (point-min) (point-max)) + (when hidestart + (outline-flag-region hidestart + (save-excursion + (goto-char (point-max)) + (outline--end-of-previous) + (point)) + t)) (when current-point (goto-char current-point)))) (defun outline-revert-buffer-restore-visibility () diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 1ca58b3ac7d..8cfa793cfc6 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -565,6 +565,19 @@ during global destruction\\.$\\)" 1 2) "\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil nil) + (rust + ,(rx bol (or (group-n 1 "error") (group-n 2 "warning") (group-n 3 "note")) + (? "[" (+ (in "A-Z" "0-9")) "]") ":" (* nonl) + "\n" (+ " ") "-->" + " " (group-n 4 (+ nonl)) ; file + ":" (group-n 5 (+ (in "0-9"))) ; line + ":" (group-n 6 (+ (in "0-9")))) ; column + 4 5 6 (2 . 3) + nil + (1 compilation-error-face) + (2 compilation-warning-face) + (3 compilation-info-face)) + (rxp "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\ \\([0-9]+\\) of file://\\(.+\\)" diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5bb825189f2..5a43d494e56 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -250,6 +250,7 @@ automatically)." . ,(eglot-alternatives '("pylsp" "pyls" ("basedpyright-langserver" "--stdio") ("pyright-langserver" "--stdio") + ("pyrefly" "lsp") "jedi-language-server" ("ruff" "server") "ruff-lsp"))) ((js-json-mode json-mode json-ts-mode jsonc-mode) . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 42057a3aacb..f14d91504af 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1649,7 +1649,10 @@ Point should be just after a string that matches TAG." (or (and (eq (char-after (point)) ?\001) (eq (char-after (- (point) (length tag) 1)) ?\177)) ;; We are not on the explicit tag name, but perhaps it follows. - (looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001")))) + (looking-at (concat "[^\177\n]*\177" + (regexp-quote tag) + ;; The optional "/x" part is for Ada tags. + "\\(/[fpsbtk]\\)?\001")))) ;; t if point is at a tag line that has an implicit name. ;; point should be just after a string that matches TAG. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 8a072b94a17..e911faf603d 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1891,6 +1891,10 @@ TYPE is usually keyword `:error', `:warning' or `:note'." (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'flymake-goto-diagnostic) (define-key map (kbd "SPC") 'flymake-show-diagnostic) + (keymap-set map "C-o" #'flymake-show-diagnostic) + (keymap-set map "C-m" #'flymake-goto-diagnostic) + (keymap-set map "n" #'next-error-this-buffer-no-select) + (keymap-set map "p" #'previous-error-this-buffer-no-select) map)) (defun flymake-show-diagnostic (pos &optional other-window) @@ -2187,6 +2191,11 @@ some of this variable's contents the diagnostic listings.") (defvar-local flymake--project-diagnostic-list-project nil) +(defvar flymake-project-diagnostics-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map flymake-diagnostics-buffer-mode-map) + map)) + (define-derived-mode flymake-project-diagnostics-mode tabulated-list-mode "Flymake diagnostics" "A mode for listing Flymake diagnostics in a project." diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 45b04f772d3..f91cd2cc400 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -710,7 +710,7 @@ first capture group of `grep-heading-regexp'.") (when (file-remote-p file-name) (write-region "Copyright\n" nil file-name)) file-name)) - ((and (eq system-type 'android) (featurep 'android)) + ((and (eq system-type 'android) (featurep 'android)) ;; /assets/etc is not accessible to grep or other shell ;; commands on Android, and therefore the template must ;; be copied to a location that is. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 14d06f1171d..44a1714b02f 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4063,6 +4063,7 @@ See `treesit-thing-settings' for more information.") ;; Which-func. (setq-local which-func-imenu-joiner-function #'js--which-func-joiner) ;; Comment. + (c-ts-common-comment-setup) (setq-local comment-setup-function #'js--treesit-comment-setup) (setq-local comment-multi-line t) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 808d2890b8d..5cf9a68a294 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1574,13 +1574,28 @@ general form of conditions." (and (memq (cdr buffer) buffers) (not (project--buffer-check - (cdr buffer) project-ignore-buffer-conditions))))) - (buffer (read-buffer - "Switch to buffer: " - (when (funcall predicate (cons other-name other-buffer)) - other-name) - nil - predicate))) + buffer project-ignore-buffer-conditions))))) + (buffer + (if (and (fboundp 'uniquify-get-unique-names) + uniquify-buffer-name-style) + ;; Forgo the use of `buffer-read-function' (often nil) in + ;; favor of uniquifying the buffers better. + (let* ((unique-names (uniquify-get-unique-names buffers)) + (other-name (when (funcall predicate (cons other-name other-buffer)) + (car (rassoc other-buffer unique-names)))) + (result (completing-read + "Switch to buffer: " + unique-names + predicate + nil nil nil + other-name))) + (assoc-default result unique-names #'equal result)) + (read-buffer + "Switch to buffer: " + (when (funcall predicate (cons other-name other-buffer)) + other-name) + nil + predicate)))) ;; XXX: This check hardcodes the default buffer-belonging relation ;; which `project-buffers' is allowed to override. Straighten ;; this up sometime later. Or not. Since we can add a method @@ -1936,12 +1951,18 @@ has changed, and NO-WRITE is nil." If project PR satisfies `project-list-exclude', then nothing is done. Save the result in `project-list-file' if the list of projects has changed, and NO-WRITE is nil." - (let ((root (project-root pr))) - (unless (seq-some (lambda (r) - (if (functionp r) - (funcall r pr) - (string-match-p r root))) - project-list-exclude) + (interactive (list (project-current t))) + (let ((root (project-root pr)) + (interact (called-interactively-p 'any))) + (if (seq-some (lambda (r) + (if (functionp r) + (funcall r pr) + (string-match-p r root))) + project-list-exclude) + (when interact + (message "Current project is blacklisted!")) + (when interact + (message "Current project remembered")) (project--remember-dir root no-write)))) (defun project--remove-from-project-list (project-root report-message) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 5075e9a0afc..dabef95463c 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1153,26 +1153,6 @@ and command `sh-reset-indent-vars-to-global-values'." :options '(sh-electric-here-document-mode) :group 'sh-script) -(defcustom sh-popup-occur-buffer nil - "Controls when `smie-config-guess' pops the `*indent*' buffer. -If t it is always shown. If nil, it is shown only when there -are conflicts." - :type '(choice - (const :tag "Only when there are conflicts." nil) - (const :tag "Always" t)) - :group 'sh-indentation) - -(defcustom sh-first-lines-indent 0 - "The indentation of the first non-blank non-comment line. -Usually 0 meaning first column. -Can be set to a number, or to nil which means leave it as is." - :type '(choice - (const :tag "Leave as is" nil) - (integer :tag "Column number" - :menu-tag "Indent to this col (0 means first col)" )) - :group 'sh-indentation) - - (defcustom sh-basic-offset 4 "The default indentation increment. This value is used for the `+' and `-' symbols in an indentation variable." @@ -1180,21 +1160,6 @@ This value is used for the `+' and `-' symbols in an indentation variable." :safe #'integerp :group 'sh-indentation) -(defcustom sh-indent-comment t - "How a comment line is to be indented. -nil means leave it as it is; -t means indent it as a normal line, aligning it to previous non-blank - non-comment line; -a number means align to that column, e.g. 0 means first column." - :type '(choice - (const :tag "Leave as is." nil) - (const :tag "Indent as a normal line." t) - (integer :menu-tag "Indent to this col (0 means first col)." - :tag "Indent to column number.") ) - :version "24.3" - :group 'sh-indentation) - - (defvar sh-debug nil "Enable lots of debug messages - if function `sh-debug' is enabled.") @@ -1220,16 +1185,6 @@ a number means align to that column, e.g. 0 means first column." (const :tag "/ " :value / :menu-tag "/ Indent left half sh-basic-offset"))) -(defcustom sh-indent-for-else 0 - "How much to indent an `else' relative to its `if'. Usually 0." - :type `(choice - (integer :menu-tag "A number (positive=>indent right)" - :tag "A number") - (const :tag "--") ;; separator! - ,@ sh-symbol-list - ) - :group 'sh-indentation) - (defconst sh-number-or-symbol-list (append '((integer :menu-tag "A number (positive=>indent right)" :tag "A number") @@ -1380,19 +1335,17 @@ punctuation characters like `-'." (defconst sh-var-list '( - sh-basic-offset sh-first-lines-indent sh-indent-after-case + sh-basic-offset sh-indent-after-case sh-indent-after-do sh-indent-after-done sh-indent-after-else sh-indent-after-if sh-indent-after-loop-construct sh-indent-after-open - sh-indent-comment sh-indent-for-case-alt sh-indent-for-case-label sh-indent-for-continuation sh-indent-for-do sh-indent-for-done - sh-indent-for-else sh-indent-for-fi sh-indent-for-then ) @@ -3368,7 +3321,7 @@ See `sh-mode--treesit-other-keywords' and :feature 'string-interpolation :language 'bash :override t - '((command_substitution) @sh-quoted-exec + '((command_substitution (command) @sh-quoted-exec) (expansion (variable_name) @font-lock-variable-use-face) (expansion ["${" "}"] @font-lock-bracket-face) (simple_expansion diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 24953f629de..6c381c8d777 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -155,7 +155,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." (typescript-ts-mode--check-dialect language) `((,language ((parent-is "program") column-0 0) - ((node-is "}") parent-bol 0) + ((node-is "}") standalone-parent 0) ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) ((node-is ">") parent-bol 0) @@ -165,7 +165,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." ((parent-is "ternary_expression") standalone-parent typescript-ts-mode-indent-offset) ((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 "statement_block") standalone-parent typescript-ts-mode-indent-offset) ((or (node-is "case") (node-is "default")) parent-bol typescript-ts-mode-indent-offset) @@ -229,6 +229,26 @@ Argument LANGUAGE is either `typescript' or `tsx'." "&&" "||" "!" "?.") "TypeScript operators for tree-sitter font-locking.") +(defun typescript-ts--standalone-parent-p (parent) + "Return t if PARENT can be considered standalone. +This is used for `treesit-simple-indent-standalone-predicate'." + (save-excursion + (goto-char (treesit-node-start parent)) + (cond + ;; Never allow nested ternary_expression node to be standalone + ;; parent, to avoid nested indentation. + ((equal (treesit-node-type (treesit-node-parent parent)) + "ternary_expression") + nil) + ;; If there's only whitespace before node, consider + ;; this node standalone. To support function + ;; chaining, allow a dot to be before the node. + ((looking-back (rx bol (* whitespace) (? ".")) + (line-beginning-position)) + (if (looking-back "\\." (max (point-min) (1- (point)))) + (1- (point)) + (point)))))) + (defun tsx-ts-mode--font-lock-compatibility-bb1f97b (language) "Font lock rules helper, to handle different releases of tree-sitter-tsx. Check if a node type is available, then return the right font lock rules. @@ -254,7 +274,10 @@ Argument LANGUAGE is either `typescript' or `tsx'." @typescript-ts-jsx-tag-face) (jsx_attribute (property_identifier) - @typescript-ts-jsx-attribute-face))) + @typescript-ts-jsx-attribute-face) + + (jsx_expression (identifier) + @font-lock-variable-use-face))) (queries-b '((jsx_opening_element [(nested_identifier (identifier)) (identifier)] @typescript-ts-jsx-tag-face) @@ -268,7 +291,10 @@ Argument LANGUAGE is either `typescript' or `tsx'." @typescript-ts-jsx-tag-face) (jsx_attribute (property_identifier) - @typescript-ts-jsx-attribute-face)))) + @typescript-ts-jsx-attribute-face) + + (jsx_expression (identifier) + @font-lock-variable-use-face)))) (or (and (treesit-query-valid-p language queries-a) queries-a) (and (treesit-query-valid-p language queries-b) @@ -305,6 +331,10 @@ Argument LANGUAGE is either `typescript' or `tsx'." :feature 'constant `(((identifier) @font-lock-constant-face (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) + ((identifier) @font-lock-constant-face + (:equal "document" @font-lock-constant-face)) + ((identifier) @font-lock-constant-face + (:equal "console" @font-lock-constant-face)) [(true) (false) (null) (undefined)] @font-lock-constant-face) :language language @@ -404,7 +434,28 @@ Argument LANGUAGE is either `typescript' or `tsx'." parameters: [(_ (identifier) @font-lock-variable-name-face) (_ (_ (identifier) @font-lock-variable-name-face)) - (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) + (_ (_ (_ (identifier) @font-lock-variable-name-face)))]) + + (template_substitution (identifier) @font-lock-variable-use-face) + + (call_expression + arguments: (arguments (identifier) @font-lock-variable-use-face)) + + (pair + value: (identifier) @font-lock-variable-use-face) + + ;; What is being called could be a static Type (convention + ;; CamelCase, leading caps). + ((member_expression + object: (identifier) @font-lock-type-face) + (:match "\\`[A-Z_][0-9A-Za-z_]*\\'" @font-lock-type-face)) + ;; If not, assume what is being called is a instance-value + ;; and in that it's a variable. Properties are less used in + ;; javascript/typescript) + (member_expression + object: (identifier) @font-lock-variable-use-face) + + (non_null_expression (identifier) @font-lock-variable-use-face)) :language language :feature 'property @@ -610,6 +661,7 @@ This mode is intended to be inherited by concrete major modes." :syntax-table typescript-ts-mode--syntax-table ;; Comments. + (c-ts-common-comment-setup) (setq-local comment-setup-function #'js--treesit-comment-setup) ;; Electric @@ -648,6 +700,8 @@ This mode is intended to be inherited by concrete major modes." ;; Indent. (setq-local treesit-simple-indent-rules (typescript-ts-mode--indent-rules 'typescript)) + (setq-local treesit-simple-indent-standalone-predicate + #'typescript-ts--standalone-parent-p) ;; Font-lock. (setq-local treesit-font-lock-settings @@ -697,6 +751,8 @@ at least 3 (which is the default value)." ;; Indent. (setq-local treesit-simple-indent-rules (typescript-ts-mode--indent-rules 'tsx)) + (setq-local treesit-simple-indent-standalone-predicate + #'typescript-ts--standalone-parent-p) (setq-local treesit-thing-settings `((tsx diff --git a/lisp/register.el b/lisp/register.el index 8d8c3ab5b8f..6d2524b94e8 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -36,6 +36,7 @@ ;; FIXME: Clean up namespace usage! (declare-function dired-current-directory "dired") +(declare-function cl-find-class "cl-extra") (cl-defstruct (registerv (:constructor nil) diff --git a/lisp/replace.el b/lisp/replace.el index a6ba6387dc9..9939273594f 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -3089,20 +3089,21 @@ characters." (set-match-data real-match-data) (match-substitute-replacement next-replacement nocasify literal)))) - ;; Bind message-log-max so we don't fill up the - ;; message log with a bunch of identical messages. - (let ((message-log-max nil) - (replacement-presentation - (if query-replace-show-replacement - (save-match-data - (set-match-data real-match-data) - (match-substitute-replacement next-replacement - nocasify literal)) - next-replacement))) - (message message - (query-replace-descr from-string) - (query-replace-descr replacement-presentation))) - (setq key (read-event)) + (let* ((replacement-presentation + (if query-replace-show-replacement + (save-match-data + (set-match-data real-match-data) + (match-substitute-replacement next-replacement + nocasify literal)) + next-replacement)) + (prompt + (format message + (query-replace-descr from-string) + (query-replace-descr + replacement-presentation)))) + ;; Use `read-key' so that escape sequences on TTYs + ;; are properly mapped back to the intended key. + (setq key (read-key prompt))) ;; Necessary in case something happens during ;; read-event that clobbers the match data. (set-match-data real-match-data) diff --git a/lisp/ses.el b/lisp/ses.el index aa3eb1bad40..01d6e755eb3 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -299,7 +299,10 @@ Used for listing local printers or renamed cells.") (defconst ses-standard-printer-functions '(ses-center - ses-center-span ses-dashfill ses-dashfill-span + ses-center-span + ses-left + ses-left-span + ses-dashfill ses-dashfill-span ses-tildefill-span ses-prin1) "List of print functions to be included in initial history of printer functions. @@ -4080,6 +4083,25 @@ either (ses-range BEG END) or (list ...). The TEST is evaluated." (put x 'side-effect-free t)) +(defun ses--align (value align-fn span fill printer) + "Helper fonction for \\{ses-center} and \\{ses-left}. Please refer to these functions help. +ALIGN-FN shall be a function to concatenate the padding, it shall have +parameters (VALUE WIDTH FILL) with: +VALUE a string already formatted by PRINTER to which padding is to be +concatenated. +WIDTH the additional width to be padded if >0, <= 0 if no padding is to +be added. +FILL the fill character to be padded." + (setq printer (or printer (ses-col-printer ses--col) ses--default-printer)) + (let ((width (ses-col-width ses--col))) + (or span (setq span 0)) + (setq value (ses-call-printer printer value)) + (dotimes (x span) + (setq width (+ width 1 (ses-col-width (+ ses--col span (- x)))))) + ;; Set column width. + (setq width (- width (string-width value))) + (funcall align-fn value width fill))) + ;;---------------------------------------------------------------------------- ;; Standard print functions ;;---------------------------------------------------------------------------- @@ -4087,36 +4109,56 @@ either (ses-range BEG END) or (list ...). The TEST is evaluated." (defun ses-center (value &optional span fill printer) "Print VALUE, centered within column. FILL is the fill character for centering (default = space). -SPAN indicates how many additional rightward columns to include -in width (default = 0). +SPAN indicates how many additional rightward columns to include in +width (default = 0). PRINTER is the printer to use for printing the value, default is the -column printer if any, or the spreadsheet the spreadsheet default -printer otherwise." - (setq printer (or printer (ses-col-printer ses--col) ses--default-printer)) - (let ((width (ses-col-width ses--col)) - half) - (or fill (setq fill ?\s)) - (or span (setq span 0)) - (setq value (ses-call-printer printer value)) - (dotimes (x span) - (setq width (+ width 1 (ses-col-width (+ ses--col span (- x)))))) - ;; Set column width. - (setq width (- width (string-width value))) - (if (<= width 0) - value ; Too large for field, anyway. - (setq half (make-string (/ width 2) fill)) - (concat half value half - (if (oddp width) (char-to-string fill)))))) +column printer if any, or the spreadsheet default printer otherwise." + (ses--align value + (lambda (value width fill) + (if (<= width 0) + value ; Too large for field, anyway. + (let ((half (make-string (/ width 2) fill))) + (concat half value half + (if (oddp width) (char-to-string fill)))))) + span (or fill ?\s) printer)) + +(defun ses--span (align-fn value fill printer) + "Helper function for \\{ses-center-span} and \\{ses-left-span}. Please refer to these functions help. +ALIGN-FN shall be a function such as \\{ses-center} or \\{ses-left}." + (let ((end (1+ ses--col))) + (while (and (< end ses--numcols) + (memq (ses-cell-value ses--row end) '(nil *skip*))) + (setq end (1+ end))) + (funcall align-fn value (- end ses--col 1) fill printer))) + (defun ses-center-span (value &optional fill printer) "Print VALUE, centered within the span that starts in the current column and continues until the next nonblank column. FILL specifies the fill character (default = space)." - (let ((end (1+ ses--col))) - (while (and (< end ses--numcols) - (memq (ses-cell-value ses--row end) '(nil *skip*))) - (setq end (1+ end))) - (ses-center value (- end ses--col 1) fill printer))) + (ses--span #'ses-center value fill printer)) + +(defun ses-left (value &optional span fill printer) + "Print VALUE, left aligned within column. +FILL is the fill character for aligning (default = '-'). +SPAN indicates how many additional rightward columns to include +in width (default = 0). +PRINTER is the printer to use for printing the value, default is the +column printer if any, or the spreadsheet the spreadsheet default +printer otherwise." + (ses--align value + (lambda (value width fill) + (if (<= width 0) + value ; Too large for field, anyway. + (concat value (make-string width fill)))) + span (or fill ?-) printer)) + +(defun ses-left-span (value &optional fill printer) + "Print VALUE, aligned left within the span that starts in the current column +and continues until the next nonblank column. +FILL specifies the fill character (default = '-')." + (ses--span #'ses-left value fill printer)) + (defun ses-dashfill (value &optional span printer) "Print VALUE centered using dashes. diff --git a/lisp/simple.el b/lisp/simple.el index f686907ad68..fa173b26289 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -478,6 +478,16 @@ select the source buffer." '(nil (inhibit-same-window . t)))) (next-error n)))) +(defun next-error-this-buffer-no-select (&optional n) + "Move point to the next error in the current buffer and highlight match. +Prefix arg N says how many error messages to move forwards (or +backwards, if negative). +Finds and highlights the source line like \\[next-error], but does not +select the source buffer." + (interactive "p") + (next-error-select-buffer (current-buffer)) + (next-error-no-select n)) + (defun previous-error-no-select (&optional n) "Move point to the previous error in the `next-error' buffer and highlight match. Prefix arg N says how many error messages to move backwards (or @@ -487,6 +497,16 @@ select the source buffer." (interactive "p") (next-error-no-select (- (or n 1)))) +(defun previous-error-this-buffer-no-select (&optional n) + "Move point to the previous error in the current buffer and highlight match. +Prefix arg N says how many error messages to move forwards (or +backwards, if negative). +Finds and highlights the source line like \\[previous-error], but does not +select the source buffer." + (interactive "p") + (next-error-select-buffer (current-buffer)) + (previous-error-no-select n)) + ;; Internal variable for `next-error-follow-mode-post-command-hook'. (defvar next-error-follow-last-line nil) diff --git a/lisp/startup.el b/lisp/startup.el index 230b50311c6..3d38f68098b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1143,6 +1143,57 @@ the `--debug-init' option to view a complete error backtrace." (defvar lisp-directory nil "Directory where Emacs's own *.el and *.elc Lisp files are installed.") +(defvar load-path-filter--cache nil + "A cache used by `load-path-filter-cache-directory-files'. + +The value is an alist. The car of each entry is a list of load suffixes, +such as returned by `get-load-suffixes'. The cdr of each entry is a +cons whose car is a regex matching those suffixes +at the end of a string, and whose cdr is a hash-table mapping directories +to files in those directories which end with one of the suffixes. +These can also be nil, in which case no filtering will happen. +The files named in the hash-table can be of any kind, +including subdirectories. +The hash-table uses `equal' as its key comparison function.") + +(defun load-path-filter-cache-directory-files (path file suffixes) + "Filter PATH to leave only directories which might contain FILE with SUFFIXES. + +PATH should be a list of directories such as `load-path'. +Returns a copy of PATH with any directories that cannot contain FILE +with SUFFIXES removed from it. +Doesn't filter PATH if FILE is an absolute file name or if FILE is +a relative file name with leading directories. + +Caches contents of directories in `load-path-filter--cache'. + +This function is called from `load' via `load-path-filter-function'." + (if (file-name-directory file) + ;; FILE has more than one component, don't bother filtering. + path + (pcase-let + ((`(,rx . ,ht) + (with-memoization (alist-get suffixes load-path-filter--cache + nil nil #'equal) + (if (member "" suffixes) + '(nil ;; Optimize the filtering. + ;; Don't bother filtering if "" is among the suffixes. + ;; It's a much less common use-case and it would use + ;; more memory to keep the corresponding info. + . nil) + (cons (concat (regexp-opt suffixes) "\\'") + (make-hash-table :test #'equal)))))) + (if (null ht) + path + (seq-filter + (lambda (dir) + (when (file-directory-p dir) + (try-completion + file + (with-memoization (gethash dir ht) + (directory-files dir nil rx t))))) + path))))) + (defun command-line () "A subroutine of `normal-top-level'. Amongst another things, it parses the command-line arguments." diff --git a/lisp/subr.el b/lisp/subr.el index d15b6c53730..729f8b3e09b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -161,11 +161,12 @@ of previous VARs. `(progn . ,(nreverse exps)))) (defmacro setq-local (&rest pairs) - "Make each VARIABLE buffer-local and assign to it the corresponding VALUE. + "Make each VARIABLE local to current buffer and set it to corresponding VALUE. 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. +make VARIABLE buffer-local in the current buffer and assign to it the +corresponding VALUE of the pair. The VARIABLEs are literal symbols +and should not be quoted. The VALUE of the Nth pair is not computed until after the VARIABLE of the (N-1)th pair is set; thus, each VALUE can use the new VALUEs @@ -4478,7 +4479,7 @@ don't change the volume setting of the sound device. :device DEVICE - play sound on DEVICE. If not specified, a system-dependent default device name is used. -Note: :data and :device are currently not supported on Windows." +Note: :device is currently not supported on Windows." (if (fboundp 'play-sound-internal) (play-sound-internal sound) (error "This Emacs binary lacks sound support"))) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 411d8cbd70d..761968b4457 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -862,8 +862,7 @@ the selected tab visible." Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive (list current-prefix-arg last-nonmenu-event)) (when (tab-line-track-tap event) - (let ((window (and (listp event) - (posn-window (tab-line-event-start event))))) + (let ((window (posn-window (tab-line-event-start event)))) (tab-line-hscroll arg window) (force-mode-line-update window)))) @@ -872,8 +871,7 @@ Interactively, ARG is the prefix numeric argument and defaults to 1." Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive (list current-prefix-arg last-nonmenu-event)) (when (tab-line-track-tap event) - (let ((window (and (listp event) - (posn-window (tab-line-event-start event))))) + (let ((window (posn-window (tab-line-event-start event)))) (tab-line-hscroll (- (or arg 1)) window) (force-mode-line-update window)))) @@ -888,7 +886,7 @@ corresponding to the new buffer shown in the window." (if (functionp tab-line-new-tab-choice) (funcall tab-line-new-tab-choice) (let ((tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups)) - (if (and (listp event) + (if (and (consp event) (display-popup-menus-p) (not tty-menu-open-use-tmm)) (mouse-buffer-menu event) ; like (buffer-menu-open) @@ -954,27 +952,26 @@ switches to the previous buffer in the sequence defined by is possible when `tab-line-switch-cycling' is non-nil." (interactive (list last-nonmenu-event (prefix-numeric-value current-prefix-arg))) - (let ((window (and (listp event) (posn-window (event-start event))))) - (with-selected-window (or window (selected-window)) - (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) - (previous-buffer arg t) - (let* ((buffers (seq-keep - (lambda (tab) (or (and (bufferp tab) tab) - (alist-get 'buffer tab))) - (funcall tab-line-tabs-function))) - (old-pos (seq-position buffers (current-buffer))) - (new-pos (when old-pos (- old-pos (or arg 1)))) - (new-pos (when new-pos - (if tab-line-switch-cycling - (mod new-pos (length buffers)) - (max new-pos 0)))) - (buffer (when new-pos (nth new-pos buffers)))) - (when (bufferp buffer) - (let ((switch-to-buffer-obey-display-actions nil)) - (switch-to-buffer buffer)))))))) + (with-selected-window (posn-window (tab-line-event-start event)) + (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) + (previous-buffer arg t) + (let* ((buffers (seq-keep + (lambda (tab) (or (and (bufferp tab) tab) + (alist-get 'buffer tab))) + (funcall tab-line-tabs-function))) + (old-pos (seq-position buffers (current-buffer))) + (new-pos (when old-pos (- old-pos (or arg 1)))) + (new-pos (when new-pos + (if tab-line-switch-cycling + (mod new-pos (length buffers)) + (max new-pos 0)))) + (buffer (when new-pos (nth new-pos buffers)))) + (when (bufferp buffer) + (let ((switch-to-buffer-obey-display-actions nil)) + (switch-to-buffer buffer))))))) (defun tab-line-switch-to-next-tab (&optional event arg) - "Switch to the next ARGth tab's buffer. + "Switch to the next ARGth tab's buffer. When `tab-line-tabs-function' is `tab-line-tabs-window-buffers', its effect is the same as using the `next-buffer' command \(\\[next-buffer]). @@ -984,24 +981,23 @@ switches to the next buffer in the sequence defined by is possible when `tab-line-switch-cycling' is non-nil." (interactive (list last-nonmenu-event (prefix-numeric-value current-prefix-arg))) - (let ((window (and (listp event) (posn-window (event-start event))))) - (with-selected-window (or window (selected-window)) - (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) - (next-buffer arg t) - (let* ((buffers (seq-keep - (lambda (tab) (or (and (bufferp tab) tab) - (alist-get 'buffer tab))) - (funcall tab-line-tabs-function))) - (old-pos (seq-position buffers (current-buffer))) - (new-pos (when old-pos (+ old-pos (or arg 1)))) - (new-pos (when new-pos - (if tab-line-switch-cycling - (mod new-pos (length buffers)) - (min new-pos (1- (length buffers)))))) - (buffer (when new-pos (nth new-pos buffers)))) - (when (bufferp buffer) - (let ((switch-to-buffer-obey-display-actions nil)) - (switch-to-buffer buffer)))))))) + (with-selected-window (posn-window (tab-line-event-start event)) + (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) + (next-buffer arg t) + (let* ((buffers (seq-keep + (lambda (tab) (or (and (bufferp tab) tab) + (alist-get 'buffer tab))) + (funcall tab-line-tabs-function))) + (old-pos (seq-position buffers (current-buffer))) + (new-pos (when old-pos (+ old-pos (or arg 1)))) + (new-pos (when new-pos + (if tab-line-switch-cycling + (mod new-pos (length buffers)) + (min new-pos (1- (length buffers)))))) + (buffer (when new-pos (nth new-pos buffers)))) + (when (bufferp buffer) + (let ((switch-to-buffer-obey-display-actions nil)) + (switch-to-buffer buffer))))))) (defun tab-line-mouse-move-tab (event) "Move a tab to a different position on the tab line using mouse. @@ -1083,6 +1079,13 @@ This option is useful when `tab-line-tabs-function' has the value :group 'tab-line :version "27.1") +(defun tab-line--current-tab () + "Return the current tab in the tab line." + (seq-find (lambda (tab) + (eq (if (bufferp tab) tab (alist-get 'buffer tab)) + (current-buffer))) + (funcall tab-line-tabs-function))) + (defun tab-line-close-tab (&optional event) "Close the selected tab. This command is usually invoked by clicking on the close button on the @@ -1090,13 +1093,13 @@ right side of the tab. This command buries the buffer, so it goes out of sight of the tab line." (interactive (list last-nonmenu-event)) (when (tab-line-track-tap event) - (let* ((posnp (and (listp event) - (tab-line-event-start event))) - (window (and posnp (posn-window posnp))) - (tab (tab-line--get-tab-property 'tab (car (posn-string posnp)))) + (let* ((posnp (tab-line-event-start event)) + (tab (if (consp event) + (tab-line--get-tab-property 'tab (car (posn-string posnp))) + (tab-line--current-tab))) (buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))) (close-function (unless (bufferp tab) (cdr (assq 'close tab))))) - (with-selected-window (or window (selected-window)) + (with-selected-window (posn-window posnp) (cond ((functionp close-function) (funcall close-function)) @@ -1111,12 +1114,42 @@ sight of the tab line." (funcall tab-line-close-tab-function tab))) (force-mode-line-update))))) +(defun tab-line-close-other-tabs (&optional event) + "Close all tabs on the selected window, except the tab on EVENT. +It preforms the same actions on the closed tabs as in `tab-line-close-tab'." + (interactive (list last-nonmenu-event)) + (when (tab-line-track-tap event) + (let* ((posnp (tab-line-event-start event)) + (keep-tab (if (consp event) + (tab-line--get-tab-property 'tab (car (posn-string posnp))) + (tab-line--current-tab)))) + (with-selected-window (posn-window posnp) + (dolist (tab (delete keep-tab (funcall tab-line-tabs-function))) + (let ((buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))) + (close-function (unless (bufferp tab) (cdr (assq 'close tab))))) + (cond + ((functionp close-function) + (funcall close-function)) + ((eq tab-line-close-tab-function 'kill-buffer) + (kill-buffer buffer)) + ((eq tab-line-close-tab-function 'bury-buffer) + (if (eq buffer (current-buffer)) + (bury-buffer) + (set-window-prev-buffers nil (assq-delete-all buffer (window-prev-buffers))) + (set-window-next-buffers nil (delq buffer (window-next-buffers))))) + ((functionp tab-line-close-tab-function) + (funcall tab-line-close-tab-function tab))))) + (force-mode-line-update))))) + (defun tab-line-tab-context-menu (&optional event) "Pop up the context menu for a tab-line tab." (interactive "e") (let ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t)))) (define-key-after menu [close] '(menu-item "Close" tab-line-close-tab :help "Close the tab")) + (define-key-after menu [close-other] + '(menu-item "Close other tabs" tab-line-close-other-tabs + :help "Close all other tabs")) (popup-menu menu event))) (defun tab-line-context-menu (&optional event) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index ee217804d8f..946685150af 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -316,7 +316,7 @@ For buffer objects, returns the buffer object itself." (defvar-local reftex-docstruct-symbol nil) (defun reftex-next-multifile-index () - ;; Return the next free index for multifile symbols. + "Return the next free index for multifile symbols." (incf reftex-multifile-index)) (defun reftex--remove-buffer-from-master-index () @@ -372,10 +372,10 @@ If the symbols for the current master file do not exist, they are created." (set symbol nil)))) (defun reftex-TeX-master-file () - ;; Return the name of the master file associated with the current buffer. - ;; When AUCTeX is loaded, we will use it's more sophisticated method. - ;; We also support the default TeX and LaTeX modes by checking for a - ;; variable tex-main-file. + "Return the name of the master file associated with the current buffer. +When AUCTeX is loaded, we will use it's more sophisticated method. +We also support the default TeX and LaTeX modes by checking for a +variable `tex-main-file'." (with-current-buffer (or (buffer-base-buffer) (current-buffer)) (let ;; Set master to a file name (possibly non-existent), or nil: @@ -445,14 +445,14 @@ If the symbols for the current master file do not exist, they are created." (or master (current-buffer)))))) (defun reftex-is-multi () - ;; Tell if this is a multifile document. When not sure, say yes. + "Tell if this is a multifile document. When not sure, say yes." (let ((entry (assq 'is-multi (symbol-value reftex-docstruct-symbol)))) (if entry (nth 1 entry) t))) (defun reftex-set-cite-format (value) - "Set the document-local value of `reftex-cite-format'. + "Set the document-local VALUE of `reftex-cite-format'. When such a value exists, it overwrites the setting given with `reftex-cite-format'. See the documentation of `reftex-cite-format' for possible values. This function should be used from AUCTeX style files." @@ -463,8 +463,9 @@ for possible values. This function should be used from AUCTeX style files." (put reftex-docstruct-symbol 'reftex-cite-format value))) (defun reftex-get-cite-format () - ;; Return the current citation format. Either the document-local value in - ;; reftex-cite-format-symbol, or the global value in reftex-cite-format. + "Return the current citation format. +Either the document-local value in `reftex-cite-format-symbol', or the +global value in `reftex-cite-format'." (if (and reftex-docstruct-symbol (symbolp reftex-docstruct-symbol) (get reftex-docstruct-symbol 'reftex-cite-format)) @@ -697,7 +698,7 @@ will deactivate it." )) (defun reftex-ensure-compiled-variables () - ;; Recompile the label alist when necessary + "Recompile the label alist when necessary." (let* ((mem reftex-memory) (cache (get reftex-docstruct-symbol 'reftex-cache)) (cmem (car cache)) @@ -777,7 +778,7 @@ This enforces rescanning the buffer on next use." (set (symbol-value symbol) nil))))) (defun reftex-erase-all-selection-and-index-buffers () - ;; Remove all selection buffers associated with current document. + "Remove all selection buffers associated with current document." (mapc (lambda (type) (reftex-erase-buffer (reftex-make-selection-buffer-name type))) @@ -789,8 +790,7 @@ This enforces rescanning the buffer on next use." (cdr (assoc 'index-tags (symbol-value reftex-docstruct-symbol))))) (defun reftex-compile-variables () - ;; Compile the information in reftex-label-alist & Co. - + "Compile the information in reftex-label-alist & Co." (message "Compiling label environment definitions...") ;; Update AUCTeX style information @@ -1129,8 +1129,8 @@ This enforces rescanning the buffer on next use." (mapcar #'symbol-value reftex-cache-variables))) (defun reftex-parse-args (macro) - ;; Return a list of macro name, nargs, arg-nr which is label and a list of - ;; optional argument indices. + "Return a list of MACRO name, nargs, arg-nr. +arg-nr is label and a list of optional argument indices." (if (string-match "[[{]\\*?[]}]" macro) (progn (let ((must-match (substring macro 0 (match-beginning 0))) @@ -1152,11 +1152,11 @@ This enforces rescanning the buffer on next use." ;;; Accessing the parse information (defun reftex-access-scan-info (&optional rescan file) - "Ensure access to the scanning info for the current file." - ;; When the multifile symbols are not yet tied, - ;; tie them. When they are empty or RESCAN is non-nil, scan the document. - ;; But, when RESCAN is -1, don't rescan even if docstruct is empty. - ;; When FILE is non-nil, parse only from that file. + "Ensure access to the scanning info for the current file. +When the multifile symbols are not yet tied, tie them. +When they are empty or RESCAN is non-nil, scan the document. +But, when RESCAN is -1, don't rescan even if docstruct is empty. +When FILE is non-nil, parse only from that file." ;; Make sure we have the symbols tied (if (eq reftex-docstruct-symbol nil) @@ -1196,7 +1196,7 @@ This enforces rescanning the buffer on next use." t)) (defun reftex-silence-toc-markers (list n) - ;; Set all toc markers in the first N entries in list to nil + "Set all toc markers in the first N entries in LIST to nil." (while (and list (> (decf n) -1)) (and (eq (car (car list)) 'toc) (markerp (nth 4 (car list))) @@ -1292,7 +1292,7 @@ For non-file buffers, persistence operations are skipped." t)))) (defun reftex-check-parse-consistency () - ;; Check if parse file is consistent, throw an error if not. + "Check if parse file is consistent, throw an error if not." ;; Check if the master is the same: when moving a document, this will see it. (let* ((real-master (reftex-TeX-master-file)) @@ -1316,7 +1316,7 @@ For non-file buffers, persistence operations are skipped." ) (defun reftex-select-external-document (xr-alist xr-index) - ;; Return index of an external document. + "Return index of an external document." (let* ((len (length xr-alist)) (highest (1- (+ ?0 len))) (prompt (format "[%c-%c] Select TAB: Read prefix with completion" ?0 highest)) @@ -1401,9 +1401,9 @@ When FILE is a buffer object, return that buffer." (t (message "No such file: %s (ignored)" file) nil))))) (defun reftex-find-file-externally (file type &optional master-dir) - ;; Use external program to find FILE. - ;; The program is taken from `reftex-external-file-finders'. - ;; Interpret relative path definitions starting from MASTER-DIR. + "Use external program to find FILE. +The program is taken from `reftex-external-file-finders'. +Interpret relative path definitions starting from MASTER-DIR." (let ((default-directory (or master-dir default-directory)) (prg (cdr (assoc type reftex-external-file-finders))) out) @@ -1425,13 +1425,13 @@ When FILE is a buffer object, return that buffer." (apply #'call-process program nil '(t nil) nil args)))))) (defun reftex-access-search-path (type &optional recurse master-dir file) - ;; Access path from environment variables. TYPE is either "tex" or "bib". - ;; When RECURSE is t, expand path elements ending in `//' recursively. - ;; Relative path elements are left as they are. However, relative recursive - ;; elements are expanded with MASTER-DIR as default directory. - ;; The expanded path is cached for the next search. - ;; FILE is just for the progress message. - ;; Returns the derived path. + "Access path from environment variables. TYPE is either \"tex\" or \"bib\". +When RECURSE is t, expand path elements ending in `//' recursively. +Relative path elements are left as they are. However, relative recursive +elements are expanded with MASTER-DIR as default directory. +The expanded path is cached for the next search. +FILE is just for the progress message. +Returns the derived path." (let* ((pathvar (intern (concat "reftex-" type "-path")))) (when (null (get pathvar 'status)) ;; Get basic path @@ -1485,8 +1485,8 @@ When FILE is a buffer object, return that buffer." (symbol-value pathvar)))) (defun reftex-find-file-on-path (file path &optional def-dir) - ;; Find FILE along the directory list PATH. - ;; DEF-DIR is the default directory for expanding relative path elements. + "Find FILE along the directory list PATH. +DEF-DIR is the default directory for expanding relative path elements." (catch 'exit (when (file-name-absolute-p file) (if (file-regular-p file) @@ -1503,8 +1503,8 @@ When FILE is a buffer object, return that buffer." nil))) (defun reftex-parse-colon-path (path) - ;; Like parse-colon-parse, but // or /~ are left alone. - ;; Trailing ! or !! will be converted into `//' (emTeX convention) + "Like parse-colon-parse, but // or /~ are left alone. +Trailing ! or !! will be converted into `//' (emTeX convention)" (mapcar (lambda (dir) (if (string-match "\\(//+\\|/*!+\\)\\'" dir) @@ -1513,8 +1513,8 @@ When FILE is a buffer object, return that buffer." (delete "" (split-string path (concat path-separator "+"))))) (defun reftex-expand-path (path &optional default-dir) - ;; Expand parts of path ending in `//' recursively into directory list. - ;; Relative recursive path elements are expanded relative to DEFAULT-DIR. + "Expand parts of path ending in `//' recursively into directory list. +Relative recursive path elements are expanded relative to DEFAULT-DIR." (let (path1 dir recursive) (while (setq dir (pop path)) (if (setq recursive (string= (substring dir -2) "//")) @@ -1530,7 +1530,7 @@ When FILE is a buffer object, return that buffer." (nreverse path1))) (defun reftex-recursive-directory-list (dir) - ;; Return a list of all directories below DIR, including DIR itself + "Return a list of all directories below DIR, including DIR itself." (let ((path (list dir)) path1 file files) (while (setq dir (pop path)) (when (file-directory-p dir) @@ -1546,7 +1546,7 @@ When FILE is a buffer object, return that buffer." ;;; Some generally useful functions (defun reftex-typekey-check (typekey conf-variable &optional n) - ;; Check if CONF-VARIABLE is true or contains TYPEKEY + "Check if CONF-VARIABLE is true or contains TYPEKEY." (and n (setq conf-variable (nth n conf-variable))) (or (eq conf-variable t) (and (stringp conf-variable) @@ -1554,8 +1554,8 @@ When FILE is a buffer object, return that buffer." (string-match (concat "[" conf-variable "]") typekey))))) (defun reftex-check-recursive-edit () - ;; Check if we are already in a recursive edit. Abort with helpful - ;; message if so. + "Check if we are already in a recursive edit. +Abort with helpful message if so." (if (marker-position reftex-recursive-edit-marker) (error (substitute-command-keys @@ -1576,26 +1576,26 @@ When FILE is a buffer object, return that buffer." pos t))))) (defun reftex-no-props (string) - ;; Return STRING with all text properties removed + "Return STRING with all text properties removed." (and (stringp string) (set-text-properties 0 (length string) nil string)) string) (defun reftex-match-string (n) - ;; Match string without properties + "Match string without properties." (when (match-beginning n) (buffer-substring-no-properties (match-beginning n) (match-end n)))) (define-obsolete-function-alias 'reftex-region-active-p #'use-region-p "28.1") (defun reftex-kill-buffer (buffer) - ;; Kill buffer if it exists. + "Kill BUFFER if it exists." (and (setq buffer (get-buffer buffer)) (kill-buffer buffer))) (defun reftex-erase-buffer (&optional buffer) - ;; Erase BUFFER if it exists. BUFFER defaults to current buffer. - ;; This even erases read-only buffers. + "Erase BUFFER if it exists. BUFFER defaults to current buffer. +This even erases read-only buffers." (cond ((null buffer) ;; erase current buffer @@ -1606,7 +1606,7 @@ When FILE is a buffer object, return that buffer." (let ((inhibit-read-only t)) (erase-buffer)))))) (defun reftex-this-word (&optional class) - ;; Grab the word around point. + "Grab the word around point." (setq class (or class "-a-zA-Z0-9:_/.*;|")) (save-excursion (buffer-substring-no-properties @@ -1619,7 +1619,7 @@ When FILE is a buffer object, return that buffer." "")) (defun reftex-all-assq (key list) - ;; Return a list of all associations of KEY in LIST. Comparison with eq. + "Return a list of all associations of KEY in LIST. Comparison with eq." (let (rtn) (while (setq list (memq (assq key list) list)) (push (car list) rtn) @@ -1627,7 +1627,7 @@ When FILE is a buffer object, return that buffer." (nreverse rtn))) (defun reftex-all-assoc-string (key list) - ;; Return a list of all associations of KEY in LIST. Comparison with string=. + "Return a list of all associations of KEY in LIST. Comparison with string=." (let (rtn) (while list (if (string= (car (car list)) key) @@ -1636,11 +1636,11 @@ When FILE is a buffer object, return that buffer." (nreverse rtn))) (defun reftex-last-assoc-before-elt (key elt list &optional exclusive) - ;; Find the last association of KEY in LIST before or at ELT - ;; ELT is found in LIST with equal, not eq. - ;; Returns nil when either KEY or elt are not found in LIST. - ;; When EXCLUSIVE is non-nil, ELT cannot be the return value. - ;; On success, returns the association. + "Find the last association of KEY in LIST before or at ELT. +ELT is found in LIST with equal, not eq. +Returns nil when either KEY or elt are not found in LIST. +When EXCLUSIVE is non-nil, ELT cannot be the return value. +On success, returns the association." (let* ((elt (car (member elt list))) (ex (not exclusive)) ass last-ass) (while (and (setq ass (assoc key list)) (setq list (memq ass list)) @@ -1651,10 +1651,9 @@ When FILE is a buffer object, return that buffer." last-ass)) (defun reftex-sublist-nth (list nth predicate &optional completion) - ;; Make a list of the NTH elements of all members of LIST which - ;; fulfill PREDICATE. - ;; When COMPLETION is non-nil, make all elements of the resulting - ;; list also a list, so that the result can be used for completion. + "Make a list of the NTH elements of all members of LIST which fulfill PREDICATE. +When COMPLETION is non-nil, make all elements of the resulting +list also a list, so that the result can be used for completion." (let (rtn) (while list (if (funcall predicate (car list)) @@ -1666,20 +1665,20 @@ When FILE is a buffer object, return that buffer." (nreverse rtn))) (defun reftex-make-selection-buffer-name (type &optional index) - ;; Make unique name for a selection buffer. + "Make unique name for a selection buffer." (format " *RefTeX[%s][%d]*" type (or index (get reftex-docstruct-symbol :master-index) 0))) (defun reftex-make-index-buffer-name (tag &optional cnt) - ;; Make unique name for an index buffer. + "Make unique name for an index buffer." (format "*Index[%s][%d]*" tag (or cnt (get reftex-docstruct-symbol :master-index) 0))) (defun reftex-truncate (string ncols &optional ellipses padding) - ;; Truncate STRING to NCOLS characters. - ;; When PADDING is non-nil, and string is shorter than NCOLS, fill with - ;; white space to NCOLS characters. When ELLIPSES is non-nil and the - ;; string needs to be truncated, replace last 3 characters by dots. + "Truncate STRING to NCOLS characters. +When PADDING is non-nil, and string is shorter than NCOLS, fill with +white space to NCOLS characters. When ELLIPSES is non-nil and the +string needs to be truncated, replace last 3 characters by dots." (setq string (if (<= (length string) ncols) string @@ -1691,9 +1690,9 @@ When FILE is a buffer object, return that buffer." string)) (defun reftex-nearest-match (regexp &optional max-length) - ;; Find the nearest match of REGEXP. Set the match data. - ;; If POS is given, calculate distances relative to it. - ;; Return nil if there is no match. + "Find the nearest match of REGEXP. Set the match data. +If POS is given, calculate distances relative to it. +Return nil if there is no match." (let ((pos (point)) (dist (or max-length (length regexp))) match1 match2 match) @@ -1713,8 +1712,8 @@ When FILE is a buffer object, return that buffer." (if match (progn (set-match-data match) t) nil))) (defun reftex-auto-mode-alist () - ;; Return an `auto-mode-alist' with only the .gz (etc) thingies. - ;; Stolen from gnus nnheader. + "Return an `auto-mode-alist' with only the .gz (etc) thingies. +Stolen from gnus nnheader." (let ((alist auto-mode-alist) out) (while alist @@ -1724,8 +1723,8 @@ When FILE is a buffer object, return that buffer." (nreverse out))) (defun reftex-enlarge-to-fit (buf2 &optional keep-current) - ;; Enlarge other window displaying buffer to show whole buffer if possible. - ;; If KEEP-CURRENT in non-nil, current buffer must remain visible. + "Enlarge other window displaying buffer to show whole buffer if possible. +If KEEP-CURRENT in non-nil, current buffer must remain visible." (let* ((win1 (selected-window)) (buf1 (current-buffer)) (win2 (get-buffer-window buf2))) ;; Only on current frame. @@ -1743,9 +1742,9 @@ When FILE is a buffer object, return that buffer." (shrink-window (- (window-height) window-min-height)))))) (defun reftex-select-with-char (prompt help-string &optional delay-time scroll) - ;; Offer to select something with PROMPT and, after DELAY-TIME seconds, - ;; also with HELP-STRING. - ;; When SCROLL is non-nil, use SPC and DEL to scroll help window. + "Offer to select something with PROMPT. +After DELAY-TIME seconds, also with HELP-STRING. When SCROLL is +non-nil, use \\`SPC' and \\`DEL' to scroll help window." (let ((char ?\?)) (save-window-excursion (catch 'exit @@ -1783,7 +1782,7 @@ When FILE is a buffer object, return that buffer." (defun reftex-make-regexp-allow-for-ctrl-m (string) - ;; convert STRING into a regexp, allowing ^M for \n and vice versa + "Convert STRING into a regexp, allowing ^M for \\n and vice versa." (let ((start -2)) (setq string (regexp-quote string)) (while (setq start (string-match "[\n\r]" string (+ 3 start))) @@ -1794,16 +1793,16 @@ When FILE is a buffer object, return that buffer." #'find-buffer-visiting "28.1") (defun reftex-visited-files (list) - ;; Takes a list of filenames and returns the buffers of those already visited + "Takes a list of filenames and returns the buffers of those already visited." (delq nil (mapcar (lambda (x) (if (find-buffer-visiting x) x nil)) list))) (defun reftex-get-file-buffer-force (file &optional mark-to-kill) - ;; Return a buffer visiting file. Make one, if necessary. - ;; If neither such a buffer nor the file exist, return nil. - ;; If MARK-TO-KILL is t and there is no live buffer, visit the file with - ;; initializations according to `reftex-initialize-temporary-buffers', - ;; and mark the buffer to be killed after use. + "Return a buffer visiting file. Make one, if necessary. +If neither such a buffer nor the file exist, return nil. +If MARK-TO-KILL is t and there is no live buffer, visit the file with +initializations according to `reftex-initialize-temporary-buffers', +and mark the buffer to be killed after use." (let ((buf (if (bufferp file) file @@ -1849,7 +1848,7 @@ When FILE is a buffer object, return that buffer." (t nil)))) (defun reftex-kill-temporary-buffers (&optional buffer) - ;; Kill all buffers in the list reftex-kill-temporary-buffers. + "Kill all buffers in the list reftex-kill-temporary-buffers." (cond (buffer (when (member buffer reftex-buffers-to-kill) @@ -1868,8 +1867,8 @@ When FILE is a buffer object, return that buffer." (pop reftex-buffers-to-kill))))) (defun reftex-splice-symbols-into-list (list alist) - ;; Splice the association in ALIST of any symbols in LIST into the list. - ;; Return new list. + "Splice the association in ALIST of any symbols in LIST into the list. +Return new list." (let (rtn tmp) (while list (while (and (not (null (car list))) ;; keep list elements nil @@ -1885,8 +1884,8 @@ When FILE is a buffer object, return that buffer." (nreverse rtn))) (defun reftex-uniquify (list &optional sort) - ;; Return a list of all strings in LIST, but each only once, keeping order - ;; unless SORT is set (faster!). + "Return a list of all strings in LIST, but each only once. +Keep order unless SORT is set (faster!)." (setq list (copy-sequence list)) (if sort (progn @@ -1917,9 +1916,9 @@ When FILE is a buffer object, return that buffer." (delq nil list))) (defun reftex-uniquify-by-car (alist &optional keep-list sort) - ;; Return a list of all elements in ALIST, but each car only once. - ;; Elements of KEEP-LIST are not removed even if duplicate. - ;; The order is kept unless SORT is set (faster!). + "Return a list of all elements in ALIST, but each car only once. +Elements of KEEP-LIST are not removed even if duplicate. +The order is kept unless SORT is set (faster!)." (setq keep-list (sort (copy-sequence keep-list) #'string<) alist (copy-sequence alist)) (if sort @@ -2055,7 +2054,7 @@ IGNORE-WORDS List of words which should be removed from the string." string)) (defun reftex-nicify-text (text) - ;; Make TEXT nice for inclusion as context into label menu. + "Make TEXT nice for inclusion as context into label menu." ;; 1. remove line breaks and extra white space (while (string-match "[\n\r\t]\\|[ \t][ \t]+" text) (setq text (replace-match " " nil t text))) @@ -2080,7 +2079,7 @@ IGNORE-WORDS List of words which should be removed from the string." ;;; Fontification and Highlighting (defun reftex-refontify () - ;; Return t if we need to refontify context + "Return t if we need to refontify context." (and reftex-use-fonts (or (eq t reftex-refontify-context) (and (eq 1 reftex-refontify-context) @@ -2088,8 +2087,9 @@ IGNORE-WORDS List of words which should be removed from the string." (and (featurep 'x-symbol-tex) (not (boundp 'x-symbol-mode))))))) (defun reftex-fontify-select-label-buffer (parent-buffer) - ;; Fontify the `*RefTeX Select*' buffer. Buffer is temporarily renamed to - ;; start with none-SPC char, because Font-Lock otherwise refuses operation. + "Fontify the `*RefTeX Select*' buffer. +Buffer is temporarily renamed to start with none-SPC char, because +Font-Lock otherwise refuses operation." (run-hook-with-args 'reftex-pre-refontification-functions parent-buffer 'reftex-ref) (let* ((oldname (buffer-name)) @@ -2107,7 +2107,7 @@ IGNORE-WORDS List of words which should be removed from the string." (rename-buffer oldname)))) (defun reftex-select-font-lock-fontify-region (beg end &optional _loudly) - ;; Fontify a region, but only lines starting with a dot. + "Fontify a region, but only lines starting with a dot." (let ((func (if (fboundp 'font-lock-default-fontify-region) 'font-lock-default-fontify-region 'font-lock-fontify-region)) @@ -2121,10 +2121,10 @@ IGNORE-WORDS List of words which should be removed from the string." (defun reftex-select-font-lock-unfontify (&rest _ignore) t) (defun reftex-verified-face (&rest faces) - ;; Return the first valid face in FACES, or nil if none is valid. - ;; Also, when finding a nil element in FACES, return nil. This - ;; function is just a safety net to catch name changes of builtin - ;; fonts. Currently it is only used for reftex-label-face. + "Return the first valid face in FACES, or nil if none is valid. +Also, when finding a nil element in FACES, return nil. This +function is just a safety net to catch name changes of builtin +fonts. Currently it is only used for reftex-label-face." (let (face) (catch 'exit (while (setq face (pop faces)) @@ -2159,7 +2159,7 @@ IGNORE-WORDS List of words which should be removed from the string." (delete-overlay (aref reftex-highlight-overlays index))) (defun reftex-highlight-shall-die () - ;; Function used in pre-command-hook to remove highlights. + "Function used in pre-command-hook to remove highlights." (remove-hook 'pre-command-hook #'reftex-highlight-shall-die) (reftex-unhighlight 0)) diff --git a/lisp/transient.el b/lisp/transient.el index 8332377c933..e0c834564c6 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -5,7 +5,7 @@ ;; Author: Jonas Bernoulli ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Version: 0.8.6 +;; Version: 0.9.1 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -32,7 +32,7 @@ ;;; Code: -(defconst transient-version "v0.8.6-7-g64cb8404-builtin") +(defconst transient-version "v0.9.1-7-gd7d2c1c2-builtin") (require 'cl-lib) (require 'eieio) @@ -54,6 +54,8 @@ (make-obsolete-variable 'transient-hide-during-minibuffer-read 'transient-show-during-minibuffer-read "0.8.0") +(defvar transient-common-command-prefix) + (defmacro transient--with-emergency-exit (id &rest body) (declare (indent defun)) (unless (keywordp id) @@ -70,42 +72,42 @@ (transient--emergency-exit :debugger) (apply #'debug args)) -;;; Options +;;;; Options (defgroup transient nil "Transient commands." :group 'extensions) (defcustom transient-show-popup t - "Whether to show the current transient in a popup buffer. + "Whether and when to show transient's menu in a buffer. \\ -- If t, then show the popup as soon as a transient prefix command +- If t, then show the buffer as soon as a transient prefix command is invoked. -- If nil, then do not show the popup unless the user explicitly +- If nil, then do not show the buffer unless the user explicitly requests it, by pressing \\[transient-show] or a prefix key. -- If a number, then delay displaying the popup and instead show +- If a number, then delay displaying the buffer and instead show a brief one-line summary. If zero or negative, then suppress even showing that summary and display the pressed key only. - Show the popup when the user explicitly requests it by pressing - \\[transient-show] or a prefix key. Unless zero, then also show the popup + Show the buffer once the user explicitly requests it by pressing + \\[transient-show] or a prefix key. Unless zero, then also show the buffer after that many seconds of inactivity (using the absolute value)." :package-version '(transient . "0.1.0") :group 'transient - :type '(choice (const :tag "instantly" t) - (const :tag "on demand" nil) - (const :tag "on demand (no summary)" 0) - (number :tag "after delay" 1))) + :type '(choice (const :tag "Instantly" t) + (const :tag "On demand" nil) + (const :tag "On demand (no summary)" 0) + (number :tag "After delay" 1))) (defcustom transient-enable-popup-navigation 'verbose - "Whether navigation commands are enabled in the transient popup. + "Whether navigation commands are enabled in the menu buffer. If the value is `verbose', additionally show brief documentation about the command under point in the echo area. -While a transient is active the transient popup buffer is not the +While a transient is active transient's menu buffer is not the current buffer, making it necessary to use dedicated commands to act on that buffer itself. If this is non-nil, then the following bindings are available: @@ -118,7 +120,7 @@ bindings are available: - \\`' and \\`' invoke the clicked on suffix. \\\ - \\[transient-isearch-backward]\ - and \\[transient-isearch-forward] start isearch in the popup buffer. + and \\[transient-isearch-forward] start isearch in the menu buffer. \\`' and \\`' are bound in `transient-push-button'. All other bindings are in `transient-popup-navigation-map'. @@ -129,18 +131,18 @@ then it is likely, that you would want \\`RET' to do what it would do if no transient were active." :package-version '(transient . "0.7.8") :group 'transient - :type '(choice (const :tag "enable navigation and echo summary" verbose) - (const :tag "enable navigation commands" t) - (const :tag "disable navigation commands" nil))) + :type '(choice (const :tag "Enable navigation and echo summary" verbose) + (const :tag "Enable navigation commands" t) + (const :tag "Disable navigation commands" nil))) (defcustom transient-display-buffer-action '(display-buffer-in-side-window (side . bottom) (dedicated . t) (inhibit-same-window . t)) - "The action used to display the transient popup buffer. + "The action used to display transient's menu buffer. -The transient popup buffer is displayed in a window using +The transient menu buffer is displayed in a window using (display-buffer BUFFER transient-display-buffer-action) @@ -200,7 +202,7 @@ is in characters." :type 'natnum) (defcustom transient-mode-line-format 'line - "The mode-line format for the transient popup buffer. + "The mode-line format for transient's menu buffer. If nil, then the buffer has no mode-line. If the buffer is not displayed right above the echo area, then this probably is not @@ -222,20 +224,25 @@ Otherwise this can be any mode-line format. See `mode-line-format' for details." :package-version '(transient . "0.2.0") :group 'transient - :type '(choice (const :tag "hide mode-line" nil) - (const :tag "substitute thin line" line) - (number :tag "substitute line with thickness") - (const :tag "name of prefix command" + :type '(choice (const :tag "Hide mode-line" nil) + (const :tag "Substitute thin line" line) + (number :tag "Substitute line with thickness") + (const :tag "Name of prefix command" ("%e" mode-line-front-space mode-line-buffer-identification)) - (sexp :tag "custom mode-line format"))) + (sexp :tag "Custom mode-line format"))) (defcustom transient-show-common-commands nil - "Whether to show common transient suffixes in the popup buffer. + "Whether to permanently show common suffix commands in transient menus. -These commands are always shown after typing the prefix key -\\`C-x' when a transient command is active. To toggle the value -of this variable use \\`C-x t' when a transient is active." +By default these commands are only temporarily shown after typing their +shared prefix key \ +\\\\[transient-common-command-prefix], \ +while a transient menu is active. When the value +of this option is non-nil, then these commands are permanently shown. +To toggle the value for the current Emacs session only type \ +\\\\[transient-toggle-common] while +any transient menu is active." :package-version '(transient . "0.1.0") :group 'transient :type 'boolean) @@ -365,7 +372,7 @@ using a layout optimized for Lisp. If non-nil, then the key binding of each suffix is colorized to indicate whether it exits the transient state or not, and the -line that is drawn below the transient popup buffer is used to +line that is drawn below transient's menu buffer is used to indicate the behavior of non-suffix commands." :package-version '(transient . "0.5.0") :group 'transient @@ -381,8 +388,18 @@ used." :group 'transient :type 'boolean) +(defcustom transient-error-on-insert-failure nil + "Whether to signal an error when failing to insert a suffix. + +When `transient-insert-suffix' and `transient-append-suffix' fail +to insert a suffix into an existing prefix, they usually just show +a warning. If this is non-nil, they signal an error instead." + :package-version '(transient . "0.8.8") + :group 'transient + :type 'boolean) + (defcustom transient-align-variable-pitch nil - "Whether to align columns pixel-wise in the popup buffer. + "Whether to align columns pixel-wise in the menu buffer. If this is non-nil, then columns are aligned pixel-wise to support variable-pitch fonts. Keys are not aligned, so you @@ -399,11 +416,11 @@ See also `transient-force-fixed-pitch'." :type 'boolean) (defcustom transient-force-fixed-pitch nil - "Whether to force use of monospaced font in the popup buffer. + "Whether to force use of monospaced font in the menu buffer. Even if you use a proportional font for the `default' face, you might still want to use a monospaced font in transient's -popup buffer. Setting this option to t causes `default' to +menu buffer. Setting this option to t causes `default' to be remapped to `fixed-pitch' in that buffer. See also `transient-align-variable-pitch'." @@ -433,7 +450,7 @@ Integers between 1 and 7 (inclusive) are valid levels. The levels of individual transients and/or their individual suffixes can be changed individually, by invoking the prefix and -then pressing \\`C-x l'. +then pressing \\\\[transient-set-level]. The default level for both transients and their suffixes is 4. This option only controls the default for transients. The default @@ -490,7 +507,7 @@ give you as many additional suffixes as you hoped.)" :group 'transient :type 'boolean) -;;; Faces +;;;; Faces (defgroup transient-faces nil "Faces used by Transient." @@ -638,7 +655,7 @@ See also option `transient-highlight-mismatched-keys'." See also option `transient-highlight-mismatched-keys'." :group 'transient-faces) -;;; Persistence +;;;; Persistence (defun transient--read-file-contents (file) (with-demoted-errors "Transient error: %S" @@ -701,7 +718,7 @@ If `transient-save-history' is nil, then do nothing." (unless noninteractive (add-hook 'kill-emacs-hook #'transient-maybe-save-history)) -;;; Classes +;;;; Classes ;;;; Prefix (defclass transient-prefix () @@ -948,7 +965,7 @@ commands or strings. This group inserts an empty line between subgroups. The subgroups are responsible for displaying their elements themselves.") -;;; Define +;;;; Define (defmacro transient-define-prefix (name arglist &rest args) "Define NAME as a transient prefix command. @@ -963,7 +980,7 @@ argument supported by the constructor of that class. The explicitly. GROUPs add key bindings for infix and suffix commands and specify -how these bindings are presented in the popup buffer. At least +how these bindings are presented in the menu buffer. At least one GROUP has to be specified. See info node `(transient)Binding Suffix and Infix Commands'. @@ -998,7 +1015,7 @@ to the setup function: (indent defun) (doc-string 3)) (pcase-let - ((`(,class ,slots ,suffixes ,docstr ,body ,interactive-only) + ((`(,class ,slots ,groups ,docstr ,body ,interactive-only) (transient--expand-define-args args arglist 'transient-define-prefix))) `(progn (defalias ',name @@ -1011,9 +1028,22 @@ to the setup function: (put ',name 'function-documentation ,docstr) (put ',name 'transient--prefix (,(or class 'transient-prefix) :command ',name ,@slots)) - (put ',name 'transient--layout - (list ,@(mapcan (lambda (s) (transient--parse-child name s)) - suffixes)))))) + (transient--set-layout + ',name + (list ,@(mapcan (lambda (s) (transient--parse-child name s)) groups)))))) + +(defmacro transient-define-group (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)) + `(transient--set-layout + ',name + (list ,@(mapcan (lambda (s) (transient--parse-child name s)) groups)))) (defmacro transient-define-suffix (name arglist &rest args) "Define NAME as a transient suffix command. @@ -1160,6 +1190,8 @@ commands are aliases for." ;; ARGLIST and FORM are only optional for backward compatibility. ;; This is necessary because "emoji.el" from Emacs 29 calls this ;; function directly, with just one argument. + (declare (advertised-calling-convention + (args arglist form &optional nobody) "0.7.1")) (unless (listp arglist) (error "Mandatory ARGLIST is missing")) (let (class keys suffixes docstr declare (interactive-only t)) @@ -1172,10 +1204,19 @@ commands are aliases for." (setq class v) (push k keys) (push v keys)))) - (while (let ((arg (car args))) - (or (vectorp arg) - (and arg (symbolp arg)))) - (push (pop args) suffixes)) + (while-let + ((arg (car args)) + (arg (cond + ;; Inline group definition. + ((vectorp arg) + (pop args)) + ;; Quoted include, as one would expect. + ((eq (car-safe arg) 'quote) + (cadr (pop args))) + ;; Unquoted include, for compatibility. + ((and arg (symbolp arg)) + (pop args))))) + (push arg suffixes)) (when (eq (car-safe (car args)) 'declare) (setq declare (car args)) (setq args (cdr args)) @@ -1202,34 +1243,19 @@ commands are aliases for." (defun transient--parse-child (prefix spec) (cl-typecase spec (null (error "Invalid transient--parse-child spec: %s" spec)) - (symbol (let ((value (symbol-value spec))) - (if (and (listp value) - (or (listp (car value)) - (vectorp (car value)))) - (mapcan (lambda (s) (transient--parse-child prefix s)) value) - (transient--parse-child prefix value)))) + (symbol (list `',spec)) (vector (and-let* ((c (transient--parse-group prefix spec))) (list c))) (list (and-let* ((c (transient--parse-suffix prefix spec))) (list c))) (string (list spec)) (t (error "Invalid transient--parse-child spec: %s" spec)))) (defun transient--parse-group (prefix spec) - (let ((spec (append spec nil)) - level class args) + (let (class args) + (setq spec (append spec nil)) (when (integerp (car spec)) - (setq level (pop spec))) + (setq args (plist-put args :level (pop spec)))) (when (stringp (car spec)) (setq args (plist-put args :description (pop spec)))) - ;; Merge value of [... GROUP-VARIABLE], if any. - (let ((spec* spec)) - (while (keywordp (car spec*)) - (setq spec* (cddr spec*))) - (when (and (length= spec* 1) (symbolp (car spec*))) - (let ((rest (append (symbol-value (car spec*)) nil)) - (args nil)) - (while (keywordp (car rest)) - (setq args (nconc (list (pop rest) (pop rest)) args))) - (setq spec (nconc args (butlast spec) rest))))) (while (keywordp (car spec)) (let* ((key (pop spec)) (val (if spec (pop spec) (error "No value for `%s'" key)))) @@ -1244,7 +1270,6 @@ commands are aliases for." (message "WARNING: %s: When %s is used, %s must also be specified" 'transient-define-prefix :setup-children :class)) (list 'vector - level (list 'quote (cond (class) ((cl-typep (car spec) @@ -1256,12 +1281,12 @@ commands are aliases for." (mapcan (lambda (s) (transient--parse-child prefix s)) spec))))) (defun transient--parse-suffix (prefix spec) - (let (level class args) + (let (class args) (cl-flet ((use (prop value) (setq args (plist-put args prop value)))) (pcase (car spec) ((cl-type integer) - (setq level (pop spec)))) + (use :level (pop spec)))) (pcase (car spec) ((cl-type (or string vector)) (use :key (pop spec)))) @@ -1274,9 +1299,10 @@ commands are aliases for." (guard (commandp (cadr spec)))) (use :description (macroexp-quote (pop spec))))) (pcase (car spec) - ((or :info :info*)) + ((or :info :info* :cons)) ((and (cl-type keyword) invalid) - (error "Need command, argument, `:info' or `:info*'; got `%s'" invalid)) + (error "Need command, argument, `:info', `:info*' or `:cons'; got `%s'" + invalid)) ((cl-type symbol) (use :command (macroexp-quote (pop spec)))) ;; During macro-expansion this is expected to be a `lambda' @@ -1327,11 +1353,19 @@ commands are aliases for." (val (if spec (pop spec) (error "No value for `%s'" key)))) (pcase key (:class (setq class val)) - (:level (setq level val)) (:info (setq class 'transient-information) (use :description val)) (:info* (setq class 'transient-information*) (use :description val)) + (:cons + (setq class 'transient-cons-option) + (use :command + (let ((sym (intern (format "transient:%s:%s" prefix val)))) + `(prog1 ',sym + (put ',sym 'interactive-only t) + (put ',sym 'completion-predicate #'transient--suffix-only) + (defalias ',sym #'transient--default-infix-command)))) + (use :argument val)) ((guard (eq (car-safe val) '\,)) (use key (cadr val))) ((guard (or (symbolp val) @@ -1341,11 +1375,13 @@ commands are aliases for." (_ (use key val))))) (when spec (error "Need keyword, got %S" (car spec))) - (when-let* (((not (plist-get args :key))) - (shortarg (plist-get args :shortarg))) - (use :key shortarg))) - (list 'list - level + (if-let* ((key (plist-get args :key))) + (when (string-match "\\`\\({p}\\)" key) + (use :key + (replace-match transient-common-command-prefix t t key 1))) + (when-let* ((shortarg (plist-get args :shortarg))) + (use :key shortarg)))) + (list 'cons (macroexp-quote (or class 'transient-suffix)) (cons 'list args)))) @@ -1374,63 +1410,121 @@ symbol property.") (setq read-extended-command-predicate #'transient-command-completion-not-suffix-only-p)) +(defun transient--set-layout (prefix layout) + (put prefix 'transient--layout (vector 2 nil layout))) + +(defun transient--get-layout (prefix) + (if-let* + ((layout + (or (get prefix 'transient--layout) + ;; Migrate unparsed legacy group definition. + (condition-case-unless-debug err + (and-let* ((value (symbol-value prefix))) + (transient--set-layout + prefix + (if (and (listp value) + (or (listp (car value)) + (vectorp (car value)))) + (transient-parse-suffixes prefix value) + (list (transient-parse-suffix prefix value))))) + (error + (message "Not a legacy group definition: %s: %S" prefix err) + nil))))) + (if (vectorp layout) + (let ((version (aref layout 0))) + (if (= version 2) + layout + (error "Unsupported layout version %s for %s" version prefix))) + ;; Upgrade from version 1. + (cl-labels + ((upgrade (spec) + (cond + ((vectorp spec) + (pcase-let ((`[,level ,class ,args ,children] spec)) + (when level + (setq args (plist-put args :level level))) + (vector class args (mapcar #'upgrade children)))) + ((and (listp spec) + (length= spec 3) + (or (null (car spec)) + (natnump (car spec))) + (symbolp (cadr spec))) + (pcase-let ((`(,level ,class ,args) spec)) + (when level + (setq args (plist-put args :level level))) + (cons class args))) + ((listp spec) + (mapcar #'upgrade spec)) + (t spec)))) + (transient--set-layout prefix (upgrade layout)))) + (error "Not a transient prefix command or group definition: %s" prefix))) + +(defun transient--get-children (prefix) + (aref (transient--get-layout prefix) 2)) + (defun transient-parse-suffix (prefix suffix) "Parse SUFFIX, to be added to PREFIX. -PREFIX is a prefix command, a symbol. +PREFIX is a prefix command symbol or object. SUFFIX is a suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). Intended for use in a group's `:setup-children' function." - (cl-assert (and prefix (symbolp prefix))) + (when (cl-typep prefix 'transient-prefix) + (setq prefix (oref prefix command))) (eval (car (transient--parse-child prefix suffix)) t)) (defun transient-parse-suffixes (prefix suffixes) "Parse SUFFIXES, to be added to PREFIX. -PREFIX is a prefix command, a symbol. +PREFIX is a prefix command symbol or object. SUFFIXES is a list of suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). Intended for use in a group's `:setup-children' function." - (cl-assert (and prefix (symbolp prefix))) + (when (cl-typep prefix 'transient-prefix) + (setq prefix (oref prefix command))) (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes)) -;;; Edit +;;;; Edit (defun transient--insert-suffix (prefix loc suffix action &optional keep-other) - (let* ((suf (cl-etypecase suffix - (vector (transient--parse-group prefix suffix)) - (list (transient--parse-suffix prefix suffix)) - (string suffix))) - (mem (transient--layout-member loc prefix)) - (elt (car mem))) - (setq suf (eval suf t)) + (pcase-let* ((suf (cl-etypecase suffix + (vector (eval (transient--parse-group prefix suffix) t)) + (list (eval (transient--parse-suffix prefix suffix) t)) + (string suffix) + (symbol suffix))) + (`(,elt ,group) (transient--locate-child prefix loc))) (cond - ((not mem) - (message "Cannot insert %S into %s; %s not found" + ((not elt) + (funcall (if transient-error-on-insert-failure #'error #'message) + "Cannot insert %S into %s; %s not found" suffix prefix loc)) ((or (and (vectorp suffix) (not (vectorp elt))) (and (listp suffix) (vectorp elt)) (and (stringp suffix) (vectorp elt))) - (message "Cannot place %S into %s at %s; %s" + (funcall (if transient-error-on-insert-failure #'error #'message) + "Cannot place %S into %s at %s; %s" suffix prefix loc "suffixes and groups cannot be siblings")) (t (when-let* (((not (eq keep-other 'always))) (bindingp (listp suf)) - (key (transient--spec-key suf)) - (conflict (car (transient--layout-member key prefix))) + (key (transient--suffix-key suf)) + (conflict (car (transient--locate-child prefix key))) (conflictp (and (not (and (eq action 'replace) (eq conflict elt))) (or (not keep-other) - (eq (plist-get (nth 2 suf) :command) - (plist-get (nth 2 conflict) :command))) + (eq (plist-get (transient--suffix-props suf) + :command) + (plist-get (transient--suffix-props conflict) + :command))) (equal (transient--suffix-predicate suf) (transient--suffix-predicate conflict))))) (transient-remove-suffix prefix key)) - (pcase-exhaustive action - ('insert (setcdr mem (cons elt (cdr mem))) - (setcar mem suf)) - ('append (setcdr mem (cons suf (cdr mem)))) - ('replace (setcar mem suf))))))) + (let ((mem (memq elt (aref group 2)))) + (pcase-exhaustive action + ('insert (setcdr mem (cons elt (cdr mem))) + (setcar mem suf)) + ('append (setcdr mem (cons suf (cdr mem)))) + ('replace (setcar mem suf)))))))) ;;;###autoload (defun transient-insert-suffix (prefix loc suffix &optional keep-other) @@ -1479,6 +1573,22 @@ See info node `(transient)Modifying Existing Transients'." (declare (indent defun)) (transient--insert-suffix prefix loc suffix 'replace)) +;;;###autoload +(defun transient-inline-group (prefix group) + "Inline the included GROUP into PREFIX. +Replace the symbol GROUP with its expanded layout in the +layout of PREFIX." + (declare (indent defun)) + (cl-assert (symbolp group)) + (pcase-let ((`(,suffix ,parent) (transient--locate-child prefix group))) + (when suffix + (let* ((siblings (aref parent 2)) + (pos (cl-position group siblings))) + (aset parent 2 + (nconc (seq-take siblings pos) + (transient--get-children group) + (seq-drop siblings (1+ pos)))))))) + ;;;###autoload (defun transient-remove-suffix (prefix loc) "Remove the suffix or group at LOC in PREFIX. @@ -1488,18 +1598,9 @@ LOC is a command, a key vector, a key description (a string (whose last element may also be a command or key). See info node `(transient)Modifying Existing Transients'." (declare (indent defun)) - (transient--layout-member loc prefix 'remove)) - -(defun transient-get-suffix (prefix loc) - "Return the suffix or group at LOC in PREFIX. -PREFIX is a prefix command, a symbol. -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'." - (if-let* ((mem (transient--layout-member loc prefix))) - (car mem) - (error "%s not found in %s" loc prefix))) + (pcase-let ((`(,suffix ,group) (transient--locate-child prefix loc))) + (when suffix + (aset group 2 (delq suffix (aref group 2)))))) (defun transient-suffix-put (prefix loc prop value) "Edit the suffix at LOC in PREFIX, setting PROP to VALUE. @@ -1510,68 +1611,69 @@ LOC is a command, a key vector, a key description (a string as returned by `key-description'), or a coordination list (whose last element may also be a command or key). See info node `(transient)Modifying Existing Transients'." - (let ((suf (transient-get-suffix prefix loc))) - (setf (elt suf 2) - (plist-put (elt suf 2) prop value)))) + (let ((child (transient-get-suffix prefix loc))) + (if (vectorp child) + (aset child 1 (plist-put (aref child 1) prop value)) + (setcdr child (plist-put (transient--suffix-props child) prop value))))) -(defun transient--layout-member (loc prefix &optional remove) - (let ((val (or (get prefix 'transient--layout) - (error "%s is not a transient command" prefix)))) - (when (listp loc) - (while (integerp (car loc)) - (let* ((children (if (vectorp val) (aref val 3) val)) - (mem (transient--nthcdr (pop loc) children))) - (if (and remove (not loc)) - (let ((rest (delq (car mem) children))) - (if (vectorp val) - (aset val 3 rest) - (put prefix 'transient--layout rest)) - (setq val nil)) - (setq val (if loc (car mem) mem))))) - (setq loc (car loc))) - (if loc - (transient--layout-member-1 (transient--kbd loc) val remove) - val))) +(defalias 'transient--suffix-props #'cdr) -(defun transient--layout-member-1 (loc layout remove) - (cond ((listp layout) - (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove)) - layout)) - ((vectorp (car (aref layout 3))) - (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove)) - (aref layout 3))) - (remove - (aset layout 3 - (delq (car (transient--group-member loc layout)) - (aref layout 3))) - nil) - ((transient--group-member loc layout)))) +(defun transient-get-suffix (prefix loc) + "Return the suffix or group at LOC in PREFIX. +PREFIX is a prefix command, a symbol. +LOC is a command, a key vector, a key description (a string + as returned by `key-description'), or a coordination list + (whose last element may also be a command or key). +See info node `(transient)Modifying Existing Transients'." + (or (car (transient--locate-child prefix loc)) + (error "%s not found in %s" loc prefix))) -(defun transient--group-member (loc group) - (cl-member-if (lambda (suffix) - (and (listp suffix) - (let* ((def (nth 2 suffix)) - (cmd (plist-get def :command))) - (if (symbolp loc) - (eq cmd loc) - (equal (transient--kbd - (or (plist-get def :key) - (transient--command-key cmd))) - loc))))) - (aref group 3))) +(defun transient--locate-child (group loc) + (when (symbolp group) + (setq group (transient--get-layout group))) + (when (vectorp loc) + (setq loc (append loc nil))) + (if (listp loc) + (and-let* ((match (transient--nth (pop loc) (aref group 2)))) + (if loc + (transient--locate-child + match (cond ((or (stringp (car loc)) + (symbolp (car loc))) + (car loc)) + ((symbolp match) + (vconcat (cons 0 loc))) + ((vconcat loc)))) + (list match group))) + (seq-some (lambda (child) + (transient--match-child group loc child)) + (aref group 2)))) -(defun transient--kbd (keys) - (when (vectorp keys) - (setq keys (key-description keys))) - (when (stringp keys) - (setq keys (kbd keys))) - keys) +(defun transient--match-child (group loc child) + (cl-etypecase child + (string nil) + (symbol (if (symbolp loc) + (and (eq child loc) + (list child group)) + (and-let* ((include (transient--get-layout child))) + (transient--locate-child include loc)))) + (vector (seq-some (lambda (subgroup) + (transient--locate-child subgroup loc)) + (aref group 2))) + (list (and (if (symbolp loc) + (eq (plist-get (transient--suffix-props child) :command) + loc) + (equal (kbd (transient--suffix-key child)) + (kbd loc))) + (list child group))))) -(defun transient--spec-key (spec) - (let ((plist (nth 2 spec))) - (or (plist-get plist :key) +(defun transient--nth (n list) + (nth (if (< n 0) (- (length list) (abs n)) n) list)) + +(defun transient--suffix-key (spec) + (let ((props (transient--suffix-props spec))) + (or (plist-get props :key) (transient--command-key - (plist-get plist :command))))) + (plist-get props :command))))) (defun transient--command-key (cmd) (and-let* ((obj (transient--suffix-prototype cmd))) @@ -1582,9 +1684,6 @@ See info node `(transient)Modifying Existing Transients'." (oref obj shortarg) (transient--derive-shortarg (oref obj argument))))))) -(defun transient--nthcdr (n list) - (nthcdr (if (< n 0) (- (length list) (abs n)) n) list)) - (defun transient-set-default-level (command level) "Set the default level of suffix COMMAND to LEVEL. @@ -1600,7 +1699,7 @@ using `transient-define-suffix', `transient-define-infix' or (user-error "Cannot set level for `%s'; no prototype object exists" command))) -;;; Variables +;;;; Variables (defvar transient-current-prefix nil "The transient from which this suffix command was invoked. @@ -1620,7 +1719,14 @@ values. In complex cases it might be necessary to use this variable instead.") (defvar transient-exit-hook nil - "Hook run after exiting a transient.") + "Hook run after exiting a transient menu. +Unlike `transient-post-exit-hook', this runs even if another transient +menu becomes active at the same time. ") + +(defvar transient-post-exit-hook nil + "Hook run after exiting all transient menus. +Unlike `transient-exit-hook', this does not run if another transient +menu becomes active at the same time.") (defvar transient-setup-buffer-hook nil "Hook run when setting up the transient buffer. @@ -1634,7 +1740,7 @@ That buffer is current and empty when this hook runs.") (defconst transient--exit nil "Do exit the transient.") (defvar transient--exitp nil "Whether to exit the transient.") -(defvar transient--showp nil "Whether to show the transient popup buffer.") +(defvar transient--showp nil "Whether to show the transient menu buffer.") (defvar transient--helpp nil "Whether help-mode is active.") (defvar transient--docsp nil "Whether docstring-mode is active.") (defvar transient--editp nil "Whether edit-mode is active.") @@ -1658,7 +1764,7 @@ That buffer is current and empty when this hook runs.") "The transient menu buffer.") (defvar transient--window nil - "The window used to display the transient popup buffer.") + "The window used to display transient's menu buffer.") (defvar transient--original-window nil "The window that was selected before the transient was invoked. @@ -1700,7 +1806,7 @@ This is bound while the suffixes are drawn in the transient buffer.") mwheel-scroll scroll-bar-toolkit-scroll)) -;;; Identities +;;;; Identities (defun transient-active-prefix (&optional prefixes) "Return the active transient object. @@ -1812,9 +1918,8 @@ probably use this instead: ((length= suffixes 1) (car suffixes)) ((cl-find-if (lambda (obj) - (equal - (listify-key-sequence (transient--kbd (oref obj key))) - (listify-key-sequence (this-command-keys)))) + (equal (listify-key-sequence (kbd (oref obj key))) + (listify-key-sequence (this-command-keys)))) suffixes)) ;; COMMAND is only provided if `this-command' is meaningless, in ;; which case `this-command-keys' is also meaningless, making it @@ -1823,7 +1928,7 @@ probably use this instead: ;; If COMMAND is nil, then failure to disambiguate likely means ;; that there is a bug somewhere. ((length> suffixes 1) - (error "BUG: Cannot unambigiously determine suffix object")) + (error "BUG: Cannot unambiguously determine suffix object")) ;; It is legimate to use this function as a predicate of sorts. ;; `transient--pre-command' and `transient-help' are examples. (t nil)))) @@ -1839,7 +1944,7 @@ probably use this instead: (seq-some (lambda (cmd) (get cmd 'transient--suffix)) (function-alias-p command)))) -;;; Keymaps +;;;; Keymaps (defvar-keymap transient-base-map :doc "Parent of other keymaps used by Transient. @@ -1873,7 +1978,7 @@ to `transient-predicate-map'." (keymap-set map "C-t" #'transient-show) (keymap-set map "?" #'transient-help) (keymap-set map "C-h" #'transient-help) - ;; Also bound to "C-x p" and "C-x n" in transient-common-commands. + ;; Next two have additional bindings in transient-common-commands. (keymap-set map "C-M-p" #'transient-history-prev) (keymap-set map "C-M-n" #'transient-history-next) (when (fboundp 'other-frame-prefix) ;Emacs >= 28.1 @@ -1888,53 +1993,84 @@ to `transient-predicate-map'. See also `transient-base-map'.") (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) + "?" #'transient-help + "C-h" #'transient-help) (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)) +(defvar transient-common-commands + [:hide (lambda () + (defvar transient--redisplay-key) + (and (not (equal (vconcat transient--redisplay-key) + (read-kbd-macro transient-common-command-prefix))) + (not transient-show-common-commands))) + ["Value commands" + ("{p} s " "Set" transient-set) + ("{p} C-s" "Save" transient-save) + ("{p} C-k" "Reset" transient-reset) + ("{p} p " "Previous value" transient-history-prev) + ("{p} n " "Next value" transient-history-next)] + ["Sticky commands" + ;; Like `transient-sticky-map' except that + ;; "C-g" has to be bound to a different command. + ("C-g" "Quit prefix or transient" transient-quit-one) + ("C-q" "Quit transient stack" transient-quit-all) + ("C-z" "Suspend transient stack" transient-suspend)] + ["Customize" + ("{p} t" transient-toggle-common) + ("{p} l" "Show/hide suffixes" transient-set-level) + ("{p} a" transient-toggle-level-limit)]] + "Commands available in all transient menus. -(put 'transient-common-commands - 'transient--layout - (list - (eval - (car (transient--parse-child - 'transient-common-commands - (vector - :hide - (lambda () - (and (not (memq - (car (bound-and-true-p transient--redisplay-key)) - transient--common-command-prefixes)) - (not transient-show-common-commands))) - (vector - "Value commands" - (list "C-x s " "Set" #'transient-set) - (list "C-x C-s" "Save" #'transient-save) - (list "C-x C-k" "Reset" #'transient-reset) - (list "C-x p " "Previous value" #'transient-history-prev) - (list "C-x n " "Next value" #'transient-history-next)) - (vector - "Sticky commands" - ;; Like `transient-sticky-map' except that - ;; "C-g" has to be bound to a different command. - (list "C-g" "Quit prefix or transient" #'transient-quit-one) - (list "C-q" "Quit transient stack" #'transient-quit-all) - (list "C-z" "Suspend transient stack" #'transient-suspend)) - (vector - "Customize" - (list "C-x t" #'transient-toggle-common) - (list "C-x l" "Show/hide suffixes" #'transient-set-level) - (list "C-x a" #'transient-toggle-level-limit))))) - t))) +The same functions, that are used to change bindings in transient prefix +commands and transient groups (defined using `transient-define-group'), +should be used to modify these bindings as well. The actual layout is +stored in the symbol's `transient--layout' property. The variable value +is only used when customizing `transient-common-command-prefix', which +resets the value of `transient--layout' based on the values of that +option and this variable.") + +(defun transient--init-common-commands () + (transient--set-layout + 'transient-common-commands + (list (eval (car (transient--parse-child 'transient-common-commands + transient-common-commands)) + t))) + (defvar transient-common-command-prefix) + (defvar transient--docstr-hint-1) + (defvar transient--docstr-hint-2) + (setq transient--docstr-hint-1 + (define-keymap transient-common-command-prefix + 'transient-common-command-prefix)) + (setq transient--docstr-hint-2 + (define-keymap (concat transient-common-command-prefix " t") + 'transient-toggle-common))) + +(defcustom transient-common-command-prefix "C-x" + "The prefix key used for most commands common to all menus. + +Some shared commands are available in all transient menus, most of +which share a common prefix specified by this option. By default the +bindings for these shared commands are only shown after pressing that +prefix key and before following that up with a valid key binding. + +For historic reasons \\`C-x' is used by default, but users are +encouraged to pick another key, preferably one that is not commonly used +in Emacs but is still convenient to them. See info node `(transient) +Common Suffix Commands'." + :type 'key + :initialize (lambda (symbol exp) + (custom-initialize-default symbol exp) + (transient--init-common-commands)) + :set (lambda (symbol value) + (set-default symbol value) + (transient--init-common-commands))) (defvar-keymap transient-popup-navigation-map - :doc "One of the keymaps used when popup navigation is enabled. + :doc "One of the keymaps used when menu navigation is enabled. See `transient-enable-popup-navigation'." "" #'transient-noop "" #'transient-backward-button @@ -1944,7 +2080,7 @@ See `transient-enable-popup-navigation'." "M-RET" #'transient-push-button) (defvar-keymap transient-button-map - :doc "One of the keymaps used when popup navigation is enabled. + :doc "One of the keymaps used when menu navigation is enabled. See `transient-enable-popup-navigation'." "" #'transient-push-button "" #'transient-push-button) @@ -2044,9 +2180,11 @@ of the corresponding object." (defun transient--make-transient-map () (let ((map (make-sparse-keymap))) - (set-keymap-parent map (if transient--editp - transient-edit-map - transient-map)) + (cond (transient--editp + (keymap-set map (concat transient-common-command-prefix " l") + #'transient-set-level) + (set-keymap-parent map transient-edit-map)) + ((set-keymap-parent map transient-map))) (dolist (obj transient--suffixes) (let ((key (oref obj key))) (when (vectorp key) @@ -2168,7 +2306,7 @@ of the corresponding object." transient--transient-map)) topmap)) -;;; Setup +;;;; Setup (defun transient-setup (&optional name layout edit &rest params) "Setup the transient specified by NAME. @@ -2210,6 +2348,7 @@ EDIT may be non-nil." (setq transient--minibuffer-depth (minibuffer-depth)) (transient--redisplay)) (get name 'transient--prefix)) + (transient--suspend-text-conversion-style) (transient--setup-transient) (transient--suspend-which-key-mode))) @@ -2270,10 +2409,9 @@ value. Otherwise return CHILDREN as is.") (defun transient--init-suffixes (name) (let ((levels (alist-get name transient-levels))) (mapcan (lambda (c) (transient--init-child levels c nil)) - (append (get name 'transient--layout) + (append (transient--get-children name) (and (not transient--editp) - (get 'transient-common-commands - 'transient--layout)))))) + (transient--get-children 'transient-common-commands)))))) (defun transient--flatten-suffixes (layout) (cl-labels ((s (def) @@ -2289,13 +2427,16 @@ value. Otherwise return CHILDREN as is.") (defun transient--init-child (levels spec parent) (cl-etypecase spec + (symbol (mapcan (lambda (c) (transient--init-child levels c parent)) + (transient--get-children spec))) (vector (transient--init-group levels spec parent)) (list (transient--init-suffix levels spec parent)) (string (list spec)))) (defun transient--init-group (levels spec parent) - (pcase-let* ((`(,level ,class ,args ,children) (append spec nil)) - (level (or level transient--default-child-level))) + (pcase-let* ((`[,class ,args ,children] spec) + (level (or (plist-get args :level) + transient--default-child-level))) (and-let* (((transient--use-level-p level)) (obj (apply class :parent parent :level level args)) ((transient--use-suffix-p obj)) @@ -2309,16 +2450,17 @@ value. Otherwise return CHILDREN as is.") (list obj))))) (defun transient--init-suffix (levels spec parent) - (pcase-let* ((`(,level ,class ,args) spec) + (pcase-let* ((`(,class . ,args) spec) (cmd (plist-get args :command)) - (key (transient--kbd (plist-get args :key))) + (_ (transient--load-command-if-autoload cmd)) + (key (plist-get args :key)) + (key (and key (kbd key))) (proto (and cmd (transient--suffix-prototype cmd))) (level (or (alist-get (cons cmd key) levels nil nil #'equal) (alist-get cmd levels) - level + (plist-get args :level) (and proto (oref proto level)) transient--default-child-level))) - (transient--load-command-if-autoload cmd) (when (transient--use-level-p level) (let ((obj (if (child-of-class-p class 'transient-information) (apply class :parent parent :level level args) @@ -2355,7 +2497,9 @@ value. Otherwise return CHILDREN as is.") (if (transient-switches--eieio-childp obj) (cl-call-next-method obj) (when-let* (((not (slot-boundp obj 'shortarg))) - (shortarg (transient--derive-shortarg (oref obj argument)))) + (argument (oref obj argument)) + ((stringp argument)) + (shortarg (transient--derive-shortarg argument))) (oset obj shortarg shortarg)) (unless (slot-boundp obj 'key) (if (slot-boundp obj 'shortarg) @@ -2423,9 +2567,9 @@ value. Otherwise return CHILDREN as is.") (default))) (defun transient--suffix-predicate (spec) - (let ((plist (nth 2 spec))) + (let ((props (transient--suffix-props spec))) (seq-some (lambda (prop) - (and-let* ((pred (plist-get plist prop))) + (and-let* ((pred (plist-get props prop))) (list prop pred))) '( :if :if-not :if-nil :if-non-nil @@ -2443,7 +2587,7 @@ value. Otherwise return CHILDREN as is.") (transient--debug " autoload %s" cmd) (autoload-do-load fn))) -;;; Flow-Control +;;;; Flow-Control (defun transient--setup-transient () (transient--debug 'setup-transient) @@ -2452,6 +2596,7 @@ value. Otherwise return CHILDREN as is.") (add-hook 'pre-command-hook #'transient--pre-command 99) (add-hook 'post-command-hook #'transient--post-command) (advice-add 'recursive-edit :around #'transient--recursive-edit) + (set-default-toplevel-value 'inhibit-quit t) (when transient--exitp ;; This prefix command was invoked as the suffix of another. ;; Prevent `transient--post-command' from removing the hooks @@ -2727,9 +2872,10 @@ value. Otherwise return CHILDREN as is.") (remove-hook 'pre-command-hook #'transient--pre-command) (remove-hook 'post-command-hook #'transient--post-command) (advice-remove 'recursive-edit #'transient--recursive-edit)) - (let ((resume (and transient--stack + (let ((replace (eq transient--exitp 'replace)) + (resume (and transient--stack (not (memq transient--exitp '(replace suspend)))))) - (unless (or resume (eq transient--exitp 'replace)) + (unless (or resume replace) (setq transient--showp nil)) (setq transient--exitp nil) (setq transient--helpp nil) @@ -2742,8 +2888,11 @@ value. Otherwise return CHILDREN as is.") (setq transient-current-command nil) (setq transient-current-suffixes nil) (setq transient--current-suffix nil)) - (when resume - (transient--stack-pop)))) + (cond (resume (transient--stack-pop)) + ((not replace) + (setq quit-flag nil) + (set-default-toplevel-value 'inhibit-quit nil) + (run-hooks 'transient-post-exit-hook))))) (defun transient--stack-push () (transient--debug 'stack-push) @@ -2822,16 +2971,17 @@ value. Otherwise return CHILDREN as is.") (defun transient--emergency-exit (&optional id) "Exit the current transient command after an error occurred. When no transient is active (i.e., when `transient--prefix' is -nil) then do nothing. Optional ID is a keyword identifying the -exit." +nil) then only reset `inhibit-quit'. Optional ID is a keyword +identifying the exit." (transient--debug 'emergency-exit id) + (set-default-toplevel-value 'inhibit-quit nil) (when transient--prefix (setq transient--stack nil) (setq transient--exitp t) (transient--pre-exit) (transient--post-exit this-command))) -;;; Pre-Commands +;;;; Pre-Commands (defun transient--call-pre-command () (if-let* ((fn (transient--get-pre-command this-command @@ -3014,7 +3164,7 @@ prefix argument and pivot to `transient-update'." (put 'transient--do-move 'transient-face 'transient-key-stay) (put 'transient--do-minus 'transient-face 'transient-key-stay) -;;; Commands +;;;; Commands ;;;; Noop (defun transient-noop () @@ -3057,7 +3207,7 @@ This should never happen. Please open an issue and post the shown command log." :error))) (defun transient-inhibit-move () - "Warn the user that popup navigation is disabled." + "Warn the user that menu navigation is disabled." (interactive) (message "To enable use of `%s', please customize `%s'" this-original-command @@ -3078,12 +3228,12 @@ Please open an issue and post the shown command log." :error))) (interactive)) (defun transient-update () - "Redraw the transient's state in the popup buffer." + "Redraw the transient's state in the menu buffer." (interactive) (setq prefix-arg current-prefix-arg)) (defun transient-show () - "Show the transient's state in the popup buffer." + "Show the transient's state in the menu buffer." (interactive) (setq transient--showp t)) @@ -3327,16 +3477,17 @@ such as when suggesting a new feature or reporting an issue." :description "Echo arguments" :key "x" (interactive (list (transient-args transient-current-command))) - (message "%s: %s" - (key-description (this-command-keys)) - (mapconcat (lambda (arg) - (propertize (if (string-match-p " " arg) - (format "%S" arg) - arg) - 'face 'transient-argument)) - arguments " "))) + (if (seq-every-p #'stringp arguments) + (message "%s: %s" (key-description (this-command-keys)) + (mapconcat (lambda (arg) + (propertize (if (string-match-p " " arg) + (format "%S" arg) + arg) + 'face 'transient-argument)) + arguments " ")) + (message "%s: %S" (key-description (this-command-keys)) arguments))) -;;; Value +;;;; Value ;;;; Init (cl-defgeneric transient-init-value (obj) @@ -3623,15 +3774,14 @@ prompt." prompt))) (if (stringp prompt) prompt - "(BUG: no prompt): ")) - (or (and-let* ((arg (and (slot-boundp obj 'argument) (oref obj argument)))) - (if (and (stringp arg) (string-suffix-p "=" arg)) - arg - (concat arg ": "))) - (and-let* ((var (and (slot-boundp obj 'variable) (oref obj variable)))) - (and (stringp var) - (concat var ": "))) - "(BUG: no prompt): "))) + "[BUG: invalid prompt]: ")) + (if-let* ((name (or (and (slot-boundp obj 'argument) (oref obj argument)) + (and (slot-boundp obj 'variable) (oref obj variable))))) + (if (and (stringp name) + (string-suffix-p "=" name)) + name + (format "%s: " name)) + "[BUG: no prompt]: "))) ;;;; Set @@ -3850,7 +4000,7 @@ Append \"=\ to ARG to indicate that it is an option." (or (match-string 1 match) ""))) (and (member arg args) t))) -;;; Return +;;;; Return (defun transient-init-return (obj) (when-let* ((transient--stack) @@ -3862,7 +4012,7 @@ Append \"=\ to ARG to indicate that it is an option." (list t 'recurse #'transient--do-recurse)))) (oset obj return t))) -;;; Scope +;;;; Scope ;;;; Init (cl-defgeneric transient-init-scope (obj) @@ -3934,7 +4084,7 @@ If no prefix matches, return nil." (and-let* ((obj (transient-prefix-object))) (oref obj scope)))) -;;; History +;;;; History (cl-defgeneric transient--history-key (obj) "Return OBJ's history key.") @@ -3966,7 +4116,7 @@ have a history of their own.") (cons val (delete val (alist-get (transient--history-key obj) transient-history)))))) -;;; Display +;;;; Display (defun transient--show-hint () (let ((message-log-max nil)) @@ -4040,7 +4190,7 @@ have a history of their own.") (window-body-width window t) (window-body-height window t)))) -;;; Delete +;;;; Delete (defun transient--delete-window () (when (window-live-p transient--window) @@ -4074,7 +4224,7 @@ have a history of their own.") (setq show (natnump show))) show)) -;;; Format +;;;; Format (defun transient--format-hint () (if (and transient-show-popup (<= transient-show-popup 0)) @@ -4441,7 +4591,7 @@ apply the face `transient-unreachable' to the complete string." 'transient-inactive-argument))) (cl-defmethod transient-format-value ((obj transient-option)) - (let ((argument (oref obj argument))) + (let ((argument (prin1-to-string (oref obj argument) t))) (if-let* ((value (oref obj value))) (pcase-exhaustive (oref obj multi-value) ('nil @@ -4578,7 +4728,7 @@ a prefix command, while porting a regular keymap to a transient." (propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face) (propertize (symbol-name command) 'face 'font-lock-function-name-face)))) -;;; Help +;;;; Help (cl-defgeneric transient-show-help (obj) "Show documentation for the command represented by OBJ.") @@ -4744,7 +4894,8 @@ Type %s and then %s to describe the respective suffix command.\n" (propertize "" 'face 'transient-key) (propertize "" 'face 'transient-key) (propertize " N " 'face 'transient-enabled-suffix) - (propertize "C-x l" 'face 'transient-key) + (propertize (concat transient-common-command-prefix " l") + 'face 'transient-key) (propertize "" 'face 'transient-key) (propertize " N " 'face 'transient-enabled-suffix) (propertize "C-h" 'face 'transient-key) @@ -4795,10 +4946,10 @@ This is used when a tooltip is needed.") (let ((message-log-max nil)) (message "%s" doc)))))) -;;; Popup Navigation +;;; Menu Navigation (defun transient-scroll-up (&optional arg) - "Scroll text of transient popup window upward ARG lines. + "Scroll text of transient's menu window upward ARG lines. If ARG is nil scroll near full screen. This is a wrapper around `scroll-up-command' (which see)." (interactive "^P") @@ -4806,7 +4957,7 @@ around `scroll-up-command' (which see)." (scroll-up-command arg))) (defun transient-scroll-down (&optional arg) - "Scroll text of transient popup window down ARG lines. + "Scroll text of transient's menu window down ARG lines. If ARG is nil scroll near full screen. This is a wrapper around `scroll-down-command' (which see)." (interactive "^P") @@ -4814,7 +4965,7 @@ around `scroll-down-command' (which see)." (scroll-down-command arg))) (defun transient-backward-button (n) - "Move to the previous button in the transient popup buffer. + "Move to the previous button in transient's menu buffer. See `backward-button' for information about N." (interactive "p") (with-selected-window transient--window @@ -4823,7 +4974,7 @@ See `backward-button' for information about N." (transient-show-summary (get-text-property (point) 'suffix))))) (defun transient-forward-button (n) - "Move to the next button in the transient popup buffer. + "Move to the next button in transient's menu buffer. See `forward-button' for information about N." (interactive "p") (with-selected-window transient--window @@ -4863,7 +5014,7 @@ See `forward-button' for information about N." beg 'face nil (line-end-position)))))) ;;; Compatibility -;;;; Popup Isearch +;;;; Menu Isearch (defvar-keymap transient--isearch-mode-map :parent isearch-mode-map @@ -4941,6 +5092,16 @@ search instead." 2) lisp-imenu-generic-expression :test #'equal) +(defun transient--suspend-text-conversion-style () + (static-if (boundp 'overriding-text-conversion-style) ; since Emacs 30.1 + (when text-conversion-style + (letrec ((suspended overriding-text-conversion-style) + (fn (lambda () + (setq overriding-text-conversion-style nil) + (remove-hook 'transient-exit-hook fn)))) + (setq overriding-text-conversion-style suspended) + (add-hook 'transient-exit-hook fn))))) + (declare-function which-key-mode "ext:which-key" (&optional arg)) (defun transient--suspend-which-key-mode () @@ -5008,12 +5169,13 @@ as stand-in for elements of exhausted lists." (setq lists (mapcar #'cdr lists))) (nreverse result))) -;;; Font-Lock +;;;; Font-Lock (defconst transient-font-lock-keywords (eval-when-compile `((,(concat "(" (regexp-opt (list "transient-define-prefix" + "transient-define-group" "transient-define-infix" "transient-define-argument" "transient-define-suffix") @@ -5025,7 +5187,7 @@ as stand-in for elements of exhausted lists." (font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords) -;;; Auxiliary Classes +;;;; Auxiliary Classes ;;;; `transient-lisp-variable' (defclass transient-lisp-variable (transient-variable) @@ -5059,10 +5221,33 @@ as stand-in for elements of exhausted lists." (defun transient-lisp-variable--reader (prompt initial-input _history) (read--expression prompt initial-input)) +;;;; `transient-cons-option' + +(defclass transient-cons-option (transient-option) + ((format :initform " %k %d: %v")) + "[Experimental] Class used for unencoded key-value pairs.") + +(cl-defmethod transient-infix-value ((obj transient-cons-option)) + "Return ARGUMENT and VALUE as a cons-cell or nil if the latter is nil." + (and-let* ((value (oref obj value))) + (cons (oref obj argument) value))) + +(cl-defmethod transient-format-description ((obj transient-cons-option)) + (or (oref obj description) + (let ((description (prin1-to-string (oref obj argument) t))) + (if (string-prefix-p ":" description) + (substring description 1) + description)))) + +(cl-defmethod transient-format-value ((obj transient-cons-option)) + (let ((value (oref obj value))) + (propertize (prin1-to-string value t) 'face + (if value 'transient-value 'transient-inactive-value)))) + ;;; _ (provide 'transient) ;; Local Variables: ;; indent-tabs-mode: nil ;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode") ;; End: -;;; transient.el ends here +;;;; transient.el ends here diff --git a/lisp/treesit.el b/lisp/treesit.el index 5df8eb70cbf..45626e77b99 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -3237,11 +3237,14 @@ The type can be `list' (the default) or `sexp'. The `list' type uses the `list' thing defined in `treesit-thing-settings'. See `treesit-thing-at-point'. With this type commands use syntax tables to -navigate symbols and treesit definition to navigate lists. +navigate symbols and treesit definitions to navigate lists. The `sexp' type uses the `sexp' thing defined in `treesit-thing-settings'. -With this type commands use only the treesit definition of parser nodes, -without distinction between symbols and lists." +With this type commands use only the treesit definitions of parser nodes, +without distinction between symbols and lists. Since tree-sitter grammars +could group node types in arbitrary ways, navigation by `sexp' might not +match your expectations, and might produce different results in differnt +treesit-based modes." (interactive "p") (if (not (treesit-thing-defined-p 'list (treesit-language-at (point)))) (user-error "No `list' thing is defined in `treesit-thing-settings'") @@ -3630,14 +3633,15 @@ predicate as described in `treesit-thing-settings'." (treesit--thing-sibling pos thing nil)) (defun treesit-thing-at (pos thing &optional strict) - "Return the smallest THING enclosing POS. + "Return the smallest node enclosing POS for THING. -The returned node, if non-nil, must enclose POS, i.e., its start -<= POS, its end > POS. If STRICT is non-nil, the returned node's -start must < POS rather than <= POS. +The returned node, if non-nil, must enclose POS, i.e., its +start <= POS, its end > POS. If STRICT is non-nil, the returned +node's start must be < POS rather than <= POS. -THING should be a thing defined in `treesit-thing-settings', or -it can be a predicate described in `treesit-thing-settings'." +THING should be a thing defined in `treesit-thing-settings' for +the current buffer's major mode, or it can be a predicate +described in `treesit-thing-settings'." (let* ((cursor (treesit-node-at pos)) (iter-pred (lambda (node) (and (treesit-node-match-p node thing t) @@ -3789,13 +3793,14 @@ function is called recursively." (if (eq counter 0) pos nil))) (defun treesit-thing-at-point (thing tactic) - "Return the THING at point, or nil if none is found. + "Return the node for THING at point, or nil if no THING is found at point. THING can be a symbol, a regexp, a predicate function, and more; -see `treesit-thing-settings' for details. +for details, see `treesit-thing-settings' as defined by the +current buffer's major mode. -Return the top-level THING if TACTIC is `top-level'; return the -smallest enclosing THING as POS if TACTIC is `nested'." +Return the top-level node for THING if TACTIC is `top-level'; return +the smallest node enclosing THING at point if TACTIC is `nested'." (let ((node (treesit-thing-at (point) thing))) (if (eq tactic 'top-level) diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 1f5bdcd6224..6e25323bf5a 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -371,14 +371,19 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (defun uniquify-rationalize (fix-list) ;; Set up uniquify to re-rationalize after killing/renaming ;; if there is a conflict. + (dolist (item fix-list) + (with-current-buffer (uniquify-item-buffer item) + (setq uniquify-managed fix-list))) + (uniquify-rationalize--generic fix-list #'uniquify-rename-buffer #'get-buffer)) + +(defun uniquify-rationalize--generic (fix-list rename-buffer-fn get-buffer-fn) (dolist (item fix-list) (with-current-buffer (uniquify-item-buffer item) ;; Refresh the dirnames and proposed names. (setf (uniquify-item-proposed item) (uniquify-get-proposed-name (uniquify-item-base item) (uniquify-item-dirname item) - nil)) - (setq uniquify-managed fix-list))) + nil)))) ;; Strip any shared last directory names of the dirname. (when (and (cdr fix-list) uniquify-strip-common-suffix) (let ((strip t)) @@ -404,13 +409,13 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." fix-list))))) ;; If uniquify-min-dir-content is 0, this will end up just ;; passing fix-list to uniquify-rationalize-conflicting-sublist. - (uniquify-rationalize-a-list fix-list)) + (uniquify-rationalize-a-list fix-list nil rename-buffer-fn get-buffer-fn)) (defun uniquify-item-greaterp (item1 item2) (string-lessp (uniquify-item-proposed item2) (uniquify-item-proposed item1))) -(defun uniquify-rationalize-a-list (fix-list &optional depth) +(defun uniquify-rationalize-a-list (fix-list depth rename-buffer-fn get-buffer-fn) (unless depth (setq depth uniquify-min-dir-content)) (let (conflicting-sublist ; all elements have the same proposed name (old-proposed "") @@ -421,12 +426,14 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (setq proposed (uniquify-item-proposed item)) (unless (equal proposed old-proposed) (uniquify-rationalize-conflicting-sublist conflicting-sublist - old-proposed depth) + old-proposed depth + rename-buffer-fn get-buffer-fn) (setq conflicting-sublist nil)) (push item conflicting-sublist) (setq old-proposed proposed)) (uniquify-rationalize-conflicting-sublist conflicting-sublist - old-proposed depth))) + old-proposed depth + rename-buffer-fn get-buffer-fn))) (defun uniquify-get-proposed-name (base dirname &optional depth) (unless depth (setq depth uniquify-min-dir-content)) @@ -478,12 +485,12 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." ;; Deal with conflicting-sublist, all of whose elements have identical ;; "base" components. -(defun uniquify-rationalize-conflicting-sublist (conf-list old-name depth) +(defun uniquify-rationalize-conflicting-sublist (conf-list old-name depth rename-buffer-fn get-buffer-fn) (when conf-list (if (or (cdr conf-list) ;; Check that the proposed name doesn't conflict with some ;; existing buffer. - (let ((buf (get-buffer old-name))) + (let ((buf (funcall get-buffer-fn old-name))) (and buf (not (eq buf (uniquify-item-buffer (car conf-list))))))) (when uniquify-possibly-resolvable (setq uniquify-possibly-resolvable nil @@ -494,10 +501,9 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (uniquify-item-base item) (uniquify-item-dirname item) depth))) - (uniquify-rationalize-a-list conf-list depth)) + (uniquify-rationalize-a-list conf-list depth rename-buffer-fn get-buffer-fn)) (unless (string= old-name "") - (uniquify-rename-buffer (car conf-list) old-name))))) - + (funcall rename-buffer-fn (car conf-list) old-name))))) (defun uniquify-rename-buffer (item newname) (let ((buffer (uniquify-item-buffer item))) @@ -507,6 +513,44 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." ;; Pass the `unique' arg, so the advice doesn't mark it as unmanaged. (rename-buffer newname t)))))) +(defvar-local uniquify--stateless-curname nil + "The current unique name of this buffer in `uniquify-get-unique-names'.") + +(defun uniquify-get-unique-names (buffers) + "Return an alist with a unique name for each buffer in BUFFERS. + +The names are unique only among BUFFERS, and may conflict with other +buffers not in that list. + +This does not rename the buffers or change any state; the unique name is +only present in the returned alist." + (let ((buffer-names (make-hash-table :size (length buffers) :test 'equal)) + fix-lists-by-base) + (dolist (buf buffers) + (with-current-buffer buf + (setq uniquify--stateless-curname (buffer-name buf)) + (puthash (buffer-name buf) buf buffer-names) + (when uniquify-managed + (let ((base (uniquify-item-base (car uniquify-managed)))) + (push + (uniquify-make-item base (uniquify-buffer-file-name buf) buf nil) + (alist-get base fix-lists-by-base nil nil #'equal)))))) + (dolist (pair fix-lists-by-base) + (uniquify-rationalize--generic + (cdr pair) + (lambda (item name) ; rename-buffer + (with-current-buffer (uniquify-item-buffer item) + (remhash uniquify--stateless-curname buffer-names) + (setq uniquify--stateless-curname name) + (puthash name (current-buffer) buffer-names))) + (lambda (name) ; get-buffer + (gethash name buffer-names))))) + (mapcar (lambda (buf) + (with-current-buffer buf + (prog1 (cons uniquify--stateless-curname buf) + (kill-local-variable 'uniquify--stateless-curname)))) + buffers)) + ;;; Hooks from the rest of Emacs (defun uniquify-maybe-rerationalize-w/o-cb () diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 1ba4450cf5d..f345a1b2779 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -816,13 +816,28 @@ If LIMIT is non-nil, show no more than this many entries." (indent-region (match-end 0) (point-max) 2) (buffer-substring (match-end 0) (point-max))))) +;; FIXME: Implement `vc-bzr-mergebase' and then delete this. (defun vc-bzr-log-incoming (buffer remote-location) (apply #'vc-bzr-command "missing" buffer 'async nil - (list "--theirs-only" (unless (string= remote-location "") remote-location)))) + (list "--theirs-only" (and (not (string-empty-p remote-location)) + remote-location)))) +(defun vc-bzr-incoming-revision (remote-location) + (with-temp-buffer + (vc-bzr-command "missing" t 1 nil + "--log-format=long" "--show-ids" + "--theirs-only" "-r-1.." + (and (not (string-empty-p remote-location)) + remote-location)) + (goto-char (point-min)) + (and (re-search-forward "^revision-id: " nil t) + (buffer-substring (point) (pos-eol))))) + +;; FIXME: Implement `vc-bzr-mergebase' and then delete this. (defun vc-bzr-log-outgoing (buffer remote-location) (apply #'vc-bzr-command "missing" buffer 'async nil - (list "--mine-only" (unless (string= remote-location "") remote-location)))) + (list "--mine-only" (and (not (string-empty-p remote-location)) + remote-location)))) (defun vc-bzr-show-log-entry (revision) "Find entry for patch name REVISION in bzr change log buffer." diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index b9d733d934b..278bafba022 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -158,6 +158,14 @@ option." :group 'vc :version "31.1") +(defcustom vc-dir-hide-up-to-date-on-revert nil + "If non-nil, \\\\[revert-buffer] in VC-Dir buffers also does \\[vc-dir-hide-up-to-date]. +That is, refreshing the VC-Dir buffer also hides `up-to-date' and +`ignored' items." + :type 'boolean + :group 'vc + :version "31.1") + (defun vc-dir-move-to-goal-column () ;; Used to keep the cursor on the file name column. (beginning-of-line) @@ -1347,7 +1355,9 @@ specific headers." (not (vc-dir-fileinfo->needs-update info)))))))))))) (defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm) - (vc-dir-refresh)) + (vc-dir-refresh) + (when vc-dir-hide-up-to-date-on-revert + (vc-dir-hide-state))) (defun vc-dir-refresh () "Refresh the contents of the *VC-dir* buffer. diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 2368cc6512e..18c0fd5e3ca 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -122,6 +122,15 @@ dispatcher client mode imposes itself." :type 'hook :group 'vc) +;; This hook was undeclared and undocumented until declared obsolete. +;; I believe it can be replaced with `vc-log-after-operation-hook'; if +;; someone can demonstrate a case where this is wanted too, we can +;; unobsolete it. --spwhitton +(defvar vc-finish-logentry-hook nil + "Additional hook run at the end of `vc-finish-logentry'.") +(make-obsolete-variable 'vc-finish-logentry-hook 'vc-log-after-operation-hook + "31.1" 'set) + (defcustom vc-delete-logbuf-window t "If non-nil, delete the log buffer and window after each logical action. If nil, bury that buffer instead. @@ -874,18 +883,14 @@ the buffer contents as a comment." (setq vc-log-operation nil) ;; Quit windows on logbuf. - (cond - ((not logbuf)) - (vc-delete-logbuf-window - (quit-windows-on logbuf t (selected-frame))) - (t - (quit-windows-on logbuf nil 0))) + (cond ((not logbuf)) + (vc-delete-logbuf-window + (quit-windows-on logbuf t (selected-frame))) + (t + (quit-windows-on logbuf nil 0))) ;; Now make sure we see the expanded headers - (when log-fileset - (mapc - (lambda (file) (vc-resynch-buffer file t t)) - log-fileset)) + (mapc (lambda (file) (vc-resynch-buffer file t t)) log-fileset) (run-hooks after-hook 'vc-finish-logentry-hook))) (defun vc-dispatcher-browsing () diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index c75c61cb3f4..bea1a2a282a 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -70,8 +70,7 @@ ;; - get-change-comment (files rev) OK ;; HISTORY FUNCTIONS ;; * print-log (files buffer &optional shortlog start-revision limit) OK -;; * log-outgoing (buffer remote-location) OK -;; * log-incoming (buffer remote-location) OK +;; * incoming-revision (remote-location) OK ;; - log-search (buffer pattern) OK ;; - log-view-mode () OK ;; - show-log-entry (revision) OK @@ -1125,7 +1124,8 @@ It is based on `log-edit-mode', and has Git-specific extensions." (delete-file ,temp)))) (defun vc-git-checkin (files comment &optional _rev) - (let* ((file1 (or (car files) default-directory)) + (let* ((parent (current-buffer)) + (file1 (or (car files) default-directory)) (root (vc-git-root file1)) (default-directory (expand-file-name root)) (only (or (cdr files) @@ -1253,7 +1253,10 @@ It is based on `log-edit-mode', and has Git-specific extensions." (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git) - (funcall post))) + (funcall post) + (when (buffer-live-p parent) + (with-current-buffer parent + (run-hooks 'vc-checkin-hook))))) (vc-set-async-update buffer)) (apply #'vc-git-command nil 0 files args) (funcall post))))) @@ -1330,12 +1333,17 @@ It is based on `log-edit-mode', and has Git-specific extensions." (vc-git-command nil 0 file "checkout" (or rev "HEAD"))) (defun vc-git-revert (file &optional contents-done) - "Revert FILE to the version stored in the git repository." + "Revert FILE to the version stored in the Git repository." (if contents-done (vc-git-command nil 0 file "update-index" "--") (vc-git-command nil 0 file "reset" "-q" "--") (vc-git-command nil nil file "checkout" "-q" "--"))) +(defun vc-git-revert-files (files) + "Revert FILES to the versions stored in the Git repository." + (vc-git-command nil 0 files "reset" "-q" "--") + (vc-git-command nil nil files "checkout" "-q" "--")) + (defvar vc-git-error-regexp-alist '(("^ \\(.+\\)\\> *|" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-git* buffers.") @@ -1573,36 +1581,19 @@ If LIMIT is a revision string, use it as an end-revision." (list "-p")) '("--"))))))) -(defun vc-git-log-outgoing (buffer remote-location) - (vc-setup-buffer buffer) - (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) +(defun vc-git-incoming-revision (remote-location) (vc-git-command nil 0 nil "fetch" - (unless (string= remote-location "") - ;; `remote-location' is in format "repository/branch", - ;; so remove everything except a repository name. - (replace-regexp-in-string - "/.*" "" 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))))) + (and (not (string-empty-p remote-location)) + ;; Extract remote from "remote/branch". + (replace-regexp-in-string "/.*" "" + remote-location))) + (ignore-errors ; in order to return nil if no such branch + (with-output-to-string + (vc-git-command standard-output 0 nil + "log" "--max-count=1" "--pretty=format:%H" + (if (string-empty-p remote-location) + "@{upstream}" + remote-location))))) (defun vc-git-log-search (buffer pattern) "Search the log of changes for PATTERN and output results into BUFFER. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 5c0758b93b2..31506ee6493 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1186,7 +1186,8 @@ It is based on `log-edit-mode', and has Hg-specific extensions.") (defun vc-hg-checkin (files comment &optional _rev) "Hg-specific version of `vc-backend-checkin'. REV is ignored." - (let ((args (nconc (list "commit" "-m") + (let ((parent (current-buffer)) + (args (nconc (list "commit" "-m") (vc-hg--extract-headers comment)))) (if vc-async-checkin (let ((buffer (vc-hg--async-buffer))) @@ -1195,12 +1196,16 @@ REV is ignored." "Finishing checking in files...") (with-current-buffer buffer (vc-run-delayed - (vc-compilation-mode 'hg))) + (vc-compilation-mode 'hg) + (when (buffer-live-p parent) + (with-current-buffer parent + (run-hooks 'vc-checkin-hook))))) (vc-set-async-update buffer)) (apply #'vc-hg-command nil 0 files args)))) (defun vc-hg-checkin-patch (patch-string comment) - (let ((patch-file (make-temp-file "hg-patch"))) + (let ((parent (current-buffer)) + (patch-file (make-temp-file "hg-patch"))) (write-region patch-string nil patch-file) (unwind-protect (let ((args (list "update" @@ -1214,7 +1219,10 @@ REV is ignored." (apply #'vc-hg--async-command buffer args) (with-current-buffer buffer (vc-run-delayed - (vc-compilation-mode 'hg))) + (vc-compilation-mode 'hg) + (when (buffer-live-p parent) + (with-current-buffer parent + (run-hooks 'vc-checkin-hook))))) (vc-set-async-update buffer)) (apply #'vc-hg-command nil 0 nil args))) (delete-file patch-file)))) @@ -1307,11 +1315,14 @@ REV is the revision to check out into WORKFILE." (defun vc-hg-revert (file &optional contents-done) (unless contents-done (with-temp-buffer - (apply #'vc-hg-command - t 0 file - "revert" + (apply #'vc-hg-command t 0 file "revert" (append (vc-switches 'hg 'revert)))))) +(defun vc-hg-revert-files (files) + (with-temp-buffer + (apply #'vc-hg-command t 0 files "revert" + (append (vc-switches 'hg 'revert))))) + ;;; Hg specific functionality. (defvar-keymap vc-hg-extra-menu-map) @@ -1450,15 +1461,40 @@ This runs the command \"hg summary\"." (nreverse result)) "\n")))) +;; FIXME: Resolve issue with `vc-hg-mergebase' and then delete this. (defun vc-hg-log-incoming (buffer remote-location) (vc-setup-buffer buffer) - (vc-hg-command buffer 1 nil "incoming" "-n" (unless (string= remote-location "") - remote-location))) + (vc-hg-command buffer 1 nil "incoming" "-n" + (and (not (string-empty-p remote-location)) + remote-location))) +(defun vc-hg-incoming-revision (remote-location) + (let ((output (with-output-to-string + ;; Exits 1 to mean nothing to pull. + (vc-hg-command standard-output 1 nil + "incoming" "-qn" "--limit=1" + "--template={node}" + (and (not (string-empty-p remote-location)) + remote-location))))) + (and (not (string-empty-p output)) + output))) + +;; FIXME: Resolve issue with `vc-hg-mergebase' and then delete this. (defun vc-hg-log-outgoing (buffer remote-location) (vc-setup-buffer buffer) - (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "") - remote-location))) + (vc-hg-command buffer 1 nil "outgoing" "-n" + (and (not (string-empty-p remote-location)) + remote-location))) + +;; FIXME: This works only when both rev1 and rev2 have already been pulled. +;; That means it can't do the work +;; `vc-default-log-incoming' and `vc-default-log-outgoing' need it to do. +(defun vc-hg-mergebase (rev1 &optional rev2) + (or (vc-hg--run-log "{node}" + (format "last(ancestors(%s) and ancestors(%s))" + rev1 (or rev2 "tip")) + nil) + (error "No common ancestor for merge base"))) (defvar vc-hg-error-regexp-alist '(("^M \\(.+\\)" 1 nil nil 0)) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 60748d05ed8..14378a85346 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -283,6 +283,12 @@ ;; If FILE is in the `added' state it should be returned to the ;; `unregistered' state. ;; +;; - revert-files (files) +;; +;; As revert, except that the first argument is a list of files, all +;; of which require reversion, and reversion from version backups is +;; not done. Backends can implement this for faster mass reverts. +;; ;; - merge-file (file &optional rev1 rev2) ;; ;; Merge the changes between REV1 and REV2 into the current working @@ -337,25 +343,33 @@ ;; * print-log (files buffer &optional shortlog start-revision limit) ;; ;; Insert the revision log for FILES into BUFFER. -;; If SHORTLOG is true insert a short version of the log. -;; If LIMIT is true insert only insert LIMIT log entries. If the -;; backend does not support limiting the number of entries to show -;; it should return `limit-unsupported'. +;; If SHORTLOG is non-nil insert a short version of the log. +;; If LIMIT is non-nil insert only insert LIMIT log entries. +;; When LIMIT is a string it means stop at that revision. +;; If the backend does not support limiting the number of entries to +;; show it should return `limit-unsupported'. ;; If START-REVISION is given, then show the log starting from that ;; revision ("starting" in the sense of it being the _newest_ ;; revision shown, rather than the working revision, which is normally -;; the case). Not all backends support this. At present, this is -;; only ever used with LIMIT = 1 (by vc-annotate-show-log-revision-at-line). +;; the case). Not all backends support this. ;; -;; * log-outgoing (buffer remote-location) +;; - log-outgoing (buffer remote-location) (DEPRECATED) ;; ;; Insert in BUFFER the revision log for the changes that will be ;; sent when performing a push operation to REMOTE-LOCATION. +;; Deprecated: implement incoming-revision and mergebase instead. ;; -;; * log-incoming (buffer remote-location) +;; - log-incoming (buffer remote-location) (DEPRECATED) ;; ;; Insert in BUFFER the revision log for the changes that will be ;; received when performing a pull operation from REMOTE-LOCATION. +;; Deprecated: implement incoming-revision and mergebase instead. +;; +;; * incoming-revision (remote-location) +;; +;; Return revision at the head of the branch at REMOTE-LOCATION. +;; If there is no such branch there, return nil. (Should signal an +;; error, not return nil, in the case that fetching data fails.) ;; ;; - log-search (buffer pattern) ;; @@ -1020,6 +1034,26 @@ Not supported by all backends." :safe #'booleanp :version "31.1") +(defvar vc-async-checkin-backends '(Git Hg) + "Backends which support `vc-async-checkin'.") + +(defmacro vc--with-backend-in-rootdir (desc &rest body) + (declare (indent 1) (debug (sexp body))) + ;; Intentionally capture `backend' and `rootdir': + ;; no need to keep repeating them. + `(let ((backend (vc-deduce-backend)) + (default-directory default-directory) + rootdir) + (if backend + (setq rootdir (vc-call-backend backend 'root default-directory)) + (setq rootdir + (read-directory-name ,(format "Directory for %s: " desc))) + (setq backend (vc-responsible-backend rootdir)) + (unless backend + (error "Directory is not version controlled"))) + (setq default-directory rootdir) + ,@body)) + ;; File property caching @@ -1518,19 +1552,22 @@ from which to check out the file(s)." (read-only-mode -1))))))) ;; Allow user to revert files with no changes (save-excursion - (dolist (file files) - (let ((visited (get-file-buffer file))) - ;; For files with locking, if the file does not contain - ;; any changes, just let go of the lock, i.e. revert. - (when (and (not (eq model 'implicit)) - (eq state 'up-to-date) - ;; If buffer is modified, that means the user just - ;; said no to saving it; in that case, don't revert, - ;; because the user might intend to save after - ;; finishing the log entry and committing. - (not (and visited (buffer-modified-p)))) - (vc-revert-file file) - (setq ready-for-commit (delete file ready-for-commit)))))) + (let (to-revert) + (dolist (file files) + (let ((visited (get-file-buffer file))) + ;; For files with locking, if the file does not contain + ;; any changes, just let go of the lock, i.e. revert. + (when (and (not (eq model 'implicit)) + (eq state 'up-to-date) + ;; If buffer is modified, that means the user just + ;; said no to saving it; in that case, don't revert, + ;; because the user might intend to save after + ;; finishing the log entry and committing. + (not (and visited (buffer-modified-p visited)))) + (push file to-revert)))) + (vc-revert-files backend to-revert) + (setq ready-for-commit + (cl-nset-difference ready-for-commit to-revert)))) ;; Remaining files need to be committed (if (not ready-for-commit) (message "No files remain to be committed") @@ -1868,43 +1905,49 @@ The optional argument PATCH-STRING is a string to check in as a patch. Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (run-hooks 'vc-before-checkin-hook) - (vc-start-logentry - files comment initial-contents - "Enter a change comment." - "*vc-log*" - (lambda () - (vc-call-backend backend 'log-edit-mode)) - (lambda (files comment) - ;; "This log message intentionally left almost blank". - ;; RCS 5.7 gripes about whitespace-only comments too. - (unless (and comment (string-match "[^\t\n ]" comment)) - (setq comment "*** empty log message ***")) - (cl-labels ((do-it () - ;; We used to change buffers to get local value of - ;; `vc-checkin-switches', but the (singular) local - ;; buffer is not well defined for filesets. - (if patch-string - (vc-call-backend backend 'checkin-patch - patch-string comment) - (vc-call-backend backend 'checkin - files comment rev)) - (mapc #'vc-delete-automatic-version-backups files))) - (if (and vc-async-checkin - ;; Backends which support `vc-async-checkin'. - (memq backend '(Git Hg))) - ;; Rely on `vc-set-async-update' to update properties. - (do-it) - (message "Checking in %s..." (vc-delistify files)) - (with-vc-properties files (do-it) - `((vc-state . up-to-date) - (vc-checkout-time - . ,(file-attribute-modification-time - (file-attributes file))) - (vc-working-revision . nil))) - (message "Checking in %s...done" (vc-delistify files))))) - 'vc-checkin-hook - backend - patch-string)) + (let ((do-async (and vc-async-checkin + (memq backend vc-async-checkin-backends)))) + (vc-start-logentry + files comment initial-contents + "Enter a change comment." + "*vc-log*" + (lambda () + (vc-call-backend backend 'log-edit-mode)) + (lambda (files comment) + ;; "This log message intentionally left almost blank". + ;; RCS 5.7 gripes about whitespace-only comments too. + (unless (and comment (string-match "[^\t\n ]" comment)) + (setq comment "*** empty log message ***")) + (cl-labels ((do-it () + ;; We used to change buffers to get local value of + ;; `vc-checkin-switches', but the (singular) local + ;; buffer is not well defined for filesets. + (if patch-string + (vc-call-backend backend 'checkin-patch + patch-string comment) + (vc-call-backend backend 'checkin + files comment rev)) + (mapc #'vc-delete-automatic-version-backups files))) + (if do-async + ;; Rely on `vc-set-async-update' to update properties. + (do-it) + (message "Checking in %s..." (vc-delistify files)) + (with-vc-properties files (do-it) + `((vc-state . up-to-date) + (vc-checkout-time + . ,(file-attribute-modification-time + (file-attributes file))) + (vc-working-revision . nil))) + (message "Checking in %s...done" (vc-delistify files))))) + + ;; FIXME: In the async case we need the hook to be added to the + ;; buffer with the checkin process, using `vc-run-delayed'. Ideally + ;; the identity of that buffer would be exposed to this code, + ;; somehow, so we could always handle running the hook up here. + (and (not do-async) 'vc-checkin-hook) + + backend + patch-string))) (defun vc-default-checkin-patch (_backend patch-string comment) (pcase-let* ((`(,backend ,files) (with-temp-buffer @@ -1917,9 +1960,11 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (expand-file-name f tmpdir))) (unwind-protect (progn - (dolist (f files) - (with-current-buffer (find-file-noselect f) - (vc-revert-file buffer-file-name))) + (vc-revert-files backend + (mapcar (lambda (f) + (with-current-buffer (find-file-noselect f) + buffer-file-name)) + files)) (with-temp-buffer ;; Trying to support CVS too. Assuming that vc-diff ;; there will usually have diff root in default-directory. @@ -2291,20 +2336,10 @@ state of each file in the fileset." ;; This is a mix of `vc-root-diff' and `vc-version-diff' (when (and (not rev1) rev2) (error "Not a valid revision range")) - (let ((backend (vc-deduce-backend)) - (default-directory default-directory) - rootdir) - (if backend - (setq rootdir (vc-call-backend backend 'root default-directory)) - (setq rootdir (read-directory-name "Directory for VC root-diff: ")) - (setq backend (vc-responsible-backend rootdir)) - (if backend - (setq default-directory rootdir) - (error "Directory is not version controlled"))) + (vc--with-backend-in-rootdir "VC root-diff" (let ((default-directory rootdir)) - (vc-diff-internal - t (list backend (list rootdir)) rev1 rev2 - (called-interactively-p 'interactive))))) + (vc-diff-internal t (list backend (list rootdir)) rev1 rev2 + (called-interactively-p 'interactive))))) ;;;###autoload (defun vc-diff (&optional historic not-essential fileset) @@ -2370,21 +2405,11 @@ The merge base is a common ancestor between REV1 and REV2 revisions." (list backend (list (vc-call-backend backend 'root default-directory))))))) (when (and (not rev1) rev2) (error "Not a valid revision range")) - (let ((backend (vc-deduce-backend)) - (default-directory default-directory) - rootdir) - (if backend - (setq rootdir (vc-call-backend backend 'root default-directory)) - (setq rootdir (read-directory-name "Directory for VC root-diff: ")) - (setq backend (vc-responsible-backend rootdir)) - (if backend - (setq default-directory rootdir) - (error "Directory is not version controlled"))) + (vc--with-backend-in-rootdir "VC root-diff" (let ((default-directory rootdir) (rev1 (vc-call-backend backend 'mergebase rev1 rev2))) - (vc-diff-internal - t (list backend (list rootdir)) rev1 rev2 - (called-interactively-p 'interactive))))) + (vc-diff-internal t (list backend (list rootdir)) rev1 rev2 + (called-interactively-p 'interactive))))) (declare-function ediff-load-version-control "ediff" (&optional silent)) (declare-function ediff-vc-internal "ediff-vers" @@ -2452,16 +2477,7 @@ saving the buffer." (if historic ;; We want the diff for the VC root dir. (call-interactively 'vc-root-version-diff) - (let ((backend (vc-deduce-backend)) - (default-directory default-directory) - rootdir) - (if backend - (setq rootdir (vc-call-backend backend 'root default-directory)) - (setq rootdir (read-directory-name "Directory for VC root-diff: ")) - (setq backend (vc-responsible-backend rootdir)) - (if backend - (setq default-directory rootdir) - (error "Directory is not version controlled"))) + (vc--with-backend-in-rootdir "VC root-diff" ;; VC diff for the root directory produces output that is ;; relative to it. Bind default-directory to the root directory ;; here, this way the *vc-diff* buffer is setup correctly, so @@ -3047,7 +3063,7 @@ LIMIT can also be a string, which means the revision before which to stop." (let* ((dir-present (cl-some #'file-directory-p files)) (shortlog (not (null (memq (if dir-present 'directory 'file) vc-log-short-style)))) - (buffer-name "*vc-change-log*") + (buffer-name "*vc-change-log*") (type (or type (if shortlog 'short 'long)))) (vc-log-internal-common backend buffer-name files type @@ -3078,7 +3094,7 @@ LIMIT can also be a string, which means the revision before which to stop." (vc-call-backend bk 'show-log-entry working-revision))) (lambda (_ignore-auto _noconfirm) (vc-print-log-internal backend files working-revision - is-start-revision limit type))))) + is-start-revision limit type))))) (defvar vc-log-view-type nil "Set this to record the type of VC log shown in the current buffer. @@ -3211,23 +3227,14 @@ with its diffs (if the underlying VCS backend supports that)." (list lim))) (t (list (when (> vc-log-show-limit 0) vc-log-show-limit))))) - (let* ((backend (vc-deduce-backend)) - (default-directory default-directory) - (with-diff (and (eq limit 1) revision)) - (vc-log-short-style (unless with-diff vc-log-short-style)) - rootdir) - (if backend - (setq rootdir (vc-call-backend backend 'root default-directory)) - (setq rootdir (read-directory-name "Directory for VC revision log: ")) - (setq backend (vc-responsible-backend rootdir)) - (unless backend - (error "Directory is not version controlled"))) - (setq default-directory rootdir) - (vc-print-log-internal backend (list rootdir) revision revision limit - (when with-diff 'with-diff)) - ;; We're looking at the root, so displaying " from " in - ;; the mode line isn't helpful. - (setq vc-parent-buffer-name nil))) + (vc--with-backend-in-rootdir "VC revision log" + (let* ((with-diff (and (eq limit 1) revision)) + (vc-log-short-style (and (not with-diff) vc-log-short-style))) + (vc-print-log-internal backend (list rootdir) revision revision limit + (and with-diff 'with-diff)) + ;; We're looking at the root, so displaying " from " in + ;; the mode line isn't helpful. + (setq vc-parent-buffer-name nil)))) ;;;###autoload (defun vc-print-branch-log (branch) @@ -3254,12 +3261,20 @@ In some version control systems REMOTE-LOCATION can be a remote branch name." (interactive (when current-prefix-arg (list (read-string "Remote location/branch (empty for default): ")))) - (let ((backend (vc-deduce-backend))) - (unless backend - (error "Buffer is not version controlled")) + (vc--with-backend-in-rootdir "VC root-log" (vc-incoming-outgoing-internal backend (or remote-location "") "*vc-incoming*" 'log-incoming))) +(defun vc-default-log-incoming (_backend buffer remote-location) + (vc--with-backend-in-rootdir "" + (let ((incoming (or (vc-call-backend backend + 'incoming-revision + remote-location) + (user-error "No incoming revision -- local-only branch?")))) + (vc-call-backend backend 'print-log (list rootdir) buffer t + (vc-call-backend backend 'mergebase incoming) + incoming)))) + ;;;###autoload (defun vc-log-outgoing (&optional remote-location) "Show log of changes that will be sent with a push operation to REMOTE-LOCATION. @@ -3268,12 +3283,20 @@ In some version control systems REMOTE-LOCATION can be a remote branch name." (interactive (when current-prefix-arg (list (read-string "Remote location/branch (empty for default): ")))) - (let ((backend (vc-deduce-backend))) - (unless backend - (error "Buffer is not version controlled")) + (vc--with-backend-in-rootdir "VC root-log" (vc-incoming-outgoing-internal backend (or remote-location "") "*vc-outgoing*" 'log-outgoing))) +(defun vc-default-log-outgoing (_backend buffer remote-location) + (vc--with-backend-in-rootdir "" + (let ((incoming (or (vc-call-backend backend + 'incoming-revision + remote-location) + (user-error "No incoming revision -- local-only branch?")))) + (vc-call-backend backend 'print-log (list rootdir) buffer t + (vc-call-backend backend 'mergebase incoming) + "")))) + ;;;###autoload (defun vc-log-search (pattern) "Search the VC log of changes for PATTERN and show log of matching changes. @@ -3304,16 +3327,7 @@ The merge base is a common ancestor of revisions REV1 and REV2." (or (ignore-errors (vc-deduce-fileset t)) (let ((backend (or (vc-deduce-backend) (vc-responsible-backend default-directory)))) (list backend (list (vc-call-backend backend 'root default-directory))))))) - (let ((backend (vc-deduce-backend)) - (default-directory default-directory) - rootdir) - (if backend - (setq rootdir (vc-call-backend backend 'root default-directory)) - (setq rootdir (read-directory-name "Directory for VC root-log: ")) - (setq backend (vc-responsible-backend rootdir)) - (unless backend - (error "Directory is not version controlled"))) - (setq default-directory rootdir) + (vc--with-backend-in-rootdir "VC root-log" (setq rev1 (vc-call-backend backend 'mergebase rev1 rev2)) (vc-print-log-internal backend (list rootdir) rev1 t (or rev2 "")))) @@ -3352,6 +3366,7 @@ This asks for confirmation if the buffer contents are not identical to the working revision (except for keyword expansion)." (interactive) (let* ((vc-fileset (vc-deduce-fileset)) + (backend (car vc-fileset)) (files (cadr vc-fileset)) (queried nil) diff-buffer) @@ -3394,10 +3409,7 @@ to the working revision (except for keyword expansion)." (error "Revert canceled"))) (when diff-buffer (quit-windows-on diff-buffer (eq vc-revert-show-diff 'kill)))) - (dolist (file files) - (message "Reverting %s..." (vc-delistify files)) - (vc-revert-file file) - (message "Reverting %s...done" (vc-delistify files))))) + (vc-revert-files backend files))) ;;;###autoload (defun vc-pull (&optional arg) @@ -3530,6 +3542,23 @@ If FILE is a directory, revert all files inside that directory." (file-attributes file))))) (vc-resynch-buffer file t t)) +(defun vc-revert-files (backend files) + "Revert each of FILES to the repository working version it was based on. +For entries in FILES that are directories, revert all files inside them." + (when files + (message "Reverting %s..." (vc-delistify files)) + (if (not (vc-find-backend-function backend 'revert-files)) + (mapc #'vc-revert-file files) + (with-vc-properties files + (vc-call-backend backend 'revert-files files) + `((vc-state . up-to-date))) + (dolist (file files) + (vc-file-setprop file 'vc-checkout-time + (file-attribute-modification-time + (file-attributes file))) + (vc-resynch-buffer file t t))) + (message "Reverting %s...done" (vc-delistify files)))) + ;;;###autoload (defun vc-change-backend (file backend) "Make BACKEND the current version control system for FILE. diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index f2a186ce320..227afe71006 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -73,6 +73,36 @@ extra indent = 2 (face-extend-p face nil t) (face-background face nil t))))) +(defvar visual-wrap--safe-display-specs + '(space-width min-width height raise) + "A list of display specs that don't interfere with wrap prefixes. +A \"safe\" display spec is one that won't interfere with the additional +text properties that `visual-wrap-prefix-mode' uses. + +Specs that replace the text are unsafe, since they generally determine +the range of text to replace via `eq'. If `visual-wrap-prefix-mode' +were to add text properties to some subset of this range, it would +violate this assumption.") + +(defun visual-wrap--display-property-safe-p (display) + "Return non-nil if the display property DISPLAY is \"safe\". +A \"safe\" display property is one where all the display specs are +members of `visual-wrap--safe-display-specs' (which see)." + ;; The display property could be a single display spec; if so, wrap it + ;; in a list so we can iterate over it in our loop below. + (when (and (consp display) (not (consp (car display)))) + (setq display (list display))) + ;; Loop over all the display specs to check if they're safe. Assume + ;; any display property other than a vector or list (e.g. a string) is + ;; unsafe. + (when (or (vectorp display) (listp display)) + (not (catch 'unsafe + (mapc (lambda (spec) + (unless (member (car-safe spec) + visual-wrap--safe-display-specs) + (throw 'unsafe t))) + display))))) + (defun visual-wrap--prefix-face (fcp _beg end) ;; If the fill-context-prefix already specifies a face, just use that. (cond ((get-text-property 0 'face fcp)) @@ -128,11 +158,11 @@ extra indent = 2 ;; the buffer.) (add-display-text-property position (min (+ position (length first-line-prefix)) - (line-end-position)) + (pos-eol)) 'min-width `((,next-line-prefix . width)))) (setq next-line-prefix (visual-wrap--adjust-prefix next-line-prefix)) (put-text-property - position (line-end-position) 'wrap-prefix + position (pos-eol) 'wrap-prefix (if (numberp next-line-prefix) `(space :align-to (,next-line-prefix . width)) next-line-prefix))))) @@ -209,8 +239,27 @@ by `visual-wrap-extra-indent'." (forward-line 0) (setq beg (point)) (while (< (point) end) - (visual-wrap--apply-to-line (point)) - (forward-line)) + ;; Check if the display property at the end of this line is "safe". + (if (visual-wrap--display-property-safe-p + (get-char-property (pos-eol) 'display)) + ;; If so, we can apply our visual wrapping properties to this + ;; line and continue to the next line. + (progn + (visual-wrap--apply-to-line (point)) + (forward-line)) + ;; Otherwise, skip ahead until the end of any unsafe display + ;; properties. NOTE: We do this out of an abundance of caution to + ;; be as certain as possible that we're not interfering with the + ;; display engine. If this results in cases where we fail to add + ;; wrapping properties when we should, then we should remove the + ;; `while' loop below. Without that loop, this should be the same + ;; logic `handle_single_display_spec' in xdisp.c uses for + ;; determining what text to replace. See bug#73600. + (goto-char (next-single-char-property-change (pos-eol) 'display)) + (while (not (visual-wrap--display-property-safe-p + (get-char-property (point) 'display))) + (goto-char (next-single-char-property-change (point) 'display))) + (unless (bolp) (forward-line 1)))) `(jit-lock-bounds ,beg . ,end)) ;;;###autoload diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 10425759562..58ba0db8c90 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -2480,7 +2480,8 @@ purposes)." ;; Assure `buffer-display-table' is unique ;; when two or more windows are visible. (setq buffer-display-table - (copy-sequence buffer-display-table))) + (copy-sequence (or buffer-display-table + standard-display-table)))) (unless buffer-display-table (setq buffer-display-table (make-display-table))) (dolist (entry whitespace-display-mappings) diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index c522e8e70b0..8f4333e6139 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c @@ -159,7 +159,7 @@ skip_nonspace (const char *str) /* This value is never changed by the code. We keep the code that supports also the value of '"', but let's allow the compiler to optimize it out, until someone actually uses that. */ -const int escape_char = '\\'; +static const int escape_char = '\\'; /* Get next token from input, advancing pointer. */ static int @@ -509,8 +509,8 @@ setup_argv (void) termination when interrupted. At the moment, only one child process can be running at any one time. */ -PROCESS_INFORMATION child; -int interactive = TRUE; +static PROCESS_INFORMATION child; +static int interactive = TRUE; BOOL console_event_handler (DWORD); diff --git a/nt/configure.bat b/nt/configure.bat deleted file mode 100755 index 12d7c554f1d..00000000000 --- a/nt/configure.bat +++ /dev/null @@ -1,26 +0,0 @@ -@echo off -rem ---------------------------------------------------------------------- -rem This was the old configuration script for MS Windows operating systems -rem Copyright (C) 1999-2025 Free Software Foundation, Inc. - -rem This file is part of GNU Emacs. - -rem GNU Emacs is free software: you can redistribute it and/or modify -rem it under the terms of the GNU General Public License as published by -rem the Free Software Foundation, either version 3 of the License, or -rem (at your option) any later version. - -rem GNU Emacs is distributed in the hope that it will be useful, -rem but WITHOUT ANY WARRANTY; without even the implied warranty of -rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -rem GNU General Public License for more details. - -rem You should have received a copy of the GNU General Public License -rem along with GNU Emacs. If not, see https://www.gnu.org/licenses/. - -rem ---------------------------------------------------------------------- -echo **************************************************************** -echo *** THIS METHOD OF BUILDING EMACS IS NO LONGER SUPPORTED. ** -echo *** INSTEAD, FOLLOW THE INSTRUCTIONS IN THE FILE INSTALL. ** -echo *** IN THE SAME DIRECTORY AS THIS BATCH FILE. ** -echo **************************************************************** diff --git a/nt/preprep.c b/nt/preprep.c deleted file mode 100644 index db255ecc744..00000000000 --- a/nt/preprep.c +++ /dev/null @@ -1,830 +0,0 @@ -/* Pre-process emacs.exe for profiling by MSVC. - Copyright (C) 1999, 2001-2025 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 . - - - Andrew Innes 16-Jan-1999 - based on code from addsection.c -*/ - -#define DEFER_MS_W32_H -#include - -#include -#include -#include -#include -#if defined(__GNUC__) && !defined(MINGW_W64) -#define _ANONYMOUS_UNION -#define _ANONYMOUS_STRUCT -#endif -#include - -/* Include relevant definitions from IMAGEHLP.H, which can be found - in \\win32sdk\mstools\samples\image\include\imagehlp.h. */ - -PIMAGE_NT_HEADERS (__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress, - DWORD_PTR FileLength, - PDWORD_PTR HeaderSum, - PDWORD_PTR CheckSum); - -#undef min -#undef max -#define min(x, y) (((x) < (y)) ? (x) : (y)) -#define max(x, y) (((x) > (y)) ? (x) : (y)) - - -/* File handling. */ - -typedef struct file_data { - const char *name; - unsigned long size; - HANDLE file; - HANDLE file_mapping; - unsigned char *file_base; -} file_data; - -int -open_input_file (file_data *p_file, const char *filename) -{ - HANDLE file; - HANDLE file_mapping; - void *file_base; - unsigned long size, upper_size; - - file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, - OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); - if (file == INVALID_HANDLE_VALUE) - return FALSE; - - size = GetFileSize (file, &upper_size); - file_mapping = CreateFileMapping (file, NULL, PAGE_READONLY, - 0, size, NULL); - if (!file_mapping) - return FALSE; - - file_base = MapViewOfFile (file_mapping, FILE_MAP_READ, 0, 0, size); - if (file_base == 0) - return FALSE; - - p_file->name = filename; - p_file->size = size; - p_file->file = file; - p_file->file_mapping = file_mapping; - p_file->file_base = file_base; - - return TRUE; -} - -int -open_output_file (file_data *p_file, const char *filename, unsigned long size) -{ - HANDLE file; - HANDLE file_mapping; - void *file_base; - - file = CreateFile (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL, - CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); - if (file == INVALID_HANDLE_VALUE) - return FALSE; - - file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE, - 0, size, NULL); - if (!file_mapping) - return FALSE; - - file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size); - if (file_base == 0) - return FALSE; - - p_file->name = filename; - p_file->size = size; - p_file->file = file; - p_file->file_mapping = file_mapping; - p_file->file_base = file_base; - - return TRUE; -} - -int -open_inout_file (file_data *p_file, const char *filename) -{ - HANDLE file; - HANDLE file_mapping; - void *file_base; - unsigned long size, upper_size; - - file = CreateFile (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL, - OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); - if (file == INVALID_HANDLE_VALUE) - return FALSE; - - size = GetFileSize (file, &upper_size); - file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE, - 0, size, NULL); - if (!file_mapping) - return FALSE; - - file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size); - if (file_base == 0) - return FALSE; - - p_file->name = filename; - p_file->size = size; - p_file->file = file; - p_file->file_mapping = file_mapping; - p_file->file_base = file_base; - - return TRUE; -} - -/* Close the system structures associated with the given file. */ -void -close_file_data (file_data *p_file) -{ - UnmapViewOfFile (p_file->file_base); - CloseHandle (p_file->file_mapping); - /* For the case of output files, set final size. */ - SetFilePointer (p_file->file, p_file->size, NULL, FILE_BEGIN); - SetEndOfFile (p_file->file); - CloseHandle (p_file->file); -} - - -/* Routines to manipulate NT executable file sections. */ - -unsigned long -get_unrounded_section_size (PIMAGE_SECTION_HEADER p_section) -{ - /* The true section size, before rounding, for an initialized data or - code section. (Supposedly some linkers swap the meaning of these - two values.) */ - return min (p_section->SizeOfRawData, - p_section->Misc.VirtualSize); -} - -/* Return pointer to section header for named section. */ -IMAGE_SECTION_HEADER * -find_section (const char *name, IMAGE_NT_HEADERS *nt_header) -{ - PIMAGE_SECTION_HEADER section; - int i; - - section = IMAGE_FIRST_SECTION (nt_header); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - if (strcmp (section->Name, name) == 0) - return section; - section++; - } - return NULL; -} - -/* Return pointer to section header for section containing the given - relative virtual address. */ -IMAGE_SECTION_HEADER * -rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header) -{ - PIMAGE_SECTION_HEADER section; - int i; - - section = IMAGE_FIRST_SECTION (nt_header); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - /* Some linkers (eg. the NT SDK linker I believe) swapped the - meaning of these two values - or rather, they ignored - VirtualSize entirely and always set it to zero. This affects - some very old exes (eg. gzip dated Dec 1993). Since - w32_executable_type relies on this function to work reliably, - we need to cope with this. */ - DWORD_PTR real_size = max (section->SizeOfRawData, - section->Misc.VirtualSize); - if (rva >= section->VirtualAddress - && rva < section->VirtualAddress + real_size) - return section; - section++; - } - return NULL; -} - -/* Return pointer to section header for section containing the given - offset in its raw data area. */ -IMAGE_SECTION_HEADER * -offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header) -{ - PIMAGE_SECTION_HEADER section; - int i; - - section = IMAGE_FIRST_SECTION (nt_header); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - if (offset >= section->PointerToRawData - && offset < section->PointerToRawData + section->SizeOfRawData) - return section; - section++; - } - return NULL; -} - -/* Return offset to an object in dst, given offset in src. We assume - there is at least one section in both src and dst images, and that - the some sections may have been added to dst (after sections in src). */ -static DWORD_PTR -relocate_offset (DWORD_PTR offset, - IMAGE_NT_HEADERS * src_nt_header, - IMAGE_NT_HEADERS * dst_nt_header) -{ - PIMAGE_SECTION_HEADER src_section = IMAGE_FIRST_SECTION (src_nt_header); - PIMAGE_SECTION_HEADER dst_section = IMAGE_FIRST_SECTION (dst_nt_header); - int i = 0; - - while (offset >= src_section->PointerToRawData) - { - if (offset < src_section->PointerToRawData + src_section->SizeOfRawData) - break; - i++; - if (i == src_nt_header->FileHeader.NumberOfSections) - { - /* Handle offsets after the last section. */ - dst_section = IMAGE_FIRST_SECTION (dst_nt_header); - dst_section += dst_nt_header->FileHeader.NumberOfSections - 1; - while (dst_section->PointerToRawData == 0) - dst_section--; - while (src_section->PointerToRawData == 0) - src_section--; - return offset - + (dst_section->PointerToRawData + dst_section->SizeOfRawData) - - (src_section->PointerToRawData + src_section->SizeOfRawData); - } - src_section++; - dst_section++; - } - return offset + - (dst_section->PointerToRawData - src_section->PointerToRawData); -} - -#define OFFSET_TO_RVA(offset, section) \ - ((section)->VirtualAddress + ((DWORD_PTR)(offset) - (section)->PointerToRawData)) - -#define RVA_TO_OFFSET(rva, section) \ - ((section)->PointerToRawData + ((DWORD_PTR)(rva) - (section)->VirtualAddress)) - -#define RVA_TO_SECTION_OFFSET(rva, section) \ - ((DWORD_PTR)(rva) - (section)->VirtualAddress) - -#define RVA_TO_PTR(var,section,filedata) \ - ((void *)((unsigned char *)(RVA_TO_OFFSET(var,section) + (filedata)->file_base))) - -/* Convert address in executing image to RVA. */ -#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL)) - -#define PTR_TO_OFFSET(ptr, pfile_data) \ - ((unsigned const char *)(ptr) - (pfile_data)->file_base) - -#define OFFSET_TO_PTR(offset, pfile_data) \ - ((pfile_data)->file_base + (DWORD_PTR)(offset)) - -#define ROUND_UP(p, align) \ - (((DWORD_PTR)(p) + (align)-1) & ~((DWORD_PTR)(align)-1)) -#define ROUND_DOWN(p, align) ((DWORD_PTR)(p) & ~((DWORD_PTR)(align)-1)) - - -/* The MSVC prep program generates a ._xe file from .exe, where relevant - function calls etc have been patched to go through thunks (generated - by prep) that record timing/call information. Because the thunks - need to make references to functions imported from profile.dll, the - import table must be expanded; the end result is that all the - sections following .rdata are relocated to higher RVAs (add a final - code section is added holding all the thunks). The .reloc section is - also expanded, so that the thunks themselves are relocatable. - - It is this relocation which kills emacs._xe, because the dumped heap - pointers aren't relocated, because there is no relocation data for - either the relevant global/static variables or the heap section - itself, both of which contain pointers into the heap. [Note that - static variables which aren't initialized during linking may become - initialized with heap pointers, or even pointers to other static - variables, because of dumping.] - - We could potentially generate the relocation data ourselves by making - two versions of temacs, one with an extra dummy section before - EMHEAP to offset it, and then compare the dumped executables from - both. That is a lot of work though, and it doesn't solve the problem - of dumped pointers to static variables, which also can be relocated. - - A better solution is to pre-process emacs.exe so that the .rdata and - .reloc sections are moved to the end of the section table, and thus - prep won't relocate anything else. (Of course, we leave "dead" - copies of these two sections in place, so that the virtual address of - everything else is unaffected.) Relocating the .reloc data is - trivial - we just update the IMAGE_BASE_RELOCATION address in the - header (the data itself doesn't change). Relocating the import table - is more complicated though, because the calls to imported functions - must be patched up. That requires us to selectively apply the base - relocations when we encounter references to imported functions (or - variables) in other sections, but at least the base relocations are - easy to parse. */ - -static void -copy_executable_and_move_sections (file_data *p_infile, - file_data *p_outfile) -{ - unsigned char *dst; - PIMAGE_DOS_HEADER dos_header; - PIMAGE_NT_HEADERS nt_header; - PIMAGE_NT_HEADERS dst_nt_header; - PIMAGE_SECTION_HEADER section; - PIMAGE_SECTION_HEADER dst_section; - PIMAGE_SECTION_HEADER import_section; - PIMAGE_SECTION_HEADER reloc_section; - PIMAGE_DATA_DIRECTORY import_dir; - PIMAGE_DATA_DIRECTORY reloc_dir; - DWORD_PTR import_delta_rva; - DWORD_PTR reloc_delta_rva; - DWORD_PTR offset; - int i; - -#define COPY_CHUNK(message, src, size) \ - do { \ - unsigned const char *s = (void *)(src); \ - unsigned long count = (size); \ - printf ("%s\n", (message)); \ - printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \ - printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ - printf ("\t0x%08x Size in bytes.\n", count); \ - memcpy (dst, s, count); \ - dst += count; \ - } while (0) - -#define DST_TO_OFFSET() PTR_TO_OFFSET (dst, p_outfile) -#define ROUND_UP_DST_AND_ZERO(align) \ - do { \ - unsigned char *newdst = p_outfile->file_base \ - + ROUND_UP (DST_TO_OFFSET (), (align)); \ - /* Zero the alignment slop; it may actually initialize real data. */ \ - memset (dst, 0, newdst - dst); \ - dst = newdst; \ - } while (0) - - /* Copy the source image sequentially, ie. section by section after - copying the headers and section table, to simplify the process of - relocating the .rdata and .reloc section table entries (which might - force the raw section data to be relocated). - - Note that dst is updated implicitly by each COPY_CHUNK. */ - - dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; - nt_header = (PIMAGE_NT_HEADERS) (((unsigned char *) dos_header) + - dos_header->e_lfanew); - section = IMAGE_FIRST_SECTION (nt_header); - - import_dir = &nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]; - import_section = rva_to_section (import_dir->VirtualAddress, nt_header); - - reloc_dir = &nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC]; - reloc_section = rva_to_section (reloc_dir->VirtualAddress, nt_header); - if (!reloc_section) - { - printf ("No relocation data, cannot prepare for profile prepping.\n"); - exit (1); - } - - dst = (unsigned char *) p_outfile->file_base; - - COPY_CHUNK ("Copying DOS header...", dos_header, - (DWORD_PTR) nt_header - (DWORD_PTR) dos_header); - dst_nt_header = (PIMAGE_NT_HEADERS) dst; - COPY_CHUNK ("Copying NT header...", nt_header, - (DWORD_PTR) section - (DWORD_PTR) nt_header); - dst_section = (PIMAGE_SECTION_HEADER) dst; - COPY_CHUNK ("Copying section table...", section, - nt_header->FileHeader.NumberOfSections * sizeof (*section)); - - /* Leave room for extra section table entries; filled in below. */ - dst += 2 * sizeof (*section); - - /* Align the first section's raw data area, and set the header size - field accordingly. */ - ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); - dst_nt_header->OptionalHeader.SizeOfHeaders = DST_TO_OFFSET (); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; - i++, section++, dst_section++) - { - char msg[100]; - sprintf (msg, "Copying raw data for %s...", section->Name); - - /* "Blank out" the two sections being relocated. */ - if (section == import_section || section == reloc_section) - { - dst_section->Name[0] = 'X'; - dst_section->Misc.VirtualSize = - ROUND_UP (dst_section->Misc.VirtualSize, - dst_nt_header->OptionalHeader.SectionAlignment); - dst_section->PointerToRawData = 0; - dst_section->SizeOfRawData = 0; - dst_section->Characteristics &= ~IMAGE_SCN_CNT_INITIALIZED_DATA; - dst_section->Characteristics |= IMAGE_SCN_CNT_UNINITIALIZED_DATA; - dst_section->Characteristics &= ~IMAGE_SCN_MEM_WRITE; - continue; - } - - /* Update the file-relative offset for this section's raw data (if - it has any) in case things have been relocated; we will update - the other offsets below once we know where everything is. */ - if (dst_section->PointerToRawData) - dst_section->PointerToRawData = DST_TO_OFFSET (); - - /* Copy the original raw data. */ - COPY_CHUNK - (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile), - section->SizeOfRawData); - - /* Round up the raw data size to the new alignment. */ - dst_section->SizeOfRawData = - ROUND_UP (dst_section->SizeOfRawData, - dst_nt_header->OptionalHeader.FileAlignment); - - /* Align the next section's raw data area. */ - ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); - } - - /* Add the extra section entries, copying the raw data we skipped - earlier. We'll patch up the data itself below. */ - if (import_section != NULL) - { - dst_nt_header->FileHeader.NumberOfSections++; - dst_nt_header->OptionalHeader.SizeOfImage += - ROUND_UP (import_section->Misc.VirtualSize, - dst_nt_header->OptionalHeader.SectionAlignment); - *dst_section = *import_section; - dst_section->VirtualAddress = - dst_section[-1].VirtualAddress - + ROUND_UP (dst_section[-1].Misc.VirtualSize, - dst_nt_header->OptionalHeader.SectionAlignment); - dst_section->PointerToRawData = DST_TO_OFFSET (); - /* Remember delta applied to import section. */ - import_delta_rva = dst_section->VirtualAddress - import_section->VirtualAddress; - COPY_CHUNK - ("Relocating import directory", - OFFSET_TO_PTR (import_section->PointerToRawData, p_infile), - import_section->SizeOfRawData); - ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); - dst_section++; - } - if (reloc_section != NULL) - { - dst_nt_header->FileHeader.NumberOfSections++; - dst_nt_header->OptionalHeader.SizeOfImage += - ROUND_UP (reloc_section->Misc.VirtualSize, - dst_nt_header->OptionalHeader.SectionAlignment); - *dst_section = *reloc_section; - dst_section->VirtualAddress = - dst_section[-1].VirtualAddress - + ROUND_UP (dst_section[-1].Misc.VirtualSize, - dst_nt_header->OptionalHeader.SectionAlignment); - dst_section->PointerToRawData = DST_TO_OFFSET (); - /* Remember delta applied to reloc section. */ - reloc_delta_rva = dst_section->VirtualAddress - reloc_section->VirtualAddress; - COPY_CHUNK - ("Relocating base relocations directory", - OFFSET_TO_PTR (reloc_section->PointerToRawData, p_infile), - reloc_section->SizeOfRawData); - ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); - reloc_dir = &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC]; - reloc_dir->VirtualAddress += reloc_delta_rva; - dst_section++; - } - - /* Copy remainder of source image. */ - section--; - offset = ROUND_UP (section->PointerToRawData + section->SizeOfRawData, - nt_header->OptionalHeader.FileAlignment); - COPY_CHUNK - ("Copying remainder of executable...", - OFFSET_TO_PTR (offset, p_infile), - p_infile->size - offset); - - /* Final size for new image. */ - p_outfile->size = DST_TO_OFFSET (); - - /* Now patch up remaining file-relative offsets. */ - printf ("Patching up raw data offsets...\n"); - - section = IMAGE_FIRST_SECTION (nt_header); - dst_section = IMAGE_FIRST_SECTION (dst_nt_header); - -#define ADJUST_OFFSET(var) \ - do { \ - if ((var) != 0) \ - (var) = relocate_offset ((var), nt_header, dst_nt_header); \ - } while (0) - -#define ADJUST_IMPORT_RVA(var) \ - do { \ - if ((var) != 0) \ - *((DWORD_PTR *)&(var)) += import_delta_rva; \ - } while (0) - - dst_nt_header->OptionalHeader.SizeOfInitializedData = 0; - dst_nt_header->OptionalHeader.SizeOfUninitializedData = 0; - for (i = 0; i < dst_nt_header->FileHeader.NumberOfSections; i++) - { - /* Recompute data sizes for completeness. */ - if (dst_section[i].Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA) - dst_nt_header->OptionalHeader.SizeOfInitializedData += - ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment); - else if (dst_section[i].Characteristics & IMAGE_SCN_CNT_UNINITIALIZED_DATA) - dst_nt_header->OptionalHeader.SizeOfUninitializedData += - ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment); - - ADJUST_OFFSET (dst_section[i].PointerToLinenumbers); - } - - ADJUST_OFFSET (dst_nt_header->FileHeader.PointerToSymbolTable); - - /* Update offsets in debug directory entries. Note that the debug - directory may be in the same section as the import table, so its - RVA may need to be adjusted too. */ - { - PIMAGE_DATA_DIRECTORY debug_dir = - &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DEBUG]; - PIMAGE_DEBUG_DIRECTORY debug_entry; - - /* Update debug_dir if part of import_section. */ - if (rva_to_section (debug_dir->VirtualAddress, nt_header) == import_section) - debug_dir->VirtualAddress += import_delta_rva; - - section = rva_to_section (debug_dir->VirtualAddress, dst_nt_header); - if (section) - { - int size; - - debug_entry = RVA_TO_PTR (debug_dir->VirtualAddress, section, p_outfile); - size = debug_dir->Size / sizeof (IMAGE_DEBUG_DIRECTORY); - - for (i = 0; i < size; i++, debug_entry++) - { - /* The debug data itself is normally not part of any - section, but stored after all the raw section data. So - let relocate_offset do the work. */ - ADJUST_OFFSET (debug_entry->PointerToRawData); - ADJUST_IMPORT_RVA (debug_entry->AddressOfRawData); - } - } - } - - /* Update RVAs in import directory entries. */ - { - PIMAGE_IMPORT_DESCRIPTOR imports; - PIMAGE_THUNK_DATA import_thunks; - - import_dir = &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]; - import_dir->VirtualAddress += import_delta_rva; - - section = rva_to_section (import_dir->VirtualAddress, dst_nt_header); - imports = RVA_TO_PTR (import_dir->VirtualAddress, section, p_outfile); - - for ( ; imports->Name != 0; imports++) - { - ADJUST_IMPORT_RVA (imports->OriginalFirstThunk); - ADJUST_IMPORT_RVA (imports->FirstThunk); - ADJUST_IMPORT_RVA (imports->Name); - - for (import_thunks = RVA_TO_PTR (imports->OriginalFirstThunk, section, p_outfile); - import_thunks->u1.Function != 0; - import_thunks++) - if ((import_thunks->u1.Ordinal >> 31) == 0) - ADJUST_IMPORT_RVA (import_thunks->u1.Ordinal); - - for (import_thunks = RVA_TO_PTR (imports->FirstThunk, section, p_outfile); - import_thunks->u1.Function != 0; - import_thunks++) - if ((import_thunks->u1.Ordinal >> 31) == 0) - ADJUST_IMPORT_RVA (import_thunks->u1.Ordinal); - } - - import_dir = &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IAT]; - import_dir->VirtualAddress += import_delta_rva; - } - - /* Fix up references to the import section. */ - printf ("Applying fixups to import references...\n"); - - { - IMAGE_BASE_RELOCATION *relocs, *block, *start_block, *end_block; - DWORD_PTR import_start = import_section->VirtualAddress + dst_nt_header->OptionalHeader.ImageBase; - DWORD_PTR import_end = import_start + import_section->Misc.VirtualSize; - DWORD_PTR len_import_relocs; - DWORD_PTR len_remaining_relocs; - int seen_high = 0; - WORD * high_word; - void * holder; - - reloc_dir = &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC]; - reloc_section = rva_to_section (reloc_dir->VirtualAddress, dst_nt_header); - relocs = RVA_TO_PTR (reloc_dir->VirtualAddress, reloc_section, p_outfile); - - /* Move the base relocations for the import section, if there are - any; the profiler needs to be able to patch RVAs in the import - section itself. */ - for (block = relocs, start_block = 0; - (DWORD_PTR) block - (DWORD_PTR) relocs < reloc_dir->Size; - block = (void *)((DWORD_PTR) block + block->SizeOfBlock)) - { - if (block->VirtualAddress >= import_section->VirtualAddress + import_section->Misc.VirtualSize) - { - end_block = block; - break; - } - if (block->VirtualAddress >= import_section->VirtualAddress) - { - if (start_block == 0) - start_block = block; - block->VirtualAddress += import_delta_rva; - } - } - if (start_block) - { - len_import_relocs = (DWORD_PTR) end_block - (DWORD_PTR) start_block; - len_remaining_relocs = (DWORD_PTR) relocs + reloc_dir->Size - (DWORD_PTR) end_block; - holder = malloc (len_import_relocs); - if (holder == 0) - abort (); - memcpy (holder, start_block, len_import_relocs); - memcpy (start_block, end_block, len_remaining_relocs); - memcpy ((char *) start_block + len_remaining_relocs, holder, len_import_relocs); - free (holder); - } - - /* Walk up the list of base relocations, checking for references - to the old import section location, and patching them to - reference the new location. */ - for (block = relocs; - (DWORD_PTR) block - (DWORD_PTR) relocs < reloc_dir->Size; - block = (void *)((DWORD_PTR) block + block->SizeOfBlock)) - { - DWORD_PTR page_rva = block->VirtualAddress; - DWORD_PTR page_offset; - union { - WORD word; - DWORD_PTR dword; - } * ploc; - WORD *fixup; - - section = rva_to_section (page_rva, dst_nt_header); - /* Don't apply fixups to the blanked sections. */ - if (section->Name[0] == 'X') - continue; - - for (fixup = (WORD *) &block[1]; - (DWORD_PTR) fixup - (DWORD_PTR) block < block->SizeOfBlock; - fixup++) - { - page_offset = (*fixup) & 0xfff; - ploc = RVA_TO_PTR (page_rva + page_offset, section, p_outfile); - - /* Unless our assumption is wrong, all low word fixups - should immediately follow a high fixup. */ - if (seen_high && ((*fixup) >> 12) != IMAGE_REL_BASED_LOW) - abort (); - - switch ((*fixup) >> 12) - { - case IMAGE_REL_BASED_ABSOLUTE: - break; - case IMAGE_REL_BASED_HIGH: - /* We must assume that high and low fixups occur in - pairs, specifically a low fixup immediately follows a - high fixup (normally separated by two bytes). We - have to process the two fixups together, to find out - the full pointer value and decide whether to apply - the fixup. */ - seen_high = 1; - high_word = &ploc->word; - break; - case IMAGE_REL_BASED_LOW: - offset = (*high_word << 16) + ploc->word; - if (offset >= import_start && offset < import_end) - { - (*high_word) += import_delta_rva >> 16; - ploc->dword += import_delta_rva & 0xffff; - } - seen_high = 0; - break; - case IMAGE_REL_BASED_HIGHLOW: - /* Docs imply two words in big-endian order, so perhaps - this is only used on big-endian platforms, in which - case the obvious code will work. */ - if (ploc->dword >= import_start && ploc->dword < import_end) - ploc->dword += import_delta_rva; - break; - case IMAGE_REL_BASED_HIGHADJ: - /* Docs don't say, but I guess this is the equivalent - for little-endian platforms. */ - if (ploc->dword >= import_start && ploc->dword < import_end) - ploc->dword += import_delta_rva; - break; - case IMAGE_REL_BASED_MIPS_JMPADDR: - /* Don't know how to handle this; MIPS support has been - dropped from NT4 anyway. */ - abort (); - break; -#ifdef IMAGE_REL_BASED_SECTION - case IMAGE_REL_BASED_SECTION: - case IMAGE_REL_BASED_REL32: - /* Docs don't say what these values mean. */ -#endif - default: - abort (); - } - } - } - } -} - - -int -main (int argc, char **argv) -{ - PIMAGE_DOS_HEADER dos_header; - PIMAGE_NT_HEADERS nt_header; - file_data in_file, out_file; - char out_filename[MAX_PATH], in_filename[MAX_PATH]; - - strcpy (in_filename, argv[1]); - strcpy (out_filename, argv[2]); - - printf ("Preparing %s for profile prepping\n", out_filename); - - /* Open the original (dumped) executable file for reference. */ - if (!open_input_file (&in_file, in_filename)) - { - printf ("Failed to open %s (%d)...bailing.\n", - in_filename, GetLastError ()); - exit (1); - } - - /* Create a new image that can be prepped; we don't expect the size to - change because we are only adding two new section table entries, - which should fit in the alignment slop. */ - if (!open_output_file (&out_file, out_filename, in_file.size)) - { - printf ("Failed to open %s (%d)...bailing.\n", - out_filename, GetLastError ()); - exit (1); - } - - copy_executable_and_move_sections (&in_file, &out_file); - - /* Patch up header fields; profiler is picky about this. */ - { - HANDLE hImagehelp = LoadLibrary ("imagehlp.dll"); - DWORD_PTR headersum; - DWORD_PTR checksum; - - dos_header = (PIMAGE_DOS_HEADER) out_file.file_base; - nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); - - nt_header->OptionalHeader.CheckSum = 0; - /* nt_header->FileHeader.TimeDateStamp = time (NULL); */ - /* dos_header->e_cp = size / 512; */ - /* nt_header->OptionalHeader.SizeOfImage = size; */ - - pfnCheckSumMappedFile = (void *) GetProcAddress (hImagehelp, "CheckSumMappedFile"); - if (pfnCheckSumMappedFile) - { - /* nt_header->FileHeader.TimeDateStamp = time (NULL); */ - pfnCheckSumMappedFile (out_file.file_base, - out_file.size, - &headersum, - &checksum); - nt_header->OptionalHeader.CheckSum = checksum; - } - FreeLibrary (hImagehelp); - } - - close_file_data (&out_file); - close_file_data (&in_file); - - return 0; -} - -/* eof */ diff --git a/src/fns.c b/src/fns.c index 04d00b7f9bf..c2dcaeea846 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3044,7 +3044,7 @@ fixnum_float_cmp (EMACS_INT a, double b) { /* This doesn't mean that a=b because the conversion may have rounded. However, b must be an integer that fits in an EMACS_INT, - because |b| ≤ 2|a| and EMACS_INT has at least one bit more than + because |b| <= 2|a| and EMACS_INT has at least one bit more than needed to represent any fixnum. Thus we can compare in the integer domain instead. */ EMACS_INT ib = b; /* lossless conversion */ diff --git a/src/frame.c b/src/frame.c index 0fd33c30e5c..03710a5f7af 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2482,6 +2482,8 @@ delete_frame (Lisp_Object frame, Lisp_Object force) else error ("Attempt to delete the only frame"); } + else if (IS_DAEMON && FRAME_INITIAL_P (f) && NILP (force)) + error ("Attempt to delete daemon's initial frame"); #ifdef HAVE_X_WINDOWS else if ((x_dnd_in_progress && f == x_dnd_frame) || (x_dnd_waiting_for_finish && f == x_dnd_finish_frame)) @@ -2954,10 +2956,11 @@ FRAME must be a live frame and defaults to the selected one. When `undelete-frame-mode' is enabled, the 16 most recently deleted frames can be undeleted with `undelete-frame', which see. -A frame may not be deleted if its minibuffer serves as surrogate -minibuffer for another frame. Normally, you may not delete a frame if -all other frames are invisible, but if the second optional argument -FORCE is non-nil, you may do so. +Do not delete a frame whose minibuffer serves as surrogate minibuffer +for another frame. Do not delete a frame if all other frames are +invisible unless the second optional argument FORCE is non-nil. Do not +delete the initial terminal frame of an Emacs process running as daemon +unless FORCE is non-nil. This function runs `delete-frame-functions' before actually deleting the frame, unless the frame is a tooltip. diff --git a/src/lisp.h b/src/lisp.h index 315ff89f391..167f2cb3a8f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5545,9 +5545,10 @@ extern bool no_site_lisp; /* True means put details like time stamps into builds. */ extern bool build_details; -#ifndef WINDOWSNT -/* 0 not a daemon, 1 foreground daemon, 2 background daemon. */ +/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background). + A negative value means the daemon initialization was already done. */ extern int daemon_type; +#ifndef WINDOWSNT #define IS_DAEMON (daemon_type != 0) /* Non-zero means daemon-initialized has not yet been called. */ #define DAEMON_RUNNING (daemon_type >= 0) diff --git a/src/lread.c b/src/lread.c index a248c8f5ed9..d5877fe6edc 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1206,7 +1206,21 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) Lisp_Object exts = Vload_file_rep_suffixes; Lisp_Object suffix = XCAR (suffixes); FOR_EACH_TAIL (exts) - lst = Fcons (concat2 (suffix, XCAR (exts)), lst); + { + Lisp_Object ext = XCAR (exts); +#ifdef HAVE_MODULES + if (SCHARS (ext) > 0 + && (suffix_p (suffix, MODULES_SUFFIX) +# ifdef MODULES_SECONDARY_SUFFIX + || suffix_p (suffix, MODULES_SECONDARY_SUFFIX) +# endif + ) + && !NILP (Fmember (ext, Fsymbol_value ( + Qjka_compr_load_suffixes)))) + continue; +#endif + lst = Fcons (concat2 (suffix, ext), lst); + } } return Fnreverse (lst); } @@ -1425,12 +1439,16 @@ Return t if the file exists and loads successfully. */) suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes); } + Lisp_Object load_path = Vload_path; + if (FUNCTIONP (Vload_path_filter_function)) + load_path = calln (Vload_path_filter_function, load_path, file, suffixes); + #if !defined USE_ANDROID_ASSETS - fd = openp (Vload_path, file, suffixes, &found, Qnil, + fd = openp (load_path, file, suffixes, &found, Qnil, load_prefer_newer, no_native, NULL); #else asset = NULL; - rc = openp (Vload_path, file, suffixes, &found, Qnil, + rc = openp (load_path, file, suffixes, &found, Qnil, load_prefer_newer, no_native, &asset); fd.fd = rc; fd.asset = asset; @@ -5903,6 +5921,8 @@ the loading functions recognize as compression suffixes, you should customize `jka-compr-load-suffixes' rather than the present variable. */); Vload_file_rep_suffixes = list1 (empty_unibyte_string); + DEFSYM (Qjka_compr_load_suffixes, "jka-compr-load-suffixes"); + DEFVAR_BOOL ("load-in-progress", load_in_progress, doc: /* Non-nil if inside of `load'. */); DEFSYM (Qload_in_progress, "load-in-progress"); @@ -6084,6 +6104,19 @@ where FILE is the filename of the eln file, including the .eln extension. through `require'. */); load_no_native = false; + DEFVAR_LISP ("load-path-filter-function", + Vload_path_filter_function, + doc: /* If non-nil, a function to filter `load-path' for `load'. + +If this variable is a function, it is called when `load' is about to +search for a file along `load-path'. This function is called with three +arguments: the current value of `load-path' (a list of directories), +the FILE argument to `load', and the current list of load-suffixes. + +It should return a (hopefully shorter) list of directories, which `load' +will use instead of `load-path' to look for the file to load. */); + Vload_path_filter_function = Qnil; + /* Vsource_directory was initialized in init_lread. */ DEFSYM (Qcurrent_load_list, "current-load-list"); diff --git a/src/nsfns.m b/src/nsfns.m index 82badea6c74..0a90d174227 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -2613,100 +2613,6 @@ DEFUN ("x-display-pixel-height", Fx_display_pixel_height, return make_fixnum (ns_display_pixel_height (dpyinfo)); } -#ifdef NS_IMPL_COCOA - -/* Returns the name for the screen that OBJ represents, or NULL. - Caller must free return value. -*/ - -static char * -ns_get_name_from_ioreg (io_object_t obj) -{ - char *name = NULL; - - NSDictionary *info = (NSDictionary *) - IODisplayCreateInfoDictionary (obj, kIODisplayOnlyPreferredName); - NSDictionary *names = [info objectForKey: - [NSString stringWithUTF8String: - kDisplayProductName]]; - - if ([names count] > 0) - { - NSString *n = [names objectForKey: [[names allKeys] - objectAtIndex:0]]; - if (n != nil) name = xstrdup ([n UTF8String]); - } - - [info release]; - - return name; -} - -/* Returns the name for the screen that DID came from, or NULL. - Caller must free return value. -*/ - -static char * -ns_screen_name (CGDirectDisplayID did) -{ - char *name = NULL; - -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 - if (CGDisplayIOServicePort == NULL) -#endif - { - mach_port_t masterPort; - io_iterator_t it; - io_object_t obj; - - /* CGDisplayIOServicePort is deprecated. Do it another (harder) way. - - Is this code OK for macOS < 10.9, and GNUstep? I suspect it is, - in which case is it worth keeping the other method in here? */ - - if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess - || IOServiceGetMatchingServices (masterPort, - IOServiceMatching ("IONDRVDevice"), - &it) != kIOReturnSuccess) - return name; - - /* Must loop until we find a name. Many devices can have the same unit - number (represents different GPU parts), but only one has a name. */ - while (! name && (obj = IOIteratorNext (it))) - { - CFMutableDictionaryRef props; - const void *val; - - if (IORegistryEntryCreateCFProperties (obj, - &props, - kCFAllocatorDefault, - kNilOptions) == kIOReturnSuccess - && props != nil - && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex"))) - { - unsigned nr = [(NSNumber *)val unsignedIntegerValue]; - if (nr == CGDisplayUnitNumber (did)) - name = ns_get_name_from_ioreg (obj); - } - - CFRelease (props); - IOObjectRelease (obj); - } - - IOObjectRelease (it); - } -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 - else -#endif -#endif /* #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 */ -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 - name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did)); -#endif - return name; -} -#endif /* NS_IMPL_COCOA */ - static Lisp_Object ns_make_monitor_attribute_list (struct MonitorInfo *monitors, int n_monitors, @@ -2787,46 +2693,51 @@ Internal use only, use `display-monitor-attributes-list' instead. */) struct MonitorInfo *m = &monitors[i]; NSRect fr = [s frame]; NSRect vfr = [s visibleFrame]; - short y, vy; #ifdef NS_IMPL_COCOA NSDictionary *dict = [s deviceDescription]; NSNumber *nid = [dict objectForKey:@"NSScreenNumber"]; CGDirectDisplayID did = [nid unsignedIntValue]; #endif + + /* The primary display is always the first in the array. */ if (i == 0) - { - primary_display_height = fr.size.height; - y = (short) fr.origin.y; - vy = (short) vfr.origin.y; - } - else - { - /* Flip y coordinate as NS screen coordinates originate from - the bottom. */ - y = (short) (primary_display_height - fr.size.height - fr.origin.y); - vy = (short) (primary_display_height - - vfr.size.height - vfr.origin.y); - } + primary_display_height = fr.size.height; + + /* Flip y coordinate as NS screen coordinates originate from + the bottom. */ m->geom.x = (short) fr.origin.x; - m->geom.y = y; + m->geom.y = (short) (primary_display_height - NSMaxY(fr)); m->geom.width = (unsigned short) fr.size.width; m->geom.height = (unsigned short) fr.size.height; + /* The work area excludes the menu bar and the dock. */ m->work.x = (short) vfr.origin.x; - /* y is flipped on NS, so vy - y are pixels missing at the - bottom, and fr.size.height - vfr.size.height are pixels - missing in total. - - Pixels missing at top are fr.size.height - vfr.size.height - - vy + y. work.y is then pixels missing at top + y. */ - m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y; + m->work.y = (short) (primary_display_height - NSMaxY(vfr)); m->work.width = (unsigned short) vfr.size.width; m->work.height = (unsigned short) vfr.size.height; #ifdef NS_IMPL_COCOA - m->name = ns_screen_name (did); + m->name = NULL; + if ([s respondsToSelector:@selector(localizedName)]) + { + NSString *name = [s valueForKey:@"localizedName"]; + if (name != NULL) + { + m->name = xmalloc ([name lengthOfBytesUsingEncoding: NSUTF8StringEncoding] + 1); + strcpy(m->name, [name UTF8String]); + } + } + /* If necessary, synthesize a name of the following form: + %dx%d@%d,%d width height x y. */ + if (m->name == NULL) + { + char buf[25]; /* sufficient for 12345x78901@34567,90123 */ + snprintf (buf, sizeof(buf), "%ux%u@%d,%d", + m->work.width, m->work.height, m->work.x, m->work.y); + m->name = xstrdup (buf); + } { CGSize mms = CGDisplayScreenSize (did); diff --git a/src/nsterm.m b/src/nsterm.m index dc952f39d2f..bd55297ecda 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4177,7 +4177,7 @@ ns_draw_stretch_glyph_string (struct glyph_string *s) face = FACE_FROM_ID_OR_NULL (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!s->face) + if (!face) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); prepare_face_for_display (s->f, face); @@ -9823,11 +9823,11 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) /* Don't do anything for child frames because that leads to weird child frame placement in some cases involving Dock placement and Dock Hiding. */ +#ifdef NS_IMPL_COCOA struct frame *f = *((EmacsView *) [self delegate])->emacsframe; if (FRAME_PARENT_FRAME (f)) return frameRect; -#ifdef NS_IMPL_COCOA #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 // If separate spaces is on, it is like each screen is independent. There is // no spanning of frames across screens. diff --git a/src/print.c b/src/print.c index 25061fa4d01..99c29bb5329 100644 --- a/src/print.c +++ b/src/print.c @@ -471,18 +471,18 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte, because printing one char can relocate. */ static void -print_string (Lisp_Object string, Lisp_Object printcharfun) +print_string_1 (Lisp_Object string, Lisp_Object printcharfun, bool escape_nonascii) { if (EQ (printcharfun, Qt) || NILP (printcharfun)) { ptrdiff_t chars; - if (print_escape_nonascii) + if (escape_nonascii) string = string_escape_byte8 (string); if (STRING_MULTIBYTE (string)) chars = SCHARS (string); - else if (! print_escape_nonascii + else if (! escape_nonascii && (EQ (printcharfun, Qt) ? ! NILP (BVAR (&buffer_defaults, enable_multibyte_characters)) : ! NILP (BVAR (current_buffer, enable_multibyte_characters)))) @@ -545,6 +545,12 @@ print_string (Lisp_Object string, Lisp_Object printcharfun) } } } + +static void +print_string (Lisp_Object string, Lisp_Object printcharfun) +{ + print_string_1 (string, printcharfun, print_escape_nonascii); +} DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0, doc: /* Output character CHARACTER to stream PRINTCHARFUN. @@ -2448,7 +2454,7 @@ print_object (Lisp_Object obj, bool escapeflag, struct print_context *pc) } else if (STRINGP (num)) { - strout (SSDATA (num), SCHARS (num), SBYTES (num), printcharfun); + print_string_1 (num, printcharfun, false); goto next_obj; } } diff --git a/src/timefns.c b/src/timefns.c index 4d296ff8dcd..8cf424bbe7e 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -189,6 +189,7 @@ emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm) display-time) are in real danger of missing timezone and DST changes. Calling tzset before each localtime call fixes that. */ tzset (); + w32_fix_tzset (); #endif tm = localtime_rz (tz, t, tm); if (!tm && errno == ENOMEM) @@ -306,6 +307,9 @@ tzlookup (Lisp_Object zone, bool settz) block_input (); emacs_setenv_TZ (zone_string); tzset (); +#ifdef WINDOWSNT + w32_fix_tzset (); +#endif timezone_t old_tz = local_tz; local_tz = new_tz; tzfree (old_tz); diff --git a/src/treesit.c b/src/treesit.c index de74e41c89a..67dd2ee3a7a 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -5193,13 +5193,16 @@ then in the system default locations for dynamic libraries, in that order. */); doc: /* A list defining things. -The value should be an alist of (LANGUAGE . DEFINITIONS), where -LANGUAGE is a language symbol, and DEFINITIONS is a list of +The value should be defined by the major mode, and should be an alist +of the form (LANGUAGE . DEFINITIONS), where LANGUAGE is a language +symbol and DEFINITIONS is a list whose elements are of the form (THING PRED) -THING is a symbol representing the thing, like `defun', `sexp', or -`sentence'; PRED defines what kind of node can be qualified as THING. +THING is a symbol representing the thing, like `defun', `defclass', +`sexp', `sentence', `comment', or any other symbol that is meaningful +for the major mode; PRED defines what kind of node can be qualified +as THING. PRED can be a regexp string that matches the type of the node; it can be a predicate function that takes the node as the sole argument and @@ -5207,12 +5210,13 @@ returns t if the node is the thing, and nil otherwise; it can be a cons (REGEXP . FN), which is a combination of a regexp and a predicate function, and the node has to match both to qualify as the thing. -PRED can also be recursively defined. It can be (or PRED...), meaning -satisfying anyone of the inner PREDs qualifies the node; or (and -PRED...) meaning satisfying all of the inner PREDs qualifies the node; -or (not PRED), meaning not satisfying the inner PRED qualifies the node. +PRED can also be recursively defined. It can be: -There are two pre-defined predicates, `named' and `anonymous`. They + (or PRED...), meaning satisfying any of the inner PREDs qualifies the node; + (and PRED...) meaning satisfying all of the inner PREDs qualifies the node; + (not PRED), meaning not satisfying the inner PRED qualifies the node. + +There are two pre-defined predicates, `named' and `anonymous'. They match named nodes and anonymous nodes, respectively. Finally, PRED can refer to other THINGs defined in this list by using diff --git a/src/w32.c b/src/w32.c index 9f2ef85340c..f89f4254c17 100644 --- a/src/w32.c +++ b/src/w32.c @@ -126,8 +126,11 @@ typedef struct _MEMORY_STATUS_EX { (excptr->ExceptionRecord->ExceptionCode) and the address where the exception happened (excptr->ExceptionRecord->ExceptionAddress), as well as some additional information specific to the exception. */ +extern PEXCEPTION_POINTERS excptr; PEXCEPTION_POINTERS excptr; +extern PEXCEPTION_RECORD excprec; PEXCEPTION_RECORD excprec; +extern PCONTEXT ctxrec; PCONTEXT ctxrec; #include @@ -353,7 +356,9 @@ static BOOL g_b_init_expand_environment_strings_w; static BOOL g_b_init_get_user_default_ui_language; static BOOL g_b_init_get_console_font_size; +extern BOOL g_b_init_compare_string_w; BOOL g_b_init_compare_string_w; +extern BOOL g_b_init_debug_break_process; BOOL g_b_init_debug_break_process; /* @@ -379,12 +384,12 @@ typedef BOOL (WINAPI * GetProcessTimes_Proc) ( LPFILETIME kernel_time, LPFILETIME user_time); -GetProcessTimes_Proc get_process_times_fn = NULL; +static GetProcessTimes_Proc get_process_times_fn = NULL; #ifdef _UNICODE -const char * const LookupAccountSid_Name = "LookupAccountSidW"; +static const char * const LookupAccountSid_Name = "LookupAccountSidW"; #else -const char * const LookupAccountSid_Name = "LookupAccountSidA"; +static const char * const LookupAccountSid_Name = "LookupAccountSidA"; #endif typedef BOOL (WINAPI * LookupAccountSid_Proc) ( LPCTSTR lpSystemName, @@ -3647,7 +3652,7 @@ is_exec (const char * name) the code that calls them doesn't grok UTF-8 encoded file names we produce in dirent->d_name[]. */ -struct dirent dir_static; /* simulated directory contents */ +static struct dirent dir_static; /* simulated directory contents */ static HANDLE dir_find_handle = INVALID_HANDLE_VALUE; static int dir_is_fat; static char dir_pathname[MAX_UTF8_PATH]; @@ -4777,7 +4782,7 @@ int sys_rename_replace (const char *oldname, const char *newname, BOOL force) { BOOL result; - char temp[MAX_UTF8_PATH], temp_a[MAX_PATH]; + char temp[MAX_UTF8_PATH], temp_a[MAX_PATH + 15]; /* "+ 15": pacify GCC */ int newname_dev; int oldname_dev; bool have_temp_a = false; @@ -7760,55 +7765,56 @@ w32_memory_info (unsigned long long *totalram, unsigned long long *freeram, (eg. gethostname). */ /* function pointers for relevant socket functions */ -int (PASCAL *pfn_WSAStartup) (WORD wVersionRequired, LPWSADATA lpWSAData); -void (PASCAL *pfn_WSASetLastError) (int iError); -int (PASCAL *pfn_WSAGetLastError) (void); -int (PASCAL *pfn_WSAEventSelect) (SOCKET s, HANDLE hEventObject, long lNetworkEvents); -int (PASCAL *pfn_WSAEnumNetworkEvents) (SOCKET s, HANDLE hEventObject, +static int (PASCAL *pfn_WSAStartup) (WORD wVersionRequired, LPWSADATA lpWSAData); +static void (PASCAL *pfn_WSASetLastError) (int iError); +static int (PASCAL *pfn_WSAGetLastError) (void); +static int (PASCAL *pfn_WSAEventSelect) (SOCKET s, HANDLE hEventObject, long lNetworkEvents); +static int (PASCAL *pfn_WSAEnumNetworkEvents) (SOCKET s, HANDLE hEventObject, WSANETWORKEVENTS *NetworkEvents); -HANDLE (PASCAL *pfn_WSACreateEvent) (void); -int (PASCAL *pfn_WSACloseEvent) (HANDLE hEvent); -int (PASCAL *pfn_socket) (int af, int type, int protocol); -int (PASCAL *pfn_bind) (SOCKET s, const struct sockaddr *addr, int namelen); -int (PASCAL *pfn_connect) (SOCKET s, const struct sockaddr *addr, int namelen); -int (PASCAL *pfn_ioctlsocket) (SOCKET s, long cmd, u_long *argp); -int (PASCAL *pfn_recv) (SOCKET s, char * buf, int len, int flags); -int (PASCAL *pfn_send) (SOCKET s, const char * buf, int len, int flags); -int (PASCAL *pfn_closesocket) (SOCKET s); -int (PASCAL *pfn_shutdown) (SOCKET s, int how); -int (PASCAL *pfn_WSACleanup) (void); +static HANDLE (PASCAL *pfn_WSACreateEvent) (void); +static int (PASCAL *pfn_WSACloseEvent) (HANDLE hEvent); +static int (PASCAL *pfn_socket) (int af, int type, int protocol); +static int (PASCAL *pfn_bind) (SOCKET s, const struct sockaddr *addr, int namelen); +static int (PASCAL *pfn_connect) (SOCKET s, const struct sockaddr *addr, int namelen); +static int (PASCAL *pfn_ioctlsocket) (SOCKET s, long cmd, u_long *argp); +static int (PASCAL *pfn_recv) (SOCKET s, char * buf, int len, int flags); +static int (PASCAL *pfn_send) (SOCKET s, const char * buf, int len, int flags); +static int (PASCAL *pfn_closesocket) (SOCKET s); +static int (PASCAL *pfn_shutdown) (SOCKET s, int how); +static int (PASCAL *pfn_WSACleanup) (void); -u_short (PASCAL *pfn_htons) (u_short hostshort); -u_short (PASCAL *pfn_ntohs) (u_short netshort); -u_long (PASCAL *pfn_htonl) (u_long hostlong); -u_long (PASCAL *pfn_ntohl) (u_long netlong); -unsigned long (PASCAL *pfn_inet_addr) (const char * cp); -int (PASCAL *pfn_gethostname) (char * name, int namelen); -struct hostent * (PASCAL *pfn_gethostbyname) (const char * name); -struct servent * (PASCAL *pfn_getservbyname) (const char * name, const char * proto); -int (PASCAL *pfn_getpeername) (SOCKET s, struct sockaddr *addr, int * namelen); -int (PASCAL *pfn_setsockopt) (SOCKET s, int level, int optname, +static u_short (PASCAL *pfn_htons) (u_short hostshort); +static u_short (PASCAL *pfn_ntohs) (u_short netshort); +static u_long (PASCAL *pfn_htonl) (u_long hostlong); +static u_long (PASCAL *pfn_ntohl) (u_long netlong); +static unsigned long (PASCAL *pfn_inet_addr) (const char * cp); +static int (PASCAL *pfn_gethostname) (char * name, int namelen); +static struct hostent * (PASCAL *pfn_gethostbyname) (const char * name); +static struct servent * (PASCAL *pfn_getservbyname) (const char * name, const char * proto); +static int (PASCAL *pfn_getpeername) (SOCKET s, struct sockaddr *addr, int * namelen); +static int (PASCAL *pfn_setsockopt) (SOCKET s, int level, int optname, const char * optval, int optlen); -int (PASCAL *pfn_listen) (SOCKET s, int backlog); -int (PASCAL *pfn_getsockname) (SOCKET s, struct sockaddr * name, +static int (PASCAL *pfn_listen) (SOCKET s, int backlog); +static int (PASCAL *pfn_getsockname) (SOCKET s, struct sockaddr * name, int * namelen); -SOCKET (PASCAL *pfn_accept) (SOCKET s, struct sockaddr * addr, int * addrlen); -int (PASCAL *pfn_recvfrom) (SOCKET s, char * buf, int len, int flags, +static SOCKET (PASCAL *pfn_accept) (SOCKET s, struct sockaddr * addr, int * addrlen); +static int (PASCAL *pfn_recvfrom) (SOCKET s, char * buf, int len, int flags, struct sockaddr * from, int * fromlen); -int (PASCAL *pfn_sendto) (SOCKET s, const char * buf, int len, int flags, +static int (PASCAL *pfn_sendto) (SOCKET s, const char * buf, int len, int flags, const struct sockaddr * to, int tolen); -int (PASCAL *pfn_getaddrinfo) (const char *, const char *, +static int (PASCAL *pfn_getaddrinfo) (const char *, const char *, const struct addrinfo *, struct addrinfo **); -void (PASCAL *pfn_freeaddrinfo) (struct addrinfo *); +static void (PASCAL *pfn_freeaddrinfo) (struct addrinfo *); /* SetHandleInformation is only needed to make sockets non-inheritable. */ -BOOL (WINAPI *pfn_SetHandleInformation) (HANDLE object, DWORD mask, DWORD flags); +static BOOL (WINAPI *pfn_SetHandleInformation) (HANDLE object, DWORD mask, DWORD flags); #ifndef HANDLE_FLAG_INHERIT #define HANDLE_FLAG_INHERIT 1 #endif +extern HANDLE winsock_lib; HANDLE winsock_lib; static int winsock_inuse; @@ -7971,7 +7977,7 @@ check_errno (void) } /* Extend strerror to handle the winsock-specific error codes. */ -struct { +static struct { int errnum; const char * msg; } _wsa_errlist[] = { @@ -10289,6 +10295,30 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) } +/* mingw.org's MinGW doesn't declare _dstbias. MinGW64 defines it as a + macro. */ +#ifndef _dstbias +__MINGW_IMPORT int _dstbias; +#endif + +/* Fix a bug in MS implementation of 'tzset'. This function should be + called immediately after 'tzset'. */ +void +w32_fix_tzset (void) +{ + char *tz_env = getenv ("TZ"); + + /* When TZ is defined in the environment, '_tzset' updates _daylight, + but not _dstbias. Then if we are switching from a timezone without + DST to a timezone with DST, 'localtime' and friends will apply zero + DST bias, which is incorrect. (When TZ is not defined, '_tzset' + does update _dstbias using values obtained from Windows API + GetTimeZoneInformation.) Here we fix that blunder by detecting + this situation and forcing _dstbias to be 1 hour. */ + if (tz_env && _daylight && !_dstbias) + _dstbias = -3600; +} + /* The Windows CRT functions are "optimized for speed", so they don't check for timezone and DST changes if they were last called less than 1 minute ago (see http://support.microsoft.com/kb/821231). So @@ -10299,6 +10329,7 @@ struct tm * sys_localtime (const time_t *t) { tzset (); + w32_fix_tzset (); return localtime (t); } diff --git a/src/w32.h b/src/w32.h index ae3999ffcfd..9d9887ec782 100644 --- a/src/w32.h +++ b/src/w32.h @@ -234,6 +234,7 @@ extern int openat (int, const char *, int, int); extern int fchmodat (int, char const *, mode_t, int); extern int lchmod (char const *, mode_t); extern bool symlinks_supported (const char *); +extern void w32_fix_tzset (void); /* Return total and free memory info. */ diff --git a/src/w32console.c b/src/w32console.c index b18eda437ad..1bca0cadff9 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -64,6 +64,7 @@ static CONSOLE_CURSOR_INFO console_cursor_info; static CONSOLE_CURSOR_INFO prev_console_cursor; #endif +extern HANDLE keyboard_handle; HANDLE keyboard_handle; int w32_console_unicode_input; @@ -623,7 +624,9 @@ sys_tgetstr (char *cap, char **area) stubs from cm.c ***********************************************************************/ +extern struct tty_display_info *current_tty; struct tty_display_info *current_tty = NULL; +extern int cost; int cost = 0; int evalcost (int); diff --git a/src/w32fns.c b/src/w32fns.c index 17221b73470..d96c051f30d 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -237,26 +237,28 @@ typedef struct Emacs_GESTURECONFIG typedef BOOL (WINAPI * SetGestureConfig_proc) (HWND, DWORD, UINT, Emacs_PGESTURECONFIG, UINT); -TrackMouseEvent_Proc track_mouse_event_fn = NULL; -ImmGetCompositionString_Proc get_composition_string_fn = NULL; -ImmGetContext_Proc get_ime_context_fn = NULL; -ImmGetOpenStatus_Proc get_ime_open_status_fn = NULL; -ImmSetOpenStatus_Proc set_ime_open_status_fn = NULL; -ImmReleaseContext_Proc release_ime_context_fn = NULL; -ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL; -MonitorFromPoint_Proc monitor_from_point_fn = NULL; -GetMonitorInfo_Proc get_monitor_info_fn = NULL; -MonitorFromWindow_Proc monitor_from_window_fn = NULL; -EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL; -GetTitleBarInfo_Proc get_title_bar_info_fn = NULL; +static TrackMouseEvent_Proc track_mouse_event_fn = NULL; +static ImmGetCompositionString_Proc get_composition_string_fn = NULL; +static ImmGetContext_Proc get_ime_context_fn = NULL; +static ImmGetOpenStatus_Proc get_ime_open_status_fn = NULL; +static ImmSetOpenStatus_Proc set_ime_open_status_fn = NULL; +static ImmReleaseContext_Proc release_ime_context_fn = NULL; +static ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL; +static MonitorFromPoint_Proc monitor_from_point_fn = NULL; +static GetMonitorInfo_Proc get_monitor_info_fn = NULL; +static MonitorFromWindow_Proc monitor_from_window_fn = NULL; +static EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL; +static GetTitleBarInfo_Proc get_title_bar_info_fn = NULL; +extern IsDebuggerPresent_Proc is_debugger_present; IsDebuggerPresent_Proc is_debugger_present = NULL; +extern SetThreadDescription_Proc set_thread_description; SetThreadDescription_Proc set_thread_description = NULL; -SetWindowTheme_Proc SetWindowTheme_fn = NULL; -DwmSetWindowAttribute_Proc DwmSetWindowAttribute_fn = NULL; -WTSUnRegisterSessionNotification_Proc WTSUnRegisterSessionNotification_fn = NULL; -WTSRegisterSessionNotification_Proc WTSRegisterSessionNotification_fn = NULL; -RegisterTouchWindow_proc RegisterTouchWindow_fn = NULL; -SetGestureConfig_proc SetGestureConfig_fn = NULL; +static SetWindowTheme_Proc SetWindowTheme_fn = NULL; +static DwmSetWindowAttribute_Proc DwmSetWindowAttribute_fn = NULL; +static WTSUnRegisterSessionNotification_Proc WTSUnRegisterSessionNotification_fn = NULL; +static WTSRegisterSessionNotification_Proc WTSRegisterSessionNotification_fn = NULL; +static RegisterTouchWindow_proc RegisterTouchWindow_fn = NULL; +static SetGestureConfig_proc SetGestureConfig_fn = NULL; extern AppendMenuW_Proc unicode_append_menu; @@ -312,7 +314,7 @@ int w32_minor_version; int w32_build_number; /* If the OS is set to use dark mode. */ -BOOL w32_darkmode = FALSE; +static BOOL w32_darkmode = FALSE; /* Distinguish between Windows NT and Windows 95. */ int os_subtype; @@ -574,7 +576,7 @@ typedef struct colormap_t COLORREF colorref; } colormap_t; -colormap_t w32_color_map[] = +static colormap_t w32_color_map[] = { {"snow" , PALETTERGB (255,250,250)}, {"ghost white" , PALETTERGB (248,248,255)}, @@ -3816,7 +3818,7 @@ w32_msg_pump (deferred_msg * msg_buf) } } -deferred_msg * deferred_msg_head; +static deferred_msg * deferred_msg_head; static deferred_msg * find_deferred_msg (HWND hwnd, UINT msg) @@ -7356,7 +7358,7 @@ static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object, Lisp_Object, int, int, int *, int *); /* The frame of the currently visible tooltip. */ -Lisp_Object tip_frame; +static Lisp_Object tip_frame; /* The window-system window corresponding to the frame of the currently visible tooltip. */ @@ -7364,16 +7366,16 @@ Window tip_window; /* A timer that hides or deletes the currently visible tooltip when it fires. */ -Lisp_Object tip_timer; +static Lisp_Object tip_timer; /* STRING argument of last `x-show-tip' call. */ -Lisp_Object tip_last_string; +static Lisp_Object tip_last_string; /* Normalized FRAME argument of last `x-show-tip' call. */ -Lisp_Object tip_last_frame; +static Lisp_Object tip_last_frame; /* PARMS argument of last `x-show-tip' call. */ -Lisp_Object tip_last_parms; +static Lisp_Object tip_last_parms; static void @@ -10901,7 +10903,7 @@ w32_get_resource (const char *key, const char *name, LPDWORD lpdwtype) ***********************************************************************/ typedef BOOL (WINAPI * SystemParametersInfoW_Proc) (UINT,UINT,PVOID,UINT); -SystemParametersInfoW_Proc system_parameters_info_w_fn = NULL; +static SystemParametersInfoW_Proc system_parameters_info_w_fn = NULL; DEFUN ("w32-set-wallpaper", Fw32_set_wallpaper, Sw32_set_wallpaper, 1, 1, 0, doc: /* Set the desktop wallpaper image to IMAGE-FILE. */) diff --git a/src/w32heap.c b/src/w32heap.c index f767e5781bf..035dee15f3c 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -87,14 +87,14 @@ typedef struct _RTL_HEAP_PARAMETERS { } RTL_HEAP_PARAMETERS, *PRTL_HEAP_PARAMETERS; /* Info for keeping track of our dynamic heap used after dumping. */ -unsigned char *data_region_base = NULL; -unsigned char *data_region_end = NULL; +static unsigned char *data_region_base = NULL; +static unsigned char *data_region_end = NULL; /* Handle for the private heap: - inside the dumped_data[] array before dump with unexec, - outside of it after dump, or always if pdumper is used. */ -HANDLE heap = NULL; +static HANDLE heap = NULL; /* We redirect the standard allocation functions. */ malloc_fn the_malloc_fn; diff --git a/src/w32inevt.c b/src/w32inevt.c index 9e3c3a75446..615f162a210 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -72,6 +72,7 @@ w32_read_console_input (HANDLE h, INPUT_RECORD *rec, DWORD recsize, } /* Set by w32_console_toggle_lock_key. */ +extern int faked_key; int faked_key; static int diff --git a/src/w32menu.c b/src/w32menu.c index df38c41b0f2..f35712f07f4 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -141,15 +141,17 @@ typedef HRESULT (WINAPI *TaskDialogIndirect_Proc) ( OUT BOOL *pfVerificationFlagChecked); #ifdef NTGUI_UNICODE -GetMenuItemInfoA_Proc get_menu_item_info = GetMenuItemInfoA; -SetMenuItemInfoA_Proc set_menu_item_info = SetMenuItemInfoA; +static GetMenuItemInfoA_Proc get_menu_item_info = GetMenuItemInfoA; +static SetMenuItemInfoA_Proc set_menu_item_info = SetMenuItemInfoA; +extern AppendMenuW_Proc unicode_append_menu; AppendMenuW_Proc unicode_append_menu = AppendMenuW; -MessageBoxW_Proc unicode_message_box = MessageBoxW; +static MessageBoxW_Proc unicode_message_box = MessageBoxW; #else /* !NTGUI_UNICODE */ -GetMenuItemInfoA_Proc get_menu_item_info = NULL; -SetMenuItemInfoA_Proc set_menu_item_info = NULL; +static GetMenuItemInfoA_Proc get_menu_item_info = NULL; +static SetMenuItemInfoA_Proc set_menu_item_info = NULL; +extern AppendMenuW_Proc unicode_append_menu; AppendMenuW_Proc unicode_append_menu = NULL; -MessageBoxW_Proc unicode_message_box = NULL; +static MessageBoxW_Proc unicode_message_box = NULL; #endif /* NTGUI_UNICODE */ static TaskDialogIndirect_Proc task_dialog_indirect; diff --git a/src/w32proc.c b/src/w32proc.c index 77042149f96..d3c11b70f39 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1795,8 +1795,8 @@ msg_wait_for_objects (DWORD nCount, HANDLE *lpHandles, #define _P_NOWAIT 1 /* Child process management list. */ -int child_proc_count = 0; -child_process child_procs[ MAX_CHILDREN ]; +static int child_proc_count = 0; +static child_process child_procs[ MAX_CHILDREN ]; static DWORD WINAPI reader_thread (void *arg); @@ -4293,7 +4293,7 @@ int_from_hex (char * s) /* We need to build a global list, since the EnumSystemLocale callback function isn't given a context pointer. */ -Lisp_Object Vw32_valid_locale_ids; +static Lisp_Object Vw32_valid_locale_ids; static BOOL CALLBACK ALIGN_STACK enum_locale_fn (LPTSTR localeNum) @@ -4357,7 +4357,7 @@ If successful, the new locale id is returned, otherwise nil. */) /* We need to build a global list, since the EnumCodePages callback function isn't given a context pointer. */ -Lisp_Object Vw32_valid_codepages; +static Lisp_Object Vw32_valid_codepages; static BOOL CALLBACK ALIGN_STACK enum_codepage_fn (LPTSTR codepageNum) diff --git a/src/w32term.c b/src/w32term.c index 7ffa370c4cc..b69700a5dd2 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -119,10 +119,10 @@ typedef struct tagGLYPHSET #endif /* compiling for pre-Win2k */ /* Dynamic linking to SetLayeredWindowAttribute (only since 2000). */ -BOOL (WINAPI *pfnSetLayeredWindowAttributes) (HWND, COLORREF, BYTE, DWORD); +static BOOL (WINAPI *pfnSetLayeredWindowAttributes) (HWND, COLORREF, BYTE, DWORD); /* PlgBlt is available since Windows 2000. */ -BOOL (WINAPI *pfnPlgBlt) (HDC, const POINT *, HDC, int, int, int, int, HBITMAP, int, int); +static BOOL (WINAPI *pfnPlgBlt) (HDC, const POINT *, HDC, int, int, int, int, HBITMAP, int, int); /* Define required types and constants on systems with older headers lest they be absent. */ @@ -160,8 +160,8 @@ typedef struct _TOUCHINPUT typedef BOOL (WINAPI * CloseTouchInputHandle_proc) (HANDLE); typedef BOOL (WINAPI * GetTouchInputInfo_proc) (HANDLE, UINT, PTOUCHINPUT, int); -CloseTouchInputHandle_proc pfnCloseTouchInputHandle; -GetTouchInputInfo_proc pfnGetTouchInputInfo; +static CloseTouchInputHandle_proc pfnCloseTouchInputHandle; +static GetTouchInputInfo_proc pfnGetTouchInputInfo; #ifndef LWA_ALPHA #define LWA_ALPHA 0x02 @@ -194,14 +194,14 @@ HANDLE hWindowsThread = NULL; DWORD dwMainThreadId = 0; HANDLE hMainThread = NULL; -int vertical_scroll_bar_min_handle; -int horizontal_scroll_bar_min_handle; -int vertical_scroll_bar_top_border; -int vertical_scroll_bar_bottom_border; -int horizontal_scroll_bar_left_border; -int horizontal_scroll_bar_right_border; +static int vertical_scroll_bar_min_handle; +static int horizontal_scroll_bar_min_handle; +static int vertical_scroll_bar_top_border; +static int vertical_scroll_bar_bottom_border; +static int horizontal_scroll_bar_left_border; +static int horizontal_scroll_bar_right_border; -int last_scroll_bar_drag_pos; +static int last_scroll_bar_drag_pos; /* Keyboard code page - may be changed by language-change events. */ int w32_keyboard_codepage; diff --git a/src/w32term.h b/src/w32term.h index 8b3b661dc2a..c6a51857d15 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -271,6 +271,7 @@ extern const char *w32_get_string_resource (void *v_rdb, const char *class); /* w32fns.c */ +extern frame_parm_handler w32_frame_parm_handlers[]; extern void w32_default_font_parameter (struct frame* f, Lisp_Object parms); extern Lisp_Object w32_process_dnd_data (int format, void *pDataObj); diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index b412be6f2e1..485c612d182 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -44,6 +44,7 @@ along with GNU Emacs. If not, see . */ #include "pdumper.h" #include "w32common.h" +extern int uniscribe_available; int uniscribe_available = 0; /* EnumFontFamiliesEx callback. */ @@ -53,6 +54,7 @@ static int CALLBACK ALIGN_STACK add_opentype_font_name_to_list (ENUMLOGFONTEX *, #ifdef HAVE_HARFBUZZ struct font_driver harfbuzz_font_driver; +extern int harfbuzz_available; int harfbuzz_available = 0; /* Typedefs for HarfBuzz functions which we call through function @@ -811,9 +813,9 @@ typedef HRESULT (WINAPI *ScriptGetFontLanguageTags_Proc) typedef HRESULT (WINAPI *ScriptGetFontFeatureTags_Proc) (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, OPENTYPE_TAG, OPENTYPE_TAG, int, OPENTYPE_TAG *, int *); -ScriptGetFontScriptTags_Proc script_get_font_scripts_fn; -ScriptGetFontLanguageTags_Proc script_get_font_languages_fn; -ScriptGetFontFeatureTags_Proc script_get_font_features_fn; +static ScriptGetFontScriptTags_Proc script_get_font_scripts_fn; +static ScriptGetFontLanguageTags_Proc script_get_font_languages_fn; +static ScriptGetFontFeatureTags_Proc script_get_font_features_fn; static bool uniscribe_new_apis; diff --git a/src/w32xfns.c b/src/w32xfns.c index 09ca77ae01f..db4e9fb6249 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c @@ -50,7 +50,8 @@ CRITICAL_SECTION critsect; extern HANDLE keyboard_handle; #endif /* WINDOWSNT */ -HANDLE input_available = NULL; +static HANDLE input_available = NULL; +extern HANDLE interrupt_handle; HANDLE interrupt_handle = NULL; void @@ -265,9 +266,9 @@ typedef struct int_msg struct int_msg *lpNext; } int_msg; -int_msg *lpHead = NULL; -int_msg *lpTail = NULL; -int nQueue = 0; +static int_msg *lpHead = NULL; +static int_msg *lpTail = NULL; +static int nQueue = 0; BOOL get_next_msg (W32Msg * lpmsg, BOOL bWait) diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index cdb3305ae14..b60e8471d87 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -18,10 +18,10 @@ # GNU Emacs support for the GitLab-specific build of Docker images. # The presence of this file does not imply any FSF/GNU endorsement of -# Docker or any other particular tool. Also, it is intended for -# evaluation purposes, thus possibly temporary. +# Docker or any other particular tool. -# Maintainer: Ted Zlatanov +# Author: Ted Zlatanov +# Maintainer: Michael Albinus # URL: https://emba.gnu.org/emacs/emacs FROM debian:bookworm as emacs-base @@ -123,12 +123,14 @@ RUN make -j `nproc` bootstrap RUN mkdir -p /root/.emacs.d/tree-sitter RUN git config --global http.sslverify "false" # See https://github.com/emacs-tree-sitter/tree-sitter-langs/tree/master/repos -# The recommended versions are generated by 'treesit-admin-verify-major-mode-queries' -# at the beginning of every ts-mode file. Loading a ts-mode file adds its -# grammar source to 'treesit-language-source-alist'. +# The recommended versions are generated by +# 'treesit-admin-verify-major-mode-queries' at the beginning of every +# ts-mode file. Loading a ts-mode file adds its grammar source to +# 'treesit-language-source-alist'. RUN src/emacs -Q --batch \ --eval '(message "library ABI min version %d max version %d" \ (treesit-library-abi-version t) (treesit-library-abi-version))' \ + --eval '(message "\nInstalling grammars\n===================")' \ --eval '(setq treesit-extra-load-path (list "/root/.emacs.d/tree-sitter"))' \ --eval '(dolist (feature (quote (c-ts-mode cmake-ts-mode csharp-mode \ dockerfile-ts-mode elixir-ts-mode heex-ts-mode go-ts-mode java-ts-mode \ @@ -137,13 +139,21 @@ RUN src/emacs -Q --batch \ toml-ts-mode yaml-ts-mode treesit-x))) (require feature))' \ --eval '(dolist (lang (mapcar (quote car) treesit-language-source-alist)) \ (treesit-install-language-grammar lang "/root/.emacs.d/tree-sitter"))' \ - --eval '(message "treesit-language-source-alist\n%s" \ - (pp-to-string treesit-language-source-alist))' \ - --eval '(dolist (lang (sort (mapcar (quote car) treesit-language-source-alist))) \ - (message "%s ABI version %d" lang (treesit-language-abi-version lang)))' \ + --eval '(message "\ntreesit-language-source-alist")' \ + --eval '(message "=============================")' \ + --eval '(message "%s" (pp-to-string treesit-language-source-alist))' \ + --eval '(message "ABI versions\n============")' \ + --eval \ + '(dolist (lang (sort (mapcar (quote car) treesit-language-source-alist))) \ + (message "%s ABI version %d" lang (treesit-language-abi-version lang)))' \ -l admin/tree-sitter/treesit-admin.el \ - --eval '(setq treesit-admin--builtin-language-sources treesit-language-source-alist)' \ + --eval '(setq treesit-admin--builtin-language-sources \ + treesit-language-source-alist)' \ + --eval '(message "\ntreesit-admin-check-manual-coverage")' \ + --eval '(message "===================================")' \ -f treesit-admin-check-manual-coverage \ + --eval '(message "\ntreesit-admin--generate-compatibility-report")' \ + --eval '(message "============================================")' \ --eval '(treesit-admin--generate-compatibility-report \ (list (expand-file-name "src/emacs")) treesit-admin--builtin-modes \ (expand-file-name "compatibility-report.html"))' @@ -184,7 +194,8 @@ COPY . /checkout WORKDIR /checkout RUN ./autogen.sh autoconf RUN ./configure --with-native-compilation -RUN make -j `nproc` bootstrap BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 1)"' +RUN make -j `nproc` bootstrap \ + BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 1)"' FROM emacs-native-comp as emacs-native-comp-speed2 diff --git a/test/infra/Makefile.in b/test/infra/Makefile.in index 579b5f86a49..cbd932e7fcd 100644 --- a/test/infra/Makefile.in +++ b/test/infra/Makefile.in @@ -124,7 +124,8 @@ tree-sitter-files: @echo '.tree-sitter-files:' >>$(FILE) @echo ' variables:' >>$(FILE) @echo ' tree_sitter_files: >-' >>$(FILE) - @for name in $(TREE-SITTER-FILES) ; do echo " $${name}" >>$(FILE) ; done + @for name in $(TREE-SITTER-FILES) ; \ + do echo " $${name}" >>$(FILE) ; done $(FILE): $(AM_V_GEN) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 114edea6b37..9db0b91a6c4 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -18,10 +18,10 @@ # GNU Emacs support for the GitLab protocol for CI. # The presence of this file does not imply any FSF/GNU endorsement of -# any particular service that uses that protocol. Also, it is intended for -# evaluation purposes, thus possibly temporary. +# any particular service that uses that protocol. -# Maintainer: Ted Zlatanov +# Author: Ted Zlatanov +# Maintainer: Michael Albinus # URL: https://emba.gnu.org/emacs/emacs # Never run merge request pipelines, they usually duplicate push pipelines @@ -67,7 +67,8 @@ default: before_script: - docker info - echo "docker registry is ${CI_REGISTRY}" - - docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} ${CI_REGISTRY} + - 'docker login + -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} ${CI_REGISTRY}' .job-template: variables: @@ -93,7 +94,8 @@ default: -e http_proxy=${http_proxy} -e https_proxy=${https_proxy} -e no_proxy=${no_proxy} - --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro + --volumes-from + $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -xvc @@ -107,15 +109,20 @@ default: after_script: # - docker ps -a # - pwd; printenv - # - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - ) # Prepare test artifacts. - - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} - - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/configure.log ${test_name} || true - - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/compatibility-report.html ${test_name} || true - - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} - - find ${test_name} ! \( -name "*.log" -o -name ${EMACS_TEST_JUNIT_REPORT} -o -name compatibility-report.html \) -type f -delete + - 'test -n "$(docker ps -aq -f name=${test_name})" && + docker cp ${test_name}:checkout/test ${test_name}' + - 'test -n "$(docker ps -aq -f name=${test_name})" && + docker cp ${test_name}:checkout/config.log ${test_name} || true' + - 'test -n "$(docker ps -aq -f name=${test_name})" && + docker cp ${test_name}:checkout/compatibility-report.html ${test_name} || + true' + - 'test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name}' + - 'find ${test_name} + ! \( -name "*.log" -o -name ${EMACS_TEST_JUNIT_REPORT} -o + -name compatibility-report.html \) -type f -delete' # BusyBox find does not know -empty. - - find ${test_name} -type d -depth -exec rmdir {} + 2>/dev/null + - 'find ${test_name} -type d -depth -exec rmdir {} + 2>/dev/null' .build-template: needs: [] @@ -147,8 +154,10 @@ default: - src/macfont.{h,m} when: never script: - - docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba . - - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} + - 'docker build --pull --target ${target} + -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} + -f test/infra/Dockerfile.emba .' + - 'docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG}' .test-template: cache: @@ -293,8 +302,8 @@ test-filenotify-gio: # This is needed in order to get a JUnit test report. make_params: >- check-expensive - TEST_HOME=/root - LOGFILES="lisp/autorevert-tests.log lisp/filenotify-tests.log" + TEST_HOME=/root + LOGFILES="lisp/autorevert-tests.log lisp/filenotify-tests.log" build-image-eglot: stage: platform-images @@ -312,10 +321,10 @@ test-eglot: target: emacs-eglot # This is needed in order to get a JUnit test report. make_params: >- - check-expensive - TEST_HOME=/root LOGFILES="lisp/progmodes/eglot-tests.log" - # EMACS_EXTRAOPT="--eval \(use-package\ company\ :ensure\ t\) - # --eval \(use-package\ yasnippet\ :ensure\ t\)" + check-expensive TEST_HOME=/root LOGFILES="lisp/progmodes/eglot-tests.log" + + # EMACS_EXTRAOPT="--eval \(use-package\ company\ :ensure\ t\) + # --eval \(use-package\ yasnippet\ :ensure\ t\)" build-image-tree-sitter: stage: platform-images diff --git a/test/lisp/ansi-osc-tests.el b/test/lisp/ansi-osc-tests.el index d2fb130e518..d083626f3f9 100644 --- a/test/lisp/ansi-osc-tests.el +++ b/test/lisp/ansi-osc-tests.el @@ -30,8 +30,7 @@ (require 'ert) (defvar ansi-osc-tests--strings - `( - ("Hello World" "Hello World") + `(("Hello World" "Hello World") ;; window title ("Buffer \e]2;A window title\e\\content" "Buffer content") @@ -44,6 +43,10 @@ ;; hyperlink ("\e]8;;http://example.com\e\\This is a link\e]8;;\e\\" "This is a link") + + ;; multiple sequences + ("Escape \e]2;A window title\e\\sequence followed by \e]2;unfinished sequence" + "Escape sequence followed by \e]2;unfinished sequence") )) ;; Don't output those strings to stdout since they may have ;; side-effects on the environment @@ -54,4 +57,44 @@ (with-temp-buffer (insert input) (ansi-osc-apply-on-region (point-min) (point-max)) - (should (equal (buffer-string) text)))))) + (should (equal + (buffer-substring-no-properties + (point-min) (point-max)) + text)))))) + +(ert-deftest ansi-osc-tests-apply-region-no-handlers-multiple-calls () + (let ((ansi-osc-handlers nil)) + (with-temp-buffer + (insert + (concat "First set the window title \e]2;A window title\e\\" + "then change it\e]2;Another ")) + (ansi-osc-apply-on-region (point-min) (point-max)) + (let ((pos (point))) + (insert "title\e\\, and stop.") + (ansi-osc-apply-on-region pos (point-max))) + (should + (equal + (buffer-substring-no-properties (point-min) (point-max)) + "First set the window title then change it, and stop."))))) + +(ert-deftest ansi-osc-tests-filter-region () + (pcase-dolist (`(,input ,text) ansi-osc-tests--strings) + (with-temp-buffer + (insert input) + (ansi-osc-filter-region (point-min) (point-max)) + (should (equal (buffer-string) text))))) + + +(ert-deftest ansi-osc-tests-filter-region-with-multiple-calls () + (with-temp-buffer + (insert + (concat "First set the window title \e]2;A window title\e\\" + "then change it\e]2;Another ")) + (ansi-osc-filter-region (point-min) (point-max)) + (let ((pos (point))) + (insert "title\e\\, and stop.") + (ansi-osc-filter-region pos (point-max))) + (should + (equal + (buffer-string) + "First set the window title then change it, and stop.")))) diff --git a/test/lisp/cedet/semantic-utest-ia.el b/test/lisp/cedet/semantic-utest-ia.el index 7626cc06236..99380d72e09 100644 --- a/test/lisp/cedet/semantic-utest-ia.el +++ b/test/lisp/cedet/semantic-utest-ia.el @@ -141,7 +141,8 @@ (semantic-src-utest-buffer-refs)) (kill-buffer b) - )))) + ))) + (semantic-mode -1)) (defun semantic-ia-utest-buffer () "Run analyzer completion unit-test pass in the current buffer." diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el index 20ef01acd95..6b6cc7256ec 100644 --- a/test/lisp/comint-tests.el +++ b/test/lisp/comint-tests.el @@ -50,6 +50,10 @@ "Enter encryption key: (repeat) " ; ccrypt "Enter Auth Password:" ; OpenVPN (Bug#35724) "Verify password: " ; zip -e zipfile.zip ... (Bug#47209) + "Vault password: " ; ansible-playbook --ask-vault-pass ... (Bug#78442) + "Vault password (dev): " ; ansible-playbook --vault-id dev@prompt ... (Bug#78442) + "SSH password: " ; ansible-playbook --ask-pass playbook.yml ... (Bug#78442) + "BECOME password: " ; ansible-playbook --ask-become-pass ... (Bug#78442) "Mot de Passe :" ; localized (Bug#29729) "Passwort:") ; localized "List of strings that should match `comint-password-prompt-regexp'.") diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 8b0c1dad4c0..d1f272f7a4d 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1357,6 +1357,20 @@ byte-compiled. Run with dynamic binding." (concat ";;; -*-lexical-binding:nil-*-\n" some-code))) (should (cookie-warning some-code)))))) +(defun bytecomp-tests--f (x y &optional u v) (list x y u v)) + +(ert-deftest bytecomp-tests--warn-arity-noncompiled-callee () + "Check that calls to non-compiled functions are arity-checked (bug#78685)" + (should (not (compiled-function-p (symbol-function 'bytecomp-tests--f)))) + (let* ((source (concat ";;; -*-lexical-binding:t-*-\n" + "(defun my-fun () (bytecomp-tests--f 11))\n")) + (lexical-binding t) + (log (bytecomp-tests--log-from-compilation source))) + (should (string-search + (concat "Warning: `bytecomp-tests--f' called with 1 argument," + " but requires 2-4") + log)))) + (ert-deftest bytecomp-tests--unescaped-char-literals () "Check that byte compiling warns about unescaped character literals (Bug#20852)." diff --git a/test/lisp/emacs-lisp/ert-resources/erts-fail.erts b/test/lisp/emacs-lisp/ert-resources/erts-fail.erts new file mode 100644 index 00000000000..12d73454f7b --- /dev/null +++ b/test/lisp/emacs-lisp/ert-resources/erts-fail.erts @@ -0,0 +1,7 @@ +Name: fail + +=-= +FOO +=-= +BAR +=-=-= diff --git a/test/lisp/emacs-lisp/ert-resources/erts-pass.erts b/test/lisp/emacs-lisp/ert-resources/erts-pass.erts new file mode 100644 index 00000000000..6f98150d4d9 --- /dev/null +++ b/test/lisp/emacs-lisp/ert-resources/erts-pass.erts @@ -0,0 +1,7 @@ +Name: pass + +=-= +FOO +=-= +FOO +=-=-= diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 52a256db9d1..5ffdf5dcb80 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -1036,6 +1036,17 @@ F failing-test (ert-with-test-buffer (:name "foo" :selected t) (buffer-name))))) +(ert-deftest ert-test-erts-pass () + "Test that `ert-test-erts-file' reports test case passed." + (ert-test-erts-file (ert-resource-file "erts-pass.erts") + (lambda () ()))) + +(ert-deftest ert-test-erts-fail () + "Test that `ert-test-erts-file' reports test case failed." + (should-error (ert-test-erts-file (ert-resource-file "erts-fail.erts") + (lambda () ())) + :type 'ert-test-failed)) + (ert-deftest ert-test-erts-skip-one () "Test that Skip does not affect subsequent test cases (Bug#76839)." (should-error (ert-test-erts-file (ert-resource-file "erts-skip-one.erts") diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index 1ef6bc864a7..d7cdaa3b331 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -212,21 +212,7 @@ (goto-char (point-min)) (should-error (forward-sexp)))) ;; FIXME: Shouldn't be an error. -;; Test some core Elisp rules. -(defvar c-e-x) -(ert-deftest core-elisp-tests-1-defvar-in-let () - "Test some core Elisp rules." - (with-temp-buffer - ;; Check that when defvar is run within a let-binding, the toplevel default - ;; is properly initialized. - (should (equal (list (let ((c-e-x 1)) (defvar c-e-x 2) c-e-x) c-e-x) - '(1 2))) - (should (equal (list (let ((c-e-x 1)) - (defcustom c-e-x 2 "doc" :group 'blah :type 'integer) c-e-x) - c-e-x) - '(1 2))))) - -(ert-deftest core-elisp-tests-2-window-configurations () +(ert-deftest core-elisp-tests-1-window-configurations () "Test properties of window-configurations." (let ((wc (current-window-configuration))) (with-current-buffer (window-buffer (frame-selected-window)) @@ -235,40 +221,10 @@ (set-window-configuration wc) (should (or (not mark-active) (mark))))) -(ert-deftest core-elisp-tests-3-backquote () +;; For variable binding tests, see src/data-tests.el. +(ert-deftest core-elisp-tests-2-backquote () (should (eq 3 (eval ``,,'(+ 1 2) t)))) -(defvar-local c-e-l 'foo) -(ert-deftest core-elisp-tests-4-toplevel-values () - (setq-default c-e-l 'foo) - (let ((c-e-l 'bar)) - (let ((c-e-l 'baz)) - (setq-default c-e-l 'bar) - (should (eq c-e-l 'bar)) - (should (eq (default-toplevel-value 'c-e-l) 'foo)) - (set-default-toplevel-value 'c-e-l 'baz) - (should (eq c-e-l 'bar)) - (should (eq (default-toplevel-value 'c-e-l) 'baz)))) - (let ((c-e-u 'foo)) - (should (condition-case _ - (default-toplevel-value 'c-e-u) - (void-variable t)))) - (with-temp-buffer - (setq-local c-e-l 'bar) - (should (eq (buffer-local-toplevel-value 'c-e-l) 'bar)) - (let ((c-e-l 'baz)) - (let ((c-e-l 'quux)) - (setq-local c-e-l 'baz) - (should (eq c-e-l 'baz)) - (should (eq (buffer-local-toplevel-value 'c-e-l) 'bar)) - (set-buffer-local-toplevel-value 'c-e-l 'foo) - (should (eq c-e-l 'baz)) - (should (eq (buffer-local-toplevel-value 'c-e-l) 'foo))))) - (with-temp-buffer - (should (condition-case _ - (buffer-local-toplevel-value 'c-e-l) - (void-variable t))))) - ;; Test up-list and backward-up-list. (defun lisp-run-up-list-test (fn data start instructions) (cl-labels ((posof (thing) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 349abdc44c9..f67a33467de 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -67,6 +67,7 @@ (require 'vc-git) (require 'vc-hg) +(declare-function project-mode-line-format "project") (declare-function tramp-check-remote-uname "tramp-sh") (declare-function tramp-find-executable "tramp-sh") (declare-function tramp-get-remote-chmod-h "tramp-sh") @@ -89,6 +90,7 @@ (defvar tramp-use-connection-share) ;; Declared in Emacs 30.1. +(defvar project-mode-line) (defvar remote-file-name-access-timeout) (defvar remote-file-name-inhibit-delete-by-moving-to-trash) @@ -278,9 +280,10 @@ being the result.") (| "rclone" "sshfs") ".") (file-name-nondirectory file))) (tramp--test-message "Delete %s" file) - (if (file-directory-p file) - (delete-directory file 'recursive) - (delete-file file)))))) + (ignore-errors ;; Wrong permissions? + (if (file-directory-p file) + (delete-directory file 'recursive) + (delete-file file))))))) ;; Cleanup connection. (tramp-cleanup-connection tramp-test-vec nil 'keep-password)) @@ -3761,11 +3764,7 @@ This tests also `access-file', `file-readable-p', (tmp-name2 (tramp--test-make-temp-name nil quoted)) ;; File name with "//". (tmp-name3 - (format - "%s%s" - (file-remote-p tmp-name1) - (replace-regexp-in-string - "/" "//" (file-remote-p tmp-name1 'localname)))) + (replace-regexp-in-string "/" "//" (file-local-name tmp-name1))) ;; `file-ownership-preserved-p' is implemented only in tramp-sh.el. (test-file-ownership-preserved-p (tramp--test-sh-p)) attr) @@ -3887,28 +3886,13 @@ This tests also `access-file', `file-readable-p', ;; symlinked files to a non-existing or cyclic target. (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name2 'group))) - (delete-file tmp-name2))) + (delete-file tmp-name2)) - ;; Check, that "//" in symlinks are handled properly. - (with-temp-buffer - (let ((default-directory ert-remote-temporary-file-directory)) - (shell-command - (format - "ln -s %s %s" - (tramp-file-name-localname - (tramp-dissect-file-name tmp-name3)) - (tramp-file-name-localname - (tramp-dissect-file-name tmp-name2))) - t))) - (when (file-symlink-p tmp-name2) + ;; Check, that "//" in symlinks are handled properly. + (make-symbolic-link tmp-name3 tmp-name2) + (should (file-symlink-p tmp-name2)) (setq attr (file-attributes tmp-name2)) - (should - (string-equal - (file-attribute-type attr) - (funcall - (if (tramp--test-sshfs-p) #'file-name-nondirectory #'identity) - (tramp-file-name-localname - (tramp-dissect-file-name tmp-name3))))) + (should (string-equal (file-attribute-type attr) tmp-name3)) (delete-file tmp-name2)) (when test-file-ownership-preserved-p @@ -5164,7 +5148,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; (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)))) + (tramp-change-syntax orig-syntax) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))) (defun tramp--test-split-on-boundary (s) "Return completion boundaries for string S." @@ -5177,15 +5162,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; boundaries are always incorrect before that. (skip-unless (tramp--test-emacs31-p)) - (should (equal (tramp--test-split-on-boundary "/ssh:user@host:foo") - '("/ssh:user@host:" . "foo"))) - (should (equal (tramp--test-split-on-boundary "/ssh:user@host:/~/foo") - '("/ssh:user@host:/~/" . "foo"))) - (should (equal (tramp--test-split-on-boundary "/ssh:user@host:/usr//usr/foo") - '("/ssh:user@host:/usr//usr/" . "foo"))) - (should (equal (tramp--test-split-on-boundary - "/ssh:user@host:/ssh:user@host://usr/foo") - '("/ssh:user@host:/ssh:user@host://usr/" . "foo")))) + (let ((remote (file-remote-p ert-remote-temporary-file-directory))) + (dolist + (file `(,remote ,(concat remote "/~/") + ,(concat remote "/usr//usr/") ,(concat remote remote "//usr/"))) + (should (equal (tramp--test-split-on-boundary (concat file "foo")) + `(,file . "foo")))))) (ert-deftest tramp-test27-load () "Check `load'." @@ -6511,6 +6493,7 @@ INPUT, if non-nil, is a string sent to the process." (file-remote-p default-directory 'localname))) ;; The shell "sh" shall always exist. (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. @@ -6539,19 +6522,19 @@ INPUT, if non-nil, is a string sent to the process." (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) - (let* ((tmp-name (tramp--test-make-temp-name)) + (let* ((tmp-name1 (tramp--test-make-temp-name)) (default-directory ert-remote-temporary-file-directory) (orig-exec-path (exec-path)) (tramp-remote-path tramp-remote-path) (orig-tramp-remote-path tramp-remote-path) - path) + tmp-name2 path) ;; The "flatpak" method modifies `tramp-remote-path'. (skip-unless (not (tramp-compat-connection-local-p tramp-remote-path))) (unwind-protect (progn ;; Non existing directories are removed. (setq tramp-remote-path - (cons (file-remote-p tmp-name 'localname) tramp-remote-path)) + (cons (file-remote-p tmp-name1 'localname) tramp-remote-path)) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (should (equal (exec-path) orig-exec-path)) (setq tramp-remote-path orig-tramp-remote-path) @@ -6564,11 +6547,11 @@ INPUT, if non-nil, is a string sent to the process." ;; We make a super long `tramp-remote-path'. (unless (tramp--test-container-oob-p) - (make-directory tmp-name) - (should (file-directory-p tmp-name)) + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) (while (length< (string-join orig-exec-path ":") 5000) (let ((dir (make-temp-file - (file-name-as-directory tmp-name) 'dir))) + (file-name-as-directory tmp-name1) 'dir))) (should (file-directory-p dir)) (setq tramp-remote-path (append @@ -6591,12 +6574,33 @@ INPUT, if non-nil, is a string sent to the process." (should (string-equal path (string-join (butlast orig-exec-path) ":")))) ;; The shell "sh" shall always exist. - (should (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. + (setq tmp-name2 + (expand-file-name + "foo" + (concat (file-remote-p default-directory) + (car (last orig-exec-path 2))))) + (write-region "foo" nil tmp-name2) + (should (file-exists-p tmp-name2)) + + (set-file-modes tmp-name2 #o777) + (should (file-executable-p tmp-name2)) + (should + (string-equal + (executable-find (file-name-nondirectory tmp-name2) 'remote) + (file-remote-p tmp-name2 'localname))) + (should-not + (executable-find + (concat (file-name-nondirectory tmp-name2) "foo") 'remote)))) ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (setq tramp-remote-path orig-tramp-remote-path) - (ignore-errors (delete-directory tmp-name 'recursive))))) + (setq tramp-remote-path orig-tramp-remote-path)))) (tramp--test-deftest-direct-async-process tramp-test35-remote-path) @@ -8372,8 +8376,52 @@ process sentinels. They shall not disturb each other." ;; Cleanup. (tramp-cleanup-connection tramp-test-vec 'keep-debug)) +;; This test is inspired by Bug#78572. +(ert-deftest tramp-test48-session-timeout () + "Check that Tramp handles a session timeout properly." + (skip-unless (tramp--test-enabled)) + (skip-unless + (tramp-get-method-parameter tramp-test-vec 'tramp-session-timeout)) + + ;; We want to see the timeout message. + (tramp--test-instrument-test-case 3 + (let ((remote-file-name-inhibit-cache t) + (tmp-name (tramp--test-make-temp-name))) + (unwind-protect + (progn + (should-not (file-exists-p tmp-name)) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + + (tramp-timeout-session tramp-test-vec) + (should (file-exists-p tmp-name)) + (should (directory-files (file-name-directory tmp-name))) + + ;; `project-mode-line' was introduced in Emacs 30.1. + (when (boundp 'project-mode-line) + (require 'project) + (ert-with-message-capture captured-messages + (let ((project-mode-line t)) + (with-temp-buffer + (set-visited-file-name tmp-name) + (insert "foo") + (should (buffer-modified-p)) + (tramp-timeout-session tramp-test-vec) + ;; This calls `file-directory-p' and + ;; `directory-files'. Shouldn't raise an error when + ;; not connected. + (project-mode-line-format) + ;; Steal the file lock. + (cl-letf (((symbol-function #'ask-user-about-lock) #'always)) + (save-buffer))) + (should-not + (string-match-p "File is missing:" captured-messages)))))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) + ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test48-auto-load () +(ert-deftest tramp-test49-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. @@ -8398,7 +8446,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test48-delay-load () +(ert-deftest tramp-test49-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 @@ -8428,7 +8476,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-test48-recursive-load () +(ert-deftest tramp-test49-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -8452,7 +8500,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test48-remote-load-path () +(ert-deftest tramp-test49-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 @@ -8477,7 +8525,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test49-without-remote-files () +(ert-deftest tramp-test50-without-remote-files () "Check that Tramp can be suppressed." (skip-unless (tramp--test-enabled)) @@ -8492,7 +8540,7 @@ process sentinels. They shall not disturb each other." (setq tramp-mode t) (should (file-remote-p ert-remote-temporary-file-directory))) -(ert-deftest tramp-test50-unload () +(ert-deftest tramp-test51-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index b12e5d0b2d4..4a25d5a5655 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -34,392 +34,405 @@ '(;; absoft (absoft "Error on line 3 of t.f: Execution error unclassifiable statement" - 1 nil 3 "t.f") + 1 nil 3 "t.f" error) (absoft "Line 45 of \"foo.c\": bloofle undefined" - 1 nil 45 "foo.c") + 1 nil 45 "foo.c" error) (absoft "error on line 19 of fplot.f: spelling error?" - 1 nil 19 "fplot.f") + 1 nil 19 "fplot.f" error) (absoft "warning on line 17 of fplot.f: data type is undefined for variable d" - 1 nil 17 "fplot.f") + 1 nil 17 "fplot.f" warning) ;; Ada & Mpatrol (gnu "foo.adb:61:11: [...] in call to size declared at foo.ads:11" - 1 11 61 "foo.adb") + 1 11 61 "foo.adb" error) (ada "foo.adb:61:11: [...] in call to size declared at foo.ads:11" - 52 nil 11 "foo.ads") + 52 nil 11 "foo.ads" error) (ada " 0x8008621 main+16 at error.c:17" - 23 nil 17 "error.c") + 23 nil 17 "error.c" error) ;; aix (aix "****** Error number 140 in line 8 of file errors.c ******" - 25 nil 8 "errors.c") + 25 nil 8 "errors.c" error) ;; ant (ant "[javac] /src/DataBaseTestCase.java:27: unreported exception ..." - 13 nil 27 "/src/DataBaseTestCase.java" 2) + 13 nil 27 "/src/DataBaseTestCase.java" error) (ant "[javac] /src/DataBaseTestCase.java:49: warning: finally clause cannot complete normally" - 13 nil 49 "/src/DataBaseTestCase.java" 1) + 13 nil 49 "/src/DataBaseTestCase.java" warning) (ant "[jikes] foo.java:3:5:7:9: blah blah" - 14 (5 . 9) (3 . 7) "foo.java" 2) + 14 (5 . 9) (3 . 7) "foo.java" error) (ant "[javac] c:/cygwin/Test.java:12: error: foo: bar" - 9 nil 12 "c:/cygwin/Test.java" 2) + 9 nil 12 "c:/cygwin/Test.java" error) (ant "[javac] c:\\cygwin\\Test.java:87: error: foo: bar" - 9 nil 87 "c:\\cygwin\\Test.java" 2) + 9 nil 87 "c:\\cygwin\\Test.java" error) ;; Checkstyle error, but ant reports a warning (note additional ;; severity level after task name) (ant "[checkstyle] [ERROR] /src/Test.java:38: warning: foo" - 22 nil 38 "/src/Test.java" 1) + 22 nil 38 "/src/Test.java" warning) ;; bash (bash "a.sh: line 1: ls-l: command not found" - 1 nil 1 "a.sh") + 1 nil 1 "a.sh" error) ;; borland (borland "Error ping.c 15: Unable to open include file 'sys/types.h'" - 1 nil 15 "ping.c") + 1 nil 15 "ping.c" error) (borland "Warning pong.c 68: Call to function 'func' with no prototype" - 1 nil 68 "pong.c") + 1 nil 68 "pong.c" warning) (borland "Error E2010 ping.c 15: Unable to open include file 'sys/types.h'" - 1 nil 15 "ping.c") + 1 nil 15 "ping.c" error) (borland "Warning W1022 pong.c 68: Call to function 'func' with no prototype" - 1 nil 68 "pong.c") + 1 nil 68 "pong.c" warning) ;; caml (python-tracebacks-and-caml "File \"foobar.ml\", lines 5-8, characters 20-155: blah blah" - 1 (20 . 155) (5 . 8) "foobar.ml") + 1 (20 . 155) (5 . 8) "foobar.ml" error) (python-tracebacks-and-caml "File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26: unused variable equ." - 1 (2 . 145) 65 "F:\\ocaml\\sorting.ml") + 1 (2 . 145) 65 "F:\\ocaml\\sorting.ml" warning) (python-tracebacks-and-caml "File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in add_children" - 1 nil 41 "/usr/share/gdesklets/display/TargetGauge.py") + 1 nil 41 "/usr/share/gdesklets/display/TargetGauge.py" error) (python-tracebacks-and-caml "File \\lib\\python\\Products\\PythonScripts\\PythonScript.py, line 302, in _exec" - 1 nil 302 "\\lib\\python\\Products\\PythonScripts\\PythonScript.py") + 1 nil 302 "\\lib\\python\\Products\\PythonScripts\\PythonScript.py" error) (python-tracebacks-and-caml "File \"/tmp/foo.py\", line 10" - 1 nil 10 "/tmp/foo.py") + 1 nil 10 "/tmp/foo.py" error) ;; clang-include (clang-include "In file included from foo.cpp:2:" - 1 nil 2 "foo.cpp" 0) + 1 nil 2 "foo.cpp" info) ;; cmake cmake-info (cmake "CMake Error at CMakeLists.txt:23 (hurz):" - 1 nil 23 "CMakeLists.txt") + 1 nil 23 "CMakeLists.txt" error) (cmake "CMake Warning at cmake/modules/UseUG.cmake:73 (find_package):" - 1 nil 73 "cmake/modules/UseUG.cmake") + 1 nil 73 "cmake/modules/UseUG.cmake" warning) (cmake-info " cmake/modules/DuneGridMacros.cmake:19 (include)" - 1 nil 19 "cmake/modules/DuneGridMacros.cmake") + 1 nil 19 "cmake/modules/DuneGridMacros.cmake" info) ;; comma (comma "\"foo.f\", line 3: Error: syntax error near end of statement" - 1 nil 3 "foo.f") + 1 nil 3 "foo.f" error) (comma "\"vvouch.c\", line 19.5: 1506-046 (S) Syntax error." - 1 5 19 "vvouch.c") + 1 5 19 "vvouch.c" error) (comma "\"foo.c\", line 32 pos 1; (E) syntax error; unexpected symbol: \"lossage\"" - 1 1 32 "foo.c") + 1 1 32 "foo.c" error) (comma "\"foo.adb\", line 2(11): warning: file name does not match ..." - 1 11 2 "foo.adb") + 1 11 2 "foo.adb" warning) (comma "\"src/swapping.c\", line 30.34: 1506-342 (W) \"/*\" detected in comment." - 1 34 30 "src/swapping.c") + 1 34 30 "src/swapping.c" warning) ;; cucumber (cucumber "Scenario: undefined step # features/cucumber.feature:3" - 29 nil 3 "features/cucumber.feature") + 29 nil 3 "features/cucumber.feature" error) (cucumber " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" - 1 nil 500 "/home/gusev/.rvm/foo/bar.rb") + 1 nil 500 "/home/gusev/.rvm/foo/bar.rb" error) ;; edg-1 edg-2 (edg-1 "build/intel/debug/../../../struct.cpp(42): error: identifier \"foo\" is undefined" - 1 nil 42 "build/intel/debug/../../../struct.cpp") + 1 nil 42 "build/intel/debug/../../../struct.cpp" error) (edg-1 "build/intel/debug/struct.cpp(44): warning #1011: missing return statement at end of" - 1 nil 44 "build/intel/debug/struct.cpp") + 1 nil 44 "build/intel/debug/struct.cpp" warning) (edg-1 "build/intel/debug/iptr.h(302): remark #981: operands are evaluated in unspecified order" - 1 nil 302 "build/intel/debug/iptr.h") + 1 nil 302 "build/intel/debug/iptr.h" info) (edg-2 " detected during ... at line 62 of \"build/intel/debug/../../../trace.h\"" - 31 nil 62 "build/intel/debug/../../../trace.h") + 31 nil 62 "build/intel/debug/../../../trace.h" info) ;; epc (epc "Error 24 at (2:progran.f90) : syntax error" - 1 nil 2 "progran.f90") + 1 nil 2 "progran.f90" error) ;; ftnchek (ftnchek " Dummy arg W in module SUBA line 8 file arrayclash.f is array" - 32 nil 8 "arrayclash.f") + 32 nil 8 "arrayclash.f" error) (ftnchek " L4 used at line 55 file test/assign.f; never set" - 16 nil 55 "test/assign.f") + 16 nil 55 "test/assign.f" error) (ftnchek "Warning near line 10 file arrayclash.f: Module contains no executable" - 1 nil 10 "arrayclash.f") + 1 nil 10 "arrayclash.f" warning) (ftnchek "Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit" - 24 9 31 "assign.f") + 24 9 31 "assign.f" error) ;; iar (iar "\"foo.c\",3 Error[32]: Error message" - 1 nil 3 "foo.c") + 1 nil 3 "foo.c" error) (iar "\"foo.c\",3 Warning[32]: Error message" - 1 nil 3 "foo.c") + 1 nil 3 "foo.c" warning) ;; ibm (ibm "foo.c(2:0) : informational EDC0804: Function foo is not referenced." - 1 0 2 "foo.c") + 1 0 2 "foo.c" info) (ibm "foo.c(3:8) : warning EDC0833: Implicit return statement encountered." - 1 8 3 "foo.c") + 1 8 3 "foo.c" warning) (ibm "foo.c(5:5) : error EDC0350: Syntax error." - 1 5 5 "foo.c") + 1 5 5 "foo.c" error) ;; irix (irix "ccom: Error: foo.c, line 2: syntax error" - 1 nil 2 "foo.c") + 1 nil 2 "foo.c" error) (irix "cc: Severe: /src/Python-2.3.3/Modules/_curses_panel.c, line 17: Cannot find file ..." - 1 nil 17 "/src/Python-2.3.3/Modules/_curses_panel.c") + 1 nil 17 "/src/Python-2.3.3/Modules/_curses_panel.c" error) (irix "cc: Info: foo.c, line 27: ..." - 1 nil 27 "foo.c") + 1 nil 27 "foo.c" info) (irix "cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ..." - 1 nil 2 "foo.c") + 1 nil 2 "foo.c" warning) (irix "cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ..." - 1 nil 170 "xfe.c") + 1 nil 170 "xfe.c" warning) (irix "/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah" - 1 nil 1 "foo.c") + 1 nil 1 "foo.c" error) (irix "/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah" - 1 nil 1 "foo.c") + 1 nil 1 "foo.c" warning) (irix "foo bar: baz.f, line 27: ..." - 1 nil 27 "baz.f") + 1 nil 27 "baz.f" error) ;; java (java "\tat org.foo.ComponentGateway.doGet(ComponentGateway.java:172)" - 5 nil 172 "ComponentGateway.java") + 5 nil 172 "ComponentGateway.java" error) (java "\tat javax.servlet.http.HttpServlet.service(HttpServlet.java:740)" - 5 nil 740 "HttpServlet.java") + 5 nil 740 "HttpServlet.java" error) (java "==1332== at 0x4040743C: System::getErrorString() (../src/Lib/System.cpp:217)" - 13 nil 217 "../src/Lib/System.cpp") + 13 nil 217 "../src/Lib/System.cpp" error) (java "==1332== by 0x8008621: main (vtest.c:180)" - 13 nil 180 "vtest.c") + 13 nil 180 "vtest.c" warning) ;; javac (javac "/src/Test.java:5: ';' expected\n foo foo\n ^\n" - 1 16 5 "/src/Test.java" 2) + 1 16 5 "/src/Test.java" error) (javac "e:\\src\\Test.java:7: warning: ';' expected\n foo foo\n ^\n" - 1 11 7 "e:\\src\\Test.java" 1) + 1 11 7 "e:\\src\\Test.java" warning) ;; jikes-file jikes-line (jikes-file "Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":" - 1 nil nil "../javax/swing/BorderFactory.java") + 1 nil nil "../javax/swing/BorderFactory.java" info) (jikes-file "Issued 1 semantic warning compiling \"java/awt/Toolkit.java\":" - 1 nil nil "java/awt/Toolkit.java") + 1 nil nil "java/awt/Toolkit.java" info) ;; gcc-include (gcc-include "In file included from /usr/include/c++/3.3/backward/warn.h:4," - 1 nil 4 "/usr/include/c++/3.3/backward/warn.h") + 1 nil 4 "/usr/include/c++/3.3/backward/warn.h" info) (gcc-include " from /usr/include/c++/3.3/backward/iostream.h:31:0," - 1 0 31 "/usr/include/c++/3.3/backward/iostream.h") + 1 0 31 "/usr/include/c++/3.3/backward/iostream.h" info) (gcc-include " from test_clt.cc:1:" - 1 nil 1 "test_clt.cc") + 1 nil 1 "test_clt.cc" info) ;; Lua (lua "lua: database.lua:10: assertion failed!\nstack traceback:\n\t" - 6 nil 10 "database.lua") + 6 nil 10 "database.lua" error) (lua "lua 5.4: database 2.lua:10: assertion failed!\nstack traceback:\n\t" - 10 nil 10 "database 2.lua") + 10 nil 10 "database 2.lua" error) (lua "/usr/local/bin/lua: core/database.lua:20: assertion failed!\nstack traceback:\n\t" - 21 nil 20 "core/database.lua") + 21 nil 20 "core/database.lua" error) (lua "C:\\Lua\\Lua.exe: Core\\Database.lua:20: assertion failed!\nstack traceback:\n\t" - 17 nil 20 "Core\\Database.lua") + 17 nil 20 "Core\\Database.lua" error) (lua "lua: /tmp/database.lua:20: assertion failed!\nstack traceback:\n\t" - 6 nil 20 "/tmp/database.lua") + 6 nil 20 "/tmp/database.lua" error) (lua "Lua.exe: C:\\Temp\\Database.lua:20: assertion failed!\nstack traceback:\n\t" - 10 nil 20 "C:\\Temp\\Database.lua") + 10 nil 20 "C:\\Temp\\Database.lua" error) (lua-stack " database.lua: in field 'statement'" - 2 nil nil "database.lua" 0) + 2 nil nil "database.lua" info) (lua-stack " database.lua:10: in field 'statement'" - 2 nil 10 "database.lua" 0) + 2 nil 10 "database.lua" info) (lua-stack " core/database.lua:20: in field 'statement'" - 2 nil 20 "core/database.lua" 0) + 2 nil 20 "core/database.lua" info) (lua-stack " database 2.lua: in field 'statement'" - 2 nil nil "database 2.lua" 0) + 2 nil nil "database 2.lua" info) (lua-stack " Core\\Database.lua:20: in field 'statement'" - 2 nil 20 "Core\\Database.lua" 0) + 2 nil 20 "Core\\Database.lua" info) (lua-stack " /tmp/database.lua: in field 'statement'" - 2 nil nil "/tmp/database.lua" 0) + 2 nil nil "/tmp/database.lua" info) (lua-stack " C:\\Core\\Database.lua: in field 'statement'" - 2 nil nil "C:\\Core\\Database.lua" 0) + 2 nil nil "C:\\Core\\Database.lua" info) ;; gmake - (gmake "make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0) + (gmake "make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" info) (gmake "make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19 - "sub/make.mk" 0) + "sub/make.mk" info) (gmake "gmake[4]: *** [sub/make.mk:19: all] Error 2" 16 nil 19 - "sub/make.mk" 0) + "sub/make.mk" info) (gmake "gmake-4.3[4]: *** [make.mk:1119: all] Error 2" 20 nil 1119 - "make.mk" 0) + "make.mk" info) (gmake "Make-4.3: *** [make.INC:1119: dir/all] Error 2" 16 nil 1119 - "make.INC" 0) + "make.INC" info) ;; gnu - (gnu "foo.c:8: message" 1 nil 8 "foo.c") - (gnu "../foo.c:8: W: message" 1 nil 8 "../foo.c") - (gnu "/tmp/foo.c:8:warning message" 1 nil 8 "/tmp/foo.c") - (gnu "foo/bar.py:8: FutureWarning message" 1 nil 8 "foo/bar.py") - (gnu "foo.py:8: RuntimeWarning message" 1 nil 8 "foo.py") - (gnu "foo.c:8:I: message" 1 nil 8 "foo.c") - (gnu "foo.c:8.23: note: message" 1 23 8 "foo.c") - (gnu "foo.c:8.23: info: message" 1 23 8 "foo.c") - (gnu "foo.c:8:23:information: message" 1 23 8 "foo.c") - (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 45) (8 . nil) "foo.c") - (gnu "foo.c:8-23: message" 1 nil (8 . 23) "foo.c") - (gnu " |foo.c:8: message" 1 nil 8 "foo.c") + (gnu "foo.c:8: message" 1 nil 8 "foo.c" error) + (gnu "../foo.c:8: W: message" 1 nil 8 "../foo.c" warning) + (gnu "/tmp/foo.c:8:warning message" 1 nil 8 "/tmp/foo.c" warning) + (gnu "foo/bar.py:8: FutureWarning message" 1 nil 8 "foo/bar.py" warning) + (gnu "foo.py:8: RuntimeWarning message" 1 nil 8 "foo.py" warning) + (gnu "foo.c:8:I: message" 1 nil 8 "foo.c" info) + (gnu "foo.c:8.23: note: message" 1 23 8 "foo.c" info) + (gnu "foo.c:8.23: info: message" 1 23 8 "foo.c" info) + (gnu "foo.c:8:23:information: message" 1 23 8 "foo.c" info) + (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 45) (8 . nil) "foo.c" + info) + (gnu "foo.c:8-23: message" 1 nil (8 . 23) "foo.c" error) + (gnu " |foo.c:8: message" 1 nil 8 "foo.c" error) ;; The next one is not in the GNU standards AFAICS. ;; Here we seem to interpret it as LINE1-LINE2.COL2. - (gnu "foo.c:8-45.3: message" 1 (nil . 3) (8 . 45) "foo.c") - (gnu "foo.c:8.23-9.1: message" 1 (23 . 1) (8 . 9) "foo.c") + (gnu "foo.c:8-45.3: message" 1 (nil . 3) (8 . 45) "foo.c" error) + (gnu "foo.c:8.23-9.1: message" 1 (23 . 1) (8 . 9) "foo.c" error) (gnu "jade:dbcommon.dsl:133:17:E: missing argument for function call" - 1 17 133 "dbcommon.dsl") + 1 17 133 "dbcommon.dsl" error) (gnu "G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." - 1 nil 54 "G:/cygwin/dev/build-myproj.xml") + 1 nil 54 "G:/cygwin/dev/build-myproj.xml" error) (gnu "file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." - 1 nil 54 "G:/cygwin/dev/build-myproj.xml") + 1 nil 54 "G:/cygwin/dev/build-myproj.xml" error) (gnu "{standard input}:27041: Warning: end of file not at end of a line; newline inserted" - 1 nil 27041 "{standard input}") + 1 nil 27041 "{standard input}" warning) (gnu "boost/container/detail/flat_tree.hpp:589:25: [ skipping 5 instantiation contexts, use -ftemplate-backtrace-limit=0 to disable ]" - 1 25 589 "boost/container/detail/flat_tree.hpp" 0) + 1 25 589 "boost/container/detail/flat_tree.hpp" info) ;; Gradle/Kotlin (gradle-kotlin - "e: file:///src/Test.kt:267:5 foo: bar" 4 5 267 "/src/Test.kt" 2) + "e: file:///src/Test.kt:267:5 foo: bar" 4 5 267 "/src/Test.kt" error) (gradle-kotlin - "w: file:///src/Test.kt:267:5 foo: bar" 4 5 267 "/src/Test.kt" 1) + "w: file:///src/Test.kt:267:5 foo: bar" 4 5 267 "/src/Test.kt" warning) (gradle-kotlin-legacy - "e: /src/Test.kt: (34, 15): foo: bar" 4 15 34 "/src/Test.kt" 2) + "e: /src/Test.kt: (34, 15): foo: bar" 4 15 34 "/src/Test.kt" error) (gradle-kotlin-legacy - "w: /src/Test.kt: (11, 98): foo: bar" 4 98 11 "/src/Test.kt" 1) + "w: /src/Test.kt: (11, 98): foo: bar" 4 98 11 "/src/Test.kt" warning) (gradle-kotlin-legacy "e: e:/cygwin/src/Test.kt: (34, 15): foo: bar" - 4 15 34 "e:/cygwin/src/Test.kt" 2) + 4 15 34 "e:/cygwin/src/Test.kt" error) (gradle-kotlin-legacy "w: e:/cygwin/src/Test.kt: (11, 98): foo: bar" - 4 98 11 "e:/cygwin/src/Test.kt" 1) + 4 98 11 "e:/cygwin/src/Test.kt" warning) (gradle-kotlin-legacy - "e: e:\\src\\Test.kt: (34, 15): foo: bar" 4 15 34 "e:\\src\\Test.kt" 2) + "e: e:\\src\\Test.kt: (34, 15): foo: bar" 4 15 34 "e:\\src\\Test.kt" error) (gradle-kotlin-legacy - "w: e:\\src\\Test.kt: (11, 98): foo: bar" 4 98 11 "e:\\src\\Test.kt" 1) + "w: e:\\src\\Test.kt: (11, 98): foo: bar" 4 98 11 "e:\\src\\Test.kt" + warning) (gradle-android " ERROR:/Users/salutis/src/AndroidSchemeExperiment/app/build/intermediates/incremental/debug/mergeDebugResources/stripped.dir/layout/item.xml:3: AAPT: error: '16dpw' is incompatible with attribute padding (attr) dimension." - 1 nil 3 "/Users/salutis/src/AndroidSchemeExperiment/app/build/intermediates/incremental/debug/mergeDebugResources/stripped.dir/layout/item.xml" 2) + 1 nil 3 "/Users/salutis/src/AndroidSchemeExperiment/app/build/intermediates/incremental/debug/mergeDebugResources/stripped.dir/layout/item.xml" error) ;; Guile - (guile-file "In foo.scm:\n" 1 nil nil "foo.scm") + (guile-file "In foo.scm:\n" 1 nil nil "foo.scm" info) (guile-line " 63:4 [call-with-prompt prompt0 ...]" 1 4 63 nil) (guile-line "1038: 1 [main (\"gud-break.scm\")]" 1 1 1038 nil) ;; lcc - (lcc "E, file.cc(35,52) Illegal operation on pointers" 1 52 35 "file.cc") - (lcc "W, file.cc(36,52) blah blah" 1 52 36 "file.cc") + (lcc "E, file.cc(35,52) Illegal operation on pointers" 1 52 35 "file.cc" + error) + (lcc "W, file.cc(36,52) blah blah" 1 52 36 "file.cc" warning) ;; makepp - (makepp "makepp: Scanning `/foo/bar.c'" 19 nil nil "/foo/bar.c") + (makepp "makepp: Scanning `/foo/bar.c'" 19 nil nil "/foo/bar.c" info) (makepp "makepp: warning: bla bla `/foo/bar.c' and `/foo/bar.h'" - 27 nil nil "/foo/bar.c") + 27 nil nil "/foo/bar.c" warning) (makepp "makepp: bla bla `/foo/Makeppfile:12' bla" - 18 nil 12 "/foo/Makeppfile") + 18 nil 12 "/foo/Makeppfile" error) (nil "makepp: bla bla `/foo/bar.c' and `/foo/bar.h'" - 35 nil nil "/foo/bar.h") + 35 nil nil "/foo/bar.h" error) ;; maven (maven "FooBar.java:[111,53] no interface expected here" - 1 53 111 "FooBar.java" 2) + 1 53 111 "FooBar.java" error) (maven "[ERROR] /Users/cinsk/hello.java:[651,96] ';' expected" - 15 96 651 "/Users/cinsk/hello.java" 2) ;Bug#11517. + 15 96 651 "/Users/cinsk/hello.java" error) ;Bug#11517. (maven "[WARNING] /foo/bar/Test.java:[27,43] unchecked conversion" - 11 43 27 "/foo/bar/Test.java" 1) ;Bug#20556 + 11 43 27 "/foo/bar/Test.java" warning) ;Bug#20556 ;; mips-1 mips-2 (mips-1 "TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" - 11 nil 255 "solomon.c") + 11 nil 255 "solomon.c" error) (mips-1 "TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" - 70 nil 93 "solomo.c") + 70 nil 93 "solomo.c" error) (mips-2 "name defined but never used: LinInt in cmap_calc.c(199)" - 40 nil 199 "cmap_calc.c") + 40 nil 199 "cmap_calc.c" error) ;; msft (msft "keyboard handler.c(537) : warning C4005: 'min' : macro redefinition" - 1 nil 537 "keyboard handler.c") + 1 nil 537 "keyboard handler.c" warning) (msft "d:\\tmp\\test.c(23) : error C2143: syntax error : missing ';' before 'if'" - 1 nil 23 "d:\\tmp\\test.c") + 1 nil 23 "d:\\tmp\\test.c" error) (msft "d:\\tmp\\test.c(1145) : see declaration of 'nsRefPtr'" 1 nil 1145 "d:\\tmp\\test.c") (msft "1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'" - 3 nil 29 "test_main.cpp") + 3 nil 29 "test_main.cpp" error) (msft "1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int" - 3 nil 29 "test_main.cpp") + 3 nil 29 "test_main.cpp" error) (msft "C:\\tmp\\test.cpp(101,11): error C4101: 'bias0123': unreferenced local variable [C:\\tmp\\project.vcxproj]" - 1 11 101 "C:\\tmp\\test.cpp") + 1 11 101 "C:\\tmp\\test.cpp" error) ;; watcom (watcom "..\\src\\ctrl\\lister.c(109): Error! E1009: Expecting ';' but found '{'" - 1 nil 109 "..\\src\\ctrl\\lister.c") + 1 nil 109 "..\\src\\ctrl\\lister.c" error) (watcom "..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code" - 1 nil 120 "..\\src\\ctrl\\lister.c") + 1 nil 120 "..\\src\\ctrl\\lister.c" warning) ;; oracle (oracle "Semantic error at line 528, column 5, file erosacqdb.pc:" - 1 5 528 "erosacqdb.pc") + 1 5 528 "erosacqdb.pc" error) (oracle "Error at line 41, column 10 in file /usr/src/sb/ODBI_BHP.hpp" - 1 10 41 "/usr/src/sb/ODBI_BHP.hpp") + 1 10 41 "/usr/src/sb/ODBI_BHP.hpp" error) (oracle "PCC-02150: error at line 49, column 27 in file /usr/src/sb/ODBI_dxfgh.pc" - 1 27 49 "/usr/src/sb/ODBI_dxfgh.pc") + 1 27 49 "/usr/src/sb/ODBI_dxfgh.pc" error) (oracle "PCC-00003: invalid SQL Identifier at column name in line 12 of file /usr/src/sb/ODBI_BHP.hpp" - 1 nil 12 "/usr/src/sb/ODBI_BHP.hpp") + 1 nil 12 "/usr/src/sb/ODBI_BHP.hpp" error) (oracle "PCC-00004: mismatched IF/ELSE/ENDIF block at line 27 in file /usr/src/sb/ODBI_BHP.hpp" - 1 nil 27 "/usr/src/sb/ODBI_BHP.hpp") + 1 nil 27 "/usr/src/sb/ODBI_BHP.hpp" error) (oracle "PCC-02151: line 21 column 40 file /usr/src/sb/ODBI_BHP.hpp:" - 1 40 21 "/usr/src/sb/ODBI_BHP.hpp") + 1 40 21 "/usr/src/sb/ODBI_BHP.hpp" error) ;; perl (perl "syntax error at automake line 922, near \"':'\"" - 14 nil 922 "automake") + 14 nil 922 "automake" error) (perl "Died at test.pl line 27." - 6 nil 27 "test.pl") + 6 nil 27 "test.pl" error) (perl "store::odrecall('File_A', 'x2') called at store.pm line 90" - 40 nil 90 "store.pm") + 40 nil 90 "store.pm" error) (perl "\t(in cleanup) something bad at foo.pl line 3 during global destruction." - 29 nil 3 "foo.pl") + 29 nil 3 "foo.pl" error) (perl "GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3." 130 nil 3 "t-compilation-perl-gtk.pl") ;; php (php "Parse error: parse error, unexpected $ in main.php on line 59" - 1 nil 59 "main.php") + 1 nil 59 "main.php" error) (php "Fatal error: Call to undefined function: mysql_pconnect() in db.inc on line 66" - 1 nil 66 "db.inc") + 1 nil 66 "db.inc" error) + ;; rust + (rust + "error[E0277]: `Foo` is not an iterator\n --> src/main.rs:4:16" + 1 16 4 "src/main.rs" error) + (rust "warning: borrow of packed field is unsafe and requires unsafe function or block (error E0133)\n --> lint_example.rs:11:13" + 1 13 11 "lint_example.rs" warning) + (rust + "note: required by a bound in `Trait`\n --> src/auxiliary/trait-debuginfo.rs:23:18" + 1 18 23 "src/auxiliary/trait-debuginfo.rs" info) ;; ruby (uses gnu) (gnu "plain-exception.rb:7:in `fun': unhandled exception" - 1 nil 7 "plain-exception.rb") + 1 nil 7 "plain-exception.rb" error) (gcc-include - "\tfrom plain-exception.rb:3:in `proxy'" 2 nil 3 "plain-exception.rb") - (gcc-include "\tfrom plain-exception.rb:12" 2 nil 12 "plain-exception.rb") + "\tfrom plain-exception.rb:3:in `proxy'" 2 nil 3 "plain-exception.rb" info) + (gcc-include "\tfrom plain-exception.rb:12" 2 nil 12 "plain-exception.rb" + info) ;; ruby-Test::Unit ;; FIXME (ruby-Test::Unit " [examples/test-unit.rb:28:in `here_is_a_deep_assert'" - 5 nil 28 "examples/test-unit.rb") + 5 nil 28 "examples/test-unit.rb" error) (ruby-Test::Unit " examples/test-unit.rb:19:in `test_a_deep_assert']:" - 6 nil 19 "examples/test-unit.rb") + 6 nil 19 "examples/test-unit.rb" error) (gnu "examples/test-unit.rb:10:in `test_assert_raise'" - 1 nil 10 "examples/test-unit.rb") + 1 nil 10 "examples/test-unit.rb" error) ;; rxp (rxp "Error: Mismatched end tag: expected , got \nin unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml" - 1 8 71 "/home/reto/test/group.xml") + 1 8 71 "/home/reto/test/group.xml" error) (rxp "Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml" - 1 8 4 "/home/reto/test/group.xml") + 1 8 4 "/home/reto/test/group.xml" warning) ;; shellcheck (shellcheck "In autogen.sh line 48:" - 1 nil 48 "autogen.sh") + 1 nil 48 "autogen.sh" error) ;; sparc-pascal-file sparc-pascal-line sparc-pascal-example (sparc-pascal-file "Thu May 14 10:46:12 1992 mom3.p:" 1 nil nil "mom3.p") ;; sun (sun "cc-1020 CC: REMARK File = CUI_App.h, Line = 735" - 13 nil 735 "CUI_App.h") + 13 nil 735 "CUI_App.h" info) (sun "cc-1070 cc: WARNING File = linkl.c, Line = 38" - 13 nil 38 "linkl.c") + 13 nil 38 "linkl.c" warning) (sun "cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3" - 18 3 16 "Hoved.f90") + 18 3 16 "Hoved.f90" error) ;; 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") + 1 6 361 "/home3/xdhar/rcds_rc/main.a" error) (typescript-tsc-plain "/home/foo/greeter.ts(30,12): error TS2339: Property 'foo' does not exist." - 1 12 30 "/home/foo/greeter.ts") + 1 12 30 "/home/foo/greeter.ts" error) (typescript-tsc-pretty "src/resources/document.ts:140:22 - error TS2362: something." - 1 22 140 "src/resources/document.ts") + 1 22 140 "src/resources/document.ts" error) ;; 4bsd (edg-1 "/usr/src/foo/foo.c(8): warning: w may be used before set" - 1 nil 8 "/usr/src/foo/foo.c") + 1 nil 8 "/usr/src/foo/foo.c" warning) (edg-1 "/usr/src/foo/foo.c(9): error: w is used before set" - 1 nil 9 "/usr/src/foo/foo.c") + 1 nil 9 "/usr/src/foo/foo.c" error) (4bsd "strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)" - 44 nil 8 "/usr/src/foo/foo.c") + 44 nil 8 "/usr/src/foo/foo.c" error) (4bsd "bloofle defined( /users/wolfgang/foo.c(4) ), but never used" - 18 nil 4 "/users/wolfgang/foo.c") + 18 nil 4 "/users/wolfgang/foo.c" error) ;; perl--Pod::Checker ;; FIXME ;; *** ERROR: Spurious text after =cut at line 193 in file foo.pm @@ -427,20 +440,19 @@ ;; *** ERROR: =over on line 1 without closing =back (at head1) at line 3 in file x.pod ;; perl--Test (perl--Test "# Failed test 1 in foo.t at line 6" - 1 nil 6 "foo.t") + 1 nil 6 "foo.t" error) ;; perl--Test::Harness (perl--Test2 "NOK 1# Test 1 got: \"1234\" (t/foo.t at line 46)" - 1 nil 46 "t/foo.t") + 1 nil 46 "t/foo.t" error) ;; weblint (weblint "index.html (13:1) Unknown element " - 1 1 13 "index.html")) + 1 1 13 "index.html" error)) "List of tests for `compilation-error-regexp-alist'. Each element has the form (RULE STR POS COLUMN LINE FILENAME [TYPE]), where RULE is the rule (as a symbol), STR is an error string, POS is the position of the error in STR, COLUMN and LINE are the reported column and line numbers (or nil) for that error, -FILENAME is the reported filename, and TYPE is 0 for an -information message, 1 for a warning, and 2 for an error. +FILENAME is the reported filename, and TYPE is `info', `warning' or `error'. LINE can also be of the form (LINE . END-LINE) meaning a range of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) @@ -511,7 +523,9 @@ can only work with the NUL byte to disambiguate colons.") (should (equal (car (nth 2 (compilation--loc->file-struct loc))) (or end-line line))) (when type - (should (equal type (compilation--message->type msg)))) + (let ((type-code (pcase-exhaustive type + ('info 0) ('warning 1) ('error 2)))) + (should (equal type-code (compilation--message->type msg))))) (should (equal rule (compilation--message->rule msg)))) msg)))) @@ -538,9 +552,9 @@ The test data is in `compile-tests--test-regexps-data'." 1 15 5 "alpha.c"))) (compile--test-error-line test)) - (should (eq compilation-num-errors-found 107)) - (should (eq compilation-num-warnings-found 36)) - (should (eq compilation-num-infos-found 35))))) + (should (eq compilation-num-errors-found 108)) + (should (eq compilation-num-warnings-found 37)) + (should (eq compilation-num-infos-found 36))))) (ert-deftest compile-test-grep-regexps () "Test the `grep-regexp-alist' regexps. @@ -584,7 +598,7 @@ The test data is in `compile-tests--grep-regexp-testcases'." (compile--test-error-line '(my-rule "My error message" - 1 (39 . 24) (123 . 134) "my-file" 2)) + 1 (39 . 24) (123 . 134) "my-file" error)) (should (eq compilation-num-errors-found 1)) (should (eq compilation-num-warnings-found 0)) (should (eq compilation-num-infos-found 0)))))) diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts index e8b1d57f132..ba41c10c08c 100644 --- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts @@ -96,6 +96,11 @@ const foo = () => { Name: Chained ternary expressions =-= +const a = cond1 ? 1 : + cond2 ? 2 : + cond3 ? 3 : + cond 4: 5; + const a = cond1 ? 1 : cond2 ? 2 : cond3 ? 3 @@ -182,3 +187,28 @@ interface Foo { bar?: boolean; } =-=-= + +Code: + (lambda () + (setq tsx-ts-mode-indent-offset 2) + (tsx-ts-mode) + (setq indent-tabs-mode nil) + (indent-region (line-beginning-position 7) (point-max))) + +Name: Function body with params misindented (bug#78121) + +=-= +const f1 = (a1: string, + a2: number) => { + const f2 = (a1: string, + a2: number) => { + const f3 = (a1: string, + a2: number) => + { + return; + } + return; + } + return; +} +=-=-= diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index fd3ecda2b72..d8f2060c5f1 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -538,7 +538,7 @@ Return the last evalled form in BODY." ;; Bind `read-event' to simulate user input. ;; If `replace-tests-bind-read-string' is non-nil, then ;; bind `read-string' as well. - (cl-letf (((symbol-function 'read-event) + (cl-letf (((symbol-function 'read-key) (lambda (&rest _args) (incf ,count) (pcase ,count ; Build the clauses from CHAR-NUMS diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index f4fcce3e957..7f0c7d7f511 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -47,12 +47,13 @@ (defmacro with-time-stamp-test-time (reference-time &rest body) "Force `time-stamp' to use time REFERENCE-TIME while evaluating BODY." (declare (indent 1) (debug t)) - `(cl-letf* - ((orig-time-stamp-string-fn (symbol-function 'time-stamp-string)) - ((symbol-function 'time-stamp-string) - (lambda (ts-format) - (apply orig-time-stamp-string-fn ts-format ,reference-time nil)))) - ,@body)) + (cl-with-gensyms (g-orig-time-stamp-string-fn) + `(cl-letf* + ((,g-orig-time-stamp-string-fn (symbol-function 'time-stamp-string)) + ((symbol-function 'time-stamp-string) + (lambda (ts-format) + (funcall ,g-orig-time-stamp-string-fn ts-format ,reference-time)))) + ,@body))) (defmacro with-time-stamp-system-name (name &rest body) "Force function `system-name' to return NAME while evaluating BODY." @@ -64,13 +65,14 @@ (defmacro time-stamp-should-warn (form) "Similar to `should' and also verify that FORM generates a format warning." (declare (debug t)) - `(let ((warning-count 0)) - (cl-letf (((symbol-function 'time-stamp-conv-warn) - (lambda (_old _new &optional _newer) - (setq warning-count (1+ warning-count))))) - (should ,form) - (unless (= warning-count 1) - (ert-fail (format "Should have warned about format: %S" ',form)))))) + (cl-with-gensyms (g-warning-count) + `(let ((,g-warning-count 0)) + (cl-letf (((symbol-function 'time-stamp-conv-warn) + (lambda (_old _new &optional _newer) + (incf ,g-warning-count)))) + (should ,form) + (unless (= ,g-warning-count 1) + (ert-fail (format "Should have warned about format: %S" ',form))))))) ;;; Tests: @@ -355,9 +357,9 @@ (should (equal (time-stamp-string "%:a" ref-time1) Monday)) ;; recommended 1997-2019, warned since 2024, will change (time-stamp-should-warn - (should (equal (time-stamp-string "%3A" ref-time1) MON))) + (equal (time-stamp-string "%3A" ref-time1) MON)) (time-stamp-should-warn - (should (equal (time-stamp-string "%10A" ref-time1) p10-MONDAY))) + (equal (time-stamp-string "%10A" ref-time1) p10-MONDAY)) ;; implemented since 2001, recommended since 2019 (should (equal (time-stamp-string "%#a" ref-time1) MON)) (should (equal (time-stamp-string "%#3a" ref-time1) MON)) @@ -411,9 +413,9 @@ (should (equal (time-stamp-string "%:b" ref-time1) January)) ;; recommended 1997-2019, warned since 2024, will change (time-stamp-should-warn - (should (equal (time-stamp-string "%3B" ref-time1) JAN))) + (equal (time-stamp-string "%3B" ref-time1) JAN)) (time-stamp-should-warn - (should (equal (time-stamp-string "%10B" ref-time1) p10-JANUARY))) + (equal (time-stamp-string "%10B" ref-time1) p10-JANUARY)) ;; implemented since 2001, recommended since 2019 (should (equal (time-stamp-string "%#b" ref-time1) JAN)) (should (equal (time-stamp-string "%#3b" ref-time1) JAN)) @@ -606,9 +608,9 @@ (should (equal (time-stamp-string "%02y" ref-time2) "16")) ;; recommended 1997-2019, warned since 2024 (time-stamp-should-warn - (should (equal (time-stamp-string "%:y" ref-time1) "2006"))) + (equal (time-stamp-string "%:y" ref-time1) "2006")) (time-stamp-should-warn - (should (equal (time-stamp-string "%:y" ref-time2) "2016"))) + (equal (time-stamp-string "%:y" ref-time2) "2016")) ;; %-y and %_y warned 1997-2019, changed in 2019 ;; (We don't expect these forms to be useful, ;; but we test here so that we can confidently state that @@ -757,12 +759,12 @@ "test-system-name.example.org"))) ;; recommended 1997-2019, warned since 2024 (time-stamp-should-warn - (should (equal (time-stamp-string "%s" ref-time1) - "test-system-name.example.org"))) + (equal (time-stamp-string "%s" ref-time1) + "test-system-name.example.org")) (time-stamp-should-warn - (should (equal (time-stamp-string "%U" ref-time1) "100%d Tester"))) + (equal (time-stamp-string "%U" ref-time1) "100%d Tester")) (time-stamp-should-warn - (should (equal (time-stamp-string "%u" ref-time1) "test-logname"))) + (equal (time-stamp-string "%u" ref-time1) "test-logname")) ;; implemented since 2001, recommended since 2019 (should (equal (time-stamp-string "%L" ref-time1) "100%d Tester")) (should (equal (time-stamp-string "%l" ref-time1) "test-logname")) @@ -983,10 +985,11 @@ The interval arguments H M and S are all non-negative." Use the free variables `form-string' and `pattern-mod'. The functions in `pattern-mod' are composed left to right." (declare (debug t)) - `(let ((result ,expect)) - (dolist (fn pattern-mod) - (setq result (funcall fn result))) - (should (equal (formatz form-string ,zone) result)))) + (cl-with-gensyms (g-result g-fn) + `(let ((,g-result ,expect)) + (dolist (,g-fn pattern-mod) + (setq ,g-result (funcall ,g-fn ,g-result))) + (should (equal (formatz form-string ,zone) ,g-result))))) ;; These test cases have zeros in all places (first, last, none, both) ;; for hours, minutes, and seconds. @@ -1359,4 +1362,14 @@ Return non-nil if the definition is found." (should (equal "" (formatz "%#z" 0))) ) + +;;; Repeat the indent properties declared by the macros above, +;;; so that we can indent code before we eval this buffer. +;; Local variables: +;; eval: (put 'with-time-stamp-test-env 'lisp-indent-function 0) +;; eval: (put 'with-time-stamp-test-time 'lisp-indent-function 1) +;; eval: (put 'with-time-stamp-system-name 'lisp-indent-function 1) +;; eval: (put 'define-formatz-tests 'lisp-indent-function 1) +;; End: + ;;; time-stamp-tests.el ends here diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index 632a6a792bd..e8aaa070018 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -69,8 +69,8 @@ ;; HISTORY FUNCTIONS ;; ;; * print-log (files buffer &optional shortlog start-revision limit) -;; * log-outgoing (backend remote-location) -;; * log-incoming (backend remote-location) +;; - log-outgoing (backend remote-location) +;; - log-incoming (backend remote-location) ;; - log-view-mode () ;; - show-log-entry (revision) ;; - comment-history (file) diff --git a/test/lisp/visual-wrap-tests.el b/test/lisp/visual-wrap-tests.el new file mode 100644 index 00000000000..04977afe207 --- /dev/null +++ b/test/lisp/visual-wrap-tests.el @@ -0,0 +1,120 @@ +;;; visual-wrap-tests.el --- Tests for `visual-wrap-prefix-mode' -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Tets for `visual-wrap-prefix-mode'. + +;;; Code: + +(require 'visual-wrap) +(require 'ert) + +;;; Tests: + +(ert-deftest visual-wrap-tests/simple () + "Test adding wrapping properties to text without display properties." + (with-temp-buffer + (insert "greetings\n* hello\n* hi") + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + #("greetings\n* hello\n* hi" + 10 12 ( wrap-prefix (space :align-to (2 . width)) + display (min-width ((2 . width)))) + 12 17 ( wrap-prefix (space :align-to (2 . width))) + 18 20 ( wrap-prefix (space :align-to (2 . width)) + display (min-width ((2 . width)))) + 20 22 ( wrap-prefix (space :align-to (2 . width)))))))) + +(ert-deftest visual-wrap-tests/safe-display () + "Test adding wrapping properties to text with safe display properties." + (with-temp-buffer + (insert #("* hello" 2 7 (display (raise 1)))) + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + #("* hello" + 0 2 ( wrap-prefix (space :align-to (2 . width)) + display (min-width ((2 . width)))) + 2 7 ( wrap-prefix (space :align-to (2 . width)) + display (raise 1))))))) + +(ert-deftest visual-wrap-tests/unsafe-display/within-line () + "Test adding wrapping properties to text with unsafe display properties. +When these properties don't extend across multiple lines, +`visual-wrap-prefix-mode' can still add wrapping properties." + (with-temp-buffer + (insert #("* [img]" 2 7 (display (image :type bmp)))) + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + #("* [img]" + 0 2 ( wrap-prefix (space :align-to (2 . width)) + display (min-width ((2 . width)))) + 2 7 ( wrap-prefix (space :align-to (2 . width)) + display (image :type bmp))))))) + +(ert-deftest visual-wrap-tests/unsafe-display/spanning-lines () + "Test adding wrapping properties to text with unsafe display properties. +When these properties do extend across multiple lines, +`visual-wrap-prefix-mode' must avoid adding wrapping properties." + (with-temp-buffer + (insert #("* a\n* b" 0 7 (display (image :type bmp)))) + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + #("* a\n* b" 0 7 (display (image :type bmp))))))) + +(ert-deftest visual-wrap-tests/unsafe-display/multiple-1 () + "Test adding wrapping properties to text with unsafe display properties. +This tests a multi-line unsafe display prop immediately followed by a +single-line unsafe display prop. `visual-wrap-prefix-mode' should *not* +add wrapping properties to either block." + (with-temp-buffer + (insert #("* a\n* b" + 0 4 (display ((image :type bmp))) + 4 7 (display ((image :type bmp) (height 1.5))))) + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + ;; NOTE: See the note in `visual-wrap-prefix-function'. If + ;; applying the change mentioned there, then this case + ;; should add wrapping properties to the second block. + #("* a\n* b" + 0 4 (display ((image :type bmp))) + 4 7 (display ((image :type bmp) (height 1.5)))))))) + +(ert-deftest visual-wrap-tests/unsafe-display/multiple-2 () + "Test adding wrapping properties to text with unsafe display properties. +This tests a multi-line unsafe display prop immediately followed by +another multi-line unsafe display prop. `visual-wrap-prefix-mode' +should *not* add wrapping properties to either block." + (with-temp-buffer + (insert #("* a\n* b\n" + 0 4 (display ((image :type bmp))) + 4 8 (display ((image :type bmp) (height 1.5))))) + (visual-wrap-prefix-function (point-min) (point-max)) + (should (equal-including-properties + (buffer-string) + #("* a\n* b\n" + 0 4 (display ((image :type bmp))) + 4 8 (display ((image :type bmp) (height 1.5)))))))) + +;; visual-wrap-tests.el ends here diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 260bdb281bb..75be9856463 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -354,6 +354,19 @@ comparing the subr with a much slower Lisp implementation." (setq-default binding-test-some-local 'new-default)) (should (eq binding-test-some-local 'some)))) +(defvar c-e-x) +(ert-deftest binding-test-defvar-in-let () + "Test some core Elisp rules." + (with-temp-buffer + ;; Check that when defvar is run within a let-binding, the toplevel default + ;; is properly initialized. + (should (equal (list (let ((c-e-x 1)) (defvar c-e-x 2) c-e-x) c-e-x) + '(1 2))) + (should (equal (list (let ((c-e-x 1)) + (defcustom c-e-x 2 "doc" :group 'blah :type 'integer) c-e-x) + c-e-x) + '(1 2))))) + (ert-deftest data-tests--let-buffer-local () (let ((blvar (make-symbol "blvar"))) (set-default blvar nil) @@ -396,6 +409,37 @@ comparing the subr with a much slower Lisp implementation." (should (equal (default-value var) def))) ))))) +(defvar-local c-e-l 'foo) +(ert-deftest binding-test-toplevel-values () + (setq-default c-e-l 'foo) + (let ((c-e-l 'bar)) + (let ((c-e-l 'baz)) + (setq-default c-e-l 'bar) + (should (eq c-e-l 'bar)) + (should (eq (default-toplevel-value 'c-e-l) 'foo)) + (set-default-toplevel-value 'c-e-l 'baz) + (should (eq c-e-l 'bar)) + (should (eq (default-toplevel-value 'c-e-l) 'baz)))) + (let ((c-e-u 'foo)) + (should (condition-case _ + (default-toplevel-value 'c-e-u) + (void-variable t)))) + (with-temp-buffer + (setq-local c-e-l 'bar) + (should (eq (buffer-local-toplevel-value 'c-e-l) 'bar)) + (let ((c-e-l 'baz)) + (let ((c-e-l 'quux)) + (setq-local c-e-l 'baz) + (should (eq c-e-l 'baz)) + (should (eq (buffer-local-toplevel-value 'c-e-l) 'bar)) + (set-buffer-local-toplevel-value 'c-e-l 'foo) + (should (eq c-e-l 'baz)) + (should (eq (buffer-local-toplevel-value 'c-e-l) 'foo))))) + (with-temp-buffer + (should (condition-case _ + (buffer-local-toplevel-value 'c-e-l) + (void-variable t))))) + (ert-deftest binding-test-makunbound () "Tests of makunbound, from the manual." (with-current-buffer binding-test-buffer-B diff --git a/test/src/print-tests.el b/test/src/print-tests.el index af57311135b..036248fd091 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -540,5 +540,23 @@ otherwise, use a different charset." (should (eq callback-buffer buffer)) (should (equal str "tata")))) +(ert-deftest test-print-number-realloc () + ;; Test for bug#78590. Note that this may in rare cases crash unfixed + ;; Emacs versions. + (let ((print-circle t) + (print-number-table (make-hash-table)) + (print-continuous-numbering t) + (str "yy") + (outstr "")) + (garbage-collect) + (ignore (make-string 100 ?a)) + (puthash str (make-string 3 ?x) print-number-table) + (prin1 str + (lambda (c) + (setq outstr (concat outstr (string c))) + (garbage-collect) + (ignore (make-string 100 ?b)))) + (should (equal outstr "xxx")))) + (provide 'print-tests) ;;; print-tests.el ends here