Merge branch 'sb/bisect-run-empty'
[git] / contrib / emacs / git-blame.el
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
10 ;;
11 ;; Compatibility: Emacs21, Emacs22 and EmacsCVS
12 ;;                Git 1.5 and up
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, see
29 ;; <http://www.gnu.org/licenses/>.
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 ;;
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.
60
61 ;;; Compatibility:
62 ;;
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:
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
80 (eval-when-compile (require 'cl))                             ; to use `push', `pop'
81 (require 'format-spec)
82
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
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))
158
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
166 (defvar git-blame-dark-colors
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).")
171
172 (defvar git-blame-light-colors
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).")
177
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.")
184
185 (defvar git-blame-autoupdate t
186   "*Automatically update the blame display while editing")
187
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)
199
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
208 ;; FIXME: docstrings
209 (defvar git-blame-file nil)
210 (defvar git-blame-current nil)
211
212 (defvar git-blame-mode nil)
213 (make-variable-buffer-local 'git-blame-mode)
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)))
221
222 ;;;###autoload
223 (defun git-blame-mode (&optional arg)
224   "Toggle minor mode for displaying Git blame
225
226 With prefix ARG, turn the mode on if ARG is positive."
227   (interactive "P")
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'."
238   (make-local-variable 'git-blame-colors)
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))
242   (git-blame-cleanup)
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))
258
259 ;;;###autoload
260 (defun git-reblame ()
261   "Recalculate all blame information in the current buffer"
262   (interactive)
263   (unless git-blame-mode
264     (error "Git-blame is not active"))
265
266   (git-blame-cleanup)
267   (git-blame-run))
268
269 (defun git-blame-run (&optional startline endline)
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
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))))
282       (setq git-blame-proc
283             (apply 'start-process
284                    "git-blame" blame-buf
285                    "git" "blame"
286                    args))
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))))
297
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
304 (defun git-blame-cleanup ()
305   "Remove all blame properties"
306     (mapc 'delete-overlay git-blame-overlays)
307     (setq git-blame-overlays nil)
308     (remove-git-blame-text-properties (point-min) (point-max)))
309
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
326 (defun git-blame-sentinel (proc status)
327   (with-current-buffer (process-buffer proc)
328     (with-current-buffer git-blame-file
329       (setq git-blame-proc nil)
330       (if git-blame-update-queue
331           (git-blame-delayed-update))))
332   ;;(kill-buffer (process-buffer proc))
333   ;;(message "git blame finished")
334   )
335
336 (defvar in-blame-filter nil)
337
338 (defun git-blame-filter (proc str)
339   (with-current-buffer (process-buffer proc)
340     (save-excursion
341       (goto-char (process-mark proc))
342       (insert-before-markers str)
343       (goto-char (point-min))
344       (unless in-blame-filter
345         (let ((more t)
346               (in-blame-filter t))
347           (while more
348             (setq more (git-blame-parse))))))))
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))))
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)))
359          t)
360         ((looking-at "\\([a-z-]+\\) \\(.+\\)\n")
361          (let ((key (match-string 1))
362                (value (match-string 2)))
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)))
370          t)
371         (t
372          nil)))
373
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)
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)))))))
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))))
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
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))))
434
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))))
443
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
481 (provide 'git-blame)
482
483 ;;; git-blame.el ends here