From 78cefb3cb78faf8be387d4319942078699ebc3e9 Mon Sep 17 00:00:00 2001 From: "John S. Yates, Jr" 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") ;; 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