This repository has been archived by the owner. It is now read-only.
Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
828 lines (732 sloc) 36.3 KB
;;; 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--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-git-blame-args ""
"Additional arguments to pass to git blame."
: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-magit 'if-available
"Controls whether or not magit will be used. Possible choices:
`never' -- do not use magit even if it is loaded
`if-available' -- use magit if it has been loaded before
`always' -- automatically load magit 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-delete-other-windows nil
"Delete other windows before setting up the blame-window and the
content-window if variable is non-nil."
:group 'mo-git-blame
:type '(choice (const :tag "Delete other windows" t)
(const :tag "Don't delete other windows" nil)))
;; 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 (or (getenv "GIT_WORK_TREE")
(if (file-directory-p cwd)
(let* ((default-directory cwd)
(dir (mo-git-blame-git-string "rev-parse" "--show-toplevel"))
(dir (concat (or (file-remote-p cwd) "") 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")))
(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)
(info (format "%s (%s %s %s) %s"
(substring (symbol-name (plist-get entry :hash)) 0 7)
(plist-get entry :author)
(format-time-string "%Y-%m-%d %T" (mo-git-blame-commit-info-to-time entry) t)
(plist-get entry :author-tz)
(plist-get entry :filename)))
i)
(mo-git-blame-goto-line-markless (plist-get entry :result-line))
(dotimes (i (plist-get entry :num-lines))
(insert info)
(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--diff-mode (revision)
"Internal function that fills the current buffer with revision using diff-mode"
(erase-buffer)
(mo-git-blame-run "show" revision)
(goto-char (point-min))
(diff-mode))
(defun mo-git-blame-show-revision--magit (revision)
"Internal function that fills the current buffer with revision using magit"
(let ((magit-commit-buffer-name (buffer-name)))
(magit-show-commit revision)))
(defun mo-git-blame-show-revision (revision)
(let ((buffer (mo-git-blame-get-output-buffer))
(the-func (cond ((eq mo-git-blame-use-magit 'always)
(require 'magit)
'mo-git-blame-show-revision--magit)
((and (eq mo-git-blame-use-magit 'if-available)
(functionp 'magit-show-commit))
'mo-git-blame-show-revision--magit)
(t 'mo-git-blame-show-revision--diff-mode))))
(with-current-buffer buffer
(funcall the-func revision))
(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))))
(defvar mo-git-blame-mode-hook nil
"Mode hook.")
(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)
(run-hooks 'mo-git-blame-mode-hook))
(defun mo-git-blame--make-args (args)
(delete ""
(append (list mo-git-blame-git-blame-args)
args)))
(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" (mo-git-blame--make-args 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 args)
(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" (mo-git-blame--make-args 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))))
(when mo-git-blame-delete-other-windows
(delete-other-windows-internal))
(if (window-full-width-p)
(split-window-horizontally mo-git-blame-blame-window-width)
(shrink-window-horizontally (- (window-width)
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)))
;;;###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 (file-truename (buffer-file-name))))
;;;###autoload
(defun mo-git-blame-current-for-revision (revision)
"Calls `mo-git-blame-file' for `revision' for the current buffer."
(interactive "sRevision: ")
(if (null (buffer-file-name))
(error "The current buffer is not associated with a file."))
(mo-git-blame-file (file-truename (buffer-file-name)) revision))
(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