lisp/vc/vc-annotate.el

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