magit-section.el (104775B)
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: 20241102.1300 12 ;; Package-Revision: 4992c3d1f64e 13 ;; Package-Requires: ( 14 ;; (emacs "26.1") 15 ;; (compat "30.0.0.0") 16 ;; (dash "2.19.1") 17 ;; (seq "2.24")) 18 19 ;; SPDX-License-Identifier: GPL-3.0-or-later 20 21 ;; Magit is free software: you can redistribute it and/or modify 22 ;; it under the terms of the GNU General Public License as published 23 ;; by the Free Software Foundation, either version 3 of the License, 24 ;; or (at your option) any later version. 25 ;; 26 ;; Magit is distributed in the hope that it will be useful, 27 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 28 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 29 ;; GNU General Public License for more details. 30 ;; 31 ;; You should have received a copy of the GNU General Public License 32 ;; along with Magit. If not, see <https://www.gnu.org/licenses/>. 33 34 ;; You should have received a copy of the AUTHORS.md file, which 35 ;; lists all contributors. If not, see https://magit.vc/authors. 36 37 ;;; Commentary: 38 39 ;; This package implements the main user interface of Magit — the 40 ;; collapsible sections that make up its buffers. This package used 41 ;; to be distributed as part of Magit but now it can also be used by 42 ;; other packages that have nothing to do with Magit or Git. 43 44 ;;; Code: 45 46 (require 'cl-lib) 47 (require 'compat) 48 (require 'dash) 49 (require 'eieio) 50 (require 'subr-x) 51 52 ;; For older Emacs releases we depend on an updated `seq' release from GNU 53 ;; ELPA, for `seq-keep'. Unfortunately something else may require `seq' 54 ;; before `package' had a chance to put this version on the `load-path'. 55 (when (and (featurep 'seq) 56 (not (fboundp 'seq-keep))) 57 (unload-feature 'seq 'force)) 58 (require 'seq) 59 ;; Furthermore, by default `package' just silently refuses to upgrade. 60 (defconst magit--core-upgrade-instructions "\ 61 Magit requires `%s' >= %s, 62 but due to bad defaults, Emacs' package manager, refuses to 63 upgrade this and other built-in packages to higher releases 64 from GNU Elpa. 65 66 To fix this, you have to add this to your init file: 67 68 (setq package-install-upgrade-built-in t) 69 70 Then evaluate that expression by placing the cursor after it 71 and typing \\[eval-last-sexp]. 72 73 Once you have done that, you have to explicitly upgrade `%s': 74 75 \\[package-install] %s \\`RET' 76 77 Then you also must make sure the updated version is loaded, 78 by evaluating this form: 79 80 (progn (unload-feature \\='%s t) (require \\='%s)) 81 82 If this does not work, then try uninstalling Magit and all of its 83 dependencies. After that exit and restart Emacs, and only then 84 reinstalling Magit. 85 86 If you don't use the `package' package manager but still get 87 this warning, then your chosen package manager likely has a 88 similar defect.") 89 (unless (fboundp 'seq-keep) 90 (display-warning 'magit (substitute-command-keys 91 (format magit--core-upgrade-instructions 92 'seq "2.24" 'seq 'seq 'seq 'seq)) 93 :emergency)) 94 95 (require 'cursor-sensor) 96 (require 'format-spec) 97 98 (eval-when-compile (require 'benchmark)) 99 100 ;; For `magit-section-get-relative-position' 101 (declare-function magit-hunk-section-p "magit-diff" (section) t) 102 103 ;;; Hooks 104 105 (defvar magit-section-movement-hook nil 106 "Hook run by `magit-section-goto'. 107 That function in turn is used by all section movement commands.") 108 109 (defvar magit-section-highlight-hook 110 '(magit-section-highlight 111 magit-section-highlight-selection) 112 "Functions used to highlight the current section. 113 Each function is run with the current section as only argument 114 until one of them returns non-nil.") 115 116 (defvar magit-section-unhighlight-hook nil 117 "Functions used to unhighlight the previously current section. 118 Each function is run with the current section as only argument 119 until one of them returns non-nil. Most sections are properly 120 unhighlighted without requiring a specialized unhighlighter, 121 diff-related sections being the only exception.") 122 123 (defvar magit-section-set-visibility-hook 124 '(magit-section-cached-visibility) 125 "Hook used to set the initial visibility of a section. 126 Stop at the first function that returns non-nil. The returned 127 value should be `show', `hide' or nil. If no function returns 128 non-nil, determine the visibility as usual, i.e., use the 129 hardcoded section specific default (see `magit-insert-section').") 130 131 ;;; Options 132 133 (defgroup magit-section nil 134 "Expandable sections." 135 :link '(info-link "(magit)Sections") 136 :group 'extensions) 137 138 (defcustom magit-section-show-child-count t 139 "Whether to append the number of children to section headings. 140 This only applies to sections for which doing so makes sense." 141 :package-version '(magit-section . "2.1.0") 142 :group 'magit-section 143 :type 'boolean) 144 145 (defcustom magit-section-cache-visibility t 146 "Whether to cache visibility of sections. 147 148 Sections always retain their visibility state when they are being 149 recreated during a refresh. But if a section disappears and then 150 later reappears again, then this option controls whether this is 151 the case. 152 153 If t, then cache the visibility of all sections. If a list of 154 section types, then only do so for matching sections. If nil, 155 then don't do so for any sections." 156 :package-version '(magit-section . "2.12.0") 157 :group 'magit-section 158 :type '(choice (const :tag "Don't cache visibility" nil) 159 (const :tag "Cache visibility of all sections" t) 160 (repeat :tag "Cache visibility for section types" symbol))) 161 162 (defcustom magit-section-initial-visibility-alist 163 '((stashes . hide)) 164 "Alist controlling the initial visibility of sections. 165 166 Each element maps a section type or lineage to the initial 167 visibility state for such sections. The state has to be one of 168 `show' or `hide', or a function that returns one of these symbols. 169 A function is called with the section as the only argument. 170 171 Use the command `magit-describe-section' to determine a section's 172 lineage or type. The vector in the output is the section lineage 173 and the type is the first element of that vector. Wildcards can 174 be used, see `magit-section-match'. 175 176 Currently this option is only used to override hardcoded defaults, 177 but in the future it will also be used set the defaults. 178 179 An entry whose key is `magit-status-initial-section' specifies 180 the visibility of the section `magit-status-goto-initial-section' 181 jumps to. This does not only override defaults, but also other 182 entries of this alist." 183 :package-version '(magit-section . "2.12.0") 184 :group 'magit-section 185 :type '(alist :key-type (sexp :tag "Section type/lineage") 186 :value-type (choice (const hide) 187 (const show) 188 function))) 189 190 (defcustom magit-section-visibility-indicator 191 (if (window-system) 192 '(magit-fringe-bitmap> . magit-fringe-bitmapv) 193 (cons (if (char-displayable-p ?…) "…" "...") 194 t)) 195 "Whether and how to indicate that a section can be expanded/collapsed. 196 197 If nil, then don't show any indicators. 198 Otherwise the value has to have one of these two forms: 199 200 \(EXPANDABLE-BITMAP . COLLAPSIBLE-BITMAP) 201 202 Both values have to be variables whose values are fringe 203 bitmaps. In this case every section that can be expanded or 204 collapsed gets an indicator in the left fringe. 205 206 To provide extra padding around the indicator, set 207 `left-fringe-width' in `magit-mode-hook'. 208 209 \(STRING . BOOLEAN) 210 211 In this case STRING (usually an ellipsis) is shown at the end 212 of the heading of every collapsed section. Expanded sections 213 get no indicator. The cdr controls whether the appearance of 214 these ellipsis take section highlighting into account. Doing 215 so might potentially have an impact on performance, while not 216 doing so is kinda ugly." 217 :package-version '(magit-section . "3.0.0") 218 :group 'magit-section 219 :type '(choice (const :tag "No indicators" nil) 220 (cons :tag "Use +- fringe indicators" 221 (const magit-fringe-bitmap+) 222 (const magit-fringe-bitmap-)) 223 (cons :tag "Use >v fringe indicators" 224 (const magit-fringe-bitmap>) 225 (const magit-fringe-bitmapv)) 226 (cons :tag "Use bold >v fringe indicators)" 227 (const magit-fringe-bitmap-bold>) 228 (const magit-fringe-bitmap-boldv)) 229 (cons :tag "Use custom fringe indicators" 230 (variable :tag "Expandable bitmap variable") 231 (variable :tag "Collapsible bitmap variable")) 232 (cons :tag "Use ellipses at end of headings" 233 (string :tag "Ellipsis" "…") 234 (choice :tag "Use face kludge" 235 (const :tag "Yes (potentially slow)" t) 236 (const :tag "No (kinda ugly)" nil))))) 237 238 (define-obsolete-variable-alias 'magit-keep-region-overlay 239 'magit-section-keep-region-overlay "Magit-Section 4.0.0") 240 241 (defcustom magit-section-keep-region-overlay nil 242 "Whether to keep the region overlay when there is a valid selection. 243 244 By default Magit removes the regular region overlay if, and only 245 if, that region constitutes a valid selection as understood by 246 Magit commands. Otherwise it does not remove that overlay, and 247 the region looks like it would in other buffers. 248 249 There are two types of such valid selections: hunk-internal 250 regions and regions that select two or more sibling sections. 251 In such cases Magit removes the region overlay and instead 252 highlights a slightly larger range. All text (for hunk-internal 253 regions) or the headings of all sections (for sibling selections) 254 that are inside that range (not just inside the region) are acted 255 on by commands such as the staging command. This buffer range 256 begins at the beginning of the line on which the region begins 257 and ends at the end of the line on which the region ends. 258 259 Because Magit acts on this larger range and not the region, it is 260 actually quite important to visualize that larger range. If we 261 don't do that, then one might think that these commands act on 262 the region instead. If you want to *also* visualize the region, 263 then set this option to t. But please note that when the region 264 does *not* constitute a valid selection, then the region is 265 *always* visualized as usual, and that it is usually under such 266 circumstances that you want to use a non-magit command to act on 267 the region. 268 269 Besides keeping the region overlay, setting this option to t also 270 causes all face properties, except for `:foreground', to be 271 ignored for the faces used to highlight headings of selected 272 sections. This avoids the worst conflicts that result from 273 displaying the region and the selection overlays at the same 274 time. We are not interested in dealing with other conflicts. 275 In fact we *already* provide a way to avoid all of these 276 conflicts: *not* changing the value of this option. 277 278 It should be clear by now that we consider it a mistake to set 279 this to display the region when the Magit selection is also 280 visualized, but since it has been requested a few times and 281 because it doesn't cost much to offer this option we do so. 282 However that might change. If the existence of this option 283 starts complicating other things, then it will be removed." 284 :package-version '(magit-section . "2.3.0") 285 :group 'magit-section 286 :type 'boolean) 287 288 (defcustom magit-section-disable-line-numbers t 289 "In Magit buffers, whether to disable modes that display line numbers. 290 291 Some users who turn on `global-display-line-numbers-mode' (or 292 `global-nlinum-mode' or `global-linum-mode') expect line numbers 293 to be displayed everywhere except in Magit buffers. Other users 294 do not expect Magit buffers to be treated differently. At least 295 in theory users in the first group should not use the global mode, 296 but that ship has sailed, thus this option." 297 :package-version '(magit-section . "3.0.0") 298 :group 'magit-section 299 :type 'boolean) 300 301 (defcustom magit-section-show-context-menu-for-emacs<28 nil 302 "Whether `mouse-3' shows a context menu for Emacs < 28. 303 304 This has to be set before loading `magit-section' or it has 305 no effect. This also has no effect for Emacs >= 28, where 306 `context-menu-mode' should be enabled instead." 307 :package-version '(magit-section . "4.0.0") 308 :group 'magit-section 309 :type 'boolean) 310 311 ;;; Variables 312 313 (defvar-local magit-section-preserve-visibility t) 314 315 (defvar-local magit-section-pre-command-region-p nil) 316 (defvar-local magit-section-pre-command-section nil) 317 (defvar-local magit-section-highlight-force-update nil) 318 (defvar-local magit-section-highlight-overlays nil) 319 (defvar-local magit-section-highlighted-sections nil) 320 (defvar-local magit-section-unhighlight-sections nil) 321 322 (defvar-local magit-section-inhibit-markers nil) 323 (defvar-local magit-section-insert-in-reverse nil) 324 325 ;;; Faces 326 327 (defgroup magit-section-faces nil 328 "Faces used by Magit-Section." 329 :group 'magit-section 330 :group 'faces) 331 332 (defface magit-section-highlight 333 `((((class color) (background light)) 334 ,@(and (>= emacs-major-version 27) '(:extend t)) 335 :background "grey95") 336 (((class color) (background dark)) 337 ,@(and (>= emacs-major-version 27) '(:extend t)) 338 :background "grey20")) 339 "Face for highlighting the current section." 340 :group 'magit-section-faces) 341 342 (defface magit-section-heading 343 `((((class color) (background light)) 344 ,@(and (>= emacs-major-version 27) '(:extend t)) 345 :foreground "DarkGoldenrod4" 346 :weight bold) 347 (((class color) (background dark)) 348 ,@(and (>= emacs-major-version 27) '(:extend t)) 349 :foreground "LightGoldenrod2" 350 :weight bold)) 351 "Face for section headings." 352 :group 'magit-section-faces) 353 354 (defface magit-section-secondary-heading 355 `((t ,@(and (>= emacs-major-version 27) '(:extend t)) 356 :weight bold)) 357 "Face for section headings of some secondary headings." 358 :group 'magit-section-faces) 359 360 (defface magit-section-heading-selection 361 `((((class color) (background light)) 362 ,@(and (>= emacs-major-version 27) '(:extend t)) 363 :foreground "salmon4") 364 (((class color) (background dark)) 365 ,@(and (>= emacs-major-version 27) '(:extend t)) 366 :foreground "LightSalmon3")) 367 "Face for selected section headings." 368 :group 'magit-section-faces) 369 370 (defface magit-section-child-count '((t nil)) 371 "Face used for child counts at the end of some section headings." 372 :group 'magit-section-faces) 373 374 ;;; Classes 375 376 (defvar magit--current-section-hook nil 377 "Internal variable used for `magit-describe-section'.") 378 379 (defvar magit--section-type-alist nil) 380 381 (defclass magit-section () 382 ((type :initform nil :initarg :type) 383 (keymap :initform nil) 384 (value :initform nil) 385 (start :initform nil) 386 (content :initform nil) 387 (end :initform nil) 388 (hidden) 389 (washer :initform nil :initarg :washer) 390 (inserter :initform (symbol-value 'magit--current-section-hook)) 391 (heading-highlight-face :initform nil :initarg :heading-highlight-face) 392 (parent :initform nil) 393 (children :initform nil))) 394 395 ;;; Mode 396 397 (defvar symbol-overlay-inhibit-map) 398 399 (defvar-keymap magit-section-heading-map 400 :doc "Keymap used in the heading line of all expandable sections. 401 This keymap is used in addition to the section-specific keymap, 402 if any." 403 "<double-down-mouse-1>" #'ignore 404 "<double-mouse-1>" #'magit-mouse-toggle-section 405 "<double-mouse-2>" #'magit-mouse-toggle-section) 406 407 (defvar magit-section-mode-map 408 (let ((map (make-keymap))) 409 (suppress-keymap map t) 410 (when (and magit-section-show-context-menu-for-emacs<28 411 (< emacs-major-version 28)) 412 (keymap-set map "<mouse-3>" nil) 413 (keymap-set 414 map "<down-mouse-3>" 415 `( menu-item "" ,(make-sparse-keymap) 416 :filter ,(lambda (_) 417 (let ((menu (make-sparse-keymap))) 418 (if (fboundp 'context-menu-local) 419 (context-menu-local menu last-input-event) 420 (magit--context-menu-local menu last-input-event)) 421 (magit-section-context-menu menu last-input-event) 422 menu))))) 423 (keymap-set map "<left-fringe> <mouse-1>" #'magit-mouse-toggle-section) 424 (keymap-set map "<left-fringe> <mouse-2>" #'magit-mouse-toggle-section) 425 (keymap-set map "TAB" #'magit-section-toggle) 426 (keymap-set map "C-c TAB" #'magit-section-cycle) 427 (keymap-set map "C-<tab>" #'magit-section-cycle) 428 (keymap-set map "M-<tab>" #'magit-section-cycle) 429 ;; <backtab> is the most portable binding for Shift+Tab. 430 (keymap-set map "<backtab>" #'magit-section-cycle-global) 431 (keymap-set map "^" #'magit-section-up) 432 (keymap-set map "p" #'magit-section-backward) 433 (keymap-set map "n" #'magit-section-forward) 434 (keymap-set map "M-p" #'magit-section-backward-sibling) 435 (keymap-set map "M-n" #'magit-section-forward-sibling) 436 (keymap-set map "1" #'magit-section-show-level-1) 437 (keymap-set map "2" #'magit-section-show-level-2) 438 (keymap-set map "3" #'magit-section-show-level-3) 439 (keymap-set map "4" #'magit-section-show-level-4) 440 (keymap-set map "M-1" #'magit-section-show-level-1-all) 441 (keymap-set map "M-2" #'magit-section-show-level-2-all) 442 (keymap-set map "M-3" #'magit-section-show-level-3-all) 443 (keymap-set map "M-4" #'magit-section-show-level-4-all) 444 map) 445 "Parent keymap for all keymaps of modes derived from `magit-section-mode'.") 446 447 (define-derived-mode magit-section-mode special-mode "Magit-Sections" 448 "Parent major mode from which major modes with Magit-like sections inherit. 449 450 Magit-Section is documented in info node `(magit-section)'." 451 :interactive nil 452 :group 'magit-section 453 (buffer-disable-undo) 454 (setq truncate-lines t) 455 (setq buffer-read-only t) 456 (setq-local line-move-visual t) ; see #1771 457 ;; Turn off syntactic font locking, but not by setting 458 ;; `font-lock-defaults' because that would enable font locking, and 459 ;; not all magit plugins may be ready for that (see #3950). 460 (setq-local font-lock-syntactic-face-function #'ignore) 461 (setq show-trailing-whitespace nil) 462 (setq-local symbol-overlay-inhibit-map t) 463 (setq list-buffers-directory (abbreviate-file-name default-directory)) 464 (make-local-variable 'text-property-default-nonsticky) 465 (push (cons 'keymap t) text-property-default-nonsticky) 466 (add-hook 'pre-command-hook #'magit-section-pre-command-hook nil t) 467 (add-hook 'post-command-hook #'magit-section-post-command-hook t t) 468 (add-hook 'deactivate-mark-hook #'magit-section-deactivate-mark t t) 469 (setq-local redisplay-highlight-region-function 470 #'magit-section--highlight-region) 471 (setq-local redisplay-unhighlight-region-function 472 #'magit-section--unhighlight-region) 473 (add-function :filter-return (local 'filter-buffer-substring-function) 474 #'magit-section--remove-text-properties) 475 (when (fboundp 'magit-section-context-menu) 476 (add-hook 'context-menu-functions #'magit-section-context-menu 10 t)) 477 (when magit-section-disable-line-numbers 478 (when (and (fboundp 'linum-mode) 479 (bound-and-true-p global-linum-mode)) 480 (linum-mode -1)) 481 (when (and (fboundp 'nlinum-mode) 482 (bound-and-true-p global-nlinum-mode)) 483 (nlinum-mode -1)) 484 (when (and (fboundp 'display-line-numbers-mode) 485 (bound-and-true-p global-display-line-numbers-mode)) 486 (display-line-numbers-mode -1))) 487 (when (fboundp 'magit-preserve-section-visibility-cache) 488 (add-hook 'kill-buffer-hook #'magit-preserve-section-visibility-cache))) 489 490 (defun magit-section--remove-text-properties (string) 491 "Remove all text-properties from STRING. 492 Most importantly `magit-section'." 493 (set-text-properties 0 (length string) nil string) 494 string) 495 496 ;;; Core 497 498 (defvar-local magit-root-section nil 499 "The root section in the current buffer. 500 All other sections are descendants of this section. The value 501 of this variable is set by `magit-insert-section' and you should 502 never modify it.") 503 (put 'magit-root-section 'permanent-local t) 504 505 (defvar-local magit--context-menu-section nil "For internal use only.") 506 507 (defvar magit--context-menu-buffer nil "For internal use only.") 508 509 (defun magit-point () 510 "Return point or the position where the context menu was invoked. 511 When using the context menu, return the position the user clicked 512 on, provided the current buffer is the buffer in which the click 513 occurred. Otherwise return the same value as `point'." 514 (if magit--context-menu-section 515 (magit-menu-position) 516 (point))) 517 518 (defun magit-thing-at-point (thing &optional no-properties) 519 "Return the THING at point or where the context menu was invoked. 520 When using the context menu, return the thing the user clicked 521 on, provided the current buffer is the buffer in which the click 522 occurred. Otherwise return the same value as `thing-at-point'. 523 For the meaning of THING and NO-PROPERTIES see that function." 524 (if-let ((pos (magit-menu-position))) 525 (save-excursion 526 (goto-char pos) 527 (thing-at-point thing no-properties)) 528 (thing-at-point thing no-properties))) 529 530 (defun magit-current-section () 531 "Return the section at point or where the context menu was invoked. 532 When using the context menu, return the section that the user 533 clicked on, provided the current buffer is the buffer in which 534 the click occurred. Otherwise return the section at point." 535 (or magit--context-menu-section 536 (magit-section-at) 537 magit-root-section)) 538 539 (defun magit-section-at (&optional position) 540 "Return the section at POSITION, defaulting to point." 541 (get-text-property (or position (point)) 'magit-section)) 542 543 (defun magit-section-ident (section) 544 "Return an unique identifier for SECTION. 545 The return value has the form ((TYPE . VALUE)...)." 546 (cons (cons (oref section type) 547 (magit-section-ident-value section)) 548 (and-let* ((parent (oref section parent))) 549 (magit-section-ident parent)))) 550 551 (cl-defgeneric magit-section-ident-value (object) 552 "Return OBJECT's value, making it constant and unique if necessary. 553 554 This is used to correlate different incarnations of the same 555 section, see `magit-section-ident' and `magit-get-section'. 556 557 Sections whose values that are not constant and/or unique should 558 implement a method that return a value that can be used for this 559 purpose.") 560 561 (cl-defmethod magit-section-ident-value ((section magit-section)) 562 "Return the value unless it is an object. 563 564 Different object incarnations representing the same value tend to not be 565 equal, so call this generic function on the object itself to determine a 566 constant value." 567 (let ((value (oref section value))) 568 (if (eieio-object-p value) 569 (magit-section-ident-value value) 570 value))) 571 572 (cl-defmethod magit-section-ident-value ((object eieio-default-superclass)) 573 "Simply return the object itself. That likely isn't 574 good enough, so you need to implement your own method." 575 object) 576 577 (defun magit-get-section (ident &optional root) 578 "Return the section identified by IDENT. 579 IDENT has to be a list as returned by `magit-section-ident'. 580 If optional ROOT is non-nil, then search in that section tree 581 instead of in the one whose root `magit-root-section' is." 582 (setq ident (reverse ident)) 583 (let ((section (or root magit-root-section))) 584 (when (eq (car (pop ident)) 585 (oref section type)) 586 (while (and ident 587 (pcase-let ((`(,type . ,value) (car ident))) 588 (setq section 589 (cl-find-if 590 (lambda (section) 591 (and (eq (oref section type) type) 592 (equal (magit-section-ident-value section) 593 value))) 594 (oref section children))))) 595 (pop ident)) 596 section))) 597 598 (defun magit-section-lineage (section &optional raw) 599 "Return the lineage of SECTION. 600 If optional RAW is non-nil, return a list of section objects, beginning 601 with SECTION, otherwise return a list of section types." 602 (cons (if raw section (oref section type)) 603 (and-let* ((parent (oref section parent))) 604 (magit-section-lineage parent raw)))) 605 606 (defvar-local magit-insert-section--current nil "For internal use only.") 607 (defvar-local magit-insert-section--parent nil "For internal use only.") 608 (defvar-local magit-insert-section--oldroot nil "For internal use only.") 609 610 ;;; Menu 611 612 (defvar magit-menu-common-value nil "See function `magit-menu-common-value'.") 613 (defvar magit-menu--desc-values nil "For internal use only.") 614 615 (defun magit-section-context-menu (menu click) 616 "Populate MENU with Magit-Section commands at CLICK." 617 (when-let ((section (save-excursion 618 (unless (region-active-p) 619 (mouse-set-point click)) 620 (magit-section-at)))) 621 (unless (region-active-p) 622 (setq magit--context-menu-buffer (current-buffer)) 623 (if-let ((alt (save-excursion 624 (mouse-set-point click) 625 (run-hook-with-args-until-success 626 'magit-menu-alternative-section-hook section)))) 627 (setq magit--context-menu-section (setq section alt)) 628 (setq magit--context-menu-section section) 629 (magit-section-update-highlight t))) 630 (when (magit-section-content-p section) 631 (keymap-set-after menu "<magit-section-toggle>" 632 `(menu-item 633 ,(if (oref section hidden) "Expand section" "Collapse section") 634 magit-section-toggle)) 635 (when-let (((not (oref section hidden))) 636 (children (oref section children))) 637 (when (seq-some #'magit-section-content-p children) 638 (when (seq-some (lambda (c) (oref c hidden)) children) 639 (keymap-set-after menu "<magit-section-show-children>" 640 `(menu-item "Expand children" 641 magit-section-show-children))) 642 (when (seq-some (lambda (c) (not (oref c hidden))) children) 643 (keymap-set-after menu "<magit-section-hide-children>" 644 `(menu-item "Collapse children" 645 magit-section-hide-children))))) 646 (keymap-set-after menu "<separator-magit-1>" menu-bar-separator)) 647 (keymap-set-after menu "<magit-describe-section>" 648 `(menu-item "Describe section" magit-describe-section)) 649 (when-let ((map (oref section keymap))) 650 (keymap-set-after menu "<separator-magit-2>" menu-bar-separator) 651 (when (symbolp map) 652 (setq map (symbol-value map))) 653 (setq magit-menu-common-value (magit-menu-common-value section)) 654 (setq magit-menu--desc-values (magit-menu--desc-values section)) 655 (map-keymap (lambda (key binding) 656 (when (consp binding) 657 (define-key-after menu (vector key) 658 (copy-sequence binding)))) 659 (if (fboundp 'menu-bar-keymap) 660 (menu-bar-keymap map) 661 (magit--menu-bar-keymap map))))) 662 menu) 663 664 (defun magit-menu-item (desc def &optional props) 665 "Return a menu item named DESC binding DEF and using PROPS. 666 667 If DESC contains a supported %-spec, substitute the 668 expression (magit-menu-format-desc DESC) for that. 669 See `magit-menu-format-desc'." 670 `(menu-item 671 ,(if (and (stringp desc) (string-match-p "%[tTvsmMx]" desc)) 672 (list 'magit-menu-format-desc desc) 673 desc) 674 ,def 675 ;; Without this, the keys for point would be shown instead 676 ;; of the relevant ones from where the click occurred. 677 :keys ,(apply-partially #'magit--menu-position-keys def) 678 ,@props)) 679 680 (defun magit--menu-position-keys (def) 681 (or (ignore-errors 682 (save-excursion 683 (goto-char (magit-menu-position)) 684 (and-let* ((key (cl-find-if-not 685 (lambda (key) 686 (string-match-p "\\`<[0-9]+>\\'" 687 (key-description key))) 688 (where-is-internal def)))) 689 (key-description key)))) 690 "")) 691 692 (defun magit-menu-position () 693 "Return the position where the context-menu was invoked. 694 If the current command wasn't invoked using the context-menu, 695 then return nil." 696 (and magit--context-menu-section 697 (ignore-errors 698 (posn-point (event-start (aref (this-command-keys-vector) 0)))))) 699 700 (defun magit-menu-highlight-point-section () 701 (setq magit-section-highlight-force-update t) 702 (if (eq (current-buffer) magit--context-menu-buffer) 703 (setq magit--context-menu-section nil) 704 (if-let ((window (get-buffer-window magit--context-menu-buffer))) 705 (with-selected-window window 706 (setq magit--context-menu-section nil) 707 (magit-section-update-highlight)) 708 (with-current-buffer magit--context-menu-buffer 709 (setq magit--context-menu-section nil)))) 710 (setq magit--context-menu-buffer nil)) 711 712 (defvar magit--plural-append-es '(branch)) 713 714 (cl-defgeneric magit-menu-common-value (_section) 715 "Return some value to be used by multiple menu items. 716 This function is called by `magit-section-context-menu', which 717 stores the value in `magit-menu-common-value'. Individual menu 718 items can use it, e.g., in the expression used to set their 719 description." 720 nil) 721 722 (defun magit-menu--desc-values (section) 723 (let ((type (oref section type)) 724 (value (oref section value)) 725 (multiple (magit-region-sections nil t))) 726 (list type 727 value 728 (format "%s %s" type value) 729 (and multiple (length multiple)) 730 (if (memq type magit--plural-append-es) "es" "s")))) 731 732 (defun magit-menu-format-desc (format) 733 "Format a string based on FORMAT and menu section or selection. 734 The following %-specs are allowed: 735 %t means \"TYPE\". 736 %T means \"TYPE\", or \"TYPEs\" if multiple sections are selected. 737 %v means \"VALUE\". 738 %s means \"TYPE VALUE\". 739 %m means \"TYPE VALUE\", or \"COUNT TYPEs\" if multiple sections 740 are selected. 741 %M means \"VALUE\", or \"COUNT TYPEs\" if multiple sections are 742 selected. 743 %x means the value of `magit-menu-common-value'." 744 (pcase-let* ((`(,type ,value ,single ,count ,suffix) magit-menu--desc-values) 745 (multiple (and count (format "%s %s%s" count type suffix)))) 746 (format-spec format 747 `((?t . ,type) 748 (?T . ,(format "%s%s" type (if count suffix ""))) 749 (?v . ,value) 750 (?s . ,single) 751 (?m . ,(or multiple single)) 752 (?M . ,(or multiple value)) 753 (?x . ,(format "%s" magit-menu-common-value)))))) 754 755 (defun magit--menu-bar-keymap (keymap) 756 "Backport of `menu-bar-keymap' for Emacs < 28. 757 Slight trimmed down." 758 (let ((menu-bar nil)) 759 (map-keymap (lambda (key binding) 760 (push (cons key binding) menu-bar)) 761 keymap) 762 (cons 'keymap (nreverse menu-bar)))) 763 764 (defun magit--context-menu-local (menu _click) 765 "Backport of `context-menu-local' for Emacs < 28." 766 (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) 767 (keymap-set-after menu "<separator-local>" menu-bar-separator) 768 (let ((keymap (local-key-binding [menu-bar]))) 769 (when keymap 770 (map-keymap (lambda (key binding) 771 (when (consp binding) 772 (define-key-after menu (vector key) 773 (copy-sequence binding)))) 774 (magit--menu-bar-keymap keymap)))) 775 menu) 776 777 (define-advice context-menu-region (:around (fn menu click) magit-section-mode) 778 "Disable in `magit-section-mode' buffers." 779 (if (derived-mode-p 'magit-section-mode) 780 menu 781 (funcall fn menu click))) 782 783 ;;; Commands 784 ;;;; Movement 785 786 (defun magit-section-forward () 787 "Move to the beginning of the next visible section." 788 (interactive) 789 (if (eobp) 790 (user-error "No next section") 791 (let ((section (magit-current-section))) 792 (if (oref section parent) 793 (let ((next (and (not (oref section hidden)) 794 (not (= (oref section end) 795 (1+ (point)))) 796 (car (oref section children))))) 797 (while (and section (not next)) 798 (unless (setq next (car (magit-section-siblings section 'next))) 799 (setq section (oref section parent)))) 800 (if next 801 (magit-section-goto next) 802 (user-error "No next section"))) 803 (magit-section-goto 1))))) 804 805 (defun magit-section-backward () 806 "Move to the beginning of the current or the previous visible section. 807 When point is at the beginning of a section then move to the 808 beginning of the previous visible section. Otherwise move to 809 the beginning of the current section." 810 (interactive) 811 (if (bobp) 812 (user-error "No previous section") 813 (let ((section (magit-current-section)) children) 814 (cond 815 ((and (= (point) 816 (1- (oref section end))) 817 (setq children (oref section children))) 818 (magit-section-goto (car (last children)))) 819 ((and (oref section parent) 820 (not (= (point) 821 (oref section start)))) 822 (magit-section-goto section)) 823 (t 824 (let ((prev (car (magit-section-siblings section 'prev)))) 825 (if prev 826 (while (and (not (oref prev hidden)) 827 (setq children (oref prev children))) 828 (setq prev (car (last children)))) 829 (setq prev (oref section parent))) 830 (cond (prev 831 (magit-section-goto prev)) 832 ((oref section parent) 833 (user-error "No previous section")) 834 ;; Eob special cases. 835 ((not (get-text-property (1- (point)) 'invisible)) 836 (magit-section-goto -1)) 837 (t 838 (goto-char (previous-single-property-change 839 (1- (point)) 'invisible)) 840 (forward-line -1) 841 (magit-section-goto (magit-current-section)))))))))) 842 843 (defun magit-section-up () 844 "Move to the beginning of the parent section." 845 (interactive) 846 (if-let ((parent (oref (magit-current-section) parent))) 847 (magit-section-goto parent) 848 (user-error "No parent section"))) 849 850 (defun magit-section-forward-sibling () 851 "Move to the beginning of the next sibling section. 852 If there is no next sibling section, then move to the parent." 853 (interactive) 854 (let ((current (magit-current-section))) 855 (if (oref current parent) 856 (if-let ((next (car (magit-section-siblings current 'next)))) 857 (magit-section-goto next) 858 (magit-section-forward)) 859 (magit-section-goto 1)))) 860 861 (defun magit-section-backward-sibling () 862 "Move to the beginning of the previous sibling section. 863 If there is no previous sibling section, then move to the parent." 864 (interactive) 865 (let ((current (magit-current-section))) 866 (if (oref current parent) 867 (if-let ((previous (car (magit-section-siblings current 'prev)))) 868 (magit-section-goto previous) 869 (magit-section-backward)) 870 (magit-section-goto -1)))) 871 872 (defun magit-section-goto (arg) 873 (if (integerp arg) 874 (progn (forward-line arg) 875 (setq arg (magit-current-section))) 876 (goto-char (oref arg start))) 877 (run-hook-with-args 'magit-section-movement-hook arg)) 878 879 (defun magit-section-set-window-start (section) 880 "Ensure the beginning of SECTION is visible." 881 (unless (pos-visible-in-window-p (oref section end)) 882 (set-window-start (selected-window) (oref section start)))) 883 884 (defmacro magit-define-section-jumper 885 (name heading type &optional value inserter &rest properties) 886 "Define an interactive function to go some section. 887 Together TYPE and VALUE identify the section. 888 HEADING is the displayed heading of the section." 889 (declare (indent defun)) 890 `(transient-define-suffix ,name (&optional expand) 891 ,(format "Jump to the section \"%s\". 892 With a prefix argument also expand it." heading) 893 ,@properties 894 ,@(and (not (plist-member properties :description)) 895 (list :description heading)) 896 ,@(and inserter 897 `(:if (lambda () (memq ',inserter 898 (bound-and-true-p magit-status-sections-hook))))) 899 :inapt-if-not (lambda () (magit-get-section 900 (cons (cons ',type ,value) 901 (magit-section-ident magit-root-section)))) 902 (interactive "P") 903 (if-let ((section (magit-get-section 904 (cons (cons ',type ,value) 905 (magit-section-ident magit-root-section))))) 906 (progn (goto-char (oref section start)) 907 (when expand 908 (with-local-quit (magit-section-show section)) 909 (recenter 0))) 910 (message ,(format "Section \"%s\" wasn't found" heading))))) 911 912 ;;;; Visibility 913 914 (defun magit-section-show (section) 915 "Show the body of the current section." 916 (interactive (list (magit-current-section))) 917 (oset section hidden nil) 918 (magit-section--maybe-wash section) 919 (when-let ((beg (oref section content))) 920 (remove-overlays beg (oref section end) 'invisible t)) 921 (magit-section-maybe-update-visibility-indicator section) 922 (magit-section-maybe-cache-visibility section) 923 (dolist (child (oref section children)) 924 (if (oref child hidden) 925 (magit-section-hide child) 926 (magit-section-show child)))) 927 928 (defun magit-section--maybe-wash (section) 929 (when-let ((washer (oref section washer))) 930 (oset section washer nil) 931 (let ((inhibit-read-only t) 932 (magit-insert-section--parent section) 933 (magit-insert-section--current section) 934 (content (oref section content))) 935 (save-excursion 936 (if (and content (< content (oref section end))) 937 (funcall washer section) ; already partially washed (hunk) 938 (goto-char (oref section end)) 939 (oset section content (point-marker)) 940 (funcall washer) 941 (oset section end (point-marker))))) 942 (setq magit-section-highlight-force-update t))) 943 944 (defun magit-section-hide (section) 945 "Hide the body of the current section." 946 (interactive (list (magit-current-section))) 947 (if (eq section magit-root-section) 948 (user-error "Cannot hide root section") 949 (oset section hidden t) 950 (when-let ((beg (oref section content))) 951 (let ((end (oref section end))) 952 (when (< beg (point) end) 953 (goto-char (oref section start))) 954 (remove-overlays beg end 'invisible t) 955 (let ((o (make-overlay beg end))) 956 (overlay-put o 'evaporate t) 957 (overlay-put o 'invisible t) 958 (overlay-put o 'cursor-intangible t)))) 959 (magit-section-maybe-update-visibility-indicator section) 960 (magit-section-maybe-cache-visibility section))) 961 962 (defun magit-section-toggle (section) 963 "Toggle visibility of the body of the current section." 964 (interactive (list (magit-current-section))) 965 (cond ((eq section magit-root-section) 966 (user-error "Cannot hide root section")) 967 ((oref section hidden) 968 (magit-section-show section)) 969 ((magit-section-hide section)))) 970 971 (defun magit-section-toggle-children (section) 972 "Toggle visibility of bodies of children of the current section." 973 (interactive (list (magit-current-section))) 974 (let* ((children (oref section children)) 975 (show (--any-p (oref it hidden) children))) 976 (dolist (c children) 977 (oset c hidden show))) 978 (magit-section-show section)) 979 980 (defun magit-section-show-children (section &optional depth) 981 "Recursively show the bodies of children of the current section. 982 With a prefix argument show children that deep and hide deeper 983 children." 984 (interactive (list (magit-current-section))) 985 (magit-section-show-children-1 section depth) 986 (magit-section-show section)) 987 988 (defun magit-section-show-children-1 (section &optional depth) 989 (dolist (child (oref section children)) 990 (oset child hidden nil) 991 (if depth 992 (if (> depth 0) 993 (magit-section-show-children-1 child (1- depth)) 994 (magit-section-hide child)) 995 (magit-section-show-children-1 child)))) 996 997 (defun magit-section-hide-children (section) 998 "Recursively hide the bodies of children of the current section." 999 (interactive (list (magit-current-section))) 1000 (mapc #'magit-section-hide (oref section children))) 1001 1002 (defun magit-section-show-headings (section) 1003 "Recursively show headings of children of the current section. 1004 Only show the headings, previously shown text-only bodies are 1005 hidden." 1006 (interactive (list (magit-current-section))) 1007 (magit-section-show-headings-1 section) 1008 (magit-section-show section)) 1009 1010 (defun magit-section-show-headings-1 (section) 1011 (dolist (child (oref section children)) 1012 (oset child hidden nil) 1013 (when (or (oref child children) 1014 (not (oref child content))) 1015 (magit-section-show-headings-1 child)))) 1016 1017 (defun magit-section-cycle (section) 1018 "Cycle visibility of current section and its children. 1019 1020 If this command is invoked using \\`C-<tab>' and that is globally bound 1021 to `tab-next', then this command pivots to behave like that command, and 1022 you must instead use \\`C-c TAB' to cycle section visibility. 1023 1024 If you would like to keep using \\`C-<tab>' to cycle section visibility 1025 but also want to use `tab-bar-mode', then you have to prevent that mode 1026 from using this key and instead bind another key to `tab-next'. Because 1027 `tab-bar-mode' does not use a mode map but instead manipulates the 1028 global map, this involves advising `tab-bar--define-keys'." 1029 (interactive (list (magit-current-section))) 1030 (cond 1031 ((and (equal (this-command-keys) [C-tab]) 1032 (eq (global-key-binding [C-tab]) 'tab-next) 1033 (fboundp 'tab-bar-switch-to-next-tab)) 1034 (tab-bar-switch-to-next-tab current-prefix-arg)) 1035 ((oref section hidden) 1036 (magit-section-show section) 1037 (magit-section-hide-children section)) 1038 ((let ((children (oref section children))) 1039 (cond ((and (--any-p (oref it hidden) children) 1040 (--any-p (oref it children) children)) 1041 (magit-section-show-headings section)) 1042 ((seq-some #'magit-section-hidden-body children) 1043 (magit-section-show-children section)) 1044 ((magit-section-hide section))))))) 1045 1046 (defun magit-section-cycle-global () 1047 "Cycle visibility of all sections in the current buffer." 1048 (interactive) 1049 (let ((children (oref magit-root-section children))) 1050 (cond ((and (--any-p (oref it hidden) children) 1051 (--any-p (oref it children) children)) 1052 (magit-section-show-headings magit-root-section)) 1053 ((seq-some #'magit-section-hidden-body children) 1054 (magit-section-show-children magit-root-section)) 1055 (t 1056 (mapc #'magit-section-hide children))))) 1057 1058 (defun magit-section-hidden-body (section &optional pred) 1059 (if-let ((children (oref section children))) 1060 (funcall (or pred #'-any-p) #'magit-section-hidden-body children) 1061 (and (oref section content) 1062 (oref section hidden)))) 1063 1064 (defun magit-section-content-p (section) 1065 "Return non-nil if SECTION has content or an unused washer function." 1066 (with-slots (content end washer) section 1067 (and content (or (not (= content end)) washer)))) 1068 1069 (defun magit-section-invisible-p (section) 1070 "Return t if the SECTION's body is invisible. 1071 When the body of an ancestor of SECTION is collapsed then 1072 SECTION's body (and heading) obviously cannot be visible." 1073 (or (oref section hidden) 1074 (and-let* ((parent (oref section parent))) 1075 (magit-section-invisible-p parent)))) 1076 1077 (defun magit-section-show-level (level) 1078 "Show surrounding sections up to LEVEL. 1079 If LEVEL is negative, show up to the absolute value. 1080 Sections at higher levels are hidden." 1081 (if (< level 0) 1082 (let ((s (magit-current-section))) 1083 (setq level (- level)) 1084 (while (> (1- (length (magit-section-ident s))) level) 1085 (setq s (oref s parent)) 1086 (goto-char (oref s start))) 1087 (magit-section-show-children magit-root-section (1- level))) 1088 (cl-do* ((s (magit-current-section) 1089 (oref s parent)) 1090 (i (1- (length (magit-section-ident s))) 1091 (cl-decf i))) 1092 ((cond ((< i level) (magit-section-show-children s (- level i 1)) t) 1093 ((= i level) (magit-section-hide s) t)) 1094 (magit-section-goto s))))) 1095 1096 (defun magit-section-show-level-1 () 1097 "Show surrounding sections on first level." 1098 (interactive) 1099 (magit-section-show-level 1)) 1100 1101 (defun magit-section-show-level-1-all () 1102 "Show all sections on first level." 1103 (interactive) 1104 (magit-section-show-level -1)) 1105 1106 (defun magit-section-show-level-2 () 1107 "Show surrounding sections up to second level." 1108 (interactive) 1109 (magit-section-show-level 2)) 1110 1111 (defun magit-section-show-level-2-all () 1112 "Show all sections up to second level." 1113 (interactive) 1114 (magit-section-show-level -2)) 1115 1116 (defun magit-section-show-level-3 () 1117 "Show surrounding sections up to third level." 1118 (interactive) 1119 (magit-section-show-level 3)) 1120 1121 (defun magit-section-show-level-3-all () 1122 "Show all sections up to third level." 1123 (interactive) 1124 (magit-section-show-level -3)) 1125 1126 (defun magit-section-show-level-4 () 1127 "Show surrounding sections up to fourth level." 1128 (interactive) 1129 (magit-section-show-level 4)) 1130 1131 (defun magit-section-show-level-4-all () 1132 "Show all sections up to fourth level." 1133 (interactive) 1134 (magit-section-show-level -4)) 1135 1136 (defun magit-mouse-toggle-section (event) 1137 "Toggle visibility of the clicked section. 1138 Clicks outside either the section heading or the left fringe are 1139 silently ignored." 1140 (interactive "e") 1141 (let* ((pos (event-start event)) 1142 (section (magit-section-at (posn-point pos)))) 1143 (if (eq (posn-area pos) 'left-fringe) 1144 (when section 1145 (while (not (magit-section-content-p section)) 1146 (setq section (oref section parent))) 1147 (unless (eq section magit-root-section) 1148 (goto-char (oref section start)) 1149 (magit-section-toggle section))) 1150 (magit-section-toggle section)))) 1151 1152 ;;;; Auxiliary 1153 1154 (defun magit-describe-section-briefly (section &optional ident interactive) 1155 "Show information about the section at point. 1156 With a prefix argument show the section identity instead of the 1157 section lineage. This command is intended for debugging purposes. 1158 \n(fn SECTION &optional IDENT)" 1159 (interactive (list (magit-current-section) current-prefix-arg t)) 1160 (let ((str (format "#<%s %S %S %s-%s%s>" 1161 (eieio-object-class section) 1162 (let ((val (oref section value))) 1163 (cond ((stringp val) 1164 (substring-no-properties val)) 1165 ((and (eieio-object-p val) 1166 (fboundp 'cl-prin1-to-string)) 1167 (cl-prin1-to-string val)) 1168 (t 1169 val))) 1170 (if ident 1171 (magit-section-ident section) 1172 (apply #'vector (magit-section-lineage section))) 1173 (and-let* ((m (oref section start))) 1174 (if (markerp m) (marker-position m) m)) 1175 (if-let ((m (oref section content))) 1176 (format "[%s-]" 1177 (if (markerp m) (marker-position m) m)) 1178 "") 1179 (and-let* ((m (oref section end))) 1180 (if (markerp m) (marker-position m) m))))) 1181 (when interactive 1182 (message "%s" str)) 1183 str)) 1184 1185 (cl-defmethod cl-print-object ((section magit-section) stream) 1186 "Print `magit-describe-section' result of SECTION." 1187 ;; Used by debug and edebug as of Emacs 26. 1188 (princ (magit-describe-section-briefly section) stream)) 1189 1190 (defun magit-describe-section (section &optional interactive-p) 1191 "Show information about the section at point." 1192 (interactive (list (magit-current-section) t)) 1193 (let ((inserter-section section)) 1194 (while (and inserter-section (not (oref inserter-section inserter))) 1195 (setq inserter-section (oref inserter-section parent))) 1196 (when (and inserter-section (oref inserter-section inserter)) 1197 (setq section inserter-section))) 1198 (pcase (oref section inserter) 1199 (`((,hook ,fun) . ,src-src) 1200 (help-setup-xref `(magit-describe-section ,section) interactive-p) 1201 (with-help-window (help-buffer) 1202 (with-current-buffer standard-output 1203 (insert (format-message 1204 "%s\n is inserted by `%s'\n from `%s'" 1205 (magit-describe-section-briefly section) 1206 (make-text-button (symbol-name fun) nil 1207 :type 'help-function 1208 'help-args (list fun)) 1209 (make-text-button (symbol-name hook) nil 1210 :type 'help-variable 1211 'help-args (list hook)))) 1212 (pcase-dolist (`(,hook ,fun) src-src) 1213 (insert (format-message 1214 ",\n called by `%s'\n from `%s'" 1215 (make-text-button (symbol-name fun) nil 1216 :type 'help-function 1217 'help-args (list fun)) 1218 (make-text-button (symbol-name hook) nil 1219 :type 'help-variable 1220 'help-args (list hook))))) 1221 (insert ".\n\n") 1222 (insert 1223 (format-message 1224 "`%s' is " 1225 (make-text-button (symbol-name fun) nil 1226 :type 'help-function 'help-args (list fun)))) 1227 (describe-function-1 fun)))) 1228 (_ (message "%s, inserter unknown" 1229 (magit-describe-section-briefly section))))) 1230 1231 ;;; Match 1232 1233 (cl-defun magit-section-match 1234 (condition &optional (section (magit-current-section))) 1235 "Return t if SECTION matches CONDITION. 1236 1237 SECTION defaults to the section at point. If SECTION is not 1238 specified and there also is no section at point, then return 1239 nil. 1240 1241 CONDITION can take the following forms: 1242 (CONDITION...) matches if any of the CONDITIONs matches. 1243 [CLASS...] matches if the section's class is the same 1244 as the first CLASS or a subclass of that; 1245 the section's parent class matches the 1246 second CLASS; and so on. 1247 [* CLASS...] matches sections that match [CLASS...] and 1248 also recursively all their child sections. 1249 CLASS matches if the section's class is the same 1250 as CLASS or a subclass of that; regardless 1251 of the classes of the parent sections. 1252 1253 Each CLASS should be a class symbol, identifying a class that 1254 derives from `magit-section'. For backward compatibility CLASS 1255 can also be a \"type symbol\". A section matches such a symbol 1256 if the value of its `type' slot is `eq'. If a type symbol has 1257 an entry in `magit--section-type-alist', then a section also 1258 matches that type if its class is a subclass of the class that 1259 corresponds to the type as per that alist. 1260 1261 Note that it is not necessary to specify the complete section 1262 lineage as printed by `magit-describe-section-briefly', unless 1263 of course you want to be that precise." 1264 (and section (magit-section-match-1 condition section))) 1265 1266 (defun magit-section-match-1 (condition section) 1267 (cl-assert condition) 1268 (and section 1269 (if (listp condition) 1270 (--first (magit-section-match-1 it section) condition) 1271 (magit-section-match-2 (if (symbolp condition) 1272 (list condition) 1273 (cl-coerce condition 'list)) 1274 section)))) 1275 1276 (defun magit-section-match-2 (condition section) 1277 (if (eq (car condition) '*) 1278 (or (magit-section-match-2 (cdr condition) section) 1279 (and-let* ((parent (oref section parent))) 1280 (magit-section-match-2 condition parent))) 1281 (and (let ((c (car condition))) 1282 (if (class-p c) 1283 (cl-typep section c) 1284 (if-let ((class (cdr (assq c magit--section-type-alist)))) 1285 (cl-typep section class) 1286 (eq (oref section type) c)))) 1287 (or (not (setq condition (cdr condition))) 1288 (and-let* ((parent (oref section parent))) 1289 (magit-section-match-2 condition parent)))))) 1290 1291 (defun magit-section-value-if (condition &optional section) 1292 "If the section at point matches CONDITION, then return its value. 1293 1294 If optional SECTION is non-nil then test whether that matches 1295 instead. If there is no section at point and SECTION is nil, 1296 then return nil. If the section does not match, then return 1297 nil. 1298 1299 See `magit-section-match' for the forms CONDITION can take." 1300 (and-let* ((section (or section (magit-current-section)))) 1301 (and (magit-section-match condition section) 1302 (oref section value)))) 1303 1304 (defmacro magit-section-case (&rest clauses) 1305 "Choose among clauses on the type of the section at point. 1306 1307 Each clause looks like (CONDITION BODY...). The type of the 1308 section is compared against each CONDITION; the BODY forms of the 1309 first match are evaluated sequentially and the value of the last 1310 form is returned. Inside BODY the symbol `it' is bound to the 1311 section at point. If no clause succeeds or if there is no 1312 section at point, return nil. 1313 1314 See `magit-section-match' for the forms CONDITION can take. 1315 Additionally a CONDITION of t is allowed in the final clause, and 1316 matches if no other CONDITION match, even if there is no section 1317 at point." 1318 (declare (indent 0) 1319 (debug (&rest (sexp body)))) 1320 `(let* ((it (magit-current-section))) 1321 (cond ,@(mapcar (lambda (clause) 1322 `(,(or (eq (car clause) t) 1323 `(and it 1324 (magit-section-match-1 ',(car clause) it))) 1325 ,@(cdr clause))) 1326 clauses)))) 1327 1328 (defun magit-section-match-assoc (section alist) 1329 "Return the value associated with SECTION's type or lineage in ALIST." 1330 (seq-some (pcase-lambda (`(,key . ,val)) 1331 (and (magit-section-match-1 key section) val)) 1332 alist)) 1333 1334 ;;; Create 1335 1336 (defvar magit-insert-section-hook nil 1337 "Hook run after `magit-insert-section's BODY. 1338 Avoid using this hook and only ever do so if you know 1339 what you are doing and are sure there is no other way.") 1340 1341 (defmacro magit-insert-section (&rest args) 1342 "Insert a section at point. 1343 1344 Create a section object of type CLASS, storing VALUE in its 1345 `value' slot, and insert the section at point. CLASS is a 1346 subclass of `magit-section' or has the form `(eval FORM)', in 1347 which case FORM is evaluated at runtime and should return a 1348 subclass. In other places a sections class is often referred 1349 to as its \"type\". 1350 1351 Many commands behave differently depending on the class of the 1352 current section and sections of a certain class can have their 1353 own keymap, which is specified using the `keymap' class slot. 1354 The value of that slot should be a variable whose value is a 1355 keymap. 1356 1357 For historic reasons Magit and Forge in most cases use symbols 1358 as CLASS that don't actually identify a class and that lack the 1359 appropriate package prefix. This works due to some undocumented 1360 kludges, which are not available to other packages. 1361 1362 When optional HIDE is non-nil collapse the section body by 1363 default, i.e., when first creating the section, but not when 1364 refreshing the buffer. Else expand it by default. This can be 1365 overwritten using `magit-section-set-visibility-hook'. When a 1366 section is recreated during a refresh, then the visibility of 1367 predecessor is inherited and HIDE is ignored (but the hook is 1368 still honored). 1369 1370 BODY is any number of forms that actually insert the section's 1371 heading and body. Optional NAME, if specified, has to be a 1372 symbol, which is then bound to the object of the section being 1373 inserted. 1374 1375 Before BODY is evaluated the `start' of the section object is set 1376 to the value of `point' and after BODY was evaluated its `end' is 1377 set to the new value of `point'; BODY is responsible for moving 1378 `point' forward. 1379 1380 If it turns out inside BODY that the section is empty, then 1381 `magit-cancel-section' can be used to abort and remove all traces 1382 of the partially inserted section. This can happen when creating 1383 a section by washing Git's output and Git didn't actually output 1384 anything this time around. 1385 1386 \(fn [NAME] (CLASS &optional VALUE HIDE) &rest BODY)" 1387 (declare (indent 1) 1388 (debug ([&optional symbolp] 1389 (&or [("eval" form) &optional form form &rest form] 1390 [symbolp &optional form form &rest form]) 1391 body))) 1392 (pcase-let* ((bind (and (symbolp (car args)) 1393 (pop args))) 1394 (`((,class ,value ,hide . ,args) . ,body) args) 1395 (obj (cl-gensym "section"))) 1396 `(let* ((,obj (magit-insert-section--create 1397 ,(if (eq (car-safe class) 'eval) (cadr class) `',class) 1398 ,value ,hide ,@args)) 1399 (magit-insert-section--current ,obj) 1400 (magit-insert-section--oldroot 1401 (or magit-insert-section--oldroot 1402 (and (not magit-insert-section--parent) 1403 (prog1 magit-root-section 1404 (setq magit-root-section ,obj))))) 1405 (magit-insert-section--parent ,obj)) 1406 (catch 'cancel-section 1407 ,@(if bind `((let ((,bind ,obj)) ,@body)) body) 1408 (magit-insert-section--finish ,obj)) 1409 ,obj))) 1410 1411 (defun magit-insert-section--create (class value hide &rest args) 1412 (let (type) 1413 (if (class-p class) 1414 (setq type (or (car (rassq class magit--section-type-alist)) 1415 class)) 1416 (setq type class) 1417 (setq class (or (cdr (assq class magit--section-type-alist)) 1418 'magit-section))) 1419 (let ((obj (apply class :type type args))) 1420 (oset obj value value) 1421 (oset obj parent magit-insert-section--parent) 1422 (oset obj start (if magit-section-inhibit-markers (point) (point-marker))) 1423 (unless (slot-boundp obj 'hidden) 1424 (oset obj hidden 1425 (let (set old) 1426 (cond 1427 ((setq set (run-hook-with-args-until-success 1428 'magit-section-set-visibility-hook obj)) 1429 (eq set 'hide)) 1430 ((setq old (and (not magit-section-preserve-visibility) 1431 magit-insert-section--oldroot 1432 (magit-get-section 1433 (magit-section-ident obj) 1434 magit-insert-section--oldroot))) 1435 (oref old hidden)) 1436 ((setq set (magit-section-match-assoc 1437 obj magit-section-initial-visibility-alist)) 1438 (eq (if (functionp set) (funcall set obj) set) 'hide)) 1439 (hide))))) 1440 (unless (oref obj keymap) 1441 (let ((type (oref obj type))) 1442 (oset obj keymap 1443 (or (let ((sym (intern (format "magit-%s-section-map" type)))) 1444 (and (boundp sym) sym)) 1445 (let ((sym (intern (format "forge-%s-section-map" type)))) 1446 (and (boundp sym) sym)))))) 1447 obj))) 1448 1449 (defun magit-insert-section--finish (obj) 1450 (run-hooks 'magit-insert-section-hook) 1451 (let ((beg (oref obj start)) 1452 (end (oset obj end 1453 (if magit-section-inhibit-markers 1454 (point) 1455 (point-marker)))) 1456 (props `( magit-section ,obj 1457 ,@(and-let* ((map (symbol-value (oref obj keymap)))) 1458 (list 'keymap map))))) 1459 (unless magit-section-inhibit-markers 1460 (set-marker-insertion-type beg t)) 1461 (cond ((eq obj magit-root-section)) 1462 ((oref obj children) 1463 (magit-insert-child-count obj) 1464 (magit-section-maybe-add-heading-map obj) 1465 (save-excursion 1466 (goto-char beg) 1467 (while (< (point) end) 1468 (let ((next (or (next-single-property-change 1469 (point) 'magit-section) 1470 end))) 1471 (unless (magit-section-at) 1472 (add-text-properties (point) next props)) 1473 (goto-char next))))) 1474 ((add-text-properties beg end props))) 1475 (cond ((eq obj magit-root-section) 1476 (when (eq magit-section-inhibit-markers 'delay) 1477 (setq magit-section-inhibit-markers nil) 1478 (magit-map-sections 1479 (lambda (section) 1480 (oset section start (copy-marker (oref section start) t)) 1481 (oset section end (copy-marker (oref section end) t))))) 1482 (let ((magit-section-cache-visibility nil)) 1483 (magit-section-show obj))) 1484 (magit-section-insert-in-reverse 1485 (push obj (oref (oref obj parent) children))) 1486 ((let ((parent (oref obj parent))) 1487 (oset parent children 1488 (nconc (oref parent children) 1489 (list obj)))))) 1490 (when magit-section-insert-in-reverse 1491 (oset obj children (nreverse (oref obj children)))))) 1492 1493 (defun magit-cancel-section (&optional if-empty) 1494 "Cancel inserting the section that is currently being inserted. 1495 1496 Canceling returns from the inner most use of `magit-insert-section' and 1497 removes all text that was inserted by that. 1498 1499 If optional IF-EMPTY is non-nil, then only cancel the section, if it is 1500 empty. If a section is split into a heading and a body (i.e., when its 1501 `content' slot is non-nil), then only check if the body is empty." 1502 (when (and magit-insert-section--current 1503 (or (not if-empty) 1504 (= (point) (or (oref magit-insert-section--current content) 1505 (oref magit-insert-section--current start))))) 1506 (if (eq magit-insert-section--current magit-root-section) 1507 (insert "(empty)\n") 1508 (delete-region (oref magit-insert-section--current start) 1509 (point)) 1510 (setq magit-insert-section--current nil) 1511 (throw 'cancel-section nil)))) 1512 1513 (defun magit-insert-heading (&rest args) 1514 "Insert the heading for the section currently being inserted. 1515 1516 This function should only be used inside `magit-insert-section'. 1517 1518 When called without any arguments, then just set the `content' 1519 slot of the object representing the section being inserted to 1520 a marker at `point'. The section should only contain a single 1521 line when this function is used like this. 1522 1523 When called with arguments ARGS, which have to be strings, or 1524 nil, then insert those strings at point. The section should not 1525 contain any text before this happens and afterwards it should 1526 again only contain a single line. If the `face' property is set 1527 anywhere inside any of these strings, then insert all of them 1528 unchanged. Otherwise use the `magit-section-heading' face for 1529 all inserted text. 1530 1531 The `content' property of the section object is the end of the 1532 heading (which lasts from `start' to `content') and the beginning 1533 of the the body (which lasts from `content' to `end'). If the 1534 value of `content' is nil, then the section has no heading and 1535 its body cannot be collapsed. If a section does have a heading, 1536 then its height must be exactly one line, including a trailing 1537 newline character. This isn't enforced, you are responsible for 1538 getting it right. The only exception is that this function does 1539 insert a newline character if necessary 1540 1541 If provided, optional CHILD-COUNT must evaluate to an integer or 1542 boolean. If t, then the count is determined once the children have been 1543 inserted, using `magit-insert-child-count' (which see). For historic 1544 reasons, if the heading ends with \":\", the count is substituted for 1545 that, at this time as well. If `magit-section-show-child-count' is nil, 1546 no counts are inserted 1547 1548 \n(fn [CHILD-COUNT] &rest STRINGS)" 1549 (declare (indent defun)) 1550 (when args 1551 (let ((count (and (or (integerp (car args)) 1552 (booleanp (car args))) 1553 (pop args))) 1554 (heading (apply #'concat args))) 1555 (insert (if (or (text-property-not-all 0 (length heading) 1556 'font-lock-face nil heading) 1557 (text-property-not-all 0 (length heading) 1558 'face nil heading)) 1559 heading 1560 (propertize heading 'font-lock-face 'magit-section-heading))) 1561 (when (and count magit-section-show-child-count) 1562 (insert (propertize (format " (%s)" count) 1563 'font-lock-face 'magit-section-child-count))))) 1564 (unless (bolp) 1565 (insert ?\n)) 1566 (when (fboundp 'magit-maybe-make-margin-overlay) 1567 (magit-maybe-make-margin-overlay)) 1568 (oset magit-insert-section--current content 1569 (if magit-section-inhibit-markers (point) (point-marker)))) 1570 1571 (defmacro magit-insert-section-body (&rest body) 1572 "Use BODY to insert the section body, once the section is expanded. 1573 If the section is expanded when it is created, then this is 1574 like `progn'. Otherwise BODY isn't evaluated until the section 1575 is explicitly expanded." 1576 (declare (indent 0)) 1577 (let ((f (cl-gensym)) 1578 (s (cl-gensym)) 1579 (l (cl-gensym))) 1580 `(let ((,f (lambda () ,@body))) 1581 (if (oref magit-insert-section--current hidden) 1582 (oset magit-insert-section--current washer 1583 (let ((,s magit-insert-section--current)) 1584 (lambda () 1585 (let ((,l (magit-section-lineage ,s t))) 1586 (dolist (s ,l) 1587 (set-marker-insertion-type (oref s end) t)) 1588 (funcall ,f) 1589 (dolist (s ,l) 1590 (set-marker-insertion-type (oref s end) nil)) 1591 (magit-section-maybe-remove-heading-map ,s) 1592 (magit-section-maybe-remove-visibility-indicator ,s))))) 1593 (funcall ,f))))) 1594 1595 (defun magit-insert-headers (hook) 1596 (let* ((header-sections nil) 1597 (fn (lambda () (push magit-insert-section--current header-sections)))) 1598 (unwind-protect 1599 (progn 1600 (add-hook 'magit-insert-section-hook fn -90 t) 1601 (magit-run-section-hook hook) 1602 (when header-sections 1603 (insert "\n") 1604 ;; Make the first header into the parent of the rest. 1605 (when (cdr header-sections) 1606 (setq header-sections (nreverse header-sections)) 1607 (let* ((1st-header (pop header-sections)) 1608 (header-parent (oref 1st-header parent))) 1609 (oset header-parent children (list 1st-header)) 1610 (oset 1st-header children header-sections) 1611 (oset 1st-header content (oref (car header-sections) start)) 1612 (oset 1st-header end (oref (car (last header-sections)) end)) 1613 (dolist (sub-header header-sections) 1614 (oset sub-header parent 1st-header)) 1615 (magit-section-maybe-add-heading-map 1st-header))))) 1616 (remove-hook 'magit-insert-section-hook fn t)))) 1617 1618 (defun magit-section-maybe-add-heading-map (section) 1619 (when (magit-section-content-p section) 1620 (let ((start (oref section start)) 1621 (map (oref section keymap))) 1622 (when (symbolp map) 1623 (setq map (symbol-value map))) 1624 (put-text-property 1625 start 1626 (save-excursion 1627 (goto-char start) 1628 (line-end-position)) 1629 'keymap (if map 1630 (make-composed-keymap 1631 (list map magit-section-heading-map)) 1632 magit-section-heading-map))))) 1633 1634 (defun magit-section-maybe-remove-heading-map (section) 1635 (with-slots (start content end keymap) section 1636 (when (= content end) 1637 (put-text-property start end 'keymap 1638 (if (symbolp keymap) (symbol-value 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 (when (stringp object) 2272 (unless beg (setq beg 0)) 2273 (unless end (setq end (length object)))) 2274 (while (< beg end) 2275 (let* ((pos (next-single-property-change beg 'font-lock-face object end)) 2276 (val (get-text-property beg 'font-lock-face object)) 2277 (val (ensure-list val))) 2278 (put-text-property beg pos 'font-lock-face 2279 (if append 2280 (append val (list face)) 2281 (cons face val)) 2282 object) 2283 (setq beg pos))) 2284 object) 2285 2286 (defun magit--propertize-face (string face) 2287 (propertize string 'face face 'font-lock-face face)) 2288 2289 (defun magit--put-face (beg end face string) 2290 (put-text-property beg end 'face face string) 2291 (put-text-property beg end 'font-lock-face face string)) 2292 2293 ;;; Imenu Support 2294 2295 (defvar-local magit--imenu-group-types nil) 2296 (defvar-local magit--imenu-item-types nil) 2297 2298 (defun magit--imenu-create-index () 2299 ;; If `which-function-mode' is active, then the create-index 2300 ;; function is called at the time the major-mode is being enabled. 2301 ;; Modes that derive from `magit-mode' have not populated the buffer 2302 ;; at that time yet, so we have to abort. 2303 (and magit-root-section 2304 (or magit--imenu-group-types 2305 magit--imenu-item-types) 2306 (let ((index 2307 (cl-mapcan 2308 (lambda (section) 2309 (cond 2310 (magit--imenu-group-types 2311 (and (if (eq (car-safe magit--imenu-group-types) 'not) 2312 (not (magit-section-match 2313 (cdr magit--imenu-group-types) 2314 section)) 2315 (magit-section-match magit--imenu-group-types section)) 2316 (and-let* ((children (oref section children))) 2317 `((,(magit--imenu-index-name section) 2318 ,@(mapcar (lambda (s) 2319 (cons (magit--imenu-index-name s) 2320 (oref s start))) 2321 children)))))) 2322 (magit--imenu-item-types 2323 (and (magit-section-match magit--imenu-item-types section) 2324 `((,(magit--imenu-index-name section) 2325 . ,(oref section start))))))) 2326 (oref magit-root-section children)))) 2327 (if (and magit--imenu-group-types (symbolp magit--imenu-group-types)) 2328 (cdar index) 2329 index)))) 2330 2331 (defun magit--imenu-index-name (section) 2332 (let ((heading (buffer-substring-no-properties 2333 (oref section start) 2334 (1- (or (oref section content) 2335 (oref section end)))))) 2336 (save-match-data 2337 (cond 2338 ((and (magit-section-match [commit logbuf] section) 2339 (string-match "[^ ]+\\([ *|]*\\).+" heading)) 2340 (replace-match " " t t heading 1)) 2341 ((magit-section-match 2342 '([branch local branchbuf] [tag tags branchbuf]) section) 2343 (oref section value)) 2344 ((magit-section-match [branch remote branchbuf] section) 2345 (concat (oref (oref section parent) value) "/" 2346 (oref section value))) 2347 ((string-match " ([0-9]+)\\'" heading) 2348 (substring heading 0 (match-beginning 0))) 2349 (t heading))))) 2350 2351 (defun magit--imenu-goto-function (_name position &rest _rest) 2352 "Go to the section at POSITION. 2353 Make sure it is visible, by showing its ancestors where 2354 necessary. For use as `imenu-default-goto-function' in 2355 `magit-mode' buffers." 2356 (goto-char position) 2357 (let ((section (magit-current-section))) 2358 (while (setq section (oref section parent)) 2359 (when (oref section hidden) 2360 (magit-section-show section))))) 2361 2362 ;;; Bookmark support 2363 2364 (declare-function bookmark-get-filename "bookmark" (bookmark-name-or-record)) 2365 (declare-function bookmark-make-record-default "bookmark" 2366 (&optional no-file no-context posn)) 2367 (declare-function bookmark-prop-get "bookmark" (bookmark-name-or-record prop)) 2368 (declare-function bookmark-prop-set "bookmark" (bookmark-name-or-record prop val)) 2369 2370 (cl-defgeneric magit-bookmark-get-filename () 2371 (or (buffer-file-name) (buffer-name))) 2372 2373 (cl-defgeneric magit-bookmark--get-child-value (section) 2374 (oref section value)) 2375 2376 (cl-defgeneric magit-bookmark-get-buffer-create (bookmark mode)) 2377 2378 (defun magit--make-bookmark () 2379 "Create a bookmark for the current Magit buffer. 2380 Input values are the major-mode's `magit-bookmark-name' method, 2381 and the buffer-local values of the variables referenced in its 2382 `magit-bookmark-variables' property." 2383 (require 'bookmark) 2384 (if (plist-member (symbol-plist major-mode) 'magit-bookmark-variables) 2385 ;; `bookmark-make-record-default's return value does not match 2386 ;; (NAME . ALIST), even though it is used as the default value 2387 ;; of `bookmark-make-record-function', which states that such 2388 ;; functions must do that. See #4356. 2389 (let ((bookmark (cons nil (bookmark-make-record-default 'no-file)))) 2390 (bookmark-prop-set bookmark 'handler #'magit--handle-bookmark) 2391 (bookmark-prop-set bookmark 'mode major-mode) 2392 (bookmark-prop-set bookmark 'filename (magit-bookmark-get-filename)) 2393 (bookmark-prop-set bookmark 'defaults (list (magit-bookmark-name))) 2394 (dolist (var (get major-mode 'magit-bookmark-variables)) 2395 (bookmark-prop-set bookmark var (symbol-value var))) 2396 (bookmark-prop-set 2397 bookmark 'magit-hidden-sections 2398 (--keep (and (oref it hidden) 2399 (cons (oref it type) 2400 (magit-bookmark--get-child-value it))) 2401 (oref magit-root-section children))) 2402 bookmark) 2403 (user-error "Bookmarking is not implemented for %s buffers" major-mode))) 2404 2405 ;;;###autoload 2406 (defun magit--handle-bookmark (bookmark) 2407 "Open a bookmark created by `magit--make-bookmark'. 2408 2409 Call the generic function `magit-bookmark-get-buffer-create' to get 2410 the appropriate buffer without displaying it. 2411 2412 Then call the `magit-*-setup-buffer' function of the the major-mode 2413 with the variables' values as arguments, which were recorded by 2414 `magit--make-bookmark'." 2415 (require (quote magit-bookmark) nil t) 2416 (let ((buffer (magit-bookmark-get-buffer-create 2417 bookmark 2418 (bookmark-prop-get bookmark 'mode)))) 2419 (set-buffer buffer) ; That is the interface we have to adhere to. 2420 (when-let ((hidden (bookmark-prop-get bookmark 'magit-hidden-sections))) 2421 (with-current-buffer buffer 2422 (dolist (child (oref magit-root-section children)) 2423 (if (member (cons (oref child type) 2424 (oref child value)) 2425 hidden) 2426 (magit-section-hide child) 2427 (magit-section-show child))))) 2428 ;; Compatibility with `bookmark+' package. See #4356. 2429 (when (bound-and-true-p bmkp-jump-display-function) 2430 (funcall bmkp-jump-display-function (current-buffer))) 2431 nil)) 2432 2433 (put 'magit--handle-bookmark 'bookmark-handler-type "Magit") 2434 2435 (cl-defgeneric magit-bookmark-name () 2436 "Return name for bookmark to current buffer." 2437 (format "%s%s" 2438 (substring (symbol-name major-mode) 0 -5) 2439 (if-let ((vars (get major-mode 'magit-bookmark-variables))) 2440 (cl-mapcan (lambda (var) 2441 (let ((val (symbol-value var))) 2442 (if (and val (atom val)) 2443 (list val) 2444 val))) 2445 vars) 2446 ""))) 2447 2448 ;;; Bitmaps 2449 2450 (when (fboundp 'define-fringe-bitmap) ;for Emacs 26 2451 (define-fringe-bitmap 'magit-fringe-bitmap+ 2452 [#b00000000 2453 #b00011000 2454 #b00011000 2455 #b01111110 2456 #b01111110 2457 #b00011000 2458 #b00011000 2459 #b00000000]) 2460 2461 (define-fringe-bitmap 'magit-fringe-bitmap- 2462 [#b00000000 2463 #b00000000 2464 #b00000000 2465 #b01111110 2466 #b01111110 2467 #b00000000 2468 #b00000000 2469 #b00000000]) 2470 2471 (define-fringe-bitmap 'magit-fringe-bitmap> 2472 [#b01100000 2473 #b00110000 2474 #b00011000 2475 #b00001100 2476 #b00011000 2477 #b00110000 2478 #b01100000 2479 #b00000000]) 2480 2481 (define-fringe-bitmap 'magit-fringe-bitmapv 2482 [#b00000000 2483 #b10000010 2484 #b11000110 2485 #b01101100 2486 #b00111000 2487 #b00010000 2488 #b00000000 2489 #b00000000]) 2490 2491 (define-fringe-bitmap 'magit-fringe-bitmap-bold> 2492 [#b11100000 2493 #b01110000 2494 #b00111000 2495 #b00011100 2496 #b00011100 2497 #b00111000 2498 #b01110000 2499 #b11100000]) 2500 2501 (define-fringe-bitmap 'magit-fringe-bitmap-boldv 2502 [#b10000001 2503 #b11000011 2504 #b11100111 2505 #b01111110 2506 #b00111100 2507 #b00011000 2508 #b00000000 2509 #b00000000]) 2510 ) 2511 2512 ;;; _ 2513 (provide 'magit-section) 2514 ;;; magit-section.el ends here