branch: elpa/magit
commit c556fee1bd3ccc44da9f2322ec17dc5c3f0ef5be
Author: Jonas Bernoulli <jo...@bernoul.li>
Commit: Jonas Bernoulli <jo...@bernoul.li>
Generalize section painting
Hunks are still the only sections whose bodies have to painted when
they are highlighted and unhighlighted. The reason this is necessary
is that highlighting is done by using (an) overlay(s) to change the
background color of selected sections, which shadows an significant
background color used in section bodies.
Hunks use different background colors to indicate added and removed
lines. Instead of using overlays, the background colors of these
lines (and also of context lines) are changed using text properties,
when a hunk gains or loses focus. I.e., they are "painted".
Such painting is more expensive than merely removing or adding one
or more overlays, because the text has to be parsed again, so we have
to avoid doing it unless actually necessary.
We do not only want to avoid needlessly painting hunks when moving
around in the buffer, we also want to avoid it for (hunk) sections
whose bodies are not visible yet. To accomplish that the `washer'
section slot was added. Its purpose is to delay "washing" until
the section is expanded.
This slot was originally added specifically for hunk sections, but
by now it is used by many other sections too. In most cases it is
even used to not only delay washing (~= "parsing" and "painting")
but to even delay inserting any section content until that time.
With this commit, we *stop* using the function from the `washer'
slot for hunk painting, and replace that with a new mechanism that
is inspired by the old washer mechanism, but incorporates lessons
learned since.
The two drivers are still `magit-section-update-highlight' and
`magit-section-show'. These two functions are the main driving
forces behind the two events that make *might* make it necessary
to repaint.
Replace the hook `magit-section-unhighlight-hook' with a new generic
function `magit-section-paint'. Create such a method for diffs, using
the hunk-specific parts of removed `magit-diff-paint-hunk'. The parts
that function are not hunk-specific, are replaced with similar logic
in new `magit-section-update-paint'.
`magit-section-update-paint' is where we now decide whether repainting
is actually necessary.
---
lisp/magit-diff.el | 119 +++++++++++++++++++-------------------------------
lisp/magit-mode.el | 4 +-
lisp/magit-section.el | 81 ++++++++++++++++++++++++----------
3 files changed, 103 insertions(+), 101 deletions(-)
diff --git a/lisp/magit-diff.el b/lisp/magit-diff.el
index e89669c146..02cbbc71b5 100644
--- a/lisp/magit-diff.el
+++ b/lisp/magit-diff.el
@@ -2617,7 +2617,6 @@ function errors."
(magit-delete-line)
(magit-insert-section
( hunk value nil
- :washer #'magit-diff-paint-hunk
:combined combined
:from-range (if combined (butlast ranges) (car ranges))
:to-range (car (last ranges))
@@ -3266,82 +3265,52 @@ actually a `diff' but a `diffstat' section."
(byte-code-function-p last-command))
(eq (region-end) (region-beginning))))))
-;;; Diff Highlight
-
-(add-hook 'magit-section-unhighlight-hook #'magit-diff-unhighlight)
-
-(defun magit-diff-unhighlight (section selection)
- "Remove the highlighting of the diff-related SECTION."
- (when (magit-hunk-section-p section)
- (magit-diff-paint-hunk section selection nil)
- t))
-
;;; Hunk Paint
-(cl-defun magit-diff-paint-hunk
- (section &optional selection
- (highlight (magit-section-selected-p section selection)))
- (let (paint)
- (unless magit-diff-highlight-hunk-body
- (setq highlight nil))
- (cond (highlight
- (unless (oref section hidden)
- (cl-pushnew section magit-section-highlighted-sections)
- (cond ((memq section magit-section-unhighlight-sections)
- (setq magit-section-unhighlight-sections
- (delq section magit-section-unhighlight-sections)))
- (magit-diff-highlight-hunk-body
- (setq paint t)))))
- ((and (oref section hidden)
- (memq section magit-section-unhighlight-sections))
- (cl-pushnew section magit-section-highlighted-sections)
- (setq magit-section-unhighlight-sections
- (delq section magit-section-unhighlight-sections)))
- (t
- (setq paint t)))
- (when paint
- (save-excursion
- (goto-char (oref section start))
- (let ((end (oref section end))
- (merging (looking-at "@@@"))
- (diff-type (magit-diff-type))
- (stage nil)
- (tab-width (magit-diff-tab-width
- (magit-section-parent-value section))))
- (forward-line)
- (while (< (point) end)
- (when (and magit-diff-hide-trailing-cr-characters
- (char-equal ?\r (char-before (line-end-position))))
- (put-text-property (1- (line-end-position)) (line-end-position)
- 'invisible t))
- (put-text-property
- (point) (1+ (line-end-position)) 'font-lock-face
- (cond
- ((looking-at "^\\+\\+?\\([<=|>]\\)\\{7\\}")
- (setq stage (pcase (list (match-string 1) highlight)
- ('("<" nil) 'magit-diff-our)
- ('("<" t) 'magit-diff-our-highlight)
- ('("|" nil) 'magit-diff-base)
- ('("|" t) 'magit-diff-base-highlight)
- ('("=" nil) 'magit-diff-their)
- ('("=" t) 'magit-diff-their-highlight)
- ('(">" nil) nil)))
- 'magit-diff-conflict-heading)
- ((looking-at (if merging "^\\(\\+\\| \\+\\)" "^\\+"))
- (magit-diff-paint-tab merging tab-width)
- (magit-diff-paint-whitespace merging 'added diff-type)
- (or stage
- (if highlight 'magit-diff-added-highlight
'magit-diff-added)))
- ((looking-at (if merging "^\\(-\\| -\\)" "^-"))
- (magit-diff-paint-tab merging tab-width)
- (magit-diff-paint-whitespace merging 'removed diff-type)
- (if highlight 'magit-diff-removed-highlight
'magit-diff-removed))
- (t
- (magit-diff-paint-tab merging tab-width)
- (magit-diff-paint-whitespace merging 'context diff-type)
- (if highlight 'magit-diff-context-highlight
'magit-diff-context))))
- (forward-line))))
- (magit-diff-update-hunk-refinement section))))
+(cl-defmethod magit-section-paint ((section magit-hunk-section) highlight)
+ (unless magit-diff-highlight-hunk-body
+ (setq highlight nil))
+ (let ((end (oref section end))
+ (merging (looking-at "@@@"))
+ (diff-type (magit-diff-type))
+ (stage nil)
+ (tab-width (magit-diff-tab-width
+ (magit-section-parent-value section))))
+ (forward-line)
+ (while (< (point) end)
+ (when (and magit-diff-hide-trailing-cr-characters
+ (char-equal ?\r (char-before (line-end-position))))
+ (put-text-property (1- (line-end-position)) (line-end-position)
+ 'invisible t))
+ (put-text-property
+ (point) (1+ (line-end-position)) 'font-lock-face
+ (cond
+ ((looking-at "^\\+\\+?\\([<=|>]\\)\\{7\\}")
+ (setq stage (pcase (list (match-string 1) highlight)
+ ('("<" nil) 'magit-diff-our)
+ ('("<" t) 'magit-diff-our-highlight)
+ ('("|" nil) 'magit-diff-base)
+ ('("|" t) 'magit-diff-base-highlight)
+ ('("=" nil) 'magit-diff-their)
+ ('("=" t) 'magit-diff-their-highlight)
+ ('(">" nil) nil)))
+ 'magit-diff-conflict-heading)
+ ((looking-at (if merging "^\\(\\+\\| \\+\\)" "^\\+"))
+ (magit-diff-paint-tab merging tab-width)
+ (magit-diff-paint-whitespace merging 'added diff-type)
+ (or stage
+ (if highlight 'magit-diff-added-highlight 'magit-diff-added)))
+ ((looking-at (if merging "^\\(-\\| -\\)" "^-"))
+ (magit-diff-paint-tab merging tab-width)
+ (magit-diff-paint-whitespace merging 'removed diff-type)
+ (if highlight 'magit-diff-removed-highlight 'magit-diff-removed))
+ (t
+ (magit-diff-paint-tab merging tab-width)
+ (magit-diff-paint-whitespace merging 'context diff-type)
+ (if highlight 'magit-diff-context-highlight 'magit-diff-context))))
+ (forward-line)))
+ (magit-diff-update-hunk-refinement section)
+ (oset section painted (if highlight 'highlight 'plain)))
(defvar magit-diff--tab-width-cache nil)
diff --git a/lisp/magit-mode.el b/lisp/magit-mode.el
index 0ddfc10717..34af242211 100644
--- a/lisp/magit-mode.el
+++ b/lisp/magit-mode.el
@@ -1070,7 +1070,8 @@ Run hooks `magit-pre-refresh-hook' and
`magit-post-refresh-hook'."
(defun magit-refresh-buffer (&optional created)
"Refresh the current Magit buffer."
(interactive)
- (let ((magit--refresh-start-time (current-time))
+ (let ((magit--refreshing-buffer-p t)
+ (magit--refresh-start-time (current-time))
(magit--refresh-cache (or magit--refresh-cache (list (cons 0 0))))
(refresh (intern (format "%s-refresh-buffer"
(substring (symbol-name major-mode) 0 -5)))))
@@ -1098,7 +1099,6 @@ Run hooks `magit-pre-refresh-hook' and
`magit-post-refresh-hook'."
(setq magit-section-highlight-overlays nil)
(setq magit-section-selection-overlays nil)
(setq magit-section-highlighted-sections nil)
- (setq magit-section-unhighlight-sections nil)
(let ((inhibit-read-only t))
(erase-buffer)
(save-excursion
diff --git a/lisp/magit-section.el b/lisp/magit-section.el
index a56faf4f55..9d486ffd6c 100644
--- a/lisp/magit-section.el
+++ b/lisp/magit-section.el
@@ -108,13 +108,6 @@ similar defect.")
"Hook run by `magit-section-goto'.
That function in turn is used by all section movement commands.")
-(defvar magit-section-unhighlight-hook nil
- "Functions used to unhighlight the previously current section.
-Each function is run with the current section as only argument
-until one of them returns non-nil. Most sections are properly
-unhighlighted without requiring a specialized unhighlighter,
-diff-related sections being the only exception.")
-
(defvar magit-section-set-visibility-hook
(list #'magit-section-cached-visibility)
"Hook used to set the initial visibility of a section.
@@ -315,13 +308,16 @@ no effect. This also has no effect for Emacs >= 28, where
(defvar-local magit-section-highlight-force-update nil)
(defvar-local magit-section-highlight-overlays nil)
(defvar-local magit-section-selection-overlays nil)
-(defvar-local magit-section-highlighted-sections nil)
-(defvar-local magit-section-unhighlight-sections nil)
+(defvar-local magit-section-highlighted-sections nil
+ "List of highlighted sections that may have to be repainted on focus
change.")
(defvar-local magit-section-focused-sections nil)
(defvar-local magit-section-inhibit-markers nil)
(defvar-local magit-section-insert-in-reverse nil)
+(defvar-local magit--refreshing-buffer-p nil
+ "Whether the current buffer is presently being refreshed.")
+
;;; Faces
(defgroup magit-section-faces nil
@@ -924,6 +920,7 @@ With a prefix argument also expand it." heading)
(interactive (list (magit-current-section)))
(oset section hidden nil)
(magit-section--opportunistic-wash section)
+ (magit-section--opportunistic-paint section)
(when-let ((beg (oref section content)))
(remove-overlays beg (oref section end) 'invisible t))
(magit-section-maybe-update-visibility-indicator section)
@@ -1675,15 +1672,12 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(oset section washer nil)
(let ((inhibit-read-only t)
(magit-insert-section--parent section)
- (magit-insert-section--current section)
- (content (oref section content)))
+ (magit-insert-section--current section))
(save-excursion
- (if (and content (< content (oref section end)))
- (funcall washer section) ; already partially washed (hunk)
- (goto-char (oref section end))
- (oset section content (point-marker))
- (funcall washer)
- (oset section end (point-marker)))))
+ (goto-char (oref section end))
+ (oset section content (point-marker))
+ (funcall washer)
+ (oset section end (point-marker))))
(setq magit-section-highlight-force-update t)))
;;; Highlight
@@ -1725,7 +1719,8 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(setq magit-section-highlight-force-update t))
(defun magit-section-update-highlight (&optional force)
- (let ((section (magit-current-section)))
+ (let ((section (magit-current-section))
+ (focused (magit-focused-sections)))
(cond
((or force
magit-section-highlight-force-update
@@ -1738,9 +1733,6 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(mapc #'delete-overlay magit-section-selection-overlays)
(setq magit-section-highlight-overlays nil)
(setq magit-section-selection-overlays nil)
- (setq magit-section-unhighlight-sections
- magit-section-highlighted-sections)
- (setq magit-section-highlighted-sections nil)
(cond ((magit-section--maybe-enable-long-lines-shortcuts))
((eq section magit-root-section))
((not magit-section-highlight-current)
@@ -1751,9 +1743,9 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(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))
+ (dolist (section (cl-union magit-section-highlighted-sections focused))
+ (when (slot-boundp section 'painted)
+ (magit-section-update-paint section focused)))
(restore-buffer-modified-p nil)))
((and (eq magit-section-pre-command-section section)
magit-section-selection-overlays
@@ -1812,6 +1804,47 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(and-let* ((children (oref section children)))
(magit-section-selective-highlight-p (car children) t))))
+;;; Paint
+
+(defun magit-section-update-paint (section focused-sections)
+ (cl-flet ((paint (highlight)
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char (oref section start))
+ (magit-section-paint section highlight))))
+ (unregister ()
+ (setq magit-section-highlighted-sections
+ (delq section magit-section-highlighted-sections))))
+ (if (magit-section-hidden section)
+ ;; If the section is highlighted but unfocused, it remains
+ ;; highlighted, but `magit-section--opportunistic-paint' via
+ ;; `magit-section-show' will unhighlight on expansion, and
+ ;; before then (or if a refresh occurs first) it doesn't matter.
+ (unregister)
+ (pcase (list (if (memq section focused-sections) 'focus 'unfocus)
+ (oref section painted))
+ (`(focus ,(or 'nil 'plain))
+ (paint t)
+ (cl-pushnew section magit-section-highlighted-sections))
+ (`(unfocus ,(or 'nil 'highlight))
+ (paint nil)
+ (unregister))
+ ('(unfocus plain)
+ (unregister))))))
+
+(cl-defmethod magit-section-paint ((section magit-section) _highlight)
+ (error "Slot `paint' bound but `magit-section-paint' not implemented for
`%s'"
+ (eieio-object-class-name section)))
+
+(defun magit-section--opportunistic-paint (section)
+ (when (and (not (oref section hidden))
+ (slot-boundp section 'painted))
+ (if magit--refreshing-buffer-p
+ ;; Defer to `magit-section-update-highlight'.
+ (unless (oref section painted)
+ (cl-pushnew section magit-section-highlighted-sections))
+ (magit-section-update-paint section (magit-focused-sections)))))
+
;;; Long Lines
(defvar magit-show-long-lines-warning t)
