config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

magit-section.el (104583B)


      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: 20241206.2214
     12 ;; Package-Revision: 7adad8c8d3bd
     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               (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               (mapcan (lambda (var) (ensure-list (symbol-value var))) vars)
   2441             "")))
   2442 
   2443 ;;; Bitmaps
   2444 
   2445 (when (fboundp 'define-fringe-bitmap) ;for Emacs 26
   2446   (define-fringe-bitmap 'magit-fringe-bitmap+
   2447     [#b00000000
   2448      #b00011000
   2449      #b00011000
   2450      #b01111110
   2451      #b01111110
   2452      #b00011000
   2453      #b00011000
   2454      #b00000000])
   2455 
   2456   (define-fringe-bitmap 'magit-fringe-bitmap-
   2457     [#b00000000
   2458      #b00000000
   2459      #b00000000
   2460      #b01111110
   2461      #b01111110
   2462      #b00000000
   2463      #b00000000
   2464      #b00000000])
   2465 
   2466   (define-fringe-bitmap 'magit-fringe-bitmap>
   2467     [#b01100000
   2468      #b00110000
   2469      #b00011000
   2470      #b00001100
   2471      #b00011000
   2472      #b00110000
   2473      #b01100000
   2474      #b00000000])
   2475 
   2476   (define-fringe-bitmap 'magit-fringe-bitmapv
   2477     [#b00000000
   2478      #b10000010
   2479      #b11000110
   2480      #b01101100
   2481      #b00111000
   2482      #b00010000
   2483      #b00000000
   2484      #b00000000])
   2485 
   2486   (define-fringe-bitmap 'magit-fringe-bitmap-bold>
   2487     [#b11100000
   2488      #b01110000
   2489      #b00111000
   2490      #b00011100
   2491      #b00011100
   2492      #b00111000
   2493      #b01110000
   2494      #b11100000])
   2495 
   2496   (define-fringe-bitmap 'magit-fringe-bitmap-boldv
   2497     [#b10000001
   2498      #b11000011
   2499      #b11100111
   2500      #b01111110
   2501      #b00111100
   2502      #b00011000
   2503      #b00000000
   2504      #b00000000])
   2505   )
   2506 
   2507 ;;; _
   2508 (provide 'magit-section)
   2509 ;;; magit-section.el ends here