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