emacs: show move addition of :notmuch-part to separate function

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index e8c83433f7c0bf52b18fd39a8a96fee60a56bd57..6ec70c906bc3e65d90cd28b649c720b575fd968b 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -482,7 +482,8 @@ message at DEPTH in the current thread."
          (insert-button
           (concat "[ " base-label " ]")
           :base-label base-label
          (insert-button
           (concat "[ " base-label " ]")
           :base-label base-label

-          :type 'notmuch-show-part-button-type))
+          :type 'notmuch-show-part-button-type
+          :notmuch-part-hidden nil))

     (insert "\n")
     ;; return button
     button))
     (insert "\n")
     ;; return button
     button))


@@ -493,20 +494,22 @@ message at DEPTH in the current thread."
   (let* ((button (or button (button-at (point))))
         (overlay (button-get button 'overlay)))
     (when overlay
   (let* ((button (or button (button-at (point))))
         (overlay (button-get button 'overlay)))
     (when overlay

-      (let* ((show (overlay-get overlay 'invisible))
+      (let* ((show (button-get button :notmuch-part-hidden))

             (new-start (button-start button))
             (button-label (button-get button :base-label))
             (old-point (point))
             (properties (text-properties-at (point)))
             (inhibit-read-only t))
             (new-start (button-start button))
             (button-label (button-get button :base-label))
             (old-point (point))
             (properties (text-properties-at (point)))
             (inhibit-read-only t))

-       (overlay-put overlay 'invisible (not show))
+       ;; Toggle the button itself.
+       (button-put button :notmuch-part-hidden (not show))

        (goto-char new-start)
        (insert "[ " button-label (if show " ]" " (hidden) ]"))
        (set-text-properties new-start (point) properties)
        (let ((old-end (button-end button)))
          (move-overlay button new-start (point))
          (delete-region (point) old-end))
        (goto-char new-start)
        (insert "[ " button-label (if show " ]" " (hidden) ]"))
        (set-text-properties new-start (point) properties)
        (let ((old-end (button-end button)))
          (move-overlay button new-start (point))
          (delete-region (point) old-end))

-       (goto-char (min old-point (1- (button-end button))))))))
+       (goto-char (min old-point (1- (button-end button))))
+       (overlay-put overlay 'invisible (not show))))))

 
 ;; MIME part renderers
 
 
 ;; MIME part renderers
 


@@ -514,8 +517,7 @@ message at DEPTH in the current thread."
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
          (plist-get part :content)))
 
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
          (plist-get part :content)))
 

-(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
-  (notmuch-show-insert-part-header nth declared-type content-type nil)
+(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button)

   (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
        (inner-parts (plist-get part :content))
        (start (point)))
   (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
        (inner-parts (plist-get part :content))
        (start (point)))


@@ -592,8 +594,7 @@ message at DEPTH in the current thread."
          content-type)
       nil)))
 
          content-type)
       nil)))
 

-(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type)
-  (notmuch-show-insert-part-header nth declared-type content-type nil)
+(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button)

   (let ((inner-parts (plist-get part :content))
        (start (point)))
 
   (let ((inner-parts (plist-get part :content))
        (start (point)))
 


@@ -612,16 +613,15 @@ message at DEPTH in the current thread."
       (indent-rigidly start (point) 1)))
   t)
 
       (indent-rigidly start (point) 1)))
   t)
 

