Merge branch 'rs/opt-help-text'
[git/kirr.git] / contrib / emacs / git-blame.el
blobd351cfb6e7e818f5f760e83889586c6dbf6e3a11
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
7 ;; Message-ID: <87iren2vqx.fsf@morpheus.local>
8 ;; License: GPL
9 ;; Keywords: git, version control, release management
11 ;; Compatibility: Emacs21, Emacs22 and EmacsCVS
12 ;; Git 1.5 and up
14 ;; This file is *NOT* part of GNU Emacs.
15 ;; This file is distributed under the same terms as GNU Emacs.
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.
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.
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
32 ;; http://www.fsf.org/copyleft/gpl.html
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37 ;;; Commentary:
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.
45 ;;; Installation:
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:
51 ;; (require 'git-blame)
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
57 ;; (autoload 'git-blame-mode "git-blame"
58 ;; "Minor mode for incremental blame for Git." t)
60 ;; Then first use of `M-x git-blame-mode' would load the package.
62 ;;; Compatibility:
64 ;; It requires GNU Emacs 21 or later and Git 1.5.0 and up
66 ;; If you'are using Emacs 20, try changing this:
68 ;; (overlay-put ovl 'face (list :background
69 ;; (cdr (assq 'color (cddddr info)))))
71 ;; to
73 ;; (overlay-put ovl 'face (cons 'background-color
74 ;; (cdr (assq 'color (cddddr info)))))
77 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
79 ;;; Code:
81 (eval-when-compile (require 'cl)) ; to use `push', `pop'
82 (require 'format-spec)
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)
93 (defgroup git-blame nil
94 "A minor mode showing Git blame information."
95 :group 'git
96 :link '(function-link git-blame-mode))
99 (defcustom git-blame-use-colors t
100 "Use colors to indicate commits in `git-blame-mode'."
101 :type 'boolean
102 :group 'git-blame)
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:
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
117 :group 'git-blame)
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:
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
133 :group 'git-blame)
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.
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))
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" ...)
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))
160 (defvar git-blame-log-oneline-format
161 "format:[%cr] %cn: %s"
162 "*Formatting option used for describing current line in the minibuffer.
164 This option is used to pass to git log --pretty= command-line option,
165 and describe which commit the current line was made.")
167 (defvar git-blame-dark-colors
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.
171 To check out the list, evaluate (list-colors-display git-blame-dark-colors).")
173 (defvar git-blame-light-colors
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.
177 To check out the list, evaluate (list-colors-display git-blame-light-colors).")
179 (defvar git-blame-colors '()
180 "Colors used by git-blame. The list is built once when activating git-blame
181 minor mode.")
183 (defvar git-blame-ancient-color "dark green"
184 "*Color to be used for ancient commit.")
186 (defvar git-blame-autoupdate t
187 "*Automatically update the blame display while editing")
189 (defvar git-blame-proc nil
190 "The running git-blame process")
191 (make-variable-buffer-local 'git-blame-proc)
193 (defvar git-blame-overlays nil
194 "The git-blame overlays used in the current buffer.")
195 (make-variable-buffer-local 'git-blame-overlays)
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)
201 (defvar git-blame-idle-timer nil
202 "An idle timer that updates the blame")
203 (make-variable-buffer-local 'git-blame-cache)
205 (defvar git-blame-update-queue nil
206 "A queue of update requests")
207 (make-variable-buffer-local 'git-blame-update-queue)
209 ;; FIXME: docstrings
210 (defvar git-blame-file nil)
211 (defvar git-blame-current nil)
213 (defvar git-blame-mode nil)
214 (make-variable-buffer-local 'git-blame-mode)
216 (defvar git-blame-mode-line-string " blame"
217 "String to display on the mode line when git-blame is active.")
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)))
223 ;;;###autoload
224 (defun git-blame-mode (&optional arg)
225 "Toggle minor mode for displaying Git blame
227 With prefix ARG, turn the mode on if ARG is positive."
228 (interactive "P")
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))))
235 (defun git-blame-mode-on ()
236 "Turn on git-blame mode.
238 See also function `git-blame-mode'."
239 (make-local-variable 'git-blame-colors)
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))
243 (git-blame-cleanup)
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))
252 (defun git-blame-mode-off ()
253 "Turn off git-blame mode.
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))
260 ;;;###autoload
261 (defun git-reblame ()
262 "Recalculate all blame information in the current buffer"
263 (interactive)
264 (unless git-blame-mode
265 (error "Git-blame is not active"))
267 (git-blame-cleanup)
268 (git-blame-run))
270 (defun git-blame-run (&optional startline endline)
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
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))))
283 (setq git-blame-proc
284 (apply 'start-process
285 "git-blame" blame-buf
286 "git" "blame"
287 args))
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))))
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)))
305 (defun git-blame-cleanup ()
306 "Remove all blame properties"
307 (mapcar 'delete-overlay git-blame-overlays)
308 (setq git-blame-overlays nil)
309 (remove-git-blame-text-properties (point-min) (point-max)))
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)))
327 (defun git-blame-sentinel (proc status)
328 (with-current-buffer (process-buffer proc)
329 (with-current-buffer git-blame-file
330 (setq git-blame-proc nil)
331 (if git-blame-update-queue
332 (git-blame-delayed-update))))
333 ;;(kill-buffer (process-buffer proc))
334 ;;(message "git blame finished")
337 (defvar in-blame-filter nil)
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)))))))
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))))
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)))
361 ((looking-at "\\([a-z-]+\\) \\(.+\\)\n")
362 (let ((key (match-string 1))
363 (value (match-string 2)))
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)))
373 nil)))
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))))
387 (defun git-blame-create-overlay (info start-line num-lines)
388 (save-excursion
389 (set-buffer git-blame-file)
390 (let ((inhibit-point-motion-hooks t)
391 (inhibit-modification-hooks t))
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
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))))))
415 (defun git-blame-add-info (info key value)
416 (nconc info (list (cons (intern key) value))))
418 (defun git-blame-get-info (info key)
419 (cdr (assq key (cdr info))))
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"))))
427 (defun git-describe-commit (hash)
428 (with-temp-buffer
429 (call-process "git" nil t nil
430 "log" "-1"
431 (concat "--pretty=" git-blame-log-oneline-format)
432 hash)
433 (buffer-substring (point-min) (point-max))))
435 (defvar git-blame-last-identification nil)
436 (make-variable-buffer-local 'git-blame-last-identification)
437 (defun git-blame-identify (&optional hash)
438 (interactive)
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))))
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)
450 (defun git-blame-after-change (start end length)
451 (when git-blame-mode
452 (git-blame-enq-update start end)))
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))
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))))
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)))))
481 (provide 'git-blame)
483 ;;; git-blame.el ends here