]>
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 | |
28 | ;; License along with this program; if not, write to the Free | |
29 | ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, | |
30 | ;; MA 02111-1307 USA | |
31 | ||
32 | ;; http://www.fsf.org/copyleft/gpl.html | |
33 | ||
34 | ||
35 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
36 | ;; | |
37 | ;;; Commentary: | |
38 | ;; | |
39 | ;; Here is an Emacs implementation of incremental git-blame. When you | |
40 | ;; turn it on while viewing a file, the editor buffer will be updated by | |
41 | ;; setting the background of individual lines to a color that reflects | |
42 | ;; which commit it comes from. And when you move around the buffer, a | |
43 | ;; one-line summary will be shown in the echo area. | |
44 | ||
45 | ;;; Installation: | |
46 | ;; | |
f6f125fb JN |
47 | ;; To use this package, put it somewhere in `load-path' (or add |
48 | ;; directory with git-blame.el to `load-path'), and add the following | |
49 | ;; line to your .emacs: | |
50 | ;; | |
51 | ;; (require 'git-blame) | |
52 | ;; | |
53 | ;; If you do not want to load this package before it is necessary, you | |
54 | ;; can make use of the `autoload' feature, e.g. by adding to your .emacs | |
55 | ;; the following lines | |
56 | ;; | |
57 | ;; (autoload 'git-blame-mode "git-blame" | |
58 | ;; "Minor mode for incremental blame for Git." t) | |
59 | ;; | |
60 | ;; Then first use of `M-x git-blame-mode' would load the package. | |
b52ba1a5 JN |
61 | |
62 | ;;; Compatibility: | |
63 | ;; | |
3cc5ca39 XM |
64 | ;; It requires GNU Emacs 21 or later and Git 1.5.0 and up |
65 | ;; | |
66 | ;; If you'are using Emacs 20, try changing this: | |
b52ba1a5 JN |
67 | ;; |
68 | ;; (overlay-put ovl 'face (list :background | |
69 | ;; (cdr (assq 'color (cddddr info))))) | |
70 | ;; | |
71 | ;; to | |
72 | ;; | |
73 | ;; (overlay-put ovl 'face (cons 'background-color | |
74 | ;; (cdr (assq 'color (cddddr info))))) | |
75 | ||
76 | ||
77 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
78 | ;; | |
79 | ;;; Code: | |
80 | ||
3cc5ca39 | 81 | (eval-when-compile (require 'cl)) ; to use `push', `pop' |
0cb3f80d | 82 | (require 'format-spec) |
3cc5ca39 | 83 | |
c5022f57 DK |
84 | (defface git-blame-prefix-face |
85 | '((((background dark)) (:foreground "gray" | |
86 | :background "black")) | |
87 | (((background light)) (:foreground "gray" | |
88 | :background "white")) | |
89 | (t (:weight bold))) | |
90 | "The face used for the hash prefix." | |
91 | :group 'git-blame) | |
92 | ||
93 | (defgroup git-blame nil | |
94 | "A minor mode showing Git blame information." | |
95 | :group 'git | |
96 | :link '(function-link git-blame-mode)) | |
97 | ||
98 | ||
99 | (defcustom git-blame-use-colors t | |
100 | "Use colors to indicate commits in `git-blame-mode'." | |
101 | :type 'boolean | |
102 | :group 'git-blame) | |
103 | ||
104 | (defcustom git-blame-prefix-format | |
105 | "%h %20A:" | |
106 | "The format of the prefix added to each line in `git-blame' | |
107 | mode. The format is passed to `format-spec' with the following format keys: | |
108 | ||
109 | %h - the abbreviated hash | |
110 | %H - the full hash | |
111 | %a - the author name | |
112 | %A - the author email | |
113 | %c - the committer name | |
114 | %C - the committer email | |
115 | %s - the commit summary | |
116 | " | |
117 | :group 'git-blame) | |
118 | ||
119 | (defcustom git-blame-mouseover-format | |
120 | "%h %a %A: %s" | |
121 | "The format of the description shown when pointing at a line in | |
122 | `git-blame' mode. The format string is passed to `format-spec' | |
123 | with the following format keys: | |
124 | ||
125 | %h - the abbreviated hash | |
126 | %H - the full hash | |
127 | %a - the author name | |
128 | %A - the author email | |
129 | %c - the committer name | |
130 | %C - the committer email | |
131 | %s - the commit summary | |
132 | " | |
133 | :group 'git-blame) | |
134 | ||
3cc5ca39 XM |
135 | |
136 | (defun git-blame-color-scale (&rest elements) | |
137 | "Given a list, returns a list of triples formed with each | |
138 | elements of the list. | |
139 | ||
140 | a b => bbb bba bab baa abb aba aaa aab" | |
141 | (let (result) | |
142 | (dolist (a elements) | |
143 | (dolist (b elements) | |
144 | (dolist (c elements) | |
145 | (setq result (cons (format "#%s%s%s" a b c) result))))) | |
146 | result)) | |
147 | ||
148 | ;; (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") => | |
149 | ;; ("#3c3c3c" "#3c3c14" "#3c3c34" "#3c3c2c" "#3c3c1c" "#3c3c24" | |
150 | ;; "#3c3c04" "#3c3c0c" "#3c143c" "#3c1414" "#3c1434" "#3c142c" ...) | |
151 | ||
152 | (defmacro git-blame-random-pop (l) | |
153 | "Select a random element from L and returns it. Also remove | |
154 | selected element from l." | |
155 | ;; only works on lists with unique elements | |
156 | `(let ((e (elt ,l (random (length ,l))))) | |
157 | (setq ,l (remove e ,l)) | |
158 | e)) | |
28389d45 | 159 | |
24a2293a JU |
160 | (defvar git-blame-log-oneline-format |
161 | "format:[%cr] %cn: %s" | |
162 | "*Formatting option used for describing current line in the minibuffer. | |
163 | ||
164 | This option is used to pass to git log --pretty= command-line option, | |
165 | and describe which commit the current line was made.") | |
166 | ||
28389d45 | 167 | (defvar git-blame-dark-colors |
3cc5ca39 XM |
168 | (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") |
169 | "*List of colors (format #RGB) to use in a dark environment. | |
170 | ||
171 | To check out the list, evaluate (list-colors-display git-blame-dark-colors).") | |
28389d45 DK |
172 | |
173 | (defvar git-blame-light-colors | |
3cc5ca39 XM |
174 | (git-blame-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec") |
175 | "*List of colors (format #RGB) to use in a light environment. | |
176 | ||
177 | To check out the list, evaluate (list-colors-display git-blame-light-colors).") | |
28389d45 | 178 | |
3cc5ca39 XM |
179 | (defvar git-blame-colors '() |
180 | "Colors used by git-blame. The list is built once when activating git-blame | |
181 | minor mode.") | |
182 | ||
183 | (defvar git-blame-ancient-color "dark green" | |
184 | "*Color to be used for ancient commit.") | |
28389d45 | 185 | |
d2589855 DK |
186 | (defvar git-blame-autoupdate t |
187 | "*Automatically update the blame display while editing") | |
188 | ||
f0f39bb4 DK |
189 | (defvar git-blame-proc nil |
190 | "The running git-blame process") | |
191 | (make-variable-buffer-local 'git-blame-proc) | |
192 | ||
193 | (defvar git-blame-overlays nil | |
194 | "The git-blame overlays used in the current buffer.") | |
195 | (make-variable-buffer-local 'git-blame-overlays) | |
196 | ||
197 | (defvar git-blame-cache nil | |
198 | "A cache of git-blame information for the current buffer") | |
199 | (make-variable-buffer-local 'git-blame-cache) | |
28389d45 | 200 | |
d2589855 DK |
201 | (defvar git-blame-idle-timer nil |
202 | "An idle timer that updates the blame") | |
203 | (make-variable-buffer-local 'git-blame-cache) | |
204 | ||
205 | (defvar git-blame-update-queue nil | |
206 | "A queue of update requests") | |
207 | (make-variable-buffer-local 'git-blame-update-queue) | |
208 | ||
3cc5ca39 XM |
209 | ;; FIXME: docstrings |
210 | (defvar git-blame-file nil) | |
211 | (defvar git-blame-current nil) | |
212 | ||
28389d45 DK |
213 | (defvar git-blame-mode nil) |
214 | (make-variable-buffer-local 'git-blame-mode) | |
02f0559e XM |
215 | |
216 | (defvar git-blame-mode-line-string " blame" | |
217 | "String to display on the mode line when git-blame is active.") | |
218 | ||
219 | (or (assq 'git-blame-mode minor-mode-alist) | |
220 | (setq minor-mode-alist | |
221 | (cons '(git-blame-mode git-blame-mode-line-string) minor-mode-alist))) | |
28389d45 | 222 | |
f6f125fb | 223 | ;;;###autoload |
28389d45 | 224 | (defun git-blame-mode (&optional arg) |
02f0559e XM |
225 | "Toggle minor mode for displaying Git blame |
226 | ||
227 | With prefix ARG, turn the mode on if ARG is positive." | |
28389d45 | 228 | (interactive "P") |
02f0559e XM |
229 | (cond |
230 | ((null arg) | |
231 | (if git-blame-mode (git-blame-mode-off) (git-blame-mode-on))) | |
232 | ((> (prefix-numeric-value arg) 0) (git-blame-mode-on)) | |
233 | (t (git-blame-mode-off)))) | |
234 | ||
235 | (defun git-blame-mode-on () | |
236 | "Turn on git-blame mode. | |
237 | ||
238 | See also function `git-blame-mode'." | |
28389d45 | 239 | (make-local-variable 'git-blame-colors) |
d2589855 DK |
240 | (if git-blame-autoupdate |
241 | (add-hook 'after-change-functions 'git-blame-after-change nil t) | |
242 | (remove-hook 'after-change-functions 'git-blame-after-change t)) | |
fa882116 | 243 | (git-blame-cleanup) |
02f0559e XM |
244 | (let ((bgmode (cdr (assoc 'background-mode (frame-parameters))))) |
245 | (if (eq bgmode 'dark) | |
246 | (setq git-blame-colors git-blame-dark-colors) | |
247 | (setq git-blame-colors git-blame-light-colors))) | |
248 | (setq git-blame-cache (make-hash-table :test 'equal)) | |
249 | (setq git-blame-mode t) | |
250 | (git-blame-run)) | |
251 | ||
252 | (defun git-blame-mode-off () | |
253 | "Turn off git-blame mode. | |
254 | ||
255 | See also function `git-blame-mode'." | |
256 | (git-blame-cleanup) | |
257 | (if git-blame-idle-timer (cancel-timer git-blame-idle-timer)) | |
258 | (setq git-blame-mode nil)) | |
28389d45 | 259 | |
f0f39bb4 DK |
260 | ;;;###autoload |
261 | (defun git-reblame () | |
262 | "Recalculate all blame information in the current buffer" | |
02f0559e | 263 | (interactive) |
f0f39bb4 | 264 | (unless git-blame-mode |
3cc5ca39 | 265 | (error "Git-blame is not active")) |
02f0559e | 266 | |
f0f39bb4 DK |
267 | (git-blame-cleanup) |
268 | (git-blame-run)) | |
269 | ||
d2589855 | 270 | (defun git-blame-run (&optional startline endline) |
f0f39bb4 DK |
271 | (if git-blame-proc |
272 | ;; Should maybe queue up a new run here | |
273 | (message "Already running git blame") | |
274 | (let ((display-buf (current-buffer)) | |
275 | (blame-buf (get-buffer-create | |
d2589855 DK |
276 | (concat " git blame for " (buffer-name)))) |
277 | (args '("--incremental" "--contents" "-"))) | |
278 | (if startline | |
279 | (setq args (append args | |
280 | (list "-L" (format "%d,%d" startline endline))))) | |
281 | (setq args (append args | |
282 | (list (file-name-nondirectory buffer-file-name)))) | |
f0f39bb4 | 283 | (setq git-blame-proc |
d2589855 DK |
284 | (apply 'start-process |
285 | "git-blame" blame-buf | |
286 | "git" "blame" | |
287 | args)) | |
f0f39bb4 DK |
288 | (with-current-buffer blame-buf |
289 | (erase-buffer) | |
290 | (make-local-variable 'git-blame-file) | |
291 | (make-local-variable 'git-blame-current) | |
292 | (setq git-blame-file display-buf) | |
293 | (setq git-blame-current nil)) | |
294 | (set-process-filter git-blame-proc 'git-blame-filter) | |
295 | (set-process-sentinel git-blame-proc 'git-blame-sentinel) | |
296 | (process-send-region git-blame-proc (point-min) (point-max)) | |
297 | (process-send-eof git-blame-proc)))) | |
28389d45 | 298 | |
96df551c DK |
299 | (defun remove-git-blame-text-properties (start end) |
300 | (let ((modified (buffer-modified-p)) | |
301 | (inhibit-read-only t)) | |
302 | (remove-text-properties start end '(point-entered nil)) | |
303 | (set-buffer-modified-p modified))) | |
304 | ||
28389d45 DK |
305 | (defun git-blame-cleanup () |
306 | "Remove all blame properties" | |
307 | (mapcar 'delete-overlay git-blame-overlays) | |
308 | (setq git-blame-overlays nil) | |
96df551c | 309 | (remove-git-blame-text-properties (point-min) (point-max))) |
28389d45 | 310 | |
d2589855 DK |
311 | (defun git-blame-update-region (start end) |
312 | "Rerun blame to get updates between START and END" | |
313 | (let ((overlays (overlays-in start end))) | |
314 | (while overlays | |
315 | (let ((overlay (pop overlays))) | |
316 | (if (< (overlay-start overlay) start) | |
317 | (setq start (overlay-start overlay))) | |
318 | (if (> (overlay-end overlay) end) | |
319 | (setq end (overlay-end overlay))) | |
320 | (setq git-blame-overlays (delete overlay git-blame-overlays)) | |
321 | (delete-overlay overlay)))) | |
322 | (remove-git-blame-text-properties start end) | |
323 | ;; We can be sure that start and end are at line breaks | |
324 | (git-blame-run (1+ (count-lines (point-min) start)) | |
325 | (count-lines (point-min) end))) | |
326 | ||
28389d45 | 327 | (defun git-blame-sentinel (proc status) |
f0f39bb4 DK |
328 | (with-current-buffer (process-buffer proc) |
329 | (with-current-buffer git-blame-file | |
d2589855 DK |
330 | (setq git-blame-proc nil) |
331 | (if git-blame-update-queue | |
332 | (git-blame-delayed-update)))) | |
28389d45 | 333 | ;;(kill-buffer (process-buffer proc)) |
96df551c DK |
334 | ;;(message "git blame finished") |
335 | ) | |
28389d45 DK |
336 | |
337 | (defvar in-blame-filter nil) | |
338 | ||
339 | (defun git-blame-filter (proc str) | |
340 | (save-excursion | |
341 | (set-buffer (process-buffer proc)) | |
342 | (goto-char (process-mark proc)) | |
343 | (insert-before-markers str) | |
344 | (goto-char 0) | |
345 | (unless in-blame-filter | |
346 | (let ((more t) | |
347 | (in-blame-filter t)) | |
348 | (while more | |
349 | (setq more (git-blame-parse))))))) | |
350 | ||
351 | (defun git-blame-parse () | |
352 | (cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n") | |
353 | (let ((hash (match-string 1)) | |
354 | (src-line (string-to-number (match-string 2))) | |
355 | (res-line (string-to-number (match-string 3))) | |
356 | (num-lines (string-to-number (match-string 4)))) | |
c5022f57 DK |
357 | (delete-region (point) (match-end 0)) |
358 | (setq git-blame-current (list (git-blame-new-commit hash) | |
359 | src-line res-line num-lines))) | |
28389d45 DK |
360 | t) |
361 | ((looking-at "\\([a-z-]+\\) \\(.+\\)\n") | |
362 | (let ((key (match-string 1)) | |
363 | (value (match-string 2))) | |
c5022f57 DK |
364 | (delete-region (point) (match-end 0)) |
365 | (git-blame-add-info (car git-blame-current) key value) | |
366 | (when (string= key "filename") | |
367 | (git-blame-create-overlay (car git-blame-current) | |
368 | (caddr git-blame-current) | |
369 | (cadddr git-blame-current)) | |
370 | (setq git-blame-current nil))) | |
28389d45 DK |
371 | t) |
372 | (t | |
373 | nil))) | |
374 | ||
c5022f57 DK |
375 | (defun git-blame-new-commit (hash) |
376 | (with-current-buffer git-blame-file | |
377 | (or (gethash hash git-blame-cache) | |
378 | ;; Assign a random color to each new commit info | |
379 | ;; Take care not to select the same color multiple times | |
380 | (let* ((color (if git-blame-colors | |
381 | (git-blame-random-pop git-blame-colors) | |
382 | git-blame-ancient-color)) | |
383 | (info `(,hash (color . ,color)))) | |
384 | (puthash hash info git-blame-cache) | |
385 | info)))) | |
386 | ||
387 | (defun git-blame-create-overlay (info start-line num-lines) | |
28389d45 DK |
388 | (save-excursion |
389 | (set-buffer git-blame-file) | |
c5022f57 | 390 | (let ((inhibit-point-motion-hooks t) |
d2589855 | 391 | (inhibit-modification-hooks t)) |
c5022f57 DK |
392 | (goto-line 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 | |
28389d45 | 409 | (overlay-put ovl 'face (list :background |
c5022f57 DK |
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)))))) | |
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 |