Function: rmail-mime-process-multipart
rmail-mime-process-multipart is a byte-compiled function defined in
rmailmm.el.gz.
Signature
(rmail-mime-process-multipart CONTENT-TYPE CONTENT-DISPOSITION CONTENT-TRANSFER-ENCODING PARSE-TAG)
Documentation
Process the current buffer as a multipart MIME body.
If PARSE-TAG is nil, modify the current buffer directly for showing the MIME body and return nil.
Otherwise, PARSE-TAG is a string indicating the depth and index number of the entity. In this case, parse the current buffer and return a list of MIME-entity objects.
The other arguments are the same as rmail-mime-multipart-handler.
Source Code
;; Defined in /usr/src/emacs/lisp/mail/rmailmm.el.gz
(defun rmail-mime-process-multipart (content-type
content-disposition
content-transfer-encoding
parse-tag)
"Process the current buffer as a multipart MIME body.
If PARSE-TAG is nil, modify the current buffer directly for
showing the MIME body and return nil.
Otherwise, PARSE-TAG is a string indicating the depth and index
number of the entity. In this case, parse the current buffer and
return a list of MIME-entity objects.
The other arguments are the same as `rmail-mime-multipart-handler'."
;; Some MUAs start boundaries with "--", while it should start
;; with "CRLF--", as defined by RFC 2046:
;; The boundary delimiter MUST occur at the beginning of a line,
;; i.e., following a CRLF, and the initial CRLF is considered to
;; be attached to the boundary delimiter line rather than part
;; of the preceding part.
;; We currently don't handle that.
(let ((boundary (cdr (assq 'boundary content-type)))
(subtype (cadr (split-string (car content-type) "/")))
(index 0)
beg end next entities truncated last)
(unless boundary
(rmail-mm-get-boundary-error-message
"No boundary defined" content-type content-disposition
content-transfer-encoding))
(setq boundary (concat "\n--" boundary))
;; Hide the body before the first bodypart
(goto-char (point-min))
(when (and (search-forward boundary nil t)
(looking-at "[ \t]*\n"))
(if parse-tag
(narrow-to-region (match-end 0) (point-max))
(delete-region (point-min) (match-end 0))))
;; Change content-type to the proper default one for the children.
(cond ((string-match "mixed" subtype)
(setq content-type '("text/plain")))
((string-match "digest" subtype)
(setq content-type '("message/rfc822")))
(t
(setq content-type nil)))
;; Loop over all body parts, where beg points at the beginning of
;; the part and end points at the end of the part. next points at
;; the beginning of the next part. The current point is just
;; after the boundary tag.
(setq beg (point-min))
(while (or (and (search-forward boundary nil t)
(setq truncated nil end (match-beginning 0)))
;; If the boundary does not appear at all,
;; the message was truncated.
;; Handle the rest of the truncated message
;; (if it isn't empty) by pretending that the boundary
;; appears at the end of the message.
;; We use `last' to distinguish this from the more
;; likely situation of there being an epilogue
;; after the last boundary, which should be ignored.
;; See rmailmm-test-multipart-handler for an example,
;; and also bug#10101.
(and (not last)
(save-excursion
(skip-chars-forward "\n")
(> (point-max) (point)))
(setq truncated t end (point-max))))
;; If this is the last boundary according to RFC 2046, hide the
;; epilogue, else hide the boundary only. Use a marker for
;; `next' because `rmail-mime-show' may change the buffer.
(cond ((looking-at "--[ \t]*$")
(setq next (point-max-marker)
last t))
((looking-at "[ \t]*\n")
(setq next (copy-marker (match-end 0) t)))
(truncated
;; We're handling what's left of a truncated message.
(setq next (point-max-marker)))
(t
;; The original code signaled an error as below, but
;; this line may be a boundary of nested multipart. So,
;; we just set `next' to nil to skip this line
;; (rmail-mm-get-boundary-error-message
;; "Malformed boundary" content-type content-disposition
;; content-transfer-encoding)
(setq next nil)))
(when next
(setq index (1+ index))
;; Handle the part.
(if parse-tag
(save-restriction
(narrow-to-region beg end)
(let ((child (rmail-mime-process
nil (format "%s/%d" parse-tag index)
content-type content-disposition)))
;; Display a tagline.
(setf (rmail-mime-display-tagline
(aref (rmail-mime-entity-display child) 1))
(aset (rmail-mime-entity-tagline child) 2 t))
(setf (rmail-mime-entity-truncated child) truncated)
(push child entities)))
(delete-region end next)
(save-restriction
(narrow-to-region beg end)
(rmail-mime-show)))
(goto-char (setq beg next))))
(when parse-tag
(setq entities (nreverse entities))
(if (string-match "alternative" subtype)
;; Find the best entity to show, and hide all the others.
;; If rmail-mime-prefer-html is set, html is best, then plain.
;; If not, plain is best, then html.
;; Then comes any other text part.
;; If thereto of the same type, earlier entities in the message (later
;; in the reverse list) are preferred.
(let (best best-priority)
(dolist (child entities)
(if (string= (or (car (rmail-mime-entity-disposition child))
(car content-disposition))
"inline")
(let ((type (car (rmail-mime-entity-type child))))
(if (string-match "text/" type)
;; Consider all inline text parts
(let ((priority
(cond ((string-match "text/html" type)
(if rmail-mime-prefer-html 1 2))
((string-match "text/plain" type)
(if rmail-mime-prefer-html 2 1))
(t 3))))
(if (or (null best) (<= priority best-priority))
(setq best child
best-priority priority)))))))
(dolist (child entities)
(unless (eq best child)
(aset (rmail-mime-entity-body child) 2 nil)
(rmail-mime-hidden-mode child)))))
entities)))