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