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:
Austin Clements 2012-12-18 01:40:10 -05:00 committed by David Bremner
parent 92d7ae3876
commit 8ba6016889
2 changed files with 17 additions and 122 deletions

View file

@ -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

View file

@ -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)