Drastically improve the speed of #'sy-git-blame

In the previous iteration of #'sy-git-blame there was 2 calls to git,
plus creating an extent and glyph for every single line in the file you
were blaming.  It took FOREVER even on small files.  Now there is 1 git
call per revision, blank lines and uncommitted lines are skipped, and
unique extents are only created once per revision, with the rest (vast
majority) being created as "child-extents" with `set-extent-parent'.

Please note that even with this speed-up blaming a large file can still
take some time, but now we're talking seconds and not minutes.

	* sy-git.el (sy-git-process-blame-buffer): Rewrite, dramatically
	increasing speed.
	(sy-git-blame): Use '--root' to treat boundary commits as normal
	commits.

Signed-off-by: Steve Youngs <steve@sxemacs.org>

diff --git a/sy-git.el b/sy-git.el
index 928458b..68f52f2 100644 (file)
--- a/sy-git.el
+++ b/sy-git.el
@@ -5,7 +5,7 @@
 ;; Author:     Steve Youngs <steve@sxemacs.org>
 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
 ;; Created:    <2015-07-05>
-;; Time-stamp: <Thursday Oct 26, 2017 21:01:14 steve>
+;; Time-stamp: <Friday Oct 27, 2017 11:41:15 steve>
 ;; Homepage:   http://git.sxemacs.org/slh
 ;; Keywords:   git, tools, convenience
 
@@ -143,6 +143,7 @@ them.")
     (setq args (and (push subcmd args)
                    (append gitopts args)))
     (apply #'call-process git nil buffer nil args)))
+(put 'sy-git-run-buffer 'lisp-indent-function 1)
 
 (defun sy-git-run-string (subcmd &rest args)
   "Return a string from output of git SUBCMD ARGS."
@@ -160,6 +161,7 @@ them.")
     (setq cmdline (mapconcat #'identity cmdline " "))
     ;; run it
     (shell-command-to-string cmdline)))
+(put 'sy-git-run-string 'lisp-indent-function 1)
 
 (defun sy-git-check-hook (hook)
   "Return non-nil when HOOK script exists and is usable.
@@ -276,7 +278,8 @@ buffer."
 (defun sy-git-process-blame-buffer ()
   "Processes the content of the blame BUFFER.
 Adds margin, extents, keymaps, etc."
-  (let ((regex #r"\(^[a-f0-9]+\)\s-+[0-9]+) "))
+  (let ((regex #r"\(^[a-f0-9]+\)\s-+[0-9]+) ")
+       (hash (make-hash-table :size 1024 :test #'equal)))
     (set-specifier left-margin-width 9 (current-buffer))
     (goto-char (point-min))
     (save-excursion
@@ -284,27 +287,48 @@ Adds margin, extents, keymaps, etc."
        (while (re-search-forward regex nil t)
          (working-status nil (substring (buffer-name) 12 -1))
          (let ((blamerev (match-string 1))
-               bhelp ext)
+               (buf (get-buffer-create "*sy-git-extents*"))
+               bhelp khelp ext)
            (delete-region (match-beginning 0) (match-end 0))
-           (unless (string= blamerev "00000000")
-             (setq bhelp (sy-git-run-string
-                          "show"
-                          (split-string (format "--name-only %s | head -n5"
-                                                blamerev)))
-                   khelp (sy-git-run-string
-                          "show"
-                          (split-string
-                           (concat "--format=\"[Keys:s,l,b1,b2] [%h] %an %ai\""
-                                   " --name-only " blamerev " | head -n1"))))
-             (setq ext (make-extent (point-at-bol) (point-at-eol)))
-             (set-extent-properties
-              ext
-              `(priority 2 mouse-face highlight keymap ,sy-git-blame-map
-                         help-echo ,khelp balloon-help ,bhelp blame t
-                         brev ,blamerev))
-             (set-extent-begin-glyph
-              ext
-              (make-glyph blamerev) 'outside-margin))))
+           ;; skip uncommitted and blank lines
+           (unless (or (string= blamerev "00000000")
+                       (zerop (length
+                               (buffer-substring
+                                (point-at-bol) (point-at-eol)))))
+             (if (not (gethash blamerev hash))
+                 ;; A new rev, set up extent
+                 (progn
+                   (puthash blamerev (point) hash)
+                   (with-current-buffer buf
+                     (erase-buffer)
+                     (insert
+                      (sy-git-run-string "show"
+                        (split-string
+                         (concat "--format=\"[Keys:s,l,b1,b2] [%h] %an "
+                                 "%ai%ncommit: %H%nAuthor: %an <%ae>%n"
+                                 "Date: %>(33)%ad%n%n %s\" --summary "
+                                 blamerev " |head -n8"))))
+                     (goto-char (point-min))
+                     (setq khelp (buffer-substring
+                                  (point-at-bol) (point-at-eol)))
+                     (delete-region (point-at-bol) (point-at-eol))
+                     (setq bhelp (buffer-string)))
+                   (kill-buffer buf)
+                   (setq ext (make-extent
+                              (point-at-bol) (point-at-eol)))
+                   (set-extent-properties
+                    ext
+                    `(mouse-face highlight keymap ,sy-git-blame-map
+                                 help-echo ,khelp balloon-help ,bhelp
+                                 blame t brev ,blamerev))
+                   (set-extent-begin-glyph
+                    ext
+                    (make-glyph blamerev) 'outside-margin))
+               ;; A previous rev, just set extent parent
+               (setq ext (make-extent (point-at-bol) (point-at-eol)))
+               (set-extent-parent
+                ext (extent-at
+                     (gethash blamerev hash) nil 'blame))))))
        (working-status t (substring (buffer-name) 12 -1))))))
 
 (defun sy-git-blame ()
@@ -325,8 +349,9 @@ file within the region."
            end (line-number (region-end))))
     (and beg end
         (push (format "-L%d,%d" beg end) args))
-    ;; We want -s for nicer, less verbose output
-    (push "-s" args)
+    ;; We want -s for nicer, less verbose output and --root for
+    ;; boundary commits
+    (setq args (append '("-s" "--root") args))
     (sy-git-run-buffer gb gitcmd args)
     (window-configuration-to-register ?G)
     (with-current-buffer gb
@@ -421,16 +446,16 @@ Example post-commit:
 
 "
   (interactive "p")
-  (let* ((topd (substring (sy-git-run-string
-                          "rev-parse" "--show-toplevel") 0 -1))
+  (let* ((topd (substring (sy-git-run-string "rev-parse"
+                           "--show-toplevel") 0 -1))
         (logfile (expand-file-name "++log" topd))
         (hookd (paths-construct-path `(,topd ".git" "hooks")))
         (msg-hook (expand-file-name "commit-msg" hookd))
         (commit-hook (expand-file-name "post-commit" hookd))
-        (add-log-full-name (substring (sy-git-run-string
-                                       "config" "user.name") 0 -1))
-        (add-log-mailing-address (substring (sy-git-run-string
-                                             "config" "user.email") 0 -1))
+        (add-log-full-name (substring (sy-git-run-string "config"
+                                        "user.name") 0 -1))
+        (add-log-mailing-address (substring (sy-git-run-string "config"
+                                              "user.email") 0 -1))
         (add-log-keep-changes-together t)
         (header (concat
                  (format-time-string "%Y-%m-%d")