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, 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;; To use this package, put it somewhere in `load-path' (or add 48;; directory with git-blame.el to `load-path'), and add the following 49;; line to your .emacs: 50;; 51;; (require 'git-blame) 52;; 53;; If you do not want to load this package before it is necessary, you 54;; can make use of the `autoload' feature, e.g. by adding to your .emacs 55;; the following lines 56;; 57;; (autoload 'git-blame-mode "git-blame" 58;; "Minor mode for incremental blame for Git." t) 59;; 60;; Then first use of `M-x git-blame-mode' would load the package. 61 62;;; Compatibility: 63;; 64;; It requires GNU Emacs 21 or later and Git 1.5.0 and up 65;; 66;; If you'are using Emacs 20, try changing this: 67;; 68;; (overlay-put ovl 'face (list :background 69;; (cdr (assq 'color (cddddr info))))) 70;; 71;; to 72;; 73;; (overlay-put ovl 'face (cons 'background-color 74;; (cdr (assq 'color (cddddr info))))) 75 76 77;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 78;; 79;;; Code: 80 81(eval-when-compile (require 'cl)) ; to use `push', `pop' 82(require 'format-spec) 83 84(defface git-blame-prefix-face 85 '((((background dark)) (:foreground "gray" 86 :background "black")) 87 (((background light)) (:foreground "gray" 88 :background "white")) 89 (t (:weight bold))) 90 "The face used for the hash prefix." 91 :group 'git-blame) 92 93(defgroup git-blame nil 94 "A minor mode showing Git blame information." 95 :group 'git 96 :link '(function-link git-blame-mode)) 97 98 99(defcustom git-blame-use-colors t 100 "Use colors to indicate commits in `git-blame-mode'." 101 :type 'boolean 102 :group 'git-blame) 103 104(defcustom git-blame-prefix-format 105 "%h %20A:" 106 "The format of the prefix added to each line in `git-blame' 107mode. The format is passed to `format-spec' with the following format keys: 108 109 %h - the abbreviated hash 110 %H - the full hash 111 %a - the author name 112 %A - the author email 113 %c - the committer name 114 %C - the committer email 115 %s - the commit summary 116" 117 :group 'git-blame) 118 119(defcustom git-blame-mouseover-format 120 "%h %a %A: %s" 121 "The format of the description shown when pointing at a line in 122`git-blame' mode. The format string is passed to `format-spec' 123with the following format keys: 124 125 %h - the abbreviated hash 126 %H - the full hash 127 %a - the author name 128 %A - the author email 129 %c - the committer name 130 %C - the committer email 131 %s - the commit summary 132" 133 :group 'git-blame) 134 135 136(defun git-blame-color-scale (&rest elements) 137 "Given a list, returns a list of triples formed with each 138elements of the list. 139 140a b => bbb bba bab baa abb aba aaa aab" 141 (let (result) 142 (dolist (a elements) 143 (dolist (b elements) 144 (dolist (c elements) 145 (setq result (cons (format "#%s%s%s" a b c) result))))) 146 result)) 147 148;; (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") => 149;; ("#3c3c3c" "#3c3c14" "#3c3c34" "#3c3c2c" "#3c3c1c" "#3c3c24" 150;; "#3c3c04" "#3c3c0c" "#3c143c" "#3c1414" "#3c1434" "#3c142c" ...) 151 152(defmacro git-blame-random-pop (l) 153 "Select a random element from L and returns it. Also remove 154selected element from l." 155 ;; only works on lists with unique elements 156 `(let ((e (elt ,l (random (length ,l))))) 157 (setq ,l (remove e ,l)) 158 e)) 159 160(defvar git-blame-log-oneline-format 161 "format:[%cr] %cn: %s" 162 "*Formatting option used for describing current line in the minibuffer. 163 164This option is used to pass to git log --pretty= command-line option, 165and describe which commit the current line was made.") 166 167(defvar git-blame-dark-colors 168 (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") 169 "*List of colors (format #RGB) to use in a dark environment. 170 171To check out the list, evaluate (list-colors-display git-blame-dark-colors).") 172 173(defvar git-blame-light-colors 174 (git-blame-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec") 175 "*List of colors (format #RGB) to use in a light environment. 176 177To check out the list, evaluate (list-colors-display git-blame-light-colors).") 178 179(defvar git-blame-colors '() 180 "Colors used by git-blame. The list is built once when activating git-blame 181minor mode.") 182 183(defvar git-blame-ancient-color "dark green" 184 "*Color to be used for ancient commit.") 185 186(defvar git-blame-autoupdate t 187 "*Automatically update the blame display while editing") 188 189(defvar git-blame-proc nil 190 "The running git-blame process") 191(make-variable-buffer-local 'git-blame-proc) 192 193(defvar git-blame-overlays nil 194 "The git-blame overlays used in the current buffer.") 195(make-variable-buffer-local 'git-blame-overlays) 196 197(defvar git-blame-cache nil 198 "A cache of git-blame information for the current buffer") 199(make-variable-buffer-local 'git-blame-cache) 200 201(defvar git-blame-idle-timer nil 202 "An idle timer that updates the blame") 203(make-variable-buffer-local 'git-blame-cache) 204 205(defvar git-blame-update-queue nil 206 "A queue of update requests") 207(make-variable-buffer-local 'git-blame-update-queue) 208 209;; FIXME: docstrings 210(defvar git-blame-file nil) 211(defvar git-blame-current nil) 212 213(defvar git-blame-mode nil) 214(make-variable-buffer-local 'git-blame-mode) 215 216(defvar git-blame-mode-line-string " blame" 217 "String to display on the mode line when git-blame is active.") 218 219(or (assq 'git-blame-mode minor-mode-alist) 220 (setq minor-mode-alist 221 (cons '(git-blame-mode git-blame-mode-line-string) minor-mode-alist))) 222 223;;;###autoload 224(defun git-blame-mode (&optional arg) 225 "Toggle minor mode for displaying Git blame 226 227With prefix ARG, turn the mode on if ARG is positive." 228 (interactive "P") 229 (cond 230 ((null arg) 231 (if git-blame-mode (git-blame-mode-off) (git-blame-mode-on))) 232 ((> (prefix-numeric-value arg) 0) (git-blame-mode-on)) 233 (t (git-blame-mode-off)))) 234 235(defun git-blame-mode-on () 236 "Turn on git-blame mode. 237 238See also function `git-blame-mode'." 239 (make-local-variable 'git-blame-colors) 240 (if git-blame-autoupdate 241 (add-hook 'after-change-functions 'git-blame-after-change nil t) 242 (remove-hook 'after-change-functions 'git-blame-after-change t)) 243 (git-blame-cleanup) 244 (let ((bgmode (cdr (assoc 'background-mode (frame-parameters))))) 245 (if (eq bgmode 'dark) 246 (setq git-blame-colors git-blame-dark-colors) 247 (setq git-blame-colors git-blame-light-colors))) 248 (setq git-blame-cache (make-hash-table :test 'equal)) 249 (setq git-blame-mode t) 250 (git-blame-run)) 251 252(defun git-blame-mode-off () 253 "Turn off git-blame mode. 254 255See also function `git-blame-mode'." 256 (git-blame-cleanup) 257 (if git-blame-idle-timer (cancel-timer git-blame-idle-timer)) 258 (setq git-blame-mode nil)) 259 260;;;###autoload 261(defun git-reblame () 262 "Recalculate all blame information in the current buffer" 263 (interactive) 264 (unless git-blame-mode 265 (error "Git-blame is not active")) 266 267 (git-blame-cleanup) 268 (git-blame-run)) 269 270(defun git-blame-run (&optional startline endline) 271 (if git-blame-proc 272 ;; Should maybe queue up a new run here 273 (message "Already running git blame") 274 (let ((display-buf (current-buffer)) 275 (blame-buf (get-buffer-create 276 (concat " git blame for " (buffer-name)))) 277 (args '("--incremental" "--contents" "-"))) 278 (if startline 279 (setq args (append args 280 (list "-L" (format "%d,%d" startline endline))))) 281 (setq args (append args 282 (list (file-name-nondirectory buffer-file-name)))) 283 (setq git-blame-proc 284 (apply 'start-process 285 "git-blame" blame-buf 286 "git" "blame" 287 args)) 288 (with-current-buffer blame-buf 289 (erase-buffer) 290 (make-local-variable 'git-blame-file) 291 (make-local-variable 'git-blame-current) 292 (setq git-blame-file display-buf) 293 (setq git-blame-current nil)) 294 (set-process-filter git-blame-proc 'git-blame-filter) 295 (set-process-sentinel git-blame-proc 'git-blame-sentinel) 296 (process-send-region git-blame-proc (point-min) (point-max)) 297 (process-send-eof git-blame-proc)))) 298 299(defun remove-git-blame-text-properties (start end) 300 (let ((modified (buffer-modified-p)) 301 (inhibit-read-only t)) 302 (remove-text-properties start end '(point-entered nil)) 303 (set-buffer-modified-p modified))) 304 305(defun git-blame-cleanup () 306 "Remove all blame properties" 307 (mapc 'delete-overlay git-blame-overlays) 308 (setq git-blame-overlays nil) 309 (remove-git-blame-text-properties (point-min) (point-max))) 310 311(defun git-blame-update-region (start end) 312 "Rerun blame to get updates between START and END" 313 (let ((overlays (overlays-in start end))) 314 (while overlays 315 (let ((overlay (pop overlays))) 316 (if (< (overlay-start overlay) start) 317 (setq start (overlay-start overlay))) 318 (if (> (overlay-end overlay) end) 319 (setq end (overlay-end overlay))) 320 (setq git-blame-overlays (delete overlay git-blame-overlays)) 321 (delete-overlay overlay)))) 322 (remove-git-blame-text-properties start end) 323 ;; We can be sure that start and end are at line breaks 324 (git-blame-run (1+ (count-lines (point-min) start)) 325 (count-lines (point-min) end))) 326 327(defun git-blame-sentinel (proc status) 328 (with-current-buffer (process-buffer proc) 329 (with-current-buffer git-blame-file 330 (setq git-blame-proc nil) 331 (if git-blame-update-queue 332 (git-blame-delayed-update)))) 333 ;;(kill-buffer (process-buffer proc)) 334 ;;(message "git blame finished") 335 ) 336 337(defvar in-blame-filter nil) 338 339(defun git-blame-filter (proc str) 340 (with-current-buffer (process-buffer proc) 341 (save-excursion 342 (goto-char (process-mark proc)) 343 (insert-before-markers str) 344 (goto-char (point-min)) 345 (unless in-blame-filter 346 (let ((more t) 347 (in-blame-filter t)) 348 (while more 349 (setq more (git-blame-parse)))))))) 350 351(defun git-blame-parse () 352 (cond ((looking-at "\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)\n") 353 (let ((hash (match-string 1)) 354 (src-line (string-to-number (match-string 2))) 355 (res-line (string-to-number (match-string 3))) 356 (num-lines (string-to-number (match-string 4)))) 357 (delete-region (point) (match-end 0)) 358 (setq git-blame-current (list (git-blame-new-commit hash) 359 src-line res-line num-lines))) 360 t) 361 ((looking-at "\\([a-z-]+\\) \\(.+\\)\n") 362 (let ((key (match-string 1)) 363 (value (match-string 2))) 364 (delete-region (point) (match-end 0)) 365 (git-blame-add-info (car git-blame-current) key value) 366 (when (string= key "filename") 367 (git-blame-create-overlay (car git-blame-current) 368 (caddr git-blame-current) 369 (cadddr git-blame-current)) 370 (setq git-blame-current nil))) 371 t) 372 (t 373 nil))) 374 375(defun git-blame-new-commit (hash) 376 (with-current-buffer git-blame-file 377 (or (gethash hash git-blame-cache) 378 ;; Assign a random color to each new commit info 379 ;; Take care not to select the same color multiple times 380 (let* ((color (if git-blame-colors 381 (git-blame-random-pop git-blame-colors) 382 git-blame-ancient-color)) 383 (info `(,hash (color . ,color)))) 384 (puthash hash info git-blame-cache) 385 info)))) 386 387(defun git-blame-create-overlay (info start-line num-lines) 388 (with-current-buffer git-blame-file 389 (save-excursion 390 (let ((inhibit-point-motion-hooks t) 391 (inhibit-modification-hooks t)) 392 (goto-char (point-min)) 393 (forward-line (1- start-line)) 394 (let* ((start (point)) 395 (end (progn (forward-line num-lines) (point))) 396 (ovl (make-overlay start end)) 397 (hash (car info)) 398 (spec `((?h . ,(substring hash 0 6)) 399 (?H . ,hash) 400 (?a . ,(git-blame-get-info info 'author)) 401 (?A . ,(git-blame-get-info info 'author-mail)) 402 (?c . ,(git-blame-get-info info 'committer)) 403 (?C . ,(git-blame-get-info info 'committer-mail)) 404 (?s . ,(git-blame-get-info info 'summary))))) 405 (push ovl git-blame-overlays) 406 (overlay-put ovl 'git-blame info) 407 (overlay-put ovl 'help-echo 408 (format-spec git-blame-mouseover-format spec)) 409 (if git-blame-use-colors 410 (overlay-put ovl 'face (list :background 411 (cdr (assq 'color (cdr info)))))) 412 (overlay-put ovl 'line-prefix 413 (propertize (format-spec git-blame-prefix-format spec) 414 'face 'git-blame-prefix-face))))))) 415 416(defun git-blame-add-info (info key value) 417 (nconc info (list (cons (intern key) value)))) 418 419(defun git-blame-get-info (info key) 420 (cdr (assq key (cdr info)))) 421 422(defun git-blame-current-commit () 423 (let ((info (get-char-property (point) 'git-blame))) 424 (if info 425 (car info) 426 (error "No commit info")))) 427 428(defun git-describe-commit (hash) 429 (with-temp-buffer 430 (call-process "git" nil t nil 431 "log" "-1" 432 (concat "--pretty=" git-blame-log-oneline-format) 433 hash) 434 (buffer-substring (point-min) (point-max)))) 435 436(defvar git-blame-last-identification nil) 437(make-variable-buffer-local 'git-blame-last-identification) 438(defun git-blame-identify (&optional hash) 439 (interactive) 440 (let ((info (gethash (or hash (git-blame-current-commit)) git-blame-cache))) 441 (when (and info (not (eq info git-blame-last-identification))) 442 (message "%s" (nth 4 info)) 443 (setq git-blame-last-identification info)))) 444 445;; (defun git-blame-after-save () 446;; (when git-blame-mode 447;; (git-blame-cleanup) 448;; (git-blame-run))) 449;; (add-hook 'after-save-hook 'git-blame-after-save) 450 451(defun git-blame-after-change (start end length) 452 (when git-blame-mode 453 (git-blame-enq-update start end))) 454 455(defvar git-blame-last-update nil) 456(make-variable-buffer-local 'git-blame-last-update) 457(defun git-blame-enq-update (start end) 458 "Mark the region between START and END as needing blame update" 459 ;; Try to be smart and avoid multiple callouts for sequential 460 ;; editing 461 (cond ((and git-blame-last-update 462 (= start (cdr git-blame-last-update))) 463 (setcdr git-blame-last-update end)) 464 ((and git-blame-last-update 465 (= end (car git-blame-last-update))) 466 (setcar git-blame-last-update start)) 467 (t 468 (setq git-blame-last-update (cons start end)) 469 (setq git-blame-update-queue (nconc git-blame-update-queue 470 (list git-blame-last-update))))) 471 (unless (or git-blame-proc git-blame-idle-timer) 472 (setq git-blame-idle-timer 473 (run-with-idle-timer 0.5 nil 'git-blame-delayed-update)))) 474 475(defun git-blame-delayed-update () 476 (setq git-blame-idle-timer nil) 477 (if git-blame-update-queue 478 (let ((first (pop git-blame-update-queue)) 479 (inhibit-point-motion-hooks t)) 480 (git-blame-update-region (car first) (cdr first))))) 481 482(provide 'git-blame) 483 484;;; git-blame.el ends here