commit 2b9c7f9508e435625c27d7b261f5ce6414d207f3 (HEAD, refs/remotes/origin/master) Author: Juri Linkov Date: Wed Sep 3 09:45:34 2025 +0300 Make 'isearch-mode' more idempotent (bug#79368). * lisp/isearch.el (isearch-mode): Don't override 'isearch--saved-local-map' when 'overriding-terminal-local-map' was already set to 'isearch-mode-map' in a previous call. (with-isearch-suspended): Don't call the function 'isearch-mode' when the variable 'isearch-mode' is already non-nil. diff --git a/lisp/isearch.el b/lisp/isearch.el index 5a79076c63d..28d24488e71 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1322,7 +1322,10 @@ used to set the value of `isearch-regexp-function'." (setq isearch-mode " Isearch") ;; forward? regexp? (force-mode-line-update) - (setq isearch--saved-local-map overriding-terminal-local-map) + ;; Prevent successive calls overriding original map + ;; in `isearch-done'. (Bug#79368) + (unless (eq overriding-terminal-local-map isearch-mode-map) + (setq isearch--saved-local-map overriding-terminal-local-map)) (setq overriding-terminal-local-map isearch-mode-map) (run-hooks 'isearch-mode-hook) ;; Remember the initial map possibly modified @@ -1765,12 +1768,18 @@ You can update the global isearch variables by setting new values to (setq isearch-suspended nil) - ;; Always resume isearching by restarting it. - (isearch-mode isearch-forward - isearch-regexp - isearch-op-fun - nil - isearch-regexp-function) + ;; When aborting recursive minibuffers with a command attempted + ;; to use minibuffer while in minibuffer, this unwind form + ;; might be called consecutively more than once. So check if + ;; `isearch-mode' was already enabled in a previous call + ;; in the same unwind form (bug#79368). + (unless isearch-mode + ;; Always resume isearching by restarting it. + (isearch-mode isearch-forward + isearch-regexp + isearch-op-fun + nil + isearch-regexp-function)) ;; Copy new local values to isearch globals (setq isearch-string isearch-new-string commit f97abe62009a2a94bda22e3e941f1bcf9879724c Author: Stefan Monnier Date: Tue Sep 2 15:10:25 2025 -0400 (macroexp--obsolete-warning): Prefer `%s` * lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning): `instead` can be a list. * lisp/dom.el (dom-text, dom-texts): Fix obsolescence declaration. diff --git a/lisp/dom.el b/lisp/dom.el index d8436abc5fb..e6ccd85c3bd 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -75,12 +75,12 @@ A typical attribute is `href'." (defun dom-text (node) "Return all the text bits in the current node concatenated." - (declare (obsolete 'dom-inner-text "31.1")) + (declare (obsolete dom-inner-text "31.1")) (mapconcat #'identity (cl-remove-if-not #'stringp (dom-children node)) " ")) (defun dom-texts (node &optional separator) "Return all textual data under NODE concatenated with SEPARATOR in-between." - (declare (obsolete 'dom-inner-text "31.1")) + (declare (obsolete dom-inner-text "31.1")) (if (eq (dom-tag node) 'script) "" (mapconcat diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 1ded58b02f1..2bf9e0eb451 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -212,8 +212,8 @@ It should normally be a symbol with position and it defaults to FORM." (if asof (concat " (as of " asof ")") "") (cond ((stringp instead) (concat "; " (substitute-command-keys instead))) ((and instead key) - (format-message "; use `%s' (%s) instead." instead key)) - (instead (format-message "; use `%s' instead." instead)) + (format-message "; use `%S' (%s) instead." instead key)) + (instead (format-message "; use `%S' instead." instead)) (t "."))))) (defun macroexpand-1 (form &optional environment) commit f1a18e84117916474596a4c9b9df3a67d324ef58 Author: Spencer Baugh Date: Tue Sep 2 09:17:06 2025 -0400 Allow any thread to run native compilations * lisp/emacs-lisp/comp-run.el (comp--run-async-workers): Don't lock the native compilation process to a thread (bug#79228). diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 1761190ea17..5e33b1bc318 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -366,6 +366,7 @@ display a message." (eq load1 'late)))) (comp--run-async-workers)) :noquery (not native-comp-async-query-on-exit)))) + (set-process-thread process nil) (puthash source-file process comp-async-compilations)) when (>= (comp--async-runnings) (comp--effective-async-max-jobs)) do (cl-return))) commit 90350729be0dc481ec27cf88c9f9c91dc8f9f20e Author: Eli Zaretskii Date: Tue Sep 2 17:45:46 2025 +0300 ; Improve error message in elisp-mode.el * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile--executable): Improve the error message. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 89b73eff552..e8344852829 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -2310,7 +2310,8 @@ variables `invocation-name' and `invocation-directory'." (if (file-executable-p filename) filename (when elisp-flymake-byte-compile-executable - (message "No such elisp-flymake-byte-compile-executable %s" filename)) + (message "No such `elisp-flymake-byte-compile-executable': %s" + filename)) (expand-file-name invocation-name invocation-directory)))) ;;;###autoload commit 077a2e8f3b65a9bbdeb5b8c4fb170f9e253cf5c4 Author: Sean Whitton Date: Tue Sep 2 13:42:26 2025 +0100 fileloop-next-file: Convert file-error to warnings * lisp/fileloop.el (fileloop-next-file): Catch file-error and convert to a delayed warning (bug#79356). diff --git a/lisp/fileloop.el b/lisp/fileloop.el index d7d2aa7e0d5..a302719bcd5 100644 --- a/lisp/fileloop.el +++ b/lisp/fileloop.el @@ -121,10 +121,16 @@ operating on the next file and nil otherwise." (kill-all-local-variables) (erase-buffer) (setq new next) - (condition-case nil + (condition-case err (insert-file-contents new nil) (file-missing - (fileloop-next-file novisit)))) + (fileloop-next-file novisit)) + (file-error + ;; See bug#79356 for discussion. + (let ((msg (error-message-string err))) + (unless (string-search new msg) + (setq msg (format "%s: %s" new msg))) + (delay-warning 'file-error msg :error))))) new))) (defun fileloop-continue () commit a6dd36e9b1cf7cabb7848c4fa557015762ce0d6c Author: Eli Zaretskii Date: Tue Sep 2 14:05:14 2025 +0300 ; Fix last change * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile-executable): Doc fix. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index a22b2145f52..89b73eff552 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -2285,12 +2285,13 @@ directory of the buffer being compiled, and nothing else.") "The Emacs executable to use for Flymake byte compilation. If non-nil, this should be an absolute or relative file name of an Emacs -executable. If it's a relative file name, it should be relative to the -root directory of the project containing the file being compiled, as -determined by `project-current'. +executable to use for byte compilation by Flymake. If it's a relative +file name, it should be relative to the root directory of the project +containing the file being compiled, as determined by `project-current'. -If nil, or the file named by this does not exist, the running Emacs is -used via variable `invocation-directory'." +If nil, or if the file named by this does not exist, Flymake will +use the same executable as the running Emacs, as specified by the +variables `invocation-name' and `invocation-directory'." :type 'file :group 'lisp :version "31.1") commit 45c5b636ced1924e627217ff5e19097e27d9caa4 Author: Spencer Baugh Date: Fri Aug 29 18:19:49 2025 -0400 Add 'elisp-flymake-byte-compile-executable' defcustom The correct Emacs executable to use for 'elisp-flymake-byte-compile' is not necessarily the running Emacs. For example, when editing trunk with Emacs 30, various Lisp changes will cause spurious flymake warnings. Add 'elisp-flymake-byte-compile-executable' to allow customizing this. * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile-executable) (elisp-flymake-byte-compile--executable): Add. (Bug#79342) (elisp-flymake-byte-compile): Invoke 'elisp-flymake-byte-compile--executable'. * etc/NEWS: Announce the change. diff --git a/etc/NEWS b/etc/NEWS index 66a5b0a9eed..0f39b78f892 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2586,6 +2586,13 @@ The tabulated listings produced by 'flymake-show-buffer-diagnostics' and 'flymake-show-project-diagnostics' now automatically adjust their column widths based on content, optimizing display space and readability. +*** New user option 'elisp-flymake-byte-compile-executable'. +This allows customizing the Emacs executable used for Flymake byte +compilation in emacs-lisp-mode. This option should be set when editing +Lisp code which will run with a different Emacs version than the running +Emacs, such as code from an older or newer version of Emacs. This will +provide more accurate warnings from byte compilation. + ** SQLite +++ diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index aa2daf6820a..a22b2145f52 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -2281,6 +2281,37 @@ directory of the buffer being compiled, and nothing else.") (defvar bytecomp--inhibit-lexical-cookie-warning) +(defcustom elisp-flymake-byte-compile-executable nil + "The Emacs executable to use for Flymake byte compilation. + +If non-nil, this should be an absolute or relative file name of an Emacs +executable. If it's a relative file name, it should be relative to the +root directory of the project containing the file being compiled, as +determined by `project-current'. + +If nil, or the file named by this does not exist, the running Emacs is +used via variable `invocation-directory'." + :type 'file + :group 'lisp + :version "31.1") + +(declare-function project-root "project" (project)) +(defun elisp-flymake-byte-compile--executable () + "Return absolute file name of the Emacs executable for flymake byte-compilation." + (let ((filename + (cond + ((file-name-absolute-p elisp-flymake-byte-compile-executable) + elisp-flymake-byte-compile-executable) + ((stringp elisp-flymake-byte-compile-executable) + (when-let* ((pr (project-current))) + (file-name-concat (project-root pr) + elisp-flymake-byte-compile-executable)))))) + (if (file-executable-p filename) + filename + (when elisp-flymake-byte-compile-executable + (message "No such elisp-flymake-byte-compile-executable %s" filename)) + (expand-file-name invocation-name invocation-directory)))) + ;;;###autoload (defun elisp-flymake-byte-compile (report-fn &rest _args) "A Flymake backend for elisp byte compilation. @@ -2316,7 +2347,7 @@ current buffer state and calls REPORT-FN when done." (make-process :name "elisp-flymake-byte-compile" :buffer output-buffer - :command `(,(expand-file-name invocation-name invocation-directory) + :command `(,(elisp-flymake-byte-compile--executable) "-Q" "--batch" ;; "--eval" "(setq load-prefer-newer t)" ; for testing commit 6ad8745833c2cc722cc73fd86ac63cd4741d2b2b Author: Michael Albinus Date: Tue Sep 2 12:09:17 2025 +0200 Extend tramp-test26-interactive-file-name-completion * lisp/net/tramp.el (tramp-get-completion-methods): Use `tramp-compat-seq-keep'. * test/lisp/net/tramp-tests.el (completions-max-height): Declare. (tramp-test26-interactive-file-name-completion): Extend test. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c7450bc015d..9bf1b4ae6c3 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3261,7 +3261,7 @@ remote host and localname (filename on remote host)." (defun tramp-get-completion-methods (partial-method &optional multi-hop) "Return all method completions for PARTIAL-METHOD. If MULTI-HOP is non-nil, return only multi-hop capable methods." - (mapcar + (tramp-compat-seq-keep (lambda (method) (and method (string-prefix-p (or partial-method "") method) (or (not multi-hop) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 892e4ef519c..8c230f43cf3 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -91,6 +91,9 @@ (defvar tramp-remote-process-environment) (defvar tramp-use-connection-share) +;; Declared in Emacs 29.1. +(defvar completions-max-height) + ;; Declared in Emacs 30.1. (defvar project-mode-line) (defvar remote-file-name-access-timeout) @@ -5002,30 +5005,33 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp--test-deftest-with-ls tramp-test26-file-name-completion) -;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042 -;; and Bug#60505. +;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, +;; Bug#54042, Bug#60505 and Bug#79236. (ert-deftest tramp-test26-interactive-file-name-completion () "Check interactive completion with different `completion-styles'." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - ;; (when (get-buffer trace-buffer) (kill-buffer trace-buffer)) - ;; (dolist (elt (append - ;; (mapcar - ;; #'intern (all-completions "tramp-" obarray #'functionp)) - ;; tramp-trace-functions)) - ;; (unless (get elt 'tramp-suppress-trace) - ;; (trace-function-background elt))) - ;; (trace-function-background #'completion-file-name-table) - ;; (trace-function-background #'read-file-name) - ;; Method, user and host name in completion mode. - (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) - (user (file-remote-p ert-remote-temporary-file-directory 'user)) - (host (file-remote-p ert-remote-temporary-file-directory 'host)) - (hop (file-remote-p ert-remote-temporary-file-directory 'hop)) - (orig-syntax tramp-syntax) - (non-essential t) - (inhibit-message (not (ignore-errors (edebug-mode))))) + (let* (;; Set this to `t' if you want to run all tests. + (expensive nil) ;(tramp--test-expensive-test-p)) + ;; Set this to `t' if you want to see the traces. + (tramp-trace nil) + (method (file-remote-p ert-remote-temporary-file-directory 'method)) + (user (file-remote-p ert-remote-temporary-file-directory 'user)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (hop (and expensive + (file-remote-p ert-remote-temporary-file-directory 'hop))) + ;; All multi-hop capable methods. + (method-list + (and hop (sort (mapcar + (lambda (x) + (substring x (length tramp-prefix-format))) + (tramp-get-completion-methods "" t))))) + (orig-syntax tramp-syntax) + (non-essential t) + (inhibit-message + (and (not tramp-trace) (not (ignore-errors (edebug-mode)))))) ;; `file-remote-p' returns as host the string "host#port", which ;; isn't useful. (when (and (stringp host) @@ -5034,6 +5040,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." host)) (setq host (replace-match "" nil nil host))) + (when tramp-trace + (when (get-buffer trace-buffer) (kill-buffer trace-buffer)) + (dolist + (elt (mapcar #'intern (all-completions "tramp-" obarray #'functionp))) + (unless (get elt 'tramp-suppress-trace) + (trace-function-background elt))) + (trace-function-background #'completion-file-name-table) + (trace-function-background #'read-file-name)) + (unwind-protect (dolist (syntax (if (tramp--test-expensive-test-p) (tramp-syntax-values) `(,orig-syntax))) @@ -5045,21 +5060,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (dolist (style - (if (tramp--test-expensive-test-p) - ;; FIXME: It doesn't work for `initials' and - ;; `shorthand' completion styles. Should it? - ;; `orderless' passes the tests, but it is an ELPA package. - ;; What about `company' backends, `consult', `cider', `helm'? + (if expensive + ;; `initials' uses "/" as separator, it doesn't apply here. + ;; `shorthand' is about symbols, it doesn't apply here. `(emacs21 emacs22 basic partial-completion substring ;; FIXME: `flex' is not compatible with IPv6 hosts. - ,@(unless (string-match-p tramp-ipv6-regexp host) '(flex))) + ,@(unless (string-match-p tramp-ipv6-regexp host) '(flex)) + ;; `orderless' is an ELPA package. + ;; What about `company' backends, `consult', + ;; `cider', `helm'? + orderless) '(basic))) (when (assoc style completion-styles-alist) (let* (;; Force the real minibuffer in batch mode. (executing-kbd-macro noninteractive) - ;; FIXME: Is this TRT for test? - (minibuffer-completing-file-name t) (confirm-nonexistent-file-or-buffer nil) (completion-styles `(,style)) completion-category-defaults @@ -5072,6 +5087,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." `(any ,(string-replace ":" "" completion-pcm-word-delimiters)))) + ;; Don't truncate in *Completions* buffer. + (completions-max-height most-positive-fixnum) ;; This is needed for the `simplified' syntax. (tramp-default-method method) (method-string @@ -5097,7 +5114,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Needed for host name completion. (default-user (file-remote-p - (concat tramp-prefix-format hop method-string host-string) + (concat + tramp-prefix-format hop method-string host-string) 'user)) (default-user-string (unless (tramp-string-empty-or-nil-p default-user) @@ -5107,8 +5125,18 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (dolist (test-and-result ;; These are triples of strings (TEST-STRING - ;; RESULT-CHECK COMPLETION-CHECK). + ;; RESULT-CHECK COMPLETION-CHECK). If + ;; COMPLETION-CHECK is a list, it is the complete + ;; result the contents of *Completions* shall be + ;; checked with. (append + ;; Complete hop. + (unless (tramp-string-empty-or-nil-p hop) + `((,(concat tramp-prefix-format hop) + ,(concat tramp-prefix-format hop) + ,(if (string-empty-p tramp-method-regexp) + (or default-user-string host-string) + method-list)))) ;; Complete method name. (unless (string-empty-p tramp-method-regexp) `((,(concat @@ -5127,7 +5155,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." tramp-prefix-format hop method-string user-string) ,user-string))) ;; Complete host name. - (unless (tramp-string-empty-or-nil-p host) + (unless (tramp-string-empty-or-nil-p host-string) `((,(concat tramp-prefix-format hop method-string ipv6-prefix @@ -5138,8 +5166,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." default-user-string host-string) ,host-string))) ;; Complete user and host name. - (unless (or (tramp-string-empty-or-nil-p user) - (tramp-string-empty-or-nil-p host)) + (unless (or (tramp-string-empty-or-nil-p user-string) + (tramp-string-empty-or-nil-p host-string)) `((,(concat tramp-prefix-format hop method-string user-string ipv6-prefix @@ -5152,8 +5180,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (dolist (predicate - (if (and (tramp--test-expensive-test-p) - (tramp--test-emacs31-p)) + (if (and expensive (tramp--test-emacs31-p)) ;; `nil' will be expanded to `file-exists-p'. ;; `read-directory-name' uses `file-directory-p'. ;; `file-directory-p' works since Emacs 31. @@ -5161,8 +5188,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." '(file-exists-p file-directory-p) '(nil))) (ignore-errors (kill-buffer "*Completions*")) - ;; (when (get-buffer trace-buffer) - ;; (kill-buffer trace-buffer)) + (when tramp-trace + (when (get-buffer trace-buffer) + (kill-buffer trace-buffer))) (discard-input) (setq test (car test-and-result) unread-command-events @@ -5186,11 +5214,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." eos)) result)) (progn - ;; (tramp--test-message - ;; (concat - ;; "syntax: %s style: %s predicate: %s " - ;; "test: %s result: %s") - ;; syntax style predicate test result) + (when tramp-trace + (tramp--test-message + (concat + "syntax: %s style: %s predicate: %s " + "test: %s result: %s") + syntax style predicate test result)) (should (string-prefix-p (cadr test-and-result) result))) @@ -5212,16 +5241,22 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (point) (point-max)) (rx (any "\r\n\t ")) 'omit))) - ;; (tramp--test-message - ;; (concat - ;; "syntax: %s style: %s predicate: %s test: %s " - ;; "result: %s completions: %S") - ;; syntax style predicate test result completions) - (should - (member (caddr test-and-result) completions))))))))) + (when tramp-trace + (tramp--test-message + (concat + "syntax: %s style: %s predicate: %s test: %s " + "result: %s completions: %S") + syntax style predicate test result completions)) + (if (stringp (caddr test-and-result)) + (should + (member (caddr test-and-result) completions)) + (should + (equal + (caddr test-and-result) (sort completions))))))))))) ;; Cleanup. - ;; (untrace-all) + (when tramp-trace + (untrace-all)) (tramp-change-syntax orig-syntax) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))) @@ -8879,15 +8914,12 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * tramp-set-file-uid-gid ;; * Work on skipped tests. Make a comment, when it is impossible. -;; * Use `skip-when' starting with Emacs 30.1. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". ;; * In `tramp-test26-file-name-completion', check also user, domain, ;; port and hop. -;; * In `tramp-test26-interactive-file-name-completion', check `flex', -;; `initials' and `shorthand' completion styles. Should -;; `minibuffer-completing-file-name' and `completion-pcm--delim-wild-regex' -;; be bound? Check also domain, port and hop. +;; * In `tramp-test26-interactive-file-name-completion', should +;; `completion-pcm--delim-wild-regex' be bound? Check also domain and port. ;; * Check, why a process filter t doesn't work in ;; `tramp-test29-start-file-process' and ;; `tramp-test30-make-process'. @@ -8899,6 +8931,8 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Check, why direct async processes do not work for ;; `tramp-test45-asynchronous-requests'. +;; Use `skip-when' starting with Emacs 30.1. + ;; Starting with Emacs 29, use `ert-with-temp-file' and ;; `ert-with-temp-directory'. commit cc1a1a984a4989d2561bdd4ecb1a7e0d3ceb5f5d Author: Sean Whitton Date: Tue Sep 2 09:23:42 2025 +0100 ; * etc/NEWS: Copyedit. diff --git a/etc/NEWS b/etc/NEWS index 630d03a1fa0..66a5b0a9eed 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2727,13 +2727,12 @@ files. If tree-sitter is properly set-up by the user, it can be enabled for files named "go.work". ** New package 'lua-mode'. -The 'lua-mode' package from Non-GNU ELPA is now included in Emacs. +The 'lua-mode' package from NonGNU ELPA is now included in Emacs. ** New library 'timeout'. -This library that provides higher order functions to throttle or -debounce Elisp functions. This is useful for corraling over-eager code -that is slow and blocks Emacs or does not provide customization options -to limit how often it runs. +This library provides functions to throttle or debounce Emacs Lisp +functions. This is useful for corralling overeager code that is slow +and blocks Emacs, or does not provide ways to limit how often it runs. * Incompatible Lisp Changes in Emacs 31.1 commit b953dc679c53d8ae26770762bcb2601389146768 Author: Spencer Baugh Date: Mon Sep 1 11:43:25 2025 -0400 Revert "Avoid duplicating strings in pcm--merge-completions" Revert "Avoid duplicating strings in pcm--merge-completions", commit b511c38bba5354ff21c697e4d27279bf73e4d3cf. It broke existing behavior, now covered by tests adding in this commit. * lisp/minibuffer.el (completion-pcm--merge-completions): * test/lisp/minibuffer-tests.el (completion-pcm-test-anydelim): (completion-pcm-bug4219): diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 914958a08a4..e26da9ee28b 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4625,35 +4625,38 @@ the same set of elements." (cond ((null (cdr strs)) (list (car strs))) (t - (let ((re (concat - (completion-pcm--pattern->regex pattern 'group) - ;; The implicit trailing `any' is greedy. - "\\([^z-a]*\\)")) + (let ((re (completion-pcm--pattern->regex pattern 'group)) (ccs ())) ;Chopped completions. - ;; First match each string against PATTERN as a regex and extract - ;; the text matched by each wildcard. + ;; First chop each string into the parts corresponding to each + ;; non-constant element of `pattern', using regexp-matching. (let ((case-fold-search completion-ignore-case)) (dolist (str strs) (unless (string-match re str) (error "Internal error: %s doesn't match %s" str re)) (let ((chopped ()) + (last 0) (i 1) next) - (while (setq next (match-string i str)) - (push next chopped) + (while (setq next (match-end i)) + (push (substring str last next) chopped) + (setq last next) (setq i (1+ i))) + ;; Add the text corresponding to the implicit trailing `any'. + (push (substring str last) chopped) (push (nreverse chopped) ccs)))) - ;; Then for each of those wildcards, extract the commonality between them. + ;; Then for each of those non-constant elements, extract the + ;; commonality between them. (let ((res ()) + (fixed "") ;; Accumulate each stretch of wildcards, and process them as a unit. (wildcards ())) ;; Make the implicit trailing `any' explicit. (dolist (elem (append pattern '(any))) (if (stringp elem) (progn - (push elem res) + (setq fixed (concat fixed elem)) (setq wildcards nil)) (let ((comps ())) (push elem wildcards) @@ -4664,13 +4667,18 @@ the same set of elements." ;; different capitalizations in different parts. ;; In practice, it doesn't seem to make any difference. (setq ccs (nreverse ccs)) - (let* ((prefix (try-completion "" comps)) - (unique (or (and (eq prefix t) (setq prefix "")) + ;; FIXED is a prefix of all of COMPS. Try to grow that prefix. + (let* ((prefix (try-completion fixed comps)) + (unique (or (and (eq prefix t) (setq prefix fixed)) (and (stringp prefix) ;; If PREFIX is equal to all of COMPS, ;; then PREFIX is a unique completion. (seq-every-p - (lambda (comp) (= (length prefix) (length comp))) + ;; PREFIX is still a prefix of all of + ;; COMPS, so if COMP is the same length, + ;; they're equal. + (lambda (comp) + (= (length prefix) (length comp))) comps))))) ;; If there's only one completion, `elem' is not useful ;; any more: it can only match the empty string. @@ -4685,7 +4693,7 @@ the same set of elements." ;; `prefix' only wants to include the fixed part before the ;; wildcard, not the result of growing that fixed part. (when (seq-some (lambda (elem) (eq elem 'prefix)) wildcards) - (setq prefix "")) + (setq prefix fixed)) (push prefix res) ;; Push all the wildcards in this stretch, to preserve `point' and ;; `star' wildcards before ELEM. @@ -4709,7 +4717,8 @@ the same set of elements." (unless (equal suffix "") (push suffix res)))) ;; We pushed these wildcards on RES, so we're done with them. - (setq wildcards nil)))))) + (setq wildcards nil)) + (setq fixed ""))))) ;; We return it in reverse order. res))))) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 99753f31330..de1a98c8189 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -332,6 +332,21 @@ "" '("fooxbar" "fooybar") nil 0) '("foobar" . 3)))) +(ert-deftest completion-pcm-test-anydelim () + ;; After each delimiter is a special wildcard which matches any + ;; sequence of delimiters. + (should (equal (completion-pcm-try-completion + "-x" '("-_.x" "-__x") nil 2) + '("-_x" . 3)))) + +(ert-deftest completion-pcm-bug4219 () + ;; With `completion-ignore-case', try-completion should change the + ;; case of existing text when the completions have different casing. + (should (equal + (let ((completion-ignore-case t)) + (completion-pcm-try-completion "a" '("ABC" "ABD") nil 1)) + '("AB" . 2)))) + (ert-deftest completion-substring-test-1 () ;; One third of a match! (should (equal commit d2532a4ef0a1c037075b8a9d44b2dbdce372ef25 Author: Philip Kaludercic Date: Fri Aug 22 15:05:12 2025 +0200 Add new library 'timeout' * lisp/emacs-lisp/timeout.el: Add the file. * etc/NEWS: Mention the library. See https://mail.gnu.org/archive/html/emacs-devel/2025-07/msg00520.html. diff --git a/etc/NEWS b/etc/NEWS index 02a556a557d..630d03a1fa0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2729,6 +2729,12 @@ enabled for files named "go.work". ** New package 'lua-mode'. The 'lua-mode' package from Non-GNU ELPA is now included in Emacs. +** New library 'timeout'. +This library that provides higher order functions to throttle or +debounce Elisp functions. This is useful for corraling over-eager code +that is slow and blocks Emacs or does not provide customization options +to limit how often it runs. + * Incompatible Lisp Changes in Emacs 31.1 diff --git a/lisp/emacs-lisp/timeout.el b/lisp/emacs-lisp/timeout.el new file mode 100644 index 00000000000..c949e7a912e --- /dev/null +++ b/lisp/emacs-lisp/timeout.el @@ -0,0 +1,243 @@ +;;; timeout.el --- Throttle or debounce Elisp functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2025 Free Software Foundation, Inc. + +;; Author: Karthik Chikmagalur +;; Maintainer: Karthik Chikmagalur +;; Keywords: convenience, extensions +;; Version: 2.0 +;; Package-Requires: ((emacs "24.4")) +;; URL: https://github.com/karthink/timeout + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; timeout is a small Elisp library that provides higher order functions to +;; throttle or debounce Elisp functions. This is useful for corralling +;; over-eager code that: +;; (i) is slow and blocks Emacs, and +;; (ii) does not provide customization options to limit how often it runs, +;; +;; To throttle a function FUNC to run no more than once every 2 seconds, run +;; (timeout-throttle 'func 2.0) +;; +;; To debounce a function FUNC to run after a delay of 0.3 seconds, run +;; (timeout-debounce 'func 0.3) +;; +;; To create a new throttled or debounced version of FUNC instead, run +;; +;; (timeout-throttled-func 'func 2.0) +;; (timeout-debounced-func 'func 0.3) +;; +;; You can bind this via `defalias': +;; +;; (defalias 'throttled-func (timeout-throttled-func 'func 2.0)) +;; +;; The interactive spec and documentation of FUNC is carried over to the new +;; function. + +;;; Code: + +(require 'nadvice) + +(defun timeout--throttle-advice (&optional timeout) + "Return a function that throttles its argument function. + +TIMEOUT defaults to 1 second. + +When FUNC does not run because of the throttle, the result from the +previous successful call is returned. + +This is intended for use as function advice." + (let ((throttle-timer) + (timeout (or timeout 1.0)) + (result)) + (lambda (orig-fn &rest args) + "Throttle calls to this function." + (prog1 result + (unless (and throttle-timer (timerp throttle-timer)) + (setq result (apply orig-fn args)) + (setq throttle-timer + (run-with-timer + timeout nil + (lambda () + (cancel-timer throttle-timer) + (setq throttle-timer nil))))))))) + +(defun timeout--debounce-advice (&optional delay default) + "Return a function that debounces its argument function. + +DELAY defaults to 0.50 seconds. The function returns immediately with +value DEFAULT when called the first time. On future invocations, the +result from the previous call is returned. + +This is intended for use as function advice." + (let ((debounce-timer nil) + (delay (or delay 0.50))) + (lambda (orig-fn &rest args) + "Debounce calls to this function." + (prog1 default + (if (timerp debounce-timer) + (timer-set-idle-time debounce-timer delay) + (setq debounce-timer + (run-with-idle-timer + delay nil + (lambda (buf) + (cancel-timer debounce-timer) + (setq debounce-timer nil) + (setq default + (if (buffer-live-p buf) + (with-current-buffer buf + (apply orig-fn args)) + (apply orig-fn args)))) + (current-buffer)))))))) + +(defun timeout-debounce (func &optional delay default) + "Debounce FUNC by making it run DELAY seconds after it is called. + +This advises FUNC, when called (interactively or from code), to +run after DELAY seconds. If FUNC is called again within this time, +the timer is reset. + +DELAY defaults to 0.5 seconds. Using a delay of 0 removes any +debounce advice. + +The function returns immediately with value DEFAULT when called the +first time. On future invocations, the result from the previous call is +returned." + (if (and delay (= delay 0)) + (advice-remove func 'debounce) + (advice-add func :around (timeout--debounce-advice delay default) + '((name . debounce) + (depth . -99))))) + +(defun timeout-throttle (func &optional throttle) + "Make FUNC run no more frequently than once every THROTTLE seconds. + +THROTTLE defaults to 1 second. Using a throttle of 0 removes any +throttle advice. + +When FUNC does not run because of the throttle, the result from the +previous successful call is returned." + (if (and throttle (= throttle 0)) + (advice-remove func 'throttle) + (advice-add func :around (timeout--throttle-advice throttle) + '((name . throttle) + (depth . -98))))) + +(defun timeout-throttled-func (func &optional throttle) + "Return a throttled version of function FUNC. + +The throttled function runs no more frequently than once every THROTTLE +seconds. THROTTLE defaults to 1 second. + +When FUNC does not run because of the throttle, the result from the +previous successful call is returned." + (let ((throttle-timer nil) + (throttle (or throttle 1)) + (result)) + (if (commandp func) + ;; INTERACTIVE version + (lambda (&rest args) + (:documentation + (concat + (documentation func) + (format "\n\nThrottle calls to this function by %f seconds" throttle))) + (interactive (advice-eval-interactive-spec + (cadr (interactive-form func)))) + (prog1 result + (unless (and throttle-timer (timerp throttle-timer)) + (setq result (apply func args)) + (setq throttle-timer + (run-with-timer + throttle nil + (lambda () + (cancel-timer throttle-timer) + (setq throttle-timer nil))))))) + ;; NON-INTERACTIVE version + (lambda (&rest args) + (:documentation + (concat + (documentation func) + (format "\n\nThrottle calls to this function by %f seconds" throttle))) + (prog1 result + (unless (and throttle-timer (timerp throttle-timer)) + (setq result (apply func args)) + (setq throttle-timer + (run-with-timer + throttle nil + (lambda () + (cancel-timer throttle-timer) + (setq throttle-timer nil)))))))))) + +(defun timeout-debounced-func (func &optional delay default) + "Return a debounced version of function FUNC. + +The debounced function runs DELAY seconds after it is called. DELAY +defaults to 0.5 seconds. + +The function returns immediately with value DEFAULT when called the +first time. On future invocations, the result from the previous call is +returned." + (let ((debounce-timer nil) + (delay (or delay 0.50))) + (if (commandp func) + ;; INTERACTIVE version + (lambda (&rest args) + (:documentation + (concat + (documentation func) + (format "\n\nDebounce calls to this function by %f seconds" delay))) + (interactive (advice-eval-interactive-spec + (cadr (interactive-form func)))) + (prog1 default + (if (timerp debounce-timer) + (timer-set-idle-time debounce-timer delay) + (setq debounce-timer + (run-with-idle-timer + delay nil + (lambda (buf) + (cancel-timer debounce-timer) + (setq debounce-timer nil) + (setq default + (if (buffer-live-p buf) + (with-current-buffer buf + (apply func args)) + (apply func args)))) + (current-buffer)))))) + ;; NON-INTERACTIVE version + (lambda (&rest args) + (:documentation + (concat + (documentation func) + (format "\n\nDebounce calls to this function by %f seconds" delay))) + (prog1 default + (if (timerp debounce-timer) + (timer-set-idle-time debounce-timer delay) + (setq debounce-timer + (run-with-idle-timer + delay nil + (lambda (buf) + (cancel-timer debounce-timer) + (setq debounce-timer nil) + (setq default + (if (buffer-live-p buf) + (with-current-buffer buf + (apply func args)) + (apply func args)))) + (current-buffer))))))))) + +(provide 'timeout) +;;; timeout.el ends here commit b52ccb997d598caa321141c0abb553d3b3803eee Author: Mattias Engdegård Date: Mon Sep 1 16:50:10 2025 +0200 ; * lisp/emacs-lisp/bytecomp.el (featurep): mistake in last change diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 45a11af9a74..4fc56ae4b5d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5885,7 +5885,7 @@ and corresponding effects." ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so ;; we can safely optimize away this test. (if (and (member feature '('xemacs 'sxemacs 'emacs)) (not rest)) - (featurep feature) + (featurep (cadr feature)) form))) ;; Report comma operator used outside of backquote. commit 9c21c112770949b23829d2f3ad319d6b0fb9d089 Author: Eli Zaretskii Date: Mon Sep 1 17:35:38 2025 +0300 ; Improve documentation of 'treesit-enabled-modes' * lisp/treesit.el (treesit-enabled-modes): Doc fix. * doc/emacs/modes.texi (Choosing Modes): Extend and improve wording of a recently-added text. diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index 4a9d753bf6f..b5049ccbd01 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -508,12 +508,23 @@ this variable overrides any remapping that Emacs might decide to perform internally. @vindex treesit-enabled-modes - For extra convenience of enabling major modes based on the tree-sitter, -the user option @code{treesit-enabled-modes} supports the value @code{t} -that enables all available tree-sitter based modes, or a list of mode -names to enable like @code{c-ts-mode}. After customizing this option, -it adds the corresponding mappings to @code{major-mode-remap-alist} such -as remapping from @code{c-mode} to @code{c-ts-mode}. + As a convenience feature for enabling major modes based on the +tree-sitter library (@pxref{Parsing Program Source,,, elisp, The Emacs +Lisp Reference Manual}), you can customize the user option +@code{treesit-enabled-modes} to selectively enable or disable +tree-sitter based modes: if the value is @code{t}, that enables all the +available tree-sitter based modes; if it is a list of mode names, that +enables only those modes. Customizing this option adds the +corresponding mappings to @code{major-mode-remap-alist} such as +remapping from @code{c-mode} to @code{c-ts-mode} (if you enable the +latter). By default, this option's value is @code{nil}, so no +tree-sitter based modes are enabled. + +Enabling a tree-stter based mode means that visiting files in the +corresponding programming language will automatically turn on that mode, +instead of any non-tree-sitter based modes for the same language. For +example, if you enable @code{c-ts-mode}, visiting C source files will +turn on @code{c-ts-mode} instead of @code{c-mode}. @findex normal-mode If you have changed the major mode of a buffer, you can return to diff --git a/lisp/treesit.el b/lisp/treesit.el index 218f4c7b36e..36d6c875d45 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -5404,13 +5404,19 @@ Tree-sitter grammar for `%s' is missing; install it?" ;;;###autoload (defcustom treesit-enabled-modes nil - "Specify what treesit modes to enable by default. + "Specify which tree-sitter based major modes to enable by default. The value can be either a list of ts-modes to enable, -or t to enable all ts-modes." +or t to enable all ts-modes. The value nil (the default) +means not to enable any tree-sitter based modes. + +Enabling a tree-stter based mode means that visiting files in the +corresponding programming language will automatically turn on that +mode, instead of any non-tree-sitter based modes for the same +language." :type `(choice - (const :tag "Disable all automatic associations" nil) - (const :tag "Enable all available ts-modes" t) - (set :tag "List of enabled ts-modes" + (const :tag "Disable all tree-sitter modes" nil) + (const :tag "Enable all available tree-sitter modes" t) + (set :tag "Enable specific tree-sitter modes" ,@(when (treesit-available-p) (sort (mapcar (lambda (m) `(function-item ,m)) (seq-uniq (mapcar #'cdr treesit-major-mode-remap-alist))))))) commit 838e8e4140a36d070695575c24b34fe2b3092299 Author: Sean Whitton Date: Mon Sep 1 15:27:57 2025 +0100 New project-find-matching-buffer-function for diff-mode * lisp/vc/diff-mode.el (project-root): Declare. (diff-find-matching-buffer): New function. (diff-mode): Use it. * doc/emacs/vc1-xtra.texi (Other Working Trees): Document 'C-x v w w' in diff-mode buffers. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 5801604204c..62311e583b2 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -516,7 +516,7 @@ following subsections. You can use @kbd{C-x v v} either in a file-visiting buffer, in a Dired buffer, or in a VC Directory buffer; in the latter two cases the command operates on the fileset consisting of the marked files. You can also use @kbd{C-x v v}, in a buffer with -patches under Diff Mode (@pxref{Diff Mode}), in which case the command +patches under Diff mode (@pxref{Diff Mode}), in which case the command operates on the files whose diffs are shown in the buffer. Note that VC filesets are distinct from the named filesets used diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 41058aefce5..f235ccfa5fb 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -473,6 +473,16 @@ do and do not exist. In other words, the file or directory the current buffer visits probably exists in other working trees too, and this command lets you switch to those versions of the file. +@kbd{C-x v w w} also works in Diff mode (@pxref{Diff Mode}). Instead of +switching to a different buffer, the command changes the default +directory of the Diff mode buffer to the corresponding directory under +another working tree. This is useful with Diff mode buffers generated +by VC commands, such as @kbd{C-x v =} and @kbd{C-x v D} (@pxref{Old +Revisions}). You can use @kbd{C-x v w w} and then standard Diff mode +commands like @w{@kbd{C-c C-a}} (@code{diff-apply-hunk}) and @kbd{C-c +RET C-a} (@code{diff-apply-buffer}) to apply hunks from one working tree +to another. + @kindex C-x v w s @findex vc-working-tree-switch-project An alternative way to switch between working trees is @kbd{C-x v w s} diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 965ab861e05..c33263f5f4a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1642,6 +1642,7 @@ In read-only buffers the following bindings are also available: (add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local) (setq-local imenu-generic-expression diff-imenu-generic-expression) + (setq-local project-find-matching-buffer-function #'diff-find-matching-buffer) ;; These are not perfect. They would be better done separately for ;; context diffs and unidiffs. ;; (setq-local paragraph-start @@ -3358,6 +3359,28 @@ hunk text is not found in the source file." ) str) +(declare-function project-root "project") + +(defun diff-find-matching-buffer (current-project mirror-project) + "Change default directory to matching one under another project. +CURRENT-PROJECT is the project instance for the current project. +MIRROR-PROJECT is the project instance for the project to visit. +A matching directory has the same name relative to the project root. +If a matching directory does not exist in the other project, it is an +error (this avoids invalidating the relative file names in Diff mode +file headers). + +This function is intended to be used as the value of +`project-find-matching-buffer-function' in Diff mode buffers." + (let* ((mirror-root (project-root mirror-project)) + (relative-name (file-relative-name default-directory + (project-root current-project))) + (mirror-name (expand-file-name relative-name mirror-root))) + (if (file-directory-p mirror-name) + (message "Default directory changed to `%s'" + (setq default-directory mirror-name)) + (user-error "`%s' not found in `%s'" relative-name mirror-root)))) + ;;; Support for converting a diff to diff3 markers via `wiggle'. ;; Wiggle can be found at https://neil.brown.name/wiggle/ or in your nearest commit 985657e5158b1eacf4d4d53bff5e3e0ca1e98af1 Author: Mattias Engdegård Date: Mon Sep 1 15:13:58 2025 +0200 ; * src/data.c (Fash): GCC argument signedness quibble diff --git a/src/data.c b/src/data.c index 202ab0a2a36..5b3c9792ea0 100644 --- a/src/data.c +++ b/src/data.c @@ -3554,7 +3554,7 @@ discarding bits. */) else if (FIXNUMP (value)) { EMACS_INT v = XFIXNUM (value); - if (stdc_leading_zeros (v < 0 ? ~v : v) - c + if (stdc_leading_zeros ((EMACS_UINT)(v < 0 ? ~v : v)) - c >= EMACS_INT_WIDTH - FIXNUM_BITS + 1) return make_fixnum (v << c); } commit bbc9ed387193efb57b5dd0179057a343ef16b006 Author: Mattias Engdegård Date: Mon Sep 1 12:51:15 2025 +0200 * src/data.c (Fash): Speed up when argument and result are fixnums. diff --git a/src/data.c b/src/data.c index b8a48203bcf..202ab0a2a36 100644 --- a/src/data.c +++ b/src/data.c @@ -3523,10 +3523,10 @@ discarding bits. */) CHECK_INTEGER (value); CHECK_INTEGER (count); + if (BASE_EQ (value, make_fixnum (0))) + return value; if (! FIXNUMP (count)) { - if (BASE_EQ (value, make_fixnum (0))) - return value; if (mpz_sgn (*xbignum_val (count)) < 0) { EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value) @@ -3536,30 +3536,38 @@ discarding bits. */) overflow_error (); } - if (XFIXNUM (count) <= 0) + EMACS_INT c = XFIXNUM (count); + if (c <= 0) { - if (XFIXNUM (count) == 0) + if (c == 0) return value; if ((EMACS_INT) -1 >> 1 == -1 && FIXNUMP (value)) { - EMACS_INT shift = -XFIXNUM (count); + EMACS_INT shift = -c; EMACS_INT result = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift : XFIXNUM (value) < 0 ? -1 : 0); return make_fixnum (result); } } + else if (FIXNUMP (value)) + { + EMACS_INT v = XFIXNUM (value); + if (stdc_leading_zeros (v < 0 ? ~v : v) - c + >= EMACS_INT_WIDTH - FIXNUM_BITS + 1) + return make_fixnum (v << c); + } mpz_t const *zval = bignum_integer (&mpz[0], value); - if (XFIXNUM (count) < 0) + if (c < 0) { - if (TYPE_MAXIMUM (mp_bitcnt_t) < - XFIXNUM (count)) + if (TYPE_MAXIMUM (mp_bitcnt_t) < -c) return make_fixnum (mpz_sgn (*zval) < 0 ? -1 : 0); - mpz_fdiv_q_2exp (mpz[0], *zval, - XFIXNUM (count)); + mpz_fdiv_q_2exp (mpz[0], *zval, -c); } else - emacs_mpz_mul_2exp (mpz[0], *zval, XFIXNUM (count)); + emacs_mpz_mul_2exp (mpz[0], *zval, c); return make_integer_mpz (); } commit 7c6de4fe73334e45deb4954bfe56e43808471eca Author: Mattias Engdegård Date: Sun Aug 31 19:05:36 2025 +0200 * lisp/emacs-lisp/bytecomp.el (featurep): Safer comp-time evaluation diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f48be896ca5..45a11af9a74 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5881,11 +5881,11 @@ and corresponding effects." ;;; Core compiler macros. (put 'featurep 'compiler-macro - (lambda (form feature &rest _ignore) + (lambda (form feature &rest rest) ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so ;; we can safely optimize away this test. - (if (member feature '('xemacs 'sxemacs 'emacs)) - (eval form) + (if (and (member feature '('xemacs 'sxemacs 'emacs)) (not rest)) + (featurep feature) form))) ;; Report comma operator used outside of backquote. commit 66ef930ebea4618c1dac71a09495766476ced1d6 Author: Sean Whitton Date: Mon Sep 1 09:41:40 2025 +0100 Rename arg REMOTE-LOCATION -> UPSTREAM-LOCATION * lisp/vc/vc-bzr.el (vc-bzr-log-incoming) (vc-bzr-incoming-revision, vc-bzr-log-outgoing): * lisp/vc/vc-git.el (vc-git-incoming-revision): * lisp/vc/vc-hg.el (vc-hg-incoming-revision): * lisp/vc/vc.el (vc-root-diff-incoming, vc-diff-incoming) (vc-root-diff-outgoing, vc-diff-outgoing) (vc-root-diff-outgoing-base, vc-diff-outgoing-base) (vc-incoming-outgoing-internal, vc-remote-location-history) (vc--incoming-revision, vc-log-incoming, vc-default-log-incoming) (vc-log-outgoing, vc-default-log-outgoing): Rename arguments REMOTE-LOCATION -> UPSTREAM-LOCATION. Adjust strings. (vc--maybe-read-remote-location): Rename ... (vc--maybe-read-upstream-location): ... to this. diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index fcec13cf24e..df8005309ce 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -817,27 +817,27 @@ If LIMIT is non-nil, show no more than this many entries." (buffer-substring (match-end 0) (point-max))))) ;; FIXME: Implement `vc-bzr-mergebase' and then delete this. -(defun vc-bzr-log-incoming (buffer remote-location) +(defun vc-bzr-log-incoming (buffer upstream-location) (apply #'vc-bzr-command "missing" buffer 'async nil - (list "--theirs-only" (and (not (string-empty-p remote-location)) - remote-location)))) + (list "--theirs-only" (and (not (string-empty-p upstream-location)) + upstream-location)))) -(defun vc-bzr-incoming-revision (remote-location &optional _refresh) +(defun vc-bzr-incoming-revision (upstream-location &optional _refresh) (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)) + (and (not (string-empty-p upstream-location)) + upstream-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) +(defun vc-bzr-log-outgoing (buffer upstream-location) (apply #'vc-bzr-command "missing" buffer 'async nil - (list "--mine-only" (and (not (string-empty-p remote-location)) - remote-location)))) + (list "--mine-only" (and (not (string-empty-p upstream-location)) + upstream-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-git.el b/lisp/vc/vc-git.el index 99203402d88..5e2f0e5bb20 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -70,7 +70,7 @@ ;; - get-change-comment (files rev) OK ;; HISTORY FUNCTIONS ;; * print-log (files buffer &optional shortlog start-revision limit) OK -;; * incoming-revision (remote-location &optional refresh) OK +;; * incoming-revision (upstream-location &optional refresh) OK ;; - log-search (buffer pattern) OK ;; - log-view-mode () OK ;; - show-log-entry (revision) OK @@ -1605,16 +1605,16 @@ If LIMIT is a non-empty string, use it as a base revision." start-revision)) '("--"))))))) -(defun vc-git-incoming-revision (remote-location &optional refresh) - (let ((rev (if (string-empty-p remote-location) +(defun vc-git-incoming-revision (upstream-location &optional refresh) + (let ((rev (if (string-empty-p upstream-location) "@{upstream}" - remote-location))) + upstream-location))) (when (or refresh (null (vc-git--rev-parse rev))) (vc-git-command nil 0 nil "fetch" - (and (not (string-empty-p remote-location)) + (and (not (string-empty-p upstream-location)) ;; Extract remote from "remote/branch". (replace-regexp-in-string "/.*" "" - remote-location)))) + upstream-location)))) (ignore-errors ; in order to return nil if no such branch (with-output-to-string (vc-git-command standard-output 0 nil diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index c867da5d34f..32725f6b5fb 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1531,19 +1531,19 @@ This runs the command \"hg summary\"." (nreverse result)) "\n")))) -(defun vc-hg-incoming-revision (remote-location &optional _refresh) - (let* ((remote-location (if (string-empty-p remote-location) +(defun vc-hg-incoming-revision (upstream-location &optional _refresh) + (let* ((upstream-location (if (string-empty-p upstream-location) "default" - remote-location)) + upstream-location)) ;; Use 'hg identify' like this, and not 'hg incoming', because ;; this will give a sensible answer regardless of whether the ;; incoming revision has been pulled yet. (rev (with-output-to-string (vc-hg-command standard-output 0 nil "identify" "--id" - remote-location "--template={node}")))) + upstream-location "--template={node}")))) (condition-case _ (vc-hg-command nil 0 nil "log" "-r" rev) ;; We don't have the revision locally. Pull it. - (error (vc-hg-command nil 0 nil "pull" remote-location))) + (error (vc-hg-command nil 0 nil "pull" upstream-location))) rev)) (defun vc-hg-mergebase (rev1 &optional rev2) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 3349231df92..8b918654242 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -396,27 +396,27 @@ ;; revision shown, rather than the working revision, which is normally ;; the case). Not all backends support this. ;; -;; - log-outgoing (buffer remote-location) (DEPRECATED) +;; - log-outgoing (buffer upstream-location) (DEPRECATED) ;; ;; Insert in BUFFER the revision log for the changes that will be -;; sent when performing a push operation to REMOTE-LOCATION. +;; sent when performing a push operation to UPSTREAM-LOCATION. ;; Deprecated: implement incoming-revision and mergebase instead. ;; -;; - log-incoming (buffer remote-location) (DEPRECATED) +;; - log-incoming (buffer upstream-location) (DEPRECATED) ;; ;; Insert in BUFFER the revision log for the changes that will be -;; received when performing a pull operation from REMOTE-LOCATION. +;; received when performing a pull operation from UPSTREAM-LOCATION. ;; Deprecated: implement incoming-revision and mergebase instead. ;; -;; * incoming-revision (remote-location &optional refresh) +;; * incoming-revision (upstream-location &optional refresh) ;; -;; Return revision at the head of the branch at REMOTE-LOCATION. +;; Return revision at the head of the branch at UPSTREAM-LOCATION. ;; If there is no such branch there, return nil. (Should signal an ;; error, not return nil, in the case that fetching data fails.) ;; For a distributed VCS, should also fetch that revision into local ;; storage for operating on by subsequent calls into the backend. ;; The backend may rely on cached information from a previous fetch -;; from REMOTE-LOCATION unless REFRESH is non-nil, which means that +;; from UPSTREAM-LOCATION unless REFRESH is non-nil, which means that ;; the most up-to-date information possible is required. ;; ;; - log-search (buffer pattern) @@ -2539,33 +2539,36 @@ The merge base is a common ancestor between REV1 and REV2 revisions." (called-interactively-p 'interactive))))) ;;;###autoload -(defun vc-root-diff-incoming (&optional remote-location) - "Report diff of all changes that would be pulled from REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name. +(defun vc-root-diff-incoming (&optional upstream-location) + "Report diff of all changes that would be pulled from UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull +from. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name. See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." - (interactive (list (vc--maybe-read-remote-location))) + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-diff" - (vc-diff-incoming remote-location `(,backend (,rootdir))))) + (vc-diff-incoming upstream-location `(,backend (,rootdir))))) ;;;###autoload -(defun vc-diff-incoming (&optional remote-location fileset) - "Report changes to VC fileset that would be pulled from REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name. -When called from Lisp optional argument FILESET overrides the VC fileset. +(defun vc-diff-incoming (&optional upstream-location fileset) + "Report changes to VC fileset that would be pulled from UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull +from. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name. +When called from Lisp optional argument FILESET overrides the VC +fileset. See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." - (interactive (list (vc--maybe-read-remote-location) nil)) + (interactive (list (vc--maybe-read-upstream-location) nil)) (let* ((fileset (or fileset (vc-deduce-fileset t))) (backend (car fileset)) (incoming (vc--incoming-revision backend - (or remote-location "") + (or upstream-location "") 'refresh))) (vc-diff-internal vc-allow-async-diff fileset (vc-call-backend backend 'mergebase incoming) @@ -2573,28 +2576,31 @@ global binding." (called-interactively-p 'interactive)))) ;;;###autoload -(defun vc-root-diff-outgoing (&optional remote-location) - "Report diff of all changes that would be pushed to REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name. +(defun vc-root-diff-outgoing (&optional upstream-location) + "Report diff of all changes that would be pushed to UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name. This command is like `vc-root-diff-outgoing-base' except that it does not include uncommitted changes. See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding." - (interactive (list (vc--maybe-read-remote-location))) + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-diff" - (vc-diff-outgoing remote-location `(,backend (,rootdir))))) + (vc-diff-outgoing upstream-location `(,backend (,rootdir))))) ;;;###autoload -(defun vc-diff-outgoing (&optional remote-location fileset) - "Report changes to VC fileset that would be pushed to REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name. -When called from Lisp optional argument FILESET overrides the VC fileset. +(defun vc-diff-outgoing (&optional upstream-location fileset) + "Report changes to VC fileset that would be pushed to UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name. +When called from Lisp optional argument FILESET overrides the VC +fileset. This command is like `vc-diff-outgoing-base' except that it does not include uncommitted changes. @@ -2606,11 +2612,11 @@ global binding." ;; for those VCS is to make a comparison between locally committed ;; changes and remote committed changes. ;; (Hence why we don't call `vc-buffer-sync-fileset'.) - (interactive (list (vc--maybe-read-remote-location))) + (interactive (list (vc--maybe-read-upstream-location))) (let* ((fileset (or fileset (vc-deduce-fileset t))) (backend (car fileset)) (incoming (vc--incoming-revision backend - (or remote-location "")))) + (or upstream-location "")))) (vc-diff-internal vc-allow-async-diff fileset (vc-call-backend backend 'mergebase incoming) ;; FIXME: In order to exclude uncommitted @@ -2640,7 +2646,7 @@ global binding." (called-interactively-p 'interactive)))) ;; For the following two commands, the default meaning for -;; REMOTE-LOCATION may become dependent on whether we are on a +;; UPSTREAM-LOCATION may become dependent on whether we are on a ;; shorter-lived or longer-lived ("trunk") branch. If we are on the ;; trunk then it will always be the place `vc-push' would push to. If ;; we are on a shorter-lived branch, it may instead become the remote @@ -2656,49 +2662,49 @@ global binding." ;; --spwhitton ;;;###autoload -(defun vc-root-diff-outgoing-base (&optional remote-location) - "Report diff of all changes since the merge base with REMOTE-LOCATION. -The merge base with REMOTE-LOCATION means the common ancestor of the -working revision and REMOTE-LOCATION. +(defun vc-root-diff-outgoing-base (&optional upstream-location) + "Report diff of all changes since the merge base with UPSTREAM-LOCATION. +The merge base with UPSTREAM-LOCATION means the common ancestor of the +working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -This default meaning for REMOTE-LOCATION may change in a future release -of Emacs. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. This default meaning for UPSTREAM-LOCATION may change in a future +release of Emacs. When called interactively with a prefix argument, prompt for -REMOTE-LOCATION. In some version control systems, REMOTE-LOCATION can -be a remote branch name. +UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION +can be a remote branch name. This command is like `vc-root-diff-outgoing' except that it includes uncommitted changes." - (interactive (list (vc--maybe-read-remote-location))) + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-diff" - (vc-diff-outgoing-base remote-location `(,backend (,rootdir))))) + (vc-diff-outgoing-base upstream-location `(,backend (,rootdir))))) ;;;###autoload -(defun vc-diff-outgoing-base (&optional remote-location fileset) - "Report changes to VC fileset since the merge base with REMOTE-LOCATION. +(defun vc-diff-outgoing-base (&optional upstream-location fileset) + "Report changes to VC fileset since the merge base with UPSTREAM-LOCATION. -The merge base with REMOTE-LOCATION means the common ancestor of the -working revision and REMOTE-LOCATION. +The merge base with UPSTREAM-LOCATION means the common ancestor of the +working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -This default meaning for REMOTE-LOCATION may change in a future release -of Emacs. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. This default meaning for UPSTREAM-LOCATION may change in a future +release of Emacs. When called interactively with a prefix argument, prompt for -REMOTE-LOCATION. In some version control systems, REMOTE-LOCATION can -be a remote branch name. +UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION +can be a remote branch name. This command is like to `vc-fileset-diff-outgoing' except that it includes uncommitted changes." - (interactive (list (vc--maybe-read-remote-location) nil)) + (interactive (list (vc--maybe-read-upstream-location) nil)) (let* ((fileset (or fileset (vc-deduce-fileset t))) (backend (car fileset)) (incoming (vc--incoming-revision backend - (or remote-location "")))) + (or upstream-location "")))) (vc-diff-internal vc-allow-async-diff fileset (vc-call-backend backend 'mergebase incoming) nil @@ -3442,15 +3448,15 @@ Each function runs in the log output buffer without args.") (set-buffer-modified-p nil) (run-hooks 'vc-log-finish-functions))))) -(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type) +(defun vc-incoming-outgoing-internal (backend upstream-location buffer-name type) (vc-log-internal-common backend buffer-name nil type (lambda (bk buf type-arg _files) - (vc-call-backend bk type-arg buf remote-location)) + (vc-call-backend bk type-arg buf upstream-location)) (lambda (_bk _files-arg _ret) nil) nil ;; Don't move point. (lambda (_ignore-auto _noconfirm) - (vc-incoming-outgoing-internal backend remote-location buffer-name type)))) + (vc-incoming-outgoing-internal backend upstream-location buffer-name type)))) ;;;###autoload (defun vc-print-log (&optional working-revision limit) @@ -3544,50 +3550,53 @@ The command prompts for the branch whose change log to show." (list rootdir) branch t (when (> vc-log-show-limit 0) vc-log-show-limit)))) +;; FIXME: Consider renaming to `vc-upstream-location-history'. (defvar vc-remote-location-history nil - "History for remote locations for VC incoming and outgoing commands.") + "History of upstream locations for VC incoming and outgoing commands.") -(defun vc--maybe-read-remote-location () +(defun vc--maybe-read-upstream-location () (and current-prefix-arg - (read-string "Remote location/branch (empty for default): " nil + (read-string "Upstream location/branch (empty for default): " nil 'vc-remote-location-history))) -(defun vc--incoming-revision (backend remote-location &optional refresh) - (or (vc-call-backend backend 'incoming-revision remote-location refresh) +(defun vc--incoming-revision (backend upstream-location &optional refresh) + (or (vc-call-backend backend 'incoming-revision upstream-location refresh) (user-error "No incoming revision -- local-only branch?"))) ;;;###autoload -(defun vc-log-incoming (&optional remote-location) - "Show log of changes that will be received with pull from REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name." - (interactive (list (vc--maybe-read-remote-location))) +(defun vc-log-incoming (&optional upstream-location) + "Show log of changes that will be received with pull from UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull +from. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name." + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-log" - (vc-incoming-outgoing-internal backend (or remote-location "") + (vc-incoming-outgoing-internal backend (or upstream-location "") "*vc-incoming*" 'log-incoming))) -(defun vc-default-log-incoming (_backend buffer remote-location) +(defun vc-default-log-incoming (_backend buffer upstream-location) (vc--with-backend-in-rootdir "" - (let ((incoming (vc--incoming-revision backend remote-location 'refresh))) + (let ((incoming (vc--incoming-revision backend upstream-location 'refresh))) (vc-call-backend backend 'print-log (list rootdir) buffer t incoming (vc-call-backend backend 'mergebase incoming))))) ;;;###autoload -(defun vc-log-outgoing (&optional remote-location) - "Show log of changes that will be sent with a push operation to REMOTE-LOCATION. -When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION. -In some version control systems REMOTE-LOCATION can be a remote branch name." - (interactive (list (vc--maybe-read-remote-location))) +(defun vc-log-outgoing (&optional upstream-location) + "Show log of changes that will be sent with a push to UPSTREAM-LOCATION. +When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push +to. When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION +can be a remote branch name." + (interactive (list (vc--maybe-read-upstream-location))) (vc--with-backend-in-rootdir "VC root-log" - (vc-incoming-outgoing-internal backend (or remote-location "") + (vc-incoming-outgoing-internal backend (or upstream-location "") "*vc-outgoing*" 'log-outgoing))) -(defun vc-default-log-outgoing (_backend buffer remote-location) +(defun vc-default-log-outgoing (_backend buffer upstream-location) (vc--with-backend-in-rootdir "" - (let ((incoming (vc--incoming-revision backend remote-location))) + (let ((incoming (vc--incoming-revision backend upstream-location))) (vc-call-backend backend 'print-log (list rootdir) buffer t "" (vc-call-backend backend 'mergebase incoming))))) diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index 02be0e722e4..c9e2a4cac09 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -73,8 +73,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 upstream-location) +;; - log-incoming (backend upstream-location) ;; - log-view-mode () ;; - show-log-entry (revision) ;; - comment-history (file) commit fa256f11ed75b6bcf4c34443d970101cb239022e Author: Sean Whitton Date: Mon Sep 1 09:32:40 2025 +0100 VC outgoing commands for Git: Don't unconditionally fetch * lisp/vc/vc-bzr.el (vc-bzr-incoming-revision): * lisp/vc/vc-hg.el (vc-hg-incoming-revision): * lisp/vc/vc.el (vc-diff-incoming, vc--incoming-revision): New REFRESH optional argument. (vc-default-log-incoming): Pass it. * lisp/vc/vc-git.el (vc-git-incoming-revision): New REFRESH optional argument. When nil, use cached info (bug#62940). diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index f345a1b2779..fcec13cf24e 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -822,7 +822,7 @@ If LIMIT is non-nil, show no more than this many entries." (list "--theirs-only" (and (not (string-empty-p remote-location)) remote-location)))) -(defun vc-bzr-incoming-revision (remote-location) +(defun vc-bzr-incoming-revision (remote-location &optional _refresh) (with-temp-buffer (vc-bzr-command "missing" t 1 nil "--log-format=long" "--show-ids" diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index b5da03764d1..99203402d88 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -70,7 +70,7 @@ ;; - get-change-comment (files rev) OK ;; HISTORY FUNCTIONS ;; * print-log (files buffer &optional shortlog start-revision limit) OK -;; * incoming-revision (remote-location) OK +;; * incoming-revision (remote-location &optional refresh) OK ;; - log-search (buffer pattern) OK ;; - log-view-mode () OK ;; - show-log-entry (revision) OK @@ -1605,19 +1605,20 @@ If LIMIT is a non-empty string, use it as a base revision." start-revision)) '("--"))))))) -(defun vc-git-incoming-revision (remote-location) - (vc-git-command nil 0 nil "fetch" - (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-incoming-revision (remote-location &optional refresh) + (let ((rev (if (string-empty-p remote-location) + "@{upstream}" + remote-location))) + (when (or refresh (null (vc-git--rev-parse rev))) + (vc-git-command nil 0 nil "fetch" + (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" rev))))) (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 550d13f9adc..c867da5d34f 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1531,7 +1531,7 @@ This runs the command \"hg summary\"." (nreverse result)) "\n")))) -(defun vc-hg-incoming-revision (remote-location) +(defun vc-hg-incoming-revision (remote-location &optional _refresh) (let* ((remote-location (if (string-empty-p remote-location) "default" remote-location)) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 229ec112bed..3349231df92 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -408,13 +408,16 @@ ;; received when performing a pull operation from REMOTE-LOCATION. ;; Deprecated: implement incoming-revision and mergebase instead. ;; -;; * incoming-revision (remote-location) +;; * incoming-revision (remote-location &optional refresh) ;; ;; 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.) ;; For a distributed VCS, should also fetch that revision into local ;; storage for operating on by subsequent calls into the backend. +;; The backend may rely on cached information from a previous fetch +;; from REMOTE-LOCATION unless REFRESH is non-nil, which means that +;; the most up-to-date information possible is required. ;; ;; - log-search (buffer pattern) ;; @@ -2562,7 +2565,8 @@ global binding." (let* ((fileset (or fileset (vc-deduce-fileset t))) (backend (car fileset)) (incoming (vc--incoming-revision backend - (or remote-location "")))) + (or remote-location "") + 'refresh))) (vc-diff-internal vc-allow-async-diff fileset (vc-call-backend backend 'mergebase incoming) incoming @@ -3548,8 +3552,8 @@ The command prompts for the branch whose change log to show." (read-string "Remote location/branch (empty for default): " nil 'vc-remote-location-history))) -(defun vc--incoming-revision (backend remote-location) - (or (vc-call-backend backend 'incoming-revision remote-location) +(defun vc--incoming-revision (backend remote-location &optional refresh) + (or (vc-call-backend backend 'incoming-revision remote-location refresh) (user-error "No incoming revision -- local-only branch?"))) ;;;###autoload @@ -3565,7 +3569,7 @@ In some version control systems REMOTE-LOCATION can be a remote branch name." (defun vc-default-log-incoming (_backend buffer remote-location) (vc--with-backend-in-rootdir "" - (let ((incoming (vc--incoming-revision backend remote-location))) + (let ((incoming (vc--incoming-revision backend remote-location 'refresh))) (vc-call-backend backend 'print-log (list rootdir) buffer t incoming (vc-call-backend backend 'mergebase incoming)))))