magit-section.el (104545B)
1 ;;; magit-section.el --- Sections for read-only buffers -*- lexical-binding:t; coding:utf-8 -*- 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 ;; Homepage: https://github.com/magit/magit 9 ;; Keywords: tools 10 11 ;; Package-Version: 4.0.0 12 ;; Package-Requires: ( 13 ;; (emacs "26.1") 14 ;; (compat "30.0.0.0") 15 ;; (dash "2.19.1") 16 ;; (seq "2.24")) 17 18 ;; SPDX-License-Identifier: GPL-3.0-or-later 19 20 ;; Magit is free software: you can redistribute it and/or modify 21 ;; it under the terms of the GNU General Public License as published 22 ;; by the Free Software Foundation, either version 3 of the License, 23 ;; or (at your option) any later version. 24 ;; 25 ;; Magit is distributed in the hope that it will be useful, 26 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 27 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 ;; GNU General Public License for more details. 29 ;; 30 ;; You should have received a copy of the GNU General Public License 31 ;; along with Magit. If not, see <https://www.gnu.org/licenses/>. 32 33 ;; You should have received a copy of the AUTHORS.md file, which 34 ;; lists all contributors. If not, see https://magit.vc/authors. 35 36 ;;; Commentary: 37 38 ;; This package implements the main user interface of Magit — the 39 ;; collapsible sections that make up its buffers. This package used 40 ;; to be distributed as part of Magit but now it can also be used by 41 ;; other packages that have nothing to do with Magit or Git. 42 43 ;;; Code: 44 45 (require 'cl-lib) 46 (require 'compat) 47 (require 'dash) 48 (require 'eieio) 49 (require 'subr-x) 50 51 ;; For older Emacs releases we depend on an updated `seq' release from GNU 52 ;; ELPA, for `seq-keep'. Unfortunately something else may require `seq' 53 ;; before `package' had a chance to put this version on the `load-path'. 54 (when (and (featurep 'seq) 55 (not (fboundp 'seq-keep))) 56 (unload-feature 'seq 'force)) 57 (require 'seq) 58 ;; Furthermore, by default `package' just silently refuses to upgrade. 59 (defconst magit--core-upgrade-instructions "\ 60 Magit requires `%s' >= %s, 61 but due to bad defaults, Emacs' package manager, refuses to 62 upgrade this and other built-in packages to higher releases 63 from GNU Elpa. 64 65 To fix this, you have to add this to your init file: 66 67 (setq package-install-upgrade-built-in t) 68 69 Then evaluate that expression by placing the cursor after it 70 and typing \\[eval-last-sexp]. 71 72 Once you have done that, you have to explicitly upgrade `%s': 73 74 \\[package-install] %s \\`RET' 75 76 Then you also must make sure the updated version is loaded, 77 by evaluating this form: 78 79 (progn (unload-feature \\='%s t) (require \\='%s)) 80 81 If this does not work, then try uninstalling Magit and all of its 82 dependencies. After that exit and restart Emacs, and only then 83 reinstalling Magit. 84 85 If you don't use the `package' package manager but still get 86 this warning, then your chosen package manager likely has a 87 similar defect.") 88 (unless (fboundp 'seq-keep) 89 (display-warning 'magit (substitute-command-keys 90 (format magit--core-upgrade-instructions 91 'seq "2.24" 'seq 'seq 'seq 'seq)) 92 :emergency)) 93 94 (require 'cursor-sensor) 95 (require 'format-spec) 96 97 (eval-when-compile (require 'benchmark)) 98 99 ;; For `magit-section-get-relative-position' 100 (declare-function magit-hunk-section-p "magit-diff" (section) t) 101 102 ;;; Hooks 103 104 (defvar magit-section-movement-hook nil 105 "Hook run by `magit-section-goto'. 106 That function in turn is used by all section movement commands.") 107 108 (defvar magit-section-highlight-hook 109 '(magit-section-highlight 110 magit-section-highlight-selection) 111 "Functions used to highlight the current section. 112 Each function is run with the current section as only argument 113 until one of them returns non-nil.") 114 115 (defvar magit-section-unhighlight-hook nil 116 "Functions used to unhighlight the previously current section. 117 Each function is run with the current section as only argument 118 until one of them returns non-nil. Most sections are properly 119 unhighlighted without requiring a specialized unhighlighter, 120 diff-related sections being the only exception.") 121 122 (defvar magit-section-set-visibility-hook 123 '(magit-section-cached-visibility) 124 "Hook used to set the initial visibility of a section. 125 Stop at the first function that returns non-nil. The returned 126 value should be `show', `hide' or nil. If no function returns 127 non-nil, determine the visibility as usual, i.e., use the 128 hardcoded section specific default (see `magit-insert-section').") 129 130 ;;; Options 131 132 (defgroup magit-section nil 133 "Expandable sections." 134 :link '(info-link "(magit)Sections") 135 :group 'extensions) 136 137 (defcustom magit-section-show-child-count t 138 "Whether to append the number of children to section headings. 139 This only applies to sections for which doing so makes sense." 140 :package-version '(magit-section . "2.1.0") 141 :group 'magit-section 142 :type 'boolean) 143 144 (defcustom magit-section-cache-visibility t 145 "Whether to cache visibility of sections. 146 147 Sections always retain their visibility state when they are being 148 recreated during a refresh. But if a section disappears and then 149 later reappears again, then this option controls whether this is 150 the case. 151 152 If t, then cache the visibility of all sections. If a list of 153 section types, then only do so for matching sections. If nil, 154 then don't do so for any sections." 155 :package-version '(magit-section . "2.12.0") 156 :group 'magit-section 157 :type '(choice (const :tag "Don't cache visibility" nil) 158 (const :tag "Cache visibility of all sections" t) 159 (repeat :tag "Cache visibility for section types" symbol))) 160 161 (defcustom magit-section-initial-visibility-alist 162 '((stashes . hide)) 163 "Alist controlling the initial visibility of sections. 164 165 Each element maps a section type or lineage to the initial 166 visibility state for such sections. The state has to be one of 167 `show' or `hide', or a function that returns one of these symbols. 168 A function is called with the section as the only argument. 169 170 Use the command `magit-describe-section' to determine a section's 171 lineage or type. The vector in the output is the section lineage 172 and the type is the first element of that vector. Wildcards can 173 be used, see `magit-section-match'. 174 175 Currently this option is only used to override hardcoded defaults, 176 but in the future it will also be used set the defaults. 177 178 An entry whose key is `magit-status-initial-section' specifies 179 the visibility of the section `magit-status-goto-initial-section' 180 jumps to. This does not only override defaults, but also other 181 entries of this alist." 182 :package-version '(magit-section . "2.12.0") 183 :group 'magit-section 184 :type '(alist :key-type (sexp :tag "Section type/lineage") 185 :value-type (choice (const hide) 186 (const show) 187 function))) 188 189 (defcustom magit-section-visibility-indicator 190 (if (window-system) 191 '(magit-fringe-bitmap> . magit-fringe-bitmapv) 192 (cons (if (char-displayable-p ?…) "…" "...") 193 t)) 194 "Whether and how to indicate that a section can be expanded/collapsed. 195 196 If nil, then don't show any indicators. 197 Otherwise the value has to have one of these two forms: 198 199 \(EXPANDABLE-BITMAP . COLLAPSIBLE-BITMAP) 200 201 Both values have to be variables whose values are fringe 202 bitmaps. In this case every section that can be expanded or 203 collapsed gets an indicator in the left fringe. 204 205 To provide extra padding around the indicator, set 206 `left-fringe-width' in `magit-mode-hook'. 207 208 \(STRING . BOOLEAN) 209 210 In this case STRING (usually an ellipsis) is shown at the end 211 of the heading of every collapsed section. Expanded sections 212 get no indicator. The cdr controls whether the appearance of 213 these ellipsis take section highlighting into account. Doing 214 so might potentially have an impact on performance, while not 215 doing so is kinda ugly." 216 :package-version '(magit-section . "3.0.0") 217 :group 'magit-section 218 :type '(choice (const :tag "No indicators" nil) 219 (cons :tag "Use +- fringe indicators" 220 (const magit-fringe-bitmap+) 221 (const magit-fringe-bitmap-)) 222 (cons :tag "Use >v fringe indicators" 223 (const magit-fringe-bitmap>) 224 (const magit-fringe-bitmapv)) 225 (cons :tag "Use bold >v fringe indicators)" 226 (const magit-fringe-bitmap-bold>) 227 (const magit-fringe-bitmap-boldv)) 228 (cons :tag "Use custom fringe indicators" 229 (variable :tag "Expandable bitmap variable") 230 (variable :tag "Collapsible bitmap variable")) 231 (cons :tag "Use ellipses at end of headings" 232 (string :tag "Ellipsis" "…") 233 (choice :tag "Use face kludge" 234 (const :tag "Yes (potentially slow)" t) 235 (const :tag "No (kinda ugly)" nil))))) 236 237 (define-obsolete-variable-alias 'magit-keep-region-overlay 238 'magit-section-keep-region-overlay "Magit-Section 4.0.0") 239 240 (defcustom magit-section-keep-region-overlay nil 241 "Whether to keep the region overlay when there is a valid selection. 242 243 By default Magit removes the regular region overlay if, and only 244 if, that region constitutes a valid selection as understood by 245 Magit commands. Otherwise it does not remove that overlay, and 246 the region looks like it would in other buffers. 247 248 There are two types of such valid selections: hunk-internal 249 regions and regions that select two or more sibling sections. 250 In such cases Magit removes the region overlay and instead 251 highlights a slightly larger range. All text (for hunk-internal 252 regions) or the headings of all sections (for sibling selections) 253 that are inside that range (not just inside the region) are acted 254 on by commands such as the staging command. This buffer range 255 begins at the beginning of the line on which the region begins 256 and ends at the end of the line on which the region ends. 257 258 Because Magit acts on this larger range and not the region, it is 259 actually quite important to visualize that larger range. If we 260 don't do that, then one might think that these commands act on 261 the region instead. If you want to *also* visualize the region, 262 then set this option to t. But please note that when the region 263 does *not* constitute a valid selection, then the region is 264 *always* visualized as usual, and that it is usually under such 265 circumstances that you want to use a non-magit command to act on 266 the region. 267 268 Besides keeping the region overlay, setting this option to t also 269 causes all face properties, except for `:foreground', to be 270 ignored for the faces used to highlight headings of selected 271 sections. This avoids the worst conflicts that result from 272 displaying the region and the selection overlays at the same 273 time. We are not interested in dealing with other conflicts. 274 In fact we *already* provide a way to avoid all of these 275 conflicts: *not* changing the value of this option. 276 277 It should be clear by now that we consider it a mistake to set 278 this to display the region when the Magit selection is also 279 visualized, but since it has been requested a few times and 280 because it doesn't cost much to offer this option we do so. 281 However that might change. If the existence of this option 282 starts complicating other things, then it will be removed." 283 :package-version '(magit-section . "2.3.0") 284 :group 'magit-section 285 :type 'boolean) 286 287 (defcustom magit-section-disable-line-numbers t 288 "In Magit buffers, whether to disable modes that display line numbers. 289 290 Some users who turn on `global-display-line-numbers-mode' (or 291 `global-nlinum-mode' or `global-linum-mode') expect line numbers 292 to be displayed everywhere except in Magit buffers. Other users 293 do not expect Magit buffers to be treated differently. At least 294 in theory users in the first group should not use the global mode, 295 but that ship has sailed, thus this option." 296 :package-version '(magit-section . "3.0.0") 297 :group 'magit-section 298 :type 'boolean) 299 300 (defcustom magit-section-show-context-menu-for-emacs<28 nil 301 "Whether `mouse-3' shows a context menu for Emacs < 28. 302 303 This has to be set before loading `magit-section' or it has 304 no effect. This also has no effect for Emacs >= 28, where 305 `context-menu-mode' should be enabled instead." 306 :package-version '(magit-section . "4.0.0") 307 :group 'magit-section 308 :type 'boolean) 309 310 ;;; Variables 311 312 (defvar-local magit-section-preserve-visibility t) 313 314 (defvar-local magit-section-pre-command-region-p nil) 315 (defvar-local magit-section-pre-command-section nil) 316 (defvar-local magit-section-highlight-force-update nil) 317 (defvar-local magit-section-highlight-overlays nil) 318 (defvar-local magit-section-highlighted-sections nil) 319 (defvar-local magit-section-unhighlight-sections nil) 320 321 (defvar-local magit-section-inhibit-markers nil) 322 (defvar-local magit-section-insert-in-reverse nil) 323 324 ;;; Faces 325 326 (defgroup magit-section-faces nil 327 "Faces used by Magit-Section." 328 :group 'magit-section 329 :group 'faces) 330 331 (defface magit-section-highlight 332 `((((class color) (background light)) 333 ,@(and (>= emacs-major-version 27) '(:extend t)) 334 :background "grey95") 335 (((class color) (background dark)) 336 ,@(and (>= emacs-major-version 27) '(:extend t)) 337 :background "grey20")) 338 "Face for highlighting the current section." 339 :group 'magit-section-faces) 340 341 (defface magit-section-heading 342 `((((class color) (background light)) 343 ,@(and (>= emacs-major-version 27) '(:extend t)) 344 :foreground "DarkGoldenrod4" 345 :weight bold) 346 (((class color) (background dark)) 347 ,@(and (>= emacs-major-version 27) '(:extend t)) 348 :foreground "LightGoldenrod2" 349 :weight bold)) 350 "Face for section headings." 351 :group 'magit-section-faces) 352 353 (defface magit-section-secondary-heading 354 `((t ,@(and (>= emacs-major-version 27) '(:extend t)) 355 :weight bold)) 356 "Face for section headings of some secondary headings." 357 :group 'magit-section-faces) 358 359 (defface magit-section-heading-selection 360 `((((class color) (background light)) 361 ,@(and (>= emacs-major-version 27) '(:extend t)) 362 :foreground "salmon4") 363 (((class color) (background dark)) 364 ,@(and (>= emacs-major-version 27) '(:extend t)) 365 :foreground "LightSalmon3")) 366 "Face for selected section headings." 367 :group 'magit-section-faces) 368 369 (defface magit-section-child-count '((t nil)) 370 "Face used for child counts at the end of some section headings." 371 :group 'magit-section-faces) 372 373 ;;; Classes 374 375 (defvar magit--current-section-hook nil 376 "Internal variable used for `magit-describe-section'.") 377 378 (defvar magit--section-type-alist nil) 379 380 (defclass magit-section () 381 ((type :initform nil :initarg :type) 382 (keymap :initform nil) 383 (value :initform nil) 384 (start :initform nil) 385 (content :initform nil) 386 (end :initform nil) 387 (hidden) 388 (washer :initform nil :initarg :washer) 389 (inserter :initform (symbol-value 'magit--current-section-hook)) 390 (heading-highlight-face :initform nil :initarg :heading-highlight-face) 391 (parent :initform nil) 392 (children :initform nil))) 393 394 ;;; Mode 395 396 (defvar symbol-overlay-inhibit-map) 397 398 (defvar-keymap magit-section-heading-map 399 :doc "Keymap used in the heading line of all expandable sections. 400 This keymap is used in addition to the section-specific keymap, 401 if any." 402 "<double-down-mouse-1>" #'ignore 403 "<double-mouse-1>" #'magit-mouse-toggle-section 404 "<double-mouse-2>" #'magit-mouse-toggle-section) 405 406 (defvar magit-section-mode-map 407 (let ((map (make-keymap))) 408 (suppress-keymap map t) 409 (when (and magit-section-show-context-menu-for-emacs<28 410 (< emacs-major-version 28)) 411 (keymap-set map "<mouse-3>" nil) 412 (keymap-set 413 map "<down-mouse-3>" 414 `( menu-item "" ,(make-sparse-keymap) 415 :filter ,(lambda (_) 416 (let ((menu (make-sparse-keymap))) 417 (if (fboundp 'context-menu-local) 418 (context-menu-local menu last-input-event) 419 (magit--context-menu-local menu last-input-event)) 420 (magit-section-context-menu menu last-input-event) 421 menu))))) 422 (keymap-set map "<left-fringe> <mouse-1>" #'magit-mouse-toggle-section) 423 (keymap-set map "<left-fringe> <mouse-2>" #'magit-mouse-toggle-section) 424 (keymap-set map "TAB" #'magit-section-toggle) 425 (keymap-set map "C-c TAB" #'magit-section-cycle) 426 (keymap-set map "C-<tab>" #'magit-section-cycle) 427 (keymap-set map "M-<tab>" #'magit-section-cycle) 428 ;; <backtab> is the most portable binding for Shift+Tab. 429 (keymap-set map "<backtab>" #'magit-section-cycle-global) 430 (keymap-set map "^" #'magit-section-up) 431 (keymap-set map "p" #'magit-section-backward) 432 (keymap-set map "n" #'magit-section-forward) 433 (keymap-set map "M-p" #'magit-section-backward-sibling) 434 (keymap-set map "M-n" #'magit-section-forward-sibling) 435 (keymap-set map "1" #'magit-section-show-level-1) 436 (keymap-set map "2" #'magit-section-show-level-2) 437 (keymap-set map "3" #'magit-section-show-level-3) 438 (keymap-set map "4" #'magit-section-show-level-4) 439 (keymap-set map "M-1" #'magit-section-show-level-1-all) 440 (keymap-set map "M-2" #'magit-section-show-level-2-all) 441 (keymap-set map "M-3" #'magit-section-show-level-3-all) 442 (keymap-set map "M-4" #'magit-section-show-level-4-all) 443 map) 444 "Parent keymap for all keymaps of modes derived from `magit-section-mode'.") 445 446 (define-derived-mode magit-section-mode special-mode "Magit-Sections" 447 "Parent major mode from which major modes with Magit-like sections inherit. 448 449 Magit-Section is documented in info node `(magit-section)'." 450 :interactive nil 451 :group 'magit-section 452 (buffer-disable-undo) 453 (setq truncate-lines t) 454 (setq buffer-read-only t) 455 (setq-local line-move-visual t) ; see #1771 456 ;; Turn off syntactic font locking, but not by setting 457 ;; `font-lock-defaults' because that would enable font locking, and 458 ;; not all magit plugins may be ready for that (see #3950). 459 (setq-local font-lock-syntactic-face-function #'ignore) 460 (setq show-trailing-whitespace nil) 461 (setq-local symbol-overlay-inhibit-map t) 462 (setq list-buffers-directory (abbreviate-file-name default-directory)) 463 (make-local-variable 'text-property-default-nonsticky) 464 (push (cons 'keymap t) text-property-default-nonsticky) 465 (add-hook 'pre-command-hook #'magit-section-pre-command-hook nil t) 466 (add-hook 'post-command-hook #'magit-section-post-command-hook t t) 467 (add-hook 'deactivate-mark-hook #'magit-section-deactivate-mark t t) 468 (setq-local redisplay-highlight-region-function 469 #'magit-section--highlight-region) 470 (setq-local redisplay-unhighlight-region-function 471 #'magit-section--unhighlight-region) 472 (add-function :filter-return (local 'filter-buffer-substring-function) 473 #'magit-section--remove-text-properties) 474 (when (fboundp 'magit-section-context-menu) 475 (add-hook 'context-menu-functions #'magit-section-context-menu 10 t)) 476 (when magit-section-disable-line-numbers 477 (when (and (fboundp 'linum-mode) 478 (bound-and-true-p global-linum-mode)) 479 (linum-mode -1)) 480 (when (and (fboundp 'nlinum-mode) 481 (bound-and-true-p global-nlinum-mode)) 482 (nlinum-mode -1)) 483 (when (and (fboundp 'display-line-numbers-mode) 484 (bound-and-true-p global-display-line-numbers-mode)) 485 (display-line-numbers-mode -1))) 486 (when (fboundp 'magit-preserve-section-visibility-cache) 487 (add-hook 'kill-buffer-hook #'magit-preserve-section-visibility-cache))) 488 489 (defun magit-section--remove-text-properties (string) 490 "Remove all text-properties from STRING. 491 Most importantly `magit-section'." 492 (set-text-properties 0 (length string) nil string) 493 string) 494 495 ;;; Core 496 497 (defvar-local magit-root-section nil 498 "The root section in the current buffer. 499 All other sections are descendants of this section. The value 500 of this variable is set by `magit-insert-section' and you should 501 never modify it.") 502 (put 'magit-root-section 'permanent-local t) 503 504 (defvar-local magit--context-menu-section nil "For internal use only.") 505 506 (defvar magit--context-menu-buffer nil "For internal use only.") 507 508 (defun magit-point () 509 "Return point or the position where the context menu was invoked. 510 When using the context menu, return the position the user clicked 511 on, provided the current buffer is the buffer in which the click 512 occurred. Otherwise return the same value as `point'." 513 (if magit--context-menu-section 514 (magit-menu-position) 515 (point))) 516 517 (defun magit-thing-at-point (thing &optional no-properties) 518 "Return the THING at point or where the context menu was invoked. 519 When using the context menu, return the thing the user clicked 520 on, provided the current buffer is the buffer in which the click 521 occurred. Otherwise return the same value as `thing-at-point'. 522 For the meaning of THING and NO-PROPERTIES see that function." 523 (if-let ((pos (magit-menu-position))) 524 (save-excursion 525 (goto-char pos) 526 (thing-at-point thing no-properties)) 527 (thing-at-point thing no-properties))) 528 529 (defun magit-current-section () 530 "Return the section at point or where the context menu was invoked. 531 When using the context menu, return the section that the user 532 clicked on, provided the current buffer is the buffer in which 533 the click occurred. Otherwise return the section at point." 534 (or magit--context-menu-section 535 (magit-section-at) 536 magit-root-section)) 537 538 (defun magit-section-at (&optional position) 539 "Return the section at POSITION, defaulting to point." 540 (get-text-property (or position (point)) 'magit-section)) 541 542 (defun magit-section-ident (section) 543 "Return an unique identifier for SECTION. 544 The return value has the form ((TYPE . VALUE)...)." 545 (cons (cons (oref section type) 546 (magit-section-ident-value section)) 547 (and-let* ((parent (oref section parent))) 548 (magit-section-ident parent)))) 549 550 (cl-defgeneric magit-section-ident-value (object) 551 "Return OBJECT's value, making it constant and unique if necessary. 552 553 This is used to correlate different incarnations of the same 554 section, see `magit-section-ident' and `magit-get-section'. 555 556 Sections whose values that are not constant and/or unique should 557 implement a method that return a value that can be used for this 558 purpose.") 559 560 (cl-defmethod magit-section-ident-value ((section magit-section)) 561 "Return the value unless it is an object. 562 563 Different object incarnations representing the same value tend to not be 564 equal, so call this generic function on the object itself to determine a 565 constant value." 566 (let ((value (oref section value))) 567 (if (eieio-object-p value) 568 (magit-section-ident-value value) 569 value))) 570 571 (cl-defmethod magit-section-ident-value ((object eieio-default-superclass)) 572 "Simply return the object itself. That likely isn't 573 good enough, so you need to implement your own method." 574 object) 575 576 (defun magit-get-section (ident &optional root) 577 "Return the section identified by IDENT. 578 IDENT has to be a list as returned by `magit-section-ident'. 579 If optional ROOT is non-nil, then search in that section tree 580 instead of in the one whose root `magit-root-section' is." 581 (setq ident (reverse ident)) 582 (let ((section (or root magit-root-section))) 583 (when (eq (car (pop ident)) 584 (oref section type)) 585 (while (and ident 586 (pcase-let ((`(,type . ,value) (car ident))) 587 (setq section 588 (cl-find-if 589 (lambda (section) 590 (and (eq (oref section type) type) 591 (equal (magit-section-ident-value section) 592 value))) 593 (oref section children))))) 594 (pop ident)) 595 section))) 596 597 (defun magit-section-lineage (section &optional raw) 598 "Return the lineage of SECTION. 599 If optional RAW is non-nil, return a list of section objects, beginning 600 with SECTION, otherwise return a list of section types." 601 (cons (if raw section (oref section type)) 602 (and-let* ((parent (oref section parent))) 603 (magit-section-lineage parent raw)))) 604 605 (defvar magit-insert-section--current nil "For internal use only.") 606 (defvar magit-insert-section--parent nil "For internal use only.") 607 (defvar magit-insert-section--oldroot nil "For internal use only.") 608 609 ;;; Menu 610 611 (defvar magit-menu-common-value nil "See function `magit-menu-common-value'.") 612 (defvar magit-menu--desc-values nil "For internal use only.") 613 614 (defun magit-section-context-menu (menu click) 615 "Populate MENU with Magit-Section commands at CLICK." 616 (when-let ((section (save-excursion 617 (unless (region-active-p) 618 (mouse-set-point click)) 619 (magit-section-at)))) 620 (unless (region-active-p) 621 (setq magit--context-menu-buffer (current-buffer)) 622 (if-let ((alt (save-excursion 623 (mouse-set-point click) 624 (run-hook-with-args-until-success 625 'magit-menu-alternative-section-hook section)))) 626 (setq magit--context-menu-section (setq section alt)) 627 (setq magit--context-menu-section section) 628 (magit-section-update-highlight t))) 629 (when (magit-section-content-p section) 630 (keymap-set-after menu "<magit-section-toggle>" 631 `(menu-item 632 ,(if (oref section hidden) "Expand section" "Collapse section") 633 magit-section-toggle)) 634 (unless (oref section hidden) 635 (when-let ((children (oref section children))) 636 (when (seq-some #'magit-section-content-p children) 637 (when (seq-some (lambda (c) (oref c hidden)) children) 638 (keymap-set-after menu "<magit-section-show-children>" 639 `(menu-item "Expand children" 640 magit-section-show-children))) 641 (when (seq-some (lambda (c) (not (oref c hidden))) children) 642 (keymap-set-after menu "<magit-section-hide-children>" 643 `(menu-item "Collapse children" 644 magit-section-hide-children)))))) 645 (keymap-set-after menu "<separator-magit-1>" menu-bar-separator)) 646 (keymap-set-after menu "<magit-describe-section>" 647 `(menu-item "Describe section" magit-describe-section)) 648 (when-let ((map (oref section keymap))) 649 (keymap-set-after menu "<separator-magit-2>" menu-bar-separator) 650 (when (symbolp map) 651 (setq map (symbol-value map))) 652 (setq magit-menu-common-value (magit-menu-common-value section)) 653 (setq magit-menu--desc-values (magit-menu--desc-values section)) 654 (map-keymap (lambda (key binding) 655 (when (consp binding) 656 (define-key-after menu (vector key) 657 (copy-sequence binding)))) 658 (if (fboundp 'menu-bar-keymap) 659 (menu-bar-keymap map) 660 (magit--menu-bar-keymap map))))) 661 menu) 662 663 (defun magit-menu-item (desc def &optional props) 664 "Return a menu item named DESC binding DEF and using PROPS. 665 666 If DESC contains a supported %-spec, substitute the 667 expression (magit-menu-format-desc DESC) for that. 668 See `magit-menu-format-desc'." 669 `(menu-item 670 ,(if (and (stringp desc) (string-match-p "%[tTvsmMx]" desc)) 671 (list 'magit-menu-format-desc desc) 672 desc) 673 ,def 674 ;; Without this, the keys for point would be shown instead 675 ;; of the relevant ones from where the click occurred. 676 :keys ,(apply-partially #'magit--menu-position-keys def) 677 ,@props)) 678 679 (defun magit--menu-position-keys (def) 680 (or (ignore-errors 681 (save-excursion 682 (goto-char (magit-menu-position)) 683 (and-let* ((key (cl-find-if-not 684 (lambda (key) 685 (string-match-p "\\`<[0-9]+>\\'" 686 (key-description key))) 687 (where-is-internal def)))) 688 (key-description key)))) 689 "")) 690 691 (defun magit-menu-position () 692 "Return the position where the context-menu was invoked. 693 If the current command wasn't invoked using the context-menu, 694 then return nil." 695 (and magit--context-menu-section 696 (ignore-errors 697 (posn-point (event-start (aref (this-command-keys-vector) 0)))))) 698 699 (defun magit-menu-highlight-point-section () 700 (setq magit-section-highlight-force-update t) 701 (if (eq (current-buffer) magit--context-menu-buffer) 702 (setq magit--context-menu-section nil) 703 (if-let ((window (get-buffer-window magit--context-menu-buffer))) 704 (with-selected-window window 705 (setq magit--context-menu-section nil) 706 (magit-section-update-highlight)) 707 (with-current-buffer magit--context-menu-buffer 708 (setq magit--context-menu-section nil)))) 709 (setq magit--context-menu-buffer nil)) 710 711 (defvar magit--plural-append-es '(branch)) 712 713 (cl-defgeneric magit-menu-common-value (_section) 714 "Return some value to be used by multiple menu items. 715 This function is called by `magit-section-context-menu', which 716 stores the value in `magit-menu-common-value'. Individual menu 717 items can use it, e.g., in the expression used to set their 718 description." 719 nil) 720 721 (defun magit-menu--desc-values (section) 722 (let ((type (oref section type)) 723 (value (oref section value)) 724 (multiple (magit-region-sections nil t))) 725 (list type 726 value 727 (format "%s %s" type value) 728 (and multiple (length multiple)) 729 (if (memq type magit--plural-append-es) "es" "s")))) 730 731 (defun magit-menu-format-desc (format) 732 "Format a string based on FORMAT and menu section or selection. 733 The following %-specs are allowed: 734 %t means \"TYPE\". 735 %T means \"TYPE\", or \"TYPEs\" if multiple sections are selected. 736 %v means \"VALUE\". 737 %s means \"TYPE VALUE\". 738 %m means \"TYPE VALUE\", or \"COUNT TYPEs\" if multiple sections 739 are selected. 740 %M means \"VALUE\", or \"COUNT TYPEs\" if multiple sections are 741 selected. 742 %x means the value of `magit-menu-common-value'." 743 (pcase-let* ((`(,type ,value ,single ,count ,suffix) magit-menu--desc-values) 744 (multiple (and count (format "%s %s%s" count type suffix)))) 745 (format-spec format 746 `((?t . ,type) 747 (?T . ,(format "%s%s" type (if count suffix ""))) 748 (?v . ,value) 749 (?s . ,single) 750 (?m . ,(or multiple single)) 751 (?M . ,(or multiple value)) 752 (?x . ,(format "%s" magit-menu-common-value)))))) 753 754 (defun magit--menu-bar-keymap (keymap) 755 "Backport of `menu-bar-keymap' for Emacs < 28. 756 Slight trimmed down." 757 (let ((menu-bar nil)) 758 (map-keymap (lambda (key binding) 759 (push (cons key binding) menu-bar)) 760 keymap) 761 (cons 'keymap (nreverse menu-bar)))) 762 763 (defun magit--context-menu-local (menu _click) 764 "Backport of `context-menu-local' for Emacs < 28." 765 (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) 766 (keymap-set-after menu "<separator-local>" menu-bar-separator) 767 (let ((keymap (local-key-binding [menu-bar]))) 768 (when keymap 769 (map-keymap (lambda (key binding) 770 (when (consp binding) 771 (define-key-after menu (vector key) 772 (copy-sequence binding)))) 773 (magit--menu-bar-keymap keymap)))) 774 menu) 775 776 (define-advice context-menu-region (:around (fn menu click) magit-section-mode) 777 "Disable in `magit-section-mode' buffers." 778 (if (derived-mode-p 'magit-section-mode) 779 menu 780 (funcall fn menu click))) 781 782 ;;; Commands 783 ;;;; Movement 784 785 (defun magit-section-forward () 786 "Move to the beginning of the next visible section." 787 (interactive) 788 (if (eobp) 789 (user-error "No next section") 790 (let ((section (magit-current-section))) 791 (if (oref section parent) 792 (let ((next (and (not (oref section hidden)) 793 (not (= (oref section end) 794 (1+ (point)))) 795 (car (oref section children))))) 796 (while (and section (not next)) 797 (unless (setq next (car (magit-section-siblings section 'next))) 798 (setq section (oref section parent)))) 799 (if next 800 (magit-section-goto next) 801 (user-error "No next section"))) 802 (magit-section-goto 1))))) 803 804 (defun magit-section-backward () 805 "Move to the beginning of the current or the previous visible section. 806 When point is at the beginning of a section then move to the 807 beginning of the previous visible section. Otherwise move to 808 the beginning of the current section." 809 (interactive) 810 (if (bobp) 811 (user-error "No previous section") 812 (let ((section (magit-current-section)) children) 813 (cond 814 ((and (= (point) 815 (1- (oref section end))) 816 (setq children (oref section children))) 817 (magit-section-goto (car (last children)))) 818 ((and (oref section parent) 819 (not (= (point) 820 (oref section start)))) 821 (magit-section-goto section)) 822 (t 823 (let ((prev (car (magit-section-siblings section 'prev)))) 824 (if prev 825 (while (and (not (oref prev hidden)) 826 (setq children (oref prev children))) 827 (setq prev (car (last children)))) 828 (setq prev (oref section parent))) 829 (cond (prev 830 (magit-section-goto prev)) 831 ((oref section parent) 832 (user-error "No previous section")) 833 ;; Eob special cases. 834 ((not (get-text-property (1- (point)) 'invisible)) 835 (magit-section-goto -1)) 836 (t 837 (goto-char (previous-single-property-change 838 (1- (point)) 'invisible)) 839 (forward-line -1) 840 (magit-section-goto (magit-current-section)))))))))) 841 842 (defun magit-section-up () 843 "Move to the beginning of the parent section." 844 (interactive) 845 (if-let ((parent (oref (magit-current-section) parent))) 846 (magit-section-goto parent) 847 (user-error "No parent section"))) 848 849 (defun magit-section-forward-sibling () 850 "Move to the beginning of the next sibling section. 851 If there is no next sibling section, then move to the parent." 852 (interactive) 853 (let ((current (magit-current-section))) 854 (if (oref current parent) 855 (if-let ((next (car (magit-section-siblings current 'next)))) 856 (magit-section-goto next) 857 (magit-section-forward)) 858 (magit-section-goto 1)))) 859 860 (defun magit-section-backward-sibling () 861 "Move to the beginning of the previous sibling section. 862 If there is no previous sibling section, then move to the parent." 863 (interactive) 864 (let ((current (magit-current-section))) 865 (if (oref current parent) 866 (if-let ((previous (car (magit-section-siblings current 'prev)))) 867 (magit-section-goto previous) 868 (magit-section-backward)) 869 (magit-section-goto -1)))) 870 871 (defun magit-section-goto (arg) 872 (if (integerp arg) 873 (progn (forward-line arg) 874 (setq arg (magit-current-section))) 875 (goto-char (oref arg start))) 876 (run-hook-with-args 'magit-section-movement-hook arg)) 877 878 (defun magit-section-set-window-start (section) 879 "Ensure the beginning of SECTION is visible." 880 (unless (pos-visible-in-window-p (oref section end)) 881 (set-window-start (selected-window) (oref section start)))) 882 883 (defmacro magit-define-section-jumper 884 (name heading type &optional value inserter &rest properties) 885 "Define an interactive function to go some section. 886 Together TYPE and VALUE identify the section. 887 HEADING is the displayed heading of the section." 888 (declare (indent defun)) 889 `(transient-define-suffix ,name (&optional expand) 890 ,(format "Jump to the section \"%s\". 891 With a prefix argument also expand it." heading) 892 ,@properties 893 ,@(and (not (plist-member properties :description)) 894 (list :description heading)) 895 ,@(and inserter 896 `(:if (lambda () (memq ',inserter 897 (bound-and-true-p magit-status-sections-hook))))) 898 :inapt-if-not (lambda () (magit-get-section 899 (cons (cons ',type ,value) 900 (magit-section-ident magit-root-section)))) 901 (interactive "P") 902 (if-let ((section (magit-get-section 903 (cons (cons ',type ,value) 904 (magit-section-ident magit-root-section))))) 905 (progn (goto-char (oref section start)) 906 (when expand 907 (with-local-quit (magit-section-show section)) 908 (recenter 0))) 909 (message ,(format "Section \"%s\" wasn't found" heading))))) 910 911 ;;;; Visibility 912 913 (defun magit-section-show (section) 914 "Show the body of the current section." 915 (interactive (list (magit-current-section))) 916 (oset section hidden nil) 917 (magit-section--maybe-wash section) 918 (when-let ((beg (oref section content))) 919 (remove-overlays beg (oref section end) 'invisible t)) 920 (magit-section-maybe-update-visibility-indicator section) 921 (magit-section-maybe-cache-visibility section) 922 (dolist (child (oref section children)) 923 (if (oref child hidden) 924 (magit-section-hide child) 925 (magit-section-show child)))) 926 927 (defun magit-section--maybe-wash (section) 928 (when-let ((washer (oref section washer))) 929 (oset section washer nil) 930 (let ((inhibit-read-only t) 931 (magit-insert-section--parent section) 932 (magit-insert-section--current section) 933 (content (oref section content))) 934 (save-excursion 935 (if (and content (< content (oref section end))) 936 (funcall washer section) ; already partially washed (hunk) 937 (goto-char (oref section end)) 938 (oset section content (point-marker)) 939 (funcall washer) 940 (oset section end (point-marker))))) 941 (setq magit-section-highlight-force-update t))) 942 943 (defun magit-section-hide (section) 944 "Hide the body of the current section." 945 (interactive (list (magit-current-section))) 946 (if (eq section magit-root-section) 947 (user-error "Cannot hide root section") 948 (oset section hidden t) 949 (when-let ((beg (oref section content))) 950 (let ((end (oref section end))) 951 (when (< beg (point) end) 952 (goto-char (oref section start))) 953 (remove-overlays beg end 'invisible t) 954 (let ((o (make-overlay beg end))) 955 (overlay-put o 'evaporate t) 956 (overlay-put o 'invisible t) 957 (overlay-put o 'cursor-intangible t)))) 958 (magit-section-maybe-update-visibility-indicator section) 959 (magit-section-maybe-cache-visibility section))) 960 961 (defun magit-section-toggle (section) 962 "Toggle visibility of the body of the current section." 963 (interactive (list (magit-current-section))) 964 (cond ((eq section magit-root-section) 965 (user-error "Cannot hide root section")) 966 ((oref section hidden) 967 (magit-section-show section)) 968 ((magit-section-hide section)))) 969 970 (defun magit-section-toggle-children (section) 971 "Toggle visibility of bodies of children of the current section." 972 (interactive (list (magit-current-section))) 973 (let* ((children (oref section children)) 974 (show (--any-p (oref it hidden) children))) 975 (dolist (c children) 976 (oset c hidden show))) 977 (magit-section-show section)) 978 979 (defun magit-section-show-children (section &optional depth) 980 "Recursively show the bodies of children of the current section. 981 With a prefix argument show children that deep and hide deeper 982 children." 983 (interactive (list (magit-current-section))) 984 (magit-section-show-children-1 section depth) 985 (magit-section-show section)) 986 987 (defun magit-section-show-children-1 (section &optional depth) 988 (dolist (child (oref section children)) 989 (oset child hidden nil) 990 (if depth 991 (if (> depth 0) 992 (magit-section-show-children-1 child (1- depth)) 993 (magit-section-hide child)) 994 (magit-section-show-children-1 child)))) 995 996 (defun magit-section-hide-children (section) 997 "Recursively hide the bodies of children of the current section." 998 (interactive (list (magit-current-section))) 999 (mapc #'magit-section-hide (oref section children))) 1000 1001 (defun magit-section-show-headings (section) 1002 "Recursively show headings of children of the current section. 1003 Only show the headings, previously shown text-only bodies are 1004 hidden." 1005 (interactive (list (magit-current-section))) 1006 (magit-section-show-headings-1 section) 1007 (magit-section-show section)) 1008 1009 (defun magit-section-show-headings-1 (section) 1010 (dolist (child (oref section children)) 1011 (oset child hidden nil) 1012 (when (or (oref child children) 1013 (not (oref child content))) 1014 (magit-section-show-headings-1 child)))) 1015 1016 (defun magit-section-cycle (section) 1017 "Cycle visibility of current section and its children. 1018 1019 If this command is invoked using \\`C-<tab>' and that is globally bound 1020 to `tab-next', then this command pivots to behave like that command, and 1021 you must instead use \\`C-c TAB' to cycle section visibility. 1022 1023 If you would like to keep using \\`C-<tab>' to cycle section visibility 1024 but also want to use `tab-bar-mode', then you have to prevent that mode 1025 from using this key and instead bind another key to `tab-next'. Because 1026 `tab-bar-mode' does not use a mode map but instead manipulates the 1027 global map, this involves advising `tab-bar--define-keys'." 1028 (interactive (list (magit-current-section))) 1029 (cond 1030 ((and (equal (this-command-keys) [C-tab]) 1031 (eq (global-key-binding [C-tab]) 'tab-next) 1032 (fboundp 'tab-bar-switch-to-next-tab)) 1033 (tab-bar-switch-to-next-tab current-prefix-arg)) 1034 ((oref section hidden) 1035 (magit-section-show section) 1036 (magit-section-hide-children section)) 1037 ((let ((children (oref section children))) 1038 (cond ((and (--any-p (oref it hidden) children) 1039 (--any-p (oref it children) children)) 1040 (magit-section-show-headings section)) 1041 ((seq-some #'magit-section-hidden-body children) 1042 (magit-section-show-children section)) 1043 ((magit-section-hide section))))))) 1044 1045 (defun magit-section-cycle-global () 1046 "Cycle visibility of all sections in the current buffer." 1047 (interactive) 1048 (let ((children (oref magit-root-section children))) 1049 (cond ((and (--any-p (oref it hidden) children) 1050 (--any-p (oref it children) children)) 1051 (magit-section-show-headings magit-root-section)) 1052 ((seq-some #'magit-section-hidden-body children) 1053 (magit-section-show-children magit-root-section)) 1054 (t 1055 (mapc #'magit-section-hide children))))) 1056 1057 (defun magit-section-hidden-body (section &optional pred) 1058 (if-let ((children (oref section children))) 1059 (funcall (or pred #'-any-p) #'magit-section-hidden-body children) 1060 (and (oref section content) 1061 (oref section hidden)))) 1062 1063 (defun magit-section-content-p (section) 1064 "Return non-nil if SECTION has content or an unused washer function." 1065 (with-slots (content end washer) section 1066 (and content (or (not (= content end)) washer)))) 1067 1068 (defun magit-section-invisible-p (section) 1069 "Return t if the SECTION's body is invisible. 1070 When the body of an ancestor of SECTION is collapsed then 1071 SECTION's body (and heading) obviously cannot be visible." 1072 (or (oref section hidden) 1073 (and-let* ((parent (oref section parent))) 1074 (magit-section-invisible-p parent)))) 1075 1076 (defun magit-section-show-level (level) 1077 "Show surrounding sections up to LEVEL. 1078 If LEVEL is negative, show up to the absolute value. 1079 Sections at higher levels are hidden." 1080 (if (< level 0) 1081 (let ((s (magit-current-section))) 1082 (setq level (- level)) 1083 (while (> (1- (length (magit-section-ident s))) level) 1084 (setq s (oref s parent)) 1085 (goto-char (oref s start))) 1086 (magit-section-show-children magit-root-section (1- level))) 1087 (cl-do* ((s (magit-current-section) 1088 (oref s parent)) 1089 (i (1- (length (magit-section-ident s))) 1090 (cl-decf i))) 1091 ((cond ((< i level) (magit-section-show-children s (- level i 1)) t) 1092 ((= i level) (magit-section-hide s) t)) 1093 (magit-section-goto s))))) 1094 1095 (defun magit-section-show-level-1 () 1096 "Show surrounding sections on first level." 1097 (interactive) 1098 (magit-section-show-level 1)) 1099 1100 (defun magit-section-show-level-1-all () 1101 "Show all sections on first level." 1102 (interactive) 1103 (magit-section-show-level -1)) 1104 1105 (defun magit-section-show-level-2 () 1106 "Show surrounding sections up to second level." 1107 (interactive) 1108 (magit-section-show-level 2)) 1109 1110 (defun magit-section-show-level-2-all () 1111 "Show all sections up to second level." 1112 (interactive) 1113 (magit-section-show-level -2)) 1114 1115 (defun magit-section-show-level-3 () 1116 "Show surrounding sections up to third level." 1117 (interactive) 1118 (magit-section-show-level 3)) 1119 1120 (defun magit-section-show-level-3-all () 1121 "Show all sections up to third level." 1122 (interactive) 1123 (magit-section-show-level -3)) 1124 1125 (defun magit-section-show-level-4 () 1126 "Show surrounding sections up to fourth level." 1127 (interactive) 1128 (magit-section-show-level 4)) 1129 1130 (defun magit-section-show-level-4-all () 1131 "Show all sections up to fourth level." 1132 (interactive) 1133 (magit-section-show-level -4)) 1134 1135 (defun magit-mouse-toggle-section (event) 1136 "Toggle visibility of the clicked section. 1137 Clicks outside either the section heading or the left fringe are 1138 silently ignored." 1139 (interactive "e") 1140 (let* ((pos (event-start event)) 1141 (section (magit-section-at (posn-point pos)))) 1142 (if (eq (posn-area pos) 'left-fringe) 1143 (when section 1144 (while (not (magit-section-content-p section)) 1145 (setq section (oref section parent))) 1146 (unless (eq section magit-root-section) 1147 (goto-char (oref section start)) 1148 (magit-section-toggle section))) 1149 (magit-section-toggle section)))) 1150 1151 ;;;; Auxiliary 1152 1153 (defun magit-describe-section-briefly (section &optional ident interactive) 1154 "Show information about the section at point. 1155 With a prefix argument show the section identity instead of the 1156 section lineage. This command is intended for debugging purposes. 1157 \n(fn SECTION &optional IDENT)" 1158 (interactive (list (magit-current-section) current-prefix-arg t)) 1159 (let ((str (format "#<%s %S %S %s-%s%s>" 1160 (eieio-object-class section) 1161 (let ((val (oref section value))) 1162 (cond ((stringp val) 1163 (substring-no-properties val)) 1164 ((and (eieio-object-p val) 1165 (fboundp 'cl-prin1-to-string)) 1166 (cl-prin1-to-string val)) 1167 (t 1168 val))) 1169 (if ident 1170 (magit-section-ident section) 1171 (apply #'vector (magit-section-lineage section))) 1172 (and-let* ((m (oref section start))) 1173 (if (markerp m) (marker-position m) m)) 1174 (if-let ((m (oref section content))) 1175 (format "[%s-]" 1176 (if (markerp m) (marker-position m) m)) 1177 "") 1178 (and-let* ((m (oref section end))) 1179 (if (markerp m) (marker-position m) m))))) 1180 (when interactive 1181 (message "%s" str)) 1182 str)) 1183 1184 (cl-defmethod cl-print-object ((section magit-section) stream) 1185 "Print `magit-describe-section' result of SECTION." 1186 ;; Used by debug and edebug as of Emacs 26. 1187 (princ (magit-describe-section-briefly section) stream)) 1188 1189 (defun magit-describe-section (section &optional interactive-p) 1190 "Show information about the section at point." 1191 (interactive (list (magit-current-section) t)) 1192 (let ((inserter-section section)) 1193 (while (and inserter-section (not (oref inserter-section inserter))) 1194 (setq inserter-section (oref inserter-section parent))) 1195 (when (and inserter-section (oref inserter-section inserter)) 1196 (setq section inserter-section))) 1197 (pcase (oref section inserter) 1198 (`((,hook ,fun) . ,src-src) 1199 (help-setup-xref `(magit-describe-section ,section) interactive-p) 1200 (with-help-window (help-buffer) 1201 (with-current-buffer standard-output 1202 (insert (format-message 1203 "%s\n is inserted by `%s'\n from `%s'" 1204 (magit-describe-section-briefly section) 1205 (make-text-button (symbol-name fun) nil 1206 :type 'help-function 1207 'help-args (list fun)) 1208 (make-text-button (symbol-name hook) nil 1209 :type 'help-variable 1210 'help-args (list hook)))) 1211 (pcase-dolist (`(,hook ,fun) src-src) 1212 (insert (format-message 1213 ",\n called by `%s'\n from `%s'" 1214 (make-text-button (symbol-name fun) nil 1215 :type 'help-function 1216 'help-args (list fun)) 1217 (make-text-button (symbol-name hook) nil 1218 :type 'help-variable 1219 'help-args (list hook))))) 1220 (insert ".\n\n") 1221 (insert 1222 (format-message 1223 "`%s' is " 1224 (make-text-button (symbol-name fun) nil 1225 :type 'help-function 'help-args (list fun)))) 1226 (describe-function-1 fun)))) 1227 (_ (message "%s, inserter unknown" 1228 (magit-describe-section-briefly section))))) 1229 1230 ;;; Match 1231 1232 (cl-defun magit-section-match 1233 (condition &optional (section (magit-current-section))) 1234 "Return t if SECTION matches CONDITION. 1235 1236 SECTION defaults to the section at point. If SECTION is not 1237 specified and there also is no section at point, then return 1238 nil. 1239 1240 CONDITION can take the following forms: 1241 (CONDITION...) matches if any of the CONDITIONs matches. 1242 [CLASS...] matches if the section's class is the same 1243 as the first CLASS or a subclass of that; 1244 the section's parent class matches the 1245 second CLASS; and so on. 1246 [* CLASS...] matches sections that match [CLASS...] and 1247 also recursively all their child sections. 1248 CLASS matches if the section's class is the same 1249 as CLASS or a subclass of that; regardless 1250 of the classes of the parent sections. 1251 1252 Each CLASS should be a class symbol, identifying a class that 1253 derives from `magit-section'. For backward compatibility CLASS 1254 can also be a \"type symbol\". A section matches such a symbol 1255 if the value of its `type' slot is `eq'. If a type symbol has 1256 an entry in `magit--section-type-alist', then a section also 1257 matches that type if its class is a subclass of the class that 1258 corresponds to the type as per that alist. 1259 1260 Note that it is not necessary to specify the complete section 1261 lineage as printed by `magit-describe-section-briefly', unless 1262 of course you want to be that precise." 1263 (and section (magit-section-match-1 condition section))) 1264 1265 (defun magit-section-match-1 (condition section) 1266 (cl-assert condition) 1267 (and section 1268 (if (listp condition) 1269 (--first (magit-section-match-1 it section) condition) 1270 (magit-section-match-2 (if (symbolp condition) 1271 (list condition) 1272 (cl-coerce condition 'list)) 1273 section)))) 1274 1275 (defun magit-section-match-2 (condition section) 1276 (if (eq (car condition) '*) 1277 (or (magit-section-match-2 (cdr condition) section) 1278 (and-let* ((parent (oref section parent))) 1279 (magit-section-match-2 condition parent))) 1280 (and (let ((c (car condition))) 1281 (if (class-p c) 1282 (cl-typep section c) 1283 (if-let ((class (cdr (assq c magit--section-type-alist)))) 1284 (cl-typep section class) 1285 (eq (oref section type) c)))) 1286 (or (not (setq condition (cdr condition))) 1287 (and-let* ((parent (oref section parent))) 1288 (magit-section-match-2 condition parent)))))) 1289 1290 (defun magit-section-value-if (condition &optional section) 1291 "If the section at point matches CONDITION, then return its value. 1292 1293 If optional SECTION is non-nil then test whether that matches 1294 instead. If there is no section at point and SECTION is nil, 1295 then return nil. If the section does not match, then return 1296 nil. 1297 1298 See `magit-section-match' for the forms CONDITION can take." 1299 (and-let* ((section (or section (magit-current-section)))) 1300 (and (magit-section-match condition section) 1301 (oref section value)))) 1302 1303 (defmacro magit-section-case (&rest clauses) 1304 "Choose among clauses on the type of the section at point. 1305 1306 Each clause looks like (CONDITION BODY...). The type of the 1307 section is compared against each CONDITION; the BODY forms of the 1308 first match are evaluated sequentially and the value of the last 1309 form is returned. Inside BODY the symbol `it' is bound to the 1310 section at point. If no clause succeeds or if there is no 1311 section at point, return nil. 1312 1313 See `magit-section-match' for the forms CONDITION can take. 1314 Additionally a CONDITION of t is allowed in the final clause, and 1315 matches if no other CONDITION match, even if there is no section 1316 at point." 1317 (declare (indent 0) 1318 (debug (&rest (sexp body)))) 1319 `(let* ((it (magit-current-section))) 1320 (cond ,@(mapcar (lambda (clause) 1321 `(,(or (eq (car clause) t) 1322 `(and it 1323 (magit-section-match-1 ',(car clause) it))) 1324 ,@(cdr clause))) 1325 clauses)))) 1326 1327 (defun magit-section-match-assoc (section alist) 1328 "Return the value associated with SECTION's type or lineage in ALIST." 1329 (seq-some (pcase-lambda (`(,key . ,val)) 1330 (and (magit-section-match-1 key section) val)) 1331 alist)) 1332 1333 ;;; Create 1334 1335 (defvar magit-insert-section-hook nil 1336 "Hook run after `magit-insert-section's BODY. 1337 Avoid using this hook and only ever do so if you know 1338 what you are doing and are sure there is no other way.") 1339 1340 (defmacro magit-insert-section (&rest args) 1341 "Insert a section at point. 1342 1343 Create a section object of type CLASS, storing VALUE in its 1344 `value' slot, and insert the section at point. CLASS is a 1345 subclass of `magit-section' or has the form `(eval FORM)', in 1346 which case FORM is evaluated at runtime and should return a 1347 subclass. In other places a sections class is often referred 1348 to as its \"type\". 1349 1350 Many commands behave differently depending on the class of the 1351 current section and sections of a certain class can have their 1352 own keymap, which is specified using the `keymap' class slot. 1353 The value of that slot should be a variable whose value is a 1354 keymap. 1355 1356 For historic reasons Magit and Forge in most cases use symbols 1357 as CLASS that don't actually identify a class and that lack the 1358 appropriate package prefix. This works due to some undocumented 1359 kludges, which are not available to other packages. 1360 1361 When optional HIDE is non-nil collapse the section body by 1362 default, i.e., when first creating the section, but not when 1363 refreshing the buffer. Else expand it by default. This can be 1364 overwritten using `magit-section-set-visibility-hook'. When a 1365 section is recreated during a refresh, then the visibility of 1366 predecessor is inherited and HIDE is ignored (but the hook is 1367 still honored). 1368 1369 BODY is any number of forms that actually insert the section's 1370 heading and body. Optional NAME, if specified, has to be a 1371 symbol, which is then bound to the object of the section being 1372 inserted. 1373 1374 Before BODY is evaluated the `start' of the section object is set 1375 to the value of `point' and after BODY was evaluated its `end' is 1376 set to the new value of `point'; BODY is responsible for moving 1377 `point' forward. 1378 1379 If it turns out inside BODY that the section is empty, then 1380 `magit-cancel-section' can be used to abort and remove all traces 1381 of the partially inserted section. This can happen when creating 1382 a section by washing Git's output and Git didn't actually output 1383 anything this time around. 1384 1385 \(fn [NAME] (CLASS &optional VALUE HIDE) &rest BODY)" 1386 (declare (indent 1) 1387 (debug ([&optional symbolp] 1388 (&or [("eval" form) &optional form form &rest form] 1389 [symbolp &optional form form &rest form]) 1390 body))) 1391 (pcase-let* ((bind (and (symbolp (car args)) 1392 (pop args))) 1393 (`((,class ,value ,hide . ,args) . ,body) args) 1394 (obj (cl-gensym "section"))) 1395 `(let* ((,obj (magit-insert-section--create 1396 ,(if (eq (car-safe class) 'eval) (cadr class) `',class) 1397 ,value ,hide ,@args)) 1398 (magit-insert-section--current ,obj) 1399 (magit-insert-section--oldroot 1400 (or magit-insert-section--oldroot 1401 (and (not magit-insert-section--parent) 1402 (prog1 magit-root-section 1403 (setq magit-root-section ,obj))))) 1404 (magit-insert-section--parent ,obj)) 1405 (catch 'cancel-section 1406 ,@(if bind `((let ((,bind ,obj)) ,@body)) body) 1407 (magit-insert-section--finish ,obj)) 1408 ,obj))) 1409 1410 (defun magit-insert-section--create (class value hide &rest args) 1411 (let (type) 1412 (if (class-p class) 1413 (setq type (or (car (rassq class magit--section-type-alist)) 1414 class)) 1415 (setq type class) 1416 (setq class (or (cdr (assq class magit--section-type-alist)) 1417 'magit-section))) 1418 (let ((obj (apply class :type type args))) 1419 (oset obj value value) 1420 (oset obj parent magit-insert-section--parent) 1421 (oset obj start (if magit-section-inhibit-markers (point) (point-marker))) 1422 (unless (slot-boundp obj 'hidden) 1423 (oset obj hidden 1424 (let (set old) 1425 (cond 1426 ((setq set (run-hook-with-args-until-success 1427 'magit-section-set-visibility-hook obj)) 1428 (eq set 'hide)) 1429 ((setq old (and (not magit-section-preserve-visibility) 1430 magit-insert-section--oldroot 1431 (magit-get-section 1432 (magit-section-ident obj) 1433 magit-insert-section--oldroot))) 1434 (oref old hidden)) 1435 ((setq set (magit-section-match-assoc 1436 obj magit-section-initial-visibility-alist)) 1437 (eq (if (functionp set) (funcall set obj) set) 'hide)) 1438 (hide))))) 1439 (unless (oref obj keymap) 1440 (let ((type (oref obj type))) 1441 (oset obj keymap 1442 (or (let ((sym (intern (format "magit-%s-section-map" type)))) 1443 (and (boundp sym) sym)) 1444 (let ((sym (intern (format "forge-%s-section-map" type)))) 1445 (and (boundp sym) sym)))))) 1446 obj))) 1447 1448 (defun magit-insert-section--finish (obj) 1449 (run-hooks 'magit-insert-section-hook) 1450 (let ((beg (oref obj start)) 1451 (end (oset obj end 1452 (if magit-section-inhibit-markers 1453 (point) 1454 (point-marker)))) 1455 (props `( magit-section ,obj 1456 ,@(and-let* ((map (symbol-value (oref obj keymap)))) 1457 (list 'keymap map))))) 1458 (unless magit-section-inhibit-markers 1459 (set-marker-insertion-type beg t)) 1460 (cond ((eq obj magit-root-section)) 1461 ((oref obj children) 1462 (magit-insert-child-count obj) 1463 (magit-section-maybe-add-heading-map obj) 1464 (save-excursion 1465 (goto-char beg) 1466 (while (< (point) end) 1467 (let ((next (or (next-single-property-change 1468 (point) 'magit-section) 1469 end))) 1470 (unless (magit-section-at) 1471 (add-text-properties (point) next props)) 1472 (goto-char next))))) 1473 ((add-text-properties beg end props))) 1474 (cond ((eq obj magit-root-section) 1475 (when (eq magit-section-inhibit-markers 'delay) 1476 (setq magit-section-inhibit-markers nil) 1477 (magit-map-sections 1478 (lambda (section) 1479 (oset section start (copy-marker (oref section start) t)) 1480 (oset section end (copy-marker (oref section end) t))))) 1481 (let ((magit-section-cache-visibility nil)) 1482 (magit-section-show obj))) 1483 (magit-section-insert-in-reverse 1484 (push obj (oref (oref obj parent) children))) 1485 ((let ((parent (oref obj parent))) 1486 (oset parent children 1487 (nconc (oref parent children) 1488 (list obj)))))) 1489 (when magit-section-insert-in-reverse 1490 (oset obj children (nreverse (oref obj children)))))) 1491 1492 (defun magit-cancel-section (&optional if-empty) 1493 "Cancel inserting the section that is currently being inserted. 1494 1495 Canceling returns from the inner most use of `magit-insert-section' and 1496 removes all text that was inserted by that. 1497 1498 If optional IF-EMPTY is non-nil, then only cancel the section, if it is 1499 empty. If a section is split into a heading and a body (i.e., when its 1500 `content' slot is non-nil), then only check if the body is empty." 1501 (when (and magit-insert-section--current 1502 (or (not if-empty) 1503 (= (point) (or (oref magit-insert-section--current content) 1504 (oref magit-insert-section--current start))))) 1505 (if (eq magit-insert-section--current magit-root-section) 1506 (insert "(empty)\n") 1507 (delete-region (oref magit-insert-section--current start) 1508 (point)) 1509 (setq magit-insert-section--current nil) 1510 (throw 'cancel-section nil)))) 1511 1512 (defun magit-insert-heading (&rest args) 1513 "Insert the heading for the section currently being inserted. 1514 1515 This function should only be used inside `magit-insert-section'. 1516 1517 When called without any arguments, then just set the `content' 1518 slot of the object representing the section being inserted to 1519 a marker at `point'. The section should only contain a single 1520 line when this function is used like this. 1521 1522 When called with arguments ARGS, which have to be strings, or 1523 nil, then insert those strings at point. The section should not 1524 contain any text before this happens and afterwards it should 1525 again only contain a single line. If the `face' property is set 1526 anywhere inside any of these strings, then insert all of them 1527 unchanged. Otherwise use the `magit-section-heading' face for 1528 all inserted text. 1529 1530 The `content' property of the section object is the end of the 1531 heading (which lasts from `start' to `content') and the beginning 1532 of the the body (which lasts from `content' to `end'). If the 1533 value of `content' is nil, then the section has no heading and 1534 its body cannot be collapsed. If a section does have a heading, 1535 then its height must be exactly one line, including a trailing 1536 newline character. This isn't enforced, you are responsible for 1537 getting it right. The only exception is that this function does 1538 insert a newline character if necessary 1539 1540 If provided, optional CHILD-COUNT must evaluate to an integer or 1541 boolean. If t, then the count is determined once the children have been 1542 inserted, using `magit-insert-child-count' (which see). For historic 1543 reasons, if the heading ends with \":\", the count is substituted for 1544 that, at this time as well. If `magit-section-show-child-count' is nil, 1545 no counts are inserted 1546 1547 \n(fn [CHILD-COUNT] &rest STRINGS)" 1548 (declare (indent defun)) 1549 (when args 1550 (let ((count (and (or (integerp (car args)) 1551 (booleanp (car args))) 1552 (pop args))) 1553 (heading (apply #'concat args))) 1554 (insert (if (or (text-property-not-all 0 (length heading) 1555 'font-lock-face nil heading) 1556 (text-property-not-all 0 (length heading) 1557 'face nil heading)) 1558 heading 1559 (propertize heading 'font-lock-face 'magit-section-heading))) 1560 (when (and count magit-section-show-child-count) 1561 (insert (propertize (format " (%s)" count) 1562 'font-lock-face 'magit-section-child-count))))) 1563 (unless (bolp) 1564 (insert ?\n)) 1565 (when (fboundp 'magit-maybe-make-margin-overlay) 1566 (magit-maybe-make-margin-overlay)) 1567 (oset magit-insert-section--current content 1568 (if magit-section-inhibit-markers (point) (point-marker)))) 1569 1570 (defmacro magit-insert-section-body (&rest body) 1571 "Use BODY to insert the section body, once the section is expanded. 1572 If the section is expanded when it is created, then this is 1573 like `progn'. Otherwise BODY isn't evaluated until the section 1574 is explicitly expanded." 1575 (declare (indent 0)) 1576 (let ((f (cl-gensym)) 1577 (s (cl-gensym)) 1578 (l (cl-gensym))) 1579 `(let ((,f (lambda () ,@body))) 1580 (if (oref magit-insert-section--current hidden) 1581 (oset magit-insert-section--current washer 1582 (let ((,s magit-insert-section--current)) 1583 (lambda () 1584 (let ((,l (magit-section-lineage ,s t))) 1585 (dolist (s ,l) 1586 (set-marker-insertion-type (oref s end) t)) 1587 (funcall ,f) 1588 (dolist (s ,l) 1589 (set-marker-insertion-type (oref s end) nil)) 1590 (magit-section-maybe-remove-heading-map ,s) 1591 (magit-section-maybe-remove-visibility-indicator ,s))))) 1592 (funcall ,f))))) 1593 1594 (defun magit-insert-headers (hook) 1595 (let* ((header-sections nil) 1596 (magit-insert-section-hook 1597 (cons (lambda () 1598 (push magit-insert-section--current 1599 header-sections)) 1600 (if (listp magit-insert-section-hook) 1601 magit-insert-section-hook 1602 (list magit-insert-section-hook))))) 1603 (magit-run-section-hook hook) 1604 (when header-sections 1605 (insert "\n") 1606 ;; Make the first header into the parent of the rest. 1607 (when (cdr header-sections) 1608 (cl-callf nreverse header-sections) 1609 (let* ((1st-header (pop header-sections)) 1610 (header-parent (oref 1st-header parent))) 1611 (oset header-parent children (list 1st-header)) 1612 (oset 1st-header children header-sections) 1613 (oset 1st-header content (oref (car header-sections) start)) 1614 (oset 1st-header end (oref (car (last header-sections)) end)) 1615 (dolist (sub-header header-sections) 1616 (oset sub-header parent 1st-header)) 1617 (magit-section-maybe-add-heading-map 1st-header)))))) 1618 1619 (defun magit-section-maybe-add-heading-map (section) 1620 (when (magit-section-content-p section) 1621 (let ((start (oref section start)) 1622 (map (oref section keymap))) 1623 (when (symbolp map) 1624 (setq map (symbol-value map))) 1625 (put-text-property 1626 start 1627 (save-excursion 1628 (goto-char start) 1629 (line-end-position)) 1630 'keymap (if map 1631 (make-composed-keymap 1632 (list map magit-section-heading-map)) 1633 magit-section-heading-map))))) 1634 1635 (defun magit-section-maybe-remove-heading-map (section) 1636 (with-slots (start content end keymap) section 1637 (when (= content end) 1638 (put-text-property start end 'keymap keymap)))) 1639 1640 (defun magit-insert-child-count (section) 1641 "Modify SECTION's heading to contain number of child sections. 1642 1643 If `magit-section-show-child-count' is non-nil and the SECTION 1644 has children and its heading ends with \":\", then replace that 1645 with \" (N)\", where N is the number of child sections. 1646 1647 This function is called by `magit-insert-section' after that has 1648 evaluated its BODY. Admittedly that's a bit of a hack." 1649 (let (content count) 1650 (cond 1651 ((not (and magit-section-show-child-count 1652 (setq content (oref section content)) 1653 (setq count (length (oref section children))) 1654 (> count 0)))) 1655 ((eq (char-before (- content 1)) ?:) 1656 (save-excursion 1657 (goto-char (- content 2)) 1658 (insert (magit--propertize-face (format " (%s)" count) 1659 'magit-section-child-count)) 1660 (delete-char 1))) 1661 ((and (eq (char-before (- content 4)) ?\s) 1662 (eq (char-before (- content 3)) ?\() 1663 (eq (char-before (- content 2)) ?t ) 1664 (eq (char-before (- content 1)) ?\))) 1665 (save-excursion 1666 (goto-char (- content 3)) 1667 (delete-char 1) 1668 (insert (format "%s" count))))))) 1669 1670 ;;; Highlight 1671 1672 (defun magit-section-pre-command-hook () 1673 (when (and (or magit--context-menu-buffer 1674 magit--context-menu-section) 1675 (not (eq (ignore-errors 1676 (event-basic-type (aref (this-command-keys) 0))) 1677 'mouse-3))) 1678 ;; This is the earliest opportunity to clean up after an aborted 1679 ;; context-menu because that neither causes the command that created 1680 ;; the menu to abort nor some abortion hook to be run. It is not 1681 ;; possible to update highlighting before the first command invoked 1682 ;; after the menu is aborted. Here we can only make sure it is 1683 ;; updated afterwards. 1684 (magit-menu-highlight-point-section)) 1685 (setq magit-section-pre-command-region-p (region-active-p)) 1686 (setq magit-section-pre-command-section (magit-current-section))) 1687 1688 (defun magit-section-post-command-hook () 1689 (let ((window (selected-window))) 1690 ;; The command may have used `set-window-buffer' to change 1691 ;; the window's buffer without changing the current buffer. 1692 (when (eq (current-buffer) (window-buffer window)) 1693 (cursor-sensor-move-to-tangible window) 1694 (when (or magit--context-menu-buffer 1695 magit--context-menu-section) 1696 (magit-menu-highlight-point-section)))) 1697 (unless (memq this-command '(magit-refresh magit-refresh-all)) 1698 (magit-section-update-highlight))) 1699 1700 (defun magit-section-deactivate-mark () 1701 (setq magit-section-highlight-force-update t)) 1702 1703 (defun magit-section-update-highlight (&optional force) 1704 (let ((section (magit-current-section))) 1705 (when (or force 1706 magit-section-highlight-force-update 1707 (xor magit-section-pre-command-region-p (region-active-p)) 1708 (not (eq magit-section-pre-command-section section))) 1709 (let ((inhibit-read-only t) 1710 (deactivate-mark nil) 1711 (selection (magit-region-sections))) 1712 (mapc #'delete-overlay magit-section-highlight-overlays) 1713 (setq magit-section-highlight-overlays nil) 1714 (setq magit-section-unhighlight-sections 1715 magit-section-highlighted-sections) 1716 (setq magit-section-highlighted-sections nil) 1717 (if (and (fboundp 'long-line-optimizations-p) 1718 (long-line-optimizations-p)) 1719 (magit-section--enable-long-lines-shortcuts) 1720 (unless (eq section magit-root-section) 1721 (run-hook-with-args-until-success 1722 'magit-section-highlight-hook section selection)) 1723 (dolist (s magit-section-unhighlight-sections) 1724 (run-hook-with-args-until-success 1725 'magit-section-unhighlight-hook s selection))) 1726 (restore-buffer-modified-p nil))) 1727 (setq magit-section-highlight-force-update nil) 1728 (magit-section-maybe-paint-visibility-ellipses))) 1729 1730 (defun magit-section-highlight (section selection) 1731 "Highlight SECTION and if non-nil all sections in SELECTION. 1732 This function works for any section but produces undesirable 1733 effects for diff related sections, which by default are 1734 highlighted using `magit-diff-highlight'. Return t." 1735 (when-let ((face (oref section heading-highlight-face))) 1736 (dolist (section (or selection (list section))) 1737 (magit-section-make-overlay 1738 (oref section start) 1739 (or (oref section content) 1740 (oref section end)) 1741 face))) 1742 (cond (selection 1743 (magit-section-make-overlay (oref (car selection) start) 1744 (oref (car (last selection)) end) 1745 'magit-section-highlight) 1746 (magit-section-highlight-selection nil selection)) 1747 (t 1748 (magit-section-make-overlay (oref section start) 1749 (oref section end) 1750 'magit-section-highlight))) 1751 t) 1752 1753 (defun magit-section-highlight-selection (_ selection) 1754 "Highlight the section-selection region. 1755 If SELECTION is non-nil, then it is a list of sections selected by 1756 the region. The headings of these sections are then highlighted. 1757 1758 This is a fallback for people who don't want to highlight the 1759 current section and therefore removed `magit-section-highlight' 1760 from `magit-section-highlight-hook'. 1761 1762 This function is necessary to ensure that a representation of 1763 such a region is visible. If neither of these functions were 1764 part of the hook variable, then such a region would be 1765 invisible." 1766 (when (and selection 1767 (not (and (eq this-command 'mouse-drag-region)))) 1768 (dolist (section selection) 1769 (magit-section-make-overlay (oref section start) 1770 (or (oref section content) 1771 (oref section end)) 1772 'magit-section-heading-selection)) 1773 t)) 1774 1775 (defun magit-section-make-overlay (start end face) 1776 ;; Yes, this doesn't belong here. But the alternative of 1777 ;; spreading this hack across the code base is even worse. 1778 (when (and magit-section-keep-region-overlay 1779 (memq face '(magit-section-heading-selection 1780 magit-diff-file-heading-selection 1781 magit-diff-hunk-heading-selection))) 1782 (setq face (list :foreground (face-foreground face)))) 1783 (let ((ov (make-overlay start end nil t))) 1784 (overlay-put ov 'font-lock-face face) 1785 (overlay-put ov 'evaporate t) 1786 (push ov magit-section-highlight-overlays) 1787 ov)) 1788 1789 (defvar magit-show-long-lines-warning t) 1790 1791 (defun magit-section--enable-long-lines-shortcuts () 1792 (message "Enabling long lines shortcuts in %S" (current-buffer)) 1793 (kill-local-variable 'redisplay-highlight-region-function) 1794 (kill-local-variable 'redisplay-unhighlight-region-function) 1795 (when magit-show-long-lines-warning 1796 (setq magit-show-long-lines-warning nil) 1797 (display-warning 'magit (format "\ 1798 Emacs has enabled redisplay shortcuts 1799 in this buffer because there are lines whose length go beyond 1800 `long-line-threshold' \(%s characters). As a result, section 1801 highlighting and the special appearance of the region has been 1802 disabled. Some existing highlighting might remain in effect. 1803 1804 These shortcuts remain enabled, even once there no longer are 1805 any long lines in this buffer. To disable them again, kill 1806 and recreate the buffer. 1807 1808 This message won't be shown for this session again. To disable 1809 it for all future sessions, set `magit-show-long-lines-warning' 1810 to nil." (bound-and-true-p long-line-threshold)) :warning))) 1811 1812 (cl-defgeneric magit-section-get-relative-position (section)) 1813 1814 (cl-defmethod magit-section-get-relative-position ((section magit-section)) 1815 (let ((start (oref section start)) 1816 (point (magit-point))) 1817 (list (- (line-number-at-pos point) 1818 (line-number-at-pos start)) 1819 (- point (line-beginning-position))))) 1820 1821 (cl-defgeneric magit-section-goto-successor ()) 1822 1823 (cl-defmethod magit-section-goto-successor ((section magit-section) 1824 line char &optional _arg) 1825 (or (magit-section-goto-successor--same section line char) 1826 (magit-section-goto-successor--related section))) 1827 1828 (defun magit-section-goto-successor--same (section line char) 1829 (let ((ident (magit-section-ident section))) 1830 (and-let* ((found (magit-get-section ident))) 1831 (let ((start (oref found start))) 1832 (goto-char start) 1833 (unless (eq found magit-root-section) 1834 (ignore-errors 1835 (forward-line line) 1836 (forward-char char)) 1837 (unless (eq (magit-current-section) found) 1838 (goto-char start))) 1839 t)))) 1840 1841 (defun magit-section-goto-successor--related (section) 1842 (and-let* ((found (magit-section-goto-successor--related-1 section))) 1843 (goto-char (if (eq (oref found type) 'button) 1844 (point-min) 1845 (oref found start))))) 1846 1847 (defun magit-section-goto-successor--related-1 (section) 1848 (or (and-let* ((alt (pcase (oref section type) 1849 ('staged 'unstaged) 1850 ('unstaged 'staged) 1851 ('unpushed 'unpulled) 1852 ('unpulled 'unpushed)))) 1853 (magit-get-section `((,alt) (status)))) 1854 (and-let* ((next (car (magit-section-siblings section 'next)))) 1855 (magit-get-section (magit-section-ident next))) 1856 (and-let* ((prev (car (magit-section-siblings section 'prev)))) 1857 (magit-get-section (magit-section-ident prev))) 1858 (and-let* ((parent (oref section parent))) 1859 (or (magit-get-section (magit-section-ident parent)) 1860 (magit-section-goto-successor--related-1 parent))))) 1861 1862 ;;; Region 1863 1864 (defvar-local magit-section--region-overlays nil) 1865 1866 (defun magit-section--delete-region-overlays () 1867 (mapc #'delete-overlay magit-section--region-overlays) 1868 (setq magit-section--region-overlays nil)) 1869 1870 (defun magit-section--highlight-region (start end window rol) 1871 (magit-section--delete-region-overlays) 1872 (if (and (not magit-section-keep-region-overlay) 1873 (or (magit-region-sections) 1874 (run-hook-with-args-until-success 'magit-region-highlight-hook 1875 (magit-current-section))) 1876 (not (= (line-number-at-pos start) 1877 (line-number-at-pos end))) 1878 ;; (not (eq (car-safe last-command-event) 'mouse-movement)) 1879 ) 1880 (funcall (default-value 'redisplay-unhighlight-region-function) rol) 1881 (funcall (default-value 'redisplay-highlight-region-function) 1882 start end window rol))) 1883 1884 (defun magit-section--unhighlight-region (rol) 1885 (magit-section--delete-region-overlays) 1886 (funcall (default-value 'redisplay-unhighlight-region-function) rol)) 1887 1888 ;;; Visibility 1889 1890 (defvar-local magit-section-visibility-cache nil) 1891 (put 'magit-section-visibility-cache 'permanent-local t) 1892 1893 (defun magit-section-cached-visibility (section) 1894 "Set SECTION's visibility to the cached value. 1895 When `magit-section-preserve-visibility' is nil, do nothing." 1896 (and magit-section-preserve-visibility 1897 (cdr (assoc (magit-section-ident section) 1898 magit-section-visibility-cache)))) 1899 1900 (cl-defun magit-section-cache-visibility 1901 (&optional (section magit-insert-section--current)) 1902 (setf (compat-call alist-get 1903 (magit-section-ident section) 1904 magit-section-visibility-cache 1905 nil nil #'equal) 1906 (if (oref section hidden) 'hide 'show))) 1907 1908 (cl-defun magit-section-maybe-cache-visibility 1909 (&optional (section magit-insert-section--current)) 1910 (when (or (eq magit-section-cache-visibility t) 1911 (memq (oref section type) 1912 magit-section-cache-visibility)) 1913 (magit-section-cache-visibility section))) 1914 1915 (defun magit-section-maybe-update-visibility-indicator (section) 1916 (when (and magit-section-visibility-indicator 1917 (magit-section-content-p section)) 1918 (let* ((beg (oref section start)) 1919 (eoh (save-excursion 1920 (goto-char beg) 1921 (line-end-position)))) 1922 (cond 1923 ((symbolp (car-safe magit-section-visibility-indicator)) 1924 (let ((ov (magit--overlay-at beg 'magit-vis-indicator 'fringe))) 1925 (unless ov 1926 (setq ov (make-overlay beg eoh nil t)) 1927 (overlay-put ov 'evaporate t) 1928 (overlay-put ov 'magit-vis-indicator 'fringe)) 1929 (overlay-put 1930 ov 'before-string 1931 (propertize "fringe" 'display 1932 (list 'left-fringe 1933 (if (oref section hidden) 1934 (car magit-section-visibility-indicator) 1935 (cdr magit-section-visibility-indicator)) 1936 'fringe))))) 1937 ((stringp (car-safe magit-section-visibility-indicator)) 1938 (let ((ov (magit--overlay-at (1- eoh) 'magit-vis-indicator 'eoh))) 1939 (cond ((oref section hidden) 1940 (unless ov 1941 (setq ov (make-overlay (1- eoh) eoh)) 1942 (overlay-put ov 'evaporate t) 1943 (overlay-put ov 'magit-vis-indicator 'eoh)) 1944 (overlay-put ov 'after-string 1945 (car magit-section-visibility-indicator))) 1946 (ov 1947 (delete-overlay ov))))))))) 1948 1949 (defvar-local magit--ellipses-sections nil) 1950 1951 (defun magit-section-maybe-paint-visibility-ellipses () 1952 ;; This is needed because we hide the body instead of "the body 1953 ;; except the final newline and additionally the newline before 1954 ;; the body"; otherwise we could use `buffer-invisibility-spec'. 1955 (when (stringp (car-safe magit-section-visibility-indicator)) 1956 (let* ((sections (append magit--ellipses-sections 1957 (setq magit--ellipses-sections 1958 (or (magit-region-sections) 1959 (list (magit-current-section)))))) 1960 (beg (--map (oref it start) sections)) 1961 (end (--map (oref it end) sections))) 1962 (when (region-active-p) 1963 ;; This ensures that the region face is removed from ellipses 1964 ;; when the region becomes inactive, but fails to ensure that 1965 ;; all ellipses within the active region use the region face, 1966 ;; because the respective overlay has not yet been updated at 1967 ;; this time. The magit-selection face is always applied. 1968 (push (region-beginning) beg) 1969 (push (region-end) end)) 1970 (setq beg (apply #'min beg)) 1971 (setq end (apply #'max end)) 1972 (dolist (ov (overlays-in beg end)) 1973 (when (eq (overlay-get ov 'magit-vis-indicator) 'eoh) 1974 (overlay-put 1975 ov 'after-string 1976 (propertize 1977 (car magit-section-visibility-indicator) 'font-lock-face 1978 (let ((pos (overlay-start ov))) 1979 (delq nil (nconc (--map (overlay-get it 'font-lock-face) 1980 (overlays-at pos)) 1981 (list (get-char-property 1982 pos 'font-lock-face)))))))))))) 1983 1984 (defun magit-section-maybe-remove-visibility-indicator (section) 1985 (when (and magit-section-visibility-indicator 1986 (= (oref section content) 1987 (oref section end))) 1988 (dolist (o (overlays-in (oref section start) 1989 (save-excursion 1990 (goto-char (oref section start)) 1991 (1+ (line-end-position))))) 1992 (when (overlay-get o 'magit-vis-indicator) 1993 (delete-overlay o))))) 1994 1995 (defvar-local magit-section--opened-sections nil) 1996 1997 (defun magit-section--open-temporarily (beg end) 1998 (save-excursion 1999 (goto-char beg) 2000 (let ((section (magit-current-section))) 2001 (while section 2002 (let ((content (oref section content))) 2003 (if (and (magit-section-invisible-p section) 2004 (<= (or content (oref section start)) 2005 beg 2006 (oref section end))) 2007 (progn 2008 (when content 2009 (magit-section-show section) 2010 (push section magit-section--opened-sections)) 2011 (setq section (oref section parent))) 2012 (setq section nil)))))) 2013 (or (eq search-invisible t) 2014 (not (isearch-range-invisible beg end)))) 2015 2016 (define-advice isearch-clean-overlays (:around (fn) magit-mode) 2017 (if (derived-mode-p 'magit-mode) 2018 (let ((pos (point))) 2019 (dolist (section magit-section--opened-sections) 2020 (unless (<= (oref section content) pos (oref section end)) 2021 (magit-section-hide section))) 2022 (setq magit-section--opened-sections nil)) 2023 (funcall fn))) 2024 2025 ;;; Utilities 2026 2027 (cl-defun magit-section-selected-p (section &optional (selection nil sselection)) 2028 (and (not (eq section magit-root-section)) 2029 (or (eq section (magit-current-section)) 2030 (memq section (if sselection 2031 selection 2032 (setq selection (magit-region-sections)))) 2033 (and-let* ((parent (oref section parent))) 2034 (magit-section-selected-p parent selection))))) 2035 2036 (defun magit-section-parent-value (section) 2037 (and-let* ((parent (oref section parent))) 2038 (oref parent value))) 2039 2040 (defun magit-section-siblings (section &optional direction) 2041 "Return a list of the sibling sections of SECTION. 2042 2043 If optional DIRECTION is `prev', then return siblings that come 2044 before SECTION. If it is `next', then return siblings that come 2045 after SECTION. For all other values, return all siblings 2046 excluding SECTION itself." 2047 (and-let* ((parent (oref section parent)) 2048 (siblings (oref parent children))) 2049 (pcase direction 2050 ('prev (cdr (member section (reverse siblings)))) 2051 ('next (cdr (member section siblings))) 2052 (_ (remq section siblings))))) 2053 2054 (defun magit-region-values (&optional condition multiple) 2055 "Return a list of the values of the selected sections. 2056 2057 Return the values that themselves would be returned by 2058 `magit-region-sections' (which see)." 2059 (--map (oref it value) 2060 (magit-region-sections condition multiple))) 2061 2062 (defun magit-region-sections (&optional condition multiple) 2063 "Return a list of the selected sections. 2064 2065 When the region is active and constitutes a valid section 2066 selection, then return a list of all selected sections. This is 2067 the case when the region begins in the heading of a section and 2068 ends in the heading of the same section or in that of a sibling 2069 section. If optional MULTIPLE is non-nil, then the region cannot 2070 begin and end in the same section. 2071 2072 When the selection is not valid, then return nil. In this case, 2073 most commands that can act on the selected sections will instead 2074 act on the section at point. 2075 2076 When the region looks like it would in any other buffer then 2077 the selection is invalid. When the selection is valid then the 2078 region uses the `magit-section-highlight' face. This does not 2079 apply to diffs where things get a bit more complicated, but even 2080 here if the region looks like it usually does, then that's not 2081 a valid selection as far as this function is concerned. 2082 2083 If optional CONDITION is non-nil, then the selection not only 2084 has to be valid; all selected sections additionally have to match 2085 CONDITION, or nil is returned. See `magit-section-match' for the 2086 forms CONDITION can take." 2087 (and (region-active-p) 2088 (let* ((rbeg (region-beginning)) 2089 (rend (region-end)) 2090 (sbeg (magit-section-at rbeg)) 2091 (send (magit-section-at rend))) 2092 (and send 2093 (not (eq send magit-root-section)) 2094 (not (and multiple (eq send sbeg))) 2095 (let ((siblings (cons sbeg (magit-section-siblings sbeg 'next))) 2096 (sections ())) 2097 (and (memq send siblings) 2098 (magit-section-position-in-heading-p sbeg rbeg) 2099 (magit-section-position-in-heading-p send rend) 2100 (progn 2101 (while siblings 2102 (push (car siblings) sections) 2103 (when (eq (pop siblings) send) 2104 (setq siblings nil))) 2105 (setq sections (nreverse sections)) 2106 (and (or (not condition) 2107 (--all-p (magit-section-match condition it) 2108 sections)) 2109 sections)))))))) 2110 2111 (defun magit-map-sections (function &optional section) 2112 "Apply FUNCTION to all sections for side effects only, depth first. 2113 If optional SECTION is non-nil, only map over that section and 2114 its descendants, otherwise map over all sections in the current 2115 buffer, ending with `magit-root-section'." 2116 (let ((section (or section magit-root-section))) 2117 (mapc (lambda (child) (magit-map-sections function child)) 2118 (oref section children)) 2119 (funcall function section))) 2120 2121 (defun magit-section-position-in-heading-p (&optional section pos) 2122 "Return t if POSITION is inside the heading of SECTION. 2123 POSITION defaults to point and SECTION defaults to the 2124 current section." 2125 (unless section 2126 (setq section (magit-current-section))) 2127 (unless pos 2128 (setq pos (point))) 2129 (ignore-errors ; Allow navigating broken sections. 2130 (and section 2131 (>= pos (oref section start)) 2132 (< pos (or (oref section content) 2133 (oref section end))) 2134 t))) 2135 2136 (defun magit-section-internal-region-p (&optional section) 2137 "Return t if the region is active and inside SECTION's body. 2138 If optional SECTION is nil, use the current section." 2139 (and (region-active-p) 2140 (or section (setq section (magit-current-section))) 2141 (let ((beg (magit-section-at (region-beginning)))) 2142 (and (eq beg (magit-section-at (region-end))) 2143 (eq beg section))) 2144 (not (or (magit-section-position-in-heading-p section (region-beginning)) 2145 (magit-section-position-in-heading-p section (region-end)))) 2146 t)) 2147 2148 (defun magit-wash-sequence (function) 2149 "Repeatedly call FUNCTION until it returns nil or eob is reached. 2150 FUNCTION has to move point forward or return nil." 2151 (while (and (not (eobp)) (funcall function)))) 2152 2153 ;;;###autoload 2154 (defun magit-add-section-hook (hook function &optional at append local) 2155 "Add to the value of section hook HOOK the function FUNCTION. 2156 2157 Add FUNCTION at the beginning of the hook list unless optional 2158 APPEND is non-nil, in which case FUNCTION is added at the end. 2159 If FUNCTION already is a member, then move it to the new location. 2160 2161 If optional AT is non-nil and a member of the hook list, then 2162 add FUNCTION next to that instead. Add before or after AT, or 2163 replace AT with FUNCTION depending on APPEND. If APPEND is the 2164 symbol `replace', then replace AT with FUNCTION. For any other 2165 non-nil value place FUNCTION right after AT. If nil, then place 2166 FUNCTION right before AT. If FUNCTION already is a member of the 2167 list but AT is not, then leave FUNCTION where ever it already is. 2168 2169 If optional LOCAL is non-nil, then modify the hook's buffer-local 2170 value rather than its global value. This makes the hook local by 2171 copying the default value. That copy is then modified. 2172 2173 HOOK should be a symbol. If HOOK is void, it is first set to nil. 2174 HOOK's value must not be a single hook function. FUNCTION should 2175 be a function that takes no arguments and inserts one or multiple 2176 sections at point, moving point forward. FUNCTION may choose not 2177 to insert its section(s), when doing so would not make sense. It 2178 should not be abused for other side-effects. To remove FUNCTION 2179 again use `remove-hook'." 2180 (unless (boundp hook) 2181 (error "Cannot add function to undefined hook variable %s" hook)) 2182 (unless (default-boundp hook) 2183 (set-default hook nil)) 2184 (let ((value (if local 2185 (if (local-variable-p hook) 2186 (symbol-value hook) 2187 (unless (local-variable-if-set-p hook) 2188 (make-local-variable hook)) 2189 (copy-sequence (default-value hook))) 2190 (default-value hook)))) 2191 (if at 2192 (when (setq at (member at value)) 2193 (setq value (delq function value)) 2194 (cond ((eq append 'replace) 2195 (setcar at function)) 2196 (append 2197 (push function (cdr at))) 2198 (t 2199 (push (car at) (cdr at)) 2200 (setcar at function)))) 2201 (setq value (delq function value))) 2202 (unless (member function value) 2203 (setq value (if append 2204 (append value (list function)) 2205 (cons function value)))) 2206 (when (eq append 'replace) 2207 (setq value (delq at value))) 2208 (if local 2209 (set hook value) 2210 (set-default hook value)))) 2211 2212 (defvar-local magit-disabled-section-inserters nil) 2213 2214 (defun magit-disable-section-inserter (fn) 2215 "Disable the section inserter FN in the current repository. 2216 It is only intended for use in \".dir-locals.el\" and 2217 \".dir-locals-2.el\". Also see info node `(magit)Per-Repository 2218 Configuration'." 2219 (cl-pushnew fn magit-disabled-section-inserters)) 2220 2221 (put 'magit-disable-section-inserter 'safe-local-eval-function t) 2222 2223 (defun magit-run-section-hook (hook &rest args) 2224 "Run HOOK with ARGS, warning about invalid entries." 2225 (let ((entries (symbol-value hook))) 2226 (unless (listp entries) 2227 (setq entries (list entries))) 2228 (when-let ((invalid (seq-remove #'functionp entries))) 2229 (message "`%s' contains entries that are no longer valid. 2230 %s\nUsing standard value instead. Please re-configure hook variable." 2231 hook 2232 (mapconcat (lambda (sym) (format " `%s'" sym)) invalid "\n")) 2233 (sit-for 5) 2234 (setq entries (eval (car (get hook 'standard-value))))) 2235 (dolist (entry entries) 2236 (let ((magit--current-section-hook (cons (list hook entry) 2237 magit--current-section-hook))) 2238 (unless (memq entry magit-disabled-section-inserters) 2239 (if (bound-and-true-p magit-refresh-verbose) 2240 (let ((time (benchmark-elapse (apply entry args)))) 2241 (message " %-50s %f %s" entry time 2242 (cond ((> time 0.03) "!!") 2243 ((> time 0.01) "!") 2244 (t "")))) 2245 (apply entry args))))))) 2246 2247 (cl-defun magit--overlay-at (pos prop &optional (val nil sval) testfn) 2248 (cl-find-if (lambda (o) 2249 (let ((p (overlay-properties o))) 2250 (and (plist-member p prop) 2251 (or (not sval) 2252 (funcall (or testfn #'eql) 2253 (plist-get p prop) 2254 val))))) 2255 (overlays-at pos t))) 2256 2257 (defun magit-face-property-all (face string) 2258 "Return non-nil if FACE is present in all of STRING." 2259 (catch 'missing 2260 (let ((pos 0)) 2261 (while (setq pos (next-single-property-change pos 'font-lock-face string)) 2262 (let ((val (get-text-property pos 'font-lock-face string))) 2263 (unless (if (consp val) 2264 (memq face val) 2265 (eq face val)) 2266 (throw 'missing nil)))) 2267 (not pos)))) 2268 2269 (defun magit--add-face-text-property (beg end face &optional append object) 2270 "Like `add-face-text-property' but for `font-lock-face'." 2271 (while (< beg end) 2272 (let* ((pos (next-single-property-change beg 'font-lock-face object end)) 2273 (val (get-text-property beg 'font-lock-face object)) 2274 (val (if (listp val) val (list val)))) 2275 (put-text-property beg pos 'font-lock-face 2276 (if append 2277 (append val (list face)) 2278 (cons face val)) 2279 object) 2280 (setq beg pos)))) 2281 2282 (defun magit--propertize-face (string face) 2283 (propertize string 'face face 'font-lock-face face)) 2284 2285 (defun magit--put-face (beg end face string) 2286 (put-text-property beg end 'face face string) 2287 (put-text-property beg end 'font-lock-face face string)) 2288 2289 ;;; Imenu Support 2290 2291 (defvar-local magit--imenu-group-types nil) 2292 (defvar-local magit--imenu-item-types nil) 2293 2294 (defun magit--imenu-create-index () 2295 ;; If `which-function-mode' is active, then the create-index 2296 ;; function is called at the time the major-mode is being enabled. 2297 ;; Modes that derive from `magit-mode' have not populated the buffer 2298 ;; at that time yet, so we have to abort. 2299 (and magit-root-section 2300 (or magit--imenu-group-types 2301 magit--imenu-item-types) 2302 (let ((index 2303 (cl-mapcan 2304 (lambda (section) 2305 (cond 2306 (magit--imenu-group-types 2307 (and (if (eq (car-safe magit--imenu-group-types) 'not) 2308 (not (magit-section-match 2309 (cdr magit--imenu-group-types) 2310 section)) 2311 (magit-section-match magit--imenu-group-types section)) 2312 (and-let* ((children (oref section children))) 2313 `((,(magit--imenu-index-name section) 2314 ,@(mapcar (lambda (s) 2315 (cons (magit--imenu-index-name s) 2316 (oref s start))) 2317 children)))))) 2318 (magit--imenu-item-types 2319 (and (magit-section-match magit--imenu-item-types section) 2320 `((,(magit--imenu-index-name section) 2321 . ,(oref section start))))))) 2322 (oref magit-root-section children)))) 2323 (if (and magit--imenu-group-types (symbolp magit--imenu-group-types)) 2324 (cdar index) 2325 index)))) 2326 2327 (defun magit--imenu-index-name (section) 2328 (let ((heading (buffer-substring-no-properties 2329 (oref section start) 2330 (1- (or (oref section content) 2331 (oref section end)))))) 2332 (save-match-data 2333 (cond 2334 ((and (magit-section-match [commit logbuf] section) 2335 (string-match "[^ ]+\\([ *|]*\\).+" heading)) 2336 (replace-match " " t t heading 1)) 2337 ((magit-section-match 2338 '([branch local branchbuf] [tag tags branchbuf]) section) 2339 (oref section value)) 2340 ((magit-section-match [branch remote branchbuf] section) 2341 (concat (oref (oref section parent) value) "/" 2342 (oref section value))) 2343 ((string-match " ([0-9]+)\\'" heading) 2344 (substring heading 0 (match-beginning 0))) 2345 (t heading))))) 2346 2347 (defun magit--imenu-goto-function (_name position &rest _rest) 2348 "Go to the section at POSITION. 2349 Make sure it is visible, by showing its ancestors where 2350 necessary. For use as `imenu-default-goto-function' in 2351 `magit-mode' buffers." 2352 (goto-char position) 2353 (let ((section (magit-current-section))) 2354 (while (setq section (oref section parent)) 2355 (when (oref section hidden) 2356 (magit-section-show section))))) 2357 2358 ;;; Bookmark support 2359 2360 (declare-function bookmark-get-filename "bookmark" (bookmark-name-or-record)) 2361 (declare-function bookmark-make-record-default "bookmark" 2362 (&optional no-file no-context posn)) 2363 (declare-function bookmark-prop-get "bookmark" (bookmark-name-or-record prop)) 2364 (declare-function bookmark-prop-set "bookmark" (bookmark-name-or-record prop val)) 2365 2366 (cl-defgeneric magit-bookmark-get-filename () 2367 (or (buffer-file-name) (buffer-name))) 2368 2369 (cl-defgeneric magit-bookmark--get-child-value (section) 2370 (oref section value)) 2371 2372 (cl-defgeneric magit-bookmark-get-buffer-create (bookmark mode)) 2373 2374 (defun magit--make-bookmark () 2375 "Create a bookmark for the current Magit buffer. 2376 Input values are the major-mode's `magit-bookmark-name' method, 2377 and the buffer-local values of the variables referenced in its 2378 `magit-bookmark-variables' property." 2379 (require 'bookmark) 2380 (if (plist-member (symbol-plist major-mode) 'magit-bookmark-variables) 2381 ;; `bookmark-make-record-default's return value does not match 2382 ;; (NAME . ALIST), even though it is used as the default value 2383 ;; of `bookmark-make-record-function', which states that such 2384 ;; functions must do that. See #4356. 2385 (let ((bookmark (cons nil (bookmark-make-record-default 'no-file)))) 2386 (bookmark-prop-set bookmark 'handler #'magit--handle-bookmark) 2387 (bookmark-prop-set bookmark 'mode major-mode) 2388 (bookmark-prop-set bookmark 'filename (magit-bookmark-get-filename)) 2389 (bookmark-prop-set bookmark 'defaults (list (magit-bookmark-name))) 2390 (dolist (var (get major-mode 'magit-bookmark-variables)) 2391 (bookmark-prop-set bookmark var (symbol-value var))) 2392 (bookmark-prop-set 2393 bookmark 'magit-hidden-sections 2394 (--keep (and (oref it hidden) 2395 (cons (oref it type) 2396 (magit-bookmark--get-child-value it))) 2397 (oref magit-root-section children))) 2398 bookmark) 2399 (user-error "Bookmarking is not implemented for %s buffers" major-mode))) 2400 2401 ;;;###autoload 2402 (defun magit--handle-bookmark (bookmark) 2403 "Open a bookmark created by `magit--make-bookmark'. 2404 2405 Call the generic function `magit-bookmark-get-buffer-create' to get 2406 the appropriate buffer without displaying it. 2407 2408 Then call the `magit-*-setup-buffer' function of the the major-mode 2409 with the variables' values as arguments, which were recorded by 2410 `magit--make-bookmark'." 2411 (require (quote magit-bookmark) nil t) 2412 (let ((buffer (magit-bookmark-get-buffer-create 2413 bookmark 2414 (bookmark-prop-get bookmark 'mode)))) 2415 (set-buffer buffer) ; That is the interface we have to adhere to. 2416 (when-let ((hidden (bookmark-prop-get bookmark 'magit-hidden-sections))) 2417 (with-current-buffer buffer 2418 (dolist (child (oref magit-root-section children)) 2419 (if (member (cons (oref child type) 2420 (oref child value)) 2421 hidden) 2422 (magit-section-hide child) 2423 (magit-section-show child))))) 2424 ;; Compatibility with `bookmark+' package. See #4356. 2425 (when (bound-and-true-p bmkp-jump-display-function) 2426 (funcall bmkp-jump-display-function (current-buffer))) 2427 nil)) 2428 2429 (put 'magit--handle-bookmark 'bookmark-handler-type "Magit") 2430 2431 (cl-defgeneric magit-bookmark-name () 2432 "Return name for bookmark to current buffer." 2433 (format "%s%s" 2434 (substring (symbol-name major-mode) 0 -5) 2435 (if-let ((vars (get major-mode 'magit-bookmark-variables))) 2436 (cl-mapcan (lambda (var) 2437 (let ((val (symbol-value var))) 2438 (if (and val (atom val)) 2439 (list val) 2440 val))) 2441 vars) 2442 ""))) 2443 2444 ;;; Bitmaps 2445 2446 (when (fboundp 'define-fringe-bitmap) ;for Emacs 26 2447 (define-fringe-bitmap 'magit-fringe-bitmap+ 2448 [#b00000000 2449 #b00011000 2450 #b00011000 2451 #b01111110 2452 #b01111110 2453 #b00011000 2454 #b00011000 2455 #b00000000]) 2456 2457 (define-fringe-bitmap 'magit-fringe-bitmap- 2458 [#b00000000 2459 #b00000000 2460 #b00000000 2461 #b01111110 2462 #b01111110 2463 #b00000000 2464 #b00000000 2465 #b00000000]) 2466 2467 (define-fringe-bitmap 'magit-fringe-bitmap> 2468 [#b01100000 2469 #b00110000 2470 #b00011000 2471 #b00001100 2472 #b00011000 2473 #b00110000 2474 #b01100000 2475 #b00000000]) 2476 2477 (define-fringe-bitmap 'magit-fringe-bitmapv 2478 [#b00000000 2479 #b10000010 2480 #b11000110 2481 #b01101100 2482 #b00111000 2483 #b00010000 2484 #b00000000 2485 #b00000000]) 2486 2487 (define-fringe-bitmap 'magit-fringe-bitmap-bold> 2488 [#b11100000 2489 #b01110000 2490 #b00111000 2491 #b00011100 2492 #b00011100 2493 #b00111000 2494 #b01110000 2495 #b11100000]) 2496 2497 (define-fringe-bitmap 'magit-fringe-bitmap-boldv 2498 [#b10000001 2499 #b11000011 2500 #b11100111 2501 #b01111110 2502 #b00111100 2503 #b00011000 2504 #b00000000 2505 #b00000000]) 2506 ) 2507 2508 ;;; _ 2509 (provide 'magit-section) 2510 ;;; magit-section.el ends here