;;; 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 ;; Package: magit ;; Contains code from Egg (Emacs Got Git) , ;; 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 . ;;; 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