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