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