X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=34dcedd28459cb92b640a4d8162be1fc38ed2ab7;hb=f84cbb1d4d65b097507381491d953272a50fe2f8;hp=df2389e40923b608905d99426879c9822173da3a;hpb=c67a04de60d4f2f9060e41204f2fd50f1edc6a5c;p=notmuch diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index df2389e4..34dcedd2 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -525,6 +525,73 @@ message at DEPTH in the current thread." (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) @@ -549,65 +616,11 @@ message at DEPTH in the current thread." (indent-rigidly start (point) 1))) t) -(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-w3m-cid-retrieve) - w3m-cid-retrieve-function-alist))) - (setq mm-inline-text-html-with-images t)) - -(defvar w3m-current-buffer) ;; From `w3m.el'. -(defvar notmuch-show-w3m-cid-store nil) -(make-variable-buffer-local 'notmuch-show-w3m-cid-store) - -(defun notmuch-show-w3m-cid-store-internal (content-id msg part content) - (push (list content-id msg part content) - notmuch-show-w3m-cid-store)) - -(defun notmuch-show-w3m-cid-store (msg part) - (let ((content-id (plist-get part :content-id))) - (when content-id - (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id) - msg part nil)))) - -(defun notmuch-show-w3m-cid-retrieve (url &rest args) - (let ((matching-part (with-current-buffer w3m-current-buffer - (assoc url notmuch-show-w3m-cid-store)))) - (if matching-part - (let* ((msg (nth 1 matching-part)) - (part (nth 2 matching-part)) - (content (nth 3 matching-part)) - (message-id (plist-get msg :id)) - (part-number (plist-get part :id)) - (content-type (plist-get part :content-type))) - ;; If we don't already have the content, get it and cache - ;; it, as some messages reference the same cid: part many - ;; times (hundreds!), which results in many calls to - ;; `notmuch part'. - (unless content - (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id) - part-number notmuch-show-process-crypto)) - (with-current-buffer w3m-current-buffer - (notmuch-show-w3m-cid-store-internal url msg part content))) - (insert content) - 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))) - ;; We assume that the first part is text/html and the remainder - ;; things that it references. - - ;; Stash the non-primary parts. - (mapc (lambda (part) - (notmuch-show-w3m-cid-store msg part)) - (cdr inner-parts)) - - ;; Render the primary part. + ;; 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) @@ -704,7 +717,7 @@ message at DEPTH in the current thread." (let ((start (if button (button-start button) (point)))) - (insert (notmuch-get-bodypart-content msg part notmuch-show-process-crypto)) + (insert (notmuch-get-bodypart-text msg part notmuch-show-process-crypto)) (save-excursion (save-restriction (narrow-to-region start (point-max)) @@ -713,9 +726,9 @@ message at DEPTH in the current thread." (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 notmuch-show-process-crypto)) - ;; notmuch-get-bodypart-content provides "raw", non-converted - ;; data. Replace CRLF with LF before icalendar can use it. + (insert (notmuch-get-bodypart-text msg part notmuch-show-process-crypto)) + ;; notmuch-get-bodypart-text does no newline conversion. + ;; Replace CRLF with LF before icalendar can use it. (goto-char (point-min)) (while (re-search-forward "\r\n" nil t) (replace-match "\n" nil nil)) @@ -919,6 +932,12 @@ useful for quoting in replies)." (defun notmuch-show-insert-body (msg body depth) "Insert the body BODY at depth DEPTH in the current thread." + + ;; Register all content IDs for this message. According to RFC + ;; 2392, content IDs are *global*, but it's okay if an MUA treats + ;; them as only global within a message. + (notmuch-show--register-cids msg (first body)) + (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body)) (defun notmuch-show-make-symbol (type) @@ -2162,15 +2181,14 @@ omit --in-reply-to=." ;; Interactive part functions and their helpers -(defun notmuch-show-generate-part-buffer (message-id nth) +(defun notmuch-show-generate-part-buffer (msg part) "Return a temporary buffer containing the specified part's content." (let ((buf (generate-new-buffer " *notmuch-part*")) (process-crypto notmuch-show-process-crypto)) (with-current-buffer buf - (setq notmuch-show-process-crypto process-crypto) - ;; Always acquires the part via `notmuch part', even if it is - ;; available in the SEXP output. - (insert (notmuch-get-bodypart-internal message-id nth notmuch-show-process-crypto))) + ;; This is always used in the content of mm handles, which + ;; expect undecoded, binary part content. + (insert (notmuch-get-bodypart-binary msg part process-crypto))) buf)) (defun notmuch-show-current-part-handle () @@ -2178,10 +2196,9 @@ omit --in-reply-to=." This creates a temporary buffer for the part's content; the caller is responsible for killing this buffer as appropriate." - (let* ((part (notmuch-show-get-part-properties)) - (message-id (notmuch-show-get-message-id)) - (nth (plist-get part :id)) - (buf (notmuch-show-generate-part-buffer message-id nth)) + (let* ((msg (notmuch-show-get-message-properties)) + (part (notmuch-show-get-part-properties)) + (buf (notmuch-show-generate-part-buffer msg part)) (computed-type (plist-get part :computed-type)) (filename (plist-get part :filename)) (disposition (if filename `(attachment (filename . ,filename)))))