]>
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 | ;; | |
11 | ;; Compatibility: Emacs21 | |
12 | ||
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 | ;; | |
47 | ;; 1) Load into emacs: M-x load-file RET git-blame.el RET | |
48 | ;; 2) Open a git-controlled file | |
49 | ;; 3) Blame: M-x git-blame-mode | |
50 | ||
51 | ;;; Compatibility: | |
52 | ;; | |
53 | ;; It requires GNU Emacs 21. If you'are using Emacs 20, try | |
54 | ;; changing this: | |
55 | ;; | |
56 | ;; (overlay-put ovl 'face (list :background | |
57 | ;; (cdr (assq 'color (cddddr info))))) | |
58 | ;; | |
59 | ;; to | |
60 | ;; | |
61 | ;; (overlay-put ovl 'face (cons 'background-color | |
62 | ;; (cdr (assq 'color (cddddr info))))) | |
63 | ||
64 | ||
65 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
66 | ;; | |
67 | ;;; Code: | |
68 | ||
69 | (require 'cl) ; to use `push', `pop' | |
28389d45 | 70 | |
28389d45 DK |
71 | (defun color-scale (l) |
72 | (let* ((colors ()) | |
73 | r g b) | |
74 | (setq r l) | |
75 | (while r | |
76 | (setq g l) | |
77 | (while g | |
78 | (setq b l) | |
79 | (while b | |
80 | (push (concat "#" (car r) (car g) (car b)) colors) | |
81 | (pop b)) | |
82 | (pop g)) | |
83 | (pop r)) | |
84 | colors)) | |
85 | ||
86 | (defvar git-blame-dark-colors | |
87 | (color-scale '("00" "04" "08" "0c" | |
88 | "10" "14" "18" "1c" | |
89 | "20" "24" "28" "2c" | |
90 | "30" "34" "38" "3c"))) | |
91 | ||
92 | (defvar git-blame-light-colors | |
93 | (color-scale '("c0" "c4" "c8" "cc" | |
94 | "d0" "d4" "d8" "dc" | |
95 | "e0" "e4" "e8" "ec" | |
96 | "f0" "f4" "f8" "fc"))) | |
97 | ||
98 | (defvar git-blame-ancient-color "dark green") | |
99 | ||
100 | (defvar git-blame-overlays nil) | |
101 | (defvar git-blame-cache nil) | |
102 | ||
103 | (defvar git-blame-mode nil) | |
104 | (make-variable-buffer-local 'git-blame-mode) | |
105 | (push (list 'git-blame-mode " blame") minor-mode-alist) | |
106 | ||
107 | (defun git-blame-mode (&optional arg) | |
108 | (interactive "P") | |
109 | (if arg | |
110 | (setq git-blame-mode (eq arg 1)) | |
111 | (setq git-blame-mode (not git-blame-mode))) | |
112 | (make-local-variable 'git-blame-overlays) | |
113 | (make-local-variable 'git-blame-colors) | |
114 | (make-local-variable 'git-blame-cache) | |
115 | (let ((bgmode (cdr (assoc 'background-mode (frame-parameters))))) | |
116 | (if (eq bgmode 'dark) | |
117 | (setq git-blame-colors git-blame-dark-colors) | |
118 | (setq git-blame-colors git-blame-light-colors))) | |
119 | (if git-blame-mode | |
120 | (git-blame-run) | |
121 | (git-blame-cleanup))) | |
122 | ||
123 | (defun git-blame-run () | |
124 | (let* ((display-buf (current-buffer)) | |
125 | (blame-buf (get-buffer-create | |
126 | (concat " git blame for " (buffer-name)))) | |
127 | (proc (start-process "git-blame" blame-buf | |
128 | "git" "blame" "--incremental" | |
129 | (file-name-nondirectory buffer-file-name)))) | |
130 | (mapcar 'delete-overlay git-blame-overlays) | |
131 | (setq git-blame-overlays nil) | |
132 | (setq git-blame-cache (make-hash-table :test 'equal)) | |
133 | (with-current-buffer blame-buf | |
134 | (erase-buffer) | |
135 | (make-local-variable 'git-blame-file) | |
136 | (make-local-variable 'git-blame-current) | |
137 | (setq git-blame-file display-buf) | |
138 | (setq git-blame-current nil)) | |
139 | (set-process-filter proc 'git-blame-filter) | |
140 | (set-process-sentinel proc 'git-blame-sentinel))) | |
141 | ||
142 | (defun git-blame-cleanup () | |
143 | "Remove all blame properties" | |
144 | (mapcar 'delete-overlay git-blame-overlays) | |
145 | (setq git-blame-overlays nil) | |
146 | (let ((modified (buffer-modified-p))) | |
147 | (remove-text-properties (point-min) (point-max) '(point-entered nil)) | |
148 | (set-buffer-modified-p modified))) | |
149 | ||
150 | (defun git-blame-sentinel (proc status) | |
151 | ;;(kill-buffer (process-buffer proc)) | |
152 | (message "git blame finished")) | |
153 | ||
154 | (defvar in-blame-filter nil) | |
155 | ||
156 | (defun git-blame-filter (proc str) | |
157 | (save-excursion | |
158 | (set-buffer (process-buffer proc)) | |
159 | (goto-char (process-mark proc)) | |
160 | (insert-before-markers str) | |
161 | (goto-char 0) | |
162 | (unless in-blame-filter | |
163 | (let ((more t) | |
164 | (in-blame-filter t)) | |
165 | (while more | |
166 | (setq more (git-blame-parse))))))) | |
167 | ||
168 | (defun git-blame-parse () | |
169 | (cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n") | |
170 | (let ((hash (match-string 1)) | |
171 | (src-line (string-to-number (match-string 2))) | |
172 | (res-line (string-to-number (match-string 3))) | |
173 | (num-lines (string-to-number (match-string 4)))) | |
174 | (setq git-blame-current | |
175 | (git-blame-new-commit | |
176 | hash src-line res-line num-lines))) | |
177 | (delete-region (point) (match-end 0)) | |
178 | t) | |
179 | ((looking-at "filename \\(.+\\)\n") | |
180 | (let ((filename (match-string 1))) | |
181 | (git-blame-add-info "filename" filename)) | |
182 | (delete-region (point) (match-end 0)) | |
183 | t) | |
184 | ((looking-at "\\([a-z-]+\\) \\(.+\\)\n") | |
185 | (let ((key (match-string 1)) | |
186 | (value (match-string 2))) | |
187 | (git-blame-add-info key value)) | |
188 | (delete-region (point) (match-end 0)) | |
189 | t) | |
190 | ((looking-at "boundary\n") | |
191 | (setq git-blame-current nil) | |
192 | (delete-region (point) (match-end 0)) | |
193 | t) | |
194 | (t | |
195 | nil))) | |
196 | ||
197 | ||
198 | (defun git-blame-new-commit (hash src-line res-line num-lines) | |
199 | (save-excursion | |
200 | (set-buffer git-blame-file) | |
201 | (let ((info (gethash hash git-blame-cache)) | |
202 | (inhibit-point-motion-hooks t)) | |
203 | (when (not info) | |
204 | (let ((color (pop git-blame-colors))) | |
205 | (unless color | |
206 | (setq color git-blame-ancient-color)) | |
207 | (setq info (list hash src-line res-line num-lines | |
208 | (cons 'color color)))) | |
209 | (puthash hash info git-blame-cache)) | |
210 | (goto-line res-line) | |
211 | (while (> num-lines 0) | |
212 | (if (get-text-property (point) 'git-blame) | |
213 | (forward-line) | |
214 | (let* ((start (point)) | |
215 | (end (progn (forward-line 1) (point))) | |
216 | (ovl (make-overlay start end))) | |
217 | (push ovl git-blame-overlays) | |
218 | (overlay-put ovl 'git-blame info) | |
219 | (overlay-put ovl 'help-echo hash) | |
220 | (overlay-put ovl 'face (list :background | |
221 | (cdr (assq 'color (cddddr info))))) | |
222 | ;;(overlay-put ovl 'point-entered | |
223 | ;; `(lambda (x y) (git-blame-identify ,hash))) | |
224 | (let ((modified (buffer-modified-p))) | |
225 | (put-text-property (if (= start 1) start (1- start)) (1- end) | |
226 | 'point-entered | |
227 | `(lambda (x y) (git-blame-identify ,hash))) | |
228 | (set-buffer-modified-p modified)))) | |
229 | (setq num-lines (1- num-lines)))))) | |
230 | ||
231 | (defun git-blame-add-info (key value) | |
232 | (if git-blame-current | |
233 | (nconc git-blame-current (list (cons (intern key) value))))) | |
234 | ||
235 | (defun git-blame-current-commit () | |
236 | (let ((info (get-char-property (point) 'git-blame))) | |
237 | (if info | |
238 | (car info) | |
239 | (error "No commit info")))) | |
240 | ||
241 | (defun git-blame-identify (&optional hash) | |
242 | (interactive) | |
243 | (shell-command | |
244 | (format "git log -1 --pretty=oneline %s" (or hash | |
245 | (git-blame-current-commit))))) | |
b52ba1a5 JN |
246 | |
247 | (provide 'git-blame) | |
248 | ||
249 | ;;; git-blame.el ends here |