unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#61071: New features: VC timemachine and BackupOnSave to RCS
@ 2023-01-26  3:24 John Yates
  2023-02-11 23:02 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
  0 siblings, 1 reply; 6+ messages in thread
From: John Yates @ 2023-01-26  3:24 UTC (permalink / raw)
  To: 61071

[-- Attachment #1: Type: text/plain, Size: 74 bytes --]

Package: emacs
Version: 30.0.50
Tags: patch

Please see the cover letter.

[-- Attachment #2: 0002-Introduce-VC-timemachine-capability.patch --]
[-- Type: text/x-patch, Size: 31442 bytes --]

From ac181d9662e6fd2fd5215c8427c164ce412b550e Mon Sep 17 00:00:00 2001
From: "John S. Yates, Jr" <john@yates-sheets.org>
Date: Sun, 15 Jan 2023 15:04:28 -0500
Subject: [PATCH 2/3] Introduce VC timemachine capability
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Introducing timemachine functionality into vc was discussed in this thread:

  https://lists.gnu.org/archive/html/emacs-devel/2022-10/msg01272.html

Where the previous commit introduced the concept of a revision buffer bound
to a unique revision, this commit introduces the concept of a timemachine
buffer, bound to the linear sequence of revisions on the branch from which
a work file was checked out.

`vc-tm-revision-head creates' a timemachine buffer, which then behaves as
a cursor over the linear sequence of revisions on a branch.  The buffer can
be repositioned along that branch via:

- `vc-tm-revision-next'
  "Show work file's next revision on checked-out branch."

- `vc-tm-revision-previous'
  "Show work file's previous revision on checked-out branch."

- `vc-tm-revision-nth'
  "Show work file's N'th most recent revision on checked-out branch
  (1 being HEAD)."

- `vc-tm-revision-complete-subject'
  "Show work file's revision via subject completion on checked-out branch."

A timemachine buffer is read-only and has a nil buffer-file-name (meaning
that it is not visiting any file).  The rationale is exactly the same as
for a revision buffer: a timemachine buffer displays immutable history.

To support timemachine functionality a backend needs to support the new
tm-revisions vc operation.  Optionally, it may support the tm-map-line
operation.  In this commit vc-rcs supports only tm-revisions while vc-git
supports both operations.

My implementation borrows design ideas and code from Peter Stiernström's
original git-timemachine.el.  In reality, my effort was little more than an
extended refactoring effort to fit git-timemachine into the vc framework.

============================================================================

* lisp/vc/vc-timemachine.el (new file):
Derive core VC timemachine functionality from Peter Stiernström's original
git-timemachine.el.
* lisp/vc/vc-hooks.el (vc-prefix-map):
Bind "," to `vc-tm-revision-head'.
(vc-menu-map):
Add "Time machine at HEAD" in a new menu section.
* lisp/vc/vc-git.el (vc-git--process-file, vc-git-global-git-arguments):
Add helper function and its supporting defcustom.
(vc-git-find-revision):
Wrap "git cat-file blob" in an ignore-errors to improve robustness.
An encountered failure mode is choosing a commit older than the file.
(vc-git-tm-revisions, vc-git-tm-map-line):
Add git-specific implementations of vc-tm backend functions, hewing closely
to Peter Stiernström's original code.
lisp/vc/vc-rcs.el (vc-rcs-tm-revisions):
Add rcs-specific implementations vc-tm backend functions, following the
vc-git.el precedent.  For now vc-rcs lacks a tm-map-line function and
therefore leverages vc-timemachine.el's default implementation.
---
 lisp/vc/vc-git.el         |  91 +++++++-
 lisp/vc/vc-hooks.el       |  10 +-
 lisp/vc/vc-rcs.el         |  50 +++++
 lisp/vc/vc-timemachine.el | 426 ++++++++++++++++++++++++++++++++++++++
 lisp/vc/vc.el             |  47 ++++-
 5 files changed, 614 insertions(+), 10 deletions(-)
 create mode 100644 lisp/vc/vc-timemachine.el

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 7689d5f879..1f45aa7e96 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -82,6 +82,9 @@
 ;; - annotate-time ()                              OK
 ;; - annotate-current-time ()                      NOT NEEDED
 ;; - annotate-extract-revision-at-line ()          OK
+;; TIMEMACHINE
+;; * tm-revisions (file)
+;; * tm-map-line (file from-revision from-line to-revision from-is-older)
 ;; TAG/BRANCH SYSTEM
 ;; - create-tag (dir name branchp)                 OK
 ;; - retrieve-tag (dir name update)                OK
@@ -101,6 +104,8 @@
 
 (require 'cl-lib)
 (require 'vc-dispatcher)
+(require 'transient)
+(require 'vc-timemachine)
 (eval-when-compile
   (require 'subr-x) ; for string-trim-right
   (require 'vc)
@@ -166,6 +171,12 @@ vc-git-program
   :version "24.1"
   :type 'string)
 
+(defcustom vc-git-global-git-arguments
+  '("-c" "log.showSignature=false" "--no-pager")
+  "Common arguments for all git commands."
+  :type 'list
+  :group 'vc-timemachine)
+
 (defcustom vc-git-root-log-format
   '("%d%h..: %an %ad %s"
     ;; The first shy group matches the characters drawn by --graph.
@@ -1217,10 +1228,11 @@ vc-git-find-revision
 	    (if (string= fn "")
 		(file-relative-name file (vc-git-root default-directory))
 	      (substring fn 0 -1)))))
-    (vc-git-command
-     buffer 0
-     nil
-     "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
+    (ignore-errors
+      (vc-git-command
+       buffer 0
+       nil
+       "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname)))))
 
 (defun vc-git-find-ignore-file (file)
   "Return the git ignore file that controls FILE."
@@ -1804,6 +1816,77 @@ vc-git-retrieve-tag
     (vc-git-command nil 0 nil "checkout" name)))
 
 
+;;; TIMEMACHINE
+
+(defun vc-git-tm-revisions (file)
+  "Return data about revisions modifying FILE on checked-out branch."
+  (let* ((default-directory (vc-git-root file))
+         (rel-file (file-relative-name file))
+         (revision-infos))
+    (unless (zerop (vc-git--process-file
+                    "log" "--pretty=format:%H%x00%ad%x00%s%x00%an"
+                    "--name-only" "--follow" "--" rel-file))
+      (error "Git log error: .git= '%s', file= '%s'" default-directory rel-file))
+    (goto-char (point-min))
+    (let ((line)
+          (commit)
+          (subject) (new-subject)
+          (author)  (new-author)
+          (date)    (new-date)
+          (file)    (new-file))
+      (while (not (eobp))
+        (setq line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
+	(string-match "\\([^\0]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)" line)
+        (setq commit (match-string 1 line))
+        (setq new-subject (match-string 3 line))
+        (setq new-author (match-string 4 line))
+        (setq new-date (vc-tm-format-date (match-string 2 line)))
+        (unless (equal subject new-subject)
+          (setq subject new-subject))
+        (unless (equal author new-author)
+          (setq author new-author))
+        (unless (equal date new-date)
+          (setq date new-date))
+        (forward-line 1)
+	(setq new-file (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
+        (unless (equal file new-file)
+          (setq file new-file))
+	(push (list commit date subject author file) revision-infos)
+        (forward-line 2))
+      revision-infos)))
+
+(defun vc-git-tm-map-line (file from-commit from-line to-commit from-is-older)
+  "Return TO-COMMIT's line corresponding to FROM-COMMIT's FROM-LINE.
+On entry the current-buffer is an empty temporary buffer.
+
+Elsewhere the formals FROM-COMMIT and TO-COMMIT are named FROM-REVISION
+and TO-REVISION.  This change of name is to clarify the git meaning."
+  (let ((line (format "-L %s,%s" from-line from-line))
+        (reverse-flag (if from-is-older "--reverse" ""))
+        (range (if from-is-older
+                   (format "%s..%s" to-commit from-commit)
+                 (format "%s..%s" from-commit to-commit)))
+        (to-line))
+    (vc-git--process-file "blame" reverse-flag "-n" line file range)
+    (goto-char (point-min))
+    ;; For an end-of-buffer problem try flipping the blame around.
+    (when (search-forward-regexp "^fatal: file .+ has only .+ lines" nil t)
+      (erase-buffer)
+      (setq from-line (1- from-line))
+      (setq line (format "-L %s,%s" from-line from-line))
+      (vc-git--process-file "blame" reverse-flag "-n" line file range))
+    (goto-char (point-min))
+    (search-forward-regexp "^[^ ]+ \\([^ ]+\\)")
+    (setq to-line (string-to-number (match-string 1)))
+    ;; Just reuse from-line if git blame fails to give us what we expect.
+    (when (= to-line 0)
+      (setq to-line from-line))
+    to-line))
+
+(defun vc-git--process-file (&rest args)
+  "Run `process-file' with ARGS and `vc-git-global-git-arguments' applied."
+  (apply #'process-file vc-git-program nil t nil (append vc-git-global-git-arguments args)))
+
 ;;; MISCELLANEOUS
 
 (defun vc-git-previous-revision (file rev)
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index e242d1e48e..9bdb94ae1a 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -30,7 +30,8 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile
+  (require 'cl-lib))
 
 ;; Faces
 
@@ -883,7 +884,9 @@ vc-prefix-map
   "D"   #'vc-root-diff
   "~"   #'vc-revision-other-window
   "x"   #'vc-delete-file
-  "!"   #'vc-edit-next-command)
+  "!"   #'vc-edit-next-command
+  ","   #'vc-tm-revision-head)
+
 (fset 'vc-prefix-map vc-prefix-map)
 (define-key ctl-x-map "v" 'vc-prefix-map)
 
@@ -904,6 +907,9 @@ vc-menu-map
     (bindings--define-key map [vc-rename-file]
       '(menu-item "Rename File" vc-rename-file
 		  :help "Rename file"))
+    (bindings--define-key map [vc-tm-revision-head]
+      '(menu-item "Time machine at HEAD" vc-tm-revision-head
+		  :help "Launch a time machine for the HEAD revision"))
     (bindings--define-key map [vc-revision-other-window]
       '(menu-item "Show Other Version" vc-revision-other-window
 		  :help "Visit another version of the current file in another window"))
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index c2112b76ad..9f52587f6f 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -31,6 +31,10 @@
 
 ;; You can support the RCS -x option by customizing vc-rcs-master-templates.
 
+;;; Todo:
+;;
+;; * Teach vc-rcs-tm-revisions about RCS branching
+
 ;;; Code:
 
 ;;;
@@ -41,6 +45,7 @@
   (require 'cl-lib)
   (require 'vc))
 (require 'log-view)
+(require 'vc-timemachine)
 
 (declare-function vc-read-revision "vc"
                   (prompt &optional files backend default initial-input))
@@ -815,6 +820,51 @@ vc-rcs-create-tag
        (lambda (f)
 	 (vc-do-command "*vc*" 0 "rcs" (vc-master-name f) (concat "-n" name ":")))))))
 
+\f
+;;;
+;;; Timemachine
+;;;
+
+;; This implementation does not handle RCS branches.
+(defun vc-rcs-tm-revisions (file)
+  "Return data about revisions modifying FILE on checked-out branch."
+  (vc-do-command t 0 "rcs" (concat vc-cache-root file) "log")
+  (vc-rcs-tm-revisions-parse-log file))
+
+;; Convert an RCS log into revisions info per vc-timemachine's expectations.
+(defun vc-rcs-tm-revisions-parse-log (file)
+  "Extract revisions info from contents of current buffer."
+  (goto-char (point-min))
+  (let ((revision-infos)
+        (line)
+        (revision)
+        (subject) (new-subject)
+        (author)  (new-author)
+        (date)    (new-date))
+    (while (search-forward-regexp "^-[-]*\n" nil t)
+      (setq line (concat (buffer-substring-no-properties (line-beginning-position) (line-end-position)) "\t"))
+      (when (string-match "^revision \\(1[.][0-9]+\\)\t" line)
+        (setq revision (match-string 1 line))
+        (forward-line 1)
+        (setq line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
+        (string-match "^date: \\([^;]*\\);  author: \\([^;]*\\);" line)
+	(setq new-author (match-string 2 line))
+        (unless (equal author new-author)
+          (setq author new-author))
+        (setq new-date (vc-tm-format-date (match-string 1 line)))
+        (unless (equal date new-date)
+          (setq date new-date))
+        (forward-line 1)
+        (when (looking-at-p "branches: .*;")
+          (forward-line 1))
+        (setq new-subject (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
+        (when (equal new-subject "*** empty log message ***")
+          (setq new-subject ""))
+        (unless (equal subject new-subject)
+          (setq subject new-subject))
+	(push (list revision date subject author file) revision-infos)))
+    revision-infos))
+
 \f
 ;;;
 ;;; Miscellaneous
diff --git a/lisp/vc/vc-timemachine.el b/lisp/vc/vc-timemachine.el
new file mode 100644
index 0000000000..ac3b936334
--- /dev/null
+++ b/lisp/vc/vc-timemachine.el
@@ -0,0 +1,426 @@
+;;; vc-timemachine.el --- Walk through revisions of a file  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Credits:
+;;
+;;  Peter Stiernström - wrote the original, git-only version
+;;  John Yates        - refactored Peter's code for the VC environment
+
+;;; Commentary:
+;;
+;; A timemachine buffer is a sliding read-only window over the distinct
+;; revisions of a single file on a VCS branch.  To create a timemachine:
+;;
+;;    (vc-prefix-map ",")   vc-tm-revision-head
+;;
+;; Timemachine implements prefix-free minor mode vc-tm-mode:
+;;
+;;    "," . vc-tm-revision-head
+;;    "~" . vc-tm-revision-select
+;;    "g" . vc-tm-revision-i
+;;    "n" . vc-tm-revision-next
+;;    "p" . vc-tm-revision-previous
+;;    "q" . vc-tm-quit
+;;    "s" . vc-tm-revision-complete-subject
+;;    "w" . vc-tm-abbreviated-revision-to-kill-ring
+;;    "W" . vc-tm-revision-to-kill-ring
+;;
+;; To support timemachine functionality a VCS backend needs to implement:
+;;
+;;   - tm-revisions (file)
+;;
+;; And ideally:
+;;
+;;   - tm-map-line (file from-revision from-line to-revision from-is-older)
+;;
+;; For more details see the large comment at the front of vc.el.
+
+;;; Todo:
+;;
+;; * implement missing blame
+;; * implement missing show-commit
+;; * vc-tm-create: when called from a revision buffer, should jump to that revision
+;; * vc-tm--time-machine: confirm revision is present in tmbuf--branch-revisions
+
+;;; Code:
+
+(require 'vc)
+
+(defgroup vc-timemachine nil
+  "Time-machine functionality for VC backends."
+  :group 'vc
+  :version "30.1")
+
+(defcustom vc-tm-date-format
+  "%a %I:%M %p %Y-%m-%d"
+  "Revision creation date format (emphasis on easy date comparison)."
+  :type 'string
+  :group 'vc-timemachine
+  :version "30.1")
+
+(defcustom vc-tm-echo-area t
+  "When non-nil show revision details in the echo-area while navigating commits."
+  :type 'boolean
+  :group 'vc-timemachine
+  :version "30.1")
+
+(defcustom vc-tm-echo-area-detail 'subject
+  "What to display when `vc-tm-echo-area` is t.
+Available values are:
+`ID`      : The revision's ID (commit hash)
+`subject` : The revision's commit message subject line"
+  :type '(radio (const :tag "Revision ID (commit hash)" commit)
+                (const :tag "Revision message subject line" subject))
+  :group 'vc-timemachine
+  :version "30.1")
+
+(defface vc-tm-echo-area-detail-face
+  '((((class color) (background dark))
+     :foreground "yellow")
+    (((class color) (background light))
+     :foreground "yellow4"))
+  "Face to use when displaying details in the echo-area."
+  :group 'vc-timemachine
+  :version "30.1")
+
+(defcustom vc-tm-echo-area-author t
+  "Prepend author to echo-area details."
+  :type 'boolean
+  :group 'vc-timemachine
+  :version "30.1")
+
+(defface vc-tm-echo-area-author-face
+  '((((class color) (background dark))
+     :foreground "orange")
+    (((class color) (background light))
+     :foreground "DarkOrange4"))
+  "Face to use when displaying author as part of details in the echo-area."
+  :group 'vc-timemachine
+  :version "30.1")
+
+(defcustom vc-tm-abbreviation-length 12
+  "Number of chars from full revision id to use for abbreviation."
+  :type 'integer
+  :group 'vc-timemachine
+  :version "30.1")
+
+(defcustom vc-tm-quit-to-invoking-buffer t
+  "Switch to invoking buffer on ‘vc-tm-quit’."
+  :type 'boolean
+  :group 'vc-timemachine
+  :version "30.1")
+
+(defvar-local vc--time-machine nil
+  "Cache a TM hint on various buffers.")
+(put 'vc--time-machine 'permanent-local t)
+
+(defvar-local tmbuf--abs-file nil
+  "Absolute path to file being traversed by this time-machine.")
+(put 'tmbuf--abs-file 'permanent-local t)
+(defvar-local tmbuf--backend nil
+  "The VC backend being used by this time-machine")
+(put 'tmbuf--backend 'permanent-local t)
+(defvar-local tmbuf--branch-index nil
+  "Zero-base index into tmbuf--branch-revisions.")
+(put 'tmbuf--branch-revisions 'permanent-local t)
+(defvar-local tmbuf--branch-revisions nil
+  "When non-nil, a vector of revision-info lists.")
+(put 'tmbuf--branch-revisions 'permanent-local t)
+(defvar-local tmbuf--source-buffer nil
+  "A non-time-machine buffer for which this time-machine was created.")
+(put 'tmbuf--source-buffer 'permanent-local t)
+
+(defun vc-tm--time-machine ()
+  "Return a valid time-machine for the current buffer."
+  (if tmbuf--backend
+      (current-buffer)
+    (let ((revision vc-tm--revision) ;; caller could be a revision buffer
+          (source (current-buffer)))
+      (set-buffer (or (buffer-base-buffer) source))
+      (vc-ensure-vc-buffer)
+
+      (let* ((parent vc-parent-buffer)
+             (abs-file (buffer-file-name))
+             (backend  (vc-backend abs-file))
+             (work-rev (vc-working-revision abs-file))
+             (tmbuf vc--time-machine))
+
+        ;; ensure that there is a revision with which to work.
+        (unless revision
+          (setq revision work-rev)
+          (setq source (current-buffer)))
+
+        ;; Validate any current time-machine buffer.
+        (when tmbuf
+          (with-current-buffer tmbuf
+            (unless (and (equal abs-file tmbuf--abs-file)
+                         (equal backend  tmbuf--backend)
+                         ;; TODO: confirm that revision is in tmbuf--branch-revisions.
+                         )
+              ;; Discard an unvalidate TM buffer.
+              (setq tmbuf nil))))
+
+        ;; Create a fresh TM buffer if needed.
+        (unless tmbuf
+          (with-current-buffer (setq tmbuf (get-buffer-create "*nascent TM*"))
+            (setq vc-parent-buffer parent)
+            (setq vc--time-machine tmbuf)
+            (setq vc-tm--revision revision)
+            (setq tmbuf--abs-file abs-file)
+            (setq tmbuf--backend backend)
+            (setq tmbuf--source-buffer source)
+            (setq tmbuf--branch-index 0)
+            (setq tmbuf--branch-revisions
+                  (with-temp-buffer
+                    (prog2
+                        (message "Enumerating revisions...")
+                        (let* ((vec (cl-coerce (vc-call-backend backend 'tm-revisions abs-file) 'vector))
+                               (branch (nreverse vec)))
+                          branch)
+                      (message "Enumerating revisions...done"))))))
+
+        (set-buffer tmbuf)
+        tmbuf))))
+
+;;;###autoload
+(defun vc-tm-revision-head ()
+  "Show work file's current revision on checked-out branch."
+  (interactive)
+  (with-current-buffer (vc-tm--time-machine)
+    (vc-tm--switch-to-revision 1)))
+
+(defun vc-tm-revision-next ()
+  "Show work file's next revision on checked-out branch."
+  (interactive)
+  (with-current-buffer (vc-tm--time-machine)
+    (vc-tm--switch-to-revision tmbuf--branch-index)))
+
+(defun vc-tm-revision-previous ()
+  "Show work file's previous revision on checked-out branch."
+  (interactive)
+  (with-current-buffer (vc-tm--time-machine)
+    (vc-tm--switch-to-revision (+ tmbuf--branch-index 2))))
+
+(defun vc-tm-revision-i (number)
+  "Show work file's N'th most recent revision on checked-out branch (1 being HEAD)."
+  (interactive "nEnter revision position: ")
+  (with-current-buffer (vc-tm--time-machine)
+    (vc-tm--switch-to-revision number)))
+
+(defun vc-tm-revision-complete-subject ()
+  "Show work file's revision via subject completion on checked-out branch."
+  (interactive)
+  (let* ((s (completing-read
+             "Commit subject: "
+             (mapcar (apply-partially #'nth 2) tmbuf--branch-revisions))))
+    (vc-tm--switch-to-revision
+     (cl-loop for revision-number from 1
+              for info across tmbuf--branch-revisions
+              if (equal s (nth 2 info)) return revision-number
+              finally (error "Subject not found")))))
+
+(defun vc-tm--switch-to-revision (to-number)
+  "Show work file's revision at position TO-NUMBER on checked-out branch."
+  (let ((branch-length (length tmbuf--branch-revisions))
+        (to-index (1- to-number))
+        (calling-window-buffer (window-buffer))
+        (cursor-win-pos))
+    (with-current-buffer calling-window-buffer
+      (setq cursor-win-pos (vc-tm--get-cursor-win-position)))
+    (cond
+     ((< to-number 1)
+      (error "%s" "This is the HEAD revision; there are none newer"))
+     ((>= to-index branch-length)
+      (error "There is no revision %d (the oldest revision is %d)"
+             to-number branch-length))
+     (t
+      (let* ((new-revision-info (vc-tm--tmbuf-revision-info to-index))
+             (new-revision (car new-revision-info))
+             (abbrev-rev (vc-tm--abbreviate new-revision))
+             (date (nth 1 new-revision-info))
+             (n-of-m (format " [%d/%d %s]" to-number branch-length date))
+             ;; Use the file-name from new-revision-info to reveal renames.
+             (file-name (file-name-nondirectory (nth 4 new-revision-info)))
+             (tmbuf (current-buffer))
+             (from-line (line-number-at-pos))
+             (to-line from-line))
+        (when vc-tm--revision
+          (unless (= tmbuf--branch-index to-index)
+            (setq to-line (vc-tm--map-line from-line to-index))))
+        (vc-find-revision tmbuf--abs-file new-revision tmbuf--backend tmbuf)
+        ;; Reuse timemachine windows, otherwise create them in some other-window.
+        (if (eq calling-window-buffer tmbuf)
+            (switch-to-buffer tmbuf)
+          (switch-to-buffer-other-window tmbuf))
+        (vc-tm-mode +1)
+        (forward-line (- to-line (line-number-at-pos)))
+        (vc-tm--set-cursor-win-position cursor-win-pos)
+        (setq tmbuf--branch-index to-index)
+
+        (rename-buffer (concat file-name " " abbrev-rev) t)
+        (setq mode-line-buffer-identification
+              (list (propertized-buffer-identification "%12b") n-of-m))
+
+        (when vc-tm-echo-area
+          (vc-tm--show-echo-area-details new-revision-info))))
+      (vc-tm--erm-workaround))))
+
+
+(defun vc-tm--map-line (from-line to-index)
+  "Return a suggested new current-line after a revision jump."
+  ;; Newer and older are first guesses; subsequently they may get swapped.
+  (let* ((to-info (vc-tm--tmbuf-revision-info to-index))
+         (to-revision (car to-info))
+         (from-revision vc-tm--revision)
+         (from-is-older (< tmbuf--branch-index to-index))
+         (backend tmbuf--backend)
+         (abs-file tmbuf--abs-file))
+    (with-temp-buffer
+      (vc-call-backend backend 'tm-map-line abs-file
+                       from-revision from-line to-revision from-is-older))))
+
+(defun vc-default-tm-map-line (_backend _rel-file _from-revision from-line
+                                     _to-revision _from-is-older)
+  "Default `map-line' implementation.
+It merely returns FROM-LINE."
+  from-line)
+
+(defun vc-tm--show-echo-area-details (revision-info)
+  "Show details for REVISION-INFO in echo-area."
+  (let* ((date (nth 1 revision-info))
+         (author (if vc-tm-show-author (concat " | " (nth 3 revision-info)) ""))
+         (sha-or-subject (if (eq vc-tm-echo-area-detail 'commit) (car revision-info) (nth 2 revision-info))))
+    (message "%s%s: %s"
+             date
+             (propertize author 'face 'vc-tm-echo-area-author-face)
+             (propertize sha-or-subject 'face 'vc-tm-echo-area-detail-face))))
+
+(defun vc-tm-format-date (date)
+  "Return date formatted per the user's vc-tm-date-format."
+  (format-time-string vc-tm-date-format (date-to-time date)))
+
+(declare-function erm-reset-buffer "ext:enh-ruby-mode")
+
+(defun vc-tm--erm-workaround ()
+  "Workaround for enhanced ruby mode not detecting revision change."
+  (when (eq major-mode 'enh-ruby-mode)
+    (ignore-errors (erm-reset-buffer))))
+
+(defun vc-tm--get-cursor-win-position ()
+  "Return the cursor visual line number w.r.t. the current window first line."
+  (let* ((win-point-min (save-excursion (move-to-window-line 0) (point)))
+         (cur-pos (count-screen-lines win-point-min (point))))
+    cur-pos))
+
+(defun vc-tm--set-cursor-win-position (POS)
+  "Set the cursor position to the POS visual line w.r.t. the window first line."
+  (recenter POS))
+
+(defun vc-tm--abbreviate (revision)
+  "Return REVISION abbreviated to `vc-tm-abbreviation-length' chars."
+  (if (length< revision vc-tm-abbreviation-length)
+      revision
+    (substring revision 0 vc-tm-abbreviation-length)))
+
+(defun vc-tm-revision-to-kill-ring ()
+  "Kill the current revisions abbreviated commit hash."
+  (interactive)
+  (let ((revision (vc-tm--tmbuf-revision)))
+    (message revision)
+    (kill-new revision)))
+
+(defun vc-tm-abbreviated-revision-to-kill-ring ()
+  "Kill the current revisions full commit hash."
+  (interactive)
+  (let ((revision (vc-tm--abbreviate (vc-tm--tmbuf-revision))))
+    (message revision)
+    (kill-new revision)))
+
+;; (defun vc-tm-show-commit ()
+;;   "Show commit for current revision."
+;;   (interactive)
+;;   (let ((rev (vc-tm--tmbuf-revision)))
+;;     (if (fboundp 'magit-show-commit)
+;;         (magit-show-commit rev)
+;;       (message "You need to install magit to show commit"))))
+
+;; (defun vc-tm-blame ()
+;;   "Call ‘magit-blame’ on current revision."
+;;   (interactive)
+;;   (if (fboundp 'magit-blame)
+;;       (let ((magit-buffer-revision (car tm--revision-info)))
+;;      (magit-blame))
+;;     (message "You need to install magit for blame capabilities")))
+
+(defun vc-tm--tmbuf-revision (&optional index)
+  "Return the unique revision id for this tmbuf's current revision."
+  (car (vc-tm--tmbuf-revision-info index)))
+
+(defun vc-tm--tmbuf-revision-info (&optional index)
+  "Return the revision-info list for this tmbuf's current revision."
+  (aref tmbuf--branch-revisions (or index tmbuf--branch-index)))
+
+(defun vc-tm-quit ()
+  "Exit the timemachine."
+  (interactive)
+  (let ((parent-buffer-name buffer-file-name))
+    (kill-buffer)
+    (let ((parent-buffer (find-buffer-visiting parent-buffer-name)))
+      (when (and parent-buffer vc-tm-quit-to-invoking-buffer)
+        (switch-to-buffer parent-buffer nil t)))))
+
+(transient-define-prefix vc-tm-help ()
+  "Show online help."
+  ["Navigate"
+   [("," "switch to HEAD revision" vc-tm-revision-head)
+    ("~" "switch to selected revision id" vc-tm-revision-select)
+    ("n" "switch to next revision" vc-tm-revision-next)
+    ("p" "switch to previous revision" vc-tm-revision-previous)
+    ("j" "switch to i'th revision" vc-tm-revision-nth)
+    ("s" "switch to subject revision" vc-tm-revision-complete-subject)]]
+  ["Revision ID to kill ring"
+   [("w" "abbreviated revision id" vc-tm-abbreviated-revision-to-kill-ring)
+    ("W" "full revision id" vc-tm-revision-to-kill-ring)]]
+  ["Misc"
+   [ ;; ("B" "blame current revision" vc-tm-blame)
+;;  ("C" "view commit" vc-tm-show-commit)
+    ("?" "show help" vc-tm-help)
+    ("q" "quit" vc-tm-quit)]])
+
+(define-minor-mode vc-tm-mode
+  "VC Timemachine, feel the wings of history."
+  :init-value nil
+  :lighter " TM"
+  :keymap
+  '(("," . vc-tm-revision-head)
+    ("~" . vc-tm-revision-select)
+;;  ("B" . vc-tm-blame)
+;;  ("C" . vc-tm-show-commit)
+    ("j" . vc-tm-revision-nth)
+    ("n" . vc-tm-revision-next)
+    ("p" . vc-tm-revision-previous)
+    ("q" . vc-tm-quit)
+    ("s" . vc-tm-revision-complete-subject)
+    ("S" . vc-tm-revision-complete-subject) ; in vc-mode "s" is vc-create-tag
+    ("w" . vc-tm-abbreviated-revision-to-kill-ring)
+    ("W" . vc-tm-revision-to-kill-ring)
+    ("?" . vc-tm-help))
+  :group 'vc-timemachine)
+
+(provide 'vc-timemachine)
+
+;;; vc-timemachine.el ends here
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 56977cbe16..88ec3376c4 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -454,6 +454,44 @@
 ;;   Return the most recent revision of FILE that made a change
 ;;   on LINE.
 
+;; TIMEMACHINE
+;;
+;; To support TM a backend must implement:
+;;
+;; - tm-revisions (file &optional branch)
+;;
+;;   Return a list of revision-infos corresponding to the revisions modifying
+;;   FILE on BRANCH within THE VCS'S root-dir.  When BRANCH is present it
+;;   will match that of working FILE.
+;;
+;;   A revision-info is a list (REVISION-ID DATE SUBJECT AUTHOR REL-FILE):
+;;
+;;   - REVISION-ID:  the VCS's unique identification of a revision
+;;   - DATE:         revision creation date formatted by vc-tm-format-date
+;;   - SUBJECT:      first line of message supplied at revision's creation
+;;   - AUTHOR:       some indication of the revision's author
+;;   - REL-FILE:     VCS root-relative path to file
+;;
+;;   The head of the list should describe the oldest revision.  The tail of
+;;   the list should describe the newest revision.
+;;
+;; - tm-map-line (rel-file from-revision from-line to-revision from-is-older)
+;;
+;;   Return TO-REVISION's line corresponding to FROM-REVISION's FROM-LINE.
+;;   FROM-REVISION and TO-REVISION are guaranteed distinct.  FROM-IS-OLDER
+;;   indicates relative temporal ordering of FROM-REVISION and TO-REVISION
+;;   on the branch.
+;;
+;;   On entry default-directory is the VCS's abs-root, REL-FILE is the path
+;;   relative to the file being displayed and the current-buffer is an empty
+;;   temporary buffer.
+;;
+;;   VC supplies a trivial vc-default-tm-map-line.  It returns FROM-LINE,
+;;   effectively asserting that the corresponding line in the TO-REVISION
+;;   occurs at exactly the same line number.  vc-git.el's implementation
+;;   is complete and reasonably understandable.  (Unfortunately, it uses
+;;   many unique features of git blame that may not exist in other VCSs.)
+
 ;; TAG/BRANCH SYSTEM
 ;;
 ;; - create-tag (dir name branchp)
@@ -1196,10 +1234,11 @@ vc-ensure-vc-buffer
 		;; current buffer are the same buffer.
  		(not (eq vc-parent-buffer (current-buffer))))
       (set-buffer vc-parent-buffer))))
-  (if (not buffer-file-name)
-      (error "Buffer %s is not associated with a file" (buffer-name))
-    (unless (vc-backend buffer-file-name)
-      (error "File %s is not under version control" buffer-file-name))))
+  (cond
+   ((not buffer-file-name)
+    (error "Buffer '%s' is not associated with a file" (buffer-name)))
+   ((unless (vc-backend buffer-file-name)
+      (error "File '%s' is not under version control" buffer-file-name)))))
 
 ;;; Support for the C-x v v command.
 ;; This is where all the single-file-oriented code from before the fileset
-- 
2.37.2


[-- Attachment #3: 0003-Introduce-vc-bos-backup-on-save-to-an-RCS-file.patch --]
[-- Type: text/x-patch, Size: 18146 bytes --]

From 77ab06cf9e2bd3dbe878df5bb07eadba5daddc47 Mon Sep 17 00:00:00 2001
From: "John S. Yates, Jr" <john@yates-sheets.org>
Date: Wed, 25 Jan 2023 20:58:59 -0500
Subject: [PATCH 3/3] Introduce vc-bos: backup on save (to an RCS file)

The dream of this vc-bos capability was what first got me working on
vc-timemachine.  From vc-bos.el's front-matter:

    ;; Modern version control systems, such as git, are wonderful.  But they
    ;; have drawbacks when dealing with lightweight save operations:
    ;;
    ;; * Too invasive: new revisions are created only by explicitly action;
    ;;   this includes supplying a commit message (even if empty)
    ;; * Too coarse: a revision captures an entire "project"
    ;; * Too smart: even files listed in .gitignore (or equivalent) remain
    ;;   eligible for edting and hence deserve to get backed-up
    ;; * Requires setup: what about files that have no project?
    ;;
    ;; Enter vc-bos...
    ;;
    ;; vc-bos provides easy access to past revisions of edited files by
    ;; integrating with VC's timemachine functionality.  To do this it
    ;; requires that VC's vc-cache-root be set and that it have '/RCS' as
    ;; one of its directory components (typically the last).
    ;;
    ;; Given such a configuration, vc-bos maintains a mirror tree of RCS
    ;; control files below vc-cache-root.  A control file appears at the
    ;; same position and has exactly the same name as the file that it
    ;; tracks (meaning no ',v' suffix).  This works because RCS treats
    ;; *any* file *anywhere* beneath an RCS directory as a control file.
    ;;
    ;; On FIRST change and EVERY subsequent save cx-bos:
    ;;
    ;; * Qualifies the buffer's path
    ;; * Ensures existence of a mirror directory beneath vc-cache-root
    ;; * Records the newly saved file as the latest RCS revision with
    ;;   an empty commit message
    ;;
    ;; vc-bos's tracking is independent of whether a file is track by
    ;; any other VCS.

Thus, vc-bos is both a minimally invasive way to capture save history for
arbitrary files and a convenient way of access that history.

============================================================================

vc-bos leverages vc-timemachine to provide easy access to revisions
recorded at the point of saving a file.  It is implemented as a new
minor mode.

* vc-bos.el: new file; implements an extremely minimal vc backend
* vc-rcs.el (vc-rcs-tm-revisions): split out vc-rcs-tm-revisions-parse-log
  so that it can be shared with vc-bos-tm-revisions.
  (vc-rcs-tm-revisions-parse-log): record empty subject as nil instead of ""
* vc-timemachine (vc-tm-revision-head): when prefix arg is present bind new
  vc-force-bos to trigger use of vc-bos backend (even when file is registered
  with some other vc backend)
  (vc-tm--switch-to-revision): pass tmbuf--backend vc-find-revision so as to
  propagate bos handling
  (vc-tm--show-echo-area-details): if backend is 'bos then suppress worthless
  author and subject
  * vc.el (vc-ensure-vc-buffer): improve diagnostic when user attempt to
  initiate a timemachine on a file that is not register with any vc backend
  (vc-find-revision): call vc-bos-find-revision when backend is 'bos
---
 lisp/vc/vc-bos.el         | 207 ++++++++++++++++++++++++++++++++++++++
 lisp/vc/vc-git.el         |   2 -
 lisp/vc/vc-rcs.el         |   2 +-
 lisp/vc/vc-timemachine.el |  40 +++++---
 lisp/vc/vc.el             |  28 +++++-
 5 files changed, 257 insertions(+), 22 deletions(-)
 create mode 100644 lisp/vc/vc-bos.el

diff --git a/lisp/vc/vc-bos.el b/lisp/vc/vc-bos.el
new file mode 100644
index 0000000000..e689a2cda3
--- /dev/null
+++ b/lisp/vc/vc-bos.el
@@ -0,0 +1,207 @@
+;;; vc-bos.el --- VC Backup On Save (to RCS)
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Benjamin Rutt <brutt@bloomington.in.us>
+;; Maintainer: Conor Nash <conor@nashcobusinessservicesllc.com>
+;; Maintainer: John S. Yates, Jr. <john@yates-sheets.org>
+;; Version: 0.8
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Credits:
+;;
+;; Author:     Benjamin Rutt      <brutt@bloomington.in.us>
+;; Maintainer: John S. Yates, Jr. <john@yates-sheets.org>
+
+;;; Commentary:
+
+;; Derived from and then heavily modified:
+;;   https://www.emacswiki.org/emacs/backup-each-save.el
+;;
+;; Modern version control system, such as git, are wonderful.  But they
+;; have drawbacks when dealing with lightweight save operations:
+;;
+;; * Too invasive: new revisions are created only by explicitly action;
+;;   this includes supplying a commit message (even if empty)
+;; * Too coarse: a revision captures an entire "project"
+;; * Too smart: even files listed in .gitignore (or equivalent) remain
+;;   eligible for edting and hence deserve to get backed-up
+;; * Requires setup: what about files that have no project?
+;;
+;; Enter vc-bos...
+;;
+;; vc-bos provides easy access to past revisions of edited files by
+;; integrating with VC's timemachine functionality.  To do this it
+;; requires that VC's vc-cache-root be set and that it have '/RCS' as
+;; one of its directory components (typically the last).
+;;
+;; Given such a configuration, vc-bos maintains a mirror tree of RCS
+;; control files below vc-cache-root.  A control file appears at the
+;; same position and has exactly the same name as the file that it
+;; tracks (meaning no ',v' suffix).  This works because RCS treats
+;; *any* file *anywhere* beneath an RCS directory as a control file.
+;;
+;; On FIRST change and EVERY subsequent save cx-bos:
+;;
+;; * Qualifies the buffer's path
+;; * Ensures existence of a mirror directory beneath vc-cache-root
+;; * Records the newly saved file as the latest RCS revision with
+;;   an empty commit message
+;;
+;; vc-bos's tracking is independent of whether a file is track by
+;; any other VCS.
+;;
+;; vc-bos requires that the rcs executable be available (typically
+;; installed at /usr/bin/rcs).
+;;
+;; To activate globally, place this file in your `load-path', ensure
+;; that vc-cache-root is set, then add the following to your init.el:
+;;
+;;     (vc-bos-mode t)
+;;
+;; To filter which files vc-bos backs up, setup a custom function for
+;; `vc-bos-filter-function'.  For example, to filter out the saving of
+;; gnus .newsrc.eld files, do:
+;;
+;;     (defun vc-bos-no-newsrc-eld (filename)
+;;       (cond
+;;        ((string= (file-name-nondirectory filename) ".newsrc.eld") nil)
+;;        (t t)))
+;;     (setq vc-bos-filter-function 'bos-no-newsrc-eld)
+
+;;; Todo:
+;;
+;; * garbage collection: it would be nice to have a cron script to purge
+;;   ancient revisions
+
+;;; Notes:
+
+;;; Code:
+
+(require 'vc-hooks)
+(require 'vc-rcs)
+
+
+(defgroup vc-bos nil
+  "Backup On Save (to an RCS file)."
+  :group 'vc-timemachine
+  :group 'backup
+  :version "30.1")
+
+(defcustom vc-bos-remote-files nil
+  "Whether to backup remote files at each save (off by default)."
+  :type 'boolean
+  :group 'vc-bos
+  :version "30.1")
+
+(defcustom vc-bos-filter-function #'identity
+  "Function which should return non-nil if the file should be backed up."
+  :type 'function
+  :group 'vc-bos
+  :version "30.1")
+
+(defcustom vc-bos-size-limit 50000
+  "Maximum size (in byte) beyond which a file will not get backed-up.
+Setting this variable to nil disables the size check."
+  :type 'natnum
+  :group 'vc-bos
+  :version "30.1")
+
+(defcustom vc-bos-rcs "/usr/bin/rcs"
+  "Path to the rcs executable (required for vc-bos functionality)."
+  :type '(file :must-match t)
+  :group 'vc-bos
+  :version "30.1")
+
+(defconst vc-bos-witnesses-regex
+  "/\\(SCCS\\|RCS\\|CVS\\|MCVS\\|[.]src\\|[.]svn\\|[.]git\\|[.]hg\\|[.]bzr\\|_MTN\\|_darcs\\|[{]arch[}]\\)/"
+  "Writes to any point below one of these witnesses should be ignored.
+
+FIXME: This is a regex-ified copy of vc-hooks's vc-directory-exclusion-list.")
+
+
+;; This implementation does not handle RCS branches.
+;;;###autoload
+(defun vc-bos-tm-revisions (file)
+  "Return data about backup-on-save revisions of FILE."
+  (let ((master-file (concat vc-cache-root file)))
+    (vc-do-command t 0 vc-bos-rcs master-file "log"))
+  (vc-rcs-tm-revisions-parse-log file))
+
+;;;###autoload
+(defun vc-bos-find-revision (file rev buffer)
+  "Return in BUFFER FILE's backup-on-save revision REV."
+  (let ((master-file (concat vc-cache-root file)))
+    (vc-do-command (or buffer "*vc*") 0 vc-bos-rcs master-file "co" "-q" (concat "-p" rev))))
+
+;; ;;;###autoload
+;; (defun vc-bos-tm-map-line (file from-revision from-line to-revision from-is-older)
+;;   "Return TO-REVISION's line corresponding to FROM-REVISION's FROM-LINE.
+;; On entry the current-buffer is an empty temporary buffer."
+;;
+;;   (message "\n == vc-bos-tm-map-line ==\n")
+;;   from-line)
+
+(defun vc-bos-add-revision ()
+  "Record a new RCS 'backup on save' revision of buffer's file."
+  (setq vc-consult-headers nil)
+  (let ((bfn buffer-file-name))
+    (when (and bfn
+               (not (string-match-p vc-bos-witnesses-regex bfn))
+               (or vc-bos-remote-files
+		   (not (file-remote-p bfn)))
+	       (or (not vc-bos-size-limit)
+		   (<= (buffer-size) vc-bos-size-limit))
+               (funcall vc-bos-filter-function bfn))
+      (let* ((mirror-file (vc-bos--mirror-file bfn)))
+        (call-process vc-bos-rcs
+                      nil (get-buffer-create "*vc-bos-log*") nil
+                      "ci" "-l" "-m''" "-t-''" bfn mirror-file)))))
+
+(defun vc-bos--mirror-file (file)
+  "Return path to FILE's RCS control file within vc-cache-root."
+  (let* ((dir (file-name-directory file))
+	 (file (file-name-nondirectory file))
+	 (mirror-dir (concat (expand-file-name vc-cache-root) dir))
+         (mirror-file (concat mirror-dir file)))
+    (unless (file-exists-p mirror-dir)
+      (make-directory mirror-dir t))
+    mirror-file))
+
+(define-minor-mode vc-bos-mode
+  "Silently backup saved files as new RCS revisions beneath vc-cache-root.
+
+Visit saved revisions using vc-tm-revision-head: (C-u C-x v ,)."
+  :global t
+  :group 'backup
+  :group 'vc-bos
+  :version "30.1"
+  :lighter " BoS"
+  (when vc-bos-mode
+    (unless (and (stringp vc-cache-root)
+                 (string-match-p "/RCS$" vc-cache-root))
+      (setq vc-bos-mode nil)
+      (error "vc-bos-mode requires vc-cache-root (%s) to contains a '/RCS' component" vc-cache-root))
+    (add-hook 'first-change-hook #'vc-bos-add-revision)
+    (add-hook 'after-save-hook   #'vc-bos-add-revision))
+  (unless vc-bos-mode
+    (remove-hook 'first-change-hook #'vc-bos-add-revision)
+    (remove-hook 'after-save-hook   #'vc-bos-add-revision)))
+
+(provide 'vc-bos)
+
+;;; vc-bos.el ends here
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 1f45aa7e96..745a275294 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -104,8 +104,6 @@
 
 (require 'cl-lib)
 (require 'vc-dispatcher)
-(require 'transient)
-(require 'vc-timemachine)
 (eval-when-compile
   (require 'subr-x) ; for string-trim-right
   (require 'vc)
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 9f52587f6f..92246c3ce7 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -859,7 +859,7 @@ vc-rcs-tm-revisions-parse-log
           (forward-line 1))
         (setq new-subject (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
         (when (equal new-subject "*** empty log message ***")
-          (setq new-subject ""))
+          (setq new-subject nil))
         (unless (equal subject new-subject)
           (setq subject new-subject))
 	(push (list revision date subject author file) revision-infos)))
diff --git a/lisp/vc/vc-timemachine.el b/lisp/vc/vc-timemachine.el
index ac3b936334..4ed7a2b8b3 100644
--- a/lisp/vc/vc-timemachine.el
+++ b/lisp/vc/vc-timemachine.el
@@ -58,6 +58,8 @@
 
 ;;; Code:
 
+(declare-function vc-bos-tm-revisions  "vc-bos" (abs-file))
+
 (require 'vc)
 
 (defgroup vc-timemachine nil
@@ -155,7 +157,7 @@ vc-tm--time-machine
 
       (let* ((parent vc-parent-buffer)
              (abs-file (buffer-file-name))
-             (backend  (vc-backend abs-file))
+             (backend  (if vc-force-bos 'bos (vc-backend abs-file)))
              (work-rev (vc-working-revision abs-file))
              (tmbuf vc--time-machine))
 
@@ -188,7 +190,10 @@ vc-tm--time-machine
                   (with-temp-buffer
                     (prog2
                         (message "Enumerating revisions...")
-                        (let* ((vec (cl-coerce (vc-call-backend backend 'tm-revisions abs-file) 'vector))
+                        (let* ((vec (cl-coerce (if (eq backend 'bos)
+                                         (vc-bos-tm-revisions abs-file)
+                                       (vc-call-backend backend 'tm-revisions abs-file))
+                                     'vector))
                                (branch (nreverse vec)))
                           branch)
                       (message "Enumerating revisions...done"))))))
@@ -197,11 +202,14 @@ vc-tm--time-machine
         tmbuf))))
 
 ;;;###autoload
-(defun vc-tm-revision-head ()
-  "Show work file's current revision on checked-out branch."
-  (interactive)
-  (with-current-buffer (vc-tm--time-machine)
-    (vc-tm--switch-to-revision 1)))
+(defun vc-tm-revision-head (&optional bos)
+  "Show work file's current revision on checked-out branch.
+With a prefix argument, disregard any registration under any
+other VCS and show vc-bos backup-on-save revisions."
+  (interactive "P")
+  (let ((vc-force-bos bos))
+    (with-current-buffer (vc-tm--time-machine)
+      (vc-tm--switch-to-revision 1))))
 
 (defun vc-tm-revision-next ()
   "Show work file's next revision on checked-out branch."
@@ -301,13 +309,17 @@ vc-default-tm-map-line
 
 (defun vc-tm--show-echo-area-details (revision-info)
   "Show details for REVISION-INFO in echo-area."
-  (let* ((date (nth 1 revision-info))
-         (author (if vc-tm-show-author (concat " | " (nth 3 revision-info)) ""))
-         (sha-or-subject (if (eq vc-tm-echo-area-detail 'commit) (car revision-info) (nth 2 revision-info))))
-    (message "%s%s: %s"
-             date
-             (propertize author 'face 'vc-tm-echo-area-author-face)
-             (propertize sha-or-subject 'face 'vc-tm-echo-area-detail-face))))
+  (let ((date  (nth 1 revision-info)))
+    (if (eq tmbuf--backend 'bos)
+        (message "%s" date)
+      (let* ((author (if vc-tm-echo-area-author (concat " | " (nth 3 revision-info)) ""))
+             (sha-or-subject (if (eq vc-tm-echo-area-detail 'commit)
+                                 (car revision-info)
+                               (nth 2 revision-info))))
+        (message "%s%s: %s"
+                 date
+                 (propertize author 'face 'vc-tm-echo-area-author-face)
+                 (propertize sha-or-subject 'face 'vc-tm-echo-area-detail-face))))))
 
 (defun vc-tm-format-date (date)
   "Return date formatted per the user's vc-tm-date-format."
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 88ec3376c4..7e9852312f 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -809,6 +809,7 @@
 
 (declare-function diff-setup-whitespace "diff-mode" ())
 (declare-function diff-setup-buffer-type "diff-mode" ())
+(declare-function vc-bos-find-revision "vc-bos" (abs-file rev buffer))
 
 (eval-when-compile
   (require 'dired))
@@ -961,6 +962,9 @@ vc-comment-alist
 (defcustom vc-find-revision-cache nil
   "When non-nil, `vc-find-revision' caches a local copy of returned revision."
   :type 'boolean
+  :group 'backup
+  :group 'vc-bos
+  :group 'vc-timemachine
   :version "30.1")
 
 (defcustom vc-cache-root nil
@@ -972,8 +976,13 @@ vc-cache-root
 
 To use `vc-bos-mode', `vc-cache-root' must include a /RCS component."
   :type 'string
+  :group 'backup
+  :group 'vc-bos
+  :group 'vc-timemachine
   :version "30.1")
 
+(defvar vc-force-bos nil
+  "Non-nil indicates retrieving vc-bos revisions.")
 \f
 ;; File property caching
 
@@ -1234,11 +1243,18 @@ vc-ensure-vc-buffer
 		;; current buffer are the same buffer.
  		(not (eq vc-parent-buffer (current-buffer))))
       (set-buffer vc-parent-buffer))))
-  (cond
-   ((not buffer-file-name)
-    (error "Buffer '%s' is not associated with a file" (buffer-name)))
-   ((unless (vc-backend buffer-file-name)
-      (error "File '%s' is not under version control" buffer-file-name)))))
+  (let ((bos-file (concat vc-cache-root buffer-file-name)))
+    (cond
+     ((not buffer-file-name)
+      (error "Buffer '%s' is not associated with a file" (buffer-name)))
+     (vc-force-bos
+      (unless (file-exists-p bos-file)
+        (error "File '%s' has no backup-on-save revisions" buffer-file-name)))
+     ((unless (vc-backend buffer-file-name)
+        (error "File '%s' is not under version control%s"
+               buffer-file-name
+               (when (file-exists-p bos-file)
+                 " but backups from saves are available")))))))
 
 ;;; Support for the C-x v v command.
 ;; This is where all the single-file-oriented code from before the fileset
@@ -2389,6 +2405,8 @@ vc-find-revision
              ;; A cached file is viable IFF it is not writable.
              ((and (file-exists-p save-file) (not (file-writable-p save-file)))
               (insert-file-contents save-file t))
+             ((eq backend 'bos)
+              (vc-bos-find-revision file revision revbuf))
              (backend
               (vc-call-backend backend 'find-revision file revision revbuf))
              (t
-- 
2.37.2


[-- Attachment #4: 0000-cover-letter.patch --]
[-- Type: text/x-patch, Size: 2363 bytes --]

From 77ab06cf9e2bd3dbe878df5bb07eadba5daddc47 Mon Sep 17 00:00:00 2001
From: "John S. Yates, Jr" <john@yates-sheets.org>
Date: Wed, 25 Jan 2023 21:14:27 -0500
Subject: [PATCH 0/3] *** SUBJECT HERE ***
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This is a series of three bisectable (I hope :-) patches that culminate
in support of a new Emacs backup scheme:

* [PATCH 1/3] Refactor and document vc-find-revision caching
* [PATCH 2/3] Introduce VC timemachine capability
* [PATCH 3/3] Introduce vc-bos: backup on save (to an RCS file)

This Backup-On-Save scheme exploits a file system mirror scheme
introduced in the first patch.  By exploiting a little known aspect
of RCS's algorithm for locating a master file, backups are stored
completely removed from the work file (i.e. no local RCS directories)
and under exactly the same filename (i.e. no ',v' suffix or similar).

Accessing backed-ups exploits a new vc-timemachine capability,
introduced in the second patch.  Both the design and code owe much
to Peter Stiernström's original git-timemachine.el.  To sidestep any
copyright issues, Peter has graciously assigned git-timemachine.el's
copyright to the FSF.  With the submission timemachine functionality
is available in both vc-git and vc-rcs.

This backup scheme works equaly well with files already under some
VCS as well as with files that are not currently version controlled.

For me (primarily a C++ programmer) this is:
  * My first significant bit of elisp
  * My first exposure to the VC codebase
  * My first Emacs / FSF submission

I welcome all nature of feedback:
  * Code criticism
  * Violations of pertinent standards
  * Bug reports
  * Suggested improvement
  * . . .

/john

John S. Yates, Jr (3):
  Refactor and document vc-find-revision caching
  Introduce VC timemachine capability
  Introduce vc-bos: backup on save (to an RCS file)

 lisp/vc/vc-bos.el         | 207 ++++++++++++++++++
 lisp/vc/vc-git.el         |  89 +++++++-
 lisp/vc/vc-hooks.el       |  10 +-
 lisp/vc/vc-rcs.el         |  50 +++++
 lisp/vc/vc-timemachine.el | 438 ++++++++++++++++++++++++++++++++++++++
 lisp/vc/vc.el             | 292 ++++++++++++++++---------
 6 files changed, 985 insertions(+), 101 deletions(-)
 create mode 100644 lisp/vc/vc-bos.el
 create mode 100644 lisp/vc/vc-timemachine.el

-- 
2.37.2


[-- Attachment #5: 0001-Refactor-and-document-vc-find-revision-caching.patch --]
[-- Type: text/x-patch, Size: 14382 bytes --]

From 78cefb3cb78faf8be387d4319942078699ebc3e9 Mon Sep 17 00:00:00 2001
From: "John S. Yates, Jr" <john@yates-sheets.org>
Date: Mon, 26 Dec 2022 15:51:03 -0500
Subject: [PATCH 1/3] Refactor and document vc-find-revision caching

Previously there existed two helper functions for vc--revision-other-window:

* vc--revision-other-window-save
* vc--revision-other-window-no-save

The expectation seems to have been that when materializing a revision is
deemed costly (slow backend? remote? ...) it should be saved.  I believe
that, even though the word 'cache' is never used, this was intended to
be a caching mechanism.  That said, the logic provided only a single
save/no-save global toggle.  Aspects of this mechanism were discussed
in this email thread:

  https://lists.gnu.org/archive/html/emacs-devel/2022-10/msg01794.html

I have tried to address some of the concerns raised therein and to
provide some clearer abstractions:

* When a revision gets saved it is deemed a cache.  Thus it is imperative
  that the cached revision be protected and adequately validated before
  being reused.

* A cached revision may be saved as a sibling of the file that triggered its
  materialization or in may be saved in a mirror directory tree rooted at
  `vc-cache-root'.  The latter choice avoids cluttering work trees with with
  historic revisions and enables caching across work trees.  `vc-cache-root'
  will also provide a location for the forthcoming vc-bos's backups.

* I have defined the concept of a revision buffer.  This is the form
  of buffer returned by vc's find-revision operation.  It is bound to
  a specific revision, it is read-only and it has a nil buffer-file-name.
  Thus it visits no saved nor cached file.  The rationale is twofold:

  - A revision is a materialization of immutable history

  - The only potential value for a revision buffer's buffer-file-name is a
    cache file which should likewise be regarded as immutable.  Futher, if
    materializing revisions is not deemed costly, even that file may not
    exist.  So, in the interest of consistency, revision buffers do not
    visit files.

============================================================================

* lisp/vc/vc.el (vc-find-revision-no-save, vc-find-revision-cache):
Rename defcustoms to be more descriptive.
(vc-find-revision, vc-find-revision-save, vc-find-revision-no-save):
Reimplement the enssence of these three function as a single
`vc-find-revision' function.  Clarify that the result is a revision
buffer, unattached to any file.  Support optional caching, either
alongside the original file or within a mirror directory structure
beneath `vc-cache-root'.
---
 lisp/vc/vc.el | 227 ++++++++++++++++++++++++++++++--------------------
 1 file changed, 136 insertions(+), 91 deletions(-)

diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 13124509c2..56977cbe16 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -664,6 +664,9 @@
 
 
 ;;; Todo:
+;;
+;; - other caching considerations: backend? remote?
+
 
 ;;;; New Primitives:
 ;;
@@ -917,10 +920,21 @@ vc-comment-alist
 		       (string :tag "Comment Start")
 		       (string :tag "Comment End"))))
 
-(defcustom vc-find-revision-no-save nil
-  "If non-nil, `vc-find-revision' doesn't write the created buffer to file."
+(defcustom vc-find-revision-cache nil
+  "When non-nil, `vc-find-revision' caches a local copy of returned revision."
   :type 'boolean
-  :version "27.1")
+  :version "30.1")
+
+(defcustom vc-cache-root nil
+  "If non-nil, the root of a tree of cached revisions (no trailing '/').
+
+When `vc-find-revision-cache' is non-nil, if `vc-cache-root' is nil then the
+cached revision will be a sibling of its working file, otherwise the cached
+revision will be saved to a mirror path beneath `vc-cache-root.'
+
+To use `vc-bos-mode', `vc-cache-root' must include a /RCS component."
+  :type 'string
+  :version "30.1")
 
 \f
 ;; File property caching
@@ -2263,97 +2277,128 @@ vc-revision-other-window
 		     rev)))
     (switch-to-buffer-other-window (vc-find-revision file revision))))
 
-(defun vc-find-revision (file revision &optional backend)
-  "Read REVISION of FILE into a buffer and return the buffer.
-Use BACKEND as the VC backend if specified."
-  (if vc-find-revision-no-save
-      (vc-find-revision-no-save file revision backend)
-    (vc-find-revision-save file revision backend)))
 
-(defun vc-find-revision-save (file revision &optional backend)
-  "Read REVISION of FILE into a buffer and return the buffer.
-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)))
-    (unless (file-exists-p filename)
-      (if (file-exists-p automatic-backup)
-          (rename-file automatic-backup filename nil)
-	(message "Checking out %s..." filename)
-	(with-current-buffer filebuf
-	  (let ((failed t))
-	    (unwind-protect
-		(let ((coding-system-for-read 'no-conversion))
-		  (with-temp-file filename
-		    (let ((outbuf (current-buffer)))
-                      ;; We will read the backend's output with no
-                      ;; conversions, so we should also save the
-                      ;; temporary file with no encoding conversions.
-                      (setq buffer-file-coding-system 'no-conversion)
-		      ;; 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)))))
-		  (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)))
-      (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))
-      result-buf)))
+(defvar-local vc-tm--revision nil
+  "Convey a revision buffer's VCS specific unique revision id to VC-TM." )
+(put 'vc-tm--revision 'permanent-local t)
 
-(defun vc-find-revision-no-save (file revision &optional backend buffer)
-  "Read REVISION of FILE into BUFFER and return the buffer.
-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
-revision number.
-Unlike `vc-find-revision-save', doesn't save the buffer to the file."
+;; Before the advent of vc-timemachine, the behavior of `vc-find-revision'
+;; was implied indirectly in the emacs manual as always caching a copy
+;; of the returned revision.  `vc-revision-other-window's write-up was:
+;;
+;;   This retrieves the file version corresponding to revision, saves it
+;;   to filename.~revision~, and visits it in a separate window.
+;;
+;; But if revisions are immutable history, then there is no reason for
+;; a revision buffer to visit a mutable file.  Saving a file could be
+;; justified as a form of caching.  But, if a cache is to be trusted,
+;; it must not be possible for a user to corrupt its contents.
+;;
+;; As of release 30.1 revision buffer are returned with buffer-file-name
+;; set to nil, signifying that revision buffers do not visit files.
+;;
+;; Whether to cache or not is controlled by `vc-find-revision-cache'.
+;;
+;; Caching revisions as siblings of a working file is often seen as
+;; "cluttering" the workspace.  `vc-cache-root' provides a alternative,
+;; a mirror directory structure where revisions are cached.
+
+(defun vc-find-revision (file revision &optional backend buffer)
+  "Read REVISION of FILE into a read-only buffer and return that buffer.
+Contruct the path to a potential cached copy from `vc-find-revision-cache',
+FILE and REVISION.  If that file exists and is writable then rewrite it
+to ensure that if accurately reflects the retrieved revision.  Otherwise,
+if `vc-find-revision-cache' is non-nil, save buffer to its cache location.
+When BUFFER is absent or dead, create a new buffer; otherwise repurpose
+the supplied BUFFER by erasing its contents, setting its name and updating
+its mode.  In all cases buffer-file-name is set to nil, ensuring that the
+returned buffer does not appear to be visiting any file (in particular the
+file in the cache)."
   (let* ((buffer (when (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))))
-    (unless (and (not buffer)
-                 (or (get-file-buffer filename)
-                     (file-exists-p filename)))
-      (with-current-buffer filebuf
-	(let ((failed t))
-	  (unwind-protect
-	      (with-current-buffer (or buffer (create-file-buffer filename))
-                (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))))
-                (decode-coding-inserted-region (point-min) (point-max) file)
-                (after-insert-file-set-coding (- (point-max) (point-min)))
-                (goto-char (point-min))
-                (if buffer
-                    ;; For non-interactive, skip any questions
-                    (let ((enable-local-variables :safe) ;; to find `mode:'
-                          (buffer-file-name file))
-                      ;; Don't run hooks that might assume buffer-file-name
-                      ;; really associates buffer with a file (bug#39190).
-                      (ignore-errors (delay-mode-hooks (set-auto-mode))))
-                  (normal-mode))
-	        (set-buffer-modified-p nil)
-                (setq buffer-read-only t))
-		(setq failed nil)
-	    (when (and failed (unless buffer (get-file-buffer filename)))
-	      (with-current-buffer (get-file-buffer filename)
-		(set-buffer-modified-p nil))
-	      (kill-buffer (get-file-buffer filename)))))))
-    (let ((result-buf (or buffer
-                          (get-file-buffer filename)
-                          (find-file-noselect filename))))
-      (with-current-buffer result-buf
-        (setq-local vc-parent-buffer filebuf))
-      result-buf)))
+         (parent (or buffer (get-file-buffer file) (current-buffer)))
+         (revd-file (vc-version-backup-file-name file revision 'manual))
+         (true-dir (file-name-directory file))
+         (true-name (file-name-nondirectory file))
+         (save-dir (concat vc-cache-root true-dir))
+         (revd-name (file-name-nondirectory revd-file))
+         (save-file (concat vc-cache-root revd-file))
+         ;; Some hooks assume that buffer-file-name associates a buffer with
+         ;; a true file.  This mapping is widely assumed to be one-to-one.
+         ;; To avoid running afoul of that assumption this fictitious path
+         ;; is expected to be unique (bug#39190).  This path also has the
+         ;; virtue that it exhibits the same file type (extension) as FILE.
+         ;; This improves setting the buffers modes.
+         (pretend (concat true-dir "PRETNED/" true-name))
+         (revbuf (or buffer (get-file-buffer save-file) (get-buffer-create revd-name)))
+         (coding-system-for-read 'no-conversion)
+         (failed t))
+
+    (with-current-buffer revbuf
+      (unwind-protect
+          (progn
+            ;; Prep revbuf in case it is being reused.
+            (setq buffer-file-name nil) ; Cancel any prior file visitation
+            (setq vc-parent-buffer nil)
+            (setq vc-tm--revision nil)
+            (setq buffer-read-only nil)
+            (buffer-disable-undo)
+            (erase-buffer)
+
+            ;; Fetch the requested revision.
+            (message "Fetching %s..." revd-file)
+            (cond
+             ;; A cached file is viable IFF it is not writable.
+             ((and (file-exists-p save-file) (not (file-writable-p save-file)))
+              (insert-file-contents save-file t))
+             (backend
+              (vc-call-backend backend 'find-revision file revision revbuf))
+             (t
+              (vc-call find-revision file revision revbuf)))
+            (setq buffer-file-name nil)
+            (message "Fetching %s...done" revd-file)
+
+            ;; Cache revision per the user's (TODO: or the backend's) desire.
+            (when (or (if (file-exists-p save-file)
+                          (file-writable-p save-file)
+                        vc-find-revision-cache))
+              (make-directory save-dir t)
+              (vc--safe-delete-file save-file)
+              ;; Backend's output was read with 'no-conversions; do the same for write
+              (setq buffer-file-coding-system 'no-conversion)
+              (write-region nil nil save-file)
+              (set-file-modes save-file (logand (file-modes save-file) #o7555)))
+
+            ;; Setup revbuf's modes based on it contents and pretend file name.
+            (let ((enable-local-variables :safe)
+                  (buffer-file-name pretend)) ;; to find `mode:'
+              (when (file-exists-p pretend)
+                (error "PRETEND file actually exists"))
+              (ignore-errors (set-auto-mode))
+              (vc--safe-delete-file pretend)
+              ;; vc-parent-buffer enables C-x v g, C-x v l, ... etc.
+              (setq vc-parent-buffer parent)
+              (setq vc-tm--revision revision))
+
+            ;; Indicate succesful negotiation of the obstacle course.
+            (setq failed nil))
+
+        (when failed
+          (vc--safe-delete-file save-file)
+          (vc--safe-delete-file pretend)
+          (erase-buffer)))
+
+      ;; Setup final revbuf configuration.
+      (setq buffer-file-name nil)
+      (set-buffer-modified-p nil)
+      (setq buffer-read-only t)
+      (goto-char (point-min))
+      revbuf)))
+
+(defun vc--safe-delete-file (file)
+  "If FILE exists delete it, even if its permissions say it is readonly."
+  (when (file-exists-p file)
+    (set-file-modes file (logior (file-modes file) #o222))
+    (delete-file file)))
 
 ;; Header-insertion code
 
-- 
2.37.2


^ permalink raw reply related	[flat|nested] 6+ messages in thread
end of thread, other threads:[~2024-01-11  3:44 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-01-26  3:24 bug#61071: New features: VC timemachine and BackupOnSave to RCS John Yates
2023-02-11 23:02 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-04 19:47   ` stefankangas
2023-09-11 13:04   ` John Yates
2024-01-10 22:42     ` Stefan Kangas
2024-01-11  3:44       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors

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).