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