diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el index 60ea5ae1cd8..f50c28be586 100644 --- a/lisp/vc/ediff-vers.el +++ b/lisp/vc/ediff-vers.el @@ -152,9 +152,9 @@ With prefix argument, prompts for a revision name." (setq buf2 (current-buffer))) (if ancestor-rev (save-excursion - (if (string= ancestor-rev "") - (setq ancestor-rev (vc-working-revision - buffer-file-name))) + (if (string-empty-p ancestor-rev) + (setq ancestor-rev + (vc-symbolic-working-revision buffer-file-name))) (vc-revision-other-window ancestor-rev) (setq ancestor-buf (current-buffer))))) (if ancestor-rev diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 54475542ac4..0c06bc298d0 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1140,6 +1140,8 @@ It is based on `log-edit-mode', and has Git-specific extensions." (defalias 'vc-git-async-checkins #'always) +(defalias 'vc-git-working-revision-symbol (cl-constantly "HEAD")) + (defun vc-git--checkin (comment &optional files patch-string) "Workhorse routine for `vc-git-checkin' and `vc-git-checkin-patch'. COMMENT is the commit message; must be non-nil. @@ -2073,26 +2075,31 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defun vc-git-previous-revision (file rev) "Git-specific version of `vc-previous-revision'." - (if file - (let* ((fname (file-relative-name file)) - (prev-rev (with-temp-buffer - (and - (vc-git--out-ok "rev-list" - (vc-git--maybe-abbrev) - "-2" rev "--" fname) - (goto-char (point-max)) - (bolp) - (zerop (forward-line -1)) - (not (bobp)) - (buffer-substring-no-properties - (point) - (1- (point-max))))))) - (or (vc-git-symbolic-commit prev-rev) prev-rev)) - ;; We used to use "^" here, but that fails on MS-Windows if git is - ;; invoked via a batch file, in which case cmd.exe strips the "^" - ;; because it is a special character for cmd which process-file - ;; does not (and cannot) quote. - (vc-git--rev-parse (concat rev "~1")))) + (cond ((string-match "\\`HEAD\\(\\^*\\)\\'" rev) + (format "HEAD~%d" (1+ (length (match-string 1 rev))))) + ((string-match "\\`HEAD~\\([0-9]+\\)\\'" rev) + (format "HEAD~%d" (1+ (string-to-number (match-string 1 rev))))) + (file + (let* ((fname (file-relative-name file)) + (prev-rev (with-temp-buffer + (and + (vc-git--out-ok "rev-list" + (vc-git--maybe-abbrev) + "-2" rev "--" fname) + (goto-char (point-max)) + (bolp) + (zerop (forward-line -1)) + (not (bobp)) + (buffer-substring-no-properties + (point) + (1- (point-max))))))) + (or (vc-git-symbolic-commit prev-rev) prev-rev))) + (t + ;; We used to use "^" here, but that fails on MS-Windows if git + ;; is invoked via a batch file, in which case cmd.exe strips + ;; the "^" because it is a special character for cmd which + ;; process-file does not (and cannot) quote. + (vc-git--rev-parse (concat rev "~1"))))) (defun vc-git--rev-parse (rev) (with-temp-buffer diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 0d1f1703081..fe977df6aae 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -557,7 +557,7 @@ This requires hg 4.4 or later, for the \"-L\" option of \"hg log\"." "Get a difference report using hg between two revisions of FILES." (let* ((firstfile (car files)) (working (and firstfile (vc-working-revision firstfile 'Hg)))) - (when (and (not newvers) (equal oldvers working)) + (when (and (not newvers) (member oldvers (list working "."))) (setq oldvers nil)) (when (and newvers (not oldvers)) (setq oldvers working)) @@ -1137,13 +1137,22 @@ hg binary." ;;; Miscellaneous (defun vc-hg-previous-revision (_file rev) - ;; We can't simply decrement by 1, because that revision might be - ;; e.g. on a different branch (bug#22032). - (with-temp-buffer - (and (eq 0 - (vc-hg-command t nil nil "id" "-n" "-r" (concat rev "^"))) - ;; Trim the trailing newline. - (buffer-substring (point-min) (1- (point-max)))))) + ;; Prefer to return values with tildes not carets because that's more + ;; compatible with MS-Windows (see `vc-git-previous-revision'). + ;; + ;; See for reference. + (cond ((string-match "\\`\\.\\(\\^*\\)\\'" rev) + (format ".~%d" (1+ (length (match-string 1 rev))))) + ((string-match "\\`\\.~\\([0-9]+\\)\\'" rev) + (format ".~%d" (1+ (string-to-number (match-string 1 rev))))) + (t + ;; We can't simply decrement by 1, because that revision might + ;; be e.g. on a different branch (bug#22032). + (with-temp-buffer + (and (zerop (vc-hg-command t nil nil "id" "-n" + "-r" (concat rev "~1"))) + ;; Trim the trailing newline. + (buffer-substring (point-min) (1- (point-max)))))))) (defun vc-hg-next-revision (_file rev) (let ((newrev (1+ (string-to-number rev))) @@ -1213,6 +1222,8 @@ It is based on `log-edit-mode', and has Hg-specific extensions.") (defalias 'vc-hg-async-checkins #'always) +(defalias 'vc-hg-working-revision-symbol (cl-constantly ".")) + (defun vc-hg--checkin (comment &optional files patch-string) "Workhorse routine for `vc-hg-checkin' and `vc-hg-checkin-patch'. COMMENT is the commit message; nil if it should come from PATCH-STRING. diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 48e84d6aee1..ab4b10a10a1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -545,14 +545,42 @@ status of this file. Otherwise, the value returned is one of: (defun vc-working-revision (file &optional backend) "Return the repository version from which FILE was checked out. -If FILE is not registered, this function always returns nil." +If FILE is not registered, this function always returns nil. + +This function does not return nil without first confirming with the +underlying VCS that FILE is unregistered; this is in contrast to +`vc-symbolic-working-revision'." (or (vc-file-getprop file 'vc-working-revision) (let ((default-directory (file-name-directory file))) - (setq backend (or backend (vc-backend file))) - (when backend - (vc-file-setprop file 'vc-working-revision - (vc-call-backend - backend 'working-revision file)))))) + (and (setq backend (or backend (vc-backend file))) + (vc-file-setprop file 'vc-working-revision + (vc-call-backend backend 'working-revision + file)))))) + +(defun vc-symbolic-working-revision (file &optional backend) + "Return BACKEND's symbolic name for FILE's working revision. +If FILE is not registered according to cached information, return nil. +If BACKEND does not have a symbolic name for the working revision or +Emacs doesn't know what it is, call `vc-working-revision' instead. + +Prefer this function to `vc-working-revision' whenever a symbolic name +will do, for it avoids a call out to the underlying VCS." + ;; Returning nil if the file is unregistered (which is why we call + ;; `vc-backend' even if BACKEND is non-nil here) makes us closer to a + ;; drop-in replacement for `vc-working-revision'. Don't actually + ;; query the VCS because the point of this function is to avoid such + ;; queries. Code that purely wants to map BACKEND to a symbolic name + ;; can call the backend API function directly. + ;; (If we don't check whether FILE is registered, then whether this + ;; function is sensitive to FILE being registered depends on whether + ;; BACKEND implements `working-revision-symbol' (because we would be + ;; sensitive to whether FILE is registered if and only if we defer to + ;; `vc-working-revision'), which would be a strange interdependence.) + (and-let* ((cached-backend (vc-backend file))) + (let* ((backend (or backend cached-backend)) + (fn (vc-find-backend-function backend + 'working-revision-symbol))) + (if fn (funcall fn) (vc-working-revision file backend))))) (defvar vc-use-short-revision nil "If non-nil, VC backend functions should return short revisions if possible. @@ -825,12 +853,13 @@ Format: This function assumes that the file is registered." (pcase-let* ((backend-name (symbol-name backend)) (state (vc-state file backend)) - (rev (vc-working-revision file backend)) + (rev (vc-symbolic-working-revision file backend)) (`(,state-echo ,face ,indicator) (vc-mode-line-state state)) - (state-string (concat (unless (eq vc-display-status 'no-backend) - backend-name) - indicator rev))) + (state-string + (concat (and (not (eq vc-display-status 'no-backend)) + backend-name) + indicator rev))) (propertize state-string 'face face 'help-echo (concat state-echo " under the " backend-name " version control system")))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7c28e4092dd..6c56b3b0ecd 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -124,6 +124,16 @@ ;; ;; Takes no arguments. Backends that return non-nil can (and do) ;; perform async checkins when `vc-async-checkin' is non-nil. +;; +;; - working-revision-symbol +;; +;; Symbolic name for the/a working revision, a constant string. If +;; defined, backend API functions that take revision numbers, revision +;; hashes or branch names can also take this string in place of those. +;; Emacs passes this name without first having to look up the working +;; revision, which is a small performance improvement. +;; In addition, using a name instead of a number or hash makes it +;; easier to edit backend commands with `vc-edit-next-command'. ;; STATE-QUERYING FUNCTIONS ;; @@ -597,8 +607,14 @@ ;; ;; - previous-revision (file rev) ;; -;; Return the revision number that precedes REV for FILE, or nil if no such -;; revision exists. +;; Return the revision number/hash that precedes REV for FILE, or nil +;; if no such revision exists. If the working-revision-symbol +;; function is defined for this backend and that symbol, or a symbolic +;; name involving that symbol, is passed to this function as REV, this +;; function may return a symbolic name. +;; +;; Possible future extension: make REV an optional argument, and if +;; nil, default it to FILE's working revision. ;; ;; - file-name-changes (rev) ;; @@ -1313,7 +1329,8 @@ STATE-MODEL-ONLY-FILES argument to `vc-deduce-fileset' is nil.") "VCS revision to which this buffer's contents corresponds. Lisp code which sets this should also set `vc-buffer-overriding-fileset' such that the buffer's local variables also specify a VC backend, -rendering the value of this variable unambiguous.") +rendering the value of this variable unambiguous. +Should never be a symbolic name but always a revision number/hash.") (defun vc-deduce-backend () (cond ((car vc-buffer-overriding-fileset)) @@ -2584,7 +2601,7 @@ INITIAL-INPUT are passed on to `vc-read-revision' directly." (t (push (ignore-errors ;If `previous-revision' doesn't work. (vc-call-backend backend 'previous-revision first - (vc-working-revision first backend))) + (vc-symbolic-working-revision first backend))) rev1-default) (when (member (car rev1-default) '("" nil)) (setq rev1-default nil)))) ;; construct argument list @@ -2806,10 +2823,8 @@ global binding." ;; 'revision-granularity) ;; 'repository) ;; (ignore-errors - ;; (vc-call-backend backend 'working-revision - ;; (caadr fileset))) - (vc-call-backend backend 'working-revision - (caadr fileset)) + ;; (vc-symbolic-working-revision (caadr fileset))) + (vc-symbolic-working-revision (caadr fileset)) (called-interactively-p 'interactive)))) ;; For the following two commands, the default meaning for @@ -2980,8 +2995,8 @@ If `F.~REV~' already exists, use it instead of checking it out again." (set-buffer (or (buffer-base-buffer) (current-buffer))) (vc-ensure-vc-buffer) (let* ((file buffer-file-name) - (revision (if (string-equal rev "") - (vc-working-revision file) + (revision (if (string-empty-p rev) + (vc-symbolic-working-revision file) rev))) (switch-to-buffer-other-window (vc-find-revision file revision)))) @@ -4522,7 +4537,7 @@ to provide the `find-revision' operation instead." (defun vc-default-revert (backend file contents-done) (unless contents-done - (let ((rev (vc-working-revision file)) + (let ((rev (vc-symbolic-working-revision file)) (file-buffer (or (get-file-buffer file) (current-buffer)))) (message "Checking out %s..." file) (let ((failed t) diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index f61de1ac5d1..b4192555efd 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -815,7 +815,7 @@ This checks also `vc-backend' and `vc-responsible-backend'." (cl-flet ((get-patch-string () "Get patch corresponding to most recent commit to FILE." - (let* ((rev (vc-call-backend backend 'working-revision file)) + (let* ((rev (vc-symbolic-working-revision file backend)) (patch (vc-call-backend backend 'prepare-patch rev))) (with-current-buffer (plist-get patch :buffer) (buffer-substring-no-properties (point-min)