git-blame.el

Here's another version of git-blame.el that automatically tries to create a sensible list of colors to use for both light and dark backgrounds. Plus a few minor fixes.

To use:

1) Load into emacs: M-x load-file RET git-blame.el RET
2) Open a git-controlled file
3) Blame: M-x git-blame-mode

;;; git-blame.el
;; David Kågedal

(defun color-scale (l)
(let* ((colors ())
r g b)
(setq r l)
(while r
(setq g l)
(while g
(setq b l)
(while b
(push (concat "#" (car r) (car g) (car b)) colors) (pop b))
(pop g))
(pop r))
colors))

(defvar git-blame-dark-colors
(color-scale '("00" "04" "08" "0c"

                 "10" "14" "18" "1c"
                 "20" "24" "28" "2c"
                 "30" "34" "38" "3c")))

(defvar git-blame-light-colors
(color-scale '("c0" "c4" "c8" "cc"

                 "d0" "d4" "d8" "dc"
                 "e0" "e4" "e8" "ec"
                 "f0" "f4" "f8" "fc")))

(defvar git-blame-ancient-color "dark green")

(defvar git-blame-overlays nil)
(defvar git-blame-cache nil)

(defvar git-blame-mode nil) (make-variable-buffer-local 'git-blame-mode) (push (list 'git-blame-mode " blame") minor-mode-alist)

