X-Git-Url: https://git.tokkee.org/?a=blobdiff_plain;f=contrib%2Femacs%2Fgit-blame.el;h=bb671d561ebc9af51bb9a5d52017e71fd81881e9;hb=1a9b8bcfb92e130b4ea67fae2d26b9569da3ed1e;hp=f1839647bcc07679a63bcc8092241dd01647b70b;hpb=f0f39bb4c4ba36a07d7a6f034ba12f2ca0522db8;p=git.git

diff --git a/contrib/emacs/git-blame.el b/contrib/emacs/git-blame.el
index f1839647b..9f92cd250 100644
--- a/contrib/emacs/git-blame.el
+++ b/contrib/emacs/git-blame.el
@@ -8,8 +8,8 @@
 ;; License:    GPL
 ;; Keywords:   git, version control, release management
 ;;
-;; Compatibility: Emacs21
-
+;; Compatibility: Emacs21, Emacs22 and EmacsCVS
+;;                Git 1.5 and up
 
 ;; This file is *NOT* part of GNU Emacs.
 ;; This file is distributed under the same terms as GNU Emacs.
@@ -61,8 +61,9 @@
 
 ;;; Compatibility:
 ;;
-;; It requires GNU Emacs 21.  If you'are using Emacs 20, try
-;; changing this:
+;; It requires GNU Emacs 21 or later and Git 1.5.0 and up
+;;
+;; If you'are using Emacs 20, try changing this:
 ;;
 ;;            (overlay-put ovl 'face (list :background
 ;;                                         (cdr (assq 'color (cddddr info)))))
@@ -77,30 +78,61 @@
 ;;
 ;;; Code:
 
-(require 'cl)			      ; to use `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))
+(eval-when-compile (require 'cl))			      ; to use `push', `pop'
+
+
+(defun git-blame-color-scale (&rest elements)
+  "Given a list, returns a list of triples formed with each
+elements of the list.
+
+a b => bbb bba bab baa abb aba aaa aab"
+  (let (result)
+    (dolist (a elements)
+      (dolist (b elements)
+        (dolist (c elements)
+          (setq result (cons (format "#%s%s%s" a b c) result)))))
+    result))
+
+;; (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") =>
+;; ("#3c3c3c" "#3c3c14" "#3c3c34" "#3c3c2c" "#3c3c1c" "#3c3c24"
+;; "#3c3c04" "#3c3c0c" "#3c143c" "#3c1414" "#3c1434" "#3c142c" ...)
+
+(defmacro git-blame-random-pop (l)
+  "Select a random element from L and returns it. Also remove
+selected element from l."
+  ;; only works on lists with unique elements
+  `(let ((e (elt ,l (random (length ,l)))))
+     (setq ,l (remove e ,l))
+     e))
+
+(defvar git-blame-log-oneline-format
+  "format:[%cr] %cn: %s"
+  "*Formatting option used for describing current line in the minibuffer.
+
+This option is used to pass to git log --pretty= command-line option,
+and describe which commit the current line was made.")
 
 (defvar git-blame-dark-colors
-  (color-scale '("0c" "04" "24" "1c" "2c" "34" "14" "3c")))
+  (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c")
+  "*List of colors (format #RGB) to use in a dark environment.
+
+To check out the list, evaluate (list-colors-display git-blame-dark-colors).")
 
 (defvar git-blame-light-colors
-  (color-scale '("c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec")))
+  (git-blame-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec")
+  "*List of colors (format #RGB) to use in a light environment.
+
+To check out the list, evaluate (list-colors-display git-blame-light-colors).")
+
+(defvar git-blame-colors '()
+  "Colors used by git-blame. The list is built once when activating git-blame
+minor mode.")
+
+(defvar git-blame-ancient-color "dark green"
+  "*Color to be used for ancient commit.")
 
-(defvar git-blame-ancient-color "dark green")
+(defvar git-blame-autoupdate t
+  "*Automatically update the blame display while editing")
 
 (defvar git-blame-proc nil
   "The running git-blame process")
@@ -114,51 +146,93 @@
   "A cache of git-blame information for the current buffer")
 (make-variable-buffer-local 'git-blame-cache)
 
+(defvar git-blame-idle-timer nil
+  "An idle timer that updates the blame")
+(make-variable-buffer-local 'git-blame-cache)
+
+(defvar git-blame-update-queue nil
+  "A queue of update requests")
+(make-variable-buffer-local 'git-blame-update-queue)
+
+;; FIXME: docstrings
+(defvar git-blame-file nil)
+(defvar git-blame-current nil)
+
 (defvar git-blame-mode nil)
 (make-variable-buffer-local 'git-blame-mode)
-(unless (assq 'git-blame-mode minor-mode-alist)
-  (setq minor-mode-alist
-	(cons (list 'git-blame-mode " blame")
-	      minor-mode-alist)))
+
+(defvar git-blame-mode-line-string " blame"
+  "String to display on the mode line when git-blame is active.")
+
+(or (assq 'git-blame-mode minor-mode-alist)
+    (setq minor-mode-alist
+	  (cons '(git-blame-mode git-blame-mode-line-string) minor-mode-alist)))
 
 ;;;###autoload
 (defun git-blame-mode (&optional arg)
+  "Toggle minor mode for displaying Git blame
+
+With prefix ARG, turn the mode on if ARG is positive."
   (interactive "P")
-  (if arg
-      (setq git-blame-mode (eq arg 1))
-    (setq git-blame-mode (not git-blame-mode)))
+  (cond
+   ((null arg)
+    (if git-blame-mode (git-blame-mode-off) (git-blame-mode-on)))
+   ((> (prefix-numeric-value arg) 0) (git-blame-mode-on))
+   (t (git-blame-mode-off))))
+
+(defun git-blame-mode-on ()
+  "Turn on git-blame mode.
+
+See also function `git-blame-mode'."
   (make-local-variable 'git-blame-colors)
+  (if git-blame-autoupdate
+      (add-hook 'after-change-functions 'git-blame-after-change nil t)
+    (remove-hook 'after-change-functions 'git-blame-after-change t))
+  (git-blame-cleanup)
+  (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)))
+  (setq git-blame-cache (make-hash-table :test 'equal))
+  (setq git-blame-mode t)
+  (git-blame-run))
+
+(defun git-blame-mode-off ()
+  "Turn off git-blame mode.
+
+See also function `git-blame-mode'."
   (git-blame-cleanup)
-  (if git-blame-mode
-      (progn
-        (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)))
-        (setq git-blame-cache (make-hash-table :test 'equal))
-        (git-blame-run))))
+  (if git-blame-idle-timer (cancel-timer git-blame-idle-timer))
+  (setq git-blame-mode nil))
 
 ;;;###autoload
 (defun git-reblame ()
   "Recalculate all blame information in the current buffer"
-  (unless git-blame-mode
-    (error "git-blame is not active"))
   (interactive)
+  (unless git-blame-mode
+    (error "Git-blame is not active"))
+
   (git-blame-cleanup)
   (git-blame-run))
 
-(defun git-blame-run ()
+(defun git-blame-run (&optional startline endline)
   (if git-blame-proc
       ;; Should maybe queue up a new run here
       (message "Already running git blame")
     (let ((display-buf (current-buffer))
           (blame-buf (get-buffer-create
-                      (concat " git blame for " (buffer-name)))))
+                      (concat " git blame for " (buffer-name))))
+          (args '("--incremental" "--contents" "-")))
+      (if startline
+          (setq args (append args
+                             (list "-L" (format "%d,%d" startline endline)))))
+      (setq args (append args
+                         (list (file-name-nondirectory buffer-file-name))))
       (setq git-blame-proc
-            (start-process "git-blame" blame-buf
-                           "git" "blame"
-                           "--incremental" "--contents" "-"
-                           (file-name-nondirectory buffer-file-name)))
+            (apply 'start-process
+                   "git-blame" blame-buf
+                   "git" "blame"
+                   args))
       (with-current-buffer blame-buf
         (erase-buffer)
         (make-local-variable 'git-blame-file)
@@ -170,20 +244,43 @@
       (process-send-region git-blame-proc (point-min) (point-max))
       (process-send-eof git-blame-proc))))
 
+(defun remove-git-blame-text-properties (start end)
+  (let ((modified (buffer-modified-p))
+        (inhibit-read-only t))
+    (remove-text-properties start end '(point-entered nil))
+    (set-buffer-modified-p modified)))
+
 (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)))
+    (remove-git-blame-text-properties (point-min) (point-max)))
+
+(defun git-blame-update-region (start end)
+  "Rerun blame to get updates between START and END"
+  (let ((overlays (overlays-in start end)))
+    (while overlays
+      (let ((overlay (pop overlays)))
+        (if (< (overlay-start overlay) start)
+            (setq start (overlay-start overlay)))
+        (if (> (overlay-end overlay) end)
+            (setq end (overlay-end overlay)))
+        (setq git-blame-overlays (delete overlay git-blame-overlays))
+        (delete-overlay overlay))))
+  (remove-git-blame-text-properties start end)
+  ;; We can be sure that start and end are at line breaks
+  (git-blame-run (1+ (count-lines (point-min) start))
+                 (count-lines (point-min) end)))
 
 (defun git-blame-sentinel (proc status)
   (with-current-buffer (process-buffer proc)
     (with-current-buffer git-blame-file
-      (setq git-blame-proc nil)))
+      (setq git-blame-proc nil)
+      (if git-blame-update-queue
+          (git-blame-delayed-update))))
   ;;(kill-buffer (process-buffer proc))
-  (message "git blame finished"))
+  ;;(message "git blame finished")
+  )
 
 (defvar in-blame-filter nil)
 
@@ -230,16 +327,18 @@
         (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))
+          (inhibit-point-motion-hooks t)
+          (inhibit-modification-hooks t))
       (when (not info)
-        (let ((color (pop git-blame-colors)))
-          (unless color
-            (setq color git-blame-ancient-color))
+	;; Assign a random color to each new commit info
+	;; Take care not to select the same color multiple times
+	(let ((color (if git-blame-colors
+			 (git-blame-random-pop git-blame-colors)
+		       git-blame-ancient-color)))
           (setq info (list hash src-line res-line num-lines
                            (git-describe-commit hash)
                            (cons 'color color))))
@@ -279,7 +378,8 @@
 (defun git-describe-commit (hash)
   (with-temp-buffer
     (call-process "git" nil t nil
-                  "log" "-1" "--pretty=oneline"
+                  "log" "-1"
+		  (concat "--pretty=" git-blame-log-oneline-format)
                   hash)
     (buffer-substring (point-min) (1- (point-max)))))
 
@@ -292,6 +392,43 @@
       (message "%s" (nth 4 info))
       (setq git-blame-last-identification info))))
 
+;; (defun git-blame-after-save ()
+;;   (when git-blame-mode
+;;     (git-blame-cleanup)
+;;     (git-blame-run)))
+;; (add-hook 'after-save-hook 'git-blame-after-save)
+
+(defun git-blame-after-change (start end length)
+  (when git-blame-mode
+    (git-blame-enq-update start end)))
+
+(defvar git-blame-last-update nil)
+(make-variable-buffer-local 'git-blame-last-update)
+(defun git-blame-enq-update (start end)
+  "Mark the region between START and END as needing blame update"
+  ;; Try to be smart and avoid multiple callouts for sequential
+  ;; editing
+  (cond ((and git-blame-last-update
+              (= start (cdr git-blame-last-update)))
+         (setcdr git-blame-last-update end))
+        ((and git-blame-last-update
+              (= end (car git-blame-last-update)))
+         (setcar git-blame-last-update start))
+        (t
+         (setq git-blame-last-update (cons start end))
+         (setq git-blame-update-queue (nconc git-blame-update-queue
+                                             (list git-blame-last-update)))))
+  (unless (or git-blame-proc git-blame-idle-timer)
+    (setq git-blame-idle-timer
+          (run-with-idle-timer 0.5 nil 'git-blame-delayed-update))))
+
+(defun git-blame-delayed-update ()
+  (setq git-blame-idle-timer nil)
+  (if git-blame-update-queue
+      (let ((first (pop git-blame-update-queue))
+            (inhibit-point-motion-hooks t))
+        (git-blame-update-region (car first) (cdr first)))))
+
 (provide 'git-blame)
 
 ;;; git-blame.el ends here