-(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type)
-  (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
-    (button-put button 'face 'notmuch-crypto-part-header)
-    ;; add signature status button if sigstatus provided
-    (if (plist-member part :sigstatus)
-       (let* ((from (notmuch-show-get-header :From msg))
-              (sigstatus (car (plist-get part :sigstatus))))
-         (notmuch-crypto-insert-sigstatus-button sigstatus from))
-      ;; if we're not adding sigstatus, tell the user how they can get it
-      (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
+(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button)
+  (button-put button 'face 'notmuch-crypto-part-header)
+  ;; add signature status button if sigstatus provided
+  (if (plist-member part :sigstatus)
+      (let* ((from (notmuch-show-get-header :From msg))
+            (sigstatus (car (plist-get part :sigstatus))))
+       (notmuch-crypto-insert-sigstatus-button sigstatus from))
+    ;; if we're not adding sigstatus, tell the user how they can get it
+    (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts."))

 
   (let ((inner-parts (plist-get part :content))
        (start (point)))
 
   (let ((inner-parts (plist-get part :content))
        (start (point)))


@@ -634,20 +634,19 @@ message at DEPTH in the current thread."
       (indent-rigidly start (point) 1)))
   t)
 
       (indent-rigidly start (point) 1)))
   t)
 

-(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type)
-  (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
-    (button-put button 'face 'notmuch-crypto-part-header)
-    ;; add encryption status button if encstatus specified
-    (if (plist-member part :encstatus)
-       (let ((encstatus (car (plist-get part :encstatus))))
-         (notmuch-crypto-insert-encstatus-button encstatus)
-         ;; add signature status button if sigstatus specified
-         (if (plist-member part :sigstatus)
-             (let* ((from (notmuch-show-get-header :From msg))
-                    (sigstatus (car (plist-get part :sigstatus))))
-               (notmuch-crypto-insert-sigstatus-button sigstatus from))))
-      ;; if we're not adding encstatus, tell the user how they can get it
-      (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
+(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button)
+  (button-put button 'face 'notmuch-crypto-part-header)
+  ;; add encryption status button if encstatus specified
+  (if (plist-member part :encstatus)
+      (let ((encstatus (car (plist-get part :encstatus))))
+       (notmuch-crypto-insert-encstatus-button encstatus)
+       ;; add signature status button if sigstatus specified
+       (if (plist-member part :sigstatus)
+           (let* ((from (notmuch-show-get-header :From msg))
+                  (sigstatus (car (plist-get part :sigstatus))))
+             (notmuch-crypto-insert-sigstatus-button sigstatus from))))
+    ;; if we're not adding encstatus, tell the user how they can get it
+    (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts."))

 
   (let ((inner-parts (plist-get part :content))
        (start (point)))
 
   (let ((inner-parts (plist-get part :content))
        (start (point)))


@@ -660,8 +659,7 @@ message at DEPTH in the current thread."
       (indent-rigidly start (point) 1)))
   t)
 
       (indent-rigidly start (point) 1)))
   t)
 

-(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type)
-  (notmuch-show-insert-part-header nth declared-type content-type nil)
+(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth button)

   (let ((inner-parts (plist-get part :content))
        (start (point)))
     ;; Show all of the parts.
   (let ((inner-parts (plist-get part :content))
        (start (point)))
     ;; Show all of the parts.


@@ -673,8 +671,7 @@ message at DEPTH in the current thread."
       (indent-rigidly start (point) 1)))
   t)
 
       (indent-rigidly start (point) 1)))
   t)
 

-(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
-  (notmuch-show-insert-part-header nth declared-type content-type nil)
+(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth button)

   (let* ((message (car (plist-get part :content)))
         (body (car (plist-get message :body)))
         (start (point)))
   (let* ((message (car (plist-get part :content)))
         (body (car (plist-get message :body)))
         (start (point)))


@@ -695,12 +692,13 @@ message at DEPTH in the current thread."
       (indent-rigidly start (point) 1)))
   t)
 
       (indent-rigidly start (point) 1)))
   t)
 

