lisp/vc/vc-annotate.el

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