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