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