my-emacs-d/elpa/magit-20161016.1325/magit-blame.el
Gergely Polonkai 437e76ad7d Update packages
2016-10-17 10:11:13 +02:00

526 lines
21 KiB
EmacsLisp

;;; magit-blame.el --- blame support for Magit -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 The Magit Project Contributors
;;
;; You should have received a copy of the AUTHORS.md file which
;; lists all contributors. If not, see http://magit.vc/authors.
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; 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:
;; Annotates each line in file-visiting buffer with information from
;; the revision which last modified the line.
;;; Code:
(require 'magit)
;;; Options
(defgroup magit-blame nil
"Blame support for Magit."
:group 'magit-extensions)
(defcustom magit-blame-heading-format "%-20a %C %s"
"Format string used for blame headings.
The following placeholders are recognized:
%H hash
%s summary
%a author
%A author time
%c committer
%C committer time
The author and committer time formats can be specified with
`magit-blame-time-format'."
:group 'magit-blame
:type 'string)
(defcustom magit-blame-time-format "%F %H:%M"
"Format for time strings in blame headings."
:group 'magit-blame
:type 'string)
(defcustom magit-blame-show-headings t
"Whether to initially show blame block headings.
The headings can also be toggled locally using command
`magit-blame-toggle-headings'."
:group 'magit-blame
:type 'boolean)
(defcustom magit-blame-disable-modes '(fci-mode yascroll-bar-mode)
"List of modes not compatible with Magit-Blame mode.
This modes are turned off when Magit-Blame mode is turned on,
and then turned on again when turning off the latter."
:group 'magit-blame
:type '(repeat (symbol :tag "Mode")))
(make-variable-buffer-local 'magit-blame-disabled-modes)
(defcustom magit-blame-mode-lighter " Blame"
"The mode-line lighter of the Magit-Blame mode."
:group 'magit-blame
:type '(choice (const :tag "No lighter" "") string))
(unless (find-lisp-object-file-name 'magit-blame-goto-chunk-hook 'defvar)
(add-hook 'magit-blame-goto-chunk-hook 'magit-blame-maybe-update-revision-buffer))
(defcustom magit-blame-goto-chunk-hook '(magit-blame-maybe-update-revision-buffer)
"Hook run by `magit-blame-next-chunk' and `magit-blame-previous-chunk'."
:package-version '(magit . "2.1.0")
:group 'magit-blame
:type 'hook
:options '(magit-blame-maybe-update-revision-buffer))
(defface magit-blame-heading
'((((class color) (background light))
:background "grey80"
:foreground "black")
(((class color) (background dark))
:background "grey25"
:foreground "white"))
"Face for blame headings."
:group 'magit-faces)
(defface magit-blame-summary
'((t :inherit magit-blame-heading))
"Face used for commit summary in blame headings."
:group 'magit-faces)
(defface magit-blame-hash
'((t :inherit magit-blame-heading))
"Face used for commit hash in blame headings."
:group 'magit-faces)
(defface magit-blame-name
'((t :inherit magit-blame-heading))
"Face used for author and committer names in blame headings."
:group 'magit-faces)
(defface magit-blame-date
'((t :inherit magit-blame-heading))
"Face used for dates in blame headings."
:group 'magit-faces)
;;; Code
(defvar magit-blame-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\r" 'magit-show-commit)
(define-key map "\s" 'magit-diff-show-or-scroll-up)
(define-key map "\d" 'magit-diff-show-or-scroll-down)
(define-key map "b" 'magit-blame-popup)
(define-key map "n" 'magit-blame-next-chunk)
(define-key map "N" 'magit-blame-next-chunk-same-commit)
(define-key map "p" 'magit-blame-previous-chunk)
(define-key map "P" 'magit-blame-previous-chunk-same-commit)
(define-key map "q" 'magit-blame-quit)
(define-key map "t" 'magit-blame-toggle-headings)
(define-key map "\M-w" 'magit-blame-copy-hash)
map)
"Keymap for `magit-blame-mode'.")
(defun magit-blame-put-keymap-before-view-mode ()
"Put `magit-blame-mode' ahead of `view-mode' in `minor-mode-map-alist'."
(--when-let (assq 'magit-blame-mode
(cl-member 'view-mode minor-mode-map-alist :key #'car))
(setq minor-mode-map-alist
(cons it (delq it minor-mode-map-alist))))
(remove-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode))
(add-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode)
(defvar-local magit-blame-buffer-read-only nil)
(defvar-local magit-blame-cache nil)
(defvar-local magit-blame-process nil)
(defvar-local magit-blame-recursive-p nil)
(defvar-local magit-blame-separator nil)
(define-minor-mode magit-blame-mode
"Display blame information inline.
\n\\{magit-blame-mode-map}"
:lighter magit-blame-mode-lighter
(cond (magit-blame-mode
(when (called-interactively-p 'any)
(setq magit-blame-mode nil)
(user-error
(concat "Don't call `magit-blame-mode' directly; "
"instead use `magit-blame' or `magit-blame-popup'")))
(setq magit-blame-buffer-read-only buffer-read-only)
(read-only-mode 1)
(dolist (mode magit-blame-disable-modes)
(when (and (boundp mode) (symbol-value mode))
(funcall mode -1)
(push mode magit-blame-disabled-modes)))
(setq magit-blame-separator (magit-blame-format-separator)))
(t
(unless magit-blame-buffer-read-only
(read-only-mode -1))
(dolist (mode magit-blame-disabled-modes)
(funcall mode 1))
(when (process-live-p magit-blame-process)
(kill-process magit-blame-process))
(save-excursion
(save-restriction
(widen)
(dolist (ov (overlays-in (point-min) (point-max)))
(when (overlay-get ov 'magit-blame)
(delete-overlay ov))))))))
(defun auto-revert-handler--unless-magit-blame-mode ()
"If Magit-Blame mode is on, then do nothing. See #1731."
magit-blame-mode)
(advice-add 'auto-revert-handler :before-until
'auto-revert-handler--unless-magit-blame-mode)
;;;###autoload (autoload 'magit-blame-popup "magit-blame" nil t)
(magit-define-popup magit-blame-popup
"Popup console for blame commands."
'magit-commands
:man-page "git-blame"
:switches '((?w "Ignore whitespace" "-w")
(?r "Do not treat root commits as boundaries" "--root"))
:options '((?C "Detect lines moved or copied between files" "-C")
(?M "Detect lines moved or copied within a file" "-M"))
:actions '((?b "Blame" magit-blame))
:default-arguments '("-w")
:default-action 'magit-blame)
;;;###autoload
(defun magit-blame (revision file &optional args line)
"Display edit history of FILE up to REVISION.
Interactively blame the file being visited in the current buffer.
If the buffer visits a revision of that file, then blame up to
that revision, otherwise blame the file's full history, including
uncommitted changes.
If Magit-Blame mode is already turned on then blame recursively, by
visiting REVISION:FILE (using `magit-find-file'), where revision
is the revision before the revision that added the lines at
point.
ARGS is a list of additional arguments to pass to `git blame';
only arguments available from `magit-blame-popup' should be used.
\n(fn REVISION FILE &optional ARGS)" ; LINE is for internal use
(interactive
(let ((args (magit-blame-arguments)))
(if magit-blame-mode
(--if-let (magit-blame-chunk-get :previous-hash)
(list it (magit-blame-chunk-get :previous-file)
args (magit-blame-chunk-get :previous-start))
(user-error "Block has no further history"))
(--if-let (magit-file-relative-name nil 'tracked)
(list (or magit-buffer-refname magit-buffer-revision) it args)
(if buffer-file-name
(user-error "Buffer isn't visiting a tracked file")
(user-error "Buffer isn't visiting a file"))))))
(let ((toplevel (or (magit-toplevel)
(user-error "Not in git repository"))))
(let ((default-directory toplevel))
(if revision
(magit-find-file revision file)
(--if-let (find-buffer-visiting file)
(progn (switch-to-buffer it)
(save-buffer))
(find-file file))))
(let ((default-directory toplevel))
(widen)
(when line
(setq magit-blame-recursive-p t)
(goto-char (point-min))
(forward-line (1- line)))
(unless magit-blame-mode
(setq magit-blame-cache (make-hash-table :test 'equal))
(let ((show-headings magit-blame-show-headings))
(magit-blame-mode 1)
(setq-local magit-blame-show-headings show-headings))
(message "Blaming...")
(let ((magit-process-popup-time -1)
(inhibit-magit-refresh t))
(magit-run-git-async
"blame" "--incremental" args
"-L" (format "%s,%s"
(line-number-at-pos (window-start))
(line-number-at-pos (1- (window-end nil t))))
revision "--" file))
(setq magit-blame-process magit-this-process)
(set-process-filter magit-this-process 'magit-blame-process-filter)
(set-process-sentinel
magit-this-process
`(lambda (process event)
(when (memq (process-status process) '(exit signal))
(magit-process-sentinel process event)
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(when magit-blame-mode
(let ((magit-process-popup-time -1)
(inhibit-magit-refresh t)
(default-directory ,default-directory))
(magit-run-git-async "blame" "--incremental" ,@args
,revision "--" ,file))
(setq magit-blame-process magit-this-process)
(set-process-filter
magit-this-process 'magit-blame-process-filter)
(set-process-sentinel
magit-this-process 'magit-blame-process-sentinel))))))))))
(defun magit-blame-process-sentinel (process event)
(let ((status (process-status process)))
(when (memq status '(exit signal))
(magit-process-sentinel process event)
(if (eq status 'exit)
(message "Blaming...done")
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(magit-blame-mode -1))
(message "Blaming...failed")))))
(defvar magit-blame-log nil
"Whether to log blame output to the process buffer.
This is intended for debugging purposes.")
(defun magit-blame-process-filter (process string)
(when magit-blame-log
(magit-process-filter process string))
(--when-let (process-get process 'partial-line)
(setq string (concat it string))
(setf (process-get process 'partial-line) nil))
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(when magit-blame-mode
(let ((chunk (process-get process 'chunk))
(lines (split-string string "\n" t)))
(unless (string-match-p "\n\\'" string)
(process-put process 'chunk chunk)
(process-put process 'partial-line (car (last lines)))
(setq lines (butlast lines)))
(dolist (line lines)
(cond
((equal line ""))
((not chunk)
(string-match
"^\\(.\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" line)
(setq chunk
(list :hash (let ((hash (match-string 1 line)))
(unless (equal hash (make-string 40 ?0))
hash))
:previous-start (string-to-number (match-string 2 line))
:start (string-to-number (match-string 3 line))
:lines (string-to-number (match-string 4 line)))))
((string-match "^filename \\(.+\\)" line)
(let* ((hash (plist-get chunk :hash))
(file (match-string 1 line)))
(--if-let (gethash hash magit-blame-cache)
(setq chunk (nconc chunk it))
(plist-put chunk :filename file)
(puthash hash chunk magit-blame-cache)))
(magit-blame-make-overlay chunk)
(setq chunk nil))
((string-match "^previous \\(.\\{40\\}\\) \\(.+\\)" line)
(plist-put chunk :previous-hash (match-string 1 line))
(plist-put chunk :previous-file (match-string 2 line)))
((string-match "^\\([^ ]+?-mail\\) <\\([^>]+\\)>" line)
(plist-put chunk (intern (concat ":" (match-string 1 line)))
(string-to-number (match-string 2 line))))
((string-match "^\\([^ ]+?-\\(?:time\\|tz\\)\\) \\(.+\\)" line)
(plist-put chunk (intern (concat ":" (match-string 1 line)))
(string-to-number (match-string 2 line))))
((string-match "^\\([^ ]+\\) \\(.+\\)" line)
(plist-put chunk (intern (concat ":" (match-string 1 line)))
(match-string 2 line))))
(process-put process 'chunk chunk))))))
(defun magit-blame-assert-buffer (process)
(unless (buffer-live-p (process-get process 'command-buf))
(kill-process process)
(user-error "Buffer being blamed has been killed")))
(defun magit-blame-make-overlay (chunk)
(let ((ov (save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(forward-line (1- (plist-get chunk :start)))
(--when-let (--first (overlay-get it 'magit-blame)
(overlays-at (point)))
(delete-overlay it))
(make-overlay (point)
(progn (forward-line
(plist-get chunk :lines))
(point))))))
(heading (magit-blame-format-heading chunk)))
(overlay-put ov 'magit-blame chunk)
(overlay-put ov 'magit-blame-heading heading)
(overlay-put ov 'before-string
(if magit-blame-show-headings
heading
magit-blame-separator))))
(defun magit-blame-format-separator ()
(propertize
(concat (propertize " " 'display '(space :height (2)))
(propertize "\n" 'line-height t))
'face (list :background (face-attribute 'magit-blame-heading :background))))
(defun magit-blame-format-heading (chunk)
(with-temp-buffer
(insert (format-spec
(concat magit-blame-heading-format "\n")
`((?H . ,(propertize (or (plist-get chunk :hash) "")
'face 'magit-blame-hash))
(?s . ,(propertize (or (plist-get chunk :summary) "")
'face 'magit-blame-summary))
(?a . ,(propertize (or (plist-get chunk :author) "")
'face 'magit-blame-name))
(?A . ,(propertize (magit-blame-format-time-string
magit-blame-time-format
(plist-get chunk :author-time)
(plist-get chunk :author-tz))
'face 'magit-blame-date))
(?c . ,(propertize (or (plist-get chunk :committer) "")
'face 'magit-blame-name))
(?C . ,(propertize (magit-blame-format-time-string
magit-blame-time-format
(plist-get chunk :committer-time)
(plist-get chunk :committer-tz))
'face 'magit-blame-date)))))
(goto-char (point-min))
(while (not (eobp))
(let ((face (get-text-property (point) 'face))
(next (or (next-single-property-change (point) 'face)
(point-max))))
(unless face
(put-text-property (point) next 'face 'magit-blame-heading))
(goto-char next)))
(buffer-string)))
(defun magit-blame-format-time-string (format time tz)
(format-time-string
format (seconds-to-time (+ time (* (/ tz 100) 60 60) (* (% tz 100) 60)))))
(defun magit-blame-quit ()
"Turn off Magit-Blame mode.
If the buffer was created during a recursive blame,
then also kill the buffer."
(interactive)
(if magit-blame-recursive-p
(kill-buffer)
(magit-blame-mode -1)))
(defun magit-blame-next-chunk ()
"Move to the next chunk."
(interactive)
(--if-let (next-single-char-property-change (point) 'magit-blame)
(progn (goto-char it)
(run-hooks 'magit-blame-goto-chunk-hook))
(user-error "No more chunks")))
(defun magit-blame-previous-chunk ()
"Move to the previous chunk."
(interactive)
(--if-let (previous-single-char-property-change (point) 'magit-blame)
(progn (goto-char it)
(run-hooks 'magit-blame-goto-chunk-hook))
(user-error "No more chunks")))
(defun magit-blame-next-chunk-same-commit (&optional previous)
"Move to the next chunk from the same commit.\n\n(fn)"
(interactive)
(-if-let (hash (magit-blame-chunk-get :hash))
(let ((pos (point)) ov)
(save-excursion
(while (and (not ov)
(not (= pos (if previous (point-min) (point-max))))
(setq pos (funcall
(if previous
'previous-single-char-property-change
'next-single-char-property-change)
pos 'magit-blame)))
(--when-let (magit-blame-overlay-at pos)
(when (equal (magit-blame-chunk-get :hash pos) hash)
(setq ov it)))))
(if ov
(goto-char (overlay-start ov))
(user-error "No more chunks from same commit")))
(user-error "This chunk hasn't been blamed yet")))
(defun magit-blame-previous-chunk-same-commit ()
"Move to the previous chunk from the same commit."
(interactive)
(magit-blame-next-chunk-same-commit 'previous-single-char-property-change))
(defun magit-blame-toggle-headings ()
"Show or hide blame chunk headings."
(interactive)
(setq-local magit-blame-show-headings (not magit-blame-show-headings))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (not (eobp))
(let ((next (next-single-char-property-change (point) 'magit-blame)))
(--when-let (magit-blame-overlay-at (point))
(overlay-put it 'before-string
(if magit-blame-show-headings
(overlay-get it 'magit-blame-heading)
magit-blame-separator)))
(goto-char (or next (point-max))))))))
(defun magit-blame-copy-hash ()
"Save hash of the current chunk's commit to the kill ring.
When the region is active, then save that to the `kill-ring',
like `kill-ring-save' would."
(interactive)
(if (use-region-p)
(copy-region-as-kill nil nil 'region)
(kill-new (message "%s" (magit-blame-chunk-get :hash)))))
(defun magit-blame-chunk-get (key &optional pos)
(--when-let (magit-blame-overlay-at pos)
(plist-get (overlay-get it 'magit-blame) key)))
(defun magit-blame-overlay-at (&optional pos)
(--first (overlay-get it 'magit-blame)
(overlays-at (or pos (point)))))
(defun magit-blame-maybe-update-revision-buffer ()
(unless magit--update-revision-buffer
(setq magit--update-revision-buffer nil)
(-when-let* ((commit (magit-blame-chunk-get :hash))
(buffer (magit-mode-get-buffer 'magit-revision-mode nil t)))
(setq magit--update-revision-buffer (list commit buffer))
(run-with-idle-timer
magit-update-other-window-delay nil
(lambda ()
(-let [(rev buf) magit--update-revision-buffer]
(setq magit--update-revision-buffer nil)
(when (buffer-live-p buf)
(let ((magit-display-buffer-noselect t))
(apply #'magit-show-commit rev (magit-diff-arguments))))))))))
;;; magit-blame.el ends soon
(provide 'magit-blame)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-blame.el ends here