Re: [patch] add interactive browse of revisions from vc *Annotate* buffers

[Benjamin Rutt]

Richard Stallman <address@hidden> writes:

> I see View mode already defines some upper case letters.
> So it seems ok for a modified version of View mode, which this is,
> to define some more upper case letters.

Now that it seems like everyone has reached agreement on the key
bindings, here is the latest patch.  Here are the new key bindings,
and the new commands (FYI, I've implemented two new commands, "show
revision comment log" and "show diff"):

(define-key vc-annotate-mode-map "A" 'vc-annotate-revision-previous-to-line)
(define-key vc-annotate-mode-map "D" 'vc-annotate-show-diff-revision-at-line)
(define-key vc-annotate-mode-map "J" 'vc-annotate-revision-at-line)
(define-key vc-annotate-mode-map "L" 'vc-annotate-show-log-revision-at-line)
(define-key vc-annotate-mode-map "N" 'vc-annotate-next-version)
(define-key vc-annotate-mode-map "P" 'vc-annotate-prev-version)

One problem, I'm getting "Cyclic keymap inheritance" errors when I
access the menu items with a mouse, maybe someone else can explain
what is going on there, I don't know how to debug that any further.
Other than that, I think the code is stable, and vc-annotate-mode now
inherits from view-mode, as some of you requested.  Comments
appreciated.

Thanks,
Benjamin Rutt

--- vc.el.orig  2004-01-10 21:51:37.000000000 -0500
+++ vc.el       2004-01-17 16:27:26.000000000 -0500
@@ -347,6 +347,25 @@
 ;;   time with hours, minutes, and seconds included.  Probably safe to
 ;;   ignore.  Return the current-time, in units of fractional days.
 ;;
+;; - annotate-extract-revision-at-line ()
+;;
+;;   Only required if `annotate-command' is defined for the backend.
+;;   Invoked from a buffer in vc-annotate-mode, return the revision
+;;   corresponding to the current line, or nil if there is no revision
+;;   corresponding to the current line.
+;;
+;; - decrement-revision (file rev)
+;;
+;;   Only required if `annotate-command' is defined for the backend.
+;;   Return the revision previous to `rev', which is a string, for
+;;   file `file'.  If there is no previous revision, return nil.
+;;
+;; - increment-revision (file rev)
+;;
+;;   Only required if `annotate-command' is defined for the backend.
+;;   Return the revision after `rev', which is a string, for
+;;   file `file'.  If there is no later revision, return nil.
+;;
 ;; SNAPSHOT SYSTEM
 ;;
 ;; - create-snapshot (dir name branchp)
@@ -631,6 +650,13 @@
     m)
   "Local keymap used for VC-Annotate mode.")
 
+(define-key vc-annotate-mode-map "A" 'vc-annotate-revision-previous-to-line)
+(define-key vc-annotate-mode-map "D" 'vc-annotate-show-diff-revision-at-line)
+(define-key vc-annotate-mode-map "J" 'vc-annotate-revision-at-line)
+(define-key vc-annotate-mode-map "L" 'vc-annotate-show-log-revision-at-line)
+(define-key vc-annotate-mode-map "N" 'vc-annotate-next-version)
+(define-key vc-annotate-mode-map "P" 'vc-annotate-prev-version)
+
 (defvar vc-annotate-mode-menu nil
   "Local keymap used for VC-Annotate mode's menu bar menu.")
 
@@ -2285,11 +2311,12 @@
 ;; Miscellaneous other entry points
 
 ;;;###autoload
-(defun vc-print-log ()
+(defun vc-print-log (&optional focus-rev)
   "List the change log of the current buffer in a window."
   (interactive)
   (vc-ensure-vc-buffer)
   (let ((file buffer-file-name))
+    (or focus-rev (setq focus-rev (vc-workfile-version file)))
     (vc-call print-log file)
     (set-buffer "*vc*")
     (pop-to-buffer (current-buffer))
@@ -2307,7 +2334,7 @@
        ;; move point to the log entry for the current version
        (vc-call-backend ',(vc-backend file)
                         'show-log-entry
-                        ',(vc-workfile-version file))
+                        ',focus-rev)
         (set-buffer-modified-p nil)))))
 
 (defun vc-default-show-log-entry (backend rev)
@@ -2778,6 +2805,14 @@
 (defvar vc-annotate-ratio nil "Global variable.")
 (defvar vc-annotate-backend nil "Global variable.")
 
+;; internal buffer-local variables
+(defvar vc-annotate-parent-file nil)
+(defvar vc-annotate-parent-rev nil)
+(defvar vc-annotate-parent-display-mode nil)
+(make-local-variable 'vc-annotate-parent-file)
+(make-local-variable 'vc-annotate-parent-rev)
+(make-local-variable 'vc-annotate-parent-display-mode)
+
 (defconst vc-annotate-font-lock-keywords
   ;; The fontification is done by vc-annotate-lines instead of font-lock.
   '((vc-annotate-lines)))
@@ -2788,7 +2823,7 @@
 `vc-annotate-buffers'."
   (cdr (assoc buffer vc-annotate-buffers)))
 
-(define-derived-mode vc-annotate-mode fundamental-mode "Annotate"
+(define-derived-mode vc-annotate-mode view-mode "Annotate"
   "Major mode for output buffers of the `vc-annotate' command.
 
 You can use the mode-specific menu to alter the time-span of the used
@@ -2885,7 +2920,21 @@
                    (unless (eq vc-annotate-display-mode 'fullscale)
                      (vc-annotate-display-select nil 'fullscale))
                    :style toggle :selected
-                   (eq vc-annotate-display-mode 'fullscale)])))
+                   (eq vc-annotate-display-mode 'fullscale)])
+                 (list "--")
+                 (list ["Annotate previous revision"
+                        (vc-annotate-prev-version)])
+                 (list ["Annotate next revision"
+                        (vc-annotate-next-version)])
+                 (list ["Annotate revision at line"
+                        (vc-annotate-revision-at-line)])
+                 (list ["Annotate revision previous to line"
+                        (vc-annotate-revision-previous-to-line)])
+                 (list ["Show log of version at line"
+                        (vc-annotate-show-log-revision-at-line)])
+                 (list ["Show diff of version at line"
+                        (vc-annotate-show-diff-revision-at-line)])))
+
     ;; Define the menu
     (if (or (featurep 'easymenu) (load "easymenu" t))
        (easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
@@ -2922,7 +2971,7 @@
 ;;;;  the contents in BUFFER.
 
 ;;;###autoload
-(defun vc-annotate (prefix)
+(defun vc-annotate (prefix &optional revision display-mode)
   "Display the edit history of the current file using colours.
 
 This command creates a buffer that shows, for each line of the current
@@ -2949,19 +2998,24 @@
 colors. `vc-annotate-background' specifies the background color."
   (interactive "P")
   (vc-ensure-vc-buffer)
-  (let* ((temp-buffer-name (concat "*Annotate " (buffer-name) "*"))
+  (let* ((temp-buffer-name nil)
          (temp-buffer-show-function 'vc-annotate-display-select)
-         (rev (vc-workfile-version buffer-file-name))
+        (rev (or revision (vc-workfile-version buffer-file-name)))
+        (bfn buffer-file-name)
          (vc-annotate-version
-          (if prefix (read-string
-                      (format "Annotate from version: (default %s) " rev)
-                      nil nil rev)
-            rev)))
-    (if prefix
-        (setq vc-annotate-display-mode
-              (float (string-to-number
-                      (read-string "Annotate span days: (default 20) "
-                                   nil nil "20")))))
+         (if prefix (read-string
+                     (format "Annotate from version: (default %s) " rev)
+                     nil nil rev)
+           rev)))
+    (if display-mode
+       (setq vc-annotate-display-mode display-mode)
+      (if prefix
+         (setq vc-annotate-display-mode
+               (float (string-to-number
+                       (read-string "Annotate span days: (default 20) "
+                                    nil nil "20"))))))
+    (setq temp-buffer-name (format "*Annotate %s (rev %s)*"
+                                  (buffer-name) vc-annotate-version))
     (setq vc-annotate-backend (vc-backend buffer-file-name))
     (message "Annotating...")
     (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command))
@@ -2972,6 +3026,12 @@
                       buffer-file-name
                       (get-buffer temp-buffer-name)
                        vc-annotate-version))
+    (save-excursion
+      (set-buffer temp-buffer-name)
+      (setq vc-annotate-parent-file bfn)
+      (setq vc-annotate-parent-rev vc-annotate-version)
+      (setq vc-annotate-parent-display-mode vc-annotate-display-mode))
+          
     ;; Don't use the temp-buffer-name until the buffer is created
     ;; (only after `with-output-to-temp-buffer'.)
     (setq vc-annotate-buffers
@@ -2979,6 +3039,155 @@
                  (list (cons (get-buffer temp-buffer-name) 
vc-annotate-backend))))
   (message "Annotating... done")))
 
+(defun vc-annotate-prev-version (prefix)
+  "Visit the annotation of the version previous to this one.
+With a numeric prefix argument, annotate the version that many
+versions previous."
+  (interactive "p")
+  (vc-annotate-warp-version (- 0 prefix)))
+
+(defun vc-annotate-next-version (prefix)
+  "Visit the annotation of the version after this one.
+With a numeric prefix argument, annotate the version that many
+versions after."
+  (interactive "p")
+  (vc-annotate-warp-version prefix))
+
+(defun vc-annotate-decrement-revision (file rev)
+  (setq vc-annotate-backend (vc-backend file))
+  (vc-call-backend vc-annotate-backend 'decrement-revision file rev))
+
+(defun vc-annotate-increment-revision (file rev)
+  (setq vc-annotate-backend (vc-backend file))
+  (vc-call-backend vc-annotate-backend 'increment-revision file rev))
+
+;; must be invoked from a buffer in vc-annotate-mode
+(defun vc-annotate-extract-revision-at-line ()
+  ;; visit parent buffer
+  (save-window-excursion
+    (vc-ensure-vc-buffer)
+    (setq vc-annotate-backend (vc-backend buffer-file-name)))
+  (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
+
+(defun vc-annotate-revision-at-line ()
+  "From a buffer in vc-annotate-mode, replace the current
+annotation with an annotation of the revision identified by the
+version number displayed in this line."
+  (interactive)
+  (if (not (equal major-mode 'vc-annotate-mode))
+      (message "Cannot be invoked outside of a vc annotate buffer!")
+    (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
+      (if (not rev-at-line)
+         (message "Cannot extract revision number from the current line")
+       (if (equal rev-at-line vc-annotate-parent-rev)
+           (message "Already at version %s" rev-at-line)
+         (vc-annotate-warp-version rev-at-line))))))
+
+(defun vc-annotate-revision-previous-to-line ()
+  "From a buffer in vc-annotate-mode, replace the current
+annotation with an annotation of the revision previous to the one
+identified by the version number displayed in this line."
+  (interactive)
+  (if (not (equal major-mode 'vc-annotate-mode))
+      (message "Cannot be invoked outside of a vc annotate buffer!")
+    (let ((rev-at-line (vc-annotate-extract-revision-at-line))
+         (prev-rev nil))
+      (if (not rev-at-line)
+         (message "Cannot extract revision number from the current line")
+       (setq prev-rev
+             (vc-annotate-decrement-revision
+              vc-annotate-parent-file
+              rev-at-line))
+       (vc-annotate-warp-version prev-rev)))))
+
+(defun vc-annotate-show-log-revision-at-line ()
+  "From a buffer in vc-annotate-mode, show the VC log of the
+revision identified by the version number displayed in this line."
+  (interactive)
+  (if (not (equal major-mode 'vc-annotate-mode))
+      (message "Cannot be invoked outside of a vc annotate buffer!")
+    (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
+      (if (not rev-at-line)
+         (message "Cannot extract revision number from the current line")
+       (vc-print-log rev-at-line)))))
+
+(defun vc-annotate-show-diff-revision-at-line ()
+  "From a buffer in vc-annotate-mode, show the diff of the
+revision identified by the version number displayed in this line
+from the revision previous to it."
+  (interactive)
+  (if (not (equal major-mode 'vc-annotate-mode))
+      (message "Cannot be invoked outside of a vc annotate buffer!")
+    (let ((rev-at-line (vc-annotate-extract-revision-at-line))
+         (prev-rev nil))
+      (if (not rev-at-line)
+         (message "Cannot extract revision number from the current line")
+       (setq prev-rev
+             (vc-annotate-decrement-revision
+              vc-annotate-parent-file
+              rev-at-line))
+       (if (not prev-rev)
+           (message "Cannot diff from any version prior to %s" rev-at-line)
+         (save-window-excursion
+           (vc-version-diff vc-annotate-parent-file prev-rev rev-at-line))
+         (switch-to-buffer "*vc-diff*"))))))
+
+(defun vc-current-line ()
+  "Returns the current buffer's line number."
+  (let ((oldpoint (point)) start)
+    (save-excursion
+      (save-restriction
+       (goto-char (point-min))
+       (widen)
+       (forward-line 0)
+       (setq start (point))
+       (goto-char oldpoint)
+       (forward-line 0)
+       (1+ (count-lines (point-min) (point)))))))
+
+(defun vc-annotate-warp-version (revspec)
+  "If argument `revspec' is a positive integer, warp that many
+versions forward, if possible, otherwise echo a warning message.
+If `revspec' is a negative integer, warp that many versions
+backward, if possible, otherwise echo a warning message.  If
+`revspec' is a string, then it describes a revision number, so
+warp to that revision."
+  (if (not (equal major-mode 'vc-annotate-mode))
+      (message "Cannot be invoked outside of a vc annotate buffer!")
+    (let* ((oldline (vc-current-line))
+          (revspeccopy revspec)
+          (newrev nil))
+      (cond
+       ((and (integerp revspec) (> revspec 0))
+       (setq newrev vc-annotate-parent-rev)
+       (while (and (> revspec 0) newrev)
+              (setq newrev (vc-annotate-increment-revision
+                            vc-annotate-parent-file newrev))
+              (setq revspec (1- revspec)))
+       (if (not newrev)
+           (message "Cannot increment %d versions from version %s"
+                    revspeccopy vc-annotate-parent-rev)))
+       ((and (integerp revspec) (< revspec 0))
+       (setq newrev vc-annotate-parent-rev)
+       (while (and (< revspec 0) newrev)
+              (setq newrev (vc-annotate-decrement-revision
+                            vc-annotate-parent-file newrev))
+              (setq revspec (1+ revspec)))
+       (if (not newrev)
+           (message "Cannot decrement %d versions from version %s"
+                    (- 0 revspeccopy) vc-annotate-parent-rev)))
+       ((stringp revspec) (setq newrev revspec))
+       (t (error "invalid argument to vc-annotate-warp-version")))
+      (when newrev
+       (save-window-excursion
+         (find-file vc-annotate-parent-file)
+         (vc-annotate nil newrev vc-annotate-parent-display-mode))
+       (kill-buffer (current-buffer)) ;; kill the buffer we started from
+       (switch-to-buffer (car (car (last vc-annotate-buffers))))
+       (goto-line (min oldline (progn (goto-char (point-max))
+                                      (previous-line)
+                                      (vc-current-line))))))))
+
 (defun vc-annotate-car-last-cons (a-list)
   "Return car of last cons in association list A-LIST."
   (if (not (eq nil (cdr a-list)))
--- vc-cvs.el.orig      2004-01-11 21:31:30.000000000 -0500
+++ vc-cvs.el   2004-01-12 13:29:49.000000000 -0500
@@ -625,6 +625,32 @@
          (beginning-of-line nil)
            (vc-cvs-annotate-time))))))
 
+(defun vc-cvs-annotate-extract-revision-at-line ()
+  (save-excursion
+    (beginning-of-line)
+    (if (re-search-forward "^\\([0-9]+\\.[0-9]+\\(\\.[0-9]+\\)*\\) +("
+                          (line-end-position) t)
+       (match-string-no-properties 1)
+      nil)))
+
+(defun vc-cvs-decrement-revision (file rev)
+  (let ((ls (split-string rev "\\.")))
+    (setq ls (nreverse ls))
+    (if (string= (car ls) "1")
+       nil ;; return nil if the revision cannot be decremented any further
+      (setq ls (cons (int-to-string (1- (string-to-int (car ls)))) (cdr ls)))
+      (setq ls (nreverse ls))
+      (mapconcat 'identity ls "."))))
+
+(defun vc-cvs-increment-revision (file rev)
+  (if (string= rev (vc-workfile-version file))
+      nil ;; return nil if the revision cannot be incremented any further
+    (let ((ls (split-string rev "\\.")))    
+      (setq ls (nreverse ls))
+      (setq ls (cons (int-to-string (1+ (string-to-int (car ls)))) (cdr ls)))
+      (setq ls (nreverse ls))
+      (mapconcat 'identity ls "."))))
+
 ;;;
 ;;; Snapshot system
 ;;;