Function: rmail-mime-process

rmail-mime-process is a byte-compiled function defined in rmailmm.el.gz.

Signature

(rmail-mime-process SHOW-HEADERS PARSE-TAG &optional DEFAULT-CONTENT-TYPE DEFAULT-CONTENT-DISPOSITION)

Source Code

;; Defined in /usr/src/emacs/lisp/mail/rmailmm.el.gz
(defun rmail-mime-process (show-headers parse-tag &optional
					default-content-type
					default-content-disposition)
  (let ((end (point-min))
	content-type
	content-transfer-encoding
	content-disposition)
    ;; `point-min' returns the beginning and `end' points at the end
    ;; of the headers.
    (goto-char (point-min))
    ;; If we're showing a part without headers, then it will start
    ;; with a newline.
    (if (eq (char-after) ?\n)
	(setq end (1+ (point)))
      (when (search-forward "\n\n" nil t)
	(setq end (match-end 0))
	(save-restriction
	  (narrow-to-region (point-min) end)
	  ;; FIXME: Default disposition of the multipart entities should
	  ;; be inherited.
	  (setq content-type
		(mail-fetch-field "Content-Type")
		content-transfer-encoding
		(mail-fetch-field "Content-Transfer-Encoding")
		content-disposition
		(mail-fetch-field "Content-Disposition")))))
    ;; Per RFC 2045, C-T-E is case insensitive (bug#5070), but the others
    ;; are not completely so.  Hopefully mail-header-parse-* DTRT.
    (if content-transfer-encoding
	(setq content-transfer-encoding (downcase content-transfer-encoding)))
    (setq content-type
	  (if content-type
	      (or (mail-header-parse-content-type content-type)
		  '("text/plain"))
	    (or default-content-type '("text/plain"))))
    (setq content-disposition
	  (if content-disposition
	      (mail-header-parse-content-disposition content-disposition)
	    ;; If none specified, we are free to choose what we deem
	    ;; suitable according to RFC 2183.  We like inline.
	    (or default-content-disposition '("inline"))))
    ;; Unrecognized disposition types are to be treated like
    ;; attachment according to RFC 2183.
    (unless (member (car content-disposition) '("inline" "attachment"))
      (setq content-disposition '("attachment")))

    (if parse-tag
	(let* ((is-inline (string= (car content-disposition) "inline"))
	       (hdr-end (copy-marker end))
	       (header (vector (point-min-marker) hdr-end nil))
	       (tagline (vector parse-tag (cons nil nil) t))
	       (body (vector hdr-end (point-max-marker) is-inline))
	       (new (rmail-mime--make-display
                     (aref header 2) (aref tagline 2) (aref body 2)))
	       children handler entity)
	  (cond ((string-match "multipart/.*" (car content-type))
		 (save-restriction
		   (narrow-to-region (1- end) (point-max))
		   (if (zerop (length parse-tag)) ; top level of message
		       (setf (rmail-mime-display-tagline new)
                             (aset tagline 2 nil))) ; don't show tagline
		   (setq children (rmail-mime-process-multipart
				   content-type
				   content-disposition
				   content-transfer-encoding
				   parse-tag)
			 handler 'rmail-mime-insert-multipart)))
		((string-match "message/rfc822" (car content-type))
		 (save-restriction
		   (narrow-to-region end (point-max))
		   (let* ((msg (rmail-mime-process t parse-tag
						   '("text/plain") '("inline")))
			  (msg-new (aref (rmail-mime-entity-display msg) 1)))
		     ;; Show header of the child.
		     (setf (rmail-mime-display-header msg-new) t)
		     (aset (rmail-mime-entity-header msg) 2 t)
		     ;; Hide tagline of the child.
		     (setf (rmail-mime-display-tagline msg-new) nil)
		     (aset (rmail-mime-entity-tagline msg) 2 nil)
		     (setq children (list msg)
			   handler 'rmail-mime-insert-multipart))))
		((and is-inline (string-match "text/html" (car content-type)))
		 ;; Display tagline, so part can be detached
		 (setf (rmail-mime-display-tagline new) (aset tagline 2 t))
		 (setf (rmail-mime-display-body new) (aset body 2 t)) ; display body also.
		 (setq handler 'rmail-mime-insert-bulk))
		;; Inline non-HTML text
		((and is-inline (string-match "text/" (car content-type)))
		 ;; Don't need a tagline.
		 (setf (rmail-mime-display-tagline new) (aset tagline 2 nil))
		 (setq handler 'rmail-mime-insert-text))
		(t
		 ;; Force hidden mode.
		 (setf (rmail-mime-display-tagline new) (aset tagline 2 t))
		 (setf (rmail-mime-display-body new) (aset body 2 nil))
		 (setq handler 'rmail-mime-insert-bulk)))
	  (setq entity (rmail-mime-entity
			content-type
			content-disposition
			content-transfer-encoding
			(vector (rmail-mime--make-display nil nil nil) new)
			header tagline body children handler))
	  (if (and (eq handler 'rmail-mime-insert-bulk)
		   (rmail-mime-set-bulk-data entity))
	      ;; Show the body.
	      (setf (rmail-mime-display-body new) (aset body 2 t)))
	  entity)

      ;; Hide headers and handle the part.
      (put-text-property (point-min) (point-max) 'rmail-mime-entity
			 (rmail-mime-entity
			  content-type content-disposition
			  content-transfer-encoding
			  (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
			  (vector nil nil 'raw) (vector "" (cons nil nil) nil)
			  (vector nil nil 'raw) nil nil))
      (save-restriction
	(cond ((string= (car content-type) "message/rfc822")
	       (narrow-to-region end (point-max)))
	      ((not show-headers)
	       (delete-region (point-min) end)))
	(rmail-mime-handle content-type content-disposition
			   content-transfer-encoding)))))