From 5fc7dff76102ea1e097bc39cbceb8b7d71df447d Mon Sep 17 00:00:00 2001
From: PythonNut <PythonNut@users.noreply.github.com>
Date: Sat, 22 Aug 2015 01:25:44 +0000
Subject: [PATCH] Add CONCRETE parameter to vc-working-revision

If CONCRETE is non-nil, the revision will be tied to an unambiguous commit
instead of the normal symbolic ref.
---
 lisp/vc/vc-bzr.el   |  2 +-
 lisp/vc/vc-cvs.el   |  2 +-
 lisp/vc/vc-git.el   | 12 ++++++------
 lisp/vc/vc-hg.el    |  2 +-
 lisp/vc/vc-hooks.el | 18 +++++++++++-------
 lisp/vc/vc-mtn.el   |  2 +-
 lisp/vc/vc-rcs.el   |  2 +-
 lisp/vc/vc-sccs.el  |  2 +-
 lisp/vc/vc-src.el   |  2 +-
 lisp/vc/vc-svn.el   |  2 +-
 10 files changed, 25 insertions(+), 21 deletions(-)

diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 5f8dd0b..953179e 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -532,7 +532,7 @@ Returns nil if unable to find this information."
              (looking-at "[0-9]+\0\\([^\0\n]+\\)\0")
              (match-string 1))))))
 
-(defun vc-bzr-working-revision (file)
+(defun vc-bzr-working-revision (file &optional concrete)
   (let* ((rootdir (vc-bzr-root file))
          (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
                                                rootdir))
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 9a41905..290b8cb 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -258,7 +258,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
      ((null checkout-time) 'unregistered)
      (t 'edited))))
 
-(defun vc-cvs-working-revision (file)
+(defun vc-cvs-working-revision (file &optional concrete)
   "CVS-specific version of `vc-working-revision'."
   ;; There is no need to consult RCS headers under CVS, because we
   ;; get the workfile version for free when we recognize that a file
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 9522328..84e2025 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -248,15 +248,15 @@ matching the resulting Git log output, and KEYWORDS is a list of
             (vc-git--state-code diff-letter)))
       (if (vc-git--empty-db-p) 'added 'up-to-date))))
 
-(defun vc-git-working-revision (file)
+(defun vc-git-working-revision (file &optional concrete)
   "Git-specific version of `vc-working-revision'."
   (let* (process-file-side-effects
-         (str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
+          (str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
     (vc-file-setprop file 'vc-git-detached (null str))
-    (if str
-        (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
-            (match-string 2 str)
-          str)
+    (if (and str (not concrete))
+      (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
+        (match-string 2 str)
+        str)
       (vc-git--rev-parse "HEAD"))))
 
 (defun vc-git-mode-line-string (file)
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index f634e2e..eee8c85 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -237,7 +237,7 @@ highlighting the Log View buffer."
 	 ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
 	 (t 'up-to-date))))))
 
-(defun vc-hg-working-revision (file)
+(defun vc-hg-working-revision (file &optional concrete)
   "Hg-specific version of `vc-working-revision'."
   (or (ignore-errors
         (with-output-to-string
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index bae9919..504efb9 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -490,15 +490,19 @@ status of this file.  Otherwise, the value returned is one of:
   "Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
   (eq (vc-state file) 'up-to-date))
 
-(defun vc-working-revision (file &optional backend)
+(defun vc-working-revision (file &optional backend concrete)
   "Return the repository version from which FILE was checked out.
-If FILE is not registered, this function always returns nil."
-  (or (vc-file-getprop file 'vc-working-revision)
+If FILE is not registered, this function always returns nil.
+If CONCRETE is non-nil, the revision will be tied to an unambiguous commit
+instead of the normal symbolic ref."
+  (if concrete
+    (vc-call-backend backend 'working-revision file t)
+    (or (vc-file-getprop file 'vc-working-revision)
       (progn
-	(setq backend (or backend (vc-responsible-backend file)))
-	(when backend
-	  (vc-file-setprop file 'vc-working-revision
-			   (vc-call-backend backend 'working-revision file))))))
+        (setq backend (or backend (vc-responsible-backend file)))
+        (when backend
+          (vc-file-setprop file 'vc-working-revision
+            (vc-call-backend backend 'working-revision file)))))))
 
 ;; Backward compatibility.
 (define-obsolete-function-alias
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 685ef3b..63efb9f 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -147,7 +147,7 @@ switches."
   (vc-run-delayed
    (vc-mtn-after-dir-status update-function)))
 
-(defun vc-mtn-working-revision (file)
+(defun vc-mtn-working-revision (file &optional concrete)
   ;; If `mtn' fails or returns status>0, or if the search fails, just
   ;; return nil.
   (ignore-errors
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 71ffa55..5a5ed76 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -168,7 +168,7 @@ For a description of possible values, see `vc-check-master-templates'."
 	  (push (list frel state) result))))
     (funcall update-function result)))
 
-(defun vc-rcs-working-revision (file)
+(defun vc-rcs-working-revision (file &optional concrete)
   "RCS-specific version of `vc-working-revision'."
   (or (and vc-consult-headers
            (vc-rcs-consult-headers file)
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index 8d8d9e8..f7fdb73 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -147,7 +147,7 @@ For a description of possible values, see `vc-check-master-templates'."
 
 (autoload 'vc-master-name "vc-filewise")
 
-(defun vc-sccs-working-revision (file)
+(defun vc-sccs-working-revision (file &optional concrete)
   "SCCS-specific version of `vc-working-revision'."
   (when (and (file-regular-p file) (vc-master-name file))
     (with-temp-buffer
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index d9aa1b1..d2dd505 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -198,7 +198,7 @@ This function differs from vc-do-command in that it invokes `vc-src-program'."
 	   (setq file-list (cons "--" file-or-list))))
     (apply 'vc-do-command (or buffer "*vc*") 0 vc-src-program file-list flags)))
 
-(defun vc-src-working-revision (file)
+(defun vc-src-working-revision (file &optional concrete)
   "SRC-specific version of `vc-working-revision'."
   (let ((result (ignore-errors
 		  (with-output-to-string
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 8d6eae5..01cb1e4 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -240,7 +240,7 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
 	     (propertize repo 'face 'font-lock-variable-name-face)))
 	   (t "")))))
 
-(defun vc-svn-working-revision (file)
+(defun vc-svn-working-revision (file &optional concrete)
   "SVN-specific version of `vc-working-revision'."
   ;; There is no need to consult RCS headers under SVN, because we
   ;; get the workfile version for free when we recognize that a file
-- 
2.5.0

