Commit | Line | Data |
---|---|---|
f439c140 DN |
1 | ;;; vc-annotate.el --- VC Annotate Support |
2 | ||
ab422c4d | 3 | ;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc. |
f439c140 DN |
4 | |
5 | ;; Author: Martin Lorentzson <emwson@emw.ericsson.se> | |
6 | ;; Maintainer: FSF | |
9766adfb | 7 | ;; Keywords: vc tools |
bd78fa1d | 8 | ;; Package: vc |
f439c140 DN |
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: | |
a464a6c7 | 32 | (eval-when-compile (require 'cl-lib)) |
f439c140 DN |
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" | |
d41b91e6 | 102 | "Color for lines older than the current color range in \\[vc-annotate]." |
f439c140 DN |
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))) | |
3cddaef1 DN |
120 | (define-key m "a" 'vc-annotate-revision-previous-to-line) |
121 | (define-key m "d" 'vc-annotate-show-diff-revision-at-line) | |
c8e83751 | 122 | (define-key m "=" 'vc-annotate-show-diff-revision-at-line) |
3cddaef1 | 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) | |
3ba7869c CY |
131 | (define-key m "v" 'vc-annotate-toggle-annotation-visibility) |
132 | (define-key m "\C-m" 'vc-annotate-goto-line) | |
f439c140 DN |
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 | ||
ffbda93a | 155 | (define-derived-mode vc-annotate-mode special-mode "Annotate" |
f439c140 DN |
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) | |
8117868f DN |
167 | '(vc-annotate-font-lock-keywords t)) |
168 | (hack-dir-local-variables-non-file-buffer)) | |
f439c140 DN |
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)) | |
a464a6c7 | 197 | (cl-assert (>= (point) bol)) |
f439c140 DN |
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"] | |
e21c597a | 282 | "--" |
f439c140 DN |
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-exec-after `(vc-annotate-display-autoscale))) | |
310 | ((eq vc-annotate-display-mode 'fullscale) | |
311 | (vc-exec-after `(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 | ;;;###autoload | |
11c46b39 | 320 | (defun vc-annotate (file rev &optional display-mode buf move-point-to vc-bk) |
12755d08 | 321 | "Display the edit history of the current FILE using colors. |
f439c140 DN |
322 | |
323 | This command creates a buffer that shows, for each line of the current | |
324 | file, when it was last edited and by whom. Additionally, colors are | |
325 | used to show the age of each line--blue means oldest, red means | |
326 | youngest, and intermediate colors indicate intermediate ages. By | |
327 | default, the time scale stretches back one year into the past; | |
328 | everything that is older than that is shown in blue. | |
329 | ||
330 | With a prefix argument, this command asks two questions in the | |
12755d08 | 331 | minibuffer. First, you may enter a revision number REV; then the buffer |
f439c140 DN |
332 | displays and annotates that revision instead of the working revision |
333 | \(type RET in the minibuffer to leave that default unchanged). Then, | |
334 | you are prompted for the time span in days which the color range | |
335 | should cover. For example, a time span of 20 days means that changes | |
336 | over the past 20 days are shown in red to blue, according to their | |
337 | age, and everything that is older than that is shown in blue. | |
338 | ||
339 | If MOVE-POINT-TO is given, move the point to that line. | |
340 | ||
11c46b39 DN |
341 | If VC-BK is given used that VC backend. |
342 | ||
f439c140 DN |
343 | Customization variables: |
344 | ||
345 | `vc-annotate-menu-elements' customizes the menu elements of the | |
346 | mode-specific menu. `vc-annotate-color-map' and | |
347 | `vc-annotate-very-old-color' define the mapping of time to colors. | |
348 | `vc-annotate-background' specifies the background color." | |
349 | (interactive | |
350 | (save-current-buffer | |
351 | (vc-ensure-vc-buffer) | |
352 | (list buffer-file-name | |
353 | (let ((def (vc-working-revision buffer-file-name))) | |
354 | (if (null current-prefix-arg) def | |
12755d08 | 355 | (vc-read-revision |
f439c140 | 356 | (format "Annotate from revision (default %s): " def) |
12755d08 | 357 | (list buffer-file-name) nil def))) |
f439c140 DN |
358 | (if (null current-prefix-arg) |
359 | vc-annotate-display-mode | |
360 | (float (string-to-number | |
361 | (read-string "Annotate span days (default 20): " | |
362 | nil nil "20"))))))) | |
363 | (vc-ensure-vc-buffer) | |
364 | (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef | |
365 | (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev)) | |
366 | (temp-buffer-show-function 'vc-annotate-display-select) | |
367 | ;; If BUF is specified, we presume the caller maintains current line, | |
368 | ;; so we don't need to do it here. This implementation may give | |
369 | ;; strange results occasionally in the case of REV != WORKFILE-REV. | |
972bf25a CY |
370 | (current-line (or move-point-to (unless buf |
371 | (save-restriction | |
372 | (widen) | |
373 | (line-number-at-pos)))))) | |
f439c140 DN |
374 | (message "Annotating...") |
375 | ;; If BUF is specified it tells in which buffer we should put the | |
376 | ;; annotations. This is used when switching annotations to another | |
377 | ;; revision, so we should update the buffer's name. | |
378 | (when buf (with-current-buffer buf | |
379 | (rename-buffer temp-buffer-name t) | |
380 | ;; In case it had to be uniquified. | |
381 | (setq temp-buffer-name (buffer-name)))) | |
382 | (with-output-to-temp-buffer temp-buffer-name | |
11c46b39 | 383 | (let ((backend (or vc-bk (vc-backend file))) |
657bc6fc | 384 | (coding-system-for-read buffer-file-coding-system)) |
f439c140 DN |
385 | (vc-call-backend backend 'annotate-command file |
386 | (get-buffer temp-buffer-name) rev) | |
387 | ;; we must setup the mode first, and then set our local | |
388 | ;; variables before the show-function is called at the exit of | |
389 | ;; with-output-to-temp-buffer | |
390 | (with-current-buffer temp-buffer-name | |
391 | (unless (equal major-mode 'vc-annotate-mode) | |
392 | (vc-annotate-mode)) | |
393 | (set (make-local-variable 'vc-annotate-backend) backend) | |
394 | (set (make-local-variable 'vc-annotate-parent-file) file) | |
395 | (set (make-local-variable 'vc-annotate-parent-rev) rev) | |
396 | (set (make-local-variable 'vc-annotate-parent-display-mode) | |
397 | display-mode)))) | |
398 | ||
399 | (with-current-buffer temp-buffer-name | |
400 | (vc-exec-after | |
401 | `(progn | |
402 | ;; Ideally, we'd rather not move point if the user has already | |
403 | ;; moved it elsewhere, but really point here is not the position | |
404 | ;; of the user's cursor :-( | |
405 | (when ,current-line ;(and (bobp)) | |
406 | (goto-line ,current-line) | |
407 | (setq vc-sentinel-movepoint (point))) | |
408 | (unless (active-minibuffer-window) | |
409 | (message "Annotating... done"))))))) | |
410 | ||
411 | (defun vc-annotate-prev-revision (prefix) | |
412 | "Visit the annotation of the revision previous to this one. | |
413 | ||
414 | With a numeric prefix argument, annotate the revision that many | |
415 | revisions previous." | |
416 | (interactive "p") | |
417 | (vc-annotate-warp-revision (- 0 prefix))) | |
418 | ||
419 | (defun vc-annotate-next-revision (prefix) | |
420 | "Visit the annotation of the revision after this one. | |
421 | ||
422 | With a numeric prefix argument, annotate the revision that many | |
423 | revisions after." | |
424 | (interactive "p") | |
425 | (vc-annotate-warp-revision prefix)) | |
426 | ||
427 | (defun vc-annotate-working-revision () | |
428 | "Visit the annotation of the working revision of this file." | |
429 | (interactive) | |
430 | (if (not (equal major-mode 'vc-annotate-mode)) | |
431 | (message "Cannot be invoked outside of a vc annotate buffer") | |
432 | (let ((warp-rev (vc-working-revision vc-annotate-parent-file))) | |
433 | (if (equal warp-rev vc-annotate-parent-rev) | |
434 | (message "Already at revision %s" warp-rev) | |
435 | (vc-annotate-warp-revision warp-rev))))) | |
436 | ||
437 | (defun vc-annotate-extract-revision-at-line () | |
d1e4c403 DN |
438 | "Extract the revision number of the current line. |
439 | Return a cons (REV . FILENAME)." | |
f439c140 | 440 | ;; This function must be invoked from a buffer in vc-annotate-mode |
d1e4c403 DN |
441 | (let ((rev (vc-call-backend vc-annotate-backend |
442 | 'annotate-extract-revision-at-line))) | |
443 | (if (or (null rev) (consp rev)) | |
444 | rev | |
445 | (cons rev vc-annotate-parent-file)))) | |
f439c140 DN |
446 | |
447 | (defun vc-annotate-revision-at-line () | |
448 | "Visit the annotation of the revision identified in the current line." | |
449 | (interactive) | |
450 | (if (not (equal major-mode 'vc-annotate-mode)) | |
451 | (message "Cannot be invoked outside of a vc annotate buffer") | |
452 | (let ((rev-at-line (vc-annotate-extract-revision-at-line))) | |
453 | (if (not rev-at-line) | |
454 | (message "Cannot extract revision number from the current line") | |
e2396d80 DN |
455 | (if (and (equal (car rev-at-line) vc-annotate-parent-rev) |
456 | (string= (cdr rev-at-line) vc-annotate-parent-file)) | |
f439c140 | 457 | (message "Already at revision %s" rev-at-line) |
d1e4c403 | 458 | (vc-annotate-warp-revision (car rev-at-line) (cdr rev-at-line))))))) |
f439c140 DN |
459 | |
460 | (defun vc-annotate-find-revision-at-line () | |
461 | "Visit the revision identified in the current line." | |
462 | (interactive) | |
463 | (if (not (equal major-mode 'vc-annotate-mode)) | |
464 | (message "Cannot be invoked outside of a vc annotate buffer") | |
465 | (let ((rev-at-line (vc-annotate-extract-revision-at-line))) | |
466 | (if (not rev-at-line) | |
467 | (message "Cannot extract revision number from the current line") | |
d1e4c403 | 468 | (switch-to-buffer-other-window |
04ec0963 | 469 | (vc-find-revision (cdr rev-at-line) (car rev-at-line) vc-annotate-backend)))))) |
f439c140 DN |
470 | |
471 | (defun vc-annotate-revision-previous-to-line () | |
472 | "Visit the annotation of the revision before the revision at line." | |
473 | (interactive) | |
474 | (if (not (equal major-mode 'vc-annotate-mode)) | |
475 | (message "Cannot be invoked outside of a vc annotate buffer") | |
d1e4c403 DN |
476 | (let* ((rev-at-line (vc-annotate-extract-revision-at-line)) |
477 | (prev-rev nil) | |
478 | (rev (car rev-at-line)) | |
479 | (fname (cdr rev-at-line))) | |
f439c140 DN |
480 | (if (not rev-at-line) |
481 | (message "Cannot extract revision number from the current line") | |
482 | (setq prev-rev | |
483 | (vc-call-backend vc-annotate-backend 'previous-revision | |
d1e4c403 | 484 | fname rev)) |
a5d358f8 | 485 | (vc-annotate-warp-revision prev-rev fname))))) |
f439c140 | 486 | |
dba372dd GM |
487 | (defvar log-view-vc-backend) |
488 | (defvar log-view-vc-fileset) | |
489 | ||
f439c140 | 490 | (defun vc-annotate-show-log-revision-at-line () |
662c5698 DN |
491 | "Visit the log of the revision at line. |
492 | If the VC backend supports it, only show the log entry for the revision. | |
493 | If a *vc-change-log* buffer exists and already shows a log for | |
ddc20cdb | 494 | the file in question, search for the log entry required and move point." |
f439c140 DN |
495 | (interactive) |
496 | (if (not (equal major-mode 'vc-annotate-mode)) | |
497 | (message "Cannot be invoked outside of a vc annotate buffer") | |
498 | (let ((rev-at-line (vc-annotate-extract-revision-at-line))) | |
499 | (if (not rev-at-line) | |
500 | (message "Cannot extract revision number from the current line") | |
662c5698 DN |
501 | (let ((backend vc-annotate-backend) |
502 | (log-buf (get-buffer "*vc-change-log*")) | |
503 | pos) | |
504 | (if (and | |
505 | log-buf | |
506 | ;; Look for a log buffer that already displays the correct file. | |
507 | (with-current-buffer log-buf | |
508 | (and (eq backend log-view-vc-backend) | |
509 | (null (cdr log-view-vc-fileset)) | |
510 | (string= (car log-view-vc-fileset) (cdr rev-at-line)) | |
511 | ;; Check if the entry we require can be found. | |
512 | (vc-call-backend | |
513 | backend 'show-log-entry (car rev-at-line)) | |
514 | (setq pos (point))))) | |
515 | (progn | |
516 | (pop-to-buffer log-buf) | |
517 | (goto-char pos)) | |
518 | ;; Ask the backend to display a single log entry. | |
519 | (vc-print-log-internal | |
520 | vc-annotate-backend (list (cdr rev-at-line)) | |
521 | (car rev-at-line) t 1))))))) | |
f439c140 | 522 | |
d1e4c403 | 523 | (defun vc-annotate-show-diff-revision-at-line-internal (filediff) |
1930bf5d | 524 | (if (not (derived-mode-p 'vc-annotate-mode)) |
f439c140 | 525 | (message "Cannot be invoked outside of a vc annotate buffer") |
d1e4c403 | 526 | (let* ((rev-at-line (vc-annotate-extract-revision-at-line)) |
1930bf5d SM |
527 | (prev-rev nil) |
528 | (rev (car rev-at-line)) | |
529 | (fname (cdr rev-at-line))) | |
f439c140 DN |
530 | (if (not rev-at-line) |
531 | (message "Cannot extract revision number from the current line") | |
532 | (setq prev-rev | |
533 | (vc-call-backend vc-annotate-backend 'previous-revision | |
c4786d60 | 534 | (if filediff fname nil) rev)) |
f439c140 | 535 | (if (not prev-rev) |
d1e4c403 | 536 | (message "Cannot diff from any revision prior to %s" rev) |
1930bf5d SM |
537 | (vc-diff-internal |
538 | t | |
539 | ;; The value passed here should follow what | |
540 | ;; `vc-deduce-fileset' returns. | |
541 | (list vc-annotate-backend | |
542 | (if filediff | |
543 | (list fname) | |
544 | nil)) | |
545 | prev-rev rev)))))) | |
f439c140 DN |
546 | |
547 | (defun vc-annotate-show-diff-revision-at-line () | |
548 | "Visit the diff of the revision at line from its previous revision." | |
549 | (interactive) | |
d1e4c403 | 550 | (vc-annotate-show-diff-revision-at-line-internal t)) |
f439c140 DN |
551 | |
552 | (defun vc-annotate-show-changeset-diff-revision-at-line () | |
553 | "Visit the diff of the revision at line from its previous revision for all files in the changeset." | |
554 | (interactive) | |
555 | (when (eq 'file (vc-call-backend vc-annotate-backend 'revision-granularity)) | |
556 | (error "The %s backend does not support changeset diffs" vc-annotate-backend)) | |
557 | (vc-annotate-show-diff-revision-at-line-internal nil)) | |
558 | ||
d1e4c403 | 559 | (defun vc-annotate-warp-revision (revspec &optional file) |
f439c140 DN |
560 | "Annotate the revision described by REVSPEC. |
561 | ||
d41b91e6 | 562 | If REVSPEC is a positive integer, warp that many revisions forward, |
f439c140 | 563 | if possible, otherwise echo a warning message. If REVSPEC is a |
d41b91e6 JB |
564 | negative integer, warp that many revisions backward, if possible, |
565 | otherwise echo a warning message. If REVSPEC is a string, then it | |
566 | describes a revision number, so warp to that revision." | |
f439c140 DN |
567 | (if (not (equal major-mode 'vc-annotate-mode)) |
568 | (message "Cannot be invoked outside of a vc annotate buffer") | |
569 | (let* ((buf (current-buffer)) | |
570 | (oldline (line-number-at-pos)) | |
571 | (revspeccopy revspec) | |
572 | (newrev nil)) | |
573 | (cond | |
574 | ((and (integerp revspec) (> revspec 0)) | |
575 | (setq newrev vc-annotate-parent-rev) | |
576 | (while (and (> revspec 0) newrev) | |
577 | (setq newrev (vc-call-backend vc-annotate-backend 'next-revision | |
d1e4c403 | 578 | (or file vc-annotate-parent-file) newrev)) |
f439c140 DN |
579 | (setq revspec (1- revspec))) |
580 | (unless newrev | |
581 | (message "Cannot increment %d revisions from revision %s" | |
582 | revspeccopy vc-annotate-parent-rev))) | |
583 | ((and (integerp revspec) (< revspec 0)) | |
584 | (setq newrev vc-annotate-parent-rev) | |
585 | (while (and (< revspec 0) newrev) | |
586 | (setq newrev (vc-call-backend vc-annotate-backend 'previous-revision | |
d1e4c403 | 587 | (or file vc-annotate-parent-file) newrev)) |
f439c140 DN |
588 | (setq revspec (1+ revspec))) |
589 | (unless newrev | |
590 | (message "Cannot decrement %d revisions from revision %s" | |
591 | (- 0 revspeccopy) vc-annotate-parent-rev))) | |
592 | ((stringp revspec) (setq newrev revspec)) | |
593 | (t (error "Invalid argument to vc-annotate-warp-revision"))) | |
594 | (when newrev | |
d1e4c403 | 595 | (vc-annotate (or file vc-annotate-parent-file) newrev |
f439c140 DN |
596 | vc-annotate-parent-display-mode |
597 | buf | |
598 | ;; Pass the current line so that vc-annotate will | |
599 | ;; place the point in the line. | |
600 | (min oldline (progn (goto-char (point-max)) | |
601 | (forward-line -1) | |
11c46b39 DN |
602 | (line-number-at-pos))) |
603 | vc-annotate-backend))))) | |
f439c140 DN |
604 | |
605 | (defun vc-annotate-compcar (threshold a-list) | |
606 | "Test successive cons cells of A-LIST against THRESHOLD. | |
607 | Return the first cons cell with a car that is not less than THRESHOLD, | |
608 | nil if no such cell exists." | |
609 | (let ((i 1) | |
610 | (tmp-cons (car a-list))) | |
611 | (while (and tmp-cons (< (car tmp-cons) threshold)) | |
612 | (setq tmp-cons (car (nthcdr i a-list))) | |
613 | (setq i (+ i 1))) | |
614 | tmp-cons)) ; Return the appropriate value | |
615 | ||
616 | (defun vc-annotate-convert-time (time) | |
617 | "Convert a time value to a floating-point number of days. | |
618 | The argument TIME is a list as returned by `current-time' or | |
619 | `encode-time', only the first two elements of that list are considered." | |
620 | (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600)) | |
621 | ||
622 | (defun vc-annotate-difference (&optional offset) | |
623 | "Return the time span in days to the next annotation. | |
624 | This calls the backend function annotate-time, and returns the | |
625 | difference in days between the time returned and the current time, | |
626 | or OFFSET if present." | |
627 | (let ((next-time (vc-annotate-get-time-set-line-props))) | |
628 | (when next-time | |
629 | (- (or offset | |
630 | (vc-call-backend vc-annotate-backend 'annotate-current-time)) | |
631 | next-time)))) | |
632 | ||
633 | (defun vc-default-annotate-current-time (backend) | |
634 | "Return the current time, encoded as fractional days." | |
635 | (vc-annotate-convert-time (current-time))) | |
636 | ||
637 | (defvar vc-annotate-offset nil) | |
638 | ||
639 | (defun vc-annotate-display (ratio &optional offset) | |
640 | "Highlight `vc-annotate' output in the current buffer. | |
d41b91e6 | 641 | RATIO is the expansion that should be applied to `vc-annotate-color-map'. |
f439c140 DN |
642 | The annotations are relative to the current time, unless overridden by OFFSET." |
643 | (when (/= ratio 1.0) | |
644 | (set (make-local-variable 'vc-annotate-color-map) | |
645 | (mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem))) | |
646 | vc-annotate-color-map))) | |
647 | (set (make-local-variable 'vc-annotate-offset) offset) | |
648 | (font-lock-mode 1)) | |
649 | ||
650 | (defun vc-annotate-lines (limit) | |
651 | (while (< (point) limit) | |
652 | (let ((difference (vc-annotate-difference vc-annotate-offset)) | |
653 | (start (point)) | |
654 | (end (progn (forward-line 1) (point)))) | |
655 | (when difference | |
656 | (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map) | |
657 | (cons nil vc-annotate-very-old-color))) | |
658 | ;; substring from index 1 to remove any leading `#' in the name | |
659 | (face-name (concat "vc-annotate-face-" | |
660 | (if (string-equal | |
661 | (substring (cdr color) 0 1) "#") | |
662 | (substring (cdr color) 1) | |
663 | (cdr color)))) | |
664 | ;; Make the face if not done. | |
665 | (face (or (intern-soft face-name) | |
666 | (let ((tmp-face (make-face (intern face-name)))) | |
667 | (set-face-foreground tmp-face (cdr color)) | |
668 | (when vc-annotate-background | |
669 | (set-face-background tmp-face | |
670 | vc-annotate-background)) | |
671 | tmp-face)))) ; Return the face | |
672 | (put-text-property start end 'face face))))) | |
673 | ;; Pretend to font-lock there were no matches. | |
674 | nil) | |
675 | ||
3ba7869c CY |
676 | (defun vc-annotate-goto-line () |
677 | "Go to the line corresponding to the current VC Annotate line." | |
678 | (interactive) | |
679 | (unless (eq major-mode 'vc-annotate-mode) | |
680 | (error "Not in a VC-Annotate buffer")) | |
681 | (let ((line (save-restriction | |
682 | (widen) | |
683 | (line-number-at-pos))) | |
684 | (rev vc-annotate-parent-rev)) | |
685 | (pop-to-buffer | |
686 | (or (and (buffer-live-p vc-parent-buffer) | |
687 | vc-parent-buffer) | |
688 | (and (file-exists-p vc-annotate-parent-file) | |
689 | (find-file-noselect vc-annotate-parent-file)) | |
690 | (error "File not found: %s" vc-annotate-parent-file))) | |
691 | (save-restriction | |
692 | (widen) | |
693 | (goto-char (point-min)) | |
694 | (forward-line (1- line)) | |
695 | (recenter)) | |
696 | ;; Issue a warning if the lines might be incorrect. | |
697 | (cond | |
698 | ((buffer-modified-p) | |
699 | (message "Buffer modified; annotated line numbers may be incorrect")) | |
700 | ((not (eq (vc-state buffer-file-name) 'up-to-date)) | |
701 | (message "File is not up-to-date; annotated line numbers may be incorrect")) | |
702 | ((not (equal rev (vc-working-revision buffer-file-name))) | |
703 | (message "Annotations were for revision %s; line numbers may be incorrect" | |
704 | rev))))) | |
705 | ||
f439c140 DN |
706 | (provide 'vc-annotate) |
707 | ||
708 | ;;; vc-annotate.el ends here |