mirror of
https://git.notmuchmail.org/git/notmuch
synced 2024-11-25 12:28:09 +01:00
emacs: Eliminate buffer invisibility specs from show and wash
Previously, all visibility in show buffers for headers, message bodies, and washed text was specified by generating one or more symbols for each region and creating overlays with their 'invisible property set to carefully crafted combinations of these symbols. Visibility was controlled not by modifying the overlays directly, but by adding and removing the generated symbols from a gigantic buffer invisibilty spec. This has myriad negative consequences. It's slow because Emacs' display engine has to traverse the buffer invisibility list for every overlay and, since every overlay has its own symbol, this makes rendering O(N^2) in the number of overlays. It composes poorly because symbol-type 'invisible properties are taken from the highest priority overlay over a given character (which is often ambiguous!), rather than being gathered from all overlays over a character. As a result, we have to include symbols related to message hiding in the wash code lest the wash overlays un-hide parts of hidden messages. It also requires various workarounds for isearch to properly open overlays, to set up buffer-invisibility-spec for remove-from-invisibility-spec to work right, and to explicitly refresh the display after updating the buffer invisibility spec. None of this is necessary. This patch converts show and wash to use simple boolean 'invisible properties and to not use the buffer invisibility spec. Rather than adding and removing generated symbols from the invisibility spec, the code now directly toggles the 'invisible property of the appropriate overlay. This speeds up rendering because the display engine only has to check the boolean values of the overlays over a character. It composes nicely because text will be invisible if *any* overlay over it has 'invisible t, which means we can overlap invisibility overlays with abandon. We no longer need any of the workarounds mentioned above. And it fixes a minor bug for free: now, when isearch opens a washed region, the button text will update to say "Click/Enter to hide" rather than remaining unchanged.
This commit is contained in:
parent
92d7ae3876
commit
8ba6016889
2 changed files with 17 additions and 122 deletions
|
@ -872,27 +872,8 @@ message at DEPTH in the current thread."
|
||||||
message-start message-end
|
message-start message-end
|
||||||
content-start content-end
|
content-start content-end
|
||||||
headers-start headers-end
|
headers-start headers-end
|
||||||
body-start body-end
|
|
||||||
(headers-invis-spec (notmuch-show-make-symbol "header"))
|
|
||||||
(message-invis-spec (notmuch-show-make-symbol "message"))
|
|
||||||
(bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
|
(bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
|
||||||
|
|
||||||
;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise
|
|
||||||
;; removing items from `buffer-invisibility-spec' (which is what
|
|
||||||
;; `notmuch-show-headers-visible' and
|
|
||||||
;; `notmuch-show-message-visible' do) is a no-op and has no
|
|
||||||
;; effect. This caused threads with only matching messages to have
|
|
||||||
;; those messages hidden initially because
|
|
||||||
;; `buffer-invisibility-spec' stayed `t'.
|
|
||||||
;;
|
|
||||||
;; This needs to be set here (rather than just above the call to
|
|
||||||
;; `notmuch-show-headers-visible') because some of the part
|
|
||||||
;; rendering or body washing functions
|
|
||||||
;; (e.g. `notmuch-wash-text/plain-citations') manipulate
|
|
||||||
;; `buffer-invisibility-spec').
|
|
||||||
(when (eq buffer-invisibility-spec t)
|
|
||||||
(setq buffer-invisibility-spec nil))
|
|
||||||
|
|
||||||
(setq message-start (point-marker))
|
(setq message-start (point-marker))
|
||||||
|
|
||||||
(notmuch-show-insert-headerline headers
|
(notmuch-show-insert-headerline headers
|
||||||
|
@ -904,9 +885,6 @@ message at DEPTH in the current thread."
|
||||||
|
|
||||||
(setq content-start (point-marker))
|
(setq content-start (point-marker))
|
||||||
|
|
||||||
(plist-put msg :headers-invis-spec headers-invis-spec)
|
|
||||||
(plist-put msg :message-invis-spec message-invis-spec)
|
|
||||||
|
|
||||||
;; Set `headers-start' to point after the 'Subject:' header to be
|
;; Set `headers-start' to point after the 'Subject:' header to be
|
||||||
;; compatible with the existing implementation. This just sets it
|
;; compatible with the existing implementation. This just sets it
|
||||||
;; to after the first header.
|
;; to after the first header.
|
||||||
|
@ -924,7 +902,6 @@ message at DEPTH in the current thread."
|
||||||
|
|
||||||
(setq notmuch-show-previous-subject bare-subject)
|
(setq notmuch-show-previous-subject bare-subject)
|
||||||
|
|
||||||
(setq body-start (point-marker))
|
|
||||||
;; A blank line between the headers and the body.
|
;; A blank line between the headers and the body.
|
||||||
(insert "\n")
|
(insert "\n")
|
||||||
(notmuch-show-insert-body msg (plist-get msg :body)
|
(notmuch-show-insert-body msg (plist-get msg :body)
|
||||||
|
@ -932,7 +909,6 @@ message at DEPTH in the current thread."
|
||||||
;; Ensure that the body ends with a newline.
|
;; Ensure that the body ends with a newline.
|
||||||
(unless (bolp)
|
(unless (bolp)
|
||||||
(insert "\n"))
|
(insert "\n"))
|
||||||
(setq body-end (point-marker))
|
|
||||||
(setq content-end (point-marker))
|
(setq content-end (point-marker))
|
||||||
|
|
||||||
;; Indent according to the depth in the thread.
|
;; Indent according to the depth in the thread.
|
||||||
|
@ -945,11 +921,9 @@ message at DEPTH in the current thread."
|
||||||
;; message.
|
;; message.
|
||||||
(put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
|
(put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
|
||||||
|
|
||||||
(let ((headers-overlay (make-overlay headers-start headers-end))
|
;; Create overlays used to control visibility
|
||||||
(invis-specs (list headers-invis-spec message-invis-spec)))
|
(plist-put msg :headers-overlay (make-overlay headers-start headers-end))
|
||||||
(overlay-put headers-overlay 'invisible invis-specs)
|
(plist-put msg :message-overlay (make-overlay headers-start content-end))
|
||||||
(overlay-put headers-overlay 'priority 10))
|
|
||||||
(overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
|
|
||||||
|
|
||||||
(plist-put msg :depth depth)
|
(plist-put msg :depth depth)
|
||||||
|
|
||||||
|
@ -1349,18 +1323,12 @@ effects."
|
||||||
;; Functions relating to the visibility of messages and their
|
;; Functions relating to the visibility of messages and their
|
||||||
;; components.
|
;; components.
|
||||||
|
|
||||||
(defun notmuch-show-element-visible (props visible-p spec-property)
|
|
||||||
(let ((spec (plist-get props spec-property)))
|
|
||||||
(if visible-p
|
|
||||||
(remove-from-invisibility-spec spec)
|
|
||||||
(add-to-invisibility-spec spec))))
|
|
||||||
|
|
||||||
(defun notmuch-show-message-visible (props visible-p)
|
(defun notmuch-show-message-visible (props visible-p)
|
||||||
(notmuch-show-element-visible props visible-p :message-invis-spec)
|
(overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
|
||||||
(notmuch-show-set-prop :message-visible visible-p props))
|
(notmuch-show-set-prop :message-visible visible-p props))
|
||||||
|
|
||||||
(defun notmuch-show-headers-visible (props visible-p)
|
(defun notmuch-show-headers-visible (props visible-p)
|
||||||
(notmuch-show-element-visible props visible-p :headers-invis-spec)
|
(overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
|
||||||
(notmuch-show-set-prop :headers-visible visible-p props))
|
(notmuch-show-set-prop :headers-visible visible-p props))
|
||||||
|
|
||||||
;; Functions for setting and getting attributes of the current
|
;; Functions for setting and getting attributes of the current
|
||||||
|
|
|
@ -96,10 +96,10 @@ this many characters or at the window width (whichever one is
|
||||||
lower).")
|
lower).")
|
||||||
|
|
||||||
(defun notmuch-wash-toggle-invisible-action (cite-button)
|
(defun notmuch-wash-toggle-invisible-action (cite-button)
|
||||||
(let ((invis-spec (button-get cite-button 'invisibility-spec)))
|
;; Toggle overlay visibility
|
||||||
(if (invisible-p invis-spec)
|
(let ((overlay (button-get cite-button 'overlay)))
|
||||||
(remove-from-invisibility-spec invis-spec)
|
(overlay-put overlay 'invisible (not (overlay-get overlay 'invisible))))
|
||||||
(add-to-invisibility-spec invis-spec)))
|
;; Update button text
|
||||||
(let* ((new-start (button-start cite-button))
|
(let* ((new-start (button-start cite-button))
|
||||||
(overlay (button-get cite-button 'overlay))
|
(overlay (button-get cite-button 'overlay))
|
||||||
(button-label (notmuch-wash-button-label overlay))
|
(button-label (notmuch-wash-button-label overlay))
|
||||||
|
@ -110,9 +110,7 @@ lower).")
|
||||||
(let ((old-end (button-end cite-button)))
|
(let ((old-end (button-end cite-button)))
|
||||||
(move-overlay cite-button new-start (point))
|
(move-overlay cite-button new-start (point))
|
||||||
(delete-region (point) old-end))
|
(delete-region (point) old-end))
|
||||||
(goto-char (min old-point (1- (button-end cite-button)))))
|
(goto-char (min old-point (1- (button-end cite-button))))))
|
||||||
(force-window-update)
|
|
||||||
(redisplay t))
|
|
||||||
|
|
||||||
(define-button-type 'notmuch-wash-button-invisibility-toggle-type
|
(define-button-type 'notmuch-wash-button-invisibility-toggle-type
|
||||||
'action 'notmuch-wash-toggle-invisible-action
|
'action 'notmuch-wash-toggle-invisible-action
|
||||||
|
@ -132,8 +130,8 @@ lower).")
|
||||||
:supertype 'notmuch-wash-button-invisibility-toggle-type)
|
:supertype 'notmuch-wash-button-invisibility-toggle-type)
|
||||||
|
|
||||||
(defun notmuch-wash-region-isearch-show (overlay)
|
(defun notmuch-wash-region-isearch-show (overlay)
|
||||||
(dolist (invis-spec (overlay-get overlay 'invisible))
|
(notmuch-wash-toggle-invisible-action
|
||||||
(remove-from-invisibility-spec invis-spec)))
|
(overlay-get overlay 'notmuch-wash-button)))
|
||||||
|
|
||||||
(defun notmuch-wash-button-label (overlay)
|
(defun notmuch-wash-button-label (overlay)
|
||||||
(let* ((type (overlay-get overlay 'type))
|
(let* ((type (overlay-get overlay 'type))
|
||||||
|
@ -158,14 +156,10 @@ that PREFIX should not include a newline."
|
||||||
;; since the newly created symbol has no plist.
|
;; since the newly created symbol has no plist.
|
||||||
|
|
||||||
(let ((overlay (make-overlay beg end))
|
(let ((overlay (make-overlay beg end))
|
||||||
(message-invis-spec (plist-get msg :message-invis-spec))
|
|
||||||
(invis-spec (make-symbol (concat "notmuch-" type "-region")))
|
|
||||||
(button-type (intern-soft (concat "notmuch-wash-button-"
|
(button-type (intern-soft (concat "notmuch-wash-button-"
|
||||||
type "-toggle-type"))))
|
type "-toggle-type"))))
|
||||||
(add-to-invisibility-spec invis-spec)
|
(overlay-put overlay 'invisible t)
|
||||||
(overlay-put overlay 'invisible (list invis-spec message-invis-spec))
|
|
||||||
(overlay-put overlay 'isearch-open-invisible #'notmuch-wash-region-isearch-show)
|
(overlay-put overlay 'isearch-open-invisible #'notmuch-wash-region-isearch-show)
|
||||||
(overlay-put overlay 'priority 10)
|
|
||||||
(overlay-put overlay 'type type)
|
(overlay-put overlay 'type type)
|
||||||
(goto-char (1+ end))
|
(goto-char (1+ end))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
|
@ -174,10 +168,10 @@ that PREFIX should not include a newline."
|
||||||
(insert-before-markers prefix))
|
(insert-before-markers prefix))
|
||||||
(let ((button-beg (point)))
|
(let ((button-beg (point)))
|
||||||
(insert-before-markers (notmuch-wash-button-label overlay) "\n")
|
(insert-before-markers (notmuch-wash-button-label overlay) "\n")
|
||||||
(make-button button-beg (1- (point))
|
(let ((button (make-button button-beg (1- (point))
|
||||||
'invisibility-spec invis-spec
|
'overlay overlay
|
||||||
'overlay overlay
|
:type button-type)))
|
||||||
:type button-type)))))
|
(overlay-put overlay 'notmuch-wash-button button))))))
|
||||||
|
|
||||||
(defun notmuch-wash-excerpt-citations (msg depth)
|
(defun notmuch-wash-excerpt-citations (msg depth)
|
||||||
"Excerpt citations and up to one signature."
|
"Excerpt citations and up to one signature."
|
||||||
|
@ -382,71 +376,4 @@ for error."
|
||||||
|
|
||||||
;;
|
;;
|
||||||
|
|
||||||
;; Temporary workaround for Emacs bug #8721
|
|
||||||
;; http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8721
|
|
||||||
|
|
||||||
(defun notmuch-isearch-range-invisible (beg end)
|
|
||||||
"Same as `isearch-range-invisible' but with fixed Emacs bug #8721."
|
|
||||||
(when (/= beg end)
|
|
||||||
;; Check that invisibility runs up to END.
|
|
||||||
(save-excursion
|
|
||||||
(goto-char beg)
|
|
||||||
(let (;; can-be-opened keeps track if we can open some overlays.
|
|
||||||
(can-be-opened (eq search-invisible 'open))
|
|
||||||
;; the list of overlays that could be opened
|
|
||||||
(crt-overlays nil))
|
|
||||||
(when (and can-be-opened isearch-hide-immediately)
|
|
||||||
(isearch-close-unnecessary-overlays beg end))
|
|
||||||
;; If the following character is currently invisible,
|
|
||||||
;; skip all characters with that same `invisible' property value.
|
|
||||||
;; Do that over and over.
|
|
||||||
(while (and (< (point) end) (invisible-p (point)))
|
|
||||||
(if (invisible-p (get-text-property (point) 'invisible))
|
|
||||||
(progn
|
|
||||||
(goto-char (next-single-property-change (point) 'invisible
|
|
||||||
nil end))
|
|
||||||
;; if text is hidden by an `invisible' text property
|
|
||||||
;; we cannot open it at all.
|
|
||||||
(setq can-be-opened nil))
|
|
||||||
(when can-be-opened
|
|
||||||
(let ((overlays (overlays-at (point)))
|
|
||||||
ov-list
|
|
||||||
o
|
|
||||||
invis-prop)
|
|
||||||
(while overlays
|
|
||||||
(setq o (car overlays)
|
|
||||||
invis-prop (overlay-get o 'invisible))
|
|
||||||
(if (invisible-p invis-prop)
|
|
||||||
(if (overlay-get o 'isearch-open-invisible)
|
|
||||||
(setq ov-list (cons o ov-list))
|
|
||||||
;; We found one overlay that cannot be
|
|
||||||
;; opened, that means the whole chunk
|
|
||||||
;; cannot be opened.
|
|
||||||
(setq can-be-opened nil)))
|
|
||||||
(setq overlays (cdr overlays)))
|
|
||||||
(if can-be-opened
|
|
||||||
;; It makes sense to append to the open
|
|
||||||
;; overlays list only if we know that this is
|
|
||||||
;; t.
|
|
||||||
(setq crt-overlays (append ov-list crt-overlays)))))
|
|
||||||
(goto-char (next-overlay-change (point)))))
|
|
||||||
;; See if invisibility reaches up thru END.
|
|
||||||
(if (>= (point) end)
|
|
||||||
(if (and can-be-opened (consp crt-overlays))
|
|
||||||
(progn
|
|
||||||
(setq isearch-opened-overlays
|
|
||||||
(append isearch-opened-overlays crt-overlays))
|
|
||||||
(mapc 'isearch-open-overlay-temporary crt-overlays)
|
|
||||||
nil)
|
|
||||||
(setq isearch-hidden t)))))))
|
|
||||||
|
|
||||||
(defadvice isearch-range-invisible (around notmuch-isearch-range-invisible-advice activate)
|
|
||||||
"Call `notmuch-isearch-range-invisible' instead of the original
|
|
||||||
`isearch-range-invisible' when in `notmuch-show-mode' mode."
|
|
||||||
(if (eq major-mode 'notmuch-show-mode)
|
|
||||||
(setq ad-return-value (notmuch-isearch-range-invisible beg end))
|
|
||||||
ad-do-it))
|
|
||||||
|
|
||||||
;;
|
|
||||||
|
|
||||||
(provide 'notmuch-wash)
|
(provide 'notmuch-wash)
|
||||||
|
|
Loading…
Reference in a new issue