unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#21383: Static revisions in vc-working-revision
@ 2015-08-31  0:45 Jonathan H
  2015-08-31  4:45 ` Stefan Monnier
  0 siblings, 1 reply; 29+ messages in thread
From: Jonathan H @ 2015-08-31  0:45 UTC (permalink / raw)
  To: 21383


[-- Attachment #1.1: Type: text/plain, Size: 980 bytes --]

Hello all!

I've attached a basic patch that adds an option to vc-working-revision. The
option is named *concrete* and if non-nil, it forces vc-working-revision to
return a revision name that will not go stale after new revisions are made.

This is useful for, e.g. git, where vc-working-revision will just return
the branch name, which only refers to the current commit for as long as
it's the head of the branch.

I'm using this in diff-hl #33 <https://github.com/dgutov/diff-hl/issues/33>to
determine when to refresh the current VC highlighting.

I've supplied an implementation for Git, and no-op implementations for all
the other backends. For most systems (i.e. all the other VCS systems I
know), the value of *concrete *does not matter. If you know a backend that
would benefit from a real implementation, please let me know.

Also, this is my first patch, so I'm not entirely sure I've got all my
ducks in a row. Any comments on that would be great too.

Thanks,
Jonathan

[-- Attachment #1.2: Type: text/html, Size: 1202 bytes --]

[-- Attachment #2: 0001-Add-CONCRETE-parameter-to-vc-working-revision.patch --]
[-- Type: application/octet-stream, Size: 7392 bytes --]

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


^ permalink raw reply related	[flat|nested] 29+ messages in thread

end of thread, other threads:[~2015-09-06 22:29 UTC | newest]

Thread overview: 29+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2015-08-31  0:45 bug#21383: Static revisions in vc-working-revision Jonathan H
2015-08-31  4:45 ` Stefan Monnier
2015-08-31  8:47   ` Dmitry Gutov
2015-08-31 17:44     ` Stefan Monnier
2015-09-01  2:11       ` Dmitry Gutov
2015-09-01  3:55         ` Stefan Monnier
2015-09-01 12:05           ` Dmitry Gutov
2015-09-01 15:45             ` Stefan Monnier
2015-09-01 15:54               ` Dmitry Gutov
2015-09-01 16:52                 ` Stefan Monnier
2015-09-01 17:23                   ` Dmitry Gutov
2015-09-02  3:50                     ` Stefan Monnier
2015-09-02 10:49                       ` Dmitry Gutov
2015-09-02 22:44                         ` Jonathan H
2015-09-03 12:56                           ` Dmitry Gutov
2015-09-03 16:17                             ` Stefan Monnier
2015-09-03 17:34                               ` Jonathan H
2015-09-03 18:40                                 ` Dmitry Gutov
2015-09-03 20:07                                   ` Stefan Monnier
2015-09-03 22:32                                     ` Dmitry Gutov
2015-09-04 14:36                                       ` Stefan Monnier
2015-09-05  2:30                                         ` Dmitry Gutov
2015-09-03 16:04                         ` Stefan Monnier
2015-09-03 19:24                           ` Dmitry Gutov
2015-09-04  2:20                             ` Stefan Monnier
2015-09-05  3:08                               ` Dmitry Gutov
2015-09-05 15:12                                 ` Stefan Monnier
2015-09-05 20:30                                   ` Dmitry Gutov
2015-09-06 22:29                                     ` Stefan Monnier

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).