Change scaling algorithm for vc-annotate.

From JD Smith <jdsmith@astro.cornell.edu>.
(vc-annotate-display-default): Accept colormap scaling
ratio (now deprecated).
(vc-annotate-display-autoscale): Added.
(vc-annotate-add-menu): New autoscaling menu options "Span to
Oldest" and "Span Oldest->Newest".  Easymenu support added for
toggle menus driven by customize variable
`vc-annotate-display-mode'.
(vc-annotate-display-select): Added.
(vc-annotate): Changed temp-buffer-show-function to
`vc-annotate-display-select'.
(vc-annotate-display): Removed arguments BUFFER and BACKEND.
Added argument OFFSET.  Instead of backend function, calls now
generic `vc-annotate-difference'.
(vc-annotate-difference): Added as generic function instead of
backend-specific function.  No longer takes argument POINT, but
instead accepts a time OFFSET.
(vc-default-annotate-current-time): Added.

1 files changed, 196 insertions, 94 deletions

diff --git a/lisp/vc.el b/lisp/vc.el
index 11193f131fd..729c9cc21a2 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -6,7 +6,7 @@
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
 ;; Keywords: tools
 
-;; $Id: vc.el,v 1.312 2001/10/21 12:15:22 spiegel Exp $
+;; $Id: vc.el,v 1.313 2001/10/21 23:31:45 spiegel Exp $
 
 ;; This file is part of GNU Emacs.
 
@@ -302,15 +302,26 @@
 ;;   of FILE in BUF, relative to version REV.  This is currently only
 ;;   implemented for CVS, using the `cvs annotate' command.
 ;;
-;; - annotate-difference (point)
+;; - annotate-time ()
 ;;
 ;;   Only required if `annotate-command' is defined for the backend.
-;;   Return the difference between the age of the line at point and the
-;;   current time.  Return NIL if there is no more comparison to be made
-;;   in the buffer.  Return value as defined for `current-time'.  You can
-;;   safely assume that point is placed at the beginning of each line,
-;;   starting at `point-min'.  The buffer that point is placed in is the
-;;   Annotate output, as defined by the relevant backend.
+;;   Return the time of the next line of annotation at or after point,
+;;   as a floating point fractional number of days.  The helper
+;;   function `vc-annotate-convert-time' may be useful for converting
+;;   multi-part times as returned by `current-time' and `encode-time'
+;;   to this format.  Return NIL if no more lines of annotation appear
+;;   in the buffer.  You can safely assume that point is placed at the
+;;   beginning of each line, starting at `point-min'.  The buffer that
+;;   point is placed in is the Annotate output, as defined by the
+;;   relevant backend.
+;;
+;; - annotate-current-time ()
+;;
+;;   Only required if `annotate-command' is defined for the backend,
+;;   AND you'd like the current time considered to be anything besides
+;;   (vs-annotate-convert-time (current-time)) -- i.e. the current
+;;   time with hours, minutes, and seconds included.  Probably safe to
+;;   ignore.  Return the current-time, in units of fractional days.
 ;;
 ;; SNAPSHOT SYSTEM
 ;;
@@ -493,6 +504,15 @@ See `run-hooks'."
   :group 'vc
   :version "21.1")
 
+(defcustom vc-annotate-display-mode nil
+  "Which mode to color the annotations with by default."
+  :type '(choice (const :tag "Default" nil)
+                 (const :tag "Scale to Oldest" scale)
+                 (const :tag "Scale Oldest->Newest" fullscale)
+                 (number :tag "Specify Fractional Number of Days"
+                         :value "20.5"))
+  :group 'vc)
+
 ;;;###autoload
 (defcustom vc-checkin-hook nil
   "*Normal hook (list of functions) run after a checkin is done.
@@ -517,26 +537,26 @@ version control backend imposes itself."
 
 ;; Annotate customization
 (defcustom vc-annotate-color-map
-  '(( 26.3672 . "#FF0000")
-    ( 52.7344 . "#FF3800")
-    ( 79.1016 . "#FF7000")
-    (105.4688 . "#FFA800")
-    (131.8359 . "#FFE000")
-    (158.2031 . "#E7FF00")
-    (184.5703 . "#AFFF00")
-    (210.9375 . "#77FF00")
-    (237.3047 . "#3FFF00")
-    (263.6719 . "#07FF00")
-    (290.0391 . "#00FF31")
-    (316.4063 . "#00FF69")
-    (342.7734 . "#00FFA1")
-    (369.1406 . "#00FFD9")
-    (395.5078 . "#00EEFF")
-    (421.8750 . "#00B6FF")
-    (448.2422 . "#007EFF"))
-  "*Association list of age versus color, for \\[vc-annotate].
-Ages are given in units of 2**-16 seconds.
-Default is eighteen steps using a twenty day increment."
+  '(( 20. . "#FF0000")
+    ( 40. . "#FF3800")
+    ( 60. . "#FF7000")
+    ( 80. . "#FFA800")
+    (100. . "#FFE000")
+    (120. . "#E7FF00")
+    (140. . "#AFFF00")
+    (160. . "#77FF00")
+    (180. . "#3FFF00")
+    (200. . "#07FF00")
+    (220. . "#00FF31")
+    (240. . "#00FF69")
+    (260. . "#00FFA1")
+    (280. . "#00FFD9")
+    (300. . "#00EEFF")
+    (320. . "#00B6FF")
+    (340. . "#007EFF"))
+  "*ASSOCIATION list of age versus color, for \\[vc-annotate].  
+Ages are given in units of fractional days.  Default is eighteen steps
+using a twenty day increment."
   :type 'alist
   :group 'vc)
 
@@ -2828,7 +2848,9 @@ Uses `rcs2log' which only works for RCS and CVS."
 
 ;; Declare globally instead of additional parameter to
 ;; temp-buffer-show-function (not possible to pass more than one
-;; parameter).
+;; parameter).  The use of annotate-ratio is deprecated in favor of
+;; annotate-mode, which replaces it with the more sensible "span-to
+;; days", along with autoscaling support.
 (defvar vc-annotate-ratio nil "Global variable.")
 (defvar vc-annotate-backend nil "Global variable.")
 
