branch: elpa/magit
commit ea5a446741110b4c3df7d89b05bf986e82685500
Author: Jonas Bernoulli <jo...@bernoul.li>
Commit: Jonas Bernoulli <jo...@bernoul.li>
Generalize selective section highlighting
Most sections are highlighted using a single overlay that covers the
complete section, including child sections, if any. Nearly as simple
to highlight are sections that use two overlays, one for its own
heading and the other for its body (again covering all children).
Selective highlighting is necessary when the headings of child sections
ought to like different from their body, or when their bodies use faces
that set the background and that should not be shadowed by highlighting.
Until recently both was only needed for diff-related sections, the
later only for hunks. So the implementation was also diff-specific
and treated this problem as a collection of special cases.
Add a new implementation that can be used by other sections as well.
The section slots `heading-highlight-face' already existed, but some
sections did not used it and instead propertized their headings using
custom code. Now this slot should be used, as that makes it possible to
detect when selective highlighting is necessary. If that is undesirable
for some reason the new `selective-highlight' can be set to a non-nil
value instead.
The new `magit-section-selective-highlight-p' function is used to detect
the need for selective highlighting. Its implementation should be
trivial to understand.
For consistency add a new slot `heading-selection-face', similar to
`heading-highlight-face'. Note that the value of this option does
not influence the decision whether selective highlighting is needed.
Add a third new slot `painted', which is unbound by default. If it is
bound to any value, that indicates that the section has to be painted.
Starting with the next commit the actual value will indicated whether
it has already been painted, and if so, what kind of paint was used.
---
lisp/magit-base.el | 9 +++++--
lisp/magit-diff.el | 74 ---------------------------------------------------
lisp/magit-section.el | 58 +++++++++++++++++++++++++++-------------
3 files changed, 47 insertions(+), 94 deletions(-)
diff --git a/lisp/magit-base.el b/lisp/magit-base.el
index 635b3f835a..402454653a 100644
--- a/lisp/magit-base.el
+++ b/lisp/magit-base.el
@@ -482,7 +482,9 @@ and delay of your graphical environment or operating
system."
((keymap :initform 'magit-file-section-map)
(source :initform nil :initarg :source)
(header :initform nil :initarg :header)
- (binary :initform nil :initarg :binary)))
+ (binary :initform nil :initarg :binary)
+ (heading-highlight-face :initform 'magit-diff-file-heading-highlight)
+ (heading-selection-face :initform 'magit-diff-file-heading-selection)))
(defclass magit-module-section (magit-file-section)
((keymap :initform 'magit-module-section-map)
@@ -490,12 +492,15 @@ and delay of your graphical environment or operating
system."
(defclass magit-hunk-section (magit-diff-section)
((keymap :initform 'magit-hunk-section-map)
+ (painted :initform nil)
(refined :initform nil)
(combined :initform nil :initarg :combined)
(from-range :initform nil :initarg :from-range)
(from-ranges :initform nil)
(to-range :initform nil :initarg :to-range)
- (about :initform nil :initarg :about)))
+ (about :initform nil :initarg :about)
+ (heading-highlight-face :initform 'magit-diff-hunk-heading-highlight)
+ (heading-selection-face :initform 'magit-diff-hunk-heading-selection)))
(setf (alist-get 'file magit--section-type-alist) 'magit-file-section)
(setf (alist-get 'module magit--section-type-alist) 'magit-module-section)
diff --git a/lisp/magit-diff.el b/lisp/magit-diff.el
index 26c23f5f0f..e89669c146 100644
--- a/lisp/magit-diff.el
+++ b/lisp/magit-diff.el
@@ -3276,80 +3276,6 @@ actually a `diff' but a `diffstat' section."
(magit-diff-paint-hunk section selection nil)
t))
-(cl-deftype magit--diff-related-section ()
- (declare (parents eieio-default-superclass))
- '(satisfies (lambda (section)
- (and (cl-typep section 'magit-section)
- (magit-diff-scope section t)
- t))))
-
-(cl-defmethod magit-section-highlight
- ((section magit--diff-related-section) selection)
- (if (and (magit-section-match 'commit section)
- (oref section children))
- (if selection
- (dolist (section selection)
- (magit-diff-highlight-list section selection))
- (magit-diff-highlight-list section))
- (when-let ((scope (magit-diff-scope section t)))
- (cond ((eq scope 'region)
- (magit-diff-paint-hunk section selection t))
- (selection
- (dolist (section selection)
- (magit-diff-highlight-recursive section selection)))
- (t
- (magit-diff-highlight-recursive section))))))
-
-(defun magit-diff-highlight-recursive (section &optional selection)
- (pcase (magit-diff-scope section)
- ('list (magit-diff-highlight-list section selection))
- ('file (magit-diff-highlight-file section selection))
- ('hunk (magit-diff-highlight-heading section selection)
- (magit-diff-paint-hunk section selection t))
- (_ (magit-section-highlight section nil))))
-
-(defun magit-diff-highlight-list (section &optional selection)
- (if (oref section children)
- (let ((beg (oref section start))
- (cnt (oref section content))
- (end (oref section end)))
- (unless selection
- (unless (and (region-active-p)
- (<= (region-beginning) beg))
- (magit-section-highlight-range beg cnt))
- (if (oref section hidden)
- (oset section washer #'ignore)
- (dolist (child (oref section children))
- (when (or (eq this-command #'mouse-drag-region)
- (not (and (region-active-p)
- (<= (region-beginning)
- (oref child start)))))
- (magit-diff-highlight-recursive child selection)))))
- (when magit-diff-highlight-hunk-body
- (magit-section-highlight-range (1- end) end)))
- (magit-section-highlight section nil)))
-
-(defun magit-diff-highlight-file (section &optional selection)
- (magit-diff-highlight-heading section selection)
- (when (or (not (oref section hidden))
- (cl-typep section 'magit-module-section))
- (dolist (child (oref section children))
- (magit-diff-highlight-recursive child selection))))
-
-(defun magit-diff-highlight-heading (section &optional selection)
- (magit-section-highlight-range
- (oref section start)
- (or (oref section content)
- (oref section end))
- (pcase (list (oref section type)
- (and (member section selection) t))
- ('(file t) 'magit-diff-file-heading-selection)
- ('(file nil) 'magit-diff-file-heading-highlight)
- ('(module t) 'magit-diff-file-heading-selection)
- ('(module nil) 'magit-diff-file-heading-highlight)
- ('(hunk t) 'magit-diff-hunk-heading-selection)
- ('(hunk nil) 'magit-diff-hunk-heading-highlight))))
-
;;; Hunk Paint
(cl-defun magit-diff-paint-hunk
diff --git a/lisp/magit-section.el b/lisp/magit-section.el
index eea6b6dbff..a56faf4f55 100644
--- a/lisp/magit-section.el
+++ b/lisp/magit-section.el
@@ -385,9 +385,12 @@ no effect. This also has no effect for Emacs >= 28, where
(content :initform nil)
(end :initform nil)
(hidden)
+ (painted)
(washer :initform nil :initarg :washer)
(inserter :initform (symbol-value 'magit--current-section-hook))
+ (selective-highlight :initform nil :initarg :selective-highlight)
(heading-highlight-face :initform nil :initarg :heading-highlight-face)
+ (heading-selection-face :initform nil :initarg :heading-selection-face)
(parent :initform nil)
(children :initform nil)))
@@ -1740,8 +1743,14 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(setq magit-section-highlighted-sections nil)
(cond ((magit-section--maybe-enable-long-lines-shortcuts))
((eq section magit-root-section))
- (magit-section-highlight-current
- (magit-section-highlight section selection)))
+ ((not magit-section-highlight-current)
+ (when selection
+ (magit-section-highlight-selection selection)))
+ ((not selection)
+ (magit-section-highlight section))
+ (t
+ (mapc #'magit-section-highlight selection)
+ (magit-section-highlight-selection selection)))
(dolist (s magit-section-unhighlight-sections)
(run-hook-with-args-until-success
'magit-section-unhighlight-hook s selection))
@@ -1755,24 +1764,29 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(setq magit-section-highlight-force-update nil)
(magit-section-maybe-paint-visibility-ellipses)))
-(cl-defmethod magit-section-highlight (section selection)
- (when-let ((face (oref section heading-highlight-face)))
- (dolist (section (or selection (list section)))
- (magit-section-highlight-range
- (oref section start)
- (or (oref section content)
- (oref section end))
- face)))
- (cond (selection
- (magit-section-highlight-range (oref (car selection) start)
- (oref (car (last selection)) end))
- (magit-section-highlight-selection selection))
- (t
- (magit-section-highlight-range (oref section start)
- (oref section end)))))
+(cl-defmethod magit-section-highlight ((section magit-section))
+ (pcase-let*
+ (((eieio start content end children heading-highlight-face) section)
+ (headlight heading-highlight-face)
+ (selective (magit-section-selective-highlight-p section)))
+ (cond
+ (selective
+ (magit-section-highlight-range start (or content end) headlight)
+ (cond (children
+ (let ((child-start (oref (car children) start)))
+ (when (and content (< content child-start))
+ (magit-section-highlight-range content child-start)))
+ (mapc #'magit-section-highlight children))
+ ((and content (not (slot-boundp section 'painted)))
+ (magit-section-highlight-range content end))))
+ (headlight
+ (magit-section-highlight-range start (or content end) headlight)
+ (when content
+ (magit-section-highlight-range (if headlight content start) end)))
+ ((magit-section-highlight-range start end)))))
(defun magit-section-highlight-selection (selection)
- (when (and magit-section-highlight-selection selection)
+ (when magit-section-highlight-selection
(dolist (sibling selection)
(with-slots (start content end heading-selection-face) sibling
(let ((ov (make-overlay start (or content end) nil t)))
@@ -1790,6 +1804,14 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(push ov magit-section-highlight-overlays)
ov))
+(defun magit-section-selective-highlight-p (section &optional as-child)
+ (or (oref section selective-highlight)
+ (and as-child
+ (oref section heading-highlight-face))
+ (slot-boundp section 'painted)
+ (and-let* ((children (oref section children)))
+ (magit-section-selective-highlight-p (car children) t))))
+
;;; Long Lines
(defvar magit-show-long-lines-warning t)
