Klimi's new dotfiles with stow.
Não pode escolher mais do que 25 tópicos Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.

948 linhas
36 KiB

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