mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 21067e7cbe6d7a0f65ff5c317a96b5c337b0b3d8
commit | author | age
5cb5f7 1 ;;; magit-section.el --- section functionality  -*- lexical-binding: t -*-
C 2
3 ;; Copyright (C) 2010-2018  The Magit Project Contributors
4 ;;
5 ;; You should have received a copy of the AUTHORS.md file which
6 ;; lists all contributors.  If not, see http://magit.vc/authors.
7
8 ;; Author: Jonas Bernoulli <jonas@bernoul.li>
9 ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
10
11 ;; Magit is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 3, or (at your option)
14 ;; any later version.
15 ;;
16 ;; Magit is distributed in the hope that it will be useful, but WITHOUT
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
19 ;; License for more details.
20 ;;
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with Magit.  If not, see http://www.gnu.org/licenses.
23
24 ;;; Commentary:
25
26 ;; This library implements "sections" as used in all Magit buffers.
27 ;; If you have used Magit before, then you probably know what that
28 ;; means, otherwise think "read-only Org-Mode for Git", kinda.
29
30 ;;; Code:
31
32 (require 'cl-lib)
33 (require 'dash)
34 (require 'eieio)
35
36 (eval-when-compile
37   (require 'subr-x))
38
39 (require 'magit-utils)
40
41 (declare-function magit-maybe-make-margin-overlay "magit-margin" ())
42 (declare-function magit-repository-local-get "magit-mode"
43                   (key &optional default repository))
44 (declare-function magit-repository-local-set "magit-mode"
45                   (key value &optional repository))
46 (defvar magit-keep-region-overlay)
47
48 ;;; Options
49
50 (defgroup magit-section nil
51   "Expandable sections."
52   :link '(info-link "(magit)Sections")
53   :group 'magit)
54
55 (defcustom magit-section-show-child-count t
56   "Whether to append the number of children to section headings.
57 This only applies to sections for which doing so makes sense."
58   :package-version '(magit . "2.1.0")
59   :group 'magit-section
60   :type 'boolean)
61
62 (defcustom magit-section-movement-hook
63   '(magit-hunk-set-window-start
64     magit-log-maybe-update-revision-buffer
65     magit-log-maybe-show-more-commits)
66   "Hook run by `magit-section-goto'.
67 That function in turn is used by all section movement commands."
68   :package-version '(magit . "2.3.0")
69   :group 'magit-section
70   :type 'hook
71   :options '(magit-hunk-set-window-start
72              magit-status-maybe-update-revision-buffer
73              magit-status-maybe-update-blob-buffer
74              magit-log-maybe-update-revision-buffer
75              magit-log-maybe-update-blob-buffer
76              magit-log-maybe-show-more-commits))
77
78 (defcustom magit-section-highlight-hook
79   '(magit-diff-highlight
80     magit-section-highlight
81     magit-section-highlight-selection)
82   "Functions used to highlight the current section.
83 Each function is run with the current section as only argument
84 until one of them returns non-nil."
85   :package-version '(magit . "2.1.0")
86   :group 'magit-section
87   :type 'hook
88   :options '(magit-diff-highlight
89              magit-section-highlight
90              magit-section-highlight-selection))
91
92 (defcustom magit-section-unhighlight-hook
93   '(magit-diff-unhighlight)
94   "Functions used to unhighlight the previously current section.
95 Each function is run with the current section as only argument
96 until one of them returns non-nil.  Most sections are properly
97 unhighlighted without requiring a specialized unhighlighter,
98 diff-related sections being the only exception."
99   :package-version '(magit . "2.1.0")
100   :group 'magit-section
101   :type 'hook
102   :options '(magit-diff-unhighlight))
103
104 (defcustom magit-section-set-visibility-hook
105   '(magit-diff-expansion-threshold
106     magit-section-cached-visibility)
107   "Hook used to set the initial visibility of a section.
108 Stop at the first function that returns non-nil.  The returned
109 value should be `show', `hide' or nil.  If no function returns
110 non-nil, determine the visibility as usual, i.e. use the
111 hardcoded section specific default (see `magit-insert-section')."
112   :package-version '(magit . "2.4.0")
113   :group 'magit-section
114   :type 'hook
115   :options '(magit-diff-expansion-threshold
116              magit-section-cached-visibility))
117
118 (defcustom magit-section-cache-visibility t
119   "Whether to cache visibility of sections.
120
121 Sections always retain their visibility state when they are being
122 recreated during a refresh.  But if a section disappears and then
123 later reappears again, then this option controls whether this is
124 the case.
125
126 If t, then cache the visibility of all sections.  If a list of
127 section types, then only do so for matching sections.  If nil,
128 then don't do so for any sections."
129   :package-version '(magit . "2.12.0")
130   :group 'magit-section
131   :type '(choice (const  :tag "Don't cache visibility" nil)
132                  (const  :tag "Cache visibility of all sections" t)
133                  (repeat :tag "Cache visibility for section types" symbol)))
134
135 (defcustom magit-section-initial-visibility-alist
136   '((stashes . hide))
137   "Alist controlling the initial visibility of sections.
138
139 Each element maps a section type or lineage to the initial
140 visibility state for such sections.  The state has to be one of
141 `show' or `hide', or a function that returns one of these symbols.
142 A function is called with the section as the only argument.
143
144 Use the command `magit-describe-section' to determine a section's
145 lineage or type.  The vector in the output is the section lineage
146 and the type is the first element of that vector.  Wildcards can
147 be used, see `magit-section-match'.
148
149 Currently this option is only used to override hardcoded defaults,
150 but in the future it will also be used set the defaults.
151
152 An entry whose key is `magit-status-initial-section' specifies
153 the visibility of the section `magit-status-goto-initial-section'
154 jumps to.  This does not only override defaults, but also other
155 entries of this alist."
156   :package-version '(magit . "2.12.0")
157   :group 'magit-section
158   :type '(alist :key-type (sexp :tag "Section type/lineage")
159                 :value-type (choice (const hide)
160                                     (const show)
161                                     function)))
162
163 (defface magit-section-highlight
164   '((((class color) (background light)) :background "grey95")
165     (((class color) (background  dark)) :background "grey20"))
166   "Face for highlighting the current section."
167   :group 'magit-faces)
168
169 (defface magit-section-heading
170   '((((class color) (background light)) :foreground "DarkGoldenrod4" :weight bold)
171     (((class color) (background  dark)) :foreground "LightGoldenrod2" :weight bold))
172   "Face for section headings."
173   :group 'magit-faces)
174
175 (defface magit-section-secondary-heading '((t :weight bold))
176   "Face for section headings of some secondary headings."
177   :group 'magit-faces)
178
179 (defface magit-section-heading-selection
180   '((((class color) (background light)) :foreground "salmon4")
181     (((class color) (background  dark)) :foreground "LightSalmon3"))
182   "Face for selected section headings."
183   :group 'magit-faces)
184
185 ;;; Classes
186
187 (defvar magit--current-section-hook nil
188   "Internal variable used for `magit-explain-section'.")
189
190 (defvar magit--section-type-alist
191   '(
192     (file            . magit-file-section)
193     (hunk            . magit-hunk-section)
194     (module          . magit-module-section)
195     ))
196
197 (defclass magit-section ()
198   ((keymap   :initform nil :allocation :class)
199    (type     :initform nil :initarg :type)
200    (value    :initform nil :initarg :value)
201    (start    :initform nil :initarg :start)
202    (content  :initform nil)
203    (end      :initform nil)
204    (hidden   :initform nil)
205    (washer   :initform nil)
206    (process  :initform nil)
207    (heading-highlight-face :initform nil)
208    (inserter :initform (symbol-value 'magit--current-section-hook))
209    (parent   :initform nil :initarg :parent)
210    (children :initform nil)))
211
212 (defclass magit-file-section (magit-section)
213   ((source   :initform nil)
214    (header   :initform nil)))
215
216 (defclass magit-hunk-section (magit-section)
217   ((refined  :initform nil)))
218
219 (defclass magit-module-section (magit-file-section)
220   ())
221
222 ;;; Core
223
224 (defvar-local magit-root-section nil
225   "The root section in the current buffer.
226 All other sections are descendants of this section.  The value
227 of this variable is set by `magit-insert-section' and you should
228 never modify it.")
229 (put 'magit-root-section 'permanent-local t)
230
231 (defun magit-current-section ()
232   "Return the section at point."
233   (or (get-text-property (point) 'magit-section) magit-root-section))
234
235 (defun magit-section-ident (section)
236   "Return an unique identifier for SECTION.
237 The return value has the form ((TYPE . VALUE)...)."
238   (with-slots (type value parent) section
239     (cons (cons type
240                 (cond ((not (memq type '(unpulled unpushed))) value)
241                       ((string-match-p "@{upstream}" value) value)
242                       ;; Unfortunately Git chokes on "@{push}" when
243                       ;; the value of `push.default' does not allow a
244                       ;; 1:1 mapping.  Arbitrary commands may consult
245                       ;; the section value so we cannot use "@{push}".
246                       ;; But `unpushed' and `unpulled' sections should
247                       ;; keep their identity when switching branches
248                       ;; so we have to use another value here.
249                       ((string-match-p "\\`\\.\\." value) "..@{push}")
250                       (t "@{push}..")))
251           (and parent
252                (magit-section-ident parent)))))
253
254 (defun magit-get-section (ident &optional root)
255   "Return the section identified by IDENT.
256 IDENT has to be a list as returned by `magit-section-ident'."
257   (setq ident (reverse ident))
258   (let ((section (or root magit-root-section)))
259     (when (eq (car (pop ident))
260               (oref section type))
261       (while (and ident
262                   (setq section
263                         (--first
264                          (and (eq    (caar ident) (oref it type))
265                               (equal (cdar ident) (oref it value)))
266                          (oref section children))))
267         (pop ident))
268       section)))
269
270 (defun magit-section-lineage (section)
271   "Return the lineage of SECTION.
272 The return value has the form (TYPE...)."
273   (cons (oref section type)
274         (when-let ((parent (oref section parent)))
275           (magit-section-lineage parent))))
276
277 (defvar magit-insert-section--current nil "For internal use only.")
278 (defvar magit-insert-section--parent  nil "For internal use only.")
279 (defvar magit-insert-section--oldroot nil "For internal use only.")
280
281 ;;; Commands
282 ;;;; Movement
283
284 (defun magit-section-forward ()
285   "Move to the beginning of the next visible section."
286   (interactive)
287   (if (eobp)
288       (user-error "No next section")
289     (let ((section (magit-current-section)))
290       (if (oref section parent)
291           (let ((next (and (not (oref section hidden))
292                            (not (= (oref section end)
293                                    (1+ (point))))
294                            (car (oref section children)))))
295             (while (and section (not next))
296               (unless (setq next (car (magit-section-siblings section 'next)))
297                 (setq section (oref section parent))))
298             (if next
299                 (magit-section-goto next)
300               (user-error "No next section")))
301         (magit-section-goto 1)))))
302
303 (defun magit-section-backward ()
304   "Move to the beginning of the current or the previous visible section.
305 When point is at the beginning of a section then move to the
306 beginning of the previous visible section.  Otherwise move to
307 the beginning of the current section."
308   (interactive)
309   (if (bobp)
310       (user-error "No previous section")
311     (let ((section (magit-current-section)) children)
312       (cond
313        ((and (= (point)
314                 (1- (oref section end)))
315              (setq children (oref section children)))
316         (magit-section-goto (car (last children))))
317        ((and (oref section parent)
318              (not (= (point)
319                      (oref section start))))
320         (magit-section-goto section))
321        (t
322         (let ((prev (car (magit-section-siblings section 'prev))))
323           (if prev
324               (while (and (not (oref prev hidden))
325                           (setq children (oref prev children)))
326                 (setq prev (car (last children))))
327             (setq prev (oref section parent)))
328           (cond (prev
329                  (magit-section-goto prev))
330                 ((oref section parent)
331                  (user-error "No previous section"))
332                 ;; Eob special cases.
333                 ((not (get-text-property (1- (point)) 'invisible))
334                  (magit-section-goto -1))
335                 (t
336                  (goto-char (previous-single-property-change
337                              (1- (point)) 'invisible))
338                  (forward-line -1)
339                  (magit-section-goto (magit-current-section))))))))))
340
341 (defun magit-section-up ()
342   "Move to the beginning of the parent section."
343   (interactive)
344   (--if-let (oref (magit-current-section) parent)
345       (magit-section-goto it)
346     (user-error "No parent section")))
347
348 (defun magit-section-forward-sibling ()
349   "Move to the beginning of the next sibling section.
350 If there is no next sibling section, then move to the parent."
351   (interactive)
352   (let ((current (magit-current-section)))
353     (if (oref current parent)
354         (--if-let (car (magit-section-siblings current 'next))
355             (magit-section-goto it)
356           (magit-section-forward))
357       (magit-section-goto 1))))
358
359 (defun magit-section-backward-sibling ()
360   "Move to the beginning of the previous sibling section.
361 If there is no previous sibling section, then move to the parent."
362   (interactive)
363   (let ((current (magit-current-section)))
364     (if (oref current parent)
365         (--if-let (car (magit-section-siblings current 'prev))
366             (magit-section-goto it)
367           (magit-section-backward))
368       (magit-section-goto -1))))
369
370 (defun magit-section-goto (arg)
371   (if (integerp arg)
372       (progn (forward-line arg)
373              (setq arg (magit-current-section)))
374     (goto-char (oref arg start)))
375   (run-hook-with-args 'magit-section-movement-hook arg))
376
377 (defun magit-section-set-window-start (section)
378   "Ensure the beginning of SECTION is visible."
379   (unless (pos-visible-in-window-p (oref section end))
380     (set-window-start (selected-window) (oref section start))))
381
382 (defun magit-hunk-set-window-start (section)
383   "When SECTION is a `hunk', ensure that its beginning is visible.
384 It the SECTION has a different type, then do nothing."
385   (when (magit-hunk-section-p section)
386     (magit-section-set-window-start section)))
387
388 (defmacro magit-define-section-jumper (name heading type &optional value)
389   "Define an interactive function to go some section.
390 Together TYPE and VALUE identify the section.
391 HEADING is the displayed heading of the section."
392   (declare (indent defun))
393   `(defun ,name (&optional expand) ,(format "\
394 Jump to the section \"%s\".
395 With a prefix argument also expand it." heading)
396      (interactive "P")
397      (--if-let (magit-get-section
398                 (cons (cons ',type ,value)
399                       (magit-section-ident magit-root-section)))
400          (progn (goto-char (oref it start))
401                 (when expand
402                   (with-local-quit (magit-section-show it))
403                   (recenter 0)))
404        (message ,(format "Section \"%s\" wasn't found" heading)))))
405
406 ;;;; Visibility
407
408 (defun magit-section-show (section)
409   "Show the body of the current section."
410   (interactive (list (magit-current-section)))
411   (oset section hidden nil)
412   (when-let ((washer (oref section washer)))
413     (oset section washer nil)
414     (let ((inhibit-read-only t)
415           (magit-insert-section--parent section)
416           (content (oref section content)))
417       (save-excursion
418         (if (and content (< content (oref section end)))
419             (funcall washer section) ; already partially washed (hunk)
420           (goto-char (oref section end))
421           (oset section content (point-marker))
422           (funcall washer)
423           (oset section end (point-marker)))))
424     (magit-section-update-highlight))
425   (when-let ((beg (oref section content)))
426     (remove-overlays beg (oref section end) 'invisible t))
427   (magit-section-maybe-cache-visibility section)
428   (dolist (child (oref section children))
429     (if (oref child hidden)
430         (magit-section-hide child)
431       (magit-section-show child))))
432
433 (defun magit-section-hide (section)
434   "Hide the body of the current section."
435   (interactive (list (magit-current-section)))
436   (if (eq section magit-root-section)
437       (user-error "Cannot hide root section")
438     (oset section hidden t)
439     (when-let ((beg (oref section content)))
440       (let ((end (oref section end)))
441         (remove-overlays beg end 'invisible t)
442         (let ((o (make-overlay beg end)))
443           (overlay-put o 'evaporate t)
444           (overlay-put o 'invisible t))))
445     (magit-section-maybe-cache-visibility section)))
446
447 (defun magit-section-toggle (section)
448   "Toggle visibility of the body of the current section."
449   (interactive (list (magit-current-section)))
450   (if (eq section magit-root-section)
451       (user-error "Cannot hide root section")
452     (goto-char (oref section start))
453     (if (oref section hidden)
454         (magit-section-show section)
455       (magit-section-hide section))))
456
457 (defun magit-section-toggle-children (section)
458   "Toggle visibility of bodies of children of the current section."
459   (interactive (list (magit-current-section)))
460   (goto-char (oref section start))
461   (let* ((children (oref section children))
462          (show (--any-p (oref it hidden) children)))
463     (dolist (c children)
464       (oset c hidden show)))
465   (magit-section-show section))
466
467 (defun magit-section-show-children (section &optional depth)
468   "Recursively show the bodies of children of the current section.
469 With a prefix argument show children that deep and hide deeper
470 children."
471   (interactive (list (magit-current-section)))
472   (magit-section-show-children-1 section depth)
473   (magit-section-show section))
474
475 (defun magit-section-show-children-1 (section &optional depth)
476   (dolist (child (oref section children))
477     (oset child hidden nil)
478     (if depth
479         (if (> depth 0)
480             (magit-section-show-children-1 child (1- depth))
481           (magit-section-hide child))
482       (magit-section-show-children-1 child))))
483
484 (defun magit-section-hide-children (section)
485   "Recursively hide the bodies of children of the current section."
486   (interactive (list (magit-current-section)))
487   (mapc 'magit-section-hide (oref section children)))
488
489 (defun magit-section-show-headings (section)
490   "Recursively show headings of children of the current section.
491 Only show the headings, previously shown text-only bodies are
492 hidden."
493   (interactive (list (magit-current-section)))
494   (magit-section-show-headings-1 section)
495   (magit-section-show section))
496
497 (defun magit-section-show-headings-1 (section)
498   (dolist (child (oref section children))
499     (oset child hidden nil)
500     (when (or (oref child children)
501               (not (oref child content)))
502       (magit-section-show-headings-1 child))))
503
504 (defun magit-section-cycle (section)
505   "Cycle visibility of current section and its children."
506   (interactive (list (magit-current-section)))
507   (goto-char (oref section start))
508   (if (oref section hidden)
509       (progn (magit-section-show section)
510              (magit-section-hide-children section))
511     (let ((children (oref section children)))
512       (cond ((and (--any-p (oref it hidden)   children)
513                   (--any-p (oref it children) children))
514              (magit-section-show-headings section))
515             ((-any-p 'magit-section-hidden-body children)
516              (magit-section-show-children section))
517             (t
518              (magit-section-hide section))))))
519
520 (defun magit-section-cycle-global ()
521   "Cycle visibility of all sections in the current buffer."
522   (interactive)
523   (let ((children (oref magit-root-section children)))
524     (cond ((and (--any-p (oref it hidden)   children)
525                 (--any-p (oref it children) children))
526            (magit-section-show-headings magit-root-section))
527           ((-any-p 'magit-section-hidden-body children)
528            (magit-section-show-children magit-root-section))
529           (t
530            (mapc 'magit-section-hide children)))))
531
532 (defun magit-section-cycle-diffs ()
533   "Cycle visibility of diff-related sections in the current buffer."
534   (interactive)
535   (when-let ((sections
536               (cond ((derived-mode-p 'magit-status-mode)
537                      (--mapcat
538                       (when it
539                         (when (oref it hidden)
540                           (magit-section-show it))
541                         (oref it children))
542                       (list (magit-get-section '((staged)   (status)))
543                             (magit-get-section '((unstaged) (status))))))
544                     ((derived-mode-p 'magit-diff-mode)
545                      (-filter #'magit-file-section-p
546                               (oref magit-root-section children))))))
547     (if (--any-p (oref it hidden) sections)
548         (dolist (s sections)
549           (magit-section-show s)
550           (magit-section-hide-children s))
551       (let ((children (--mapcat (oref it children) sections)))
552         (cond ((and (--any-p (oref it hidden)   children)
553                     (--any-p (oref it children) children))
554                (mapc 'magit-section-show-headings sections))
555               ((-any-p 'magit-section-hidden-body children)
556                (mapc 'magit-section-show-children sections))
557               (t
558                (mapc 'magit-section-hide sections)))))))
559
560 (defun magit-section-hidden-body (section &optional pred)
561   (--if-let (oref section children)
562       (funcall (or pred '-any-p) 'magit-section-hidden-body it)
563     (and (oref section content)
564          (oref section hidden))))
565
566 (defun magit-section-invisible-p (section)
567   "Return t if the SECTION's body is invisible.
568 When the body of an ancestor of SECTION is collapsed then
569 SECTION's body (and heading) obviously cannot be visible."
570   (or (oref section hidden)
571       (--when-let (oref section parent)
572         (magit-section-invisible-p it))))
573
574 (defun magit-section-show-level (level)
575   "Show surrounding sections up to LEVEL.
576 If LEVEL is negative, show up to the absolute value.
577 Sections at higher levels are hidden."
578   (if (< level 0)
579       (let ((s (magit-current-section)))
580         (setq level (- level))
581         (while (> (1- (length (magit-section-ident s))) level)
582           (setq s (oref s parent))
583           (goto-char (oref s start)))
584         (magit-section-show-children magit-root-section (1- level)))
585     (cl-do* ((s (magit-current-section)
586                 (oref s parent))
587              (i (1- (length (magit-section-ident s)))
588                 (cl-decf i)))
589         ((cond ((< i level) (magit-section-show-children s (- level i 1)) t)
590                ((= i level) (magit-section-hide s) t))
591          (magit-section-goto s)))))
592
593 (defun magit-section-show-level-1 ()
594   "Show surrounding sections on first level."
595   (interactive)
596   (magit-section-show-level 1))
597
598 (defun magit-section-show-level-1-all ()
599   "Show all sections on first level."
600   (interactive)
601   (magit-section-show-level -1))
602
603 (defun magit-section-show-level-2 ()
604   "Show surrounding sections up to second level."
605   (interactive)
606   (magit-section-show-level 2))
607
608 (defun magit-section-show-level-2-all ()
609   "Show all sections up to second level."
610   (interactive)
611   (magit-section-show-level -2))
612
613 (defun magit-section-show-level-3 ()
614   "Show surrounding sections up to third level."
615   (interactive)
616   (magit-section-show-level 3))
617
618 (defun magit-section-show-level-3-all ()
619   "Show all sections up to third level."
620   (interactive)
621   (magit-section-show-level -3))
622
623 (defun magit-section-show-level-4 ()
624   "Show surrounding sections up to fourth level."
625   (interactive)
626   (magit-section-show-level 4))
627
628 (defun magit-section-show-level-4-all ()
629   "Show all sections up to fourth level."
630   (interactive)
631   (magit-section-show-level -4))
632
633 ;;;; Auxiliary
634
635 (defun magit-describe-section-briefly (section &optional message ident)
636   "Show information about the section at point.
637 With a prefix argument show the section identity instead of the
638 section lineage.  This command is intended for debugging purposes."
639   (interactive (list (magit-current-section) t))
640   (let ((str (format "#<%s %S %S %s-%s>"
641                      (eieio-object-class section)
642                      (let ((val (oref section value)))
643                        (cond ((stringp val)
644                               (substring-no-properties val))
645                              ((and (eieio-object-p val)
646                                    (fboundp 'cl-prin1-to-string))
647                               (cl-prin1-to-string val))
648                              (t
649                               val)))
650                      (if ident
651                          (magit-section-ident section)
652                        (apply #'vector (magit-section-lineage section)))
653                      (when-let ((m (oref section start)))
654                        (marker-position m))
655                      (when-let ((m (oref section end)))
656                        (marker-position m)))))
657     (if message (message "%s" str) str)))
658
659 (cl-defmethod cl-print-object ((section magit-section) stream)
660   "Print `magit-describe-section' result of SECTION."
661   ;; Used by debug and edebug as of Emacs 26.
662   (princ (magit-describe-section-briefly section) stream))
663
664 (defun magit-describe-section (section &optional interactive-p)
665   "Show information about the section at point."
666   (interactive (list (magit-current-section) t))
667   (let ((inserter-section section))
668     (while (and inserter-section (not (oref inserter-section inserter)))
669       (setq inserter-section (oref inserter-section parent)))
670     (when (and inserter-section (oref inserter-section inserter))
671       (setq section inserter-section)))
672   (pcase (oref section inserter)
673     (`((,hook ,fun) . ,src-src)
674      (help-setup-xref `(magit-describe-section ,section) interactive-p)
675      (with-help-window (help-buffer)
676        (with-current-buffer standard-output
677          (insert (format-message
678                   "%s\n  is inserted by `%s'\n  from `%s'"
679                   (magit-describe-section-briefly section)
680                   (make-text-button (symbol-name fun) nil
681                                     :type 'help-function
682                                     'help-args (list fun))
683                   (make-text-button (symbol-name hook) nil
684                                     :type 'help-variable
685                                     'help-args (list hook))))
686          (pcase-dolist (`(,hook ,fun) src-src)
687            (insert (format-message
688                     ",\n  called by `%s'\n  from `%s'"
689                     (make-text-button (symbol-name fun) nil
690                                       :type 'help-function
691                                       'help-args (list fun))
692                     (make-text-button (symbol-name hook) nil
693                                       :type 'help-variable
694                                       'help-args (list hook)))))
695          (insert ".\n\n")
696          (insert
697           (format-message
698            "`%s' is "
699            (make-text-button (symbol-name fun) nil
700                              :type 'help-function 'help-args (list fun))))
701          (describe-function-1 fun))))
702     (_ (message "%s, inserter unknown"
703                 (magit-describe-section-briefly section)))))
704
705 ;;; Match
706
707 (cl-defun magit-section-match
708     (condition &optional (section (magit-current-section)))
709   "Return t if SECTION matches CONDITION.
710
711 SECTION defaults to the section at point.  If SECTION is not
712 specified and there also is no section at point, then return
713 nil.
714
715 CONDITION can take the following forms:
716   (CONDITION...)  matches if any of the CONDITIONs matches.
717   [CLASS...]      matches if the section's class is the same
718                   as the first CLASS or a subclass of that;
719                   the section's parent class matches the
720                   second CLASS; and so on.
721   [* CLASS...]    matches sections that match [CLASS...] and
722                   also recursively all their child sections.
723   CLASS           matches if the section's class is the same
724                   as CLASS or a subclass of that; regardless
725                   of the classes of the parent sections.
726
727 Each CLASS should be a class symbol, identifying a class that
728 derives from `magit-section'.  For backward compatibility CLASS
729 can also be a \"type symbol\".  A section matches such a symbol
730 if the value of its `type' slot is `eq'.  If a type symbol has
731 an entry in `magit--section-type-alist', then a section also
732 matches that type if its class is a subclass of the class that
733 corresponds to the type as per that alist.
734
735 Note that it is not necessary to specify the complete section
736 lineage as printed by `magit-describe-section-briefly', unless
737 of course you want to be that precise."
738   (and section (magit-section-match-1 condition section)))
739
740 (defun magit-section-match-1 (condition section)
741   (cl-assert condition)
742   (and section
743        (if (listp condition)
744            (--first (magit-section-match-1 it section) condition)
745          (magit-section-match-2 (if (symbolp condition)
746                                     (list condition)
747                                   (cl-coerce condition 'list))
748                                 section))))
749
750 (defun magit-section-match-2 (condition section)
751   (if (eq (car condition) '*)
752       (or (magit-section-match-2 (cdr condition) section)
753           (when-let ((parent (oref section parent)))
754             (magit-section-match-2 condition parent)))
755     (and (let ((c (car condition)))
756            (if (class-p c)
757                (cl-typep section c)
758              (if-let ((class (cdr (assq c magit--section-type-alist))))
759                  (cl-typep section class)
760                (eq (oref section type) c))))
761          (or (not (setq condition (cdr condition)))
762              (when-let ((parent (oref section parent)))
763                (magit-section-match-2 condition parent))))))
764
765 (defun magit-section-value-if (condition &optional section)
766   "If the section at point matches CONDITION, then return its value.
767
768 If optional SECTION is non-nil then test whether that matches
769 instead.  If there is no section at point and SECTION is nil,
770 then return nil.  If the section does not match, then return
771 nil.
772
773 See `magit-section-match' for the forms CONDITION can take."
774   (when-let ((section (or section (magit-current-section))))
775     (and (magit-section-match condition section)
776          (oref section value))))
777
778 (defmacro magit-section-when (condition &rest body)
779   "If the section at point matches CONDITION, evaluate BODY.
780
781 If the section matches, then evaluate BODY forms sequentially
782 with `it' bound to the section and return the value of the last
783 form.  If there are no BODY forms, then return the value of the
784 section.  If the section does not match or if there is no section
785 at point, then return nil.
786
787 See `magit-section-match' for the forms CONDITION can take."
788   (declare (obsolete
789             "instead use `magit-section-match' or `magit-section-value-if'."
790             "Magit 2.90.0")
791            (indent 1)
792            (debug (sexp body)))
793   `(--when-let (magit-current-section)
794      ;; Quoting CONDITION here often leads to double-quotes, which
795      ;; isn't an issue because `magit-section-match-1' implicitly
796      ;; deals with that.  We shouldn't force users of this function
797      ;; to not quote CONDITION because that would needlessly break
798      ;; backward compatibility.
799      (when (magit-section-match ',condition it)
800        ,@(or body '((oref it value))))))
801
802 (defmacro magit-section-case (&rest clauses)
803   "Choose among clauses on the type of the section at point.
804
805 Each clause looks like (CONDITION BODY...).  The type of the
806 section is compared against each CONDITION; the BODY forms of the
807 first match are evaluated sequentially and the value of the last
808 form is returned.  Inside BODY the symbol `it' is bound to the
809 section at point.  If no clause succeeds or if there is no
810 section at point, return nil.
811
812 See `magit-section-match' for the forms CONDITION can take.
813 Additionally a CONDITION of t is allowed in the final clause, and
814 matches if no other CONDITION match, even if there is no section
815 at point."
816   (declare (indent 0)
817            (debug (&rest (sexp body))))
818   `(let* ((it (magit-current-section)))
819      (cond ,@(mapcar (lambda (clause)
820                        `(,(or (eq (car clause) t)
821                               `(and it
822                                     (magit-section-match-1 ',(car clause) it)))
823                          ,@(cdr clause)))
824                      clauses))))
825
826 (defun magit-section-match-assoc (section alist)
827   "Return the value associated with SECTION's type or lineage in ALIST."
828   (-some (pcase-lambda (`(,key . ,val))
829            (and (magit-section-match-1 key section) val))
830          alist))
831
832 ;;; Create
833
834 (defvar magit-insert-section-hook nil
835   "Hook run after `magit-insert-section's BODY.
836 Avoid using this hook and only ever do so if you know
837 what you are doing and are sure there is no other way.")
838
839 (defmacro magit-insert-section (&rest args)
840   "Insert a section at point.
841
842 TYPE is the section type, a symbol.  Many commands that act on
843 the current section behave differently depending on that type.
844 Also if a variable `magit-TYPE-section-map' exists, then use
845 that as the text-property `keymap' of all text belonging to the
846 section (but this may be overwritten in subsections).  TYPE can
847 also have the form `(eval FORM)' in which case FORM is evaluated
848 at runtime.
849
850 Optional VALUE is the value of the section, usually a string
851 that is required when acting on the section.
852
853 When optional HIDE is non-nil collapse the section body by
854 default, i.e. when first creating the section, but not when
855 refreshing the buffer.  Else expand it by default.  This can be
856 overwritten using `magit-section-set-visibility-hook'.  When a
857 section is recreated during a refresh, then the visibility of
858 predecessor is inherited and HIDE is ignored (but the hook is
859 still honored).
860
861 BODY is any number of forms that actually insert the section's
862 heading and body.  Optional NAME, if specified, has to be a
863 symbol, which is then bound to the struct of the section being
864 inserted.
865
866 Before BODY is evaluated the `start' of the section object is set
867 to the value of `point' and after BODY was evaluated its `end' is
868 set to the new value of `point'; BODY is responsible for moving
869 `point' forward.
870
871 If it turns out inside BODY that the section is empty, then
872 `magit-cancel-section' can be used to abort and remove all traces
873 of the partially inserted section.  This can happen when creating
874 a section by washing Git's output and Git didn't actually output
875 anything this time around.
876
877 \(fn [NAME] (TYPE &optional VALUE HIDE) &rest BODY)"
878   (declare (indent defun)
879            (debug ([&optional symbolp]
880                    (&or [("eval" symbolp) &optional form form]
881                         [symbolp &optional form form])
882                    body)))
883   (let ((tp (cl-gensym "type"))
884         (s* (and (symbolp (car args))
885                  (pop args)))
886         (s  (cl-gensym "section")))
887     `(let* ((,tp ,(let ((type (nth 0 (car args))))
888                     (if (eq (car-safe type) 'eval)
889                         (cadr type)
890                       `',type)))
891             (,s (funcall (if (class-p ,tp)
892                              ,tp
893                            (or (cdr (assq ,tp magit--section-type-alist))
894                                'magit-section))
895                          :type
896                          (if (class-p ,tp)
897                              (or (car (rassq ,tp magit--section-type-alist))
898                                  (error "BUG: No entry for %s in %s" ,tp
899                                         'magit--section-type-alist))
900                            ,tp)
901                          :value ,(nth 1 (car args))
902                          :start (point-marker)
903                          :parent magit-insert-section--parent)))
904        (oset ,s hidden
905              (if-let ((value (run-hook-with-args-until-success
906                               'magit-section-set-visibility-hook ,s)))
907                  (eq value 'hide)
908                (if-let ((incarnation (and magit-insert-section--oldroot
909                                           (magit-get-section
910                                            (magit-section-ident ,s)
911                                            magit-insert-section--oldroot))))
912                    (oref incarnation hidden)
913                  (if-let ((value (magit-section-match-assoc
914                                   ,s magit-section-initial-visibility-alist)))
915                      (progn
916                        (when (functionp value)
917                          (setq value (funcall value ,s)))
918                        (eq value 'hide))
919                    ,(nth 2 (car args))))))
920        (let ((magit-insert-section--current ,s)
921              (magit-insert-section--parent  ,s)
922              (magit-insert-section--oldroot
923               (or magit-insert-section--oldroot
924                   (unless magit-insert-section--parent
925                     (prog1 magit-root-section
926                       (setq magit-root-section ,s))))))
927          (catch 'cancel-section
928            ,@(if s*
929                  `((let ((,s* ,s))
930                      ,@(cdr args)))
931                (cdr args))
932            ;; `magit-insert-section-hook' should *not* be run with
933            ;; `magit-run-section-hook' because it's a hook that runs
934            ;; on section insertion, not a section inserting hook.
935            (run-hooks 'magit-insert-section-hook)
936            (magit-insert-child-count ,s)
937            (set-marker-insertion-type (oref ,s start) t)
938            (let* ((end (oset ,s end (point-marker)))
939                   (class-map (oref-default ,s keymap))
940                   (magit-map (intern (format "magit-%s-section-map"
941                                              (oref ,s type))))
942                   (forge-map (intern (format "forge-%s-section-map"
943                                              (oref ,s type))))
944                   (map (or (and         class-map  (symbol-value class-map))
945                            (and (boundp magit-map) (symbol-value magit-map))
946                            (and (boundp forge-map) (symbol-value forge-map)))))
947              (save-excursion
948                (goto-char (oref ,s start))
949                (while (< (point) end)
950                  (let ((next (or (next-single-property-change
951                                   (point) 'magit-section)
952                                  end)))
953                    (unless (get-text-property (point) 'magit-section)
954                      (put-text-property (point) next 'magit-section ,s)
955                      (when map
956                        (put-text-property (point) next 'keymap map)))
957                    (goto-char next)))))
958            (if (eq ,s magit-root-section)
959                (let ((magit-section-cache-visibility nil))
960                  (magit-section-show ,s))
961              (oset (oref ,s parent) children
962                    (nconc (oref (oref ,s parent) children)
963                           (list ,s)))))
964          ,s))))
965
966 (defun magit-cancel-section ()
967   (when magit-insert-section--current
968     (if (not (oref magit-insert-section--current parent))
969         (insert "(empty)\n")
970       (delete-region (oref magit-insert-section--current start)
971                      (point))
972       (setq magit-insert-section--current nil)
973       (throw 'cancel-section nil))))
974
975 (defun magit-insert-heading (&rest args)
976   "Insert the heading for the section currently being inserted.
977
978 This function should only be used inside `magit-insert-section'.
979
980 When called without any arguments, then just set the `content'
981 slot of the object representing the section being inserted to
982 a marker at `point'.  The section should only contain a single
983 line when this function is used like this.
984
985 When called with arguments ARGS, which have to be strings, or
986 nil, then insert those strings at point.  The section should not
987 contain any text before this happens and afterwards it should
988 again only contain a single line.  If the `face' property is set
989 anywhere inside any of these strings, then insert all of them
990 unchanged.  Otherwise use the `magit-section-heading' face for
991 all inserted text.
992
993 The `content' property of the section struct is the end of the
994 heading (which lasts from `start' to `content') and the beginning
995 of the the body (which lasts from `content' to `end').  If the
996 value of `content' is nil, then the section has no heading and
997 its body cannot be collapsed.  If a section does have a heading,
998 then its height must be exactly one line, including a trailing
999 newline character.  This isn't enforced, you are responsible for
1000 getting it right.  The only exception is that this function does
1001 insert a newline character if necessary."
1002   (declare (indent defun))
1003   (when args
1004     (let ((heading (apply #'concat args)))
1005       (insert (if (text-property-not-all 0 (length heading) 'face nil heading)
1006                   heading
1007                 (propertize heading 'face 'magit-section-heading)))))
1008   (unless (bolp)
1009     (insert ?\n))
1010   (magit-maybe-make-margin-overlay)
1011   (oset magit-insert-section--current content (point-marker)))
1012
1013 (defun magit-insert-headers (hook)
1014   (let* ((header-sections nil)
1015          (magit-insert-section-hook
1016           (cons (lambda ()
1017                   (push magit-insert-section--current
1018                         header-sections))
1019                 (if (listp magit-insert-section-hook)
1020                     magit-insert-section-hook
1021                   (list magit-insert-section-hook)))))
1022     (magit-run-section-hook hook)
1023     (when header-sections
1024       (insert "\n")
1025       ;; Make the first header into the parent of the rest.
1026       (when (cdr header-sections)
1027         (cl-callf nreverse header-sections)
1028         (let* ((1st-header (pop header-sections))
1029                (header-parent (oref 1st-header parent)))
1030           (oset header-parent children (list 1st-header))
1031           (oset 1st-header children header-sections)
1032           (oset 1st-header content (oref (car header-sections) start))
1033           (oset 1st-header end (oref (car (last header-sections)) end))
1034           (dolist (sub-header header-sections)
1035             (oset sub-header parent 1st-header)))))))
1036
1037 (defun magit-insert-child-count (section)
1038   "Modify SECTION's heading to contain number of child sections.
1039
1040 If `magit-section-show-child-count' is non-nil and the SECTION
1041 has children and its heading ends with \":\", then replace that
1042 with \" (N)\", where N is the number of child sections.
1043
1044 This function is called by `magit-insert-section' after that has
1045 evaluated its BODY.  Admittedly that's a bit of a hack."
1046   ;; This has to be fast, not pretty!
1047   (let (content count)
1048     (when (and magit-section-show-child-count
1049                (setq count (length (oref section children)))
1050                (> count 0)
1051                (setq content (oref section content))
1052                (eq (char-before (1- content)) ?:))
1053       (save-excursion
1054         (goto-char (- content 2))
1055         (insert (format " (%s)" count))
1056         (delete-char 1)))))
1057
1058 ;;; Update
1059
1060 (defvar-local magit-section-highlight-overlays nil)
1061 (defvar-local magit-section-highlighted-section nil)
1062 (defvar-local magit-section-highlighted-sections nil)
1063 (defvar-local magit-section-unhighlight-sections nil)
1064
1065 (defun magit-section-update-region (_)
1066   "When the region is a valid section-selection, highlight them all."
1067   ;; At least that's what it does conceptually.  In actuality it just
1068   ;; returns a list of those sections, and it doesn't even matter if
1069   ;; this is a member of `magit-region-highlight-hook'.  It probably
1070   ;; should be removed, but I want to make sure before removing it.
1071   (magit-region-sections))
1072
1073 (defun magit-section-update-highlight ()
1074   (let ((section (magit-current-section)))
1075     (unless (eq section magit-section-highlighted-section)
1076       (let ((inhibit-read-only t)
1077             (deactivate-mark nil)
1078             (selection (magit-region-sections)))
1079         (mapc #'delete-overlay magit-section-highlight-overlays)
1080         (setq magit-section-highlight-overlays nil)
1081         (setq magit-section-unhighlight-sections
1082               magit-section-highlighted-sections)
1083         (setq magit-section-highlighted-sections nil)
1084         (unless (eq section magit-root-section)
1085           (run-hook-with-args-until-success
1086            'magit-section-highlight-hook section selection))
1087         (dolist (s magit-section-unhighlight-sections)
1088           (run-hook-with-args-until-success
1089            'magit-section-unhighlight-hook s selection))
1090         (restore-buffer-modified-p nil)
1091         (unless (eq magit-section-highlighted-section section)
1092           (setq magit-section-highlighted-section
1093                 (and (not (oref section hidden))
1094                      section))))
1095       (when (version< emacs-version "25.1")
1096         (setq deactivate-mark nil)))))
1097
1098 (defun magit-section-highlight (section selection)
1099   "Highlight SECTION and if non-nil all sections in SELECTION.
1100 This function works for any section but produces undesirable
1101 effects for diff related sections, which by default are
1102 highlighted using `magit-diff-highlight'.  Return t."
1103   (when-let ((face (oref section heading-highlight-face)))
1104     (dolist (section (or selection (list section)))
1105       (magit-section-make-overlay
1106        (oref section start)
1107        (or (oref section content)
1108            (oref section end))
1109        face)))
1110   (cond (selection
1111          (magit-section-make-overlay (oref (car selection) start)
1112                                      (oref (car (last selection)) end)
1113                                      'magit-section-highlight)
1114          (magit-section-highlight-selection nil selection))
1115         (t
1116          (magit-section-make-overlay (oref section start)
1117                                      (oref section end)
1118                                      'magit-section-highlight)))
1119   t)
1120
1121 (defun magit-section-highlight-selection (_ selection)
1122   "Highlight the section-selection region.
1123 If SELECTION is non-nil, then it is a list of sections selected by
1124 the region.  The headings of these sections are then highlighted.
1125
1126 This is a fallback for people who don't want to highlight the
1127 current section and therefore removed `magit-section-highlight'
1128 from `magit-section-highlight-hook'.
1129
1130 This function is necessary to ensure that a representation of
1131 such a region is visible.  If neither of these functions were
1132 part of the hook variable, then such a region would be
1133 invisible."
1134   (when (and selection
1135              (not (and (eq this-command 'mouse-drag-region))))
1136     (dolist (section selection)
1137       (magit-section-make-overlay (oref section start)
1138                                   (or (oref section content)
1139                                       (oref section end))
1140                                   'magit-section-heading-selection))
1141     t))
1142
1143 (defun magit-section-make-overlay (start end face)
1144   ;; Yes, this doesn't belong here.  But the alternative of
1145   ;; spreading this hack across the code base is even worse.
1146   (when (and magit-keep-region-overlay
1147              (memq face '(magit-section-heading-selection
1148                           magit-diff-file-heading-selection
1149                           magit-diff-hunk-heading-selection)))
1150     (setq face (list :foreground (face-foreground face))))
1151   (let ((ov (make-overlay start end nil t)))
1152     (overlay-put ov 'face face)
1153     (overlay-put ov 'evaporate t)
1154     (push ov magit-section-highlight-overlays)
1155     ov))
1156
1157 (defun magit-section-goto-successor (section line char arg)
1158   (let ((ident (magit-section-ident section)))
1159     (--if-let (magit-get-section ident)
1160         (let ((start (oref it start)))
1161           (goto-char start)
1162           (unless (eq it magit-root-section)
1163             (ignore-errors
1164               (forward-line line)
1165               (forward-char char))
1166             (unless (eq (magit-current-section) it)
1167               (goto-char start))))
1168       (or (and (magit-hunk-section-p section)
1169                (when-let ((parent (magit-get-section
1170                                    (magit-section-ident
1171                                     (oref section parent)))))
1172                  (let* ((children (oref parent children))
1173                         (siblings (magit-section-siblings section 'prev))
1174                         (previous (nth (length siblings) children)))
1175                    (if (not arg)
1176                        (--when-let (or previous (car (last children)))
1177                          (magit-section-goto it)
1178                          t)
1179                      (when previous
1180                        (magit-section-goto previous))
1181                      (if (and (stringp arg)
1182                               (re-search-forward arg (oref parent end) t))
1183                          (goto-char (match-beginning 0))
1184                        (goto-char (oref (car (last children)) end))
1185                        (forward-line -1)
1186                        (while (looking-at "^ ")    (forward-line -1))
1187                        (while (looking-at "^[-+]") (forward-line -1))
1188                        (forward-line))))))
1189           (goto-char (--if-let (magit-section-goto-successor-1 section)
1190                          (if (eq (oref it type) 'button)
1191                              (point-min)
1192                            (oref it start))
1193                        (point-min)))))))
1194
1195 (defun magit-section-goto-successor-1 (section)
1196   (or (--when-let (pcase (oref section type)
1197                     (`staged 'unstaged)
1198                     (`unstaged 'staged)
1199                     (`unpushed 'unpulled)
1200                     (`unpulled 'unpushed))
1201         (magit-get-section `((,it) (status))))
1202       (--when-let (car (magit-section-siblings section 'next))
1203         (magit-get-section (magit-section-ident it)))
1204       (--when-let (car (magit-section-siblings section 'prev))
1205         (magit-get-section (magit-section-ident it)))
1206       (--when-let (oref section parent)
1207         (or (magit-get-section (magit-section-ident it))
1208             (magit-section-goto-successor-1 it)))))
1209
1210 ;;; Visibility
1211
1212 (defvar-local magit-section-visibility-cache nil)
1213 (put 'magit-section-visibility-cache 'permanent-local t)
1214
1215 (defun magit-section-cached-visibility (section)
1216   "Set SECTION's visibility to the cached value."
1217   (cdr (assoc (magit-section-ident section)
1218               magit-section-visibility-cache)))
1219
1220 (cl-defun magit-section-cache-visibility
1221     (&optional (section magit-insert-section--current))
1222   ;; Emacs 25's `alist-get' lacks TESTFN.
1223   (let* ((id  (magit-section-ident section))
1224          (elt (assoc id magit-section-visibility-cache))
1225          (val (if (oref section hidden) 'hide 'show)))
1226     (if elt
1227         (setcdr elt val)
1228       (push (cons id val) magit-section-visibility-cache))))
1229
1230 (cl-defun magit-section-maybe-cache-visibility
1231     (&optional (section magit-insert-section--current))
1232   (when (or (eq magit-section-cache-visibility t)
1233             (memq (oref section type)
1234                   magit-section-cache-visibility))
1235     (magit-section-cache-visibility section)))
1236
1237 (defun magit-preserve-section-visibility-cache ()
1238   (when (derived-mode-p 'magit-status-mode 'magit-refs-mode)
1239     (magit-repository-local-set
1240      (cons major-mode 'magit-section-visibility-cache)
1241      magit-section-visibility-cache)))
1242
1243 (defun magit-restore-section-visibility-cache (mode)
1244   (setq magit-section-visibility-cache
1245         (magit-repository-local-get
1246          (cons mode 'magit-section-visibility-cache))))
1247
1248 ;;; Utilities
1249
1250 (cl-defun magit-section-selected-p (section &optional (selection nil sselection))
1251   (and (not (eq section magit-root-section))
1252        (or  (eq section (magit-current-section))
1253             (memq section (if sselection
1254                               selection
1255                             (setq selection (magit-region-sections))))
1256             (--when-let (oref section parent)
1257               (magit-section-selected-p it selection)))))
1258
1259 (defun magit-section-parent-value (section)
1260   (when-let ((parent (oref section parent)))
1261     (oref parent value)))
1262
1263 (defun magit-section-siblings (section &optional direction)
1264   "Return a list of the sibling sections of SECTION.
1265
1266 If optional DIRECTION is `prev', then return siblings that come
1267 before SECTION.  If it is `next', then return siblings that come
1268 after SECTION.  For all other values, return all siblings
1269 excluding SECTION itself."
1270   (when-let ((parent (oref section parent)))
1271     (let ((siblings (oref parent children)))
1272       (pcase direction
1273         (`prev  (cdr (member section (reverse siblings))))
1274         (`next  (cdr (member section siblings)))
1275         (_      (remq section siblings))))))
1276
1277 (defun magit-region-values (&optional condition multiple)
1278   "Return a list of the values of the selected sections.
1279
1280 Return the values that themselves would be returned by
1281 `magit-region-sections' (which see)."
1282   (--map (oref it value)
1283          (magit-region-sections condition multiple)))
1284
1285 (defun magit-region-sections (&optional condition multiple)
1286   "Return a list of the selected sections.
1287
1288 When the region is active and constitutes a valid section
1289 selection, then return a list of all selected sections.  This is
1290 the case when the region begins in the heading of a section and
1291 ends in the heading of the same section or in that of a sibling
1292 section.  If optional MULTIPLE is non-nil, then the region cannot
1293 begin and end in the same section.
1294
1295 When the selection is not valid, then return nil.  In this case,
1296 most commands that can act on the selected sections will instead
1297 act on the section at point.
1298
1299 When the region looks like it would in any other buffer then
1300 the selection is invalid.  When the selection is valid then the
1301 region uses the `magit-section-highlight' face.  This does not
1302 apply to diffs where things get a bit more complicated, but even
1303 here if the region looks like it usually does, then that's not
1304 a valid selection as far as this function is concerned.
1305
1306 If optional CONDITION is non-nil, then the selection not only
1307 has to be valid; all selected sections additionally have to match
1308 CONDITION, or nil is returned.  See `magit-section-match' for the
1309 forms CONDITION can take."
1310   (when (region-active-p)
1311     (let* ((rbeg (region-beginning))
1312            (rend (region-end))
1313            (sbeg (get-text-property rbeg 'magit-section))
1314            (send (get-text-property rend 'magit-section)))
1315       (when (and send
1316                  (not (eq send magit-root-section))
1317                  (not (and multiple (eq send sbeg))))
1318         (let ((siblings (cons sbeg (magit-section-siblings sbeg 'next)))
1319               sections)
1320           (when (and (memq send siblings)
1321                      (magit-section-position-in-heading-p sbeg rbeg)
1322                      (magit-section-position-in-heading-p send rend))
1323             (while siblings
1324               (push (car siblings) sections)
1325               (when (eq (pop siblings) send)
1326                 (setq siblings nil)))
1327             (setq sections (nreverse sections))
1328             (when (or (not condition)
1329                       (--all-p (magit-section-match condition it) sections))
1330               sections)))))))
1331
1332 (defun magit-section-position-in-heading-p (&optional section pos)
1333   "Return t if POSITION is inside the heading of SECTION.
1334 POSITION defaults to point and SECTION defaults to the
1335 current section."
1336   (unless section
1337     (setq section (magit-current-section)))
1338   (unless pos
1339     (setq pos (point)))
1340   (and section
1341        (>= pos (oref section start))
1342        (<  pos (or (oref section content)
1343                    (oref section end)))
1344        t))
1345
1346 (defun magit-section-internal-region-p (&optional section)
1347   "Return t if the region is active and inside SECTION's body.
1348 If optional SECTION is nil, use the current section."
1349   (and (region-active-p)
1350        (or section (setq section (magit-current-section)))
1351        (let ((beg (get-text-property (region-beginning) 'magit-section)))
1352          (and (eq beg (get-text-property   (region-end) 'magit-section))
1353               (eq beg section)))
1354        (not (or (magit-section-position-in-heading-p section (region-beginning))
1355                 (magit-section-position-in-heading-p section (region-end))))
1356        t))
1357
1358 (defun magit-section--backward-protected ()
1359   "Move to the beginning of the current or the previous visible section.
1360 Same as `magit-section-backward' but for non-interactive use.
1361 Suppress `magit-section-movement-hook', and return a boolean to
1362 indicate whether a section was found, instead of raising an error
1363 if not."
1364   (condition-case nil
1365       (let ((magit-section-movement-hook nil))
1366         (magit-section-backward)
1367         t)
1368     (user-error nil)))
1369
1370 (defun magit-section--backward-find (predicate)
1371   "Move to the first previous section satisfying PREDICATE.
1372 PREDICATE does not take any parameter and should not move
1373 point."
1374   (let (found)
1375     (while (and (setq found (magit-section--backward-protected))
1376                 (not (funcall predicate))))
1377     found))
1378
1379 (defun magit-wash-sequence (function)
1380   "Repeatedly call FUNCTION until it returns nil or eob is reached.
1381 FUNCTION has to move point forward or return nil."
1382   (while (and (not (eobp)) (funcall function))))
1383
1384 (defun magit-add-section-hook (hook function &optional at append local)
1385   "Add to the value of section hook HOOK the function FUNCTION.
1386
1387 Add FUNCTION at the beginning of the hook list unless optional
1388 APPEND is non-nil, in which case FUNCTION is added at the end.
1389 If FUNCTION already is a member, then move it to the new location.
1390
1391 If optional AT is non-nil and a member of the hook list, then
1392 add FUNCTION next to that instead.  Add before or after AT, or
1393 replace AT with FUNCTION depending on APPEND.  If APPEND is the
1394 symbol `replace', then replace AT with FUNCTION.  For any other
1395 non-nil value place FUNCTION right after AT.  If nil, then place
1396 FUNCTION right before AT.  If FUNCTION already is a member of the
1397 list but AT is not, then leave FUNCTION where ever it already is.
1398
1399 If optional LOCAL is non-nil, then modify the hook's buffer-local
1400 value rather than its global value.  This makes the hook local by
1401 copying the default value.  That copy is then modified.
1402
1403 HOOK should be a symbol.  If HOOK is void, it is first set to nil.
1404 HOOK's value must not be a single hook function.  FUNCTION should
1405 be a function that takes no arguments and inserts one or multiple
1406 sections at point, moving point forward.  FUNCTION may choose not
1407 to insert its section(s), when doing so would not make sense.  It
1408 should not be abused for other side-effects.  To remove FUNCTION
1409 again use `remove-hook'."
1410   (unless (boundp hook)
1411     (error "Cannot add function to undefined hook variable %s" hook))
1412   (or (default-boundp hook) (set-default hook nil))
1413   (let ((value (if local
1414                    (if (local-variable-p hook)
1415                        (symbol-value hook)
1416                      (unless (local-variable-if-set-p hook)
1417                        (make-local-variable hook))
1418                      (copy-sequence (default-value hook)))
1419                  (default-value hook))))
1420     (if at
1421         (when (setq at (member at value))
1422           (setq value (delq function value))
1423           (cond ((eq append 'replace)
1424                  (setcar at function))
1425                 (append
1426                  (push function (cdr at)))
1427                 (t
1428                  (push (car at) (cdr at))
1429                  (setcar at function))))
1430       (setq value (delq function value)))
1431     (unless (member function value)
1432       (setq value (if append
1433                       (append value (list function))
1434                     (cons function value))))
1435     (when (eq append 'replace)
1436       (setq value (delq at value)))
1437     (if local
1438         (set hook value)
1439       (set-default hook value))))
1440
1441 (defun magit-run-section-hook (hook &rest args)
1442   "Run HOOK with ARGS, warning about invalid entries."
1443   (let ((entries (symbol-value hook)))
1444     (unless (listp entries)
1445       (setq entries (list entries)))
1446     (--when-let (-remove #'functionp entries)
1447       (message "`%s' contains entries that are no longer valid.
1448 %s\nUsing standard value instead.  Please re-configure hook variable."
1449                hook
1450                (mapconcat (lambda (sym) (format "  `%s'" sym)) it "\n"))
1451       (sit-for 5)
1452       (setq entries (eval (car (get hook 'standard-value)))))
1453     (dolist (entry entries)
1454       (let ((magit--current-section-hook (cons (list hook entry)
1455                                                magit--current-section-hook)))
1456         (apply entry args)))))
1457
1458 ;;; _
1459 (provide 'magit-section)
1460 ;;; magit-section.el ends here