-(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
-  (let ((start (point)))
-    ;; If this text/plain part is not the first part in the message,
-    ;; insert a header to make this clear.
-    (if (> nth 1)
-       (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
+(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth button)
+  ;; For backward compatibility we want to apply the text/plain hook
+  ;; to the whole of the part including the part button if there is
+  ;; one.
+  (let ((start (if button
+                  (button-start button)
+                (point))))

     (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
     (save-excursion
       (save-restriction
     (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
     (save-excursion
       (save-restriction


@@ -708,8 +706,7 @@ message at DEPTH in the current thread."
        (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
   t)
 
        (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
   t)
 

-(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)
-  (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
+(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth button)

   (insert (with-temp-buffer
            (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
            ;; notmuch-get-bodypart-content provides "raw", non-converted
   (insert (with-temp-buffer
            (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
            ;; notmuch-get-bodypart-content provides "raw", non-converted


@@ -732,8 +729,8 @@ message at DEPTH in the current thread."
   t)
 
 ;; For backwards compatibility.
   t)
 
 ;; For backwards compatibility.

-(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
-  (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type))
+(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button)
+  (notmuch-show-insert-part-text/calendar msg part content-type nth depth button))

 
 (defun notmuch-show-get-mime-type-of-application/octet-stream (part)
   ;; If we can deduce a MIME type from the filename of the attachment,
 
 (defun notmuch-show-get-mime-type-of-application/octet-stream (part)
   ;; If we can deduce a MIME type from the filename of the attachment,


@@ -751,11 +748,7 @@ message at DEPTH in the current thread."
                nil))
          nil))))
 
                nil))
          nil))))
 

-;; Handler for wash generated inline patch fake parts.
-(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type)
-  (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type))
-
-(defun notmuch-show-insert-part-text/html (msg part content-type nth depth declared-type)
+(defun notmuch-show-insert-part-text/html (msg part content-type nth depth button)

   ;; text/html handler to work around bugs in renderers and our
   ;; invisibile parts code. In particular w3m sets up a keymap which
   ;; "leaks" outside the invisible region and causes strange effects
   ;; text/html handler to work around bugs in renderers and our
   ;; invisibile parts code. In particular w3m sets up a keymap which
   ;; "leaks" outside the invisible region and causes strange effects


@@ -763,11 +756,10 @@ message at DEPTH in the current thread."
   ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map
   ;; remains).
   (let ((mm-inline-text-html-with-w3m-keymap nil))
   ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map
   ;; remains).
   (let ((mm-inline-text-html-with-w3m-keymap nil))

-    (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type)))
+    (notmuch-show-insert-part-*/* msg part content-type nth depth button)))

 
 

-(defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
+(defun notmuch-show-insert-part-*/* (msg part content-type nth depth button)

   ;; This handler _must_ succeed - it is the handler of last resort.
   ;; This handler _must_ succeed - it is the handler of last resort.

-  (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))

   (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
   t)
 
   (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
   t)
 


@@ -790,13 +782,13 @@ message at DEPTH in the current thread."
 
 ;; \f
 
 
 ;; \f
 

-(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
+(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)

   (let ((handlers (notmuch-show-handlers-for content-type)))
     ;; Run the content handlers until one of them returns a non-nil
     ;; value.
     (while (and handlers
                (not (condition-case err
   (let ((handlers (notmuch-show-handlers-for content-type)))
     ;; Run the content handlers until one of them returns a non-nil
     ;; value.
     (while (and handlers
                (not (condition-case err

-                        (funcall (car handlers) msg part content-type nth depth declared-type)
+                        (funcall (car handlers) msg part content-type nth depth button)

                       (error (progn
                                (insert "!!! Bodypart insert error: ")
                                (insert (error-message-string err))
                       (error (progn
                                (insert "!!! Bodypart insert error: ")
                                (insert (error-message-string err))


@@ -804,26 +796,43 @@ message at DEPTH in the current thread."
       (setq handlers (cdr handlers))))
   t)
 
       (setq handlers (cdr handlers))))
   t)
 

-(defun notmuch-show-create-part-overlays (msg beg end hide)
+(defun notmuch-show-create-part-overlays (button beg end)

   "Add an overlay to the part between BEG and END"
   "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))
-      ;; We toggle the button for hidden parts as that gets the
-      ;; button label right.
-      (save-excursion
-       (when hide
-         (notmuch-show-toggle-part-invisibility button))))))
+
+  ;; If there is no button (i.e., the part is text/plain and the first
+  ;; part) or if the part has no content then we don't make the part
+  ;; toggleable.
+  (when (and button (/= beg end))
+    (button-put button 'overlay (make-overlay beg end))
+    ;; Return true if we created an overlay.
+    t))
+
+(defun notmuch-show-record-part-information (part beg end)
+  "Store PART as a text property from BEG to END"
+
+  ;; Record part information.  Since we already inserted subparts,
+  ;; don't override existing :notmuch-part properties.
+  (notmuch-map-text-property beg end :notmuch-part
+                            (lambda (v) (or v part)))
+  ;; Make :notmuch-part front sticky and rear non-sticky so it stays
+  ;; applied to the beginning of each line when we indent the
+  ;; message.  Since we're operating on arbitrary renderer output,
+  ;; watch out for sticky specs of t, which means all properties are
+  ;; front-sticky/rear-nonsticky.
+  (notmuch-map-text-property beg end 'front-sticky
+                            (lambda (v) (if (listp v)
+                                            (pushnew :notmuch-part v)
+                                          v)))
+  (notmuch-map-text-property beg end 'rear-nonsticky
+                            (lambda (v) (if (listp v)
+                                            (pushnew :notmuch-part v)
+                                          v))))

 
 (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."
 
 (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)))
         (mime-type (or (and (string= content-type "application/octet-stream")
                             (notmuch-show-get-mime-type-of-application/octet-stream part))
   (let* ((content-type (downcase (plist-get part :content-type)))
         (mime-type (or (and (string= content-type "application/octet-stream")
                             (notmuch-show-get-mime-type-of-application/octet-stream part))


@@ -831,26 +840,24 @@ If HIDE is non-nil then initially hide this part."
                             "text/x-diff")
                        content-type))
         (nth (plist-get part :id))
                             "text/x-diff")
                        content-type))
         (nth (plist-get part :id))

-        (beg (point)))
+        (beg (point))
+        ;; We omit the part button for the first (or only) part if this is text/plain.
+        (button (unless (and (string= mime-type "text/plain") (<= nth 1))
+                  (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename))))
+        (content-beg (point)))

 
 

-    (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type)
+    (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)

     ;; 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"))
     ;; 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)
-    ;; Record part information.  Since we already inserted subparts,
-    ;; don't override existing :notmuch-part properties.
-    (notmuch-map-text-property beg (point) :notmuch-part
-                              (lambda (v) (or v part)))
-    ;; Make :notmuch-part front sticky and rear non-sticky so it stays
-    ;; applied to the beginning of each line when we indent the message.
-    (notmuch-map-text-property beg (point) 'front-sticky
-                              (lambda (v) (pushnew :notmuch-part v)))
-    (notmuch-map-text-property beg (point) 'rear-nonsticky
-                              (lambda (v) (pushnew :notmuch-part v)))))
+    (notmuch-show-create-part-overlays button content-beg (point))
+    (when hide
+      (save-excursion
+       (notmuch-show-toggle-part-invisibility button)))
+    (notmuch-show-record-part-information part beg (point))))

 
 (defun notmuch-show-insert-body (msg body depth)
   "Insert the body BODY at depth DEPTH in the current thread."
 
 (defun notmuch-show-insert-body (msg body depth)
   "Insert the body BODY at depth DEPTH in the current thread."


@@ -1529,8 +1536,8 @@ This command is intended to be one of the simplest ways to
 process a thread of email. It works exactly like
 notmuch-show-advance, in that it scrolls through messages in a
 show buffer, except that when it gets to the end of the buffer it
 process a thread of email. It works exactly like
 notmuch-show-advance, in that it scrolls through messages in a
 show buffer, except that when it gets to the end of the buffer it

-archives the entire current thread, (remove the \"inbox\" tag
-from each message), kills the buffer, and displays the next
+archives the entire current thread, (apply changes in
+`notmuch-archive-tags'), kills the buffer, and displays the next

 thread from the search from which this thread was originally
 shown."
   (interactive)
 thread from the search from which this thread was originally
 shown."
   (interactive)


@@ -1835,10 +1842,9 @@ search results instead."
   "Archive each message in thread.
 
 Archive each message currently shown by applying the tag changes
   "Archive each message in thread.
 
 Archive each message currently shown by applying the tag changes

-in `notmuch-archive-tags' to each (remove the \"inbox\" tag by
-default). If a prefix argument is given, the messages will be
-\"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
-will be reversed.
+in `notmuch-archive-tags' to each. If a prefix argument is given,
+the messages will be \"unarchived\", i.e. the tag changes in
+`notmuch-archive-tags' will be reversed.

 
 Note: This command is safe from any race condition of new messages
 being delivered to the same thread. It does not archive the
 
 Note: This command is safe from any race condition of new messages
 being delivered to the same thread. It does not archive the


@@ -1865,10 +1871,9 @@ buffer."
   "Archive the current message.
 
 Archive the current message by applying the tag changes in
   "Archive the current message.
 
 Archive the current message by applying the tag changes in

-`notmuch-archive-tags' to it (remove the \"inbox\" tag by
-default). If a prefix argument is given, the message will be
-\"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
-will be reversed."
+`notmuch-archive-tags' to it. If a prefix argument is given, the
+message will be \"unarchived\", i.e. the tag changes in
+`notmuch-archive-tags' will be reversed."

   (interactive "P")
   (when notmuch-archive-tags
     (apply 'notmuch-show-tag-message
   (interactive "P")
   (when notmuch-archive-tags
     (apply 'notmuch-show-tag-message