Mercurial > emacs
comparison lisp/vc-annotate.el @ 96202:2bd68cb03fe1
* vc.el: Move vc-annotate variables and functions ...
* vc-annotate.el: ... here. New file.
* Makefile.in (ELCFILES): Add vc-annotate.elc.
author | Dan Nicolaescu <dann@ics.uci.edu> |
---|---|
date | Sun, 22 Jun 2008 17:56:00 +0000 |
parents | |
children | d4a46d5d6f08 |
comparison
equal
deleted
inserted
replaced
96201:84f1326f4862 | 96202:2bd68cb03fe1 |
---|---|
1 ;;; vc-annotate.el --- VC Annotate Support | |
2 | |
3 ;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, | |
4 ;; 2007, 2008 Free Software Foundation, Inc. | |
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: | |
26 ;; | |
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]. | |
95 Ages are given in units of fractional days. Default is eighteen | |
96 steps using a twenty day increment, from red to blue. For TTY | |
97 displays with 8 or fewer colors, the default is red to blue with | |
98 all other colors between (excluding black and white)." | |
99 :type 'alist | |
100 :group 'vc) | |
101 | |
102 (defcustom vc-annotate-very-old-color "#3F3FFF" | |
103 "Color for lines older than the current color range in \\[vc-annotate]]." | |
104 :type 'string | |
105 :group 'vc) | |
106 | |
107 (defcustom vc-annotate-background "black" | |
108 "Background color for \\[vc-annotate]. | |
109 Default 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. | |
115 List 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))) | |
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 "f" 'vc-annotate-find-revision-at-line) | |
124 (define-key m "J" 'vc-annotate-revision-at-line) | |
125 (define-key m "L" 'vc-annotate-show-log-revision-at-line) | |
126 (define-key m "N" 'vc-annotate-next-revision) | |
127 (define-key m "P" 'vc-annotate-prev-revision) | |
128 (define-key m "W" 'vc-annotate-working-revision) | |
129 (define-key m "V" 'vc-annotate-toggle-annotation-visibility) | |
130 m) | |
131 "Local keymap used for VC-Annotate mode.") | |
132 | |
133 ;;; Annotate functionality | |
134 | |
135 ;; Declare globally instead of additional parameter to | |
136 ;; temp-buffer-show-function (not possible to pass more than one | |
137 ;; parameter). The use of annotate-ratio is deprecated in favor of | |
138 ;; annotate-mode, which replaces it with the more sensible "span-to | |
139 ;; days", along with autoscaling support. | |
140 (defvar vc-annotate-ratio nil "Global variable.") | |
141 | |
142 ;; internal buffer-local variables | |
143 (defvar vc-annotate-backend nil) | |
144 (defvar vc-annotate-parent-file nil) | |
145 (defvar vc-annotate-parent-rev nil) | |
146 (defvar vc-annotate-parent-display-mode nil) | |
147 | |
148 (defconst vc-annotate-font-lock-keywords | |
149 ;; The fontification is done by vc-annotate-lines instead of font-lock. | |
150 '((vc-annotate-lines))) | |
151 | |
152 (define-derived-mode vc-annotate-mode fundamental-mode "Annotate" | |
153 "Major mode for output buffers of the `vc-annotate' command. | |
154 | |
155 You can use the mode-specific menu to alter the time-span of the used | |
156 colors. See variable `vc-annotate-menu-elements' for customizing the | |
157 menu items." | |
158 ;; Frob buffer-invisibility-spec so that if it is originally a naked t, | |
159 ;; it will become a list, to avoid initial annotations being invisible. | |
160 (add-to-invisibility-spec 'foo) | |
161 (remove-from-invisibility-spec 'foo) | |
162 (set (make-local-variable 'truncate-lines) t) | |
163 (set (make-local-variable 'font-lock-defaults) | |
164 '(vc-annotate-font-lock-keywords t)) | |
165 (view-mode 1)) | |
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. | |
178 The color range is given by `vc-annotate-color-map', scaled by RATIO. | |
179 The 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. | |
200 Autoscaling means that the map is scaled from the current time to the | |
201 oldest annotation in the buffer, or, with prefix argument FULL, to | |
202 cover 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"] | |
279 ["Show log of revision at line" vc-annotate-show-log-revision-at-line | |
280 :help "Visit the log of the revision at line"] | |
281 ["Show diff of revision at line" vc-annotate-show-diff-revision-at-line | |
282 :help "Visit the diff of the revision at line from its previous revision"] | |
283 ["Show changeset diff of revision at line" | |
284 vc-annotate-show-changeset-diff-revision-at-line | |
285 :enable | |
286 (eq 'repository (vc-call-backend ,vc-annotate-backend 'revision-granularity)) | |
287 :help "Visit the diff of the revision at line from its previous revision"] | |
288 ["Visit revision at line" vc-annotate-find-revision-at-line | |
289 :help "Visit the revision identified in the current line"])) | |
290 | |
291 (defun vc-annotate-display-select (&optional buffer mode) | |
292 "Highlight the output of \\[vc-annotate]. | |
293 By default, the current buffer is highlighted, unless overridden by | |
294 BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to | |
295 use; you may override this using the second optional arg MODE." | |
296 (interactive) | |
297 (when mode (setq vc-annotate-display-mode mode)) | |
298 (pop-to-buffer (or buffer (current-buffer))) | |
299 (cond ((null vc-annotate-display-mode) | |
300 ;; The ratio is global, thus relative to the global color-map. | |
301 (kill-local-variable 'vc-annotate-color-map) | |
302 (vc-annotate-display-default (or vc-annotate-ratio 1.0))) | |
303 ;; One of the auto-scaling modes | |
304 ((eq vc-annotate-display-mode 'scale) | |
305 (vc-exec-after `(vc-annotate-display-autoscale))) | |
306 ((eq vc-annotate-display-mode 'fullscale) | |
307 (vc-exec-after `(vc-annotate-display-autoscale t))) | |
308 ((numberp vc-annotate-display-mode) ; A fixed number of days lookback | |
309 (vc-annotate-display-default | |
310 (/ vc-annotate-display-mode | |
311 (vc-annotate-oldest-in-map vc-annotate-color-map)))) | |
312 (t (error "No such display mode: %s" | |
313 vc-annotate-display-mode)))) | |
314 | |
315 ;;;###autoload | |
316 (defun vc-annotate (file rev &optional display-mode buf move-point-to) | |
317 "Display the edit history of the current file using colors. | |
318 | |
319 This command creates a buffer that shows, for each line of the current | |
320 file, when it was last edited and by whom. Additionally, colors are | |
321 used to show the age of each line--blue means oldest, red means | |
322 youngest, and intermediate colors indicate intermediate ages. By | |
323 default, the time scale stretches back one year into the past; | |
324 everything that is older than that is shown in blue. | |
325 | |
326 With a prefix argument, this command asks two questions in the | |
327 minibuffer. First, you may enter a revision number; then the buffer | |
328 displays and annotates that revision instead of the working revision | |
329 \(type RET in the minibuffer to leave that default unchanged). Then, | |
330 you are prompted for the time span in days which the color range | |
331 should cover. For example, a time span of 20 days means that changes | |
332 over the past 20 days are shown in red to blue, according to their | |
333 age, and everything that is older than that is shown in blue. | |
334 | |
335 If MOVE-POINT-TO is given, move the point to that line. | |
336 | |
337 Customization variables: | |
338 | |
339 `vc-annotate-menu-elements' customizes the menu elements of the | |
340 mode-specific menu. `vc-annotate-color-map' and | |
341 `vc-annotate-very-old-color' define the mapping of time to colors. | |
342 `vc-annotate-background' specifies the background color." | |
343 (interactive | |
344 (save-current-buffer | |
345 (vc-ensure-vc-buffer) | |
346 (list buffer-file-name | |
347 (let ((def (vc-working-revision buffer-file-name))) | |
348 (if (null current-prefix-arg) def | |
349 (read-string | |
350 (format "Annotate from revision (default %s): " def) | |
351 nil nil def))) | |
352 (if (null current-prefix-arg) | |
353 vc-annotate-display-mode | |
354 (float (string-to-number | |
355 (read-string "Annotate span days (default 20): " | |
356 nil nil "20"))))))) | |
357 (vc-ensure-vc-buffer) | |
358 (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef | |
359 (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev)) | |
360 (temp-buffer-show-function 'vc-annotate-display-select) | |
361 ;; If BUF is specified, we presume the caller maintains current line, | |
362 ;; so we don't need to do it here. This implementation may give | |
363 ;; strange results occasionally in the case of REV != WORKFILE-REV. | |
364 (current-line (or move-point-to (unless buf (line-number-at-pos))))) | |
365 (message "Annotating...") | |
366 ;; If BUF is specified it tells in which buffer we should put the | |
367 ;; annotations. This is used when switching annotations to another | |
368 ;; revision, so we should update the buffer's name. | |
369 (when buf (with-current-buffer buf | |
370 (rename-buffer temp-buffer-name t) | |
371 ;; In case it had to be uniquified. | |
372 (setq temp-buffer-name (buffer-name)))) | |
373 (with-output-to-temp-buffer temp-buffer-name | |
374 (let ((backend (vc-backend file))) | |
375 (vc-call-backend backend 'annotate-command file | |
376 (get-buffer temp-buffer-name) rev) | |
377 ;; we must setup the mode first, and then set our local | |
378 ;; variables before the show-function is called at the exit of | |
379 ;; with-output-to-temp-buffer | |
380 (with-current-buffer temp-buffer-name | |
381 (unless (equal major-mode 'vc-annotate-mode) | |
382 (vc-annotate-mode)) | |
383 (set (make-local-variable 'vc-annotate-backend) backend) | |
384 (set (make-local-variable 'vc-annotate-parent-file) file) | |
385 (set (make-local-variable 'vc-annotate-parent-rev) rev) | |
386 (set (make-local-variable 'vc-annotate-parent-display-mode) | |
387 display-mode)))) | |
388 | |
389 (with-current-buffer temp-buffer-name | |
390 (vc-exec-after | |
391 `(progn | |
392 ;; Ideally, we'd rather not move point if the user has already | |
393 ;; moved it elsewhere, but really point here is not the position | |
394 ;; of the user's cursor :-( | |
395 (when ,current-line ;(and (bobp)) | |
396 (goto-line ,current-line) | |
397 (setq vc-sentinel-movepoint (point))) | |
398 (unless (active-minibuffer-window) | |
399 (message "Annotating... done"))))))) | |
400 | |
401 (defun vc-annotate-prev-revision (prefix) | |
402 "Visit the annotation of the revision previous to this one. | |
403 | |
404 With a numeric prefix argument, annotate the revision that many | |
405 revisions previous." | |
406 (interactive "p") | |
407 (vc-annotate-warp-revision (- 0 prefix))) | |
408 | |
409 (defun vc-annotate-next-revision (prefix) | |
410 "Visit the annotation of the revision after this one. | |
411 | |
412 With a numeric prefix argument, annotate the revision that many | |
413 revisions after." | |
414 (interactive "p") | |
415 (vc-annotate-warp-revision prefix)) | |
416 | |
417 (defun vc-annotate-working-revision () | |
418 "Visit the annotation of the working revision of this file." | |
419 (interactive) | |
420 (if (not (equal major-mode 'vc-annotate-mode)) | |
421 (message "Cannot be invoked outside of a vc annotate buffer") | |
422 (let ((warp-rev (vc-working-revision vc-annotate-parent-file))) | |
423 (if (equal warp-rev vc-annotate-parent-rev) | |
424 (message "Already at revision %s" warp-rev) | |
425 (vc-annotate-warp-revision warp-rev))))) | |
426 | |
427 (defun vc-annotate-extract-revision-at-line () | |
428 "Extract the revision number of the current line." | |
429 ;; This function must be invoked from a buffer in vc-annotate-mode | |
430 (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line)) | |
431 | |
432 (defun vc-annotate-revision-at-line () | |
433 "Visit the annotation of the revision identified in the current line." | |
434 (interactive) | |
435 (if (not (equal major-mode 'vc-annotate-mode)) | |
436 (message "Cannot be invoked outside of a vc annotate buffer") | |
437 (let ((rev-at-line (vc-annotate-extract-revision-at-line))) | |
438 (if (not rev-at-line) | |
439 (message "Cannot extract revision number from the current line") | |
440 (if (equal rev-at-line vc-annotate-parent-rev) | |
441 (message "Already at revision %s" rev-at-line) | |
442 (vc-annotate-warp-revision rev-at-line)))))) | |
443 | |
444 (defun vc-annotate-find-revision-at-line () | |
445 "Visit the revision identified in the current line." | |
446 (interactive) | |
447 (if (not (equal major-mode 'vc-annotate-mode)) | |
448 (message "Cannot be invoked outside of a vc annotate buffer") | |
449 (let ((rev-at-line (vc-annotate-extract-revision-at-line))) | |
450 (if (not rev-at-line) | |
451 (message "Cannot extract revision number from the current line") | |
452 (vc-revision-other-window rev-at-line))))) | |
453 | |
454 (defun vc-annotate-revision-previous-to-line () | |
455 "Visit the annotation of the revision before the revision at line." | |
456 (interactive) | |
457 (if (not (equal major-mode 'vc-annotate-mode)) | |
458 (message "Cannot be invoked outside of a vc annotate buffer") | |
459 (let ((rev-at-line (vc-annotate-extract-revision-at-line)) | |
460 (prev-rev nil)) | |
461 (if (not rev-at-line) | |
462 (message "Cannot extract revision number from the current line") | |
463 (setq prev-rev | |
464 (vc-call-backend vc-annotate-backend 'previous-revision | |
465 vc-annotate-parent-file rev-at-line)) | |
466 (vc-annotate-warp-revision prev-rev))))) | |
467 | |
468 (defun vc-annotate-show-log-revision-at-line () | |
469 "Visit the log of the revision at line." | |
470 (interactive) | |
471 (if (not (equal major-mode 'vc-annotate-mode)) | |
472 (message "Cannot be invoked outside of a vc annotate buffer") | |
473 (let ((rev-at-line (vc-annotate-extract-revision-at-line))) | |
474 (if (not rev-at-line) | |
475 (message "Cannot extract revision number from the current line") | |
476 (vc-print-log rev-at-line))))) | |
477 | |
478 (defun vc-annotate-show-diff-revision-at-line-internal (fileset) | |
479 (if (not (equal major-mode 'vc-annotate-mode)) | |
480 (message "Cannot be invoked outside of a vc annotate buffer") | |
481 (let ((rev-at-line (vc-annotate-extract-revision-at-line)) | |
482 (prev-rev nil)) | |
483 (if (not rev-at-line) | |
484 (message "Cannot extract revision number from the current line") | |
485 (setq prev-rev | |
486 (vc-call-backend vc-annotate-backend 'previous-revision | |
487 vc-annotate-parent-file rev-at-line)) | |
488 (if (not prev-rev) | |
489 (message "Cannot diff from any revision prior to %s" rev-at-line) | |
490 (save-window-excursion | |
491 (vc-diff-internal | |
492 nil | |
493 ;; The value passed here should follow what | |
494 ;; `vc-deduce-fileset' returns. | |
495 (cons vc-annotate-backend (cons fileset nil)) | |
496 prev-rev rev-at-line)) | |
497 (switch-to-buffer "*vc-diff*")))))) | |
498 | |
499 (defun vc-annotate-show-diff-revision-at-line () | |
500 "Visit the diff of the revision at line from its previous revision." | |
501 (interactive) | |
502 (vc-annotate-show-diff-revision-at-line-internal (list vc-annotate-parent-file))) | |
503 | |
504 (defun vc-annotate-show-changeset-diff-revision-at-line () | |
505 "Visit the diff of the revision at line from its previous revision for all files in the changeset." | |
506 (interactive) | |
507 (when (eq 'file (vc-call-backend vc-annotate-backend 'revision-granularity)) | |
508 (error "The %s backend does not support changeset diffs" vc-annotate-backend)) | |
509 (vc-annotate-show-diff-revision-at-line-internal nil)) | |
510 | |
511 (defun vc-annotate-warp-revision (revspec) | |
512 "Annotate the revision described by REVSPEC. | |
513 | |
514 If REVSPEC is a positive integer, warp that many revisions | |
515 forward, if possible, otherwise echo a warning message. If | |
516 REVSPEC is a negative integer, warp that many revisions backward, | |
517 if possible, otherwise echo a warning message. If REVSPEC is a | |
518 string, then it describes a revision number, so warp to that | |
519 revision." | |
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. | |
559 Return the first cons cell with a car that is not less than THRESHOLD, | |
560 nil 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. | |
570 The 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. | |
576 This calls the backend function annotate-time, and returns the | |
577 difference in days between the time returned and the current time, | |
578 or 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. | |
593 RATIO, is the expansion that should be applied to `vc-annotate-color-map'. | |
594 The 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 | |
630 ;;; vc-annotate.el ends here |