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:
parent
f15e98afb6
commit
34331ae6f9
2 changed files with 34 additions and 32 deletions
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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)))))
|
||||
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue