my-emacs-d/elpa/magit-1.2.1/magit-blame.el

304 lines
12 KiB
EmacsLisp
Raw Normal View History

2014-10-05 12:57:41 +00:00
;;; magit-blame.el --- blame support for magit
;; Copyright (C) 2012 Rüdiger Sonderfeld
;; Copyright (C) 2012 Yann Hodique
;; Copyright (C) 2011 byplayer
;; Copyright (C) 2010 Alexander Prusov
;; Copyright (C) 2009 Tim Moore
;; Copyright (C) 2008 Linh Dang
;; Copyright (C) 2008 Marius Vollmer
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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:
;; This code has been backported from Egg (Magit fork) to Magit
;;; Code:
(eval-when-compile (require 'cl))
(require 'magit)
(defface magit-blame-header
'((t :inherit magit-header))
"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)
(defconst magit-blame-map
(let ((map (make-sparse-keymap "Magit:Blame")))
(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}")
(defvar magit-blame-buffer-read-only)
(make-variable-buffer-local 'magit-blame-buffer-read-only)
;;;###autoload
(define-minor-mode magit-blame-mode
"Display blame information inline."
:keymap magit-blame-map
:lighter " blame"
(unless (buffer-file-name)
(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))
(if magit-blame-mode
(progn
(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))
(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)
(if (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
(magit-git-insert (list "blame" "--porcelain" "--"
(file-name-nondirectory
(buffer-file-name buffer))))
(magit-blame-parse buffer (current-buffer)))))))
(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)
(if (overlay-get ov :blame)
(setq sha1 (plist-get (nth 3 (overlay-get ov :blame)) :sha1))))
(if sha1
(magit-show-commit sha1))))
(defun magit-find-next-overlay-change (BEG END PROP)
"Return the next position after BEG where an overlay matching a
property PROP starts or ends. If there are no matching overlay
boundaries from BEG to END, the return value is nil."
(save-excursion
(goto-char BEG)
(catch 'found
(flet ((overlay-change (pos)
(if (< BEG END) (next-overlay-change pos)
(previous-overlay-change pos)))
(within-bounds-p (pos)
(if (< BEG END) (< pos END)
(> pos END))))
(let ((ov-pos BEG))
;; iterate through overlay changes from BEG to END
(while (within-bounds-p ov-pos)
(let* ((next-ov-pos (overlay-change ov-pos))
;; search for an overlay with a PROP property
(next-ov
(let ((overlays (overlays-at next-ov-pos)))
(while (and overlays
(not (overlay-get (car overlays) PROP)))
(setq overlays (cdr overlays)))
(car overlays))))
(if next-ov
;; found the next overlay with prop PROP at next-ov-pos
(throw 'found next-ov-pos)
;; no matching overlay found, keep looking
(setq ov-pos next-ov-pos)))))))))
(defun magit-blame-next-chunk (pos)
"Go to the next blame chunk."
(interactive "d")
(let ((next-chunk-pos (magit-find-next-overlay-change pos (point-max) :blame)))
(when next-chunk-pos
(goto-char next-chunk-pos))))
(defun magit-blame-previous-chunk (pos)
"Go to the previous blame chunk."
(interactive "d")
(let ((prev-chunk-pos (magit-find-next-overlay-change pos (point-min) :blame)))
(when prev-chunk-pos
(goto-char prev-chunk-pos))))
(defcustom magit-time-format-string "%Y-%m-%dT%T%z"
"How to format time in magit-blame header."
:group 'magit
:type 'string)
(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)
;;; magit-blame.el ends here