(defun git-blame-mode (&optional arg)
(interactive "P")
(if arg
(setq git-blame-mode (eq arg 1))
(setq git-blame-mode (not git-blame-mode)))
(make-local-variable 'git-blame-overlays) (make-local-variable 'git-blame-colors) (make-local-variable 'git-blame-cache)
(let ((bgmode (cdr (assoc 'background-mode (frame-parameters)))))
(if (eq bgmode 'dark)
(setq git-blame-colors git-blame-dark-colors)
(setq git-blame-colors git-blame-light-colors)))
(if git-blame-mode

      (git-blame-run)
    (git-blame-cleanup)))

(defun git-blame-run ()
(let* ((display-buf (current-buffer))
(blame-buf (get-buffer-create
(concat " git blame for " (buffer-name))))
(proc (start-process "git-blame" blame-buf
"git" "blame" "--incremental" (file-name-nondirectory buffer-file-name))))
(mapcar 'delete-overlay git-blame-overlays)
(setq git-blame-overlays nil)
(setq git-blame-cache (make-hash-table :test 'equal)) (with-current-buffer blame-buf
(erase-buffer)
(make-local-variable 'git-blame-file) (make-local-variable 'git-blame-current)
(setq git-blame-file display-buf)
(setq git-blame-current nil))
(set-process-filter proc 'git-blame-filter) (set-process-sentinel proc 'git-blame-sentinel)))

(defun git-blame-cleanup ()
"Remove all blame properties"
(mapcar 'delete-overlay git-blame-overlays)
(setq git-blame-overlays nil)
(let ((modified (buffer-modified-p)))
(remove-text-properties (point-min) (point-max) '(point-entered nil)) (set-buffer-modified-p modified)))

(defun git-blame-sentinel (proc status)
;;(kill-buffer (process-buffer proc))
(message "git blame finished"))

(defvar in-blame-filter nil)

(defun git-blame-filter (proc str)
(save-excursion

    (set-buffer (process-buffer proc))
    (goto-char (process-mark proc))
    (insert-before-markers str)
    (goto-char 0)
    (unless in-blame-filter
      (let ((more t)
            (in-blame-filter t))
        (while more
          (setq more (git-blame-parse)))))))

(defun git-blame-parse ()
(cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n")

         (let ((hash (match-string 1))
               (src-line (string-to-number (match-string 2)))
               (res-line (string-to-number (match-string 3)))
               (num-lines (string-to-number (match-string 4))))
           (setq git-blame-current
                 (git-blame-new-commit
                  hash src-line res-line num-lines)))
         (delete-region (point) (match-end 0))
         t)
        ((looking-at "filename \\(.+\\)\n")
         (let ((filename (match-string 1)))
           (git-blame-add-info "filename" filename))
         (delete-region (point) (match-end 0))
         t)
        ((looking-at "\\([a-z-]+\\) \\(.+\\)\n")
         (let ((key (match-string 1))
               (value (match-string 2)))
           (git-blame-add-info key value))
         (delete-region (point) (match-end 0))
         t)
        ((looking-at "boundary\n")
         (setq git-blame-current nil)
         (delete-region (point) (match-end 0))
         t)
        (t
         nil)))

(defun git-blame-new-commit (hash src-line res-line num-lines)
(save-excursion
(set-buffer git-blame-file)
(let ((info (gethash hash git-blame-cache))
(inhibit-point-motion-hooks t))
(when (not info)
(let ((color (pop git-blame-colors)))
(unless color
(setq color git-blame-ancient-color))
(setq info (list hash src-line res-line num-lines
(cons 'color color))))
(puthash hash info git-blame-cache))
(goto-line res-line)
(while (> num-lines 0)
(if (get-text-property (point) 'git-blame)
(forward-line)
(let* ((start (point))
(end (progn (forward-line 1) (point)))
(ovl (make-overlay start end)))
(push ovl git-blame-overlays)
(overlay-put ovl 'git-blame info)
(overlay-put ovl 'help-echo hash)
(overlay-put ovl 'face (list :background
(cdr (assq 'color (cddddr info)))))
;;(overlay-put ovl 'point-entered
;; `(lambda (x y) (git-blame-identify ,hash)))
(let ((modified (buffer-modified-p)))
(put-text-property (if (= start 1) start (1- start)) (1- end)
'point-entered
`(lambda (x y) (git-blame-identify ,hash)))
(set-buffer-modified-p modified))))
(setq num-lines (1- num-lines))))))

(defun git-blame-add-info (key value)
(if git-blame-current
(nconc git-blame-current (list (cons (intern key) value)))))

(defun git-blame-current-commit ()
(let ((info (get-char-property (point) 'git-blame)))

    (if info
        (car info)
      (error "No commit info"))))

(defun git-blame-identify (&optional hash)
(interactive)
(shell-command
(format "git log -1 --pretty=oneline %s" (or hash

                                                (git-blame-current-commit)))))

David Kågedal

I've tried it, like the concept of in-buffer blame and the pretty colors, and have a few comments and suggestions:

1. For some files, but not all, emacs is unresponsive (and consumes lots of CPU) right after git-blame-mode is activated. Once git-blame has finished, it becomes responsive again, but this kind of defeats the whole "incremental" idea.

This is most easily seen by holdnig down Ctrl+N or similar, to make the cursor move constantly.

2. Getting to see the sha1 of the commit is not so useful when it can't be selected for copy-pasting. Maybe a keyboard shortcut for "copy-sha1-to-kill-ring"?

3. Even after I've edited a line, or added a new line, they continue to be attributed to the same existing commits. They should either have no attribution, or possibly just "local edit" or something. I seem to recall this kind of functionality for git-blame being discussed very recently?

4. It would be nice with a keyboard shortcut that (in a new buffer) printed more details about the commit under the cursor, kind of like the output from git-log. (Having this available would obviate the need for (2).)

5. It would be nice with a keyboard shortcut for displaying the commit under the cursor in gitk. (For extra points: successive uses of this command should reuse the same gitk window if it's still open.)

6. It would be nice with a keyboard shortcut for displaying (in a separate buffer) the diff to that file introduced by the commit under the cursor. This could be combined with (3) by having commit details followed by diff.

Oh, and try to have it done by Monday. ;-)

Karl Hasselström, [email protected]
      www.treskal.com/kalle

Don't know why this happens. I haven't seen it myself.

Sure. It's a trivial addition.

I saw it was discussed, but I don't think it was added. Currently, it probably makes most sense to verify that the file hasn't been modified, and then switch to read-only mode while viewing the blame.

This is almost as trivial as 2, since the hash is available, you can simply run shell-command.

As in "git log -p", you mean?

Sorry Kalle. I won't have any more spare cycles until next week.

David Kågedal

Hmm, probably, yes. But it'll be kind of limiting to not be able to run blame on a file that has local modifications. I think I understand why vc-annotate opens a new buffer ...

Yes. I was thinking of exactly what "git log -p $hash^..$hash" produces. The Emacs windows should be split in two frames, with the commit details + diff in the lower frame, just like vc-diff.

Karl Hasselström, [email protected]
      www.treskal.com/kalle

I seem to be getting tons of these; wouldn't you want some (require)?

error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr error in process filter: assq: Symbol's function definition is void: cddddr error in process filter: Symbol's function definition is void: cddddr

Yeah, I apparently need a (require 'cl)

I try to stay away from cl by habit, but since I usually have it required by something I use, I might use it without noticing.

So, to try it, add (require 'cl) to the top of the file.

David Kågedal

David> Here's another version of git-blame.el that automatically tries to David> create a sensible list of colors to use for both light and dark David> backgrounds. Plus a few minor fixes.

If this gets traction, this should be what vc-annotate uses on a git file.

Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<[email protected]> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!

I only had a very quick glance, but one "problem" is that vc-annotate assumes that what you want to do is to run an annotate/blame command and show the output in another buffer. My solution is a minor-mode that shows the blame directly in the edit buffer, and I'm not sure how easy it would be to convince vc that this is what I want. And I need a way to turn it off again, and maybe some local key bindings when it is active. This all points to the fact that a minor mode is really the thing to use. So maybe I should simply rebind C-x v g to git-blame-mode instead of vc-annotate...

David Kågedal

Here is an Emacs implementation of incremental git-blame. When you turn it on while viewing a file, the editor buffer will be updated by setting the background of individual lines to a color that reflects which commit it comes from. And when you move around the buffer, a one-line summary will be shown in the echo area.

Created by David Kågedal, header and comments added by Jakub Narębski.

---
Here it is as a proper git patch, and with some headers and comments added. As compared to latest version sent by David KÃ¥gedal,
Message-ID: <[email protected]>
http://permalink.gmane.org/gmane.comp.version-control.git/38246
it has elisp header and description by David KÃ¥gedal, has (require 'cl) with explanation added, and (provide 'git-blame) at the end; no other changes (as of now).

David, is it released as GPL? If it is, GPL boilerplate (as in git.el) could be added to the header.

 contrib/emacs/git-blame.el |  222 ++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 222 insertions(+), 0 deletions(-)

new file mode 100644
index 0000000..fa89889
@@ -0,0 +1,222 @@
+;;; git-blame.el --- Minor mode for incremental blame for Git  -*- coding: utf-8 -*-
+;;
+;; Copyright (C) 2007 by David KÃ¥gedal
+;;
+;; Authors:    David KÃ¥gedal <[email protected]>
+;; Created:    31 Jan 2007
+;; Keywords:   git, version control, release management
+;;
+;; Compatibility: Emacs21
+
+;;; Commentary:
+;;
+;; Here is an Emacs implementation of incremental git-blame.  When you
+;; turn it on while viewing a file, the editor buffer will be updated by
+;; setting the background of individual lines to a color that reflects
+;; which commit it comes from.  And when you move around the buffer, a
+;; one-line summary will be shown in the echo area.
+
+;;; Installation:
+;;
+;;  1) Load into emacs: M-x load-file RET git-blame.el RET
+;;  2) Open a git-controlled file
+;;  3) Blame: M-x git-blame-mode
+
+;;; Compatibility:
+;;
+;; It requires GNU Emacs 21.  If you'are using Emacs 20, try
+;; changing this:
+;;
+;;            (overlay-put ovl 'face (list :background
+;;                                         (cdr (assq 'color (cddddr info)))))
+;;
+;; to
+;;
+;;            (overlay-put ovl 'face (cons 'background-color
+;;                                         (cdr (assq 'color (cddddr info)))))
+
+
+;;; Code:
+
+(require 'cl)			      ; to use `cddddr', `push', `pop'
+
+(defun color-scale (l)
+  (let* ((colors ())
+         r g b)
+    (setq r l)
+    (while r
+      (setq g l)
+      (while g
+        (setq b l)
+        (while b
+          (push (concat "#" (car r) (car g) (car b)) colors)
+          (pop b))
+        (pop g))
+      (pop r))
+    colors))
+
+(defvar git-blame-dark-colors
+  (color-scale '("00" "04" "08" "0c"
+                 "10" "14" "18" "1c"
+                 "20" "24" "28" "2c"
+                 "30" "34" "38" "3c")))
+
+(defvar git-blame-light-colors
+  (color-scale '("c0" "c4" "c8" "cc"
+                 "d0" "d4" "d8" "dc"
+                 "e0" "e4" "e8" "ec"
+                 "f0" "f4" "f8" "fc")))
+
+(defvar git-blame-ancient-color "dark green")
+
+(defvar git-blame-overlays nil)
+(defvar git-blame-cache nil)
+
+(defvar git-blame-mode nil)
+(make-variable-buffer-local 'git-blame-mode)
+(push (list 'git-blame-mode " blame") minor-mode-alist)
+
+(defun git-blame-mode (&optional arg)
+  (interactive "P")
+  (if arg
+      (setq git-blame-mode (eq arg 1))
+    (setq git-blame-mode (not git-blame-mode)))
+  (make-local-variable 'git-blame-overlays)
+  (make-local-variable 'git-blame-colors)
+  (make-local-variable 'git-blame-cache)
+   (let ((bgmode (cdr (assoc 'background-mode (frame-parameters)))))
+    (if (eq bgmode 'dark)
+        (setq git-blame-colors git-blame-dark-colors)
+      (setq git-blame-colors git-blame-light-colors)))
+  (if git-blame-mode
+      (git-blame-run)
+    (git-blame-cleanup)))
+
+(defun git-blame-run ()
+  (let* ((display-buf (current-buffer))
+         (blame-buf (get-buffer-create
+                     (concat " git blame for " (buffer-name))))
+         (proc (start-process "git-blame" blame-buf
+                             "git" "blame" "--incremental"
+                             (file-name-nondirectory buffer-file-name))))
+    (mapcar 'delete-overlay git-blame-overlays)
+    (setq git-blame-overlays nil)
+    (setq git-blame-cache (make-hash-table :test 'equal))
+    (with-current-buffer blame-buf
+      (erase-buffer)
+      (make-local-variable 'git-blame-file)
+      (make-local-variable 'git-blame-current)
+      (setq git-blame-file display-buf)
+      (setq git-blame-current nil))
+    (set-process-filter proc 'git-blame-filter)
+    (set-process-sentinel proc 'git-blame-sentinel)))
+
+(defun git-blame-cleanup ()
+  "Remove all blame properties"
+    (mapcar 'delete-overlay git-blame-overlays)
+    (setq git-blame-overlays nil)
+    (let ((modified (buffer-modified-p)))
+      (remove-text-properties (point-min) (point-max) '(point-entered nil))
+      (set-buffer-modified-p modified)))
+
+
+(defun git-blame-sentinel (proc status)
+  ;;(kill-buffer (process-buffer proc))
+  (message "git blame finished"))
+
+(defvar in-blame-filter nil)
+
+(defun git-blame-filter (proc str)
+  (save-excursion
+    (set-buffer (process-buffer proc))
+    (goto-char (process-mark proc))
+    (insert-before-markers str)
+    (goto-char 0)
+    (unless in-blame-filter
+      (let ((more t)
+            (in-blame-filter t))
+        (while more
+          (setq more (git-blame-parse)))))))
+
+(defun git-blame-parse ()
+  (cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n")
+         (let ((hash (match-string 1))
+               (src-line (string-to-number (match-string 2)))
+               (res-line (string-to-number (match-string 3)))
+               (num-lines (string-to-number (match-string 4))))
+           (setq git-blame-current
+                 (git-blame-new-commit
+                  hash src-line res-line num-lines)))
+         (delete-region (point) (match-end 0))
+         t)
+        ((looking-at "filename \\(.+\\)\n")
+         (let ((filename (match-string 1)))
+           (git-blame-add-info "filename" filename))
+         (delete-region (point) (match-end 0))
+         t)
+        ((looking-at "\\([a-z-]+\\) \\(.+\\)\n")
+         (let ((key (match-string 1))
+               (value (match-string 2)))
+           (git-blame-add-info key value))
+         (delete-region (point) (match-end 0))
+         t)
+        ((looking-at "boundary\n")
+         (setq git-blame-current nil)
+         (delete-region (point) (match-end 0))
+         t)
+        (t
+         nil)))
+
+
+(defun git-blame-new-commit (hash src-line res-line num-lines)
+  (save-excursion
+    (set-buffer git-blame-file)
+    (let ((info (gethash hash git-blame-cache))
+          (inhibit-point-motion-hooks t))
+      (when (not info)
+        (let ((color (pop git-blame-colors)))
+          (unless color
+            (setq color git-blame-ancient-color))
+          (setq info (list hash src-line res-line num-lines
+                           (cons 'color color))))
+        (puthash hash info git-blame-cache))
+      (goto-line res-line)
+      (while (> num-lines 0)
+        (if (get-text-property (point) 'git-blame)
+            (forward-line)
+          (let* ((start (point))
+                 (end (progn (forward-line 1) (point)))
+                 (ovl (make-overlay start end)))
+            (push ovl git-blame-overlays)
+            (overlay-put ovl 'git-blame info)
+            (overlay-put ovl 'help-echo hash)
+            (overlay-put ovl 'face (list :background
+                                         (cdr (assq 'color (cddddr info)))))
+            ;;(overlay-put ovl 'point-entered
+            ;;             `(lambda (x y) (git-blame-identify ,hash)))
+            (let ((modified (buffer-modified-p)))
+              (put-text-property (if (= start 1) start (1- start)) (1- end)
+                                 'point-entered
+                                 `(lambda (x y) (git-blame-identify ,hash)))
+              (set-buffer-modified-p modified))))
+        (setq num-lines (1- num-lines))))))
+
+(defun git-blame-add-info (key value)
+  (if git-blame-current
+      (nconc git-blame-current (list (cons (intern key) value)))))
+
+(defun git-blame-current-commit ()
+  (let ((info (get-char-property (point) 'git-blame)))
+    (if info
+        (car info)
+      (error "No commit info"))))
+
+(defun git-blame-identify (&optional hash)
+  (interactive)
+  (shell-command
+   (format "git log -1 --pretty=oneline %s" (or hash
+                                                (git-blame-current-commit)))))
+
+(provide 'git-blame)
+
+;;; git-blame.el ends here

1.4.4.4