]>
Commit | Line | Data |
---|---|---|
b52ba1a5 JN |
1 | ;;; git-blame.el --- Minor mode for incremental blame for Git -*- coding: utf-8 -*- |
2 | ;; | |
3 | ;; Copyright (C) 2007 David Kågedal | |
4 | ;; | |
5 | ;; Authors: David Kågedal <davidk@lysator.liu.se> | |
6 | ;; Created: 31 Jan 2007 | |
28389d45 | 7 | ;; Message-ID: <87iren2vqx.fsf@morpheus.local> |
b52ba1a5 JN |
8 | ;; License: GPL |
9 | ;; Keywords: git, version control, release management | |
10 | ;; | |
3cc5ca39 XM |
11 | ;; Compatibility: Emacs21, Emacs22 and EmacsCVS |
12 | ;; Git 1.5 and up | |
b52ba1a5 JN |
13 | |
14 | ;; This file is *NOT* part of GNU Emacs. | |
15 | ;; This file is distributed under the same terms as GNU Emacs. | |
16 | ||
17 | ;; This program is free software; you can redistribute it and/or | |
18 | ;; modify it under the terms of the GNU General Public License as | |
19 | ;; published by the Free Software Foundation; either version 2 of | |
20 | ;; the License, or (at your option) any later version. | |
21 | ||
22 | ;; This program is distributed in the hope that it will be | |
23 | ;; useful, but WITHOUT ANY WARRANTY; without even the implied | |
24 | ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR | |
25 | ;; PURPOSE. See the GNU General Public License for more details. | |
26 | ||
27 | ;; You should have received a copy of the GNU General Public | |
48425792 TZ |
28 | ;; License along with this program; if not, see |
29 | ;; <http://www.gnu.org/licenses/>. | |
b52ba1a5 JN |
30 | |
31 | ;; http://www.fsf.org/copyleft/gpl.html | |
32 | ||
33 | ||
34 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
35 | ;; | |
36 | ;;; Commentary: | |
37 | ;; | |
38 | ;; Here is an Emacs implementation of incremental git-blame. When you | |
39 | ;; turn it on while viewing a file, the editor buffer will be updated by | |
40 | ;; setting the background of individual lines to a color that reflects | |
41 | ;; which commit it comes from. And when you move around the buffer, a | |
42 | ;; one-line summary will be shown in the echo area. | |
43 | ||
44 | ;;; Installation: | |
45 | ;; | |
f6f125fb JN |
46 | ;; To use this package, put it somewhere in `load-path' (or add |
47 | ;; directory with git-blame.el to `load-path'), and add the following | |
48 | ;; line to your .emacs: | |
49 | ;; | |
50 | ;; (require 'git-blame) | |
51 | ;; | |
52 | ;; If you do not want to load this package before it is necessary, you | |
53 | ;; can make use of the `autoload' feature, e.g. by adding to your .emacs | |
54 | ;; the following lines | |
55 | ;; | |
56 | ;; (autoload 'git-blame-mode "git-blame" | |
57 | ;; "Minor mode for incremental blame for Git." t) | |
58 | ;; | |
59 | ;; Then first use of `M-x git-blame-mode' would load the package. | |
b52ba1a5 JN |
60 | |
61 | ;;; Compatibility: | |
62 | ;; | |
3cc5ca39 XM |
63 | ;; It requires GNU Emacs 21 or later and Git 1.5.0 and up |
64 | ;; | |
65 | ;; If you'are using Emacs 20, try changing this: | |
b52ba1a5 JN |
66 | ;; |
67 | ;; (overlay-put ovl 'face (list :background | |
68 | ;; (cdr (assq 'color (cddddr info))))) | |
69 | ;; | |
70 | ;; to | |
71 | ;; | |
72 | ;; (overlay-put ovl 'face (cons 'background-color | |
73 | ;; (cdr (assq 'color (cddddr info))))) | |
74 | ||
75 | ||
76 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
77 | ;; | |
78 | ;;; Code: | |
79 | ||
3cc5ca39 | 80 | (eval-when-compile (require 'cl)) ; to use `push', `pop' |
0cb3f80d | 81 | (require 'format-spec) |
3cc5ca39 | 82 | |
c5022f57 DK |
83 | (defface git-blame-prefix-face |
84 | '((((background dark)) (:foreground "gray" | |
85 | :background "black")) | |
86 | (((background light)) (:foreground "gray" | |
87 | :background "white")) | |
88 | (t (:weight bold))) | |
89 | "The face used for the hash prefix." | |
90 | :group 'git-blame) | |
91 | ||
92 | (defgroup git-blame nil | |
93 | "A minor mode showing Git blame information." | |
94 | :group 'git | |
95 | :link '(function-link git-blame-mode)) | |
96 | ||
97 | ||
98 | (defcustom git-blame-use-colors t | |
99 | "Use colors to indicate commits in `git-blame-mode'." | |
100 | :type 'boolean | |
101 | :group 'git-blame) | |
102 | ||
103 | (defcustom git-blame-prefix-format | |
104 | "%h %20A:" | |
105 | "The format of the prefix added to each line in `git-blame' | |
106 | mode. The format is passed to `format-spec' with the following format keys: | |
107 | ||
108 | %h - the abbreviated hash | |
109 | %H - the full hash | |
110 | %a - the author name | |
111 | %A - the author email | |
112 | %c - the committer name | |
113 | %C - the committer email | |
114 | %s - the commit summary | |
115 | " | |
116 | :group 'git-blame) | |
117 | ||
118 | (defcustom git-blame-mouseover-format | |
119 | "%h %a %A: %s" | |
120 | "The format of the description shown when pointing at a line in | |
121 | `git-blame' mode. The format string is passed to `format-spec' | |
122 | with the following format keys: | |
123 | ||
124 | %h - the abbreviated hash | |
125 | %H - the full hash | |
126 | %a - the author name | |
127 | %A - the author email | |
128 | %c - the committer name | |
129 | %C - the committer email | |
130 | %s - the commit summary | |
131 | " | |
132 | :group 'git-blame) | |
133 | ||
3cc5ca39 XM |
134 | |
135 | (defun git-blame-color-scale (&rest elements) | |
136 | "Given a list, returns a list of triples formed with each | |
137 | elements of the list. | |
138 | ||
139 | a b => bbb bba bab baa abb aba aaa aab" | |
140 | (let (result) | |
141 | (dolist (a elements) | |
142 | (dolist (b elements) | |
143 | (dolist (c elements) | |
144 | (setq result (cons (format "#%s%s%s" a b c) result))))) | |
145 | result)) | |
146 | ||
147 | ;; (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") => | |
148 | ;; ("#3c3c3c" "#3c3c14" "#3c3c34" "#3c3c2c" "#3c3c1c" "#3c3c24" | |
149 | ;; "#3c3c04" "#3c3c0c" "#3c143c" "#3c1414" "#3c1434" "#3c142c" ...) | |
150 | ||
151 | (defmacro git-blame-random-pop (l) | |
152 | "Select a random element from L and returns it. Also remove | |
153 | selected element from l." | |
154 | ;; only works on lists with unique elements | |
155 | `(let ((e (elt ,l (random (length ,l))))) | |
156 | (setq ,l (remove e ,l)) | |
157 | e)) | |
28389d45 | 158 | |
24a2293a JU |
159 | (defvar git-blame-log-oneline-format |
160 | "format:[%cr] %cn: %s" | |
161 | "*Formatting option used for describing current line in the minibuffer. | |
162 | ||
163 | This option is used to pass to git log --pretty= command-line option, | |
164 | and describe which commit the current line was made.") | |
165 | ||
28389d45 | 166 | (defvar git-blame-dark-colors |
3cc5ca39 XM |
167 | (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") |
168 | "*List of colors (format #RGB) to use in a dark environment. | |
169 | ||
170 | To check out the list, evaluate (list-colors-display git-blame-dark-colors).") | |
28389d45 DK |
171 | |
172 | (defvar git-blame-light-colors | |
3cc5ca39 XM |
173 | (git-blame-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec") |
174 | "*List of colors (format #RGB) to use in a light environment. | |
175 | ||
176 | To check out the list, evaluate (list-colors-display git-blame-light-colors).") | |
28389d45 | 177 | |
3cc5ca39 XM |
178 | (defvar git-blame-colors '() |
179 | "Colors used by git-blame. The list is built once when activating git-blame | |
180 | minor mode.") | |
181 | ||
182 | (defvar git-blame-ancient-color "dark green" | |
183 | "*Color to be used for ancient commit.") | |
28389d45 | 184 | |
d2589855 DK |
185 | (defvar git-blame-autoupdate t |
186 | "*Automatically update the blame display while editing") | |
187 | ||
f0f39bb4 DK |
188 | (defvar git-blame-proc nil |
189 | "The running git-blame process") | |
190 | (make-variable-buffer-local 'git-blame-proc) | |
191 | ||
192 | (defvar git-blame-overlays nil | |
193 | "The git-blame overlays used in the current buffer.") | |
194 | (make-variable-buffer-local 'git-blame-overlays) | |
195 | ||
196 | (defvar git-blame-cache nil | |
197 | "A cache of git-blame information for the current buffer") | |
198 | (make-variable-buffer-local 'git-blame-cache) | |
28389d45 | 199 | |
d2589855 DK |
200 | (defvar git-blame-idle-timer nil |
201 | "An idle timer that updates the blame") | |
202 | (make-variable-buffer-local 'git-blame-cache) | |
203 | ||
204 | (defvar git-blame-update-queue nil | |
205 | "A queue of update requests") | |
206 | (make-variable-buffer-local 'git-blame-update-queue) | |
207 | ||
3cc5ca39 XM |
208 | ;; FIXME: docstrings |
209 | (defvar git-blame-file nil) | |
210 | (defvar git-blame-current nil) | |
211 | ||
28389d45 DK |
212 | (defvar git-blame-mode nil) |
213 | (make-variable-buffer-local 'git-blame-mode) | |
02f0559e XM |
214 | |
215 | (defvar git-blame-mode-line-string " blame" | |
216 | "String to display on the mode line when git-blame is active.") | |
217 | ||
218 | (or (assq 'git-blame-mode minor-mode-alist) | |
219 | (setq minor-mode-alist | |
220 | (cons '(git-blame-mode git-blame-mode-line-string) minor-mode-alist))) | |
28389d45 | 221 | |
f6f125fb | 222 | ;;;###autoload |
28389d45 | 223 | (defun git-blame-mode (&optional arg) |
02f0559e XM |
224 | "Toggle minor mode for displaying Git blame |
225 | ||
226 | With prefix ARG, turn the mode on if ARG is positive." | |
28389d45 | 227 | (interactive "P") |
02f0559e XM |
228 | (cond |
229 | ((null arg) | |
230 | (if git-blame-mode (git-blame-mode-off) (git-blame-mode-on))) | |
231 | ((> (prefix-numeric-value arg) 0) (git-blame-mode-on)) | |
232 | (t (git-blame-mode-off)))) | |
233 | ||
234 | (defun git-blame-mode-on () | |
235 | "Turn on git-blame mode. | |
236 | ||
237 | See also function `git-blame-mode'." | |
28389d45 | 238 | (make-local-variable 'git-blame-colors) |
d2589855 DK |
239 | (if git-blame-autoupdate |
240 | (add-hook 'after-change-functions 'git-blame-after-change nil t) | |
241 | (remove-hook 'after-change-functions 'git-blame-after-change t)) | |
fa882116 | 242 | (git-blame-cleanup) |
02f0559e XM |
243 | (let ((bgmode (cdr (assoc 'background-mode (frame-parameters))))) |
244 | (if (eq bgmode 'dark) | |
245 | (setq git-blame-colors git-blame-dark-colors) | |
246 | (setq git-blame-colors git-blame-light-colors))) | |
247 | (setq git-blame-cache (make-hash-table :test 'equal)) | |
248 | (setq git-blame-mode t) | |
249 | (git-blame-run)) | |
250 | ||
251 | (defun git-blame-mode-off () | |
252 | "Turn off git-blame mode. | |
253 | ||
254 | See also function `git-blame-mode'." | |
255 | (git-blame-cleanup) | |
256 | (if git-blame-idle-timer (cancel-timer git-blame-idle-timer)) | |
257 | (setq git-blame-mode nil)) | |
28389d45 | 258 | |
f0f39bb4 DK |
259 | ;;;###autoload |
260 | (defun git-reblame () | |
261 | "Recalculate all blame information in the current buffer" | |
02f0559e | 262 | (interactive) |
f0f39bb4 | 263 | (unless git-blame-mode |
3cc5ca39 | 264 | (error "Git-blame is not active")) |
02f0559e | 265 | |
f0f39bb4 DK |
266 | (git-blame-cleanup) |
267 | (git-blame-run)) | |
268 | ||
d2589855 | 269 | (defun git-blame-run (&optional startline endline) |
f0f39bb4 DK |
270 | (if git-blame-proc |
271 | ;; Should maybe queue up a new run here | |
272 | (message "Already running git blame") | |
273 | (let ((display-buf (current-buffer)) | |
274 | (blame-buf (get-buffer-create | |
d2589855 DK |
275 | (concat " git blame for " (buffer-name)))) |
276 | (args '("--incremental" "--contents" "-"))) | |
277 | (if startline | |
278 | (setq args (append args | |
279 | (list "-L" (format "%d,%d" startline endline))))) | |
280 | (setq args (append args | |
281 | (list (file-name-nondirectory buffer-file-name)))) | |
f0f39bb4 | 282 | (setq git-blame-proc |
d2589855 DK |
283 | (apply 'start-process |
284 | "git-blame" blame-buf | |
285 | "git" "blame" | |
286 | args)) | |
f0f39bb4 DK |
287 | (with-current-buffer blame-buf |
288 | (erase-buffer) | |
289 | (make-local-variable 'git-blame-file) | |
290 | (make-local-variable 'git-blame-current) | |
291 | (setq git-blame-file display-buf) | |
292 | (setq git-blame-current nil)) | |
293 | (set-process-filter git-blame-proc 'git-blame-filter) | |
294 | (set-process-sentinel git-blame-proc 'git-blame-sentinel) | |
295 | (process-send-region git-blame-proc (point-min) (point-max)) | |
296 | (process-send-eof git-blame-proc)))) | |
28389d45 | 297 | |
96df551c DK |
298 | (defun remove-git-blame-text-properties (start end) |
299 | (let ((modified (buffer-modified-p)) | |
300 | (inhibit-read-only t)) | |
301 | (remove-text-properties start end '(point-entered nil)) | |
302 | (set-buffer-modified-p modified))) | |
303 | ||
28389d45 DK |
304 | (defun git-blame-cleanup () |
305 | "Remove all blame properties" | |
cbbc935c | 306 | (mapc 'delete-overlay git-blame-overlays) |
28389d45 | 307 | (setq git-blame-overlays nil) |
96df551c | 308 | (remove-git-blame-text-properties (point-min) (point-max))) |
28389d45 | 309 | |
d2589855 DK |
310 | (defun git-blame-update-region (start end) |
311 | "Rerun blame to get updates between START and END" | |
312 | (let ((overlays (overlays-in start end))) | |
313 | (while overlays | |
314 | (let ((overlay (pop overlays))) | |
315 | (if (< (overlay-start overlay) start) | |
316 | (setq start (overlay-start overlay))) | |
317 | (if (> (overlay-end overlay) end) | |
318 | (setq end (overlay-end overlay))) | |
319 | (setq git-blame-overlays (delete overlay git-blame-overlays)) | |
320 | (delete-overlay overlay)))) | |
321 | (remove-git-blame-text-properties start end) | |
322 | ;; We can be sure that start and end are at line breaks | |
323 | (git-blame-run (1+ (count-lines (point-min) start)) | |
324 | (count-lines (point-min) end))) | |
325 | ||
28389d45 | 326 | (defun git-blame-sentinel (proc status) |
f0f39bb4 DK |
327 | (with-current-buffer (process-buffer proc) |
328 | (with-current-buffer git-blame-file | |
d2589855 DK |
329 | (setq git-blame-proc nil) |
330 | (if git-blame-update-queue | |
331 | (git-blame-delayed-update)))) | |
28389d45 | 332 | ;;(kill-buffer (process-buffer proc)) |
96df551c DK |
333 | ;;(message "git blame finished") |
334 | ) | |
28389d45 DK |
335 | |
336 | (defvar in-blame-filter nil) | |
337 | ||
338 | (defun git-blame-filter (proc str) | |
0e59a6f6 LM |
339 | (with-current-buffer (process-buffer proc) |
340 | (save-excursion | |
341 | (goto-char (process-mark proc)) | |
342 | (insert-before-markers str) | |
32663b22 | 343 | (goto-char (point-min)) |
0e59a6f6 LM |
344 | (unless in-blame-filter |
345 | (let ((more t) | |
346 | (in-blame-filter t)) | |
347 | (while more | |
348 | (setq more (git-blame-parse)))))))) | |
28389d45 DK |
349 | |
350 | (defun git-blame-parse () | |
351 | (cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n") | |
352 | (let ((hash (match-string 1)) | |
353 | (src-line (string-to-number (match-string 2))) | |
354 | (res-line (string-to-number (match-string 3))) | |
355 | (num-lines (string-to-number (match-string 4)))) | |
c5022f57 DK |
356 | (delete-region (point) (match-end 0)) |
357 | (setq git-blame-current (list (git-blame-new-commit hash) | |
358 | src-line res-line num-lines))) | |
28389d45 DK |
359 | t) |
360 | ((looking-at "\\([a-z-]+\\) \\(.+\\)\n") | |
361 | (let ((key (match-string 1)) | |
362 | (value (match-string 2))) | |
c5022f57 DK |
363 | (delete-region (point) (match-end 0)) |
364 | (git-blame-add-info (car git-blame-current) key value) | |
365 | (when (string= key "filename") | |
366 | (git-blame-create-overlay (car git-blame-current) | |
367 | (caddr git-blame-current) | |
368 | (cadddr git-blame-current)) | |
369 | (setq git-blame-current nil))) | |
28389d45 DK |
370 | t) |
371 | (t | |
372 | nil))) | |
373 | ||
c5022f57 DK |
374 | (defun git-blame-new-commit (hash) |
375 | (with-current-buffer git-blame-file | |
376 | (or (gethash hash git-blame-cache) | |
377 | ;; Assign a random color to each new commit info | |
378 | ;; Take care not to select the same color multiple times | |
379 | (let* ((color (if git-blame-colors | |
380 | (git-blame-random-pop git-blame-colors) | |
381 | git-blame-ancient-color)) | |
382 | (info `(,hash (color . ,color)))) | |
383 | (puthash hash info git-blame-cache) | |
384 | info)))) | |
385 | ||
386 | (defun git-blame-create-overlay (info start-line num-lines) | |
0e59a6f6 LM |
387 | (with-current-buffer git-blame-file |
388 | (save-excursion | |
389 | (let ((inhibit-point-motion-hooks t) | |
390 | (inhibit-modification-hooks t)) | |
391 | (goto-char (point-min)) | |
392 | (forward-line (1- start-line)) | |
393 | (let* ((start (point)) | |
394 | (end (progn (forward-line num-lines) (point))) | |
395 | (ovl (make-overlay start end)) | |
396 | (hash (car info)) | |
397 | (spec `((?h . ,(substring hash 0 6)) | |
398 | (?H . ,hash) | |
399 | (?a . ,(git-blame-get-info info 'author)) | |
400 | (?A . ,(git-blame-get-info info 'author-mail)) | |
401 | (?c . ,(git-blame-get-info info 'committer)) | |
402 | (?C . ,(git-blame-get-info info 'committer-mail)) | |
403 | (?s . ,(git-blame-get-info info 'summary))))) | |
404 | (push ovl git-blame-overlays) | |
405 | (overlay-put ovl 'git-blame info) | |
406 | (overlay-put ovl 'help-echo | |
407 | (format-spec git-blame-mouseover-format spec)) | |
408 | (if git-blame-use-colors | |
409 | (overlay-put ovl 'face (list :background | |
410 | (cdr (assq 'color (cdr info)))))) | |
411 | (overlay-put ovl 'line-prefix | |
412 | (propertize (format-spec git-blame-prefix-format spec) | |
413 | 'face 'git-blame-prefix-face))))))) | |
c5022f57 DK |
414 | |
415 | (defun git-blame-add-info (info key value) | |
416 | (nconc info (list (cons (intern key) value)))) | |
417 | ||
418 | (defun git-blame-get-info (info key) | |
419 | (cdr (assq key (cdr info)))) | |
28389d45 DK |
420 | |
421 | (defun git-blame-current-commit () | |
422 | (let ((info (get-char-property (point) 'git-blame))) | |
423 | (if info | |
424 | (car info) | |
425 | (error "No commit info")))) | |
426 | ||
9f85fb32 DK |
427 | (defun git-describe-commit (hash) |
428 | (with-temp-buffer | |
429 | (call-process "git" nil t nil | |
24a2293a JU |
430 | "log" "-1" |
431 | (concat "--pretty=" git-blame-log-oneline-format) | |
9f85fb32 | 432 | hash) |
c79cc2e5 | 433 | (buffer-substring (point-min) (point-max)))) |
9f85fb32 DK |
434 | |
435 | (defvar git-blame-last-identification nil) | |
436 | (make-variable-buffer-local 'git-blame-last-identification) | |
28389d45 DK |
437 | (defun git-blame-identify (&optional hash) |
438 | (interactive) | |
9f85fb32 DK |
439 | (let ((info (gethash (or hash (git-blame-current-commit)) git-blame-cache))) |
440 | (when (and info (not (eq info git-blame-last-identification))) | |
441 | (message "%s" (nth 4 info)) | |
442 | (setq git-blame-last-identification info)))) | |
b52ba1a5 | 443 | |
d2589855 DK |
444 | ;; (defun git-blame-after-save () |
445 | ;; (when git-blame-mode | |
446 | ;; (git-blame-cleanup) | |
447 | ;; (git-blame-run))) | |
448 | ;; (add-hook 'after-save-hook 'git-blame-after-save) | |
449 | ||
450 | (defun git-blame-after-change (start end length) | |
451 | (when git-blame-mode | |
452 | (git-blame-enq-update start end))) | |
453 | ||
454 | (defvar git-blame-last-update nil) | |
455 | (make-variable-buffer-local 'git-blame-last-update) | |
456 | (defun git-blame-enq-update (start end) | |
457 | "Mark the region between START and END as needing blame update" | |
458 | ;; Try to be smart and avoid multiple callouts for sequential | |
459 | ;; editing | |
460 | (cond ((and git-blame-last-update | |
461 | (= start (cdr git-blame-last-update))) | |
462 | (setcdr git-blame-last-update end)) | |
463 | ((and git-blame-last-update | |
464 | (= end (car git-blame-last-update))) | |
465 | (setcar git-blame-last-update start)) | |
466 | (t | |
467 | (setq git-blame-last-update (cons start end)) | |
468 | (setq git-blame-update-queue (nconc git-blame-update-queue | |
469 | (list git-blame-last-update))))) | |
470 | (unless (or git-blame-proc git-blame-idle-timer) | |
471 | (setq git-blame-idle-timer | |
472 | (run-with-idle-timer 0.5 nil 'git-blame-delayed-update)))) | |
473 | ||
474 | (defun git-blame-delayed-update () | |
475 | (setq git-blame-idle-timer nil) | |
476 | (if git-blame-update-queue | |
477 | (let ((first (pop git-blame-update-queue)) | |
478 | (inhibit-point-motion-hooks t)) | |
479 | (git-blame-update-region (car first) (cdr first))))) | |
480 | ||
b52ba1a5 JN |
481 | (provide 'git-blame) |
482 | ||
483 | ;;; git-blame.el ends here |