@@ -2846,43 +2868,120 @@ colors.  See variable `vc-annotate-menu-elements' for customizing the
 menu items."
   (vc-annotate-add-menu))
 
-(defun vc-annotate-display-default (&optional event)
-  "Use the default color spectrum for VC Annotate mode."
+(defun vc-annotate-display-default (&optional ratio)
+  "Use the default color spectrum for VC Annotate mode, scaling the
+colormap by RATIO, if present.  Use the current time as offset."
   (interactive "e")
   (message "Redisplaying annotation...")
-  (vc-annotate-display (current-buffer)
-                       nil
-                       (vc-annotate-get-backend (current-buffer)))
+  (vc-annotate-display 
+   (if ratio (vc-annotate-time-span vc-annotate-color-map ratio)))
   (message "Redisplaying annotation...done"))
 
+(defun vc-annotate-display-autoscale (&optional full)
+  "Re-display annotation using colormap scaled from the current time
+to the oldest annotation in the buffer, or, with argument FULL set, to
+cover the full time range, from oldest to newest."
+  (interactive)
+  (let ((newest 0.0)
+        (oldest 999999.)                ;Any CVS users at the founding of Rome?
+        (current (vc-annotate-convert-time (current-time)))
+        date)
+    (message "Redisplaying annotation...")
+    ;; Run through this file and find the oldest and newest dates annotated.
+    (save-excursion
+      (goto-char (point-min))
+      (while (setq date (vc-call-backend vc-annotate-backend 'annotate-time))
+        (if (> date newest)
+            (setq newest date))
+        (if (< date oldest)
+            (setq oldest date))))
+    (vc-annotate-display
+     (vc-annotate-time-span             ;return the scaled colormap.
+      vc-annotate-color-map
+      (/ (-  (if full newest current) oldest) 
+         (vc-annotate-car-last-cons vc-annotate-color-map)))
+     (if full newest))
+    (message "Redisplaying annotation...done \(%s\)" 
+             (if full 
+                 (format "Spanned from %.1f to %.1f days old" 
+                         (- current oldest)
+                         (- current newest))
+               (format "Spanned to %.1f days old" (- current oldest))))))
+
+;; Menu -- Using easymenu.el
 (defun vc-annotate-add-menu ()
   "Add the menu 'Annotate' to the menu bar in VC-Annotate mode."
-  (setq vc-annotate-mode-menu (make-sparse-keymap "Annotate"))
-  (define-key vc-annotate-mode-map [menu-bar vc-annotate-mode]
-    (cons "VC-Annotate" vc-annotate-mode-menu))
-  (define-key vc-annotate-mode-menu [default]
-    '("Default" . vc-annotate-display-default))
-  (let ((menu-elements vc-annotate-menu-elements))
+  (let ((menu-elements vc-annotate-menu-elements)
+        (menu-def
+         '("VC-Annotate"
+           ["Default" (unless (null vc-annotate-display-mode)
+                        (setq vc-annotate-display-mode nil)
+                        (vc-annotate-display-select))
+            :style toggle :selected (null vc-annotate-display-mode)]))
+        (oldest-in-map (vc-annotate-car-last-cons vc-annotate-color-map)))
     (while menu-elements
       (let* ((element (car menu-elements))
-             (days (round (* element
-                             (vc-annotate-car-last-cons vc-annotate-color-map)
-                             0.7585))))
+             (days (* element oldest-in-map)))
         (setq menu-elements (cdr menu-elements))
-        (define-key vc-annotate-mode-menu
-          (vector days)
-          (cons (format "Span %d days"
-                        days)
-                `(lambda ()
-                   ,(format "Use colors spanning %d days" days)
+        (setq menu-def 
+              (append menu-def 
+                      `([,(format "Span %.1f days" days)
+                         (unless (and (numberp vc-annotate-display-mode)
+                                      (= vc-annotate-display-mode ,days))
+                           (vc-annotate-display-select nil ,days))
+                         :style toggle :selected 
+                         (and (numberp vc-annotate-display-mode)
+                              (= vc-annotate-display-mode ,days)) ])))))
+    (setq menu-def 
+          (append menu-def 
+                  (list
+                   ["Span ..."
+                    (let ((days 
+                           (float (string-to-number
+                                   (read-string "Span how many days? ")))))
+                      (vc-annotate-display-select nil days)) t])
+                  (list "--")
+                  (list 
+                   ["Span to Oldest" 
+                    (unless (eq vc-annotate-display-mode 'scale)
+                      (vc-annotate-display-select nil 'scale))
+                    :style toggle :selected 
+                    (eq vc-annotate-display-mode 'scale)])
+                  (list 
+                   ["Span Oldest->Newest" 
+                    (unless (eq vc-annotate-display-mode 'fullscale)
+                      (vc-annotate-display-select nil 'fullscale))
+                    :style toggle :selected 
+                    (eq vc-annotate-display-mode 'fullscale)])))
+    ;; Define the menu
+    (if (or (featurep 'easymenu) (load "easymenu" t))
+        (easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map 
+                          "VC Annotate Display Menu" menu-def))))
+
+(defun vc-annotate-display-select (&optional buffer mode)
+  "Do the default or chosen annotation display as specified in the
+customizable variable `vc-annotate-display-mode'."
                    (interactive)
-                   (message "Redisplaying annotation...")
-                   (vc-annotate-display
-                    (get-buffer (buffer-name))
-                    (vc-annotate-time-span vc-annotate-color-map ,element)
-                    (vc-annotate-get-backend (current-buffer)))
-                   (message "Redisplaying annotation...done"))))))))
-
+  (if mode (setq vc-annotate-display-mode mode))
+  (when buffer
+    (set-buffer buffer)
+    (display-buffer buffer))
+  (if (not vc-annotate-mode)            ; Turn on vc-annotate-mode if not done
+      (vc-annotate-mode))
+  (cond ((null vc-annotate-display-mode) (vc-annotate-display-default 
+                                          vc-annotate-ratio))
+        ((symbolp vc-annotate-display-mode) ; One of the auto-scaling modes
+         (cond ((eq vc-annotate-display-mode 'scale)
+                (vc-annotate-display-autoscale))
+               ((eq vc-annotate-display-mode 'fullscale) 
+                (vc-annotate-display-autoscale t))
+               (t (error "No such display mode: %s" 
+                         vc-annotate-display-mode))))
+        ((numberp vc-annotate-display-mode) ; A fixed number of days lookback
+         (vc-annotate-display-default
+          (/ vc-annotate-display-mode (vc-annotate-car-last-cons 
+                                       vc-annotate-color-map))))
+        (t (error "Error in display mode select"))))
 
 ;;;; (defun vc-BACKEND-annotate-command (file buffer) ...)
 ;;;;  Execute "annotate" on FILE by using `call-process' and insert
@@ -2918,19 +3017,19 @@ colors. `vc-annotate-background' specifies the background color."
   (interactive "P")
   (vc-ensure-vc-buffer)
   (let* ((temp-buffer-name (concat "*Annotate " (buffer-name) "*"))
-         (temp-buffer-show-function 'vc-annotate-display)
+         (temp-buffer-show-function 'vc-annotate-display-select)
          (rev (vc-workfile-version (buffer-file-name)))
          (vc-annotate-version 
           (if prefix (read-string 
                       (format "Annotate from version: (default %s) " rev) 
                       nil nil rev)
-            rev))
-         (vc-annotate-ratio 
-          (if prefix (string-to-number
-                      (read-string "Annotate ratio: (default 1.0) " 
-                                   nil nil "1.0"))
-            1.0))
-         (vc-annotate-backend (vc-backend (buffer-file-name))))
+            rev)))
+    (if prefix 
+        (setq vc-annotate-display-mode
+              (float (string-to-number
+                      (read-string "Annotate span days: (default 20) " 
+                                   nil nil "20")))))
+    (setq vc-annotate-backend (vc-backend (buffer-file-name)))
     (message "Annotating...")
     (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command))
         (error "Sorry, annotating is not implemented for %s"
@@ -2947,7 +3046,6 @@ colors. `vc-annotate-background' specifies the background color."
                   (list (cons (get-buffer temp-buffer-name) vc-annotate-backend))))
   (message "Annotating... done")))
 
-
 (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)))
@@ -2977,26 +3075,34 @@ nil otherwise"
      (setq i (+ i 1)))
    tmp-cons))                           ; Return the appropriate value
 
-
-(defun vc-annotate-display (buffer &optional color-map backend)
-  "Do the VC-Annotate display in BUFFER using COLOR-MAP.
-The original annotating file is supposed to be handled by BACKEND.
-If BACKEND is NIL, variable VC-ANNOTATE-BACKEND is used instead.
-This function is destructive on VC-ANNOTATE-BACKEND when BACKEND is non-nil."
-
-  ;; Handle the case of the global variable vc-annotate-ratio being
-  ;; set. This variable is used to pass information from function
-  ;; vc-annotate since it is not possible to use another parameter
-  ;; (see temp-buffer-show-function).
-  (if (and (not color-map) vc-annotate-ratio)
-      ;; This will only be true if called from vc-annotate with ratio
-      ;; being non-nil.
-      (setq color-map (vc-annotate-time-span vc-annotate-color-map
-                                             vc-annotate-ratio)))
-  (set-buffer buffer)
-  (display-buffer buffer)
-  (if (not vc-annotate-mode)            ; Turn on vc-annotate-mode if not done
-      (vc-annotate-mode))
+(defun vc-annotate-convert-time (time)
+  "Convert high/low times, as returned by `current-time' and
+`encode-time', to a single floating point value in units of days.
+TIME is list, only the first two elements of TIME are considered,
+comprising the high 16 and low 16 bits of the number of seconds since
+Jan 1, 1970."
+  (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))
+
+(defun vc-annotate-difference (&optional offset)
+   "Calculate the difference, in days, from the current time and the
+time returned from the backend function annotate-time.  If OFFSET is
+set, use it as the time base instead of the current time."
+   (let ((next-time (vc-call-backend vc-annotate-backend 'annotate-time)))
+     (if next-time
+         (- (or offset 
+                (vc-call-backend vc-annotate-backend 'annotate-current-time))
+            next-time))))
+
+(defun vc-default-annotate-current-time (backend)
+  "Return the current time, encoded as fractional days."
+  (vc-annotate-convert-time (current-time)))
+  
+(defun vc-annotate-display (&optional color-map offset)
+  "Do the VC-Annotate display in BUFFER using COLOR-MAP, and time
+offset OFFSET (defaults to the present time).  You probably want
+`vc-annotate-select' instead, after setting
+`vc-annotate-display-mode'"
+  (save-excursion
   (goto-char (point-min))               ; Position at the top of the buffer.
   ;; Delete old overlays
   (mapcar
@@ -3005,11 +3111,8 @@ This function is destructive on VC-ANNOTATE-BACKEND when BACKEND is non-nil."
          (delete-overlay overlay)))
    (overlays-in (point-min) (point-max)))
   (goto-char (point-min))               ; Position at the top of the buffer.
-
-  (if backend (setq vc-annotate-backend backend)) ; Destructive on `vc-annotate-backend'
-
-  (let ((difference (vc-call-backend vc-annotate-backend 'annotate-difference (point))))
-    (while difference
+    (let (difference)
+      (while (setq difference (vc-annotate-difference offset))
       (let*
           ((color (or (vc-annotate-compcar
                        difference (or color-map vc-annotate-color-map))
@@ -3021,16 +3124,15 @@ This function is destructive on VC-ANNOTATE-BACKEND when BACKEND is non-nil."
                      (let ((tmp-face (make-face (intern face-name))))
                        (set-face-foreground tmp-face (cdr color))
                        (if vc-annotate-background
-                           (set-face-background tmp-face vc-annotate-background))
+                             (set-face-background tmp-face 
+                                                  vc-annotate-background))
                        tmp-face)))      ; Return the face
            (point (point))
            overlay)
         (forward-line 1)
         (setq overlay (make-overlay point (point)))
         (overlay-put overlay 'face face)
-        (overlay-put overlay 'vc-annotation t))
-      (setq difference (vc-call-backend vc-annotate-backend 'annotate-difference (point))))))
-
+          (overlay-put overlay 'vc-annotation t))))))
 
 ;; Collect back-end-dependent stuff here