]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: show: add overlays for each part
[notmuch] / emacs / notmuch-show.el
index 7d9f8a905f9103e378249069948c33709daca4dd..dc86b43b986cf71b98c5ad6bc2d9a8c37de243c1 100644 (file)
@@ -483,17 +483,17 @@ message at DEPTH in the current thread."
 (fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
 
 (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
-  (let ((button))
+  (let ((button)
+       (base-label (concat (when name (concat name ": "))
+                           declared-type
+                           (unless (string-equal declared-type content-type)
+                             (concat " (as " content-type ")"))
+                           comment)))
+
     (setq button
          (insert-button
-          (concat "[ "
-                  (if name (concat name ": ") "")
-                  declared-type
-                  (if (not (string-equal declared-type content-type))
-                      (concat " (as " content-type ")")
-                    "")
-                  (or comment "")
-                  " ]")
+          (concat "[ " base-label " ]")
+          :base-label base-label
           :type 'notmuch-show-part-button-type
           :notmuch-part nth
           :notmuch-filename name
@@ -567,11 +567,10 @@ message at DEPTH in the current thread."
     ;; but it's not clear that this is the wrong thing to do - which
     ;; should be chosen if there are more than one that match?
     (mapc (lambda (inner-part)
-           (let ((inner-type (plist-get inner-part :content-type)))
-             (if (or notmuch-show-all-multipart/alternative-parts
-                     (string= chosen-type inner-type))
-                 (notmuch-show-insert-bodypart msg inner-part depth)
-               (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil " (not shown)"))))
+           (let* ((inner-type (plist-get inner-part :content-type))
+                 (hide (not (or notmuch-show-all-multipart/alternative-parts
+                          (string= chosen-type inner-type)))))
+             (notmuch-show-insert-bodypart msg inner-part depth hide)))
          inner-parts)
 
     (when notmuch-show-indent-multipart
@@ -839,17 +838,33 @@ message at DEPTH in the current thread."
       (setq handlers (cdr handlers))))
   t)
 
-(defun notmuch-show-insert-bodypart (msg part depth)
-  "Insert the body part PART at depth DEPTH in the current thread."
+(defun notmuch-show-create-part-overlays (msg beg end hide)
+  "Add an overlay to the part between BEG and END"
+  (let* ((button (button-at beg))
+        (part-beg (and button (1+ (button-end button)))))
+
+    ;; If the part contains no text we do not make it toggleable. We
+    ;; also need to check that the button is a genuine part button not
+    ;; a notmuch-wash button.
+    (when (and button (/= part-beg end) (button-get button :base-label))
+       (button-put button 'overlay (make-overlay part-beg end)))))
+
+(defun notmuch-show-insert-bodypart (msg part depth &optional hide)
+  "Insert the body part PART at depth DEPTH in the current thread.
+
+If HIDE is non-nil then initially hide this part."
   (let ((content-type (downcase (plist-get part :content-type)))
-       (nth (plist-get part :id)))
-    (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))
-  ;; Some of the body part handlers leave point somewhere up in the
-  ;; part, so we make sure that we're down at the end.
-  (goto-char (point-max))
-  ;; Ensure that the part ends with a carriage return.
-  (unless (bolp)
-    (insert "\n")))
+       (nth (plist-get part :id))
+       (beg (point)))
+
+    (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type)
+    ;; Some of the body part handlers leave point somewhere up in the
+    ;; part, so we make sure that we're down at the end.
+    (goto-char (point-max))
+    ;; Ensure that the part ends with a carriage return.
+    (unless (bolp)
+      (insert "\n"))
+    (notmuch-show-create-part-overlays msg beg (point) hide)))
 
 (defun notmuch-show-insert-body (msg body depth)
   "Insert the body BODY at depth DEPTH in the current thread."
@@ -872,27 +887,8 @@ message at DEPTH in the current thread."
         message-start message-end
         content-start content-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))))
 
-    ;; 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))
 
     (notmuch-show-insert-headerline headers
@@ -904,9 +900,6 @@ message at DEPTH in the current thread."
 
     (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
     ;; compatible with the existing implementation. This just sets it
     ;; to after the first header.
@@ -924,7 +917,6 @@ message at DEPTH in the current thread."
 
     (setq notmuch-show-previous-subject bare-subject)
 
-    (setq body-start (point-marker))
     ;; A blank line between the headers and the body.
     (insert "\n")
     (notmuch-show-insert-body msg (plist-get msg :body)
@@ -932,7 +924,6 @@ message at DEPTH in the current thread."
     ;; Ensure that the body ends with a newline.
     (unless (bolp)
       (insert "\n"))
-    (setq body-end (point-marker))
     (setq content-end (point-marker))
 
     ;; Indent according to the depth in the thread.
@@ -945,11 +936,9 @@ message at DEPTH in the current thread."
     ;; message.
     (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
 
-    (let ((headers-overlay (make-overlay headers-start headers-end))
-          (invis-specs (list headers-invis-spec message-invis-spec)))
-      (overlay-put headers-overlay 'invisible invis-specs)
-      (overlay-put headers-overlay 'priority 10))
-    (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
+    ;; Create overlays used to control visibility
+    (plist-put msg :headers-overlay (make-overlay headers-start headers-end))
+    (plist-put msg :message-overlay (make-overlay headers-start content-end))
 
     (plist-put msg :depth depth)
 
@@ -1349,18 +1338,12 @@ effects."
 ;; Functions relating to the visibility of messages and their
 ;; 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)
-  (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))
 
 (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))
 
 ;; Functions for setting and getting attributes of the current