308 lines
11 KiB
EmacsLisp
308 lines
11 KiB
EmacsLisp
;;; magit-blame.el --- blame support for Magit
|
|
|
|
;; Copyright (C) 2012-2015 The Magit Project Developers
|
|
;;
|
|
;; For a full list of contributors, see the AUTHORS.md file
|
|
;; at the top-level directory of this distribution and at
|
|
;; https://raw.github.com/magit/magit/master/AUTHORS.md
|
|
|
|
;; Author: Yann Hodique <yann.hodique@gmail.com>
|
|
;; Package: magit
|
|
|
|
;; Contains code from Egg (Emacs Got Git) <https://github.com/byplayer/egg>,
|
|
;; released under the GNU General Public License version 3 or later.
|
|
|
|
;; Magit 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.
|
|
;;
|
|
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Control git-blame from Magit.
|
|
;; This code has been backported from Egg (Magit fork) to Magit.
|
|
|
|
;;; Code:
|
|
|
|
(eval-when-compile (require 'cl-lib))
|
|
(require 'magit)
|
|
(require 'easymenu)
|
|
|
|
;;; Options
|
|
|
|
(defgroup magit-blame nil
|
|
"Git-blame support for Magit."
|
|
:group 'magit-extensions)
|
|
|
|
(defcustom magit-blame-ignore-whitespace t
|
|
"Ignore whitespace when determining blame information."
|
|
:group 'magit-blame
|
|
:type 'boolean)
|
|
|
|
(defcustom magit-time-format-string "%Y-%m-%dT%T%z"
|
|
"How to format time in magit-blame header."
|
|
:group 'magit-blame
|
|
:type 'string)
|
|
|
|
(defface magit-blame-header
|
|
'((t :inherit magit-section-title))
|
|
"Face for blame header."
|
|
:group 'magit-faces)
|
|
|
|
(defface magit-blame-sha1
|
|
'((t :inherit (magit-log-sha1 magit-blame-header)))
|
|
"Face for blame sha1."
|
|
:group 'magit-faces)
|
|
|
|
(defface magit-blame-culprit
|
|
'((t :inherit magit-blame-header))
|
|
"Face for blame culprit."
|
|
:group 'magit-faces)
|
|
|
|
(defface magit-blame-time
|
|
'((t :inherit magit-blame-header))
|
|
"Face for blame time."
|
|
:group 'magit-faces)
|
|
|
|
(defface magit-blame-subject
|
|
'((t :inherit (magit-log-message magit-blame-header)))
|
|
"Face for blame tag line."
|
|
:group 'magit-faces)
|
|
|
|
;;; Keymaps
|
|
|
|
(defvar magit-blame-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map (kbd "l") 'magit-blame-locate-commit)
|
|
(define-key map (kbd "RET") 'magit-blame-locate-commit)
|
|
(define-key map (kbd "q") 'magit-blame-mode)
|
|
(define-key map (kbd "n") 'magit-blame-next-chunk)
|
|
(define-key map (kbd "p") 'magit-blame-previous-chunk)
|
|
map)
|
|
"Keymap for an annotated section.\\{magit-blame-map}")
|
|
|
|
(easy-menu-define magit-blame-mode-menu magit-blame-map
|
|
"Magit blame menu"
|
|
'("Blame"
|
|
["Locate Commit" magit-blame-locate-commit t]
|
|
["Next" magit-blame-next-chunk t]
|
|
["Previous" magit-blame-previous-chunk t]
|
|
"---"
|
|
["Quit" magit-blame-mode t]))
|
|
|
|
;;; Mode
|
|
|
|
(defvar-local magit-blame-buffer-read-only nil)
|
|
|
|
;;;###autoload
|
|
(define-minor-mode magit-blame-mode
|
|
"Display blame information inline."
|
|
:keymap magit-blame-map
|
|
:lighter " blame"
|
|
(unless (buffer-file-name)
|
|
(user-error "Current buffer has no associated file!"))
|
|
(when (and (buffer-modified-p)
|
|
(y-or-n-p (format "save %s first? " (buffer-file-name))))
|
|
(save-buffer))
|
|
|
|
(cond (magit-blame-mode
|
|
(setq magit-blame-buffer-read-only buffer-read-only)
|
|
(magit-blame-file-on (current-buffer))
|
|
(set-buffer-modified-p nil)
|
|
(setq buffer-read-only t))
|
|
(t
|
|
(magit-blame-file-off (current-buffer))
|
|
(set-buffer-modified-p nil)
|
|
(setq buffer-read-only magit-blame-buffer-read-only))))
|
|
|
|
(defun magit-blame-file-off (buffer)
|
|
(save-excursion
|
|
(save-restriction
|
|
(with-current-buffer buffer
|
|
(widen)
|
|
(mapc (lambda (ov)
|
|
(when (overlay-get ov :blame)
|
|
(delete-overlay ov)))
|
|
(overlays-in (point-min) (point-max)))))))
|
|
|
|
(defun magit-blame-file-on (buffer)
|
|
(magit-blame-file-off buffer)
|
|
(save-excursion
|
|
(with-current-buffer buffer
|
|
(save-restriction
|
|
(with-temp-buffer
|
|
(apply 'magit-git-insert "blame" "--porcelain"
|
|
`(,@(and magit-blame-ignore-whitespace (list "-w")) "--"
|
|
,(file-name-nondirectory (buffer-file-name buffer))))
|
|
(magit-blame-parse buffer (current-buffer)))))))
|
|
|
|
;;; Commands
|
|
|
|
(defun magit-blame-locate-commit (pos)
|
|
"Jump to a commit in the branch history from an annotated blame section."
|
|
(interactive "d")
|
|
(let ((overlays (overlays-at pos))
|
|
sha1)
|
|
(dolist (ov overlays)
|
|
(when (overlay-get ov :blame)
|
|
(setq sha1 (plist-get (nth 3 (overlay-get ov :blame)) :sha1))))
|
|
(when sha1
|
|
(magit-show-commit sha1))))
|
|
|
|
(defun magit-blame-next-chunk ()
|
|
"Go to the next blame chunk."
|
|
(interactive)
|
|
(let ((next (next-single-property-change (point) :blame)))
|
|
(when next
|
|
(goto-char next))))
|
|
|
|
(defun magit-blame-previous-chunk ()
|
|
"Go to the previous blame chunk."
|
|
(interactive)
|
|
(let ((prev (previous-single-property-change (point) :blame)))
|
|
(when prev
|
|
(goto-char prev))))
|
|
|
|
;;; Parse
|
|
|
|
(defun magit-blame-decode-time (unixtime &optional tz)
|
|
"Decode UNIXTIME into (HIGH LOW) format.
|
|
|
|
The second argument TZ can be used to add the timezone in (-)HHMM
|
|
format to UNIXTIME. UNIXTIME should be either a number
|
|
containing seconds since epoch or Emacs's (HIGH LOW . IGNORED)
|
|
format."
|
|
(when (numberp tz)
|
|
(unless (numberp unixtime)
|
|
(setq unixtime (float-time unixtime)))
|
|
(let* ((ptz (abs tz))
|
|
(min (+ (* (/ ptz 100) 60)
|
|
(mod ptz 100))))
|
|
(setq unixtime (+ (* (if (< tz 0) (- min) min) 60) unixtime))))
|
|
|
|
(when (numberp unixtime)
|
|
(setq unixtime (seconds-to-time unixtime)))
|
|
unixtime)
|
|
|
|
(defun magit-blame-format-time-string (format &optional unixtime tz)
|
|
"Use FORMAT to format the time UNIXTIME, or now if omitted.
|
|
|
|
UNIXTIME is specified as a number containing seconds since epoch
|
|
or Emacs's (HIGH LOW . IGNORED) format. The optional argument TZ
|
|
can be used to set the time zone. If TZ is a number it is
|
|
treated as a (-)HHMM offset to Universal Time. If TZ is not
|
|
a number and non-nil the time is printed in UTC. If TZ is nil
|
|
the local zime zone is used. The format of the function is
|
|
similar to `format-time-string' except for %Z which is not
|
|
officially supported at the moment."
|
|
(unless unixtime
|
|
(setq unixtime (current-time)))
|
|
(when (numberp tz) ;; TODO add support for %Z
|
|
(setq format (replace-regexp-in-string "%z" (format "%+05d" tz) format)))
|
|
(format-time-string format (magit-blame-decode-time unixtime tz) tz))
|
|
|
|
(defun magit-blame-parse (target-buf blame-buf)
|
|
"Parse blame-info in buffer BLAME-BUF and decorate TARGET-BUF buffer."
|
|
(save-match-data
|
|
(let ((blank (propertize " " 'face 'magit-blame-header))
|
|
(nl (propertize "\n" 'face 'magit-blame-header))
|
|
(commit-hash (make-hash-table :test 'equal :size 577))
|
|
commit commit-info old-line new-line num old-file subject author
|
|
author-time author-timezone info ov beg end blame)
|
|
(with-current-buffer blame-buf
|
|
(goto-char (point-min))
|
|
;; search for a ful commit info
|
|
(while (re-search-forward
|
|
"^\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)$"
|
|
nil t)
|
|
(setq commit (match-string-no-properties 1)
|
|
old-line (string-to-number
|
|
(match-string-no-properties 2))
|
|
new-line (string-to-number
|
|
(match-string-no-properties 3))
|
|
num (string-to-number
|
|
(match-string-no-properties 4)))
|
|
;; was this commit already seen (and stored in the hash)?
|
|
(setq commit-info (gethash commit commit-hash))
|
|
;; Nope, this is the 1st time, the full commit-info follow.
|
|
(unless commit-info
|
|
(re-search-forward "^author \\(.+\\)$")
|
|
(setq author (match-string-no-properties 1))
|
|
(re-search-forward "^author-time \\(.+\\)$")
|
|
(setq author-time (string-to-number
|
|
(match-string-no-properties 1)))
|
|
(re-search-forward "^author-tz \\(.+\\)$")
|
|
(setq author-timezone (string-to-number
|
|
(match-string-no-properties 1)))
|
|
(re-search-forward "^summary \\(.+\\)$")
|
|
(setq subject (match-string-no-properties 1))
|
|
(re-search-forward "^filename \\(.+\\)$")
|
|
(setq old-file (match-string-no-properties 1))
|
|
(setq commit-info (list :sha1 commit :author author
|
|
:author-time author-time
|
|
:author-timezone author-timezone
|
|
:subject subject :file old-file))
|
|
;; save it in the hash
|
|
(puthash commit commit-info commit-hash))
|
|
;; add the current blame-block into the list INFO.
|
|
(setq info (cons (list old-line new-line num commit-info)
|
|
info))))
|
|
;; now do from beginning
|
|
(setq info (nreverse info))
|
|
(with-current-buffer target-buf
|
|
;; for every blame chunk
|
|
(dolist (chunk info)
|
|
(setq commit-info (nth 3 chunk)
|
|
old-line (nth 0 chunk)
|
|
new-line (nth 1 chunk)
|
|
num (nth 2 chunk)
|
|
commit (plist-get commit-info :sha1)
|
|
author (plist-get commit-info :author)
|
|
author-time (plist-get commit-info :author-time)
|
|
author-timezone (plist-get commit-info :author-timezone)
|
|
subject (plist-get commit-info :subject))
|
|
|
|
(goto-char (point-min))
|
|
(forward-line (1- new-line))
|
|
|
|
(setq beg (line-beginning-position)
|
|
end (save-excursion
|
|
(forward-line num)
|
|
(line-beginning-position)))
|
|
;; mark the blame chunk
|
|
(put-text-property beg end :blame chunk)
|
|
|
|
;; make an overlay with blame info as 'before-string
|
|
;; on the current chunk.
|
|
(setq ov (make-overlay beg end))
|
|
(overlay-put ov :blame chunk)
|
|
(setq blame (concat
|
|
(propertize (substring-no-properties commit 0 8)
|
|
'face 'magit-blame-sha1)
|
|
blank
|
|
(propertize (format "%-20s" author)
|
|
'face 'magit-blame-culprit)
|
|
blank
|
|
(propertize (magit-blame-format-time-string
|
|
magit-time-format-string
|
|
author-time author-timezone)
|
|
'face 'magit-blame-time)
|
|
blank
|
|
(propertize subject 'face 'magit-blame-subject)
|
|
blank nl))
|
|
(overlay-put ov 'before-string blame))))))
|
|
|
|
(provide 'magit-blame)
|
|
;; Local Variables:
|
|
;; indent-tabs-mode: nil
|
|
;; End:
|
|
;;; magit-blame.el ends here
|