1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

Pass the VC backend down through fns called by vc--count-revisions

* lisp/vc/vc-hooks.el (vc--repo-setprop, vc--repo-getprop)
(vc--repo-clearprops):
* lisp/vc/vc.el (vc-root-dir): New BACKEND parameter.
(vc--incoming-revision, vc-push): Pass it.
(vc-default-log-incoming, vc-default-log-outgoing): Pass down
BACKEND provided by caller, instead of ignoring it and always
calling vc-deduce-backend (bug#79929).
This commit is contained in:
Sean Whitton 2025-12-03 11:19:12 +00:00
parent f15e98afb6
commit 34331ae6f9
2 changed files with 34 additions and 32 deletions

View file

@ -259,17 +259,17 @@ VC commands are globally reachable under the prefix \\[vc-prefix-map]:
(kill-local-variable 'vc-parent-buffer)) (kill-local-variable 'vc-parent-buffer))
(setplist (intern (expand-file-name file) vc-file-prop-obarray) nil)) (setplist (intern (expand-file-name file) vc-file-prop-obarray) nil))
(defun vc--repo-setprop (property value) (defun vc--repo-setprop (backend property value)
"Set per-repository VC PROPERTY to VALUE and return the value." "Set per-repository VC PROPERTY to VALUE and return the value."
(vc-file-setprop (vc-root-dir) property value)) (vc-file-setprop (vc-root-dir backend) property value))
(defun vc--repo-getprop (property) (defun vc--repo-getprop (backend property)
"Get per-repository VC PROPERTY." "Get per-repository VC PROPERTY."
(vc-file-getprop (vc-root-dir) property)) (vc-file-getprop (vc-root-dir backend) property))
(defun vc--repo-clearprops () (defun vc--repo-clearprops (backend)
"Clear all VC whole-repository properties." "Clear all VC whole-repository properties."
(vc-file-clearprops (vc-root-dir))) (vc-file-clearprops (vc-root-dir backend)))
;; We keep properties on each symbol naming a backend as follows: ;; We keep properties on each symbol naming a backend as follows:

View file

@ -3239,17 +3239,17 @@ saving the buffer."
(called-interactively-p 'interactive)))))) (called-interactively-p 'interactive))))))
;;;###autoload ;;;###autoload
(defun vc-root-dir () (defun vc-root-dir (&optional backend)
"Return the root directory for the current VC tree. "Return the root directory for the current VC tree.
Return nil if the root directory cannot be identified." Return nil if the root directory cannot be identified.
(let ((backend (vc-deduce-backend))) BACKEND is the VC backend."
(if backend (and-let* ((backend (or backend (vc-deduce-backend))))
(condition-case err (condition-case err
(vc-call-backend backend 'root default-directory) (vc-call-backend backend 'root default-directory)
(vc-not-supported (vc-not-supported
(unless (eq (cadr err) 'root) (unless (eq (cadr err) 'root)
(signal (car err) (cdr err))) (signal (car err) (cdr err)))
nil))))) nil))))
;;;###autoload ;;;###autoload
(defun vc-revision-other-window (rev) (defun vc-revision-other-window (rev)
@ -4032,14 +4032,15 @@ The command prompts for the branch whose change log to show."
;; determine and so should be remembered. ;; determine and so should be remembered.
(if-let* ((_ (not refresh)) (if-let* ((_ (not refresh))
(record (assoc upstream-location (record (assoc upstream-location
(vc--repo-getprop 'vc-incoming-revision)))) (vc--repo-getprop backend 'vc-incoming-revision))))
(cdr record) (cdr record)
(let ((res (vc-call-backend backend 'incoming-revision (let ((res (vc-call-backend backend 'incoming-revision
upstream-location refresh))) upstream-location refresh)))
(if-let* ((alist (vc--repo-getprop 'vc-incoming-revision))) (if-let* ((alist (vc--repo-getprop backend 'vc-incoming-revision)))
(setf (alist-get upstream-location alist nil nil #'equal) (setf (alist-get upstream-location alist nil nil #'equal)
res) res)
(vc--repo-setprop 'vc-incoming-revision (vc--repo-setprop backend
'vc-incoming-revision
`((,upstream-location . ,res)))) `((,upstream-location . ,res))))
(or res (or res
(user-error "No incoming revision -- local-only branch?"))))) (user-error "No incoming revision -- local-only branch?")))))
@ -4056,12 +4057,13 @@ can be a remote branch name."
(vc-incoming-outgoing-internal backend upstream-location (vc-incoming-outgoing-internal backend upstream-location
"*vc-incoming*" 'log-incoming))) "*vc-incoming*" 'log-incoming)))
(defun vc-default-log-incoming (_backend buffer upstream-location) (defun vc-default-log-incoming (backend buffer upstream-location)
(vc--with-backend-in-rootdir "" (let ((incoming (vc--incoming-revision backend upstream-location
(let ((incoming (vc--incoming-revision backend upstream-location 'refresh))) 'refresh))
(vc-call-backend backend 'print-log (list rootdir) buffer t (default-directory (vc-root-dir backend)))
incoming (vc-call-backend backend 'print-log (list default-directory)
(vc-call-backend backend 'mergebase incoming))))) buffer t incoming
(vc-call-backend backend 'mergebase incoming))))
;;;###autoload ;;;###autoload
(defun vc-log-outgoing (&optional upstream-location) (defun vc-log-outgoing (&optional upstream-location)
@ -4075,12 +4077,12 @@ can be a remote branch name."
(vc-incoming-outgoing-internal backend upstream-location (vc-incoming-outgoing-internal backend upstream-location
"*vc-outgoing*" 'log-outgoing))) "*vc-outgoing*" 'log-outgoing)))
(defun vc-default-log-outgoing (_backend buffer upstream-location) (defun vc-default-log-outgoing (backend buffer upstream-location)
(vc--with-backend-in-rootdir "" (let ((incoming (vc--incoming-revision backend upstream-location))
(let ((incoming (vc--incoming-revision backend upstream-location))) (default-directory (vc-root-dir backend)))
(vc-call-backend backend 'print-log (list rootdir) buffer t (vc-call-backend backend 'print-log (list default-directory)
"" buffer t ""
(vc-call-backend backend 'mergebase incoming))))) (vc-call-backend backend 'mergebase incoming))))
(defun vc--count-outgoing (backend) (defun vc--count-outgoing (backend)
"Return number of changes that will be sent with a `vc-push'." "Return number of changes that will be sent with a `vc-push'."
@ -4278,7 +4280,7 @@ It also signals an error in a Bazaar bound branch."
;; FIXME: Ideally we would only clear out the ;; FIXME: Ideally we would only clear out the
;; REMOTE-LOCATION to which we are pushing. ;; REMOTE-LOCATION to which we are pushing.
(vc-run-delayed (vc-run-delayed
(vc--repo-setprop 'vc-incoming-revision nil))) (vc--repo-setprop backend 'vc-incoming-revision nil)))
(user-error "VC push is unsupported for `%s'" backend)))) (user-error "VC push is unsupported for `%s'" backend))))
;;;###autoload ;;;###autoload