procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

New buffer-local vc-buffer-overriding-fileset and vc-buffer-revision

Browse source 
* lisp/vc/vc.el (vc-buffer-overriding-fileset)
(vc-buffer-revision): New variables (bug#77529).
(vc-find-revision-save, vc-find-revision-no-save): Set them.
(vc-deduce-fileset): Respect vc-buffer-overriding-fileset.
(vc-print-log): Use vc-buffer-revision as a default working
revision.

* 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-svn-annotate-current-time): Use
vc-buffer-overriding-fileset instead of vc-annotate-parent-file,
vc-buffer-revision instead of vc-annotate-parent-rev.
(vc-annotate-parent-rev): Delete declaration.

* etc/NEWS: Announce the new variables.
This commit is contained in:
Sean Whitton 2025-04-04 10:49:57 +08:00
parent 37164032f6
commit 60530889c3
4 changed files with 127 additions and 81 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
etc/NEWS
View file

@ -2142,6 +2142,18 @@ sleep state.
'advertised-undo', 'advertised-widget-backward', and 'advertised-undo', 'advertised-widget-backward', and
'dired-advertised-find-file'. '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 * Changes in Emacs 31.1 on Non-Free Operating Systems

131
lisp/vc/vc-annotate.el
View file

@ -194,8 +194,6 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'."
;; internal buffer-local variables ;; internal buffer-local variables
(defvar vc-annotate-backend nil) (defvar vc-annotate-backend nil)
(defvar vc-annotate-parent-file nil)
(defvar vc-annotate-parent-rev nil)
(defvar vc-annotate-parent-display-mode nil) (defvar vc-annotate-parent-display-mode nil)
(defconst vc-annotate-font-lock-keywords (defconst vc-annotate-font-lock-keywords
@ -368,7 +366,7 @@ use; you may override this using the second optional arg MODE."
(defvar vc-sentinel-movepoint) (defvar vc-sentinel-movepoint)
;;;###autoload ;;;###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. "Display the edit history of the current FILE using colors.
This command creates a buffer that shows, for each line of the current This command creates a buffer that shows, for each line of the current
@ -389,7 +387,7 @@ age, and everything that is older than that is shown in blue.
If MOVE-POINT-TO is given, move the point to that line. 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: Customization variables:
@ -401,22 +399,25 @@ mode-specific menu. `vc-annotate-color-map' and
should be applied to the background or to the foreground." should be applied to the background or to the foreground."
(interactive (interactive
(save-current-buffer (save-current-buffer
(vc-ensure-vc-buffer) (let ((name (if (length= (cadr vc-buffer-overriding-fileset) 1)
(list buffer-file-name (caadr vc-buffer-overriding-fileset)
(let ((def (funcall (if vc-annotate-use-short-revision (vc-ensure-vc-buffer)
#'vc-short-revision buffer-file-name)))
#'vc-working-revision) (list name
buffer-file-name))) (let ((def (or vc-buffer-revision
(if (null current-prefix-arg) def (funcall (if vc-annotate-use-short-revision
(vc-read-revision #'vc-short-revision
(format-prompt "Annotate from revision" def) #'vc-working-revision)
(list buffer-file-name) nil def))) name))))
(if (null current-prefix-arg) (if (null current-prefix-arg) def
vc-annotate-display-mode (vc-read-revision
(float (string-to-number (format-prompt "Annotate from revision" def)
(read-string (format-prompt "Annotate span days" 20) (list name) nil def)))
nil nil "20"))))))) (if (null current-prefix-arg)
(vc-ensure-vc-buffer) 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 (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef
(let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev)) (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev))
(temp-buffer-show-function 'vc-annotate-display-select) (temp-buffer-show-function 'vc-annotate-display-select)
@ -435,31 +436,33 @@ should be applied to the background or to the foreground."
(rename-buffer temp-buffer-name t) (rename-buffer temp-buffer-name t)
;; In case it had to be uniquified. ;; In case it had to be uniquified.
(setq temp-buffer-name (buffer-name)))) (setq temp-buffer-name (buffer-name))))
(with-output-to-temp-buffer temp-buffer-name (let ((backend (or backend
(let ((backend (or vc-bk (vc-backend file))) (car vc-buffer-overriding-fileset)
(coding-system-for-read buffer-file-coding-system)) (vc-backend file)))
;; For a VC backend running on DOS/Windows, it's normal to (coding-system-for-read buffer-file-coding-system))
;; produce CRLF EOLs even if the original file has Unix EOLs, (with-output-to-temp-buffer temp-buffer-name
;; which will show ^M characters in the Annotate buffer. (One ;; For a VC backend running on DOS/Windows, it's normal to
;; known case in point is "svn annotate".) Prevent that by ;; produce CRLF EOLs even if the original file has Unix EOLs,
;; forcing DOS EOL decoding. ;; which will show ^M characters in the Annotate buffer. (One
(if (memq system-type '(windows-nt ms-dos)) ;; known case in point is "svn annotate".) Prevent that by
(setq coding-system-for-read ;; forcing DOS EOL decoding.
(coding-system-change-eol-conversion coding-system-for-read (if (memq system-type '(windows-nt ms-dos))
'dos))) (setq coding-system-for-read
(vc-call-backend backend 'annotate-command file (coding-system-change-eol-conversion coding-system-for-read
(get-buffer temp-buffer-name) rev) 'dos)))
;; we must setup the mode first, and then set our local (vc-call-backend backend 'annotate-command file
;; variables before the show-function is called at the exit of (get-buffer temp-buffer-name) rev)
;; with-output-to-temp-buffer ;; we must setup the mode first, and then set our local
(with-current-buffer temp-buffer-name ;; variables before the show-function is called at the exit of
(unless (equal major-mode 'vc-annotate-mode) ;; with-output-to-temp-buffer
(vc-annotate-mode)) (with-current-buffer temp-buffer-name
(setq-local vc-annotate-backend backend) (unless (equal major-mode 'vc-annotate-mode)
(setq-local vc-annotate-parent-file file) (vc-annotate-mode))
(setq-local vc-annotate-parent-rev rev) (setq-local vc-annotate-backend backend)
(setq-local vc-annotate-parent-display-mode display-mode) (setq-local vc-buffer-overriding-fileset `(,backend (,file)))
(kill-local-variable 'revert-buffer-function)))) (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 (with-current-buffer temp-buffer-name
(vc-run-delayed (vc-run-delayed
@ -494,8 +497,8 @@ revisions after."
(interactive) (interactive)
(if (not (equal major-mode 'vc-annotate-mode)) (if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer") (message "Cannot be invoked outside of a vc annotate buffer")
(let ((warp-rev (vc-working-revision vc-annotate-parent-file))) (let ((warp-rev (vc-working-revision (cadr vc-buffer-overriding-fileset))))
(if (equal warp-rev vc-annotate-parent-rev) (if (equal warp-rev vc-buffer-revision)
(message "Already at revision %s" warp-rev) (message "Already at revision %s" warp-rev)
(vc-annotate-warp-revision warp-rev))))) (vc-annotate-warp-revision warp-rev)))))
@ -507,7 +510,7 @@ Return a cons (REV . FILENAME)."
'annotate-extract-revision-at-line))) 'annotate-extract-revision-at-line)))
(if (or (null rev) (consp rev)) (if (or (null rev) (consp rev))
rev rev
(cons rev vc-annotate-parent-file)))) (cons rev (cadr vc-buffer-overriding-fileset)))))
(defun vc-annotate-revision-at-line () (defun vc-annotate-revision-at-line ()
"Visit the annotation of the revision identified in the current line." "Visit the annotation of the revision identified in the current line."
@ -517,8 +520,8 @@ Return a cons (REV . FILENAME)."
(let ((rev-at-line (vc-annotate-extract-revision-at-line))) (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
(if (not rev-at-line) (if (not rev-at-line)
(message "Cannot extract revision number from the current line") (message "Cannot extract revision number from the current line")
(if (and (equal (car rev-at-line) vc-annotate-parent-rev) (if (and (equal (car rev-at-line) vc-buffer-revision)
(string= (cdr rev-at-line) vc-annotate-parent-file)) (string= (cdr rev-at-line) (cadr vc-buffer-overriding-fileset)))
(message "Already at revision %s" rev-at-line) (message "Already at revision %s" rev-at-line)
(vc-annotate-warp-revision (car rev-at-line) (cdr rev-at-line))))))) (vc-annotate-warp-revision (car rev-at-line) (cdr rev-at-line)))))))
@ -644,27 +647,33 @@ describes a revision number, so warp to that revision."
(newrev nil)) (newrev nil))
(cond (cond
((and (integerp revspec) (> revspec 0)) ((and (integerp revspec) (> revspec 0))
(setq newrev vc-annotate-parent-rev) (setq newrev vc-buffer-revision)
(while (and (> revspec 0) newrev) (while (and (> revspec 0) newrev)
(setq newrev (vc-call-backend vc-annotate-backend 'next-revision (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))) (setq revspec (1- revspec)))
(unless newrev (unless newrev
(message "Cannot increment %d revisions from revision %s" (message "Cannot increment %d revisions from revision %s"
revspeccopy vc-annotate-parent-rev))) revspeccopy vc-buffer-revision)))
((and (integerp revspec) (< revspec 0)) ((and (integerp revspec) (< revspec 0))
(setq newrev vc-annotate-parent-rev) (setq newrev vc-buffer-revision)
(while (and (< revspec 0) newrev) (while (and (< revspec 0) newrev)
(setq newrev (vc-call-backend vc-annotate-backend 'previous-revision (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))) (setq revspec (1+ revspec)))
(unless newrev (unless newrev
(message "Cannot decrement %d revisions from revision %s" (message "Cannot decrement %d revisions from revision %s"
(- 0 revspeccopy) vc-annotate-parent-rev))) (- 0 revspeccopy) vc-buffer-revision)))
((stringp revspec) (setq newrev revspec)) ((stringp revspec) (setq newrev revspec))
(t (error "Invalid argument to vc-annotate-warp-revision"))) (t (error "Invalid argument to vc-annotate-warp-revision")))
(when newrev (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 vc-annotate-parent-display-mode
buf buf
;; Pass the current line so that vc-annotate will ;; Pass the current line so that vc-annotate will
@ -757,13 +766,13 @@ The annotations are relative to the current time, unless overridden by OFFSET."
(let ((line (save-restriction (let ((line (save-restriction
(widen) (widen)
(line-number-at-pos))) (line-number-at-pos)))
(rev vc-annotate-parent-rev)) (rev vc-buffer-revision)
(file (cadr vc-buffer-overriding-fileset)))
(pop-to-buffer (pop-to-buffer
(or (and (buffer-live-p vc-parent-buffer) (or (and (buffer-live-p vc-parent-buffer)
vc-parent-buffer) vc-parent-buffer)
(and (file-exists-p vc-annotate-parent-file) (and (file-exists-p file) (find-file-noselect file))
(find-file-noselect vc-annotate-parent-file)) (error "File not found: %s" file)))
(error "File not found: %s" vc-annotate-parent-file)))
(save-restriction (save-restriction
(widen) (widen)
(goto-char (point-min)) (goto-char (point-min))

4
lisp/vc/vc-svn.el
View file

@ -791,10 +791,8 @@ Set file properties accordingly. If FILENAME is non-nil, return its status."
;; Arbitrarily assume 10 commits per day. ;; Arbitrarily assume 10 commits per day.
(/ (string-to-number rev) 10.0)) (/ (string-to-number rev) 10.0))
(defvar vc-annotate-parent-rev)
(defun vc-svn-annotate-current-time () (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 ]+ ") (defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ")

61
lisp/vc/vc.el
View file

@ -1184,6 +1184,19 @@ If the value is t, the backend is deduced in all modes."
(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files)) (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)) (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.
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.")
(defun vc-deduce-fileset (&optional not-state-changing (defun vc-deduce-fileset (&optional not-state-changing
allow-unregistered allow-unregistered
state-model-only-files) state-model-only-files)
@ -1223,6 +1236,14 @@ BEWARE: this function may change the current buffer."
(set-buffer (buffer-base-buffer))) (set-buffer (buffer-base-buffer)))
(let (backend) (let (backend)
(cond (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) ((derived-mode-p 'vc-dir-mode)
(vc-dir-deduce-fileset state-model-only-files)) (vc-dir-deduce-fileset state-model-only-files))
((derived-mode-p 'dired-mode) ((derived-mode-p 'dired-mode)
@ -1265,6 +1286,9 @@ BEWARE: this function may change the current buffer."
(list buffer-file-name)))) (list buffer-file-name))))
(t (error "File is not under version control"))))) (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 () (defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file." "Make sure that the current buffer visits a version-controlled file."
(cond (cond
@ -2442,7 +2466,8 @@ Use BACKEND as the VC backend if specified."
Saves the buffer to the file." Saves the buffer to the file."
(let ((automatic-backup (vc-version-backup-file-name file revision)) (let ((automatic-backup (vc-version-backup-file-name file revision))
(filebuf (or (get-file-buffer file) (current-buffer))) (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) (unless (file-exists-p filename)
(if (file-exists-p automatic-backup) (if (file-exists-p automatic-backup)
(rename-file automatic-backup filename nil) (rename-file automatic-backup filename nil)
@ -2460,19 +2485,19 @@ Saves the buffer to the file."
;; Change buffer to get local value of ;; Change buffer to get local value of
;; vc-checkout-switches. ;; vc-checkout-switches.
(with-current-buffer filebuf (with-current-buffer filebuf
(if backend (vc-call-backend backend 'find-revision
(vc-call-backend backend 'find-revision file revision outbuf) file revision outbuf))))
(vc-call find-revision file revision outbuf)))))
(setq failed nil)) (setq failed nil))
(when (and failed (file-exists-p filename)) (when (and failed (file-exists-p filename))
(delete-file filename)))) (delete-file filename))))
(vc-mode-line file)) (vc-mode-line file))
(message "Checking out %s...done" filename))) (message "Checking out %s...done" filename)))
(let ((result-buf (find-file-noselect filename))) (let ((result-buf (find-file-noselect filename))
(file (expand-file-name file))) ; ensure it's absolute
(with-current-buffer result-buf (with-current-buffer result-buf
;; Set the parent buffer so that things like (setq-local vc-parent-buffer filebuf
;; C-x v g, C-x v l, ... etc work. vc-buffer-overriding-fileset `(,backend (,file))
(setq-local vc-parent-buffer filebuf)) vc-buffer-revision revision))
result-buf))) result-buf)))
(defun vc-find-revision-no-save (file revision &optional backend buffer) (defun vc-find-revision-no-save (file revision &optional backend buffer)
@ -2481,9 +2506,11 @@ If BUFFER omitted or nil, this function creates a new buffer and sets
`buffer-file-name' to the name constructed from the file name and the `buffer-file-name' to the name constructed from the file name and the
revision number. revision number.
Unlike `vc-find-revision-save', doesn't save the buffer to the file." 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))) (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) (unless (and (not buffer)
(or (get-file-buffer filename) (or (get-file-buffer filename)
(file-exists-p filename))) (file-exists-p filename)))
@ -2494,9 +2521,7 @@ Unlike `vc-find-revision-save', doesn't save the buffer to the file."
(unless buffer (setq buffer-file-name filename)) (unless buffer (setq buffer-file-name filename))
(let ((outbuf (current-buffer))) (let ((outbuf (current-buffer)))
(with-current-buffer filebuf (with-current-buffer filebuf
(if backend (vc-call-backend backend 'find-revision file revision outbuf)))
(vc-call-backend backend 'find-revision file revision outbuf)
(vc-call find-revision file revision outbuf))))
(decode-coding-inserted-region (point-min) (point-max) file) (decode-coding-inserted-region (point-min) (point-max) file)
(after-insert-file-set-coding (- (point-max) (point-min))) (after-insert-file-set-coding (- (point-max) (point-min)))
(goto-char (point-min)) (goto-char (point-min))
@ -2524,9 +2549,12 @@ Unlike `vc-find-revision-save', doesn't save the buffer to the file."
(kill-buffer (get-file-buffer filename))))))) (kill-buffer (get-file-buffer filename)))))))
(let ((result-buf (or buffer (let ((result-buf (or buffer
(get-file-buffer filename) (get-file-buffer filename)
(find-file-noselect filename)))) (find-file-noselect filename)))
(file (expand-file-name file))) ; ensure it's absolute
(with-current-buffer result-buf (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))) result-buf)))
;; Header-insertion code ;; Header-insertion code
@ -3102,8 +3130,7 @@ shown log style is available via `vc-log-short-style'."
(let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: Why t? --Stef (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: Why t? --Stef
(backend (car vc-fileset)) (backend (car vc-fileset))
(files (cadr vc-fileset)) (files (cadr vc-fileset))
;; (working-revision (or working-revision (vc-working-revision (car files)))) (working-revision (or working-revision vc-buffer-revision)))
)
(vc-print-log-internal backend files working-revision nil limit))) (vc-print-log-internal backend files working-revision nil limit)))
;;;###autoload ;;;###autoload