.emacs.d.git - Gitblit

Chizi123

2018-11-18 21067e7cbe6d7a0f65ff5c317a96b5c337b0b3d8

commit \| author \| age
5cb5f7	1	;;; magit-blame.el --- blame support for Magit -- lexical-binding: t --
C	2
	3	;; Copyright (C) 2012-2018 The Magit Project Contributors
	4	;;
	5	;; You should have received a copy of the AUTHORS.md file which
	6	;; lists all contributors. If not, see http://magit.vc/authors.
	7
	8	;; Author: Jonas Bernoulli <jonas@bernoul.li>
	9	;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
	10
	11	;; Magit is free software; you can redistribute it and/or modify it
	12	;; under the terms of the GNU General Public License as published by
	13	;; the Free Software Foundation; either version 3, or (at your option)
	14	;; any later version.
	15	;;
	16	;; Magit is distributed in the hope that it will be useful, but WITHOUT
	17	;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
	18	;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
	19	;; License for more details.
	20	;;
	21	;; You should have received a copy of the GNU General Public License
	22	;; along with Magit. If not, see http://www.gnu.org/licenses.
	23
	24	;;; Commentary:
	25
	26	;; Annotates each line in file-visiting buffer with information from
	27	;; the revision which last modified the line.
	28
	29	;;; Code:
	30
	31	(eval-when-compile
	32	(require 'subr-x))
	33
	34	(require 'magit)
	35
	36	;;; Options
	37
	38	(defgroup magit-blame nil
	39	"Blame support for Magit."
	40	:link '(info-link "(magit)Blaming")
	41	:group 'magit-modes)
	42
	43	(defcustom magit-blame-styles
	44	'((headings
	45	(heading-format . "%-20a %C %s\n"))
	46	(margin
	47	(margin-format . (" %s%f" " %C %a" " %H"))
	48	(margin-width . 42)
	49	(margin-face . magit-blame-margin)
	50	(margin-body-face . (magit-blame-dimmed)))
	51	(highlight
	52	(highlight-face . magit-blame-highlight))
	53	(lines
	54	(show-lines . t)))
	55	"List of styles used to visualize blame information.
	56
	57	Each entry has the form (IDENT (KEY . VALUE)...). IDENT has
	58	to be a symbol uniquely identifing the style. The following
	59	KEYs are recognized:
	60
	61	`show-lines'
	62	Whether to prefix each chunk of lines with a thin line.
	63	This has no effect if `heading-format' is non-nil.
	64	`highlight-face'
	65	Face used to highlight the first line of each chunk.
	66	If this is nil, then those lines are not highlighted.
	67	`heading-format'
	68	String specifing the information to be shown above each
	69	chunk of lines. It must end with a newline character.
	70	`margin-format'
	71	String specifing the information to be shown in the left
	72	buffer margin. It must NOT end with a newline character.
	73	This can also be a list of formats used for the lines at
	74	the same positions within the chunk. If the chunk has
	75	more lines than formats are specified, then the last is
	76	repeated.
	77	`margin-width'
	78	Width of the margin, provided `margin-format' is non-nil.
	79	`margin-face'
	80	Face used in the margin, provided `margin-format' is
	81	non-nil. This face is used in combination with the faces
	82	that are specific to the used %-specs. If this is nil,
	83	then `magit-blame-margin' is used.
	84	`margin-body-face'
	85	Face used in the margin for all but first line of a chunk.
	86	This face is used in combination with the faces that are
	87	specific to the used %-specs. This can also be a list of
	88	faces (usually one face), in which case only these faces
	89	are used and the %-spec faces are ignored. A good value
	90	might be `(magit-blame-dimmed)'. If this is nil, then
	91	the same face as for the first line is used.
	92
	93	The following %-specs can be used in `heading-format' and
	94	`margin-format':
	95
	96	%H hash using face `magit-blame-hash'
	97	%s summary using face `magit-blame-summary'
	98	%a author using face `magit-blame-name'
	99	%A author time using face `magit-blame-date'
	100	%c committer using face `magit-blame-name'
	101	%C committer time using face `magit-blame-date'
	102
	103	Additionally if `margin-format' ends with %f, then the string
	104	that is displayed in the margin is made at least `margin-width'
	105	characters wide, which may be desirable if the used face sets
	106	the background color.
	107
	108	The style used in the current buffer can be cycled from the blame
	109	popup. Blame commands (except `magit-blame-echo') use the first
	110	style as the initial style when beginning to blame in a buffer."
	111	:package-version '(magit . "2.13.0")
	112	:group 'magit-blame
	113	:type 'string)
	114
	115	(defcustom magit-blame-echo-style 'lines
	116	"The blame visualization style used by `magit-blame-echo'.
	117	A symbol that has to be used as the identifier for one of the
	118	styles defined in `magit-blame-styles'."
	119	:package-version '(magit . "2.13.0")
	120	:group 'magit-blame
	121	:type 'symbol)
	122
	123	(defcustom magit-blame-time-format "%F %H:%M"
	124	"Format for time strings in blame headings."
	125	:group 'magit-blame
	126	:type 'string)
	127
	128	(defcustom magit-blame-read-only t
	129	"Whether to initially make the blamed buffer read-only."
	130	:package-version '(magit . "2.13.0")
	131	:group 'magit-blame
	132	:type 'boolean)
	133
	134	(defcustom magit-blame-disable-modes '(fci-mode yascroll-bar-mode)
	135	"List of modes not compatible with Magit-Blame mode.
	136	This modes are turned off when Magit-Blame mode is turned on,
	137	and then turned on again when turning off the latter."
	138	:group 'magit-blame
	139	:type '(repeat (symbol :tag "Mode")))
	140
	141	(defcustom magit-blame-mode-lighter " Blame"
	142	"The mode-line lighter of the Magit-Blame mode."
	143	:group 'magit-blame
	144	:type '(choice (const :tag "No lighter" "") string))
	145
	146	(defcustom magit-blame-goto-chunk-hook
	147	'(magit-blame-maybe-update-revision-buffer
	148	magit-blame-maybe-show-message)
	149	"Hook run after point entered another chunk."
	150	:package-version '(magit . "2.13.0")
	151	:group 'magit-blame
	152	:type 'hook
	153	:get 'magit-hook-custom-get
	154	:options '(magit-blame-maybe-update-revision-buffer
	155	magit-blame-maybe-show-message))
	156
	157	;;; Faces
	158
	159	(defface magit-blame-highlight
	160	'((((class color) (background light))
	161	:background "grey80"
	162	:foreground "black")
	163	(((class color) (background dark))
	164	:background "grey25"
	165	:foreground "white"))
	166	"Face used for highlighting when blaming.
	167	Also see option `magit-blame-styles'."
	168	:group 'magit-faces)
	169
	170	(defface magit-blame-margin
	171	'((t :inherit magit-blame-highlight
	172	:weight normal
	173	:slant normal))
	174	"Face used for the blame margin by default when blaming.
	175	Also see option `magit-blame-styles'."
	176	:group 'magit-faces)
	177
	178	(defface magit-blame-dimmed
	179	'((t :inherit magit-dimmed
	180	:weight normal
	181	:slant normal))
	182	"Face used for the blame margin in some cases when blaming.
	183	Also see option `magit-blame-styles'."
	184	:group 'magit-faces)
	185
	186	(defface magit-blame-heading
	187	'((t :inherit magit-blame-highlight
	188	:weight normal
	189	:slant normal))
	190	"Face used for blame headings by default when blaming.
	191	Also see option `magit-blame-styles'."
	192	:group 'magit-faces)
	193
	194	(defface magit-blame-summary nil
	195	"Face used for commit summaries when blaming."
	196	:group 'magit-faces)
	197
	198	(defface magit-blame-hash nil
	199	"Face used for commit hashes when blaming."
	200	:group 'magit-faces)
	201
	202	(defface magit-blame-name nil
	203	"Face used for author and committer names when blaming."
	204	:group 'magit-faces)
	205
	206	(defface magit-blame-date nil
	207	"Face used for dates when blaming."
	208	:group 'magit-faces)
	209
	210	;;; Chunks
	211
	212	(defclass magit-blame-chunk ()
	213	(;; <orig-rev> <orig-line> <final-line> <num-lines>
	214	(orig-rev :initarg :orig-rev)
	215	(orig-line :initarg :orig-line)
	216	(final-line :initarg :final-line)
	217	(num-lines :initarg :num-lines)
	218	;; previous <prev-rev> <prev-file>
	219	(prev-rev :initform nil)
	220	(prev-file :initform nil)
	221	;; filename <orig-file>
	222	(orig-file)))
	223
	224	(defun magit-current-blame-chunk (&optional type)
	225	(or (and (not (and type (not (eq type magit-blame-type))))
	226	(magit-blame-chunk-at (point)))
	227	(and type
	228	(let ((rev (or magit-buffer-refname magit-buffer-revision))
	229	(file (magit-file-relative-name nil (not magit-buffer-file-name)))
	230	(line (format "%i,+1" (line-number-at-pos))))
	231	(unless file
	232	(error "Buffer does not visit a tracked file"))
	233	(with-temp-buffer
	234	(magit-with-toplevel
	235	(magit-git-insert
	236	"blame" "--porcelain"
	237	(if (memq magit-blame-type '(final removal))
	238	(cons "--reverse" (magit-blame-arguments))
	239	(magit-blame-arguments))
	240	"-L" line rev "--" file)
	241	(goto-char (point-min))
	242	(car (magit-blame--parse-chunk type))))))))
	243
	244	(defun magit-blame-chunk-at (pos)
	245	(--some (overlay-get it 'magit-blame-chunk)
	246	(overlays-at pos)))
	247
	248	(defun magit-blame--overlay-at (&optional pos key)
	249	(unless pos
	250	(setq pos (point)))
	251	(--first (overlay-get it (or key 'magit-blame-chunk))
	252	(nconc (overlays-at pos)
	253	(overlays-in pos pos))))
	254
	255	;;; Keymaps
	256
	257	(defvar magit-blame-mode-map
	258	(let ((map (make-sparse-keymap)))
	259	(define-key map (kbd "C-c C-q") 'magit-blame-quit)
	260	map)
	261	"Keymap for `magit-blame-mode'.
	262	Note that most blaming key bindings are defined
	263	in `magit-blame-read-only-mode-map' instead.")
	264
	265	(defvar magit-blame-read-only-mode-map
	266	(let ((map (make-sparse-keymap)))
	267	(cond ((featurep 'jkl)
	268	(define-key map [return] 'magit-show-commit)
	269	(define-key map (kbd "i") 'magit-blame-previous-chunk)
	270	(define-key map (kbd "I") 'magit-blame-previous-chunk-same-commit)
	271	(define-key map (kbd "k") 'magit-blame-next-chunk)
	272	(define-key map (kbd "K") 'magit-blame-next-chunk-same-commit)
	273	(define-key map (kbd "j") 'magit-blame-addition)
	274	(define-key map (kbd "l") 'magit-blame-removal)
	275	(define-key map (kbd "f") 'magit-blame-reverse)
	276	(define-key map (kbd "b") 'magit-blame-popup))
	277	(t
	278	(define-key map (kbd "C-m") 'magit-show-commit)
	279	(define-key map (kbd "p") 'magit-blame-previous-chunk)
	280	(define-key map (kbd "P") 'magit-blame-previous-chunk-same-commit)
	281	(define-key map (kbd "n") 'magit-blame-next-chunk)
	282	(define-key map (kbd "N") 'magit-blame-next-chunk-same-commit)
	283	(define-key map (kbd "b") 'magit-blame-addition)
	284	(define-key map (kbd "r") 'magit-blame-removal)
	285	(define-key map (kbd "f") 'magit-blame-reverse)
	286	(define-key map (kbd "B") 'magit-blame-popup)))
	287	(define-key map (kbd "c") 'magit-blame-cycle-style)
	288	(define-key map (kbd "q") 'magit-blame-quit)
	289	(define-key map (kbd "M-w") 'magit-blame-copy-hash)
	290	(define-key map (kbd "SPC") 'magit-diff-show-or-scroll-up)
	291	(define-key map (kbd "DEL") 'magit-diff-show-or-scroll-down)
	292	map)
	293	"Keymap for `magit-blame-read-only-mode'.")
	294
	295	;;; Modes
	296	;;;; Variables
	297
	298	(defvar-local magit-blame-buffer-read-only nil)
	299	(defvar-local magit-blame-cache nil)
	300	(defvar-local magit-blame-disabled-modes nil)
	301	(defvar-local magit-blame-process nil)
	302	(defvar-local magit-blame-recursive-p nil)
	303	(defvar-local magit-blame-type nil)
	304	(defvar-local magit-blame-separator nil)
	305	(defvar-local magit-blame-previous-chunk nil)
	306
	307	(defvar-local magit-blame--style nil)
	308
	309	(defsubst magit-blame--style-get (key)
	310	(cdr (assoc key (cdr magit-blame--style))))
	311
	312	;;;; Base Mode
	313
	314	(define-minor-mode magit-blame-mode
	315	"Display blame information inline."
	316	:lighter magit-blame-mode-lighter
	317	(cond (magit-blame-mode
	318	(when (called-interactively-p 'any)
	319	(setq magit-blame-mode nil)
	320	(user-error
	321	(concat "Don't call `magit-blame-mode' directly; "
	322	"instead use `magit-blame' or `magit-blame-popup'")))
	323	(add-hook 'after-save-hook 'magit-blame--run t t)
	324	(add-hook 'post-command-hook 'magit-blame-goto-chunk-hook t t)
	325	(add-hook 'before-revert-hook 'magit-blame--remove-overlays t t)
	326	(add-hook 'after-revert-hook 'magit-blame--run t t)
	327	(add-hook 'read-only-mode-hook 'magit-blame-toggle-read-only t t)
	328	(setq magit-blame-buffer-read-only buffer-read-only)
	329	(when (or magit-blame-read-only magit-buffer-file-name)
	330	(read-only-mode 1))
	331	(dolist (mode magit-blame-disable-modes)
	332	(when (and (boundp mode) (symbol-value mode))
	333	(funcall mode -1)
	334	(push mode magit-blame-disabled-modes)))
	335	(setq magit-blame-separator (magit-blame--format-separator))
	336	(unless magit-blame--style
	337	(setq magit-blame--style (car magit-blame-styles)))
	338	(magit-blame--update-margin))
	339	(t
	340	(when (process-live-p magit-blame-process)
	341	(kill-process magit-blame-process)
	342	(while magit-blame-process
	343	(sit-for 0.01))) ; avoid racing the sentinal
	344	(remove-hook 'after-save-hook 'magit-blame--run t)
	345	(remove-hook 'post-command-hook 'magit-blame-goto-chunk-hook t)
	346	(remove-hook 'before-revert-hook 'magit-blame--remove-overlays t)
	347	(remove-hook 'after-revert-hook 'magit-blame--run t)
	348	(remove-hook 'read-only-mode-hook 'magit-blame-toggle-read-only t)
	349	(unless magit-blame-buffer-read-only
	350	(read-only-mode -1))
	351	(magit-blame-read-only-mode -1)
	352	(dolist (mode magit-blame-disabled-modes)
	353	(funcall mode 1))
	354	(kill-local-variable 'magit-blame-disabled-modes)
	355	(kill-local-variable 'magit-blame-type)
	356	(kill-local-variable 'magit-blame--style)
	357	(magit-blame--update-margin)
	358	(magit-blame--remove-overlays))))
	359
	360	(defun magit-blame-goto-chunk-hook ()
	361	(let ((chunk (magit-blame-chunk-at (point))))
	362	(when (cl-typep chunk 'magit-blame-chunk)
	363	(unless (eq chunk magit-blame-previous-chunk)
	364	(run-hooks 'magit-blame-goto-chunk-hook))
	365	(setq magit-blame-previous-chunk chunk))))
	366
	367	(defun magit-blame-toggle-read-only ()
	368	(magit-blame-read-only-mode (if buffer-read-only 1 -1)))
	369
	370	;;;; Read-Only Mode
	371
	372	(define-minor-mode magit-blame-read-only-mode
	373	"Provide keybindings for Magit-Blame mode.
	374
	375	This minor-mode provides the key bindings for Magit-Blame mode,
	376	but only when Read-Only mode is also enabled because these key
	377	bindings would otherwise conflict badly with regular bindings.
	378
	379	When both Magit-Blame mode and Read-Only mode are enabled, then
	380	this mode gets automatically enabled too and when one of these
	381	modes is toggled, then this mode also gets toggled automatically.
	382
	383	\\{magit-blame-read-only-mode-map}")
	384
	385	;;;; Kludges
	386
	387	(defun magit-blame-put-keymap-before-view-mode ()
	388	"Put `magit-blame-read-only-mode' ahead of `view-mode' in `minor-mode-map-alist'."
	389	(--when-let (assq 'magit-blame-read-only-mode
	390	(cl-member 'view-mode minor-mode-map-alist :key #'car))
	391	(setq minor-mode-map-alist
	392	(cons it (delq it minor-mode-map-alist))))
	393	(remove-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode))
	394
	395	(add-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode)
	396
	397	;;; Process
	398
	399	(defun magit-blame--run ()
	400	(magit-with-toplevel
	401	(unless magit-blame-mode
	402	(magit-blame-mode 1))
	403	(message "Blaming...")
	404	(magit-blame-run-process
	405	(or magit-buffer-refname magit-buffer-revision)
	406	(magit-file-relative-name nil (not magit-buffer-file-name))
	407	(if (memq magit-blame-type '(final removal))
	408	(cons "--reverse" (magit-blame-arguments))
	409	(magit-blame-arguments))
	410	(list (line-number-at-pos (window-start))
	411	(line-number-at-pos (1- (window-end nil t)))))
	412	(set-process-sentinel magit-this-process
	413	'magit-blame-process-quickstart-sentinel)))
	414
	415	(defun magit-blame-run-process (revision file args &optional lines)
	416	(let ((process (magit-parse-git-async
	417	"blame" "--incremental" args
	418	(and lines (list "-L" (apply #'format "%s,%s" lines)))
	419	revision "--" file)))
	420	(set-process-filter process 'magit-blame-process-filter)
	421	(set-process-sentinel process 'magit-blame-process-sentinel)
	422	(process-put process 'arguments (list revision file args))
	423	(setq magit-blame-cache (make-hash-table :test 'equal))
	424	(setq magit-blame-process process)))
	425
	426	(defun magit-blame-process-quickstart-sentinel (process event)
	427	(when (memq (process-status process) '(exit signal))
	428	(magit-blame-process-sentinel process event t)
	429	(magit-blame-assert-buffer process)
	430	(with-current-buffer (process-get process 'command-buf)
	431	(when magit-blame-mode
	432	(let ((default-directory (magit-toplevel)))
	433	(apply #'magit-blame-run-process
	434	(process-get process 'arguments)))))))
	435
	436	(defun magit-blame-process-sentinel (process _event &optional quiet)
	437	(let ((status (process-status process)))
	438	(when (memq status '(exit signal))
	439	(kill-buffer (process-buffer process))
	440	(if (and (eq status 'exit)
	441	(zerop (process-exit-status process)))
	442	(unless quiet
	443	(message "Blaming...done"))
	444	(magit-blame-assert-buffer process)
	445	(with-current-buffer (process-get process 'command-buf)
	446	(if magit-blame-mode
	447	(progn (magit-blame-mode -1)
	448	(message "Blaming...failed"))
	449	(message "Blaming...aborted"))))
	450	(kill-local-variable 'magit-blame-process))))
	451
	452	(defun magit-blame-process-filter (process string)
	453	(internal-default-process-filter process string)
	454	(let ((buf (process-get process 'command-buf))
	455	(pos (process-get process 'parsed))
	456	(mark (process-mark process))
	457	type cache)
	458	(with-current-buffer buf
	459	(setq type magit-blame-type)
	460	(setq cache magit-blame-cache))
	461	(with-current-buffer (process-buffer process)
	462	(goto-char pos)
	463	(while (and (< (point) mark)
	464	(save-excursion (re-search-forward "^filename .+\n" nil t)))
	465	(pcase-let* ((`(,chunk ,revinfo)
	466	(magit-blame--parse-chunk type))
	467	(rev (oref chunk orig-rev)))
	468	(if revinfo
	469	(puthash rev revinfo cache)
	470	(setq revinfo
	471	(or (gethash rev cache)
	472	(puthash rev (magit-blame--commit-alist rev) cache))))
	473	(magit-blame--make-overlays buf chunk revinfo))
	474	(process-put process 'parsed (point))))))
	475
	476	(defun magit-blame--parse-chunk (type)
	477	(let (chunk revinfo)
	478	(looking-at "^\\(.\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)")
	479	(with-slots (orig-rev orig-file prev-rev prev-file)
	480	(setq chunk (magit-blame-chunk
	481	:orig-rev (match-string 1)
	482	:orig-line (string-to-number (match-string 2))
	483	:final-line (string-to-number (match-string 3))
	484	:num-lines (string-to-number (match-string 4))))
	485	(forward-line)
	486	(let (done)
	487	(while (not done)
	488	(cond ((looking-at "^filename \\(.+\\)")
	489	(setq done t)
	490	(setf orig-file (match-string 1)))
	491	((looking-at "^previous \\(.\\{40\\}\\) \\(.+\\)")
	492	(setf prev-rev (match-string 1))
	493	(setf prev-file (match-string 2)))
	494	((looking-at "^\\([^ ]+\\) \\(.+\\)")
	495	(push (cons (match-string 1)
	496	(match-string 2)) revinfo)))
	497	(forward-line)))
	498	(when (and (eq type 'removal) prev-rev)
	499	(cl-rotatef orig-rev prev-rev)
	500	(cl-rotatef orig-file prev-file)
	501	(setq revinfo nil)))
	502	(list chunk revinfo)))
	503
	504	(defun magit-blame--commit-alist (rev)
	505	(cl-mapcar 'cons
	506	'("summary"
	507	"author" "author-time" "author-tz"
	508	"committer" "committer-time" "committer-tz")
	509	(split-string (magit-rev-format "%s\v%an\v%ad\v%cn\v%cd" rev
	510	"--date=format:%s\v%z")
	511	"\v")))
	512
	513	(defun magit-blame-assert-buffer (process)
	514	(unless (buffer-live-p (process-get process 'command-buf))
	515	(kill-process process)
	516	(user-error "Buffer being blamed has been killed")))
	517
	518	;;; Display
	519
	520	(defun magit-blame--make-overlays (buf chunk revinfo)
	521	(with-current-buffer buf
	522	(save-excursion
	523	(save-restriction
	524	(widen)
	525	(goto-char (point-min))
	526	(forward-line (1- (oref chunk final-line)))
	527	(let ((beg (point))
	528	(end (save-excursion
	529	(forward-line (oref chunk num-lines))
	530	(point))))
	531	(magit-blame--remove-overlays beg end)
	532	(magit-blame--make-margin-overlays chunk revinfo beg end)
	533	(magit-blame--make-heading-overlay chunk revinfo beg end)
	534	(magit-blame--make-highlight-overlay chunk beg))))))
	535
	536	(defun magit-blame--make-margin-overlays (chunk revinfo _beg end)
	537	(save-excursion
	538	(let ((line 0))
	539	(while (< (point) end)
	540	(magit-blame--make-margin-overlay chunk revinfo line)
	541	(forward-line)
	542	(cl-incf line)))))
	543
	544	(defun magit-blame--make-margin-overlay (chunk revinfo line)
	545	(let* ((end (line-end-position))
	546	;; If possible avoid putting this on the first character
	547	;; of the line to avoid a conflict with the line overlay.
	548	(beg (min (1+ (line-beginning-position)) end))
	549	(ov (make-overlay beg end)))
	550	(overlay-put ov 'magit-blame-chunk chunk)
	551	(overlay-put ov 'magit-blame-revinfo revinfo)
	552	(overlay-put ov 'magit-blame-margin line)
	553	(magit-blame--update-margin-overlay ov)))
	554
	555	(defun magit-blame--make-heading-overlay (chunk revinfo beg end)
	556	(let ((ov (make-overlay beg end)))
	557	(overlay-put ov 'magit-blame-chunk chunk)
	558	(overlay-put ov 'magit-blame-revinfo revinfo)
	559	(overlay-put ov 'magit-blame-heading t)
	560	(magit-blame--update-heading-overlay ov)))
	561
	562	(defun magit-blame--make-highlight-overlay (chunk beg)
	563	(let ((ov (make-overlay beg (1+ (line-end-position)))))
	564	(overlay-put ov 'magit-blame-chunk chunk)
	565	(overlay-put ov 'magit-blame-highlight t)
	566	(magit-blame--update-highlight-overlay ov)))
	567
	568	(defun magit-blame--update-margin ()
	569	(setq left-margin-width (or (magit-blame--style-get 'margin-width) 0))
	570	(set-window-buffer (selected-window) (current-buffer)))
	571
	572	(defun magit-blame--update-overlays ()
	573	(save-restriction
	574	(widen)
	575	(dolist (ov (overlays-in (point-min) (point-max)))
	576	(cond ((overlay-get ov 'magit-blame-heading)
	577	(magit-blame--update-heading-overlay ov))
	578	((overlay-get ov 'magit-blame-margin)
	579	(magit-blame--update-margin-overlay ov))
	580	((overlay-get ov 'magit-blame-highlight)
	581	(magit-blame--update-highlight-overlay ov))))))
	582
	583	(defun magit-blame--update-margin-overlay (ov)
	584	(overlay-put
	585	ov 'before-string
	586	(and (magit-blame--style-get 'margin-width)
	587	(propertize
	588	"o" 'display
	589	(list (list 'margin 'left-margin)
	590	(let ((line (overlay-get ov 'magit-blame-margin))
	591	(format (magit-blame--style-get 'margin-format))
	592	(face (magit-blame--style-get 'margin-face)))
	593	(magit-blame--format-string
	594	ov
	595	(or (and (atom format)
	596	format)
	597	(nth line format)
	598	(car (last format)))
	599	(or (and (not (zerop line))
	600	(magit-blame--style-get 'margin-body-face))
	601	face
	602	'magit-blame-margin))))))))
	603
	604	(defun magit-blame--update-heading-overlay (ov)
	605	(overlay-put
	606	ov 'before-string
	607	(--if-let (magit-blame--style-get 'heading-format)
	608	(magit-blame--format-string ov it 'magit-blame-heading)
	609	(and (magit-blame--style-get 'show-lines)
	610	(or (not (magit-blame--style-get 'margin-format))
	611	(save-excursion
	612	(goto-char (overlay-start ov))
	613	;; Special case of the special case described in
	614	;; `magit-blame--make-margin-overlay'. For empty
	615	;; lines it is not possible to show both overlays
	616	;; without the line being to high.
	617	(not (= (point) (line-end-position)))))
	618	magit-blame-separator))))
	619
	620	(defun magit-blame--update-highlight-overlay (ov)
	621	(overlay-put ov 'face (magit-blame--style-get 'highlight-face)))
	622
	623	(defun magit-blame--format-string (ov format face)
	624	(let* ((chunk (overlay-get ov 'magit-blame-chunk))
	625	(revinfo (overlay-get ov 'magit-blame-revinfo))
	626	(key (list format face))
	627	(string (cdr (assoc key revinfo))))
	628	(unless string
	629	(setq string
	630	(and format
	631	(magit-blame--format-string-1 (oref chunk orig-rev)
	632	revinfo format face)))
	633	(nconc revinfo (list (cons key string))))
	634	string))
	635
	636	(defun magit-blame--format-string-1 (rev revinfo format face)
	637	(let ((str
	638	(if (equal rev "0000000000000000000000000000000000000000")
	639	(propertize (concat (if (string-prefix-p "\s" format) "\s" "")
	640	"Not Yet Committed"
	641	(if (string-suffix-p "\n" format) "\n" ""))
	642	'face face)
	643	(magit--format-spec
	644	(propertize format 'face face)
	645	(cl-flet* ((p0 (s f)
	646	(propertize s 'face (if face
	647	(if (listp face)
	648	face
	649	(list f face))
	650	f)))
	651	(p1 (k f)
	652	(p0 (cdr (assoc k revinfo)) f))
	653	(p2 (k1 k2 f)
	654	(p0 (magit-blame--format-time-string
	655	(cdr (assoc k1 revinfo))
	656	(cdr (assoc k2 revinfo)))
	657	f)))
	658	`((?H . ,(p0 rev 'magit-blame-hash))
	659	(?s . ,(p1 "summary" 'magit-blame-summary))
	660	(?a . ,(p1 "author" 'magit-blame-name))
	661	(?c . ,(p1 "committer" 'magit-blame-name))
	662	(?A . ,(p2 "author-time" "author-tz" 'magit-blame-date))
	663	(?C . ,(p2 "committer-time" "committer-tz" 'magit-blame-date))
	664	(?f . "")))))))
	665	(if-let ((width (and (string-suffix-p "%f" format)
	666	(magit-blame--style-get 'margin-width))))
	667	(concat str
	668	(propertize (make-string (max 0 (- width (length str))) ?\s)
	669	'face face))
	670	str)))
	671
	672	(defun magit-blame--format-separator ()
	673	(propertize
	674	(concat (propertize "\s" 'display '(space :height (2)))
	675	(propertize "\n" 'line-height t))
	676	'face (list :background
	677	(face-attribute 'magit-blame-heading :background nil t))))
	678
	679	(defun magit-blame--format-time-string (time tz)
	680	(let* ((time-format (or (magit-blame--style-get 'time-format)
	681	magit-blame-time-format))
	682	(tz-in-second (and (not (version< emacs-version "25"))
	683	(string-match "%z" time-format)
	684	(car (last (parse-time-string tz))))))
	685	(format-time-string time-format
	686	(seconds-to-time (string-to-number time))
	687	tz-in-second)))
	688
	689	(defun magit-blame--remove-overlays (&optional beg end)
	690	(save-restriction
	691	(widen)
	692	(dolist (ov (overlays-in (or beg (point-min))
	693	(or end (point-max))))
	694	(when (overlay-get ov 'magit-blame-chunk)
	695	(delete-overlay ov)))))
	696
	697	(defun magit-blame-maybe-show-message ()
	698	(when (magit-blame--style-get 'show-message)
	699	(let ((message-log-max 0))
	700	(if-let ((msg (cdr (assq 'heading
	701	(gethash (oref (magit-current-blame-chunk)
	702	orig-rev)
	703	magit-blame-cache)))))
	704	(progn (setq msg (substring msg 0 -1))
	705	(set-text-properties 0 (length msg) nil msg)
	706	(message msg))
	707	(message "Commit data not available yet. Still blaming.")))))
	708
	709	;;; Commands
	710
	711	;;;###autoload
	712	(defun magit-blame-echo ()
	713	"For each line show the revision in which it was added.
	714	Show the information about the chunk at point in the echo area
	715	when moving between chunks. Unlike other blaming commands, do
	716	not turn on `read-only-mode'."
	717	(interactive)
	718	(when magit-buffer-file-name
	719	(user-error "Blob buffers aren't supported"))
	720	(setq-local magit-blame--style
	721	(assq magit-blame-echo-style magit-blame-styles))
	722	(setq-local magit-blame-disable-modes
	723	(cons 'eldoc-mode magit-blame-disable-modes))
	724	(if (not magit-blame-mode)
	725	(let ((magit-blame-read-only nil))
	726	(magit-blame-addition))
	727	(read-only-mode -1)
	728	(magit-blame--update-overlays)))
	729
	730	;;;###autoload
	731	(defun magit-blame-addition ()
	732	"For each line show the revision in which it was added."
	733	(interactive)
	734	(magit-blame--pre-blame-assert 'addition)
	735	(magit-blame--pre-blame-setup 'addition)
	736	(magit-blame--run))
	737
	738	;;;###autoload
	739	(defun magit-blame-removal ()
	740	"For each line show the revision in which it was removed."
	741	(interactive)
	742	(unless magit-buffer-file-name
	743	(user-error "Only blob buffers can be blamed in reverse"))
	744	(magit-blame--pre-blame-assert 'removal)
	745	(magit-blame--pre-blame-setup 'removal)
	746	(magit-blame--run))
	747
	748	;;;###autoload
	749	(defun magit-blame-reverse ()
	750	"For each line show the last revision in which it still exists."
	751	(interactive)
	752	(unless magit-buffer-file-name
	753	(user-error "Only blob buffers can be blamed in reverse"))
	754	(magit-blame--pre-blame-assert 'final)
	755	(magit-blame--pre-blame-setup 'final)
	756	(magit-blame--run))
	757
	758	(defun magit-blame--pre-blame-assert (type)
	759	(unless (magit-toplevel)
	760	(magit--not-inside-repository-error))
	761	(if (and magit-blame-mode
	762	(eq type magit-blame-type))
	763	(if-let ((chunk (magit-current-blame-chunk)))
	764	(unless (oref chunk prev-rev)
	765	(user-error "Chunk has no further history"))
	766	(user-error "Commit data not available yet. Still blaming."))
	767	(unless (magit-file-relative-name nil (not magit-buffer-file-name))
	768	(if buffer-file-name
	769	(user-error "Buffer isn't visiting a tracked file")
	770	(user-error "Buffer isn't visiting a file")))))
	771
	772	(defun magit-blame--pre-blame-setup (type)
	773	(when magit-blame-mode
	774	(if (eq type magit-blame-type)
	775	(let ((style magit-blame--style))
	776	(magit-blame-visit-other-file)
	777	(setq-local magit-blame--style style)
	778	(setq-local magit-blame-recursive-p t)
	779	;; Set window-start for the benefit of quickstart.
	780	(redisplay))
	781	(magit-blame--remove-overlays)))
	782	(setq magit-blame-type type))
	783
	784	(defun magit-blame-visit-other-file ()
	785	"Visit another blob related to the current chunk."
	786	(interactive)
	787	(with-slots (prev-rev prev-file orig-line)
	788	(magit-current-blame-chunk)
	789	(unless prev-rev
	790	(user-error "Chunk has no further history"))
	791	(magit-with-toplevel
	792	(magit-find-file prev-rev prev-file))
	793	;; TODO Adjust line like magit-diff-visit-file.
	794	(goto-char (point-min))
	795	(forward-line (1- orig-line))))
	796
	797	(defun magit-blame-visit-file ()
	798	"Visit the blob related to the current chunk."
	799	(interactive)
	800	(with-slots (orig-rev orig-file orig-line)
	801	(magit-current-blame-chunk)
	802	(magit-with-toplevel
	803	(magit-find-file orig-rev orig-file))
	804	(goto-char (point-min))
	805	(forward-line (1- orig-line))))
	806
	807	(defun magit-blame-quit ()
	808	"Turn off Magit-Blame mode.
	809	If the buffer was created during a recursive blame,
	810	then also kill the buffer."
	811	(interactive)
	812	(magit-blame-mode -1)
	813	(when magit-blame-recursive-p
	814	(kill-buffer)))
	815
	816	(defun magit-blame-next-chunk ()
	817	"Move to the next chunk."
	818	(interactive)
	819	(--if-let (next-single-char-property-change (point) 'magit-blame-chunk)
	820	(goto-char it)
	821	(user-error "No more chunks")))
	822
	823	(defun magit-blame-previous-chunk ()
	824	"Move to the previous chunk."
	825	(interactive)
	826	(--if-let (previous-single-char-property-change (point) 'magit-blame-chunk)
	827	(goto-char it)
	828	(user-error "No more chunks")))
	829
	830	(defun magit-blame-next-chunk-same-commit (&optional previous)
	831	"Move to the next chunk from the same commit.\n\n(fn)"
	832	(interactive)
	833	(if-let ((rev (oref (magit-current-blame-chunk) orig-rev)))
	834	(let ((pos (point)) ov)
	835	(save-excursion
	836	(while (and (not ov)
	837	(not (= pos (if previous (point-min) (point-max))))
	838	(setq pos (funcall
	839	(if previous
	840	'previous-single-char-property-change
	841	'next-single-char-property-change)
	842	pos 'magit-blame-chunk)))
	843	(--when-let (magit-blame--overlay-at pos)
	844	(when (equal (oref (magit-blame-chunk-at pos) orig-rev) rev)
	845	(setq ov it)))))
	846	(if ov
	847	(goto-char (overlay-start ov))
	848	(user-error "No more chunks from same commit")))
	849	(user-error "This chunk hasn't been blamed yet")))
	850
	851	(defun magit-blame-previous-chunk-same-commit ()
	852	"Move to the previous chunk from the same commit."
	853	(interactive)
	854	(magit-blame-next-chunk-same-commit 'previous-single-char-property-change))
	855
	856	(defun magit-blame-cycle-style ()
	857	"Change how blame information is visualized.
	858	Cycle through the elements of option `magit-blame-styles'."
	859	(interactive)
	860	(setq magit-blame--style
	861	(or (cadr (cl-member (car magit-blame--style)
	862	magit-blame-styles :key #'car))
	863	(car magit-blame-styles)))
	864	(magit-blame--update-margin)
	865	(magit-blame--update-overlays))
	866
	867	(defun magit-blame-copy-hash ()
	868	"Save hash of the current chunk's commit to the kill ring.
	869
	870	When the region is active, then save the region's content
	871	instead of the hash, like `kill-ring-save' would."
	872	(interactive)
	873	(if (use-region-p)
	874	(copy-region-as-kill nil nil 'region)
	875	(kill-new (message "%s" (oref (magit-current-blame-chunk) orig-rev)))))
	876
	877	;;; Popup
	878
	879	;;;###autoload (autoload 'magit-blame-popup "magit-blame" nil t)
	880	(magit-define-popup magit-blame-popup
	881	"Popup console for blame commands."
	882	:man-page "git-blame"
	883	:switches '((?w "Ignore whitespace" "-w")
	884	(?r "Do not treat root commits as boundaries" "--root"))
	885	:options '((?M "Detect lines moved or copied within a file" "-M")
	886	(?C "Detect lines moved or copied between files" "-C"))
	887	:actions '("Actions"
	888	(?b "Show commits adding lines" magit-blame-addition)
	889	(?r (lambda ()
	890	(with-current-buffer magit-pre-popup-buffer
	891	(and (not buffer-file-name)
	892	(propertize "Show commits removing lines"
	893	'face 'default))))
	894	magit-blame-removal)
	895	(?f (lambda ()
	896	(with-current-buffer magit-pre-popup-buffer
	897	(and (not buffer-file-name)
	898	(propertize "Show last commits that still have lines"
	899	'face 'default))))
	900	magit-blame-reverse)
	901	(lambda ()
	902	(and (with-current-buffer magit-pre-popup-buffer
	903	magit-blame-mode)
	904	(propertize "Refresh" 'face 'magit-popup-heading)))
	905	(?c "Cycle style" magit-blame-cycle-style))
	906	:default-arguments '("-w")
	907	:max-action-columns 1
	908	:default-action 'magit-blame-addition)
	909
	910	;;; Utilities
	911
	912	(defun magit-blame-maybe-update-revision-buffer ()
	913	(unless magit--update-revision-buffer
	914	(setq magit--update-revision-buffer nil)
	915	(when-let ((chunk (magit-current-blame-chunk))
	916	(commit (oref chunk orig-rev))
	917	(buffer (magit-mode-get-buffer 'magit-revision-mode nil t)))
	918	(setq magit--update-revision-buffer (list commit buffer))
	919	(run-with-idle-timer
	920	magit-update-other-window-delay nil
	921	(lambda ()
	922	(pcase-let ((`(,rev ,buf) magit--update-revision-buffer))
	923	(setq magit--update-revision-buffer nil)
	924	(when (buffer-live-p buf)
	925	(let ((magit-display-buffer-noselect t))
	926	(apply #'magit-show-commit rev (magit-diff-arguments))))))))))
	927
	928	;;; _
	929	(provide 'magit-blame)
	930	;;; magit-blame.el ends here