magit-section.el (76658B)
1 ;;; magit-section.el --- Sections for read-only buffers -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2010-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 ;; Keywords: tools 12 ;; Homepage: https://github.com/magit/magit 13 ;; Package-Requires: ((emacs "25.1") (dash "2.19.1")) 14 ;; Package-Version: 3.3.0 15 ;; SPDX-License-Identifier: GPL-3.0-or-later 16 17 ;; Magit-Section is free software; you can redistribute it and/or modify 18 ;; it under the terms of the GNU General Public License as published by 19 ;; the Free Software Foundation; either version 3, or (at your option) 20 ;; any later version. 21 ;; 22 ;; Magit-Section is distributed in the hope that it will be useful, 23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 25 ;; GNU General Public License for more details. 26 ;; 27 ;; You should have received a copy of the GNU General Public License 28 ;; along with Magit. If not, see http://www.gnu.org/licenses. 29 30 ;;; Commentary: 31 32 ;; This package implements the main user interface of Magit — the 33 ;; collapsible sections that make up its buffers. This package used 34 ;; to be distributed as part of Magit but now it can also be used by 35 ;; other packages that have nothing to do with Magit or Git. 36 37 ;;; Code: 38 39 (require 'cl-lib) 40 (require 'dash) 41 (require 'eieio) 42 (require 'seq) 43 (require 'subr-x) 44 45 (eval-when-compile (require 'benchmark)) 46 47 ;;; Hooks 48 49 (defvar magit-section-movement-hook nil 50 "Hook run by `magit-section-goto'. 51 That function in turn is used by all section movement commands.") 52 53 (defvar magit-section-highlight-hook 54 '(magit-section-highlight 55 magit-section-highlight-selection) 56 "Functions used to highlight the current section. 57 Each function is run with the current section as only argument 58 until one of them returns non-nil.") 59 60 (defvar magit-section-unhighlight-hook nil 61 "Functions used to unhighlight the previously current section. 62 Each function is run with the current section as only argument 63 until one of them returns non-nil. Most sections are properly 64 unhighlighted without requiring a specialized unhighlighter, 65 diff-related sections being the only exception.") 66 67 (defvar magit-section-set-visibility-hook 68 '(magit-section-cached-visibility) 69 "Hook used to set the initial visibility of a section. 70 Stop at the first function that returns non-nil. The returned 71 value should be `show', `hide' or nil. If no function returns 72 non-nil, determine the visibility as usual, i.e. use the 73 hardcoded section specific default (see `magit-insert-section').") 74 75 (defvar magit-section-goto-successor-hook nil 76 "Hook used to go to the same section as was current before a refresh. 77 This is only used if the standard mechanism for doing so did not 78 succeed.") 79 80 ;;; Options 81 82 (defgroup magit-section nil 83 "Expandable sections." 84 :link '(info-link "(magit)Sections") 85 :group 'extensions) 86 87 (defcustom magit-section-show-child-count t 88 "Whether to append the number of children to section headings. 89 This only applies to sections for which doing so makes sense." 90 :package-version '(magit . "2.1.0") 91 :group 'magit-section 92 :type 'boolean) 93 94 (defcustom magit-section-cache-visibility t 95 "Whether to cache visibility of sections. 96 97 Sections always retain their visibility state when they are being 98 recreated during a refresh. But if a section disappears and then 99 later reappears again, then this option controls whether this is 100 the case. 101 102 If t, then cache the visibility of all sections. If a list of 103 section types, then only do so for matching sections. If nil, 104 then don't do so for any sections." 105 :package-version '(magit . "2.12.0") 106 :group 'magit-section 107 :type '(choice (const :tag "Don't cache visibility" nil) 108 (const :tag "Cache visibility of all sections" t) 109 (repeat :tag "Cache visibility for section types" symbol))) 110 111 (defcustom magit-section-initial-visibility-alist 112 '((stashes . hide)) 113 "Alist controlling the initial visibility of sections. 114 115 Each element maps a section type or lineage to the initial 116 visibility state for such sections. The state has to be one of 117 `show' or `hide', or a function that returns one of these symbols. 118 A function is called with the section as the only argument. 119 120 Use the command `magit-describe-section' to determine a section's 121 lineage or type. The vector in the output is the section lineage 122 and the type is the first element of that vector. Wildcards can 123 be used, see `magit-section-match'. 124 125 Currently this option is only used to override hardcoded defaults, 126 but in the future it will also be used set the defaults. 127 128 An entry whose key is `magit-status-initial-section' specifies 129 the visibility of the section `magit-status-goto-initial-section' 130 jumps to. This does not only override defaults, but also other 131 entries of this alist." 132 :package-version '(magit . "2.12.0") 133 :group 'magit-section 134 :type '(alist :key-type (sexp :tag "Section type/lineage") 135 :value-type (choice (const hide) 136 (const show) 137 function))) 138 139 (defcustom magit-section-visibility-indicator 140 (if (window-system) 141 '(magit-fringe-bitmap> . magit-fringe-bitmapv) 142 (cons (if (char-displayable-p ?…) "…" "...") 143 t)) 144 "Whether and how to indicate that a section can be expanded/collapsed. 145 146 If nil, then don't show any indicators. 147 Otherwise the value has to have one of these two forms: 148 149 \(EXPANDABLE-BITMAP . COLLAPSIBLE-BITMAP) 150 151 Both values have to be variables whose values are fringe 152 bitmaps. In this case every section that can be expanded or 153 collapsed gets an indicator in the left fringe. 154 155 To provide extra padding around the indicator, set 156 `left-fringe-width' in `magit-mode-hook'. 157 158 \(STRING . BOOLEAN) 159 160 In this case STRING (usually an ellipsis) is shown at the end 161 of the heading of every collapsed section. Expanded sections 162 get no indicator. The cdr controls whether the appearance of 163 these ellipsis take section highlighting into account. Doing 164 so might potentially have an impact on performance, while not 165 doing so is kinda ugly." 166 :package-version '(magit . "3.0.0") 167 :group 'magit-section 168 :type '(choice (const :tag "No indicators" nil) 169 (cons :tag "Use +- fringe indicators" 170 (const magit-fringe-bitmap+) 171 (const magit-fringe-bitmap-)) 172 (cons :tag "Use >v fringe indicators" 173 (const magit-fringe-bitmap>) 174 (const magit-fringe-bitmapv)) 175 (cons :tag "Use bold >v fringe indicators)" 176 (const magit-fringe-bitmap-bold>) 177 (const magit-fringe-bitmap-boldv)) 178 (cons :tag "Use custom fringe indicators" 179 (variable :tag "Expandable bitmap variable") 180 (variable :tag "Collapsible bitmap variable")) 181 (cons :tag "Use ellipses at end of headings" 182 (string :tag "Ellipsis" "…") 183 (choice :tag "Use face kludge" 184 (const :tag "Yes (potentially slow)" t) 185 (const :tag "No (kinda ugly)" nil))))) 186 187 (defcustom magit-keep-region-overlay nil 188 "Whether to keep the region overlay when there is a valid selection. 189 190 By default Magit removes the regular region overlay if, and only 191 if, that region constitutes a valid selection as understood by 192 Magit commands. Otherwise it does not remove that overlay, and 193 the region looks like it would in other buffers. 194 195 There are two types of such valid selections: hunk-internal 196 regions and regions that select two or more sibling sections. 197 In such cases Magit removes the region overlay and instead 198 highlights a slightly larger range. All text (for hunk-internal 199 regions) or the headings of all sections (for sibling selections) 200 that are inside that range (not just inside the region) are acted 201 on by commands such as the staging command. This buffer range 202 begins at the beginning of the line on which the region begins 203 and ends at the end of the line on which the region ends. 204 205 Because Magit acts on this larger range and not the region, it is 206 actually quite important to visualize that larger range. If we 207 don't do that, then one might think that these commands act on 208 the region instead. If you want to *also* visualize the region, 209 then set this option to t. But please note that when the region 210 does *not* constitute a valid selection, then the region is 211 *always* visualized as usual, and that it is usually under such 212 circumstances that you want to use a non-magit command to act on 213 the region. 214 215 Besides keeping the region overlay, setting this option to t also 216 causes all face properties, except for `:foreground', to be 217 ignored for the faces used to highlight headings of selected 218 sections. This avoids the worst conflicts that result from 219 displaying the region and the selection overlays at the same 220 time. We are not interested in dealing with other conflicts. 221 In fact we *already* provide a way to avoid all of these 222 conflicts: *not* changing the value of this option. 223 224 It should be clear by now that we consider it a mistake to set 225 this to display the region when the Magit selection is also 226 visualized, but since it has been requested a few times and 227 because it doesn't cost much to offer this option we do so. 228 However that might change. If the existence of this option 229 starts complicating other things, then it will be removed." 230 :package-version '(magit . "2.3.0") 231 :group 'magit-section 232 :type 'boolean) 233 234 (defcustom magit-section-disable-line-numbers t 235 "In Magit buffers, whether to disable modes that display line numbers. 236 237 Some users who turn on `global-display-line-numbers-mode' (or 238 `global-nlinum-mode' or `global-linum-mode') expect line numbers 239 to be displayed everywhere except in Magit buffers. Other users 240 do not expect Magit buffers to be treated differently. At least 241 in theory users in the first group should not use the global mode, 242 but that ship has sailed, thus this option." 243 :package-version '(magit . "3.0.0") 244 :group 'magit-section 245 :type 'boolean) 246 247 ;;; Faces 248 249 (defgroup magit-section-faces nil 250 "Faces used by Magit-Section." 251 :group 'magit-section 252 :group 'faces) 253 254 (defface magit-section-highlight 255 `((((class color) (background light)) 256 ,@(and (>= emacs-major-version 27) '(:extend t)) 257 :background "grey95") 258 (((class color) (background dark)) 259 ,@(and (>= emacs-major-version 27) '(:extend t)) 260 :background "grey20")) 261 "Face for highlighting the current section." 262 :group 'magit-section-faces) 263 264 (defface magit-section-heading 265 `((((class color) (background light)) 266 ,@(and (>= emacs-major-version 27) '(:extend t)) 267 :foreground "DarkGoldenrod4" 268 :weight bold) 269 (((class color) (background dark)) 270 ,@(and (>= emacs-major-version 27) '(:extend t)) 271 :foreground "LightGoldenrod2" 272 :weight bold)) 273 "Face for section headings." 274 :group 'magit-section-faces) 275 276 (defface magit-section-secondary-heading 277 `((t ,@(and (>= emacs-major-version 27) '(:extend t)) 278 :weight bold)) 279 "Face for section headings of some secondary headings." 280 :group 'magit-section-faces) 281 282 (defface magit-section-heading-selection 283 `((((class color) (background light)) 284 ,@(and (>= emacs-major-version 27) '(:extend t)) 285 :foreground "salmon4") 286 (((class color) (background dark)) 287 ,@(and (>= emacs-major-version 27) '(:extend t)) 288 :foreground "LightSalmon3")) 289 "Face for selected section headings." 290 :group 'magit-section-faces) 291 292 ;;; Classes 293 294 (defvar magit--current-section-hook nil 295 "Internal variable used for `magit-describe-section'.") 296 297 (defvar magit--section-type-alist nil) 298 299 (defclass magit-section () 300 ((keymap :initform nil :allocation :class) 301 (type :initform nil :initarg :type) 302 (value :initform nil :initarg :value) 303 (start :initform nil :initarg :start) 304 (content :initform nil) 305 (end :initform nil) 306 (hidden :initform nil) 307 (washer :initform nil) 308 (process :initform nil) 309 (heading-highlight-face :initform nil) 310 (inserter :initform (symbol-value 'magit--current-section-hook)) 311 (parent :initform nil :initarg :parent) 312 (children :initform nil))) 313 314 ;;; Mode 315 316 (defvar symbol-overlay-inhibit-map) 317 318 (defvar magit-section-mode-map 319 (let ((map (make-keymap))) 320 (suppress-keymap map t) 321 (define-key map (kbd "TAB") 'magit-section-toggle) 322 (define-key map [C-tab] 'magit-section-cycle) 323 (define-key map [M-tab] 'magit-section-cycle) 324 ;; [backtab] is the most portable binding for Shift+Tab. 325 (define-key map [backtab] 'magit-section-cycle-global) 326 (define-key map (kbd "^") 'magit-section-up) 327 (define-key map (kbd "p") 'magit-section-backward) 328 (define-key map (kbd "n") 'magit-section-forward) 329 (define-key map (kbd "M-p") 'magit-section-backward-sibling) 330 (define-key map (kbd "M-n") 'magit-section-forward-sibling) 331 (define-key map (kbd "1") 'magit-section-show-level-1) 332 (define-key map (kbd "2") 'magit-section-show-level-2) 333 (define-key map (kbd "3") 'magit-section-show-level-3) 334 (define-key map (kbd "4") 'magit-section-show-level-4) 335 (define-key map (kbd "M-1") 'magit-section-show-level-1-all) 336 (define-key map (kbd "M-2") 'magit-section-show-level-2-all) 337 (define-key map (kbd "M-3") 'magit-section-show-level-3-all) 338 (define-key map (kbd "M-4") 'magit-section-show-level-4-all) 339 map)) 340 341 (define-derived-mode magit-section-mode special-mode "Magit-Sections" 342 "Parent major mode from which major modes with Magit-like sections inherit. 343 344 Magit-Section is documented in info node `(magit-section)'." 345 :group 'magit-section 346 (buffer-disable-undo) 347 (setq truncate-lines t) 348 (setq buffer-read-only t) 349 (setq-local line-move-visual t) ; see #1771 350 ;; Turn off syntactic font locking, but not by setting 351 ;; `font-lock-defaults' because that would enable font locking, and 352 ;; not all magit plugins may be ready for that (see #3950). 353 (setq-local font-lock-syntactic-face-function #'ignore) 354 (setq show-trailing-whitespace nil) 355 (setq-local symbol-overlay-inhibit-map t) 356 (setq list-buffers-directory (abbreviate-file-name default-directory)) 357 ;; (hack-dir-local-variables-non-file-buffer) 358 (make-local-variable 'text-property-default-nonsticky) 359 (push (cons 'keymap t) text-property-default-nonsticky) 360 (add-hook 'pre-command-hook #'magit-section-pre-command-hook nil t) 361 (add-hook 'post-command-hook #'magit-section-update-highlight t t) 362 (add-hook 'deactivate-mark-hook #'magit-section-deactivate-mark t t) 363 (setq-local redisplay-highlight-region-function 364 'magit-section--highlight-region) 365 (setq-local redisplay-unhighlight-region-function 366 'magit-section--unhighlight-region) 367 (when magit-section-disable-line-numbers 368 (when (bound-and-true-p global-linum-mode) 369 (linum-mode -1)) 370 (when (and (fboundp 'nlinum-mode) 371 (bound-and-true-p global-nlinum-mode)) 372 (nlinum-mode -1)) 373 (when (and (fboundp 'display-line-numbers-mode) 374 (bound-and-true-p global-display-line-numbers-mode)) 375 (display-line-numbers-mode -1))) 376 (when (fboundp 'magit-preserve-section-visibility-cache) 377 (add-hook 'kill-buffer-hook #'magit-preserve-section-visibility-cache))) 378 379 ;;; Core 380 381 (defvar-local magit-root-section nil 382 "The root section in the current buffer. 383 All other sections are descendants of this section. The value 384 of this variable is set by `magit-insert-section' and you should 385 never modify it.") 386 (put 'magit-root-section 'permanent-local t) 387 388 (defun magit-current-section () 389 "Return the section at point." 390 (or (get-text-property (point) 'magit-section) magit-root-section)) 391 392 (defun magit-section-ident (section) 393 "Return an unique identifier for SECTION. 394 The return value has the form ((TYPE . VALUE)...)." 395 (with-slots (type value parent) section 396 (cons (cons type 397 (cond ((eieio-object-p value) 398 (magit-section-ident-value value)) 399 ((not (memq type '(unpulled unpushed))) value) 400 ((string-match-p "@{upstream}" value) value) 401 ;; Unfortunately Git chokes on "@{push}" when 402 ;; the value of `push.default' does not allow a 403 ;; 1:1 mapping. Arbitrary commands may consult 404 ;; the section value so we cannot use "@{push}". 405 ;; But `unpushed' and `unpulled' sections should 406 ;; keep their identity when switching branches 407 ;; so we have to use another value here. 408 ((string-match-p "\\`\\.\\." value) "..@{push}") 409 (t "@{push}.."))) 410 (and parent 411 (magit-section-ident parent))))) 412 413 (cl-defgeneric magit-section-ident-value (value) 414 "Return a constant representation of VALUE. 415 VALUE is the value of a `magit-section' object. If that is an 416 object itself, then that is not suitable to be used to identify 417 the section because two objects may represent the same thing but 418 not be equal. If possible a method should be added for such 419 objects, which returns a value that is equal. Otherwise the 420 catch-all method is used, which just returns the argument 421 itself.") 422 423 (cl-defmethod magit-section-ident-value (arg) arg) 424 425 (defun magit-get-section (ident &optional root) 426 "Return the section identified by IDENT. 427 IDENT has to be a list as returned by `magit-section-ident'. 428 If optional ROOT is non-nil, then search in that section tree 429 instead of in the one whose root `magit-root-section' is." 430 (setq ident (reverse ident)) 431 (let ((section (or root magit-root-section))) 432 (when (eq (car (pop ident)) 433 (oref section type)) 434 (while (and ident 435 (pcase-let* ((`(,type . ,value) (car ident)) 436 (value (magit-section-ident-value value))) 437 (setq section 438 (cl-find-if (lambda (section) 439 (and (eq (oref section type) type) 440 (equal (magit-section-ident-value 441 (oref section value)) 442 value))) 443 (oref section children))))) 444 (pop ident)) 445 section))) 446 447 (defun magit-section-lineage (section) 448 "Return the lineage of SECTION. 449 The return value has the form (TYPE...)." 450 (cons (oref section type) 451 (when-let ((parent (oref section parent))) 452 (magit-section-lineage parent)))) 453 454 (defvar magit-insert-section--current nil "For internal use only.") 455 (defvar magit-insert-section--parent nil "For internal use only.") 456 (defvar magit-insert-section--oldroot nil "For internal use only.") 457 458 ;;; Commands 459 ;;;; Movement 460 461 (defun magit-section-forward () 462 "Move to the beginning of the next visible section." 463 (interactive) 464 (if (eobp) 465 (user-error "No next section") 466 (let ((section (magit-current-section))) 467 (if (oref section parent) 468 (let ((next (and (not (oref section hidden)) 469 (not (= (oref section end) 470 (1+ (point)))) 471 (car (oref section children))))) 472 (while (and section (not next)) 473 (unless (setq next (car (magit-section-siblings section 'next))) 474 (setq section (oref section parent)))) 475 (if next 476 (magit-section-goto next) 477 (user-error "No next section"))) 478 (magit-section-goto 1))))) 479 480 (defun magit-section-backward () 481 "Move to the beginning of the current or the previous visible section. 482 When point is at the beginning of a section then move to the 483 beginning of the previous visible section. Otherwise move to 484 the beginning of the current section." 485 (interactive) 486 (if (bobp) 487 (user-error "No previous section") 488 (let ((section (magit-current-section)) children) 489 (cond 490 ((and (= (point) 491 (1- (oref section end))) 492 (setq children (oref section children))) 493 (magit-section-goto (car (last children)))) 494 ((and (oref section parent) 495 (not (= (point) 496 (oref section start)))) 497 (magit-section-goto section)) 498 (t 499 (let ((prev (car (magit-section-siblings section 'prev)))) 500 (if prev 501 (while (and (not (oref prev hidden)) 502 (setq children (oref prev children))) 503 (setq prev (car (last children)))) 504 (setq prev (oref section parent))) 505 (cond (prev 506 (magit-section-goto prev)) 507 ((oref section parent) 508 (user-error "No previous section")) 509 ;; Eob special cases. 510 ((not (get-text-property (1- (point)) 'invisible)) 511 (magit-section-goto -1)) 512 (t 513 (goto-char (previous-single-property-change 514 (1- (point)) 'invisible)) 515 (forward-line -1) 516 (magit-section-goto (magit-current-section)))))))))) 517 518 (defun magit-section-up () 519 "Move to the beginning of the parent section." 520 (interactive) 521 (--if-let (oref (magit-current-section) parent) 522 (magit-section-goto it) 523 (user-error "No parent section"))) 524 525 (defun magit-section-forward-sibling () 526 "Move to the beginning of the next sibling section. 527 If there is no next sibling section, then move to the parent." 528 (interactive) 529 (let ((current (magit-current-section))) 530 (if (oref current parent) 531 (--if-let (car (magit-section-siblings current 'next)) 532 (magit-section-goto it) 533 (magit-section-forward)) 534 (magit-section-goto 1)))) 535 536 (defun magit-section-backward-sibling () 537 "Move to the beginning of the previous sibling section. 538 If there is no previous sibling section, then move to the parent." 539 (interactive) 540 (let ((current (magit-current-section))) 541 (if (oref current parent) 542 (--if-let (car (magit-section-siblings current 'prev)) 543 (magit-section-goto it) 544 (magit-section-backward)) 545 (magit-section-goto -1)))) 546 547 (defun magit-section-goto (arg) 548 (if (integerp arg) 549 (progn (forward-line arg) 550 (setq arg (magit-current-section))) 551 (goto-char (oref arg start))) 552 (run-hook-with-args 'magit-section-movement-hook arg)) 553 554 (defun magit-section-set-window-start (section) 555 "Ensure the beginning of SECTION is visible." 556 (unless (pos-visible-in-window-p (oref section end)) 557 (set-window-start (selected-window) (oref section start)))) 558 559 (defmacro magit-define-section-jumper (name heading type &optional value) 560 "Define an interactive function to go some section. 561 Together TYPE and VALUE identify the section. 562 HEADING is the displayed heading of the section." 563 (declare (indent defun)) 564 `(defun ,name (&optional expand) ,(format "\ 565 Jump to the section \"%s\". 566 With a prefix argument also expand it." heading) 567 (interactive "P") 568 (--if-let (magit-get-section 569 (cons (cons ',type ,value) 570 (magit-section-ident magit-root-section))) 571 (progn (goto-char (oref it start)) 572 (when expand 573 (with-local-quit (magit-section-show it)) 574 (recenter 0))) 575 (message ,(format "Section \"%s\" wasn't found" heading))))) 576 577 ;;;; Visibility 578 579 (defun magit-section-show (section) 580 "Show the body of the current section." 581 (interactive (list (magit-current-section))) 582 (oset section hidden nil) 583 (magit-section--maybe-wash section) 584 (when-let ((beg (oref section content))) 585 (remove-overlays beg (oref section end) 'invisible t)) 586 (magit-section-maybe-update-visibility-indicator section) 587 (magit-section-maybe-cache-visibility section) 588 (dolist (child (oref section children)) 589 (if (oref child hidden) 590 (magit-section-hide child) 591 (magit-section-show child)))) 592 593 (defun magit-section--maybe-wash (section) 594 (when-let ((washer (oref section washer))) 595 (oset section washer nil) 596 (let ((inhibit-read-only t) 597 (magit-insert-section--parent section) 598 (content (oref section content))) 599 (save-excursion 600 (if (and content (< content (oref section end))) 601 (funcall washer section) ; already partially washed (hunk) 602 (goto-char (oref section end)) 603 (oset section content (point-marker)) 604 (funcall washer) 605 (oset section end (point-marker))))) 606 (magit-section-update-highlight))) 607 608 (defun magit-section-hide (section) 609 "Hide the body of the current section." 610 (interactive (list (magit-current-section))) 611 (if (eq section magit-root-section) 612 (user-error "Cannot hide root section") 613 (oset section hidden t) 614 (when-let ((beg (oref section content))) 615 (let ((end (oref section end))) 616 (remove-overlays beg end 'invisible t) 617 (let ((o (make-overlay beg end))) 618 (overlay-put o 'evaporate t) 619 (overlay-put o 'invisible t)))) 620 (magit-section-maybe-update-visibility-indicator section) 621 (magit-section-maybe-cache-visibility section))) 622 623 (defun magit-section-toggle (section) 624 "Toggle visibility of the body of the current section." 625 (interactive (list (magit-current-section))) 626 (if (eq section magit-root-section) 627 (user-error "Cannot hide root section") 628 (goto-char (oref section start)) 629 (if (oref section hidden) 630 (magit-section-show section) 631 (magit-section-hide section)))) 632 633 (defun magit-section-toggle-children (section) 634 "Toggle visibility of bodies of children of the current section." 635 (interactive (list (magit-current-section))) 636 (goto-char (oref section start)) 637 (let* ((children (oref section children)) 638 (show (--any-p (oref it hidden) children))) 639 (dolist (c children) 640 (oset c hidden show))) 641 (magit-section-show section)) 642 643 (defun magit-section-show-children (section &optional depth) 644 "Recursively show the bodies of children of the current section. 645 With a prefix argument show children that deep and hide deeper 646 children." 647 (interactive (list (magit-current-section))) 648 (magit-section-show-children-1 section depth) 649 (magit-section-show section)) 650 651 (defun magit-section-show-children-1 (section &optional depth) 652 (dolist (child (oref section children)) 653 (oset child hidden nil) 654 (if depth 655 (if (> depth 0) 656 (magit-section-show-children-1 child (1- depth)) 657 (magit-section-hide child)) 658 (magit-section-show-children-1 child)))) 659 660 (defun magit-section-hide-children (section) 661 "Recursively hide the bodies of children of the current section." 662 (interactive (list (magit-current-section))) 663 (mapc 'magit-section-hide (oref section children))) 664 665 (defun magit-section-show-headings (section) 666 "Recursively show headings of children of the current section. 667 Only show the headings, previously shown text-only bodies are 668 hidden." 669 (interactive (list (magit-current-section))) 670 (magit-section-show-headings-1 section) 671 (magit-section-show section)) 672 673 (defun magit-section-show-headings-1 (section) 674 (dolist (child (oref section children)) 675 (oset child hidden nil) 676 (when (or (oref child children) 677 (not (oref child content))) 678 (magit-section-show-headings-1 child)))) 679 680 (defun magit-section-cycle (section) 681 "Cycle visibility of current section and its children." 682 (interactive (list (magit-current-section))) 683 (goto-char (oref section start)) 684 (if (oref section hidden) 685 (progn (magit-section-show section) 686 (magit-section-hide-children section)) 687 (let ((children (oref section children))) 688 (cond ((and (--any-p (oref it hidden) children) 689 (--any-p (oref it children) children)) 690 (magit-section-show-headings section)) 691 ((seq-some 'magit-section-hidden-body children) 692 (magit-section-show-children section)) 693 (t 694 (magit-section-hide section)))))) 695 696 (defun magit-section-cycle-global () 697 "Cycle visibility of all sections in the current buffer." 698 (interactive) 699 (let ((children (oref magit-root-section children))) 700 (cond ((and (--any-p (oref it hidden) children) 701 (--any-p (oref it children) children)) 702 (magit-section-show-headings magit-root-section)) 703 ((seq-some 'magit-section-hidden-body children) 704 (magit-section-show-children magit-root-section)) 705 (t 706 (mapc 'magit-section-hide children))))) 707 708 (defun magit-section-hidden-body (section &optional pred) 709 (--if-let (oref section children) 710 (funcall (or pred '-any-p) 'magit-section-hidden-body it) 711 (and (oref section content) 712 (oref section hidden)))) 713 714 (defun magit-section-invisible-p (section) 715 "Return t if the SECTION's body is invisible. 716 When the body of an ancestor of SECTION is collapsed then 717 SECTION's body (and heading) obviously cannot be visible." 718 (or (oref section hidden) 719 (--when-let (oref section parent) 720 (magit-section-invisible-p it)))) 721 722 (defun magit-section-show-level (level) 723 "Show surrounding sections up to LEVEL. 724 If LEVEL is negative, show up to the absolute value. 725 Sections at higher levels are hidden." 726 (if (< level 0) 727 (let ((s (magit-current-section))) 728 (setq level (- level)) 729 (while (> (1- (length (magit-section-ident s))) level) 730 (setq s (oref s parent)) 731 (goto-char (oref s start))) 732 (magit-section-show-children magit-root-section (1- level))) 733 (cl-do* ((s (magit-current-section) 734 (oref s parent)) 735 (i (1- (length (magit-section-ident s))) 736 (cl-decf i))) 737 ((cond ((< i level) (magit-section-show-children s (- level i 1)) t) 738 ((= i level) (magit-section-hide s) t)) 739 (magit-section-goto s))))) 740 741 (defun magit-section-show-level-1 () 742 "Show surrounding sections on first level." 743 (interactive) 744 (magit-section-show-level 1)) 745 746 (defun magit-section-show-level-1-all () 747 "Show all sections on first level." 748 (interactive) 749 (magit-section-show-level -1)) 750 751 (defun magit-section-show-level-2 () 752 "Show surrounding sections up to second level." 753 (interactive) 754 (magit-section-show-level 2)) 755 756 (defun magit-section-show-level-2-all () 757 "Show all sections up to second level." 758 (interactive) 759 (magit-section-show-level -2)) 760 761 (defun magit-section-show-level-3 () 762 "Show surrounding sections up to third level." 763 (interactive) 764 (magit-section-show-level 3)) 765 766 (defun magit-section-show-level-3-all () 767 "Show all sections up to third level." 768 (interactive) 769 (magit-section-show-level -3)) 770 771 (defun magit-section-show-level-4 () 772 "Show surrounding sections up to fourth level." 773 (interactive) 774 (magit-section-show-level 4)) 775 776 (defun magit-section-show-level-4-all () 777 "Show all sections up to fourth level." 778 (interactive) 779 (magit-section-show-level -4)) 780 781 ;;;; Auxiliary 782 783 (defun magit-describe-section-briefly (section &optional ident) 784 "Show information about the section at point. 785 With a prefix argument show the section identity instead of the 786 section lineage. This command is intended for debugging purposes." 787 (interactive (list (magit-current-section) current-prefix-arg)) 788 (let ((str (format "#<%s %S %S %s-%s%s>" 789 (eieio-object-class section) 790 (let ((val (oref section value))) 791 (cond ((stringp val) 792 (substring-no-properties val)) 793 ((and (eieio-object-p val) 794 (fboundp 'cl-prin1-to-string)) 795 (cl-prin1-to-string val)) 796 (t 797 val))) 798 (if ident 799 (magit-section-ident section) 800 (apply #'vector (magit-section-lineage section))) 801 (when-let ((m (oref section start))) 802 (marker-position m)) 803 (if-let ((m (oref section content))) 804 (format "[%s-]" (marker-position m)) 805 "") 806 (when-let ((m (oref section end))) 807 (marker-position m))))) 808 (if (called-interactively-p 'any) 809 (message "%s" str) 810 str))) 811 812 (cl-defmethod cl-print-object ((section magit-section) stream) 813 "Print `magit-describe-section' result of SECTION." 814 ;; Used by debug and edebug as of Emacs 26. 815 (princ (magit-describe-section-briefly section) stream)) 816 817 (defun magit-describe-section (section &optional interactive-p) 818 "Show information about the section at point." 819 (interactive (list (magit-current-section) t)) 820 (let ((inserter-section section)) 821 (while (and inserter-section (not (oref inserter-section inserter))) 822 (setq inserter-section (oref inserter-section parent))) 823 (when (and inserter-section (oref inserter-section inserter)) 824 (setq section inserter-section))) 825 (pcase (oref section inserter) 826 (`((,hook ,fun) . ,src-src) 827 (help-setup-xref `(magit-describe-section ,section) interactive-p) 828 (with-help-window (help-buffer) 829 (with-current-buffer standard-output 830 (insert (format-message 831 "%s\n is inserted by `%s'\n from `%s'" 832 (magit-describe-section-briefly section) 833 (make-text-button (symbol-name fun) nil 834 :type 'help-function 835 'help-args (list fun)) 836 (make-text-button (symbol-name hook) nil 837 :type 'help-variable 838 'help-args (list hook)))) 839 (pcase-dolist (`(,hook ,fun) src-src) 840 (insert (format-message 841 ",\n called by `%s'\n from `%s'" 842 (make-text-button (symbol-name fun) nil 843 :type 'help-function 844 'help-args (list fun)) 845 (make-text-button (symbol-name hook) nil 846 :type 'help-variable 847 'help-args (list hook))))) 848 (insert ".\n\n") 849 (insert 850 (format-message 851 "`%s' is " 852 (make-text-button (symbol-name fun) nil 853 :type 'help-function 'help-args (list fun)))) 854 (describe-function-1 fun)))) 855 (_ (message "%s, inserter unknown" 856 (magit-describe-section-briefly section))))) 857 858 ;;; Match 859 860 (cl-defun magit-section-match 861 (condition &optional (section (magit-current-section))) 862 "Return t if SECTION matches CONDITION. 863 864 SECTION defaults to the section at point. If SECTION is not 865 specified and there also is no section at point, then return 866 nil. 867 868 CONDITION can take the following forms: 869 (CONDITION...) matches if any of the CONDITIONs matches. 870 [CLASS...] matches if the section's class is the same 871 as the first CLASS or a subclass of that; 872 the section's parent class matches the 873 second CLASS; and so on. 874 [* CLASS...] matches sections that match [CLASS...] and 875 also recursively all their child sections. 876 CLASS matches if the section's class is the same 877 as CLASS or a subclass of that; regardless 878 of the classes of the parent sections. 879 880 Each CLASS should be a class symbol, identifying a class that 881 derives from `magit-section'. For backward compatibility CLASS 882 can also be a \"type symbol\". A section matches such a symbol 883 if the value of its `type' slot is `eq'. If a type symbol has 884 an entry in `magit--section-type-alist', then a section also 885 matches that type if its class is a subclass of the class that 886 corresponds to the type as per that alist. 887 888 Note that it is not necessary to specify the complete section 889 lineage as printed by `magit-describe-section-briefly', unless 890 of course you want to be that precise." 891 (and section (magit-section-match-1 condition section))) 892 893 (defun magit-section-match-1 (condition section) 894 (cl-assert condition) 895 (and section 896 (if (listp condition) 897 (--first (magit-section-match-1 it section) condition) 898 (magit-section-match-2 (if (symbolp condition) 899 (list condition) 900 (cl-coerce condition 'list)) 901 section)))) 902 903 (defun magit-section-match-2 (condition section) 904 (if (eq (car condition) '*) 905 (or (magit-section-match-2 (cdr condition) section) 906 (when-let ((parent (oref section parent))) 907 (magit-section-match-2 condition parent))) 908 (and (let ((c (car condition))) 909 (if (class-p c) 910 (cl-typep section c) 911 (if-let ((class (cdr (assq c magit--section-type-alist)))) 912 (cl-typep section class) 913 (eq (oref section type) c)))) 914 (or (not (setq condition (cdr condition))) 915 (when-let ((parent (oref section parent))) 916 (magit-section-match-2 condition parent)))))) 917 918 (defun magit-section-value-if (condition &optional section) 919 "If the section at point matches CONDITION, then return its value. 920 921 If optional SECTION is non-nil then test whether that matches 922 instead. If there is no section at point and SECTION is nil, 923 then return nil. If the section does not match, then return 924 nil. 925 926 See `magit-section-match' for the forms CONDITION can take." 927 (when-let ((section (or section (magit-current-section)))) 928 (and (magit-section-match condition section) 929 (oref section value)))) 930 931 (defmacro magit-section-when (condition &rest body) 932 "If the section at point matches CONDITION, evaluate BODY. 933 934 If the section matches, then evaluate BODY forms sequentially 935 with `it' bound to the section and return the value of the last 936 form. If there are no BODY forms, then return the value of the 937 section. If the section does not match or if there is no section 938 at point, then return nil. 939 940 See `magit-section-match' for the forms CONDITION can take." 941 (declare (obsolete 942 "instead use `magit-section-match' or `magit-section-value-if'." 943 "Magit 2.90.0") 944 (indent 1) 945 (debug (sexp body))) 946 `(--when-let (magit-current-section) 947 ;; Quoting CONDITION here often leads to double-quotes, which 948 ;; isn't an issue because `magit-section-match-1' implicitly 949 ;; deals with that. We shouldn't force users of this function 950 ;; to not quote CONDITION because that would needlessly break 951 ;; backward compatibility. 952 (when (magit-section-match ',condition it) 953 ,@(or body '((oref it value)))))) 954 955 (defmacro magit-section-case (&rest clauses) 956 "Choose among clauses on the type of the section at point. 957 958 Each clause looks like (CONDITION BODY...). The type of the 959 section is compared against each CONDITION; the BODY forms of the 960 first match are evaluated sequentially and the value of the last 961 form is returned. Inside BODY the symbol `it' is bound to the 962 section at point. If no clause succeeds or if there is no 963 section at point, return nil. 964 965 See `magit-section-match' for the forms CONDITION can take. 966 Additionally a CONDITION of t is allowed in the final clause, and 967 matches if no other CONDITION match, even if there is no section 968 at point." 969 (declare (indent 0) 970 (debug (&rest (sexp body)))) 971 `(let* ((it (magit-current-section))) 972 (cond ,@(mapcar (lambda (clause) 973 `(,(or (eq (car clause) t) 974 `(and it 975 (magit-section-match-1 ',(car clause) it))) 976 ,@(cdr clause))) 977 clauses)))) 978 979 (defun magit-section-match-assoc (section alist) 980 "Return the value associated with SECTION's type or lineage in ALIST." 981 (seq-some (pcase-lambda (`(,key . ,val)) 982 (and (magit-section-match-1 key section) val)) 983 alist)) 984 985 ;;; Create 986 987 (defvar magit-insert-section-hook nil 988 "Hook run after `magit-insert-section's BODY. 989 Avoid using this hook and only ever do so if you know 990 what you are doing and are sure there is no other way.") 991 992 (defmacro magit-insert-section (&rest args) 993 "Insert a section at point. 994 995 Create a section object of type CLASS, storing VALUE in its 996 `value' slot, and insert the section at point. CLASS is a 997 subclass of `magit-section' or has the form `(eval FORM)', in 998 which case FORM is evaluated at runtime and should return a 999 subclass. In other places a sections class is oftern referred 1000 to as its \"type\". 1001 1002 Many commands behave differently depending on the class of the 1003 current section and sections of a certain class can have their 1004 own keymap, which is specified using the `keymap' class slot. 1005 The value of that slot should be a variable whose value is a 1006 keymap. 1007 1008 For historic reasons Magit and Forge in most cases use symbols 1009 as CLASS that don't actually identify a class and that lack the 1010 appropriate package prefix. This works due to some undocumented 1011 kludges, which are not available to other packages. 1012 1013 When optional HIDE is non-nil collapse the section body by 1014 default, i.e. when first creating the section, but not when 1015 refreshing the buffer. Else expand it by default. This can be 1016 overwritten using `magit-section-set-visibility-hook'. When a 1017 section is recreated during a refresh, then the visibility of 1018 predecessor is inherited and HIDE is ignored (but the hook is 1019 still honored). 1020 1021 BODY is any number of forms that actually insert the section's 1022 heading and body. Optional NAME, if specified, has to be a 1023 symbol, which is then bound to the object of the section being 1024 inserted. 1025 1026 Before BODY is evaluated the `start' of the section object is set 1027 to the value of `point' and after BODY was evaluated its `end' is 1028 set to the new value of `point'; BODY is responsible for moving 1029 `point' forward. 1030 1031 If it turns out inside BODY that the section is empty, then 1032 `magit-cancel-section' can be used to abort and remove all traces 1033 of the partially inserted section. This can happen when creating 1034 a section by washing Git's output and Git didn't actually output 1035 anything this time around. 1036 1037 \(fn [NAME] (CLASS &optional VALUE HIDE) &rest BODY)" 1038 (declare (indent defun) 1039 (debug ([&optional symbolp] 1040 (&or [("eval" form) &optional form form] 1041 [symbolp &optional form form]) 1042 body))) 1043 (let ((tp (cl-gensym "type")) 1044 (s* (and (symbolp (car args)) 1045 (pop args))) 1046 (s (cl-gensym "section"))) 1047 `(let* ((,tp ,(let ((type (nth 0 (car args)))) 1048 (if (eq (car-safe type) 'eval) 1049 (cadr type) 1050 `',type))) 1051 (,s (funcall (if (class-p ,tp) 1052 ,tp 1053 (or (cdr (assq ,tp magit--section-type-alist)) 1054 'magit-section)) 1055 :type 1056 (or (and (class-p ,tp) 1057 (car (rassq ,tp magit--section-type-alist))) 1058 ,tp) 1059 :value ,(nth 1 (car args)) 1060 :start (point-marker) 1061 :parent magit-insert-section--parent))) 1062 (oset ,s hidden 1063 (let ((value (run-hook-with-args-until-success 1064 'magit-section-set-visibility-hook ,s))) 1065 (if value 1066 (eq value 'hide) 1067 (let ((incarnation (and magit-insert-section--oldroot 1068 (magit-get-section 1069 (magit-section-ident ,s) 1070 magit-insert-section--oldroot)))) 1071 (if incarnation 1072 (oref incarnation hidden) 1073 (let ((value (magit-section-match-assoc 1074 ,s magit-section-initial-visibility-alist))) 1075 (if value 1076 (progn 1077 (when (functionp value) 1078 (setq value (funcall value ,s))) 1079 (eq value 'hide)) 1080 ,(nth 2 (car args))))))))) 1081 (let ((magit-insert-section--current ,s) 1082 (magit-insert-section--parent ,s) 1083 (magit-insert-section--oldroot 1084 (or magit-insert-section--oldroot 1085 (unless magit-insert-section--parent 1086 (prog1 magit-root-section 1087 (setq magit-root-section ,s)))))) 1088 (catch 'cancel-section 1089 ,@(if s* 1090 `((let ((,s* ,s)) 1091 ,@(cdr args))) 1092 (cdr args)) 1093 ;; `magit-insert-section-hook' should *not* be run with 1094 ;; `magit-run-section-hook' because it's a hook that runs 1095 ;; on section insertion, not a section inserting hook. 1096 (run-hooks 'magit-insert-section-hook) 1097 (magit-insert-child-count ,s) 1098 (set-marker-insertion-type (oref ,s start) t) 1099 (let* ((end (oset ,s end (point-marker))) 1100 (class-map (oref-default ,s keymap)) 1101 (magit-map (intern (format "magit-%s-section-map" 1102 (oref ,s type)))) 1103 (forge-map (intern (format "forge-%s-section-map" 1104 (oref ,s type)))) 1105 (map (or (and class-map (symbol-value class-map)) 1106 (and (boundp magit-map) (symbol-value magit-map)) 1107 (and (boundp forge-map) (symbol-value forge-map))))) 1108 (save-excursion 1109 (goto-char (oref ,s start)) 1110 (while (< (point) end) 1111 (let ((next (or (next-single-property-change 1112 (point) 'magit-section) 1113 end))) 1114 (unless (get-text-property (point) 'magit-section) 1115 (put-text-property (point) next 'magit-section ,s) 1116 (when map 1117 (put-text-property (point) next 'keymap map))) 1118 (goto-char next))))) 1119 (if (eq ,s magit-root-section) 1120 (let ((magit-section-cache-visibility nil)) 1121 (magit-section-show ,s)) 1122 (oset (oref ,s parent) children 1123 (nconc (oref (oref ,s parent) children) 1124 (list ,s))))) 1125 ,s)))) 1126 1127 (defun magit-cancel-section () 1128 "Cancel inserting the section that is currently being inserted. 1129 Remove all traces of that section." 1130 (when magit-insert-section--current 1131 (if (not (oref magit-insert-section--current parent)) 1132 (insert "(empty)\n") 1133 (delete-region (oref magit-insert-section--current start) 1134 (point)) 1135 (setq magit-insert-section--current nil) 1136 (throw 'cancel-section nil)))) 1137 1138 (defun magit-insert-heading (&rest args) 1139 "Insert the heading for the section currently being inserted. 1140 1141 This function should only be used inside `magit-insert-section'. 1142 1143 When called without any arguments, then just set the `content' 1144 slot of the object representing the section being inserted to 1145 a marker at `point'. The section should only contain a single 1146 line when this function is used like this. 1147 1148 When called with arguments ARGS, which have to be strings, or 1149 nil, then insert those strings at point. The section should not 1150 contain any text before this happens and afterwards it should 1151 again only contain a single line. If the `face' property is set 1152 anywhere inside any of these strings, then insert all of them 1153 unchanged. Otherwise use the `magit-section-heading' face for 1154 all inserted text. 1155 1156 The `content' property of the section object is the end of the 1157 heading (which lasts from `start' to `content') and the beginning 1158 of the the body (which lasts from `content' to `end'). If the 1159 value of `content' is nil, then the section has no heading and 1160 its body cannot be collapsed. If a section does have a heading, 1161 then its height must be exactly one line, including a trailing 1162 newline character. This isn't enforced, you are responsible for 1163 getting it right. The only exception is that this function does 1164 insert a newline character if necessary." 1165 (declare (indent defun)) 1166 (when args 1167 (let ((heading (apply #'concat args))) 1168 (insert (if (or (text-property-not-all 0 (length heading) 1169 'font-lock-face nil heading) 1170 (text-property-not-all 0 (length heading) 1171 'face nil heading)) 1172 heading 1173 (propertize heading 'font-lock-face 'magit-section-heading))))) 1174 (unless (bolp) 1175 (insert ?\n)) 1176 (when (fboundp 'magit-maybe-make-margin-overlay) 1177 (magit-maybe-make-margin-overlay)) 1178 (oset magit-insert-section--current content (point-marker))) 1179 1180 (defmacro magit-insert-section-body (&rest body) 1181 "Use BODY to insert the section body, once the section is expanded. 1182 If the section is expanded when it is created, then this is 1183 like `progn'. Otherwise BODY isn't evaluated until the section 1184 is explicitly expanded." 1185 (declare (indent 0)) 1186 (let ((f (cl-gensym)) 1187 (s (cl-gensym))) 1188 `(let ((,f (lambda () ,@body)) 1189 (,s magit-insert-section--current)) 1190 (if (oref ,s hidden) 1191 (oset ,s washer 1192 (lambda () 1193 (funcall ,f) 1194 (magit-section-maybe-remove-visibility-indicator ,s))) 1195 (funcall ,f))))) 1196 1197 (defun magit-insert-headers (hook) 1198 (let* ((header-sections nil) 1199 (magit-insert-section-hook 1200 (cons (lambda () 1201 (push magit-insert-section--current 1202 header-sections)) 1203 (if (listp magit-insert-section-hook) 1204 magit-insert-section-hook 1205 (list magit-insert-section-hook))))) 1206 (magit-run-section-hook hook) 1207 (when header-sections 1208 (insert "\n") 1209 ;; Make the first header into the parent of the rest. 1210 (when (cdr header-sections) 1211 (cl-callf nreverse header-sections) 1212 (let* ((1st-header (pop header-sections)) 1213 (header-parent (oref 1st-header parent))) 1214 (oset header-parent children (list 1st-header)) 1215 (oset 1st-header children header-sections) 1216 (oset 1st-header content (oref (car header-sections) start)) 1217 (oset 1st-header end (oref (car (last header-sections)) end)) 1218 (dolist (sub-header header-sections) 1219 (oset sub-header parent 1st-header))))))) 1220 1221 (defun magit-insert-child-count (section) 1222 "Modify SECTION's heading to contain number of child sections. 1223 1224 If `magit-section-show-child-count' is non-nil and the SECTION 1225 has children and its heading ends with \":\", then replace that 1226 with \" (N)\", where N is the number of child sections. 1227 1228 This function is called by `magit-insert-section' after that has 1229 evaluated its BODY. Admittedly that's a bit of a hack." 1230 ;; This has to be fast, not pretty! 1231 (let (content count) 1232 (when (and magit-section-show-child-count 1233 (setq count (length (oref section children))) 1234 (> count 0) 1235 (setq content (oref section content)) 1236 (eq (char-before (1- content)) ?:)) 1237 (save-excursion 1238 (goto-char (- content 2)) 1239 (insert (format " (%s)" count)) 1240 (delete-char 1))))) 1241 1242 ;;; Highlight 1243 1244 (defvar-local magit-section-pre-command-section nil) 1245 (defvar-local magit-section-highlight-overlays nil) 1246 (defvar-local magit-section-highlighted-sections nil) 1247 (defvar-local magit-section-unhighlight-sections nil) 1248 1249 (defun magit-section-pre-command-hook () 1250 (setq magit-section-pre-command-section (magit-current-section))) 1251 1252 (defun magit-section-deactivate-mark () 1253 (magit-section-update-highlight t)) 1254 1255 (defun magit-section-update-highlight (&optional force) 1256 (let ((section (magit-current-section))) 1257 (when (or force (not (eq magit-section-pre-command-section section))) 1258 (let ((inhibit-read-only t) 1259 (deactivate-mark nil) 1260 (selection (magit-region-sections))) 1261 (mapc #'delete-overlay magit-section-highlight-overlays) 1262 (setq magit-section-highlight-overlays nil) 1263 (setq magit-section-unhighlight-sections 1264 magit-section-highlighted-sections) 1265 (setq magit-section-highlighted-sections nil) 1266 (unless (eq section magit-root-section) 1267 (run-hook-with-args-until-success 1268 'magit-section-highlight-hook section selection)) 1269 (dolist (s magit-section-unhighlight-sections) 1270 (run-hook-with-args-until-success 1271 'magit-section-unhighlight-hook s selection)) 1272 (restore-buffer-modified-p nil))) 1273 (magit-section-maybe-paint-visibility-ellipses))) 1274 1275 (defun magit-section-highlight (section selection) 1276 "Highlight SECTION and if non-nil all sections in SELECTION. 1277 This function works for any section but produces undesirable 1278 effects for diff related sections, which by default are 1279 highlighted using `magit-diff-highlight'. Return t." 1280 (when-let ((face (oref section heading-highlight-face))) 1281 (dolist (section (or selection (list section))) 1282 (magit-section-make-overlay 1283 (oref section start) 1284 (or (oref section content) 1285 (oref section end)) 1286 face))) 1287 (cond (selection 1288 (magit-section-make-overlay (oref (car selection) start) 1289 (oref (car (last selection)) end) 1290 'magit-section-highlight) 1291 (magit-section-highlight-selection nil selection)) 1292 (t 1293 (magit-section-make-overlay (oref section start) 1294 (oref section end) 1295 'magit-section-highlight))) 1296 t) 1297 1298 (defun magit-section-highlight-selection (_ selection) 1299 "Highlight the section-selection region. 1300 If SELECTION is non-nil, then it is a list of sections selected by 1301 the region. The headings of these sections are then highlighted. 1302 1303 This is a fallback for people who don't want to highlight the 1304 current section and therefore removed `magit-section-highlight' 1305 from `magit-section-highlight-hook'. 1306 1307 This function is necessary to ensure that a representation of 1308 such a region is visible. If neither of these functions were 1309 part of the hook variable, then such a region would be 1310 invisible." 1311 (when (and selection 1312 (not (and (eq this-command 'mouse-drag-region)))) 1313 (dolist (section selection) 1314 (magit-section-make-overlay (oref section start) 1315 (or (oref section content) 1316 (oref section end)) 1317 'magit-section-heading-selection)) 1318 t)) 1319 1320 (defun magit-section-make-overlay (start end face) 1321 ;; Yes, this doesn't belong here. But the alternative of 1322 ;; spreading this hack across the code base is even worse. 1323 (when (and magit-keep-region-overlay 1324 (memq face '(magit-section-heading-selection 1325 magit-diff-file-heading-selection 1326 magit-diff-hunk-heading-selection))) 1327 (setq face (list :foreground (face-foreground face)))) 1328 (let ((ov (make-overlay start end nil t))) 1329 (overlay-put ov 'font-lock-face face) 1330 (overlay-put ov 'evaporate t) 1331 (push ov magit-section-highlight-overlays) 1332 ov)) 1333 1334 (defun magit-section-goto-successor (section line char arg) 1335 (let ((ident (magit-section-ident section))) 1336 (--if-let (magit-get-section ident) 1337 (let ((start (oref it start))) 1338 (goto-char start) 1339 (unless (eq it magit-root-section) 1340 (ignore-errors 1341 (forward-line line) 1342 (forward-char char)) 1343 (unless (eq (magit-current-section) it) 1344 (goto-char start)))) 1345 (or (run-hook-with-args-until-success 1346 'magit-section-goto-successor-hook section arg) 1347 (goto-char (--if-let (magit-section-goto-successor-1 section) 1348 (if (eq (oref it type) 'button) 1349 (point-min) 1350 (oref it start)) 1351 (point-min))))))) 1352 1353 (defun magit-section-goto-successor-1 (section) 1354 (or (--when-let (pcase (oref section type) 1355 (`staged 'unstaged) 1356 (`unstaged 'staged) 1357 (`unpushed 'unpulled) 1358 (`unpulled 'unpushed)) 1359 (magit-get-section `((,it) (status)))) 1360 (--when-let (car (magit-section-siblings section 'next)) 1361 (magit-get-section (magit-section-ident it))) 1362 (--when-let (car (magit-section-siblings section 'prev)) 1363 (magit-get-section (magit-section-ident it))) 1364 (--when-let (oref section parent) 1365 (or (magit-get-section (magit-section-ident it)) 1366 (magit-section-goto-successor-1 it))))) 1367 1368 ;;; Region 1369 1370 (defvar-local magit-section--region-overlays nil) 1371 1372 (defun magit-section--delete-region-overlays () 1373 (mapc #'delete-overlay magit-section--region-overlays) 1374 (setq magit-section--region-overlays nil)) 1375 1376 (defun magit-section--highlight-region (start end window rol) 1377 (magit-section--delete-region-overlays) 1378 (if (and (not magit-keep-region-overlay) 1379 (or (magit-region-sections) 1380 (run-hook-with-args-until-success 'magit-region-highlight-hook 1381 (magit-current-section))) 1382 (not (= (line-number-at-pos start) 1383 (line-number-at-pos end))) 1384 ;; (not (eq (car-safe last-command-event) 'mouse-movement)) 1385 ) 1386 (funcall (default-value 'redisplay-unhighlight-region-function) rol) 1387 (funcall (default-value 'redisplay-highlight-region-function) 1388 start end window rol))) 1389 1390 (defun magit-section--unhighlight-region (rol) 1391 (magit-section--delete-region-overlays) 1392 (funcall (default-value 'redisplay-unhighlight-region-function) rol)) 1393 1394 ;;; Visibility 1395 1396 (defvar-local magit-section-visibility-cache nil) 1397 (put 'magit-section-visibility-cache 'permanent-local t) 1398 1399 (defun magit-section-cached-visibility (section) 1400 "Set SECTION's visibility to the cached value." 1401 (cdr (assoc (magit-section-ident section) 1402 magit-section-visibility-cache))) 1403 1404 (cl-defun magit-section-cache-visibility 1405 (&optional (section magit-insert-section--current)) 1406 ;; Emacs 25's `alist-get' lacks TESTFN. 1407 (let* ((id (magit-section-ident section)) 1408 (elt (assoc id magit-section-visibility-cache)) 1409 (val (if (oref section hidden) 'hide 'show))) 1410 (if elt 1411 (setcdr elt val) 1412 (push (cons id val) magit-section-visibility-cache)))) 1413 1414 (cl-defun magit-section-maybe-cache-visibility 1415 (&optional (section magit-insert-section--current)) 1416 (when (or (eq magit-section-cache-visibility t) 1417 (memq (oref section type) 1418 magit-section-cache-visibility)) 1419 (magit-section-cache-visibility section))) 1420 1421 (defun magit-section-maybe-update-visibility-indicator (section) 1422 (when magit-section-visibility-indicator 1423 (let ((beg (oref section start)) 1424 (cnt (oref section content)) 1425 (end (oref section end))) 1426 (when (and cnt (or (not (= cnt end)) (oref section washer))) 1427 (let ((eoh (save-excursion 1428 (goto-char beg) 1429 (line-end-position)))) 1430 (cond 1431 ((symbolp (car-safe magit-section-visibility-indicator)) 1432 ;; It would make more sense to put the overlay only on the 1433 ;; location we actually don't put it on, but then inserting 1434 ;; before that location (while taking care not to mess with 1435 ;; the overlay) would cause the fringe bitmap to disappear 1436 ;; (but not other effects of the overlay). 1437 (let ((ov (magit--overlay-at (1+ beg) 'magit-vis-indicator 'fringe))) 1438 (unless ov 1439 (setq ov (make-overlay (1+ beg) eoh)) 1440 (overlay-put ov 'evaporate t) 1441 (overlay-put ov 'magit-vis-indicator 'fringe)) 1442 (overlay-put 1443 ov 'before-string 1444 (propertize "fringe" 'display 1445 (list 'left-fringe 1446 (if (oref section hidden) 1447 (car magit-section-visibility-indicator) 1448 (cdr magit-section-visibility-indicator)) 1449 'fringe))))) 1450 ((stringp (car-safe magit-section-visibility-indicator)) 1451 (let ((ov (magit--overlay-at (1- eoh) 'magit-vis-indicator 'eoh))) 1452 (cond ((oref section hidden) 1453 (unless ov 1454 (setq ov (make-overlay (1- eoh) eoh)) 1455 (overlay-put ov 'evaporate t) 1456 (overlay-put ov 'magit-vis-indicator 'eoh)) 1457 (overlay-put ov 'after-string 1458 (car magit-section-visibility-indicator))) 1459 (ov 1460 (delete-overlay ov))))))))))) 1461 1462 (defvar-local magit--ellipses-sections nil) 1463 1464 (defun magit-section-maybe-paint-visibility-ellipses () 1465 ;; This is needed because we hide the body instead of "the body 1466 ;; except the final newline and additionally the newline before 1467 ;; the body"; otherwise we could use `buffer-invisibility-spec'. 1468 (when (stringp (car-safe magit-section-visibility-indicator)) 1469 (let* ((sections (append magit--ellipses-sections 1470 (setq magit--ellipses-sections 1471 (or (magit-region-sections) 1472 (list (magit-current-section)))))) 1473 (beg (--map (oref it start) sections)) 1474 (end (--map (oref it end) sections))) 1475 (when (region-active-p) 1476 ;; This ensures that the region face is removed from ellipses 1477 ;; when the region becomes inactive, but fails to ensure that 1478 ;; all ellipses within the active region use the region face, 1479 ;; because the respective overlay has not yet been updated at 1480 ;; this time. The magit-selection face is always applied. 1481 (push (region-beginning) beg) 1482 (push (region-end) end)) 1483 (setq beg (apply #'min beg)) 1484 (setq end (apply #'max end)) 1485 (dolist (ov (overlays-in beg end)) 1486 (when (eq (overlay-get ov 'magit-vis-indicator) 'eoh) 1487 (overlay-put 1488 ov 'after-string 1489 (propertize 1490 (car magit-section-visibility-indicator) 'font-lock-face 1491 (let ((pos (overlay-start ov))) 1492 (delq nil (nconc (--map (overlay-get it 'font-lock-face) 1493 (overlays-at pos)) 1494 (list (get-char-property 1495 pos 'font-lock-face)))))))))))) 1496 1497 (defun magit-section-maybe-remove-visibility-indicator (section) 1498 (when (and magit-section-visibility-indicator 1499 (= (oref section content) 1500 (oref section end))) 1501 (dolist (o (overlays-in (oref section start) 1502 (save-excursion 1503 (goto-char (oref section start)) 1504 (1+ (line-end-position))))) 1505 (when (overlay-get o 'magit-vis-indicator) 1506 (delete-overlay o))))) 1507 1508 (defvar-local magit-section--opened-sections nil) 1509 1510 (defun magit-section--open-temporarily (beg end) 1511 (save-excursion 1512 (goto-char beg) 1513 (let ((section (magit-current-section))) 1514 (while section 1515 (let ((content (oref section content))) 1516 (if (and (magit-section-invisible-p section) 1517 (<= (or content (oref section start)) 1518 beg 1519 (oref section end))) 1520 (progn 1521 (when content 1522 (magit-section-show section) 1523 (push section magit-section--opened-sections)) 1524 (setq section (oref section parent))) 1525 (setq section nil)))))) 1526 (or (eq search-invisible t) 1527 (not (isearch-range-invisible beg end)))) 1528 1529 (defun isearch-clean-overlays@magit-mode (fn) 1530 (if (derived-mode-p 'magit-mode) 1531 (let ((pos (point))) 1532 (dolist (section magit-section--opened-sections) 1533 (unless (<= (oref section content) pos (oref section end)) 1534 (magit-section-hide section))) 1535 (setq magit-section--opened-sections nil)) 1536 (funcall fn))) 1537 1538 (advice-add 'isearch-clean-overlays :around 1539 'isearch-clean-overlays@magit-mode) 1540 1541 ;;; Utilities 1542 1543 (cl-defun magit-section-selected-p (section &optional (selection nil sselection)) 1544 (and (not (eq section magit-root-section)) 1545 (or (eq section (magit-current-section)) 1546 (memq section (if sselection 1547 selection 1548 (setq selection (magit-region-sections)))) 1549 (--when-let (oref section parent) 1550 (magit-section-selected-p it selection))))) 1551 1552 (defun magit-section-parent-value (section) 1553 (when-let ((parent (oref section parent))) 1554 (oref parent value))) 1555 1556 (defun magit-section-siblings (section &optional direction) 1557 "Return a list of the sibling sections of SECTION. 1558 1559 If optional DIRECTION is `prev', then return siblings that come 1560 before SECTION. If it is `next', then return siblings that come 1561 after SECTION. For all other values, return all siblings 1562 excluding SECTION itself." 1563 (when-let ((parent (oref section parent))) 1564 (let ((siblings (oref parent children))) 1565 (pcase direction 1566 (`prev (cdr (member section (reverse siblings)))) 1567 (`next (cdr (member section siblings))) 1568 (_ (remq section siblings)))))) 1569 1570 (defun magit-region-values (&optional condition multiple) 1571 "Return a list of the values of the selected sections. 1572 1573 Return the values that themselves would be returned by 1574 `magit-region-sections' (which see)." 1575 (--map (oref it value) 1576 (magit-region-sections condition multiple))) 1577 1578 (defun magit-region-sections (&optional condition multiple) 1579 "Return a list of the selected sections. 1580 1581 When the region is active and constitutes a valid section 1582 selection, then return a list of all selected sections. This is 1583 the case when the region begins in the heading of a section and 1584 ends in the heading of the same section or in that of a sibling 1585 section. If optional MULTIPLE is non-nil, then the region cannot 1586 begin and end in the same section. 1587 1588 When the selection is not valid, then return nil. In this case, 1589 most commands that can act on the selected sections will instead 1590 act on the section at point. 1591 1592 When the region looks like it would in any other buffer then 1593 the selection is invalid. When the selection is valid then the 1594 region uses the `magit-section-highlight' face. This does not 1595 apply to diffs where things get a bit more complicated, but even 1596 here if the region looks like it usually does, then that's not 1597 a valid selection as far as this function is concerned. 1598 1599 If optional CONDITION is non-nil, then the selection not only 1600 has to be valid; all selected sections additionally have to match 1601 CONDITION, or nil is returned. See `magit-section-match' for the 1602 forms CONDITION can take." 1603 (when (region-active-p) 1604 (let* ((rbeg (region-beginning)) 1605 (rend (region-end)) 1606 (sbeg (get-text-property rbeg 'magit-section)) 1607 (send (get-text-property rend 'magit-section))) 1608 (when (and send 1609 (not (eq send magit-root-section)) 1610 (not (and multiple (eq send sbeg)))) 1611 (let ((siblings (cons sbeg (magit-section-siblings sbeg 'next))) 1612 sections) 1613 (when (and (memq send siblings) 1614 (magit-section-position-in-heading-p sbeg rbeg) 1615 (magit-section-position-in-heading-p send rend)) 1616 (while siblings 1617 (push (car siblings) sections) 1618 (when (eq (pop siblings) send) 1619 (setq siblings nil))) 1620 (setq sections (nreverse sections)) 1621 (when (or (not condition) 1622 (--all-p (magit-section-match condition it) sections)) 1623 sections))))))) 1624 1625 (defun magit-section-position-in-heading-p (&optional section pos) 1626 "Return t if POSITION is inside the heading of SECTION. 1627 POSITION defaults to point and SECTION defaults to the 1628 current section." 1629 (unless section 1630 (setq section (magit-current-section))) 1631 (unless pos 1632 (setq pos (point))) 1633 (and section 1634 (>= pos (oref section start)) 1635 (< pos (or (oref section content) 1636 (oref section end))) 1637 t)) 1638 1639 (defun magit-section-internal-region-p (&optional section) 1640 "Return t if the region is active and inside SECTION's body. 1641 If optional SECTION is nil, use the current section." 1642 (and (region-active-p) 1643 (or section (setq section (magit-current-section))) 1644 (let ((beg (get-text-property (region-beginning) 'magit-section))) 1645 (and (eq beg (get-text-property (region-end) 'magit-section)) 1646 (eq beg section))) 1647 (not (or (magit-section-position-in-heading-p section (region-beginning)) 1648 (magit-section-position-in-heading-p section (region-end)))) 1649 t)) 1650 1651 (defun magit-section--backward-protected () 1652 "Move to the beginning of the current or the previous visible section. 1653 Same as `magit-section-backward' but for non-interactive use. 1654 Suppress `magit-section-movement-hook', and return a boolean to 1655 indicate whether a section was found, instead of raising an error 1656 if not." 1657 (condition-case nil 1658 (let ((magit-section-movement-hook nil)) 1659 (magit-section-backward) 1660 t) 1661 (user-error nil))) 1662 1663 (defun magit-section--backward-find (predicate) 1664 "Move to the first previous section satisfying PREDICATE. 1665 PREDICATE does not take any parameter and should not move 1666 point." 1667 (let (found) 1668 (while (and (setq found (magit-section--backward-protected)) 1669 (not (funcall predicate)))) 1670 found)) 1671 1672 (defun magit-wash-sequence (function) 1673 "Repeatedly call FUNCTION until it returns nil or eob is reached. 1674 FUNCTION has to move point forward or return nil." 1675 (while (and (not (eobp)) (funcall function)))) 1676 1677 (defun magit-add-section-hook (hook function &optional at append local) 1678 "Add to the value of section hook HOOK the function FUNCTION. 1679 1680 Add FUNCTION at the beginning of the hook list unless optional 1681 APPEND is non-nil, in which case FUNCTION is added at the end. 1682 If FUNCTION already is a member, then move it to the new location. 1683 1684 If optional AT is non-nil and a member of the hook list, then 1685 add FUNCTION next to that instead. Add before or after AT, or 1686 replace AT with FUNCTION depending on APPEND. If APPEND is the 1687 symbol `replace', then replace AT with FUNCTION. For any other 1688 non-nil value place FUNCTION right after AT. If nil, then place 1689 FUNCTION right before AT. If FUNCTION already is a member of the 1690 list but AT is not, then leave FUNCTION where ever it already is. 1691 1692 If optional LOCAL is non-nil, then modify the hook's buffer-local 1693 value rather than its global value. This makes the hook local by 1694 copying the default value. That copy is then modified. 1695 1696 HOOK should be a symbol. If HOOK is void, it is first set to nil. 1697 HOOK's value must not be a single hook function. FUNCTION should 1698 be a function that takes no arguments and inserts one or multiple 1699 sections at point, moving point forward. FUNCTION may choose not 1700 to insert its section(s), when doing so would not make sense. It 1701 should not be abused for other side-effects. To remove FUNCTION 1702 again use `remove-hook'." 1703 (unless (boundp hook) 1704 (error "Cannot add function to undefined hook variable %s" hook)) 1705 (unless (default-boundp hook) 1706 (set-default hook nil)) 1707 (let ((value (if local 1708 (if (local-variable-p hook) 1709 (symbol-value hook) 1710 (unless (local-variable-if-set-p hook) 1711 (make-local-variable hook)) 1712 (copy-sequence (default-value hook))) 1713 (default-value hook)))) 1714 (if at 1715 (when (setq at (member at value)) 1716 (setq value (delq function value)) 1717 (cond ((eq append 'replace) 1718 (setcar at function)) 1719 (append 1720 (push function (cdr at))) 1721 (t 1722 (push (car at) (cdr at)) 1723 (setcar at function)))) 1724 (setq value (delq function value))) 1725 (unless (member function value) 1726 (setq value (if append 1727 (append value (list function)) 1728 (cons function value)))) 1729 (when (eq append 'replace) 1730 (setq value (delq at value))) 1731 (if local 1732 (set hook value) 1733 (set-default hook value)))) 1734 1735 (defvar-local magit-disabled-section-inserters nil) 1736 1737 (defun magit-disable-section-inserter (fn) 1738 "Disable the section inserter FN in the current repository. 1739 It is only intended for use in \".dir-locals.el\" and 1740 \".dir-locals-2.el\". Also see info node `(magit)Per-Repository 1741 Configuration'." 1742 (cl-pushnew fn magit-disabled-section-inserters)) 1743 1744 (put 'magit-disable-section-inserter 'safe-local-eval-function t) 1745 1746 (defun magit-run-section-hook (hook &rest args) 1747 "Run HOOK with ARGS, warning about invalid entries." 1748 (let ((entries (symbol-value hook))) 1749 (unless (listp entries) 1750 (setq entries (list entries))) 1751 (--when-let (-remove #'functionp entries) 1752 (message "`%s' contains entries that are no longer valid. 1753 %s\nUsing standard value instead. Please re-configure hook variable." 1754 hook 1755 (mapconcat (lambda (sym) (format " `%s'" sym)) it "\n")) 1756 (sit-for 5) 1757 (setq entries (eval (car (get hook 'standard-value))))) 1758 (dolist (entry entries) 1759 (let ((magit--current-section-hook (cons (list hook entry) 1760 magit--current-section-hook))) 1761 (unless (memq entry magit-disabled-section-inserters) 1762 (if (bound-and-true-p magit-refresh-verbose) 1763 (let ((time (benchmark-elapse (apply entry args)))) 1764 (message " %-50s %s %s" entry time 1765 (cond ((> time 0.03) "!!") 1766 ((> time 0.01) "!") 1767 (t "")))) 1768 (apply entry args))))))) 1769 1770 (cl-defun magit--overlay-at (pos prop &optional (val nil sval) testfn) 1771 (cl-find-if (lambda (o) 1772 (let ((p (overlay-properties o))) 1773 (and (plist-member p prop) 1774 (or (not sval) 1775 (funcall (or testfn #'eql) 1776 (plist-get p prop) 1777 val))))) 1778 (overlays-at pos t))) 1779 1780 ;;; Bitmaps 1781 1782 (when (fboundp 'define-fringe-bitmap) 1783 (define-fringe-bitmap 'magit-fringe-bitmap+ 1784 [#b00000000 1785 #b00011000 1786 #b00011000 1787 #b01111110 1788 #b01111110 1789 #b00011000 1790 #b00011000 1791 #b00000000]) 1792 (define-fringe-bitmap 'magit-fringe-bitmap- 1793 [#b00000000 1794 #b00000000 1795 #b00000000 1796 #b01111110 1797 #b01111110 1798 #b00000000 1799 #b00000000 1800 #b00000000]) 1801 1802 (define-fringe-bitmap 'magit-fringe-bitmap> 1803 [#b01100000 1804 #b00110000 1805 #b00011000 1806 #b00001100 1807 #b00011000 1808 #b00110000 1809 #b01100000 1810 #b00000000]) 1811 (define-fringe-bitmap 'magit-fringe-bitmapv 1812 [#b00000000 1813 #b10000010 1814 #b11000110 1815 #b01101100 1816 #b00111000 1817 #b00010000 1818 #b00000000 1819 #b00000000]) 1820 1821 (define-fringe-bitmap 'magit-fringe-bitmap-bold> 1822 [#b11100000 1823 #b01110000 1824 #b00111000 1825 #b00011100 1826 #b00011100 1827 #b00111000 1828 #b01110000 1829 #b11100000]) 1830 (define-fringe-bitmap 'magit-fringe-bitmap-boldv 1831 [#b10000001 1832 #b11000011 1833 #b11100111 1834 #b01111110 1835 #b00111100 1836 #b00011000 1837 #b00000000 1838 #b00000000]) 1839 ) 1840 1841 ;;; _ 1842 (provide 'magit-section) 1843 ;;; magit-section.el ends here