- 'face 'message-mml)
-
-(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name)
- (insert-button
- (concat "[ "
- (if name (concat name ": ") "")
- declared-type
- (if (not (string-equal declared-type content-type))
- (concat " (as " content-type ")")
- "")
- " ]\n")
- :type 'notmuch-show-part-button-type
- :notmuch-part nth
- :notmuch-filename name))
-
-;; Functions handling particular MIME parts.
-
-(defun notmuch-show-save-part (message-id nth &optional filename)
- (with-temp-buffer
- ;; Always acquires the part via `notmuch part', even if it is
- ;; available in the JSON output.
- (insert (notmuch-show-get-bodypart-internal message-id nth))
- (let ((file (read-file-name
- "Filename to save as: "
- (or mailcap-download-directory "~/")
- nil nil
- filename))
- (require-final-newline nil)
- (coding-system-for-write 'no-conversion))
- (write-region (point-min) (point-max) file))))
-
-(defun notmuch-show-mm-display-part-inline (msg part content-type content)
- "Use the mm-decode/mm-view functions to display a part in the
-current buffer, if possible."
- (let ((display-buffer (current-buffer)))
- (with-temp-buffer
- (insert content)
- (let ((handle (mm-make-handle (current-buffer) (list content-type))))
- (set-buffer display-buffer)
- (if (and (mm-inlinable-p handle)
- (mm-inlined-p handle))
- (progn
- (mm-display-part handle)
- t)
- nil)))))
+ 'face 'message-mml
+ :supertype 'notmuch-button-type)
+
+(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
+ (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 "[ " base-label " ]")
+ :base-label base-label
+ :type 'notmuch-show-part-button-type
+ :notmuch-part-hidden nil))
+ (insert "\n")
+ ;; return button
+ button))
+
+(defun notmuch-show-toggle-part-invisibility (&optional button)
+ (interactive)
+ (let ((button (or button (button-at (point)))))
+ (when button
+ (let ((overlay (button-get button 'overlay))
+ (lazy-part (button-get button :notmuch-lazy-part)))
+ ;; We have a part to toggle if there is an overlay or if there is a lazy part.
+ ;; If neither is present we cannot toggle the part so we just return nil.
+ (when (or overlay lazy-part)
+ (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 (button-start button)))
+ (inhibit-read-only t))
+ ;; 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 (min old-point (1- (button-end button))))
+ ;; Return nil if there is a lazy-part, it is empty, and we are
+ ;; trying to show it. In all other cases return t.
+ (if lazy-part
+ (when show
+ (button-put button :notmuch-lazy-part nil)
+ (notmuch-show-lazy-part lazy-part button))
+ ;; else there must be an overlay.
+ (overlay-put overlay 'invisible (not show))
+ t)))))))
+
+;; Part content ID handling
+
+(defvar notmuch-show--cids nil
+ "Alist from raw content ID to (MSG PART).")
+(make-variable-buffer-local 'notmuch-show--cids)
+
+(defun notmuch-show--register-cids (msg part)
+ "Register content-IDs in PART and all of PART's sub-parts."
+ (let ((content-id (plist-get part :content-id)))
+ (when content-id
+ ;; Note that content-IDs are globally unique, except when they
+ ;; aren't: RFC 2046 section 5.1.4 permits children of a
+ ;; multipart/alternative to have the same content-ID, in which
+ ;; case the MUA is supposed to pick the best one it can render.
+ ;; We simply add the content-ID to the beginning of our alist;
+ ;; so if this happens, we'll take the last (and "best")
+ ;; alternative (even if we can't render it).
+ (push (list content-id msg part) notmuch-show--cids)))
+ ;; Recurse on sub-parts
+ (let ((ctype (notmuch-split-content-type
+ (downcase (plist-get part :content-type)))))
+ (cond ((equal (first ctype) "multipart")
+ (mapc (apply-partially #'notmuch-show--register-cids msg)
+ (plist-get part :content)))
+ ((equal ctype '("message" "rfc822"))
+ (notmuch-show--register-cids
+ msg
+ (first (plist-get (first (plist-get part :content)) :body)))))))
+
+(defun notmuch-show--get-cid-content (cid)
+ "Return a list (CID-content content-type) or nil.
+
+This will only find parts from messages that have been inserted
+into the current buffer. CID must be a raw content ID, without
+enclosing angle brackets, a cid: prefix, or URL encoding. This
+will return nil if the CID is unknown or cannot be retrieved."
+ (let ((descriptor (cdr (assoc cid notmuch-show--cids))))
+ (when descriptor
+ (let* ((msg (first descriptor))
+ (part (second descriptor))
+ ;; Request caching for this content, as some messages
+ ;; reference the same cid: part many times (hundreds!).
+ (content (notmuch-get-bodypart-binary
+ msg part notmuch-show-process-crypto 'cache))
+ (content-type (plist-get part :content-type)))
+ (list content content-type)))))
+
+(defun notmuch-show-setup-w3m ()
+ "Instruct w3m how to retrieve content from a \"related\" part of a message."
+ (interactive)
+ (if (boundp 'w3m-cid-retrieve-function-alist)
+ (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
+ (push (cons 'notmuch-show-mode #'notmuch-show--cid-w3m-retrieve)
+ w3m-cid-retrieve-function-alist)))
+ (setq mm-inline-text-html-with-images t))
+
+(defvar w3m-current-buffer) ;; From `w3m.el'.
+(defun notmuch-show--cid-w3m-retrieve (url &rest args)
+ ;; url includes the cid: prefix and is URL encoded (see RFC 2392).
+ (let* ((cid (url-unhex-string (substring url 4)))
+ (content-and-type
+ (with-current-buffer w3m-current-buffer
+ (notmuch-show--get-cid-content cid))))
+ (when content-and-type
+ (insert (first content-and-type))
+ (second content-and-type))))
+
+;; MIME part renderers
+
+(defun notmuch-show-multipart/*-to-list (part)
+ (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 button)
+ (let ((chosen-type (car (notmuch-multipart/alternative-choose msg (notmuch-show-multipart/*-to-list part))))
+ (inner-parts (plist-get part :content))
+ (start (point)))
+ ;; This inserts all parts of the chosen type rather than just one,
+ ;; 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))
+ (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
+ (indent-rigidly start (point) 1)))
+ t)
+
+(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button)
+ (let ((inner-parts (plist-get part :content))
+ (start (point)))
+
+ ;; Render the primary part. FIXME: Support RFC 2387 Start header.
+ (notmuch-show-insert-bodypart msg (car inner-parts) depth)
+ ;; Add hidden buttons for the rest
+ (mapc (lambda (inner-part)
+ (notmuch-show-insert-bodypart msg inner-part depth t))
+ (cdr inner-parts))
+
+ (when notmuch-show-indent-multipart
+ (indent-rigidly start (point) 1)))
+ t)