mo-git-blame.el

;;; mo-git-blame.el --- An interactive, iterative 'git blame' mode for Emacs

;; Copyright (C) 2009, 2010  Moritz Bunkus <moritz@bunkus.org>
;; Copyright (C) 2010  Štěpán Němec <stepnem@gmail.com>

;; Author: Moritz Bunkus <moritz@bunkus.org>
;; Maintainer: Moritz Bunkus <moritz@bunkus.org>
;; Version: 0.1.0
;; Keywords: tools

;; mo-git-blame is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or (at
;; your option) any later version.
;;
;; mo-git-blame is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Installation:
;;;
;;; Put this file somewhere in your load-path or add the directory it
;;; is in to it, e.g.:
;;;
;;; (add-to-list 'load-path "~/.emacs.d/mo-git-blame")
;;;
;;; Then add two autoload definitions:
;;;
;;; (autoload 'mo-git-blame-file "mo-git-blame" nil t)
;;; (autoload 'mo-git-blame-current "mo-git-blame" nil t)

(require 'cl)
(require 'easymenu)

(defvar mo-git-blame-vars nil
  "Buffer-local plist that stores various variables needed for
interactive use, e.g. the file name, current revision etc.")

(defvar mo-git-blame-rev-ts nil
  "Buffer-local alist that maps revision to timestamp")

(defvar mo-git-blame--wincfg nil)

(defvar mo-git-blame-mode-map
  (let ((map (make-keymap)))
    (suppress-keymap map t)
    (define-key map (kbd "a") 'mo-git-blame-reblame-for-ancestor-of-revision-at)
    (define-key map (kbd "A") 'mo-git-blame-reblame-for-ancestor-of-current-revision)
    (define-key map (kbd "b") 'mo-git-blame-reblame-for-revision-at)
    (define-key map (kbd "B") 'mo-git-blame-reblame-for-specific-revision)
    (define-key map (kbd "c") 'mo-git-blame-content-for-revision-at)
    (define-key map (kbd "i") 'mo-git-blame-display-info)
    (define-key map (kbd "l") 'mo-git-blame-log-for-revision-at)
    (define-key map (kbd "L") 'mo-git-blame-log-for-current-revision)
    (define-key map (kbd "o") 'mo-git-blame-overwrite-file-with-revision-at)
    (define-key map (kbd "O") 'mo-git-blame-overwrite-file-with-current-revision)
    (define-key map (kbd "p") 'mo-git-blame-reblame-for-prior-revision)
    (define-key map (kbd "q") 'mo-git-blame-quit)
    (define-key map (kbd "s") 'mo-git-blame-show-revision-at)
    (define-key map (kbd "S") 'mo-git-blame-show-current-revision)
    (define-key map (kbd "RET") 'mo-git-blame-show-revision-at)
    (define-key map (kbd "TAB") 'mo-git-blame-display-content-buffer)
    (define-key map [?\C-x ?k] 'mo-git-blame-quit)
    (define-key map [?\C-x ?\C-l] 'mo-git-blame-goto-line)
    map)
  "The mode map for the blame output window of mo-git-blame-mode.")

(defvar mo-git-blame-content-mode-map
  (let ((map (make-keymap)))
    (suppress-keymap map t)
    (define-key map (kbd "A") 'mo-git-blame-reblame-for-ancestor-of-current-revision)
    (define-key map (kbd "B") 'mo-git-blame-reblame-for-specific-revision)
    (define-key map (kbd "i") 'mo-git-blame-display-info)
    (define-key map (kbd "L") 'mo-git-blame-log-for-current-revision)
    (define-key map (kbd "O") 'mo-git-blame-overwrite-file-with-current-revision)
    (define-key map (kbd "q") 'mo-git-blame-quit)
    (define-key map (kbd "S") 'mo-git-blame-show-current-revision)
    (define-key map [?\C-x ?k] 'mo-git-blame-quit)
    (define-key map [?\C-x ?\C-l] 'mo-git-blame-goto-line)
    map)
  "The mode map for the content window of mo-git-blame-mode.")

(easy-menu-define mo-git-blame-mode-menu mo-git-blame-mode-map
  "MoGitBlame menu"
  '("MoGitBlame"
    ["Re-blame for revision at point" mo-git-blame-reblame-for-revision-at t]
    ["Re-blame for ancestor of revision at point" mo-git-blame-reblame-for-ancestor-of-revision-at t]
    ["Raw content for revision at point" mo-git-blame-content-for-revision-at t]
    ["Log for revision at point" mo-git-blame-log-for-revision-at t]
    ["Overwrite file with revision at point" mo-git-blame-overwrite-file-with-revision-at t]
    ["'git show' for revision at point" mo-git-blame-show-revision-at t]
    "---"
    ["Re-blame for ancestor of current revision" mo-git-blame-reblame-for-ancestor-of-current-revision t]
    ["Log for current revision" mo-git-blame-log-for-current-revision t]
    ["Overwrite file with current revision" mo-git-blame-overwrite-file-with-current-revision t]
    ["'git show' for current revision" mo-git-blame-show-current-revision t]
    "---"
    ["Re-blame for prior revision" mo-git-blame-reblame-for-prior-revision t]
    ["Re-blame for a specific revision" mo-git-blame-reblame-for-specific-revision t]
    "---"
    ["Display status information" mo-git-blame-display-info t]
    ["Display content buffer" mo-git-blame-display-content-buffer t]
    "---"
    ["Exit MoGitBlame" mo-git-blame-quit t]))

(defgroup mo-git-blame nil
  "Interactively use Git's 'blame' from Emacs."
  :prefix "mo-git-blame-"
  :group 'tools)

(defcustom mo-git-blame-git-executable "git"
  "The name of the Git executable."
  :group 'mo-git-blame
  :type 'string)

(defcustom mo-git-blame-incremental t
  "Runs `git blame' in the background with the --incremental
option if this variable is non-nil."
  :group 'mo-git-blame
  :type '(choice (const :tag "Use --incremental" t)
                 (const :tag "Don't use --incremental" nil)))

(defcustom mo-git-blame-blame-window-width 45
  "The width of the 'blame' window leaving the rest for the
'content' window."
  :group 'mo-git-blame
  :type 'integer)

(defcustom mo-git-blame-use-ido 'if-available
  "Controls whether or not ido will be used. Possible choices:

  `never'        -- do not use ido even if it is loaded
  `if-available' -- use ido if it has been loaded before
  `always'       -- automatically load ido and use it"
  :group 'mo-git-blame
  :type '(choice (const :tag "Always" always)
                 (const :tag "If available" if-available)
                 (const :tag "Never" never)))

(defcustom mo-git-blame-use-colors t
  "Use colors to indicate commit age."
  :type 'boolean
  :group 'mo-git-blame)

(defcustom mo-git-blame-time-format "%Y-%m-%d %T"
  "Time format (used in format-time-string) to display"
  :type 'string
  :group 'mo-git-blame)

(defcustom mo-git-blame-time-UTC t
  "Convert all times to univeral timezone"
  :type 'boolean
  :group 'mo-git-blame)

;; The 2 functions and variable were taken from git-blame by
;; David Kågedal, taken from
;; https://github.com/jaalto/emacs-epackage--git-blame-mode

(defmacro mo-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))

(defun mo-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))

(defun mo-git-how-red (color)
  "Returns an int representing the red intensity minus the blue
  intensity for the given color string"
  (let
      ((r (string-to-number (substring color 1 3) 16))
       (g (string-to-number (substring color 3 5) 16))
       (b (string-to-number (substring color 5 7) 16)))
    (+ (- r b) (/ g 512.0))))

(defun mo-git-sort-blue-to-red (colors)
  "Given a list of rgb color strings, sort them to smoothly vary from
  blue to red"
  (let
      ((comp (lambda (a b)
               (< (mo-git-how-red a) (mo-git-how-red b))
               )))
    (sort colors comp)))

(defun mo-git-blame-light-colors ()
  "*List of colors (format #RGB) to use in a light environment.

To check out the list, evaluate (list-colors-display git-blame-light-colors)."
  (mo-git-sort-blue-to-red
;   ;(mo-git-blame-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec")))
   (mo-git-blame-color-scale "aa" "bb" "cc" "dd" "ee" "f0")))

(defvar mo-git-blame-colors '())

;; This function was taken from magit (called 'magit-trim-line' there).
(defun mo-git-blame-trim-line (str)
  (cond ((string= str "")
         nil)
        ((equal (elt str (- (length str) 1)) ?\n)
         (substring str 0 (- (length str) 1)))
        (t str)))

;; This function was taken from magit (called 'magit-git-output' there).
(defun mo-git-blame-git-output (args)
  (with-output-to-string
    (with-current-buffer standard-output
      (apply #'process-file
             mo-git-blame-git-executable
             nil (list t nil) nil
             args))))

;; This function was taken from magit (called 'magit-git-string' there).
(defun mo-git-blame-git-string (&rest args)
  (mo-git-blame-trim-line (mo-git-blame-git-output args)))

(defun mo-git-blame-get-top-dir (cwd)
  (let ((cwd (expand-file-name cwd))
        git-dir)
    (setq git-dir
          (or (getenv "GIT_WORK_TREE")
              (if (file-directory-p cwd)
                  (let* ((default-directory cwd)
                         (dir (mo-git-blame-git-string "rev-parse" "--git-dir"))
                         (dir (concat (or (file-remote-p cwd) "") dir))
                         (dir (if dir (file-name-directory (expand-file-name dir)) "")))
                    (if (and dir (file-directory-p dir))
                        (file-name-as-directory dir))))))
    (or git-dir
        (error "No Git repository found"))))

(defun mo-git-blame-run (&rest args)
  (message "Running 'git %s'..." (car args))
  (apply 'shell-command
         (apply 'concat mo-git-blame-git-executable
                (mapcar (lambda (arg)
                          (concat " " (shell-quote-argument arg)))
                        args))
         (current-buffer) nil)
  (message "Running 'git %s'... done" (car args)))

(defvar mo-git-blame-process nil)
(defvar mo-git-blame-client-buffer nil)

(defun mo-git-blame-assert-not-running ()
  "Exits with an error if `mo-git-blame-incremental' is true and
git is already/still running."
  (if (and mo-git-blame-incremental
           mo-git-blame-process
           (get-buffer "*mo-git-blame-process*"))
      (error "Git is already running")))

(defun mo-git-blame-process-sentinel (process event)
  (let ((msg (format "Git %s." (substring event 0 -1)))
        (successp (string-match "^finished" event)))
    (with-current-buffer (process-buffer process)
      (let ((inhibit-read-only t))
        (goto-char (point-max))
        (insert msg "\n")
        (message msg)))
    (setq mo-git-blame-process nil)
    (message "Running 'git blame'... done")
    (mo-git-blame-colorize)
    ))

(defun mo-git-blame-commit-info-to-time (entry)
  (let* ((tz (plist-get entry :author-tz))
         (mult (if (string= "+" (substring tz 0 1)) 1 -1))
         (hours (string-to-number (substring tz 1 3)))
         (minutes (string-to-number (substring tz 3 5))))
    (seconds-to-time (+ (string-to-number (plist-get entry :author-time))
                        (* mult
                           (+ (* minutes 60)
                              (* hours 3600)))))))

(defun mo-git-blame-process-filter-process-entry (entry)
  (with-current-buffer (plist-get mo-git-blame-vars :blame-buffer)
    (save-excursion
      (let* ((inhibit-read-only t)
	     (ts (plist-get entry :author-time))
	     (shorthash (substring (symbol-name (plist-get entry :hash)) 0 8))
	     (info (format "%s (%s %s %s) %s"
			   shorthash
			   (plist-get entry :author)
			   (format-time-string mo-git-blame-time-format (mo-git-blame-commit-info-to-time entry) mo-git-blame-time-UTC)
			   (plist-get entry :author-tz)
			   (plist-get entry :filename)))
	     i)
	(unless (assq (intern (concat ":" shorthash)) mo-git-blame-rev-ts)
	  (add-to-list 'mo-git-blame-rev-ts (cons shorthash ts)))
        (mo-git-blame-goto-line-markless (plist-get entry :result-line))
        (dotimes (i (plist-get entry :num-lines))
          (insert info)
	  (put-text-property (point-at-bol) (point-at-eol) 'mo-git-blame-rev-ts
			     (plist-get entry :author-time))
          (goto-char (line-beginning-position 2)))))))

(defun mo-git-blame-set-entry (key value)
  (let ((plist (or (plist-get mo-git-blame-data mo-git-blame-curr-entry)
                   (list :hash mo-git-blame-curr-entry))))
    (setq mo-git-blame-data
          (plist-put mo-git-blame-data
                     mo-git-blame-curr-entry
                     (plist-put plist key value)))))

(defun mo-git-blame-process-filter (process string)
  (with-current-buffer (process-buffer process)
    (let ((inhibit-read-only t)
          done matched)
      (save-excursion
        (goto-char (process-mark process))
        (insert string)
        (set-marker (process-mark process) (point)))
      (while (not done)
        (goto-char (line-end-position))
        (setq done (= (point) (point-max)))
        (goto-char (line-beginning-position))
        (unless done
          (setq matched t)
          (cond ((and (not mo-git-blame-curr-entry)
                      (looking-at "^\\([a-fA-F0-9]\\{40\\}\\) +\\([0-9]+\\) +\\([0-9]+\\) +\\([0-9]+\\)$"))
                 ;; SHA line, beginning of entry
                 (setq mo-git-blame-curr-entry (intern (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
                 (mo-git-blame-set-entry :source-line (string-to-number (buffer-substring-no-properties (match-beginning 2) (match-end 2))))
                 (mo-git-blame-set-entry :result-line (string-to-number (buffer-substring-no-properties (match-beginning 3) (match-end 3))))
                 (mo-git-blame-set-entry :num-lines (string-to-number (buffer-substring-no-properties (match-beginning 4) (match-end 4))))
                 )

                ((and mo-git-blame-curr-entry
                      (looking-at "^filename +\\(.+\\)$"))
                 ;; filename line, end of entry
                 (mo-git-blame-set-entry :filename (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                 (mo-git-blame-process-filter-process-entry (plist-get mo-git-blame-data mo-git-blame-curr-entry))
                 (setq mo-git-blame-curr-entry nil)
                 )
                ((and mo-git-blame-curr-entry
                      (looking-at "^\\([a-zA-Z0-9-]+\\) +\\(.+\\)$"))
                 ;; property line
                 (mo-git-blame-set-entry (intern (concat ":" (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
                                         (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                 )

                (t (setq matched nil)))
          (forward-line 1))))))

(defun mo-git-blame-run* (&rest args)
  (message "Running 'git blame'...")
  (let ((buf (get-buffer-create "*mo-git-blame-process*"))
        (cmd (car args))
        (dir default-directory)
        (vars mo-git-blame-vars))
    (save-excursion
      (set-buffer buf)
      (setq buffer-read-only t)
      (let ((inhibit-read-only t))
        (set (make-local-variable 'mo-git-blame-data) nil)
        (set (make-local-variable 'mo-git-blame-curr-entry) nil)
        (set (make-local-variable 'mo-git-blame-vars) vars)
        (setq default-directory dir
              mo-git-blame-process (apply 'start-file-process cmd buf mo-git-blame-git-executable args))
        (set-process-sentinel mo-git-blame-process 'mo-git-blame-process-sentinel)
        (set-process-filter mo-git-blame-process 'mo-git-blame-process-filter)))))

(defun mo-git-blame-get-output-buffer ()
  (let* ((name "*mo-git-blame-output*")
         (buffer (get-buffer name)))
    (if (null buffer)
        (progn
          (setq buffer (get-buffer-create name))
          (with-current-buffer buffer
            (use-local-map mo-git-blame-mode-map))))
    buffer))

(defun mo-git-blame-parse-rev (revision)
  (let ((result (mo-git-blame-git-string "rev-parse" "--short" revision)))
    (unless result
      (error "Unparseable revision %s" revision))
    result))

(defun mo-git-blame-parse-blame-line ()
  (save-excursion
    (save-match-data
      (beginning-of-line)
      (cond ((looking-at "^\\([a-f0-9]+\\) +\\(([^)]+)\\) *$")
             (list :hash (buffer-substring (match-beginning 1) (match-end 1))
                   :file-name (plist-get mo-git-blame-vars :file-name)
                   :timestamp (buffer-substring (match-beginning 2) (match-end 2))))
            ((looking-at "^\\([a-f0-9]+\\) +\\(([^)]+)\\) +\\(.+\\)")
             (list :hash (buffer-substring (match-beginning 1) (match-end 1))
                   :file-name (buffer-substring (match-beginning 3) (match-end 3))
                   :timestamp (buffer-substring (match-beginning 2) (match-end 2))))
            (t (error "Not a 'git blame' line"))))))

(defun mo-git-blame-revision-at-point ()
  (plist-get (mo-git-blame-parse-blame-line) :hash))

(defun mo-git-blame-log-for-revision (revision)
  (let ((file-name (plist-get mo-git-blame-vars :file-name))
        (buffer (mo-git-blame-get-output-buffer)))
    (with-current-buffer buffer
      (erase-buffer)
      (mo-git-blame-run "log" revision "--" file-name)
      (goto-char (point-min)))
    (display-buffer buffer)))

(defun mo-git-blame-log-for-revision-at ()
  "Calls 'git log' for revision in the current line."
  (interactive)
  (mo-git-blame-log-for-revision (mo-git-blame-revision-at-point)))

(defun mo-git-blame-log-for-current-revision ()
  "Calls 'git log' for the buffer's current revision and file."
  (interactive)
  (mo-git-blame-log-for-revision (plist-get mo-git-blame-vars :current-revision)))

(defun mo-git-blame-show-revision (revision)
  (let ((buffer (mo-git-blame-get-output-buffer)))
    (with-current-buffer buffer
      (erase-buffer)
      (mo-git-blame-run "show" revision)
      (goto-char (point-min))
      (diff-mode))
    (display-buffer buffer)))

(defun mo-git-blame-show-revision-at ()
  "Calls 'git show' for the revision in the current line."
  (interactive)
  (mo-git-blame-show-revision (mo-git-blame-revision-at-point)))

(defun mo-git-blame-show-current-revision ()
  "Calls 'git show' for the current revision."
  (interactive)
  (mo-git-blame-show-revision (plist-get mo-git-blame-vars :current-revision)))

(defun mo-git-blame-content-for-revision-at ()
  "Calls 'git cat-file' for the revision in the current line."
  (interactive)
  (let ((info (mo-git-blame-parse-blame-line))
        (buffer (mo-git-blame-get-output-buffer)))
    (with-current-buffer buffer
      (erase-buffer)
      (mo-git-blame-run "cat-file" "blob" (concat (plist-get info :hash) ":" (plist-get info :file-name)))
      (goto-char (point-min)))
    (display-buffer buffer)))

(defun mo-git-blame-overwrite-file-with-revision (revision)
  (let ((file-name (plist-get mo-git-blame-vars :original-file-name)))
    (if (yes-or-no-p (format "Do you really want to overwrite %s with revision %s " file-name revision))
        (progn
          (find-file (concat (plist-get mo-git-blame-vars :top-dir) file-name))
          (erase-buffer)
          (mo-git-blame-run "cat-file" "blob" (concat revision ":" file-name))
          (goto-char (point-min))))))

(defun mo-git-blame-overwrite-file-with-revision-at ()
  "Calls 'git cat-file' for the revision in the current line and overwrites
the original file's content. The file is not saved but left modified in an
open buffer."
  (interactive)
  (mo-git-blame-overwrite-file-with-revision (mo-git-blame-revision-at-point)))

(defun mo-git-blame-overwrite-file-with-current-revision ()
  "Calls 'git cat-file' for the current revision and overwrites
the original file's content. The file is not saved but left modified in an
open buffer."
  (interactive)
  (mo-git-blame-overwrite-file-with-revision (plist-get mo-git-blame-vars :current-revision)))

(defun mo-git-blame-reblame-for-ancestor-of-revision-at (&optional arg)
  "Calls 'git blame' for the ancestor of the revision in the current line.

With a numeric prefix argument ARG only the ARG lines before and
after point are blamed by using git blame's `-L'
option. Otherwise the whole file is blamed."
  (interactive "P")
  (mo-git-blame-reblame-for-specific-revision (mo-git-blame-parse-rev (concat (plist-get (mo-git-blame-parse-blame-line) :hash) "~")) arg))

(defun mo-git-blame-reblame-for-ancestor-of-current-revision (&optional arg)
  "Calls 'git blame' for the ancestor of the current revision.

With a numeric prefix argument ARG only the ARG lines before and
after point are blamed by using git blame's `-L'
option. Otherwise the whole file is blamed."
  (interactive "P")
  (mo-git-blame-reblame-for-specific-revision (mo-git-blame-parse-rev (concat (plist-get mo-git-blame-vars :current-revision) "~")) arg))

(defun mo-git-blame-reblame-for-revision-at (&optional arg)
  "Calls 'git blame' for the revision in the current line.

With a numeric prefix argument ARG only the ARG lines before and
after point are blamed by using git blame's `-L'
option. Otherwise the whole file is blamed."
  (interactive "P")
  (let* ((info (mo-git-blame-parse-blame-line))
         (revision (plist-get info :hash)))
    (if (string= revision (plist-get mo-git-blame-vars :current-revision))
        (error "Already showing this revision"))
    (mo-git-blame-file (concat (plist-get mo-git-blame-vars :top-dir) (plist-get info :file-name)) revision (plist-get mo-git-blame-vars :original-file-name) arg)))

(defun mo-git-blame-reblame-for-specific-revision (&optional revision arg)
  "Calls 'git blame' for a specific REVISION.

With a numeric prefix argument ARG only the ARG lines before and
after point are blamed by using git blame's `-L'
option. Otherwise the whole file is blamed."
  (interactive "sRevision: \nP")
  (setq revision (mo-git-blame-parse-rev revision))
  (if (string= revision (plist-get mo-git-blame-vars :current-revision))
      (error "Already showing this revision"))
  (mo-git-blame-file (concat (plist-get mo-git-blame-vars :top-dir) (plist-get mo-git-blame-vars :file-name)) revision (plist-get mo-git-blame-vars :original-file-name) arg))

(defun mo-git-blame-reblame-for-prior-revision (&optional arg)
  "Calls 'git blame' for the revision shown before the current
one (see `prior revisions' in the info output of
`mo-git-blame-display-info').

With a numeric prefix argument ARG only the ARG lines before and
after point are blamed by using git blame's `-L'
option. Otherwise the whole file is blamed."
  (interactive "P")
  (let ((rev-list (plist-get mo-git-blame-vars :prior-revisions))
        revision-plist)
    (unless rev-list
      (error "No revision shown prior to the current one"))
    (setq revision-plist (car rev-list))
    (mo-git-blame-file (plist-get revision-plist :full-file-name)
                       (plist-get revision-plist :revision)
                       (plist-get mo-git-blame-vars :original-file-name)
                       arg)))

(defun mo-git-blame-display-info ()
  "Displays short information about the current revision."
  (interactive)
  (let* ((buffer (mo-git-blame-get-output-buffer))
         (vars mo-git-blame-vars)
         (prior-revs (plist-get vars :prior-revisions))
         (prior-revs-str (if prior-revs
                             (reduce (lambda (joined element) (concat (or joined "") (if joined " " "") element))
                                     (mapcar (lambda (element) (plist-get element :revision))
                                             prior-revs))
                           "none")))
    (with-current-buffer buffer
      (erase-buffer)
      (insert (format "Current revision:   %s\n" (plist-get vars :current-revision))
              (format "Prior revisions:    %s\n" prior-revs-str)
              (format "Git repository:     %s\n" (plist-get vars :top-dir))
              (format "Original file name: %s\n" (file-relative-name (plist-get vars :original-file-name)
                                                                     (plist-get vars :top-dir)))
              (format "Current file name:  %s\n" (plist-get vars :file-name)))
      (goto-char (point-min)))
    (display-buffer buffer)))

(defun mo-git-blame-number-of-content-lines ()
  (with-current-buffer (plist-get mo-git-blame-vars :content-buffer)
    (save-excursion
      (goto-char (point-max))
      (line-number-at-pos))))

(defun mo-git-blame-mode ()
  "Show the output of 'git blame' and the content of the file in
two frames side-by-side. Allows iterative re-blaming for specific
revisions. Can show the output of 'git log' and 'git show'. Can
overwrite the file with the content of specific revisions by
calling 'git cat-file blob ...'.

Use 'mo-git-blame-current' interactively or 'mo-git-blame-file'
from elisp.

\\{mo-git-blame-mode-map}"
  (setq major-mode 'mo-git-blame-mode
        mode-name "MoGitBlame"
        mode-line-process ""
        truncate-lines t)
  (use-local-map mo-git-blame-mode-map))

(defun mo-git-blame-run-blame-normally (start-line lines-to-blame)
  (let* ((num-content-lines (mo-git-blame-number-of-content-lines))
         (num-lines-to-append (if (and start-line
                                       (< (+ start-line lines-to-blame)
                                          num-content-lines))
                                  (- num-content-lines start-line lines-to-blame)))
         args i)
    (if (and start-line (> start-line 1))
        (dotimes (i (1- start-line))
          (insert "\n")))

    (setq args (list (plist-get mo-git-blame-vars :current-revision) "--" (plist-get mo-git-blame-vars :file-name)))
    (if start-line
        (setq args (append (list "-L" (format "%d,+%d" start-line lines-to-blame))
                           args)))
    (apply 'mo-git-blame-run "blame" args)

    (if num-lines-to-append
        (dotimes (i num-lines-to-append)
          (insert "\n")))))

(defun mo-git-blame-run-blame-incrementally (start-line lines-to-blame)
  (let* ((num-content-lines (mo-git-blame-number-of-content-lines))
         i)
    (dotimes (i (1- num-content-lines))
      (insert "\n"))

    (setq args (list "--incremental" (plist-get mo-git-blame-vars :current-revision) "--" (plist-get mo-git-blame-vars :file-name)))
    (if start-line
        (setq args (append (list "-L" (format "%d,+%d" start-line lines-to-blame))
                           args)))
    (mo-git-blame-assert-not-running)
    (apply 'mo-git-blame-run* "blame" args)))

(defun mo-git-blame-init-blame-buffer (start-line lines-to-blame)
  (if mo-git-blame-incremental
      (mo-git-blame-run-blame-incrementally start-line lines-to-blame)
    (mo-git-blame-run-blame-normally start-line lines-to-blame))
  (goto-char (point-min))
  (save-match-data
    (while (re-search-forward "^\\([a-f0-9]+\\) +\\(([^)]+)\\) \\(.*\\)" nil t)
      (replace-match "\\1 \\2" nil nil))
    (goto-char (point-min))
    (while (re-search-forward "^\\([a-f0-9]+\\) +\\([^ ]+\\) +\\(([^)]+)\\) \\(.*\\)" nil t)
      (replace-match "\\1 \\3 \\2" nil nil))
    (goto-char (point-min))
    (while (re-search-forward " +[0-9]+)" nil t)
      (replace-match ")" nil nil)))
  (toggle-read-only t)
  (goto-char (point-min))
  (set (make-local-variable 'line-move-visual) nil))

(defun mo-git-blame-init-content-buffer ()
  (let ((vars mo-git-blame-vars))
    (rename-buffer (concat "*mo-git-blame:" (file-name-nondirectory (plist-get vars :full-file-name)) ":" (plist-get vars :current-revision) "*"))
    (setq buffer-file-name (file-name-nondirectory (plist-get vars :full-file-name))
          default-directory (plist-get vars :top-dir))
    (mo-git-blame-run "cat-file" "blob" (concat (plist-get vars :current-revision) ":" (plist-get vars :file-name)))
    (normal-mode)
    (use-local-map mo-git-blame-content-mode-map)
    (font-lock-fontify-buffer)
    (toggle-read-only t)
    (set-buffer-modified-p nil)
    (setq truncate-lines t)
    (set (make-local-variable 'mo-git-blame-vars) vars)
    (set (make-local-variable 'line-move-visual) nil)))

(defun mo-git-blame-read-file-name ()
  "Calls `read-file-name' or `ido-read-file-name' depending on
the value of `mo-git-blame-use-ido'."
  (let ((the-func (cond ((eq mo-git-blame-use-ido 'always)
                         (require 'ido)
                         'ido-read-file-name)
                        ((and (eq mo-git-blame-use-ido 'if-available)
                              (functionp 'ido-read-file-name))
                         'ido-read-file-name)
                        (t 'read-file-name))))
    (funcall the-func "File for 'git blame': " nil nil t)))

;;;###autoload
(defun mo-git-blame-file (&optional file-name revision original-file-name num-lines-to-blame)
  "Calls `git blame' for REVISION of FILE-NAME or `HEAD' if
REVISION is not given. Initializes the two windows that will show
the output of 'git blame' and the content.

If FILE-NAME is missing it will be read with `find-file' in
interactive mode.

ORIGINAL-FILE-NAME defaults to FILE-NAME if not given. This is
used for tracking renaming and moving of files during iterative
re-blaming.

With a numeric prefix argument or with NUM-LINES-TO-BLAME only
the NUM-LINES-TO-BLAME lines before and after point are blamed by
using git blame's `-L' option. Otherwise the whole file is
blamed."
  (interactive)
  (mo-git-blame-assert-not-running)
  (unless mo-git-blame--wincfg
    (setq mo-git-blame--wincfg (current-window-configuration)))
  (let* ((file-name (or file-name (mo-git-blame-read-file-name)))
         (has-blame-vars (local-variable-p 'mo-git-blame-vars))
         (the-raw-revision (or revision "HEAD"))
         (the-revision (if (string= the-raw-revision "HEAD")
                           (mo-git-blame-parse-rev "HEAD")
                         the-raw-revision))
         (base-name (concat (file-name-nondirectory file-name) "@" the-revision))
         (blame-buffer (get-buffer-create "*mo-git-blame*"))
         (content-buffer-name (concat "*mo-git-blame:" (file-name-nondirectory file-name) ":" the-revision "*"))
         (content-buffer (if has-blame-vars
                             (plist-get mo-git-blame-vars :content-buffer)
                           (get-buffer-create content-buffer-name)))
         (top-dir (mo-git-blame-get-top-dir (file-name-directory file-name)))
         (relative-file-name (file-relative-name file-name top-dir))
         (blame-window (selected-window))
         (prior-vars (if has-blame-vars mo-git-blame-vars))
         (line-to-go-to (line-number-at-pos))
         (lines-to-blame (or num-lines-to-blame
                             (if (and current-prefix-arg (> (prefix-numeric-value current-prefix-arg) 0))
                                 (prefix-numeric-value current-prefix-arg))))
         content-window the-buffer prior-revisions start-line)
    (switch-to-buffer blame-buffer)
    (setq prior-revisions (if prior-vars (plist-get prior-vars :prior-revisions)))
    (setq prior-revisions
          (if (and prior-revisions (string= the-revision (plist-get (car prior-revisions) :revision)))
              (cdr prior-revisions)
            (if prior-vars
                (cons (list :full-file-name (plist-get prior-vars :full-file-name)
                            :revision (plist-get prior-vars :current-revision))
                      prior-revisions))))
    (if (window-full-width-p)
        (split-window-horizontally mo-git-blame-blame-window-width))
    (select-window (setq content-window (next-window)))
    (switch-to-buffer content-buffer)
    (select-window blame-window)
    (dolist (the-buffer (list blame-buffer content-buffer))
      (with-current-buffer the-buffer
        (toggle-read-only 0)
        (kill-all-local-variables)
        (buffer-disable-undo)
        (erase-buffer)
        (setq default-directory top-dir)
        (set (make-local-variable 'mo-git-blame-vars)
             (list :top-dir top-dir
                   :file-name relative-file-name
                   :full-file-name file-name
                   :original-file-name (or original-file-name file-name)
                   :current-revision the-revision
                   :prior-revisions prior-revisions
                   :blame-buffer blame-buffer
                   :blame-window blame-window
                   :content-buffer content-buffer
                   :content-window content-window))))
    (with-current-buffer content-buffer
      (mo-git-blame-init-content-buffer))
    (when lines-to-blame
      (setq start-line (max 1 (- line-to-go-to lines-to-blame))
            lines-to-blame (1+ (- (+ line-to-go-to lines-to-blame)
                                  start-line))))
    (with-current-buffer blame-buffer
      (mo-git-blame-mode)
      (mo-git-blame-init-blame-buffer start-line lines-to-blame))
    (mo-git-blame-goto-line line-to-go-to)
    (add-to-list 'window-scroll-functions 'mo-git-blame-window-scrolled)))

(defvar mo-git-blame-scroll-info
  nil
  "Information which window to scroll and where to scroll to.")

(defun mo-git-blame-window-scrolled (window new-start-pos)
  (if (and window
           (eq window (selected-window))
           (local-variable-p 'mo-git-blame-vars))
      (let* ((vars (with-current-buffer (window-buffer window) mo-git-blame-vars))
             (start-line (line-number-at-pos new-start-pos))
             (point-line (line-number-at-pos (window-point window)))
             (window-to-scroll (if (eq window (plist-get vars :blame-window))
                                   (plist-get vars :content-window)
                                 (plist-get vars :blame-window))))
        (setq mo-git-blame-scroll-info (list :window-to-scroll window-to-scroll
                                             :start-line start-line
                                             :point-line point-line))
        (run-at-time "0 sec" nil 'mo-git-blame-update-other-window-after-scrolling))))

(defun mo-git-blame-update-other-window-after-scrolling ()
  (if mo-git-blame-scroll-info
      (let ((window (plist-get mo-git-blame-scroll-info :window-to-scroll))
            new-start-pos)
        (with-selected-window window
          (with-current-buffer (window-buffer window)
            (goto-char (point-min))
            (setq new-start-pos (line-beginning-position (plist-get mo-git-blame-scroll-info :start-line)))
            (goto-char (point-min))
            (goto-char (line-beginning-position (plist-get mo-git-blame-scroll-info :point-line)))
            (set-window-start window new-start-pos)))
        (setq mo-git-blame-scroll-info nil))))

(defun mo-git-blame-quit ()
  "Kill the mo-git-blame buffers."
  (interactive)
  (setq window-scroll-functions (remq 'mo-git-blame-window-scrolled window-scroll-functions))
  (let ((buffer))
    (dolist (buffer (buffer-list))
      (if (string-match-p "^\\*mo-git-blame" (buffer-name buffer))
          (kill-buffer buffer))))
  (set-window-configuration mo-git-blame--wincfg)
  (setq mo-git-blame--wincfg nil))

(defun mo-git-blame-display-content-buffer ()
  "Show the content buffer in the content window."
  (interactive)
  ;; Declare buffer here because mo-git-blame-vars might not be available in the other buffer.
  (let ((buffer (plist-get mo-git-blame-vars :content-buffer))
        (line-num (line-number-at-pos)))
    (mo-git-blame-goto-line-markless line-num)
    (recenter)
    (with-selected-window (plist-get mo-git-blame-vars :content-window)
      (switch-to-buffer buffer)
      (mo-git-blame-goto-line-markless line-num)
      (recenter))))

(defun mo-git-blame-other-buffer ()
  (plist-get mo-git-blame-vars
             (if (eq (current-buffer) (plist-get mo-git-blame-vars :blame-buffer))
                 :content-buffer
               :blame-buffer)))

(defun mo-git-blame-goto-line-markless (line)
  (goto-char (point-min))
  (goto-char (line-beginning-position line)))

(defun mo-git-blame-goto-line (line)
  "Goto a line in both the blame and the content buffer."
  (interactive "nGoto line: ")
  (with-selected-window (plist-get mo-git-blame-vars :blame-window)
    (mo-git-blame-goto-line-markless line))
  (with-selected-window (plist-get mo-git-blame-vars :content-window)
    (mo-git-blame-goto-line-markless line)))


;; poor mans line highlight. Go through each line in the buffer, make
;; a dictionary of the hash, and assign it to a color from the
;; specified git colors
(defun create-buffer-hash-colors (h)
  (save-excursion
    (goto-char (point-min))
    (while (= 0 (forward-line))
      (let
          ((hash (car (split-string 
                       (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))
        (if (gethash hash h)
            ()
          (puthash hash (pop mo-git-blame-colors)
                   h))))))

  ;; (dolist
  ;;     (line (split-string
  ;;            (buffer-substring-no-properties (point-min) (point-max))
  ;;            "\n"))
  ;;   (let
  ;;       ((hash (car (split-string line))))
  ;;     (if (gethash hash h)
  ;;         ()
  ;;       (puthash hash (mo-git-blame-random-pop mo-git-blame-colors) h)))))

;; applies the buffer hash colors passed in to every line in the buffer
(defun apply-buffer-hash-colors (h)
  (save-excursion
    (goto-char (point-min))
    (while (= 0 (forward-line))
      (let
          ((color (gethash (car (split-string 
                            (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
                      h)))
        ;(if (> (length color) 0)
            (overlay-put
             (make-overlay (point-at-bol) (point-at-eol))
             'face
             (list :background color))
          ;()
          ;)
            ))))

(defun apply-buffer-alist-colors (colors)
  (save-excursion
    (goto-char (point-min))
    (while (= 0 (forward-line))
      (let
          ((color (cdr (assq (intern (concat ":" (car (split-string 
						       (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) colors))))
        ;(if (> (length color) 0)
	(message color)
            (overlay-put
             (make-overlay (point-at-bol) (point-at-eol))
             'face
             (list :background color))
          ;()
          ;)
            ))))

(defun mo-git-blame-colorize ()
  (let*
      ((window (plist-get mo-git-blame-vars :blame-window))
       (sorted-hashes (sort mo-git-blame-rev-ts
			    (lambda (a b) (< (string-to-number (cdr a)) (string-to-number (cdr b))))))
       (num-hashes (length sorted-hashes))
       (colors (mo-git-blame-build-colorscale num-hashes))
       )
    (with-selected-window window
      (with-current-buffer (window-buffer window)
        (apply-buffer-alist-colors colors)))))

(defun mo-git-blame-colorize-old ()
  (let
      ((table (make-hash-table :test 'equal))
       (window (plist-get mo-git-blame-vars :blame-window)))
    (with-selected-window window
      (with-current-buffer (window-buffer window)
        (make-local-variable 'mo-git-blame-colors)
        (setq mo-git-blame-colors (mo-git-blame-light-colors))
        (create-buffer-hash-colors table)
        (apply-buffer-hash-colors table)
        (clrhash table)
        (message "colorize done")))))

;; TEMP: move
(defun mo-git-blame-build-colorscale (n)
  (mo-git-light-colors 0.0 (/ 1.0 (- n 1)))
  ;;;; TODO: somehow turn attach the colors to the alist mo-git-blame-rev-ts
  )

(defun mo-git-colors (x delta)
  (if (> x 1.0) ()
    (cons
     (format "#%02x%02x%02x"
             (* 255 (if (< x 0.5) 0 (* (- x 0.5) 2)))
             (* 255 (if (< x 0.5) (* 2 x) (* 2 (- 1.0 x))))
             (* 255 (if (> x 0.5) 0 (- 1.0 (* x 2.0))))
             )
     (mo-git-light-colors (+ x delta) delta))))

(defun mo-git-light-colors (x delta)
  (if (> x 1.0) ()
    (cons
     (format "#%02x%02x%02x"
             (* 255 (if (< x 0.5) 0.5 x))
             (* 255 (if (< x 0.5) (+ 0.5 x) (- 1.0 (- x 0.5))))
             (* 255 (if (> x 0.5) 0.5 (- 1.0 (* x 1.0))))
             )
     (mo-git-light-colors (+ x delta) delta))))

(defun mo-git-blame-test-colors (n)
  "testing function to show all of the colors"
  (switch-to-buffer "tmp-colors")
  (let
      ((colors (mo-git-light-colors 0.0 (/ 1.0 (- n 1)) ;7.8125e-3
                                    ))
       (table (make-hash-table :test 'equal)))
    (dolist (c colors)
      (prin1 c (current-buffer))
      (overlay-put
       (make-overlay (point-at-bol) (point-at-eol))
       'face
       (list :background c))
      (prin1 "\n" (current-buffer))
      )))


;;;###autoload
(defun mo-git-blame-current ()
  "Calls `mo-git-blame-file' for HEAD for the current buffer."
  (interactive)
  (if (null (buffer-file-name))
      (error "The current buffer is not associated with a file."))
  (mo-git-blame-file (buffer-file-name)))

(provide 'mo-git-blame)

;; Leave this in for debugging purposes:
;; (global-set-key [?\C-c ?i ?b] (lambda () (interactive) (let ((mo-git-blame-incremental t)) (mo-git-blame-current))))
;; (global-set-key [?\C-c ?i ?B] (lambda () (interactive) (let ((mo-git-blame-incremental nil)) (mo-git-blame-current))))

;;; mo-git-blame.el ends here