1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -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))
(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."
(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."
(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."
(vc-file-clearprops (vc-root-dir)))
(vc-file-clearprops (vc-root-dir backend)))
;; We keep properties on each symbol naming a backend as follows:

View file

@ -3239,17 +3239,17 @@ saving the buffer."
(called-interactively-p 'interactive))))))
;;;###autoload
(defun vc-root-dir ()
(defun vc-root-dir (&optional backend)
"Return the root directory for the current VC tree.
Return nil if the root directory cannot be identified."
(let ((backend (vc-deduce-backend)))
(if backend
(condition-case err
(vc-call-backend backend 'root default-directory)
(vc-not-supported
(unless (eq (cadr err) 'root)
(signal (car err) (cdr err)))
nil)))))
Return nil if the root directory cannot be identified.
BACKEND is the VC backend."
(and-let* ((backend (or backend (vc-deduce-backend))))
(condition-case err
(vc-call-backend backend 'root default-directory)
(vc-not-supported
(unless (eq (cadr err) 'root)
(signal (car err) (cdr err)))
nil))))
;;;###autoload
(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.
(if-let* ((_ (not refresh))
(record (assoc upstream-location
(vc--repo-getprop 'vc-incoming-revision))))
(vc--repo-getprop backend 'vc-incoming-revision))))
(cdr record)
(let ((res (vc-call-backend backend 'incoming-revision
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)
res)
(vc--repo-setprop 'vc-incoming-revision
(vc--repo-setprop backend
'vc-incoming-revision
`((,upstream-location . ,res))))
(or res
(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*" 'log-incoming)))
(defun vc-default-log-incoming (_backend buffer upstream-location)
(vc--with-backend-in-rootdir ""
(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)))))
(defun vc-default-log-incoming (backend buffer upstream-location)
(let ((incoming (vc--incoming-revision backend upstream-location
'refresh))
(default-directory (vc-root-dir backend)))
(vc-call-backend backend 'print-log (list default-directory)
buffer t incoming
(vc-call-backend backend 'mergebase incoming))))
;;;###autoload
(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-outgoing*" 'log-outgoing)))
(defun vc-default-log-outgoing (_backend buffer upstream-location)
(vc--with-backend-in-rootdir ""
(let ((incoming (vc--incoming-revision backend upstream-location)))
(vc-call-backend backend 'print-log (list rootdir) buffer t
""
(vc-call-backend backend 'mergebase incoming)))))
(defun vc-default-log-outgoing (backend buffer upstream-location)
(let ((incoming (vc--incoming-revision backend upstream-location))
(default-directory (vc-root-dir backend)))
(vc-call-backend backend 'print-log (list default-directory)
buffer t ""
(vc-call-backend backend 'mergebase incoming))))
(defun vc--count-outgoing (backend)
"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
;; REMOTE-LOCATION to which we are pushing.
(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))))
;;;###autoload