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