Subject: bug#77529: 31.0.50; [Feature Request][VC] How can I get the current revision of the buffer opened by =vc-find-revision=?

From: Sean Whitton <[email-masked]>
Date: Sun, 06 Apr 2025 08:26:39 +0800

Hello,

I have a work-in-progress patch to improve things in this area that I'm
testing, please find attached.

-- 
Sean Whitton
>From 989aa74743fc64a51bf7ae3a9c3f970f1268670e Mon Sep 17 00:00:00 2001
From: Sean Whitton <[email-masked]>
Date: Fri, 4 Apr 2025 10:49:57 +0800
Subject: [PATCH] New buffer-local vc-buffer-overriding-fileset and
 vc-buffer-revision

* lisp/vc/vc.el (vc-buffer-overriding-fileset)
(vc-buffer-revision): New variables.
(vc-find-revision-save, vc-find-revision-no-save): Set them.
(vc-deduce-fileset): Respect vc-buffer-overriding-fileset.

* lisp/vc/vc-annotate.el (vc-annotate-parent-file)
(vc-annotate-parent-rev): Delete.
(vc-annotate): Respect vc-buffer-overriding-fileset and
vc-buffer-revision.  This makes 'C-x v g' work from buffers
generated by 'C-x v ~' (bug#5424).
Set the two variables in the newly prepared buffer.
(vc-annotate-working-revision)
(vc-annotate-extract-revision-at-line)
(vc-annotate-revision-at-line, vc-annotate-warp-revision)
(vc-annotate-goto-line):
* lisp/vc/vc-svn.el (vc-annotate-parent-rev)
(vc-svn-annotate-current-time): Use vc-buffer-overriding-fileset
instead of vc-annotate-parent-file, vc-buffer-revision instead
of vc-annotate-parent-rev.

* etc/NEWS: Announce the new variables.
---
 etc/NEWS               |  12 ++++
 lisp/vc/vc-annotate.el | 131 ++++++++++++++++++++++-------------------
 lisp/vc/vc-svn.el      |   4 +-
 lisp/vc/vc.el          |  58 +++++++++++++-----
 4 files changed, 126 insertions(+), 79 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 61474af7fcb..ff421d7bce0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2097,6 +2097,18 @@ sleep state.
 'advertised-undo', 'advertised-widget-backward', and
 'dired-advertised-find-file'.
 
+** VC
+
+---
+*** New buffer-local variable 'vc-buffer-overriding-fileset'.
+This can be used to override the behavior of 'vc-deduce-fileset'.
+This replaces and generalizes the old 'vc-annotate-parent-file'.
+
+---
+*** New buffer-local variable 'vc-buffer-revision'.
+This specifies the revision to which the buffer's contents corresponds.
+This replaces and generalizes the old 'vc-annotate-parent-rev'.
+
 
 * Changes in Emacs 31.1 on Non-Free Operating Systems
 
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index 1be6bab09a5..e47ab426ef4 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -194,8 +194,6 @@ vc-annotate-ratio
 
 ;; internal buffer-local variables
 (defvar vc-annotate-backend nil)
-(defvar vc-annotate-parent-file nil)
-(defvar vc-annotate-parent-rev nil)
 (defvar vc-annotate-parent-display-mode nil)
 
 (defconst vc-annotate-font-lock-keywords
@@ -368,7 +366,7 @@ vc-annotate-display-select
 (defvar vc-sentinel-movepoint)
 
 ;;;###autoload
-(defun vc-annotate (file rev &optional display-mode buf move-point-to vc-bk)
+(defun vc-annotate (file rev &optional display-mode buf move-point-to backend)
   "Display the edit history of the current FILE using colors.
 
 This command creates a buffer that shows, for each line of the current
@@ -389,7 +387,7 @@ vc-annotate
 
 If MOVE-POINT-TO is given, move the point to that line.
 
-If VC-BK is given used that VC backend.
+If BACKEND is given, use that VC backend.
 
 Customization variables:
 
@@ -401,22 +399,25 @@ vc-annotate
 should be applied to the background or to the foreground."
   (interactive
    (save-current-buffer
-     (vc-ensure-vc-buffer)
-     (list buffer-file-name
-	   (let ((def (funcall (if vc-annotate-use-short-revision
-                                   #'vc-short-revision
-                                 #'vc-working-revision)
-                               buffer-file-name)))
-	     (if (null current-prefix-arg) def
-	       (vc-read-revision
-		(format-prompt "Annotate from revision" def)
-		(list buffer-file-name) nil def)))
-	   (if (null current-prefix-arg)
-	       vc-annotate-display-mode
-	     (float (string-to-number
-		     (read-string (format-prompt "Annotate span days" 20)
-				  nil nil "20")))))))
-  (vc-ensure-vc-buffer)
+     (let ((name (if (length= (cadr vc-buffer-overriding-fileset) 1)
+                     (caadr vc-buffer-overriding-fileset)
+                   (vc-ensure-vc-buffer)
+                   buffer-file-name)))
+       (list name
+	     (let ((def (or vc-buffer-revision
+                            (funcall (if vc-annotate-use-short-revision
+                                         #'vc-short-revision
+                                       #'vc-working-revision)
+                                     name))))
+	       (if (null current-prefix-arg) def
+	         (vc-read-revision
+		  (format-prompt "Annotate from revision" def)
+		  (list name) nil def)))
+	     (if (null current-prefix-arg)
+	         vc-annotate-display-mode
+	       (float (string-to-number
+		       (read-string (format-prompt "Annotate span days" 20)
+				    nil nil "20"))))))))
   (setq vc-annotate-display-mode display-mode) ;Not sure why.  --Stef
   (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev))
          (temp-buffer-show-function 'vc-annotate-display-select)
@@ -435,31 +436,33 @@ vc-annotate
 		(rename-buffer temp-buffer-name t)
 		;; In case it had to be uniquified.
 		(setq temp-buffer-name (buffer-name))))
-    (with-output-to-temp-buffer temp-buffer-name
-      (let ((backend (or vc-bk (vc-backend file)))
-	    (coding-system-for-read buffer-file-coding-system))
-        ;; For a VC backend running on DOS/Windows, it's normal to
-        ;; produce CRLF EOLs even if the original file has Unix EOLs,
-        ;; which will show ^M characters in the Annotate buffer.  (One
-        ;; known case in point is "svn annotate".)  Prevent that by
-        ;; forcing DOS EOL decoding.
-        (if (memq system-type '(windows-nt ms-dos))
-            (setq coding-system-for-read
-                  (coding-system-change-eol-conversion coding-system-for-read
-                                                       'dos)))
-        (vc-call-backend backend 'annotate-command file
-                         (get-buffer temp-buffer-name) rev)
-        ;; we must setup the mode first, and then set our local
-        ;; variables before the show-function is called at the exit of
-        ;; with-output-to-temp-buffer
-        (with-current-buffer temp-buffer-name
-          (unless (equal major-mode 'vc-annotate-mode)
-            (vc-annotate-mode))
-          (setq-local vc-annotate-backend backend)
-          (setq-local vc-annotate-parent-file file)
-          (setq-local vc-annotate-parent-rev rev)
-          (setq-local vc-annotate-parent-display-mode display-mode)
-          (kill-local-variable 'revert-buffer-function))))
+    (let ((backend (or backend
+                       (car vc-buffer-overriding-fileset)
+                       (vc-backend file)))
+          (coding-system-for-read buffer-file-coding-system))
+     (with-output-to-temp-buffer temp-buffer-name
+       ;; For a VC backend running on DOS/Windows, it's normal to
+       ;; produce CRLF EOLs even if the original file has Unix EOLs,
+       ;; which will show ^M characters in the Annotate buffer.  (One
+       ;; known case in point is "svn annotate".)  Prevent that by
+       ;; forcing DOS EOL decoding.
+       (if (memq system-type '(windows-nt ms-dos))
+           (setq coding-system-for-read
+                 (coding-system-change-eol-conversion coding-system-for-read
+                                                      'dos)))
+       (vc-call-backend backend 'annotate-command file
+                        (get-buffer temp-buffer-name) rev)
+       ;; we must setup the mode first, and then set our local
+       ;; variables before the show-function is called at the exit of
+       ;; with-output-to-temp-buffer
+       (with-current-buffer temp-buffer-name
+         (unless (equal major-mode 'vc-annotate-mode)
+           (vc-annotate-mode))
+         (setq-local vc-annotate-backend backend)
+         (setq-local vc-buffer-overriding-fileset `(,backend (,file)))
+         (setq-local vc-buffer-revision rev)
+         (setq-local vc-annotate-parent-display-mode display-mode)
+         (kill-local-variable 'revert-buffer-function))))
 
     (with-current-buffer temp-buffer-name
       (vc-run-delayed
@@ -494,8 +497,8 @@ vc-annotate-working-revision
   (interactive)
   (if (not (equal major-mode 'vc-annotate-mode))
       (message "Cannot be invoked outside of a vc annotate buffer")
-    (let ((warp-rev (vc-working-revision vc-annotate-parent-file)))
-      (if (equal warp-rev vc-annotate-parent-rev)
+    (let ((warp-rev (vc-working-revision (cadr vc-buffer-overriding-fileset))))
+      (if (equal warp-rev vc-buffer-revision)
 	  (message "Already at revision %s" warp-rev)
 	(vc-annotate-warp-revision warp-rev)))))
 
@@ -507,7 +510,7 @@ vc-annotate-extract-revision-at-line
 			      'annotate-extract-revision-at-line)))
     (if (or (null rev) (consp rev))
 	rev
-      (cons rev vc-annotate-parent-file))))
+      (cons rev (cadr vc-buffer-overriding-fileset)))))
 
 (defun vc-annotate-revision-at-line ()
   "Visit the annotation of the revision identified in the current line."
@@ -517,8 +520,8 @@ vc-annotate-revision-at-line
     (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
       (if (not rev-at-line)
 	  (message "Cannot extract revision number from the current line")
-	(if (and (equal (car rev-at-line) vc-annotate-parent-rev)
-		 (string= (cdr rev-at-line) vc-annotate-parent-file))
+	(if (and (equal (car rev-at-line) vc-buffer-revision)
+		 (string= (cdr rev-at-line) (cadr vc-buffer-overriding-fileset)))
 	    (message "Already at revision %s" rev-at-line)
 	  (vc-annotate-warp-revision (car rev-at-line) (cdr rev-at-line)))))))
 
@@ -644,27 +647,33 @@ vc-annotate-warp-revision
 	   (newrev nil))
       (cond
        ((and (integerp revspec) (> revspec 0))
-	(setq newrev vc-annotate-parent-rev)
+	(setq newrev vc-buffer-revision)
 	(while (and (> revspec 0) newrev)
           (setq newrev (vc-call-backend vc-annotate-backend 'next-revision
-                                        (or file vc-annotate-parent-file) newrev))
+                                        (or file
+                                            (cadr vc-buffer-overriding-fileset))
+                                        newrev))
           (setq revspec (1- revspec)))
 	(unless newrev
 	  (message "Cannot increment %d revisions from revision %s"
-		   revspeccopy vc-annotate-parent-rev)))
+		   revspeccopy vc-buffer-revision)))
        ((and (integerp revspec) (< revspec 0))
-	(setq newrev vc-annotate-parent-rev)
+	(setq newrev vc-buffer-revision)
 	(while (and (< revspec 0) newrev)
           (setq newrev (vc-call-backend vc-annotate-backend 'previous-revision
-                                        (or file vc-annotate-parent-file) newrev))
+                                        (or file
+                                            (cadr vc-buffer-overriding-fileset))
+                                        newrev))
           (setq revspec (1+ revspec)))
 	(unless newrev
 	  (message "Cannot decrement %d revisions from revision %s"
-		   (- 0 revspeccopy) vc-annotate-parent-rev)))
+		   (- 0 revspeccopy) vc-buffer-revision)))
        ((stringp revspec) (setq newrev revspec))
        (t (error "Invalid argument to vc-annotate-warp-revision")))
       (when newrev
-	(vc-annotate (or file vc-annotate-parent-file) newrev
+	(vc-annotate (or file
+                         (cadr vc-buffer-overriding-fileset))
+                     newrev
                      vc-annotate-parent-display-mode
                      buf
 		     ;; Pass the current line so that vc-annotate will
@@ -757,13 +766,13 @@ vc-annotate-goto-line
   (let ((line (save-restriction
 		(widen)
 		(line-number-at-pos)))
-	(rev vc-annotate-parent-rev))
+	(rev vc-buffer-revision)
+        (file (cadr vc-buffer-overriding-fileset)))
     (pop-to-buffer
      (or (and (buffer-live-p vc-parent-buffer)
 	      vc-parent-buffer)
-	 (and (file-exists-p vc-annotate-parent-file)
-	      (find-file-noselect vc-annotate-parent-file))
-	 (error "File not found: %s" vc-annotate-parent-file)))
+	 (and (file-exists-p file) (find-file-noselect file))
+	 (error "File not found: %s" file)))
     (save-restriction
       (widen)
       (goto-char (point-min))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index e81636552b5..079aa3c0a22 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -791,10 +791,8 @@ vc-svn-annotate-time-of-rev
   ;; Arbitrarily assume 10 commits per day.
   (/ (string-to-number rev) 10.0))
 
-(defvar vc-annotate-parent-rev)
-
 (defun vc-svn-annotate-current-time ()
-  (vc-svn-annotate-time-of-rev vc-annotate-parent-rev))
+  (vc-svn-annotate-time-of-rev vc-buffer-revision))
 
 (defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ")
 
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 2db2a017525..cb39317e85b 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1181,6 +1181,19 @@ vc-deduce-backend
 (declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
 (declare-function dired-vc-deduce-fileset "dired-aux" (&optional state-model-only-files not-state-changing))
 
+(defvar-local vc-buffer-overriding-fileset nil
+  "Specialized, static value for `vc-deduce-fileset' for this buffer.
+If non-nil, this should be a list of length 2 or 5.
+See `vc-deduce-fileset' regarding these possible forms.
+If this list is of length 2, it will be used only when the
+STATE-MODEL-ONLY-FILES argument to `vc-deduce-fileset' is nil.")
+
+(defvar-local vc-buffer-revision nil
+  "VCS revision to which this buffer's contents corresponds.
+Functions which set 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.")
+
 (defun vc-deduce-fileset (&optional not-state-changing
 				    allow-unregistered
 				    state-model-only-files)
@@ -1220,6 +1233,14 @@ vc-deduce-fileset
     (set-buffer (buffer-base-buffer)))
   (let (backend)
     (cond
+     ((and vc-buffer-overriding-fileset
+           (not (or (length= vc-buffer-overriding-fileset 2)
+                    (length= vc-buffer-overriding-fileset 5))))
+      (error "Invalid value for `vc-buffer-overriding-fileset' %S"
+             vc-buffer-overriding-fileset))
+     ((and (or (not state-model-only-files)
+               (length= vc-buffer-overriding-fileset 5))
+           vc-buffer-overriding-fileset))
      ((derived-mode-p 'vc-dir-mode)
       (vc-dir-deduce-fileset state-model-only-files))
      ((derived-mode-p 'dired-mode)
@@ -1262,6 +1283,9 @@ vc-deduce-fileset
 	      (list buffer-file-name))))
      (t (error "File is not under version control")))))
 
+;; This function should possibly honor `vc-buffer-overriding-fileset'
+;; when the fileset consists of a single file, but only if that file is
+;; part of the current working revision, i.e., actually on disk now.
 (defun vc-ensure-vc-buffer ()
   "Make sure that the current buffer visits a version-controlled file."
   (cond
@@ -2401,7 +2425,8 @@ vc-find-revision-save
 Saves the buffer to the file."
   (let ((automatic-backup (vc-version-backup-file-name file revision))
 	(filebuf (or (get-file-buffer file) (current-buffer)))
-        (filename (vc-version-backup-file-name file revision 'manual)))
+        (filename (vc-version-backup-file-name file revision 'manual))
+        (backend (or backend (vc-backend file))))
     (unless (file-exists-p filename)
       (if (file-exists-p automatic-backup)
           (rename-file automatic-backup filename nil)
@@ -2419,19 +2444,19 @@ vc-find-revision-save
 		      ;; Change buffer to get local value of
 		      ;; vc-checkout-switches.
 		      (with-current-buffer filebuf
-			(if backend
-			    (vc-call-backend backend 'find-revision file revision outbuf)
-			  (vc-call find-revision file revision outbuf)))))
+			(vc-call-backend backend 'find-revision
+                                         file revision outbuf))))
 		  (setq failed nil))
 	      (when (and failed (file-exists-p filename))
 		(delete-file filename))))
 	  (vc-mode-line file))
 	(message "Checking out %s...done" filename)))
-    (let ((result-buf (find-file-noselect filename)))
+    (let ((result-buf (find-file-noselect filename))
+          (file (file-relative-name file (file-name-directory filename))))
       (with-current-buffer result-buf
-	;; Set the parent buffer so that things like
-	;; C-x v g, C-x v l, ... etc work.
-        (setq-local vc-parent-buffer filebuf))
+        (setq-local vc-parent-buffer filebuf
+                    vc-buffer-overriding-fileset `(,backend (,file))
+                    vc-buffer-revision revision))
       result-buf)))
 
 (defun vc-find-revision-no-save (file revision &optional backend buffer)
@@ -2440,9 +2465,11 @@ vc-find-revision-no-save
 `buffer-file-name' to the name constructed from the file name and the
 revision number.
 Unlike `vc-find-revision-save', doesn't save the buffer to the file."
-  (let* ((buffer (when (buffer-live-p buffer) buffer))
+  (let* ((buffer (and (buffer-live-p buffer) buffer))
          (filebuf (or buffer (get-file-buffer file) (current-buffer)))
-         (filename (unless buffer (vc-version-backup-file-name file revision 'manual))))
+         (filename (and (not buffer)
+                        (vc-version-backup-file-name file revision 'manual)))
+         (backend (or backend (vc-backend file))))
     (unless (and (not buffer)
                  (or (get-file-buffer filename)
                      (file-exists-p filename)))
@@ -2453,9 +2480,7 @@ vc-find-revision-no-save
                 (unless buffer (setq buffer-file-name filename))
 		(let ((outbuf (current-buffer)))
 		  (with-current-buffer filebuf
-		    (if backend
-			(vc-call-backend backend 'find-revision file revision outbuf)
-		      (vc-call find-revision file revision outbuf))))
+		    (vc-call-backend backend 'find-revision file revision outbuf)))
                 (decode-coding-inserted-region (point-min) (point-max) file)
                 (after-insert-file-set-coding (- (point-max) (point-min)))
                 (goto-char (point-min))
@@ -2483,9 +2508,12 @@ vc-find-revision-no-save
 	      (kill-buffer (get-file-buffer filename)))))))
     (let ((result-buf (or buffer
                           (get-file-buffer filename)
-                          (find-file-noselect filename))))
+                          (find-file-noselect filename)))
+          (file (file-relative-name file (file-name-directory filename))))
       (with-current-buffer result-buf
-        (setq-local vc-parent-buffer filebuf))
+        (setq-local vc-parent-buffer filebuf
+                    vc-buffer-overriding-fileset `(,backend (,file))
+                    vc-buffer-revision revision))
       result-buf)))
 
 ;; Header-insertion code
-- 
2.49.0