Andrew's git / gitweb.git /
ba9d8a6cdeb97b51082cbcf0b91ad09097876824
   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
  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'
  70
  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)))))
 246
 247(provide 'git-blame)
 248
 249;;; git-blame.el ends here