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