mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-05 22:20:24 -08:00
Cache VC incoming revisions
* lisp/vc/vc-hooks.el (vc-file-setprop): Use cl-pushnew. (vc--repo-setprop, vc--repo-getprop, vc--repo-clearprops): New functions. * lisp/vc/vc.el (vc--incoming-revision): Cache incoming revisions. * src/fns.c (Fput): State that VALUE is returned.
This commit is contained in:
parent
9174bc811a
commit
5167989b2a
4 changed files with 51 additions and 14 deletions
|
|
@ -576,6 +576,8 @@ project backend implementation of `project-external-roots'.")
|
||||||
|
|
||||||
See `project-vc-extra-root-markers' for the marker value format.")
|
See `project-vc-extra-root-markers' for the marker value format.")
|
||||||
|
|
||||||
|
;; FIXME: Should perhaps use `vc--repo-*prop' functions
|
||||||
|
;; (after promoting those to public). --spwhitton
|
||||||
(defun project-try-vc (dir)
|
(defun project-try-vc (dir)
|
||||||
;; FIXME: Learn to invalidate when the value changes:
|
;; FIXME: Learn to invalidate when the value changes:
|
||||||
;; `project-vc-merge-submodules' or `project-vc-extra-root-markers'.
|
;; `project-vc-merge-submodules' or `project-vc-extra-root-markers'.
|
||||||
|
|
|
||||||
|
|
@ -228,24 +228,26 @@ VC commands are globally reachable under the prefix \\[vc-prefix-map]:
|
||||||
(defmacro vc-error-occurred (&rest body)
|
(defmacro vc-error-occurred (&rest body)
|
||||||
`(condition-case nil (progn ,@body nil) (error t)))
|
`(condition-case nil (progn ,@body nil) (error t)))
|
||||||
|
|
||||||
;; We need a notion of per-file properties because the version
|
;; We need a notion of per-file properties because the version control
|
||||||
;; control state of a file is expensive to derive --- we compute
|
;; state of a file is expensive to derive -- we compute it when the file
|
||||||
;; them when the file is initially found, keep them up to date
|
;; is initially found, keep them up to date during any subsequent VC
|
||||||
;; during any subsequent VC operations, and forget them when
|
;; operations, and forget them when the buffer is killed.
|
||||||
;; the buffer is killed.
|
;;
|
||||||
|
;; In addition we store some whole-repository properties keyed to the
|
||||||
|
;; repository root. We invalidate/update these during VC operations,
|
||||||
|
;; but there isn't a point analagous to the killing of a buffer at which
|
||||||
|
;; we clear them all out, like there is for per-file properties.
|
||||||
|
|
||||||
(defvar vc-file-prop-obarray (obarray-make 17)
|
(defvar vc-file-prop-obarray (obarray-make 17)
|
||||||
"Obarray for per-file properties.")
|
"Obarray for VC per-file and per-repository properties.")
|
||||||
|
|
||||||
(defvar vc-touched-properties nil)
|
(defvar vc-touched-properties nil)
|
||||||
|
|
||||||
(defun vc-file-setprop (file property value)
|
(defun vc-file-setprop (file property value)
|
||||||
"Set per-file VC PROPERTY for FILE to VALUE."
|
"Set per-file VC PROPERTY for FILE to VALUE."
|
||||||
(if (and vc-touched-properties
|
(cl-pushnew property vc-touched-properties)
|
||||||
(not (memq property vc-touched-properties)))
|
(put (intern (expand-file-name file) vc-file-prop-obarray)
|
||||||
(setq vc-touched-properties (append (list property)
|
property value))
|
||||||
vc-touched-properties)))
|
|
||||||
(put (intern (expand-file-name file) vc-file-prop-obarray) property value))
|
|
||||||
|
|
||||||
(defun vc-file-getprop (file property)
|
(defun vc-file-getprop (file property)
|
||||||
"Get per-file VC PROPERTY for FILE."
|
"Get per-file VC PROPERTY for FILE."
|
||||||
|
|
@ -257,6 +259,18 @@ 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)
|
||||||
|
"Set per-repository VC PROPERTY to VALUE and return the value."
|
||||||
|
(vc-file-setprop (vc-root-dir) property value))
|
||||||
|
|
||||||
|
(defun vc--repo-getprop (property)
|
||||||
|
"Get per-repository VC PROPERTY."
|
||||||
|
(vc-file-getprop (vc-root-dir) property))
|
||||||
|
|
||||||
|
(defun vc--repo-clearprops ()
|
||||||
|
"Clear all VC whole-repository properties."
|
||||||
|
(vc-file-clearprops (vc-root-dir)))
|
||||||
|
|
||||||
|
|
||||||
;; We keep properties on each symbol naming a backend as follows:
|
;; We keep properties on each symbol naming a backend as follows:
|
||||||
;; * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION.
|
;; * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION.
|
||||||
|
|
|
||||||
|
|
@ -4015,7 +4015,28 @@ The command prompts for the branch whose change log to show."
|
||||||
'vc-remote-location-history)))
|
'vc-remote-location-history)))
|
||||||
|
|
||||||
(defun vc--incoming-revision (backend &optional upstream-location refresh)
|
(defun vc--incoming-revision (backend &optional upstream-location refresh)
|
||||||
(or (vc-call-backend backend 'incoming-revision upstream-location refresh)
|
;; Some backends don't support REFRESH and so always behave as though
|
||||||
|
;; REFRESH is non-nil. This is not just for a lack of implementation
|
||||||
|
;; in Emacs; for example, Mercurial repositories don't store any
|
||||||
|
;; representation of the incoming revision between running commands.
|
||||||
|
;;
|
||||||
|
;; Fetching the incoming revision is often slow, and in many cases the
|
||||||
|
;; last known incoming revision will serve perfectly well. For
|
||||||
|
;; example, when finding revisions that are outgoing, the last known
|
||||||
|
;; incoming revision is fine except for the rare case in which someone
|
||||||
|
;; else cherry-picks the very same commits that you have outstanding,
|
||||||
|
;; and pushes them. Given this, we implement our own caching.
|
||||||
|
(or (and (not refresh)
|
||||||
|
(cdr (assoc upstream-location
|
||||||
|
(vc--repo-getprop 'vc-incoming-revision))))
|
||||||
|
(let ((res (vc-call-backend backend 'incoming-revision
|
||||||
|
upstream-location refresh)))
|
||||||
|
(if-let* ((alist (vc--repo-getprop 'vc-incoming-revision)))
|
||||||
|
(setf (alist-get upstream-location alist nil nil #'equal)
|
||||||
|
res)
|
||||||
|
(vc--repo-setprop 'vc-incoming-revision
|
||||||
|
`((,upstream-location . ,res))))
|
||||||
|
res)
|
||||||
(user-error "No incoming revision -- local-only branch?")))
|
(user-error "No incoming revision -- local-only branch?")))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
|
|
|
||||||
|
|
@ -2702,8 +2702,8 @@ plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
|
||||||
}
|
}
|
||||||
|
|
||||||
DEFUN ("put", Fput, Sput, 3, 3, 0,
|
DEFUN ("put", Fput, Sput, 3, 3, 0,
|
||||||
doc: /* Store SYMBOL's PROPNAME property with value VALUE.
|
doc: /* Store SYMBOL's PROPNAME property with value VALUE and return that value.
|
||||||
It can be retrieved with `(get SYMBOL PROPNAME)'. */)
|
It can later be retrieved with `(get SYMBOL PROPNAME)'. */)
|
||||||
(Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
|
(Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
|
||||||
{
|
{
|
||||||
CHECK_SYMBOL (symbol);
|
CHECK_SYMBOL (symbol);
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue