lisp/vc-annotate.el

   1 ;;; vc-annotate.el --- VC Annotate Support
   2
   3 ;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
   4 ;;   2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author:     Martin Lorentzson  <emwson@emw.ericsson.se>
   7 ;; Maintainer: FSF
   8 ;; Keywords: tools
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26 ;;
  27
  28 (require 'vc-hooks)
  29 (require 'vc)
  30
  31 ;;; Code:
  32 (eval-when-compile
  33   (require 'cl))
  34
  35 (defcustom vc-annotate-display-mode 'fullscale
  36   "Which mode to color the output of \\[vc-annotate] with by default."
  37   :type '(choice (const :tag "By Color Map Range" nil)
  38                  (const :tag "Scale to Oldest" scale)
  39                  (const :tag "Scale Oldest->Newest" fullscale)
  40                  (number :tag "Specify Fractional Number of Days"
  41                          :value "20.5"))
  42   :group 'vc)
  43
  44 (defcustom vc-annotate-color-map
  45   (if (and (tty-display-color-p) (<= (display-color-cells) 8))
  46       ;; A custom sorted TTY colormap
  47       (let* ((colors
  48               (sort
  49                (delq nil
  50                      (mapcar (lambda (x)
  51                                (if (not (or
  52                                          (string-equal (car x) "white")
  53                                          (string-equal (car x) "black") ))
  54                                    (car x)))
  55                              (tty-color-alist)))
  56                (lambda (a b)
  57                  (cond
  58                   ((or (string-equal a "red") (string-equal b "blue")) t)
  59                   ((or (string-equal b "red") (string-equal a "blue")) nil)
  60                   ((string-equal a "yellow") t)
  61                   ((string-equal b "yellow") nil)
  62                   ((string-equal a "cyan") t)
  63                   ((string-equal b "cyan") nil)
  64                   ((string-equal a "green") t)
  65                   ((string-equal b "green") nil)
  66                   ((string-equal a "magenta") t)
  67                   ((string-equal b "magenta") nil)
  68                   (t (string< a b))))))
  69              (date 20.)
  70              (delta (/ (- 360. date) (1- (length colors)))))
  71         (mapcar (lambda (x)
  72                   (prog1
  73                       (cons date x)
  74                     (setq date (+ date delta)))) colors))
  75     ;; Normal colormap: hue stepped from 0-240deg, value=1., saturation=0.75
  76     '(( 20. . "#FF3F3F")
  77       ( 40. . "#FF6C3F")
  78       ( 60. . "#FF993F")
  79       ( 80. . "#FFC63F")
  80       (100. . "#FFF33F")
  81       (120. . "#DDFF3F")
  82       (140. . "#B0FF3F")
  83       (160. . "#83FF3F")
  84       (180. . "#56FF3F")
  85       (200. . "#3FFF56")
  86       (220. . "#3FFF83")
  87       (240. . "#3FFFB0")
  88       (260. . "#3FFFDD")
  89       (280. . "#3FF3FF")
  90       (300. . "#3FC6FF")
  91       (320. . "#3F99FF")
  92       (340. . "#3F6CFF")
  93       (360. . "#3F3FFF")))
  94   "Association list of age versus color, for \\[vc-annotate].
  95 Ages are given in units of fractional days.  Default is eighteen
  96 steps using a twenty day increment, from red to blue.  For TTY
  97 displays with 8 or fewer colors, the default is red to blue with
  98 all other colors between (excluding black and white)."
  99   :type 'alist
 100   :group 'vc)
 101
 102 (defcustom vc-annotate-very-old-color "#3F3FFF"
 103   "Color for lines older than the current color range in \\[vc-annotate]]."
 104   :type 'string
 105   :group 'vc)
 106
 107 (defcustom vc-annotate-background "black"
 108   "Background color for \\[vc-annotate].
 109 Default color is used if nil."
 110   :type '(choice (const :tag "Default background" nil) (color))
 111   :group 'vc)
 112
 113 (defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01)
 114   "Menu elements for the mode-specific menu of VC-Annotate mode.
 115 List of factors, used to expand/compress the time scale.  See `vc-annotate'."
 116   :type '(repeat number)
 117   :group 'vc)
 118
 119 (defvar vc-annotate-mode-map
 120   (let ((m (make-sparse-keymap)))
 121     (define-key m "A" 'vc-annotate-revision-previous-to-line)
 122     (define-key m "D" 'vc-annotate-show-diff-revision-at-line)
 123     (define-key m "f" 'vc-annotate-find-revision-at-line)
 124     (define-key m "J" 'vc-annotate-revision-at-line)
 125     (define-key m "L" 'vc-annotate-show-log-revision-at-line)
 126     (define-key m "N" 'vc-annotate-next-revision)
 127     (define-key m "P" 'vc-annotate-prev-revision)
 128     (define-key m "W" 'vc-annotate-working-revision)
 129     (define-key m "V" 'vc-annotate-toggle-annotation-visibility)
 130     m)
 131   "Local keymap used for VC-Annotate mode.")
 132
 133 ;;; Annotate functionality
 134
 135 ;; Declare globally instead of additional parameter to
 136 ;; temp-buffer-show-function (not possible to pass more than one
 137 ;; parameter).  The use of annotate-ratio is deprecated in favor of
 138 ;; annotate-mode, which replaces it with the more sensible "span-to
 139 ;; days", along with autoscaling support.
 140 (defvar vc-annotate-ratio nil "Global variable.")
 141
 142 ;; internal buffer-local variables
 143 (defvar vc-annotate-backend nil)
 144 (defvar vc-annotate-parent-file nil)
 145 (defvar vc-annotate-parent-rev nil)
 146 (defvar vc-annotate-parent-display-mode nil)
 147
 148 (defconst vc-annotate-font-lock-keywords
 149   ;; The fontification is done by vc-annotate-lines instead of font-lock.
 150   '((vc-annotate-lines)))
 151
 152 (define-derived-mode vc-annotate-mode special-mode "Annotate"
 153   "Major mode for output buffers of the `vc-annotate' command.
 154
 155 You can use the mode-specific menu to alter the time-span of the used
 156 colors.  See variable `vc-annotate-menu-elements' for customizing the
 157 menu items."
 158   ;; Frob buffer-invisibility-spec so that if it is originally a naked t,
 159   ;; it will become a list, to avoid initial annotations being invisible.
 160   (add-to-invisibility-spec 'foo)
 161   (remove-from-invisibility-spec 'foo)
 162   (set (make-local-variable 'truncate-lines) t)
 163   (set (make-local-variable 'font-lock-defaults)
 164        '(vc-annotate-font-lock-keywords t)))
 165
 166 (defun vc-annotate-toggle-annotation-visibility ()
 167   "Toggle whether or not the annotation is visible."
 168   (interactive)
 169   (funcall (if (memq 'vc-annotate-annotation buffer-invisibility-spec)
 170                'remove-from-invisibility-spec
 171              'add-to-invisibility-spec)
 172            'vc-annotate-annotation)
 173   (force-window-update (current-buffer)))
 174
 175 (defun vc-annotate-display-default (ratio)
 176   "Display the output of \\[vc-annotate] using the default color range.
 177 The color range is given by `vc-annotate-color-map', scaled by RATIO.
 178 The current time is used as the offset."
 179   (interactive (progn (kill-local-variable 'vc-annotate-color-map) '(1.0)))
 180   (message "Redisplaying annotation...")
 181   (vc-annotate-display ratio)
 182   (message "Redisplaying annotation...done"))
 183
 184 (defun vc-annotate-oldest-in-map (color-map)
 185   "Return the oldest time in the COLOR-MAP."
 186   ;; Since entries should be sorted, we can just use the last one.
 187   (caar (last color-map)))
 188
 189 (defun vc-annotate-get-time-set-line-props ()
 190   (let ((bol (point))
 191         (date (vc-call-backend vc-annotate-backend 'annotate-time))
 192         (inhibit-read-only t))
 193     (assert (>= (point) bol))
 194     (put-text-property bol (point) 'invisible 'vc-annotate-annotation)
 195     date))
 196
 197 (defun vc-annotate-display-autoscale (&optional full)
 198   "Highlight the output of \\[vc-annotate] using an autoscaled color map.
 199 Autoscaling means that the map is scaled from the current time to the
 200 oldest annotation in the buffer, or, with prefix argument FULL, to
 201 cover the range from the oldest annotation to the newest."
 202   (interactive "P")
 203   (let ((newest 0.0)
 204         (oldest 999999.)                ;Any CVS users at the founding of Rome?
 205         (current (vc-annotate-convert-time (current-time)))
 206         date)
 207     (message "Redisplaying annotation...")
 208     ;; Run through this file and find the oldest and newest dates annotated.
 209     (save-excursion
 210       (goto-char (point-min))
 211       (while (not (eobp))
 212         (when (setq date (vc-annotate-get-time-set-line-props))
 213           (when (> date newest)
 214             (setq newest date))
 215           (when (< date oldest)
 216             (setq oldest date)))
 217         (forward-line 1)))
 218     (vc-annotate-display
 219      (/ (- (if full newest current) oldest)
 220         (vc-annotate-oldest-in-map vc-annotate-color-map))
 221      (if full newest))
 222     (message "Redisplaying annotation...done \(%s\)"
 223              (if full
 224                  (format "Spanned from %.1f to %.1f days old"
 225                          (- current oldest)
 226                          (- current newest))
 227                (format "Spanned to %.1f days old" (- current oldest))))))
 228
 229 ;; Menu -- Using easymenu.el
 230 (easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
 231   "VC Annotate Display Menu"
 232   `("VC-Annotate"
 233     ["By Color Map Range" (unless (null vc-annotate-display-mode)
 234                  (setq vc-annotate-display-mode nil)
 235                  (vc-annotate-display-select))
 236      :style toggle :selected (null vc-annotate-display-mode)]
 237     ,@(let ((oldest-in-map (vc-annotate-oldest-in-map vc-annotate-color-map)))
 238         (mapcar (lambda (element)
 239                   (let ((days (* element oldest-in-map)))
 240                     `[,(format "Span %.1f days" days)
 241                       (vc-annotate-display-select nil ,days)
 242                       :style toggle :selected
 243                       (eql vc-annotate-display-mode ,days) ]))
 244                 vc-annotate-menu-elements))
 245     ["Span ..."
 246      (vc-annotate-display-select
 247       nil (float (string-to-number (read-string "Span how many days? "))))]
 248     "--"
 249     ["Span to Oldest"
 250      (unless (eq vc-annotate-display-mode 'scale)
 251        (vc-annotate-display-select nil 'scale))
 252      :help
 253      "Use an autoscaled color map from the oldest annotation to the current time"
 254      :style toggle :selected
 255      (eq vc-annotate-display-mode 'scale)]
 256     ["Span Oldest->Newest"
 257      (unless (eq vc-annotate-display-mode 'fullscale)
 258        (vc-annotate-display-select nil 'fullscale))
 259      :help
 260      "Use an autoscaled color map from the oldest to the newest annotation"
 261      :style toggle :selected
 262      (eq vc-annotate-display-mode 'fullscale)]
 263     "--"
 264     ["Toggle annotation visibility" vc-annotate-toggle-annotation-visibility
 265      :help
 266      "Toggle whether the annotation is visible or not"]
 267     ["Annotate previous revision" vc-annotate-prev-revision
 268      :help "Visit the annotation of the revision previous to this one"]
 269     ["Annotate next revision" vc-annotate-next-revision
 270      :help "Visit the annotation of the revision after this one"]
 271     ["Annotate revision at line" vc-annotate-revision-at-line
 272      :help
 273      "Visit the annotation of the revision identified in the current line"]
 274     ["Annotate revision previous to line" vc-annotate-revision-previous-to-line
 275      :help "Visit the annotation of the revision before the revision at line"]
 276     ["Annotate latest revision" vc-annotate-working-revision
 277      :help "Visit the annotation of the working revision of this file"]
 278     ["Show log of revision at line" vc-annotate-show-log-revision-at-line
 279      :help "Visit the log of the revision at line"]
 280     ["Show diff of revision at line" vc-annotate-show-diff-revision-at-line
 281      :help "Visit the diff of the revision at line from its previous revision"]
 282     ["Show changeset diff of revision at line"
 283      vc-annotate-show-changeset-diff-revision-at-line
 284      :enable
 285      (eq 'repository (vc-call-backend ,vc-annotate-backend 'revision-granularity))
 286      :help "Visit the diff of the revision at line from its previous revision"]
 287     ["Visit revision at line" vc-annotate-find-revision-at-line
 288      :help "Visit the revision identified in the current line"]))
 289
 290 (defun vc-annotate-display-select (&optional buffer mode)
 291   "Highlight the output of \\[vc-annotate].
 292 By default, the current buffer is highlighted, unless overridden by
 293 BUFFER.  `vc-annotate-display-mode' specifies the highlighting mode to
 294 use; you may override this using the second optional arg MODE."
 295   (interactive)
 296   (when mode (setq vc-annotate-display-mode mode))
 297   (pop-to-buffer (or buffer (current-buffer)))
 298   (cond ((null vc-annotate-display-mode)
 299          ;; The ratio is global, thus relative to the global color-map.
 300          (kill-local-variable 'vc-annotate-color-map)
 301          (vc-annotate-display-default (or vc-annotate-ratio 1.0)))
 302         ;; One of the auto-scaling modes
 303         ((eq vc-annotate-display-mode 'scale)
 304          (vc-exec-after `(vc-annotate-display-autoscale)))
 305         ((eq vc-annotate-display-mode 'fullscale)
 306          (vc-exec-after `(vc-annotate-display-autoscale t)))
 307         ((numberp vc-annotate-display-mode) ; A fixed number of days lookback
 308          (vc-annotate-display-default
 309           (/ vc-annotate-display-mode
 310              (vc-annotate-oldest-in-map vc-annotate-color-map))))
 311         (t (error "No such display mode: %s"
 312                   vc-annotate-display-mode))))
 313
 314 ;;;###autoload
 315 (defun vc-annotate (file rev &optional display-mode buf move-point-to)
 316   "Display the edit history of the current file using colors.
 317
 318 This command creates a buffer that shows, for each line of the current
 319 file, when it was last edited and by whom.  Additionally, colors are
 320 used to show the age of each line--blue means oldest, red means
 321 youngest, and intermediate colors indicate intermediate ages.  By
 322 default, the time scale stretches back one year into the past;
 323 everything that is older than that is shown in blue.
 324
 325 With a prefix argument, this command asks two questions in the
 326 minibuffer.  First, you may enter a revision number; then the buffer
 327 displays and annotates that revision instead of the working revision
 328 \(type RET in the minibuffer to leave that default unchanged).  Then,
 329 you are prompted for the time span in days which the color range
 330 should cover.  For example, a time span of 20 days means that changes
 331 over the past 20 days are shown in red to blue, according to their
 332 age, and everything that is older than that is shown in blue.
 333
 334 If MOVE-POINT-TO is given, move the point to that line.
 335
 336 Customization variables:
 337
 338 `vc-annotate-menu-elements' customizes the menu elements of the
 339 mode-specific menu.  `vc-annotate-color-map' and
 340 `vc-annotate-very-old-color' define the mapping of time to colors.
 341 `vc-annotate-background' specifies the background color."
 342   (interactive
 343    (save-current-buffer
 344      (vc-ensure-vc-buffer)
 345      (list buffer-file-name
 346            (let ((def (vc-working-revision buffer-file-name)))
 347              (if (null current-prefix-arg) def
 348                (read-string
 349                 (format "Annotate from revision (default %s): " def)
 350                 nil nil def)))
 351            (if (null current-prefix-arg)
 352                vc-annotate-display-mode
 353              (float (string-to-number
 354                      (read-string "Annotate span days (default 20): "
 355                                   nil nil "20")))))))
 356   (vc-ensure-vc-buffer)
 357   (setq vc-annotate-display-mode display-mode) ;Not sure why.  --Stef
 358   (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev))
 359          (temp-buffer-show-function 'vc-annotate-display-select)
 360          ;; If BUF is specified, we presume the caller maintains current line,
 361          ;; so we don't need to do it here.  This implementation may give
 362          ;; strange results occasionally in the case of REV != WORKFILE-REV.
 363          (current-line (or move-point-to (unless buf (line-number-at-pos)))))
 364     (message "Annotating...")
 365     ;; If BUF is specified it tells in which buffer we should put the
 366     ;; annotations.  This is used when switching annotations to another
 367     ;; revision, so we should update the buffer's name.
 368     (when buf (with-current-buffer buf
 369                 (rename-buffer temp-buffer-name t)
 370                 ;; In case it had to be uniquified.
 371                 (setq temp-buffer-name (buffer-name))))
 372     (with-output-to-temp-buffer temp-buffer-name
 373       (let ((backend (vc-backend file)))
 374         (vc-call-backend backend 'annotate-command file
 375                          (get-buffer temp-buffer-name) rev)
 376         ;; we must setup the mode first, and then set our local
 377         ;; variables before the show-function is called at the exit of
 378         ;; with-output-to-temp-buffer
 379         (with-current-buffer temp-buffer-name
 380           (unless (equal major-mode 'vc-annotate-mode)
 381             (vc-annotate-mode))
 382           (set (make-local-variable 'vc-annotate-backend) backend)
 383           (set (make-local-variable 'vc-annotate-parent-file) file)
 384           (set (make-local-variable 'vc-annotate-parent-rev) rev)
 385           (set (make-local-variable 'vc-annotate-parent-display-mode)
 386                display-mode))))
 387
 388     (with-current-buffer temp-buffer-name
 389       (vc-exec-after
 390        `(progn
 391           ;; Ideally, we'd rather not move point if the user has already
 392           ;; moved it elsewhere, but really point here is not the position
 393           ;; of the user's cursor :-(
 394           (when ,current-line           ;(and (bobp))
 395             (goto-line ,current-line)
 396             (setq vc-sentinel-movepoint (point)))
 397           (unless (active-minibuffer-window)
 398             (message "Annotating... done")))))))
 399
 400 (defun vc-annotate-prev-revision (prefix)
 401   "Visit the annotation of the revision previous to this one.
 402
 403 With a numeric prefix argument, annotate the revision that many
 404 revisions previous."
 405   (interactive "p")
 406   (vc-annotate-warp-revision (- 0 prefix)))
 407
 408 (defun vc-annotate-next-revision (prefix)
 409   "Visit the annotation of the revision after this one.
 410
 411 With a numeric prefix argument, annotate the revision that many
 412 revisions after."
 413   (interactive "p")
 414   (vc-annotate-warp-revision prefix))
 415
 416 (defun vc-annotate-working-revision ()
 417   "Visit the annotation of the working revision of this file."
 418   (interactive)
 419   (if (not (equal major-mode 'vc-annotate-mode))
 420       (message "Cannot be invoked outside of a vc annotate buffer")
 421     (let ((warp-rev (vc-working-revision vc-annotate-parent-file)))
 422       (if (equal warp-rev vc-annotate-parent-rev)
 423           (message "Already at revision %s" warp-rev)
 424         (vc-annotate-warp-revision warp-rev)))))
 425
 426 (defun vc-annotate-extract-revision-at-line ()
 427   "Extract the revision number of the current line."
 428   ;; This function must be invoked from a buffer in vc-annotate-mode
 429   (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
 430
 431 (defun vc-annotate-revision-at-line ()
 432   "Visit the annotation of the revision identified in the current line."
 433   (interactive)
 434   (if (not (equal major-mode 'vc-annotate-mode))
 435       (message "Cannot be invoked outside of a vc annotate buffer")
 436     (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
 437       (if (not rev-at-line)
 438           (message "Cannot extract revision number from the current line")
 439         (if (equal rev-at-line vc-annotate-parent-rev)
 440             (message "Already at revision %s" rev-at-line)
 441           (vc-annotate-warp-revision rev-at-line))))))
 442
 443 (defun vc-annotate-find-revision-at-line ()
 444   "Visit the revision identified in the current line."
 445   (interactive)
 446   (if (not (equal major-mode 'vc-annotate-mode))
 447       (message "Cannot be invoked outside of a vc annotate buffer")
 448     (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
 449       (if (not rev-at-line)
 450           (message "Cannot extract revision number from the current line")
 451         (vc-revision-other-window rev-at-line)))))
 452
 453 (defun vc-annotate-revision-previous-to-line ()
 454   "Visit the annotation of the revision before the revision at line."
 455   (interactive)
 456   (if (not (equal major-mode 'vc-annotate-mode))
 457       (message "Cannot be invoked outside of a vc annotate buffer")
 458     (let ((rev-at-line (vc-annotate-extract-revision-at-line))
 459           (prev-rev nil))
 460       (if (not rev-at-line)
 461           (message "Cannot extract revision number from the current line")
 462         (setq prev-rev
 463               (vc-call-backend vc-annotate-backend 'previous-revision
 464                                vc-annotate-parent-file rev-at-line))
 465         (vc-annotate-warp-revision prev-rev)))))
 466
 467 (defun vc-annotate-show-log-revision-at-line ()
 468   "Visit the log of the revision at line."
 469   (interactive)
 470   (if (not (equal major-mode 'vc-annotate-mode))
 471       (message "Cannot be invoked outside of a vc annotate buffer")
 472     (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
 473       (if (not rev-at-line)
 474           (message "Cannot extract revision number from the current line")
 475         (vc-print-log rev-at-line)))))
 476
 477 (defun vc-annotate-show-diff-revision-at-line-internal (fileset)
 478   (if (not (equal major-mode 'vc-annotate-mode))
 479       (message "Cannot be invoked outside of a vc annotate buffer")
 480     (let ((rev-at-line (vc-annotate-extract-revision-at-line))
 481           (prev-rev nil))
 482       (if (not rev-at-line)
 483           (message "Cannot extract revision number from the current line")
 484         (setq prev-rev
 485               (vc-call-backend vc-annotate-backend 'previous-revision
 486                                vc-annotate-parent-file rev-at-line))
 487         (if (not prev-rev)
 488             (message "Cannot diff from any revision prior to %s" rev-at-line)
 489           (save-window-excursion
 490             (vc-diff-internal
 491              nil
 492              ;; The value passed here should follow what
 493              ;; `vc-deduce-fileset' returns.
 494              (cons vc-annotate-backend (cons fileset nil))
 495              prev-rev rev-at-line))
 496           (switch-to-buffer "*vc-diff*"))))))
 497
 498 (defun vc-annotate-show-diff-revision-at-line ()
 499   "Visit the diff of the revision at line from its previous revision."
 500   (interactive)
 501   (vc-annotate-show-diff-revision-at-line-internal (list vc-annotate-parent-file)))
 502
 503 (defun vc-annotate-show-changeset-diff-revision-at-line ()
 504   "Visit the diff of the revision at line from its previous revision for all files in the changeset."
 505   (interactive)
 506   (when (eq 'file (vc-call-backend vc-annotate-backend 'revision-granularity))
 507     (error "The %s backend does not support changeset diffs" vc-annotate-backend))
 508   (vc-annotate-show-diff-revision-at-line-internal nil))
 509
 510 (defun vc-annotate-warp-revision (revspec)
 511   "Annotate the revision described by REVSPEC.
 512
 513 If REVSPEC is a positive integer, warp that many revisions
 514 forward, if possible, otherwise echo a warning message.  If
 515 REVSPEC is a negative integer, warp that many revisions backward,
 516 if possible, otherwise echo a warning message.  If REVSPEC is a
 517 string, then it describes a revision number, so warp to that
 518 revision."
 519   (if (not (equal major-mode 'vc-annotate-mode))
 520       (message "Cannot be invoked outside of a vc annotate buffer")
 521     (let* ((buf (current-buffer))
 522            (oldline (line-number-at-pos))
 523            (revspeccopy revspec)
 524            (newrev nil))
 525       (cond
 526        ((and (integerp revspec) (> revspec 0))
 527         (setq newrev vc-annotate-parent-rev)
 528         (while (and (> revspec 0) newrev)
 529           (setq newrev (vc-call-backend vc-annotate-backend 'next-revision
 530                                         vc-annotate-parent-file newrev))
 531           (setq revspec (1- revspec)))
 532         (unless newrev
 533           (message "Cannot increment %d revisions from revision %s"
 534                    revspeccopy vc-annotate-parent-rev)))
 535        ((and (integerp revspec) (< revspec 0))
 536         (setq newrev vc-annotate-parent-rev)
 537         (while (and (< revspec 0) newrev)
 538           (setq newrev (vc-call-backend vc-annotate-backend 'previous-revision
 539                                         vc-annotate-parent-file newrev))
 540           (setq revspec (1+ revspec)))
 541         (unless newrev
 542           (message "Cannot decrement %d revisions from revision %s"
 543                    (- 0 revspeccopy) vc-annotate-parent-rev)))
 544        ((stringp revspec) (setq newrev revspec))
 545        (t (error "Invalid argument to vc-annotate-warp-revision")))
 546       (when newrev
 547         (vc-annotate vc-annotate-parent-file newrev
 548                      vc-annotate-parent-display-mode
 549                      buf
 550                      ;; Pass the current line so that vc-annotate will
 551                      ;; place the point in the line.
 552                      (min oldline (progn (goto-char (point-max))
 553                                          (forward-line -1)
 554                                          (line-number-at-pos))))))))
 555
 556 (defun vc-annotate-compcar (threshold a-list)
 557   "Test successive cons cells of A-LIST against THRESHOLD.
 558 Return the first cons cell with a car that is not less than THRESHOLD,
 559 nil if no such cell exists."
 560  (let ((i 1)
 561        (tmp-cons (car a-list)))
 562    (while (and tmp-cons (< (car tmp-cons) threshold))
 563      (setq tmp-cons (car (nthcdr i a-list)))
 564      (setq i (+ i 1)))
 565    tmp-cons))                           ; Return the appropriate value
 566
 567 (defun vc-annotate-convert-time (time)
 568   "Convert a time value to a floating-point number of days.
 569 The argument TIME is a list as returned by `current-time' or
 570 `encode-time', only the first two elements of that list are considered."
 571   (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))
 572
 573 (defun vc-annotate-difference (&optional offset)
 574   "Return the time span in days to the next annotation.
 575 This calls the backend function annotate-time, and returns the
 576 difference in days between the time returned and the current time,
 577 or OFFSET if present."
 578    (let ((next-time (vc-annotate-get-time-set-line-props)))
 579      (when next-time
 580        (- (or offset
 581               (vc-call-backend vc-annotate-backend 'annotate-current-time))
 582           next-time))))
 583
 584 (defun vc-default-annotate-current-time (backend)
 585   "Return the current time, encoded as fractional days."
 586   (vc-annotate-convert-time (current-time)))
 587
 588 (defvar vc-annotate-offset nil)
 589
 590 (defun vc-annotate-display (ratio &optional offset)
 591   "Highlight `vc-annotate' output in the current buffer.
 592 RATIO, is the expansion that should be applied to `vc-annotate-color-map'.
 593 The annotations are relative to the current time, unless overridden by OFFSET."
 594   (when (/= ratio 1.0)
 595     (set (make-local-variable 'vc-annotate-color-map)
 596          (mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem)))
 597                  vc-annotate-color-map)))
 598   (set (make-local-variable 'vc-annotate-offset) offset)
 599   (font-lock-mode 1))
 600
 601 (defun vc-annotate-lines (limit)
 602   (while (< (point) limit)
 603     (let ((difference (vc-annotate-difference vc-annotate-offset))
 604           (start (point))
 605           (end (progn (forward-line 1) (point))))
 606       (when difference
 607         (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map)
 608                           (cons nil vc-annotate-very-old-color)))
 609                ;; substring from index 1 to remove any leading `#' in the name
 610                (face-name (concat "vc-annotate-face-"
 611                                   (if (string-equal
 612                                        (substring (cdr color) 0 1) "#")
 613                                       (substring (cdr color) 1)
 614                                     (cdr color))))
 615                ;; Make the face if not done.
 616                (face (or (intern-soft face-name)
 617                          (let ((tmp-face (make-face (intern face-name))))
 618                            (set-face-foreground tmp-face (cdr color))
 619                            (when vc-annotate-background
 620                              (set-face-background tmp-face
 621                                                   vc-annotate-background))
 622                            tmp-face)))) ; Return the face
 623           (put-text-property start end 'face face)))))
 624   ;; Pretend to font-lock there were no matches.
 625   nil)
 626
 627 (provide 'vc-annotate)
 628
 629 ;; arch-tag: c3454a89-80e5-4ffd-8993-671b59612898
 630 ;;; vc-annotate.el ends here