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