More git files
[emacs.git] / .emacs.d / elisp / mo-git-blame / mo-git-blame.el
1 ;;; mo-git-blame.el --- An interactive, iterative 'git blame' mode for Emacs
2
3 ;; Copyright (C) 2009, 2010 Moritz Bunkus <moritz@bunkus.org>
4 ;; Copyright (C) 2010 Štěpán Němec <stepnem@gmail.com>
5
6 ;; Author: Moritz Bunkus <moritz@bunkus.org>
7 ;; Maintainer: Moritz Bunkus <moritz@bunkus.org>
8 ;; Version: 20140409.320
9 ;; X-Original-Version: 0.1.0
10 ;; Keywords: tools
11
12 ;; mo-git-blame is free software; you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation; either version 3, or (at
15 ;; your option) any later version.
16 ;;
17 ;; mo-git-blame is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
21 ;;
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
26
27 ;;; Installation:
28 ;;;
29 ;;; Put this file somewhere in your load-path or add the directory it
30 ;;; is in to it, e.g.:
31 ;;;
32 ;;; (add-to-list 'load-path "~/.emacs.d/mo-git-blame")
33 ;;;
34 ;;; Then add two autoload definitions:
35 ;;;
36 ;;; (autoload 'mo-git-blame-file "mo-git-blame" nil t)
37 ;;; (autoload 'mo-git-blame-current "mo-git-blame" nil t)
38
39 (require 'cl)
40 (require 'easymenu)
41
42 (defvar mo-git-blame-vars nil
43 "Buffer-local plist that stores various variables needed for
44 interactive use, e.g. the file name, current revision etc.")
45
46 (defvar mo-git-blame--wincfg nil)
47
48 (defvar mo-git-blame-mode-map
49 (let ((map (make-keymap)))
50 (suppress-keymap map t)
51 (define-key map (kbd "a") 'mo-git-blame-reblame-for-ancestor-of-revision-at)
52 (define-key map (kbd "A") 'mo-git-blame-reblame-for-ancestor-of-current-revision)
53 (define-key map (kbd "b") 'mo-git-blame-reblame-for-revision-at)
54 (define-key map (kbd "B") 'mo-git-blame-reblame-for-specific-revision)
55 (define-key map (kbd "c") 'mo-git-blame-content-for-revision-at)
56 (define-key map (kbd "i") 'mo-git-blame-display-info)
57 (define-key map (kbd "l") 'mo-git-blame-log-for-revision-at)
58 (define-key map (kbd "L") 'mo-git-blame-log-for-current-revision)
59 (define-key map (kbd "o") 'mo-git-blame-overwrite-file-with-revision-at)
60 (define-key map (kbd "O") 'mo-git-blame-overwrite-file-with-current-revision)
61 (define-key map (kbd "p") 'mo-git-blame-reblame-for-prior-revision)
62 (define-key map (kbd "q") 'mo-git-blame-quit)
63 (define-key map (kbd "s") 'mo-git-blame-show-revision-at)
64 (define-key map (kbd "S") 'mo-git-blame-show-current-revision)
65 (define-key map (kbd "RET") 'mo-git-blame-show-revision-at)
66 (define-key map (kbd "TAB") 'mo-git-blame-display-content-buffer)
67 (define-key map [?\C-x ?k] 'mo-git-blame-quit)
68 (define-key map [?\C-x ?\C-l] 'mo-git-blame-goto-line)
69 map)
70 "The mode map for the blame output window of mo-git-blame-mode.")
71
72 (defvar mo-git-blame-content-mode-map
73 (let ((map (make-keymap)))
74 (suppress-keymap map t)
75 (define-key map (kbd "A") 'mo-git-blame-reblame-for-ancestor-of-current-revision)
76 (define-key map (kbd "B") 'mo-git-blame-reblame-for-specific-revision)
77 (define-key map (kbd "i") 'mo-git-blame-display-info)
78 (define-key map (kbd "L") 'mo-git-blame-log-for-current-revision)
79 (define-key map (kbd "O") 'mo-git-blame-overwrite-file-with-current-revision)
80 (define-key map (kbd "q") 'mo-git-blame-quit)
81 (define-key map (kbd "S") 'mo-git-blame-show-current-revision)
82 (define-key map [?\C-x ?k] 'mo-git-blame-quit)
83 (define-key map [?\C-x ?\C-l] 'mo-git-blame-goto-line)
84 map)
85 "The mode map for the content window of mo-git-blame-mode.")
86
87 (easy-menu-define mo-git-blame-mode-menu mo-git-blame-mode-map
88 "MoGitBlame menu"
89 '("MoGitBlame"
90 ["Re-blame for revision at point" mo-git-blame-reblame-for-revision-at t]
91 ["Re-blame for ancestor of revision at point" mo-git-blame-reblame-for-ancestor-of-revision-at t]
92 ["Raw content for revision at point" mo-git-blame-content-for-revision-at t]
93 ["Log for revision at point" mo-git-blame-log-for-revision-at t]
94 ["Overwrite file with revision at point" mo-git-blame-overwrite-file-with-revision-at t]
95 ["'git show' for revision at point" mo-git-blame-show-revision-at t]
96 "---"
97 ["Re-blame for ancestor of current revision" mo-git-blame-reblame-for-ancestor-of-current-revision t]
98 ["Log for current revision" mo-git-blame-log-for-current-revision t]
99 ["Overwrite file with current revision" mo-git-blame-overwrite-file-with-current-revision t]
100 ["'git show' for current revision" mo-git-blame-show-current-revision t]
101 "---"
102 ["Re-blame for prior revision" mo-git-blame-reblame-for-prior-revision t]
103 ["Re-blame for a specific revision" mo-git-blame-reblame-for-specific-revision t]
104 "---"
105 ["Display status information" mo-git-blame-display-info t]
106 ["Display content buffer" mo-git-blame-display-content-buffer t]
107 "---"
108 ["Exit MoGitBlame" mo-git-blame-quit t]))
109
110 (defgroup mo-git-blame nil
111 "Interactively use Git's 'blame' from Emacs."
112 :prefix "mo-git-blame-"
113 :group 'tools)
114
115 (defcustom mo-git-blame-git-executable "git"
116 "The name of the Git executable."
117 :group 'mo-git-blame
118 :type 'string)
119
120 (defcustom mo-git-blame-git-blame-args ""
121 "Additional arguments to pass to git blame."
122 :group 'mo-git-blame
123 :type 'string)
124
125
126 (defcustom mo-git-blame-incremental t
127 "Runs `git blame' in the background with the --incremental
128 option if this variable is non-nil."
129 :group 'mo-git-blame
130 :type '(choice (const :tag "Use --incremental" t)
131 (const :tag "Don't use --incremental" nil)))
132
133 (defcustom mo-git-blame-blame-window-width 45
134 "The width of the 'blame' window leaving the rest for the
135 'content' window."
136 :group 'mo-git-blame
137 :type 'integer)
138
139 (defcustom mo-git-blame-use-ido 'if-available
140 "Controls whether or not ido will be used. Possible choices:
141
142 `never' -- do not use ido even if it is loaded
143 `if-available' -- use ido if it has been loaded before
144 `always' -- automatically load ido and use it"
145 :group 'mo-git-blame
146 :type '(choice (const :tag "Always" always)
147 (const :tag "If available" if-available)
148 (const :tag "Never" never)))
149
150 (defcustom mo-git-blame-use-magit 'if-available
151 "Controls whether or not magit will be used. Possible choices:
152
153 `never' -- do not use magit even if it is loaded
154 `if-available' -- use magit if it has been loaded before
155 `always' -- automatically load magit and use it"
156 :group 'mo-git-blame
157 :type '(choice (const :tag "Always" always)
158 (const :tag "If available" if-available)
159 (const :tag "Never" never)))
160
161 ;; This function was taken from magit (called 'magit-trim-line' there).
162 (defun mo-git-blame-trim-line (str)
163 (cond ((string= str "")
164 nil)
165 ((equal (elt str (- (length str) 1)) ?\n)
166 (substring str 0 (- (length str) 1)))
167 (t str)))
168
169 ;; This function was taken from magit (called 'magit-git-output' there).
170 (defun mo-git-blame-git-output (args)
171 (with-output-to-string
172 (with-current-buffer standard-output
173 (apply #'process-file
174 mo-git-blame-git-executable
175 nil (list t nil) nil
176 args))))
177
178 ;; This function was taken from magit (called 'magit-git-string' there).
179 (defun mo-git-blame-git-string (&rest args)
180 (mo-git-blame-trim-line (mo-git-blame-git-output args)))
181
182 (defun mo-git-blame-get-top-dir (cwd)
183 (let* ((cwd (expand-file-name cwd))
184 (git-dir (or (getenv "GIT_WORK_TREE")
185 (if (file-directory-p cwd)
186 (let* ((default-directory cwd)
187 (dir (mo-git-blame-git-string "rev-parse" "--show-toplevel"))
188 (dir (concat (or (file-remote-p cwd) "") dir)))
189 (if (and dir (file-directory-p dir))
190 (file-name-as-directory dir)))))))
191 (or git-dir
192 (error "No Git repository found"))))
193
194 (defun mo-git-blame-run (&rest args)
195 (message "Running 'git %s'..." (car args))
196 (apply 'shell-command
197 (apply 'concat mo-git-blame-git-executable
198 (mapcar (lambda (arg)
199 (concat " " (shell-quote-argument arg)))
200 args))
201 (current-buffer) nil)
202 (message "Running 'git %s'... done" (car args)))
203
204 (defvar mo-git-blame-process nil)
205 (defvar mo-git-blame-client-buffer nil)
206
207 (defun mo-git-blame-assert-not-running ()
208 "Exits with an error if `mo-git-blame-incremental' is true and
209 git is already/still running."
210 (if (and mo-git-blame-incremental
211 mo-git-blame-process
212 (get-buffer "*mo-git-blame-process*"))
213 (error "Git is already running")))
214
215 (defun mo-git-blame-process-sentinel (process event)
216 (let ((msg (format "Git %s." (substring event 0 -1)))
217 (successp (string-match "^finished" event)))
218 (with-current-buffer (process-buffer process)
219 (let ((inhibit-read-only t))
220 (goto-char (point-max))
221 (insert msg "\n")
222 (message msg)))
223 (setq mo-git-blame-process nil)
224 (message "Running 'git blame'... done")))
225
226 (defun mo-git-blame-commit-info-to-time (entry)
227 (let* ((tz (plist-get entry :author-tz))
228 (mult (if (string= "+" (substring tz 0 1)) 1 -1))
229 (hours (string-to-number (substring tz 1 3)))
230 (minutes (string-to-number (substring tz 3 5))))
231 (seconds-to-time (+ (string-to-number (plist-get entry :author-time))
232 (* mult
233 (+ (* minutes 60)
234 (* hours 3600)))))))
235
236 (defun mo-git-blame-process-filter-process-entry (entry)
237 (with-current-buffer (plist-get mo-git-blame-vars :blame-buffer)
238 (save-excursion
239 (let ((inhibit-read-only t)
240 (info (format "%s (%s %s %s) %s"
241 (substring (symbol-name (plist-get entry :hash)) 0 8)
242 (plist-get entry :author)
243 (format-time-string "%Y-%m-%d %T" (mo-git-blame-commit-info-to-time entry) t)
244 (plist-get entry :author-tz)
245 (plist-get entry :filename)))
246 i)
247 (mo-git-blame-goto-line-markless (plist-get entry :result-line))
248 (dotimes (i (plist-get entry :num-lines))
249 (insert info)
250 (goto-char (line-beginning-position 2)))))))
251
252 (defun mo-git-blame-set-entry (key value)
253 (let ((plist (or (plist-get mo-git-blame-data mo-git-blame-curr-entry)
254 (list :hash mo-git-blame-curr-entry))))
255 (setq mo-git-blame-data
256 (plist-put mo-git-blame-data
257 mo-git-blame-curr-entry
258 (plist-put plist key value)))))
259
260 (defun mo-git-blame-process-filter (process string)
261 (with-current-buffer (process-buffer process)
262 (let ((inhibit-read-only t)
263 done matched)
264 (save-excursion
265 (goto-char (process-mark process))
266 (insert string)
267 (set-marker (process-mark process) (point)))
268 (while (not done)
269 (goto-char (line-end-position))
270 (setq done (= (point) (point-max)))
271 (goto-char (line-beginning-position))
272 (unless done
273 (setq matched t)
274 (cond ((and (not mo-git-blame-curr-entry)
275 (looking-at "^\\([a-fA-F0-9]\\{40\\}\\) +\\([0-9]+\\) +\\([0-9]+\\) +\\([0-9]+\\)$"))
276 ;; SHA line, beginning of entry
277 (setq mo-git-blame-curr-entry (intern (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
278 (mo-git-blame-set-entry :source-line (string-to-number (buffer-substring-no-properties (match-beginning 2) (match-end 2))))
279 (mo-git-blame-set-entry :result-line (string-to-number (buffer-substring-no-properties (match-beginning 3) (match-end 3))))
280 (mo-git-blame-set-entry :num-lines (string-to-number (buffer-substring-no-properties (match-beginning 4) (match-end 4))))
281 )
282
283 ((and mo-git-blame-curr-entry
284 (looking-at "^filename +\\(.+\\)$"))
285 ;; filename line, end of entry
286 (mo-git-blame-set-entry :filename (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
287 (mo-git-blame-process-filter-process-entry (plist-get mo-git-blame-data mo-git-blame-curr-entry))
288 (setq mo-git-blame-curr-entry nil)
289 )
290 ((and mo-git-blame-curr-entry
291 (looking-at "^\\([a-zA-Z0-9-]+\\) +\\(.+\\)$"))
292 ;; property line
293 (mo-git-blame-set-entry (intern (concat ":" (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
294 (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
295 )
296
297 (t (setq matched nil)))
298 (forward-line 1))))))
299
300 (defun mo-git-blame-run* (&rest args)
301 (message "Running 'git blame'...")
302 (let ((buf (get-buffer-create "*mo-git-blame-process*"))
303 (cmd (car args))
304 (dir default-directory)
305 (vars mo-git-blame-vars))
306 (save-excursion
307 (set-buffer buf)
308 (setq buffer-read-only t)
309 (let ((inhibit-read-only t))
310 (set (make-local-variable 'mo-git-blame-data) nil)
311 (set (make-local-variable 'mo-git-blame-curr-entry) nil)
312 (set (make-local-variable 'mo-git-blame-vars) vars)
313 (setq default-directory dir
314 mo-git-blame-process (apply 'start-file-process cmd buf mo-git-blame-git-executable args))
315 (set-process-sentinel mo-git-blame-process 'mo-git-blame-process-sentinel)
316 (set-process-filter mo-git-blame-process 'mo-git-blame-process-filter)))))
317
318 (defun mo-git-blame-get-output-buffer ()
319 (let* ((name "*mo-git-blame-output*")
320 (buffer (get-buffer name)))
321 (if (null buffer)
322 (progn
323 (setq buffer (get-buffer-create name))
324 (with-current-buffer buffer
325 (use-local-map mo-git-blame-mode-map))))
326 buffer))
327
328 (defun mo-git-blame-parse-rev (revision)
329 (let ((result (mo-git-blame-git-string "rev-parse" "--short" revision)))
330 (unless result
331 (error "Unparseable revision %s" revision))
332 result))
333
334 (defun mo-git-blame-parse-blame-line ()
335 (save-excursion
336 (save-match-data
337 (beginning-of-line)
338 (cond ((looking-at "^\\([a-f0-9]+\\) +\\(([^)]+)\\) *$")
339 (list :hash (buffer-substring (match-beginning 1) (match-end 1))
340 :file-name (plist-get mo-git-blame-vars :file-name)
341 :timestamp (buffer-substring (match-beginning 2) (match-end 2))))
342 ((looking-at "^\\([a-f0-9]+\\) +\\(([^)]+)\\) +\\(.+\\)")
343 (list :hash (buffer-substring (match-beginning 1) (match-end 1))
344 :file-name (buffer-substring (match-beginning 3) (match-end 3))
345 :timestamp (buffer-substring (match-beginning 2) (match-end 2))))
346 (t (error "Not a 'git blame' line"))))))
347
348 (defun mo-git-blame-revision-at-point ()
349 (plist-get (mo-git-blame-parse-blame-line) :hash))
350
351 (defun mo-git-blame-log-for-revision (revision)
352 (let ((file-name (plist-get mo-git-blame-vars :file-name))
353 (buffer (mo-git-blame-get-output-buffer)))
354 (with-current-buffer buffer
355 (erase-buffer)
356 (mo-git-blame-run "log" revision "--" file-name)
357 (goto-char (point-min)))
358 (display-buffer buffer)))
359
360 (defun mo-git-blame-log-for-revision-at ()
361 "Calls 'git log' for revision in the current line."
362 (interactive)
363 (mo-git-blame-log-for-revision (mo-git-blame-revision-at-point)))
364
365 (defun mo-git-blame-log-for-current-revision ()
366 "Calls 'git log' for the buffer's current revision and file."
367 (interactive)
368 (mo-git-blame-log-for-revision (plist-get mo-git-blame-vars :current-revision)))
369
370 (defun mo-git-blame-show-revision--diff-mode (revision)
371 "Internal function that fills the current buffer with revision using diff-mode"
372 (erase-buffer)
373 (mo-git-blame-run "show" revision)
374 (goto-char (point-min))
375 (diff-mode))
376
377 (defun mo-git-blame-show-revision--magit (revision)
378 "Internal function that fills the current buffer with revision using magit"
379 (let ((magit-commit-buffer-name (buffer-name)))
380 (magit-show-commit revision)))
381
382 (defun mo-git-blame-show-revision (revision)
383 (let ((buffer (mo-git-blame-get-output-buffer))
384 (the-func (cond ((eq mo-git-blame-use-magit 'always)
385 (require 'magit)
386 'mo-git-blame-show-revision--magit)
387 ((and (eq mo-git-blame-use-magit 'if-available)
388 (functionp 'magit-show-commit))
389 'mo-git-blame-show-revision--magit)
390 (t 'mo-git-blame-show-revision--diff-mode))))
391 (with-current-buffer buffer
392 (funcall the-func revision))
393 (display-buffer buffer)))
394
395 (defun mo-git-blame-show-revision-at ()
396 "Calls 'git show' for the revision in the current line."
397 (interactive)
398 (mo-git-blame-show-revision (mo-git-blame-revision-at-point)))
399
400 (defun mo-git-blame-show-current-revision ()
401 "Calls 'git show' for the current revision."
402 (interactive)
403 (mo-git-blame-show-revision (plist-get mo-git-blame-vars :current-revision)))
404
405 (defun mo-git-blame-content-for-revision-at ()
406 "Calls 'git cat-file' for the revision in the current line."
407 (interactive)
408 (let ((info (mo-git-blame-parse-blame-line))
409 (buffer (mo-git-blame-get-output-buffer)))
410 (with-current-buffer buffer
411 (erase-buffer)
412 (mo-git-blame-run "cat-file" "blob" (concat (plist-get info :hash) ":" (plist-get info :file-name)))
413 (goto-char (point-min)))
414 (display-buffer buffer)))
415
416 (defun mo-git-blame-overwrite-file-with-revision (revision)
417 (let ((file-name (plist-get mo-git-blame-vars :original-file-name)))
418 (if (yes-or-no-p (format "Do you really want to overwrite %s with revision %s " file-name revision))
419 (progn
420 (find-file (concat (plist-get mo-git-blame-vars :top-dir) file-name))
421 (erase-buffer)
422 (mo-git-blame-run "cat-file" "blob" (concat revision ":" file-name))
423 (goto-char (point-min))))))
424
425 (defun mo-git-blame-overwrite-file-with-revision-at ()
426 "Calls 'git cat-file' for the revision in the current line and overwrites
427 the original file's content. The file is not saved but left modified in an
428 open buffer."
429 (interactive)
430 (mo-git-blame-overwrite-file-with-revision (mo-git-blame-revision-at-point)))
431
432 (defun mo-git-blame-overwrite-file-with-current-revision ()
433 "Calls 'git cat-file' for the current revision and overwrites
434 the original file's content. The file is not saved but left modified in an
435 open buffer."
436 (interactive)
437 (mo-git-blame-overwrite-file-with-revision (plist-get mo-git-blame-vars :current-revision)))
438
439 (defun mo-git-blame-reblame-for-ancestor-of-revision-at (&optional arg)
440 "Calls 'git blame' for the ancestor of the revision in the current line.
441
442 With a numeric prefix argument ARG only the ARG lines before and
443 after point are blamed by using git blame's `-L'
444 option. Otherwise the whole file is blamed."
445 (interactive "P")
446 (mo-git-blame-reblame-for-specific-revision (mo-git-blame-parse-rev (concat (plist-get (mo-git-blame-parse-blame-line) :hash) "~")) arg))
447
448 (defun mo-git-blame-reblame-for-ancestor-of-current-revision (&optional arg)
449 "Calls 'git blame' for the ancestor of the current revision.
450
451 With a numeric prefix argument ARG only the ARG lines before and
452 after point are blamed by using git blame's `-L'
453 option. Otherwise the whole file is blamed."
454 (interactive "P")
455 (mo-git-blame-reblame-for-specific-revision (mo-git-blame-parse-rev (concat (plist-get mo-git-blame-vars :current-revision) "~")) arg))
456
457 (defun mo-git-blame-reblame-for-revision-at (&optional arg)
458 "Calls 'git blame' for the revision in the current line.
459
460 With a numeric prefix argument ARG only the ARG lines before and
461 after point are blamed by using git blame's `-L'
462 option. Otherwise the whole file is blamed."
463 (interactive "P")
464 (let* ((info (mo-git-blame-parse-blame-line))
465 (revision (plist-get info :hash)))
466 (if (string= revision (plist-get mo-git-blame-vars :current-revision))
467 (error "Already showing this revision"))
468 (mo-git-blame-file (concat (plist-get mo-git-blame-vars :top-dir) (plist-get info :file-name)) revision (plist-get mo-git-blame-vars :original-file-name) arg)))
469
470 (defun mo-git-blame-reblame-for-specific-revision (&optional revision arg)
471 "Calls 'git blame' for a specific REVISION.
472
473 With a numeric prefix argument ARG only the ARG lines before and
474 after point are blamed by using git blame's `-L'
475 option. Otherwise the whole file is blamed."
476 (interactive "sRevision: \nP")
477 (setq revision (mo-git-blame-parse-rev revision))
478 (if (string= revision (plist-get mo-git-blame-vars :current-revision))
479 (error "Already showing this revision"))
480 (mo-git-blame-file (concat (plist-get mo-git-blame-vars :top-dir) (plist-get mo-git-blame-vars :file-name)) revision (plist-get mo-git-blame-vars :original-file-name) arg))
481
482 (defun mo-git-blame-reblame-for-prior-revision (&optional arg)
483 "Calls 'git blame' for the revision shown before the current
484 one (see `prior revisions' in the info output of
485 `mo-git-blame-display-info').
486
487 With a numeric prefix argument ARG only the ARG lines before and
488 after point are blamed by using git blame's `-L'
489 option. Otherwise the whole file is blamed."
490 (interactive "P")
491 (let ((rev-list (plist-get mo-git-blame-vars :prior-revisions))
492 revision-plist)
493 (unless rev-list
494 (error "No revision shown prior to the current one"))
495 (setq revision-plist (car rev-list))
496 (mo-git-blame-file (plist-get revision-plist :full-file-name)
497 (plist-get revision-plist :revision)
498 (plist-get mo-git-blame-vars :original-file-name)
499 arg)))
500
501 (defun mo-git-blame-display-info ()
502 "Displays short information about the current revision."
503 (interactive)
504 (let* ((buffer (mo-git-blame-get-output-buffer))
505 (vars mo-git-blame-vars)
506 (prior-revs (plist-get vars :prior-revisions))
507 (prior-revs-str (if prior-revs
508 (reduce (lambda (joined element) (concat (or joined "") (if joined " " "") element))
509 (mapcar (lambda (element) (plist-get element :revision))
510 prior-revs))
511 "none")))
512 (with-current-buffer buffer
513 (erase-buffer)
514 (insert (format "Current revision: %s\n" (plist-get vars :current-revision))
515 (format "Prior revisions: %s\n" prior-revs-str)
516 (format "Git repository: %s\n" (plist-get vars :top-dir))
517 (format "Original file name: %s\n" (file-relative-name (plist-get vars :original-file-name)
518 (plist-get vars :top-dir)))
519 (format "Current file name: %s\n" (plist-get vars :file-name)))
520 (goto-char (point-min)))
521 (display-buffer buffer)))
522
523 (defun mo-git-blame-number-of-content-lines ()
524 (with-current-buffer (plist-get mo-git-blame-vars :content-buffer)
525 (save-excursion
526 (goto-char (point-max))
527 (line-number-at-pos))))
528
529 (defun mo-git-blame-mode ()
530 "Show the output of 'git blame' and the content of the file in
531 two frames side-by-side. Allows iterative re-blaming for specific
532 revisions. Can show the output of 'git log' and 'git show'. Can
533 overwrite the file with the content of specific revisions by
534 calling 'git cat-file blob ...'.
535
536 Use 'mo-git-blame-current' interactively or 'mo-git-blame-file'
537 from elisp.
538
539 \\{mo-git-blame-mode-map}"
540 (setq major-mode 'mo-git-blame-mode
541 mode-name "MoGitBlame"
542 mode-line-process ""
543 truncate-lines t)
544 (use-local-map mo-git-blame-mode-map))
545
546 (defun mo-git-blame--make-args (args)
547 (delete ""
548 (append (list mo-git-blame-git-blame-args)
549 args)))
550
551 (defun mo-git-blame-run-blame-normally (start-line lines-to-blame)
552 (let* ((num-content-lines (mo-git-blame-number-of-content-lines))
553 (num-lines-to-append (if (and start-line
554 (< (+ start-line lines-to-blame)
555 num-content-lines))
556 (- num-content-lines start-line lines-to-blame)))
557 args i)
558 (if (and start-line (> start-line 1))
559 (dotimes (i (1- start-line))
560 (insert "\n")))
561
562 (setq args (list (plist-get mo-git-blame-vars :current-revision) "--" (plist-get mo-git-blame-vars :file-name)))
563 (if start-line
564 (setq args (append (list "-L" (format "%d,+%d" start-line lines-to-blame))
565 args)))
566 (apply 'mo-git-blame-run "blame" (mo-git-blame--make-args args))
567
568 (if num-lines-to-append
569 (dotimes (i num-lines-to-append)
570 (insert "\n")))))
571
572 (defun mo-git-blame-run-blame-incrementally (start-line lines-to-blame)
573 (let* ((num-content-lines (mo-git-blame-number-of-content-lines))
574 i)
575 (dotimes (i (1- num-content-lines))
576 (insert "\n"))
577
578 (setq args (list "--incremental" (plist-get mo-git-blame-vars :current-revision) "--" (plist-get mo-git-blame-vars :file-name)))
579 (if start-line
580 (setq args (append (list "-L" (format "%d,+%d" start-line lines-to-blame))
581 args)))
582 (mo-git-blame-assert-not-running)
583 (apply 'mo-git-blame-run* "blame" (mo-git-blame--make-args args))))
584
585 (defun mo-git-blame-init-blame-buffer (start-line lines-to-blame)
586 (if mo-git-blame-incremental
587 (mo-git-blame-run-blame-incrementally start-line lines-to-blame)
588 (mo-git-blame-run-blame-normally start-line lines-to-blame))
589 (goto-char (point-min))
590 (save-match-data
591 (while (re-search-forward "^\\([a-f0-9]+\\) +\\(([^)]+)\\) \\(.*\\)" nil t)
592 (replace-match "\\1 \\2" nil nil))
593 (goto-char (point-min))
594 (while (re-search-forward "^\\([a-f0-9]+\\) +\\([^ ]+\\) +\\(([^)]+)\\) \\(.*\\)" nil t)
595 (replace-match "\\1 \\3 \\2" nil nil))
596 (goto-char (point-min))
597 (while (re-search-forward " +[0-9]+)" nil t)
598 (replace-match ")" nil nil)))
599 (toggle-read-only t)
600 (goto-char (point-min))
601 (set (make-local-variable 'line-move-visual) nil))
602
603 (defun mo-git-blame-init-content-buffer ()
604 (let ((vars mo-git-blame-vars))
605 (rename-buffer (concat "*mo-git-blame:" (file-name-nondirectory (plist-get vars :full-file-name)) ":" (plist-get vars :current-revision) "*"))
606 (setq buffer-file-name (file-name-nondirectory (plist-get vars :full-file-name))
607 default-directory (plist-get vars :top-dir))
608 (mo-git-blame-run "cat-file" "blob" (concat (plist-get vars :current-revision) ":" (plist-get vars :file-name)))
609 (normal-mode)
610 (use-local-map mo-git-blame-content-mode-map)
611 (font-lock-fontify-buffer)
612 (toggle-read-only t)
613 (set-buffer-modified-p nil)
614 (setq truncate-lines t)
615 (set (make-local-variable 'mo-git-blame-vars) vars)
616 (set (make-local-variable 'line-move-visual) nil)))
617
618 (defun mo-git-blame-read-file-name ()
619 "Calls `read-file-name' or `ido-read-file-name' depending on
620 the value of `mo-git-blame-use-ido'."
621 (let ((the-func (cond ((eq mo-git-blame-use-ido 'always)
622 (require 'ido)
623 'ido-read-file-name)
624 ((and (eq mo-git-blame-use-ido 'if-available)
625 (functionp 'ido-read-file-name))
626 'ido-read-file-name)
627 (t 'read-file-name))))
628 (funcall the-func "File for 'git blame': " nil nil t)))
629
630 ;;;###autoload
631 (defun mo-git-blame-file (&optional file-name revision original-file-name num-lines-to-blame)
632 "Calls `git blame' for REVISION of FILE-NAME or `HEAD' if
633 REVISION is not given. Initializes the two windows that will show
634 the output of 'git blame' and the content.
635
636 If FILE-NAME is missing it will be read with `find-file' in
637 interactive mode.
638
639 ORIGINAL-FILE-NAME defaults to FILE-NAME if not given. This is
640 used for tracking renaming and moving of files during iterative
641 re-blaming.
642
643 With a numeric prefix argument or with NUM-LINES-TO-BLAME only
644 the NUM-LINES-TO-BLAME lines before and after point are blamed by
645 using git blame's `-L' option. Otherwise the whole file is
646 blamed."
647 (interactive)
648 (mo-git-blame-assert-not-running)
649 (unless mo-git-blame--wincfg
650 (setq mo-git-blame--wincfg (current-window-configuration)))
651 (let* ((file-name (or file-name (mo-git-blame-read-file-name)))
652 (has-blame-vars (local-variable-p 'mo-git-blame-vars))
653 (the-raw-revision (or revision "HEAD"))
654 (the-revision (if (string= the-raw-revision "HEAD")
655 (mo-git-blame-parse-rev "HEAD")
656 the-raw-revision))
657 (base-name (concat (file-name-nondirectory file-name) "@" the-revision))
658 (blame-buffer (get-buffer-create "*mo-git-blame*"))
659 (content-buffer-name (concat "*mo-git-blame:" (file-name-nondirectory file-name) ":" the-revision "*"))
660 (content-buffer (if has-blame-vars
661 (plist-get mo-git-blame-vars :content-buffer)
662 (get-buffer-create content-buffer-name)))
663 (top-dir (mo-git-blame-get-top-dir (file-name-directory file-name)))
664 (relative-file-name (file-relative-name file-name top-dir))
665 (blame-window (selected-window))
666 (prior-vars (if has-blame-vars mo-git-blame-vars))
667 (line-to-go-to (line-number-at-pos))
668 (lines-to-blame (or num-lines-to-blame
669 (if (and current-prefix-arg (> (prefix-numeric-value current-prefix-arg) 0))
670 (prefix-numeric-value current-prefix-arg))))
671 content-window the-buffer prior-revisions start-line)
672 (switch-to-buffer blame-buffer)
673 (setq prior-revisions (if prior-vars (plist-get prior-vars :prior-revisions)))
674 (setq prior-revisions
675 (if (and prior-revisions (string= the-revision (plist-get (car prior-revisions) :revision)))
676 (cdr prior-revisions)
677 (if prior-vars
678 (cons (list :full-file-name (plist-get prior-vars :full-file-name)
679 :revision (plist-get prior-vars :current-revision))
680 prior-revisions))))
681 (if (window-full-width-p)
682 (split-window-horizontally mo-git-blame-blame-window-width))
683 (select-window (setq content-window (next-window)))
684 (switch-to-buffer content-buffer)
685 (select-window blame-window)
686 (dolist (the-buffer (list blame-buffer content-buffer))
687 (with-current-buffer the-buffer
688 (toggle-read-only 0)
689 (kill-all-local-variables)
690 (buffer-disable-undo)
691 (erase-buffer)
692 (setq default-directory top-dir)
693 (set (make-local-variable 'mo-git-blame-vars)
694 (list :top-dir top-dir
695 :file-name relative-file-name
696 :full-file-name file-name
697 :original-file-name (or original-file-name file-name)
698 :current-revision the-revision
699 :prior-revisions prior-revisions
700 :blame-buffer blame-buffer
701 :blame-window blame-window
702 :content-buffer content-buffer
703 :content-window content-window))))
704 (with-current-buffer content-buffer
705 (mo-git-blame-init-content-buffer))
706 (when lines-to-blame
707 (setq start-line (max 1 (- line-to-go-to lines-to-blame))
708 lines-to-blame (1+ (- (+ line-to-go-to lines-to-blame)
709 start-line))))
710 (with-current-buffer blame-buffer
711 (mo-git-blame-mode)
712 (mo-git-blame-init-blame-buffer start-line lines-to-blame))
713 (mo-git-blame-goto-line line-to-go-to)
714 (add-to-list 'window-scroll-functions 'mo-git-blame-window-scrolled)))
715
716 (defvar mo-git-blame-scroll-info
717 nil
718 "Information which window to scroll and where to scroll to.")
719
720 (defun mo-git-blame-window-scrolled (window new-start-pos)
721 (if (and window
722 (eq window (selected-window))
723 (local-variable-p 'mo-git-blame-vars))
724 (let* ((vars (with-current-buffer (window-buffer window) mo-git-blame-vars))
725 (start-line (line-number-at-pos new-start-pos))
726 (point-line (line-number-at-pos (window-point window)))
727 (window-to-scroll (if (eq window (plist-get vars :blame-window))
728 (plist-get vars :content-window)
729 (plist-get vars :blame-window))))
730 (setq mo-git-blame-scroll-info (list :window-to-scroll window-to-scroll
731 :start-line start-line
732 :point-line point-line))
733 (run-at-time "0 sec" nil 'mo-git-blame-update-other-window-after-scrolling))))
734
735 (defun mo-git-blame-update-other-window-after-scrolling ()
736 (if mo-git-blame-scroll-info
737 (let ((window (plist-get mo-git-blame-scroll-info :window-to-scroll))
738 new-start-pos)
739 (with-selected-window window
740 (with-current-buffer (window-buffer window)
741 (goto-char (point-min))
742 (setq new-start-pos (line-beginning-position (plist-get mo-git-blame-scroll-info :start-line)))
743 (goto-char (point-min))
744 (goto-char (line-beginning-position (plist-get mo-git-blame-scroll-info :point-line)))
745 (set-window-start window new-start-pos)))
746 (setq mo-git-blame-scroll-info nil))))
747
748 (defun mo-git-blame-quit ()
749 "Kill the mo-git-blame buffers."
750 (interactive)
751 (setq window-scroll-functions (remq 'mo-git-blame-window-scrolled window-scroll-functions))
752 (let ((buffer))
753 (dolist (buffer (buffer-list))
754 (if (string-match-p "^\\*mo-git-blame" (buffer-name buffer))
755 (kill-buffer buffer))))
756 (set-window-configuration mo-git-blame--wincfg)
757 (setq mo-git-blame--wincfg nil))
758
759 (defun mo-git-blame-display-content-buffer ()
760 "Show the content buffer in the content window."
761 (interactive)
762 ;; Declare buffer here because mo-git-blame-vars might not be available in the other buffer.
763 (let ((buffer (plist-get mo-git-blame-vars :content-buffer))
764 (line-num (line-number-at-pos)))
765 (mo-git-blame-goto-line-markless line-num)
766 (recenter)
767 (with-selected-window (plist-get mo-git-blame-vars :content-window)
768 (switch-to-buffer buffer)
769 (mo-git-blame-goto-line-markless line-num)
770 (recenter))))
771
772 (defun mo-git-blame-other-buffer ()
773 (plist-get mo-git-blame-vars
774 (if (eq (current-buffer) (plist-get mo-git-blame-vars :blame-buffer))
775 :content-buffer
776 :blame-buffer)))
777
778 (defun mo-git-blame-goto-line-markless (line)
779 (goto-char (point-min))
780 (goto-char (line-beginning-position line)))
781
782 (defun mo-git-blame-goto-line (line)
783 "Goto a line in both the blame and the content buffer."
784 (interactive "nGoto line: ")
785 (with-selected-window (plist-get mo-git-blame-vars :blame-window)
786 (mo-git-blame-goto-line-markless line))
787 (with-selected-window (plist-get mo-git-blame-vars :content-window)
788 (mo-git-blame-goto-line-markless line)))
789
790 ;;;###autoload
791 (defun mo-git-blame-current ()
792 "Calls `mo-git-blame-file' for HEAD for the current buffer."
793 (interactive)
794 (if (null (buffer-file-name))
795 (error "The current buffer is not associated with a file."))
796 (mo-git-blame-file (file-truename (buffer-file-name))))
797
798 ;;;###autoload
799 (defun mo-git-blame-current-for-revision (revision)
800 "Calls `mo-git-blame-file' for `revision' for the current buffer."
801 (interactive "sRevision: ")
802 (if (null (buffer-file-name))
803 (error "The current buffer is not associated with a file."))
804 (mo-git-blame-file (file-truename (buffer-file-name)) revision))
805
806 (provide 'mo-git-blame)
807
808 ;; Leave this in for debugging purposes:
809 ;; (global-set-key [?\C-c ?i ?b] (lambda () (interactive) (let ((mo-git-blame-incremental t)) (mo-git-blame-current))))
810 ;; (global-set-key [?\C-c ?i ?B] (lambda () (interactive) (let ((mo-git-blame-incremental nil)) (mo-git-blame-current))))
811
812 ;;; mo-git-blame.el ends here