Function: mm-dissect-buffer

mm-dissect-buffer is an autoloaded and byte-compiled function defined in mm-decode.el.gz.

Signature

(mm-dissect-buffer &optional NO-STRICT-MIME LOOSE-MIME FROM)

Documentation

Dissect the current buffer and return a list of MIME handles.

If NO-STRICT-MIME, don't require the message to have a MIME-Version header before proceeding.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/mm-decode.el.gz
(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
  "Dissect the current buffer and return a list of MIME handles.
If NO-STRICT-MIME, don't require the message to have a
MIME-Version header before proceeding."
  (save-excursion
    (let (ct ctl type subtype cte cd description id result)
      (save-restriction
	(mail-narrow-to-head)
	(when (or no-strict-mime
		  loose-mime
		  (mail-fetch-field "mime-version"))
	  (setq ct (mail-fetch-field "content-type")
		ctl (and ct (mail-header-parse-content-type ct))
		cte (mail-fetch-field "content-transfer-encoding")
                cd (or (mail-fetch-field "content-disposition")
                       (when (and ctl
                                  (eq 'mm-inline-text
                                      (cadr (mm-assoc-string-match
                                             mm-inline-media-tests
                                             (car ctl)))))
                         "inline"))
		;; Newlines in description should be stripped so as
		;; not to break the MIME tag into two or more lines.
		description (message-fetch-field "content-description")
		id (mail-fetch-field "content-id"))
	  (unless from
	    (setq from (mail-fetch-field "from")))
	  ;; FIXME: In some circumstances, this code is running within
	  ;; a unibyte macro.  mail-extract-address-components
	  ;; creates unibyte buffers. This `if', though not a perfect
	  ;; solution, avoids most of them.
	  (if from
	      (setq from (cadr (mail-extract-address-components from))))
	  (if description
	      (setq description (mail-decode-encoded-word-string
				 description)))))
      (if (or (not ctl)
	      (not (string-search "/" (car ctl))))
	  (mm-dissect-singlepart
	   (list mm-dissect-default-type)
	   (and cte (intern (downcase (mail-header-strip-cte cte))))
	   no-strict-mime
	   (and cd (mail-header-parse-content-disposition cd))
	   description)
	(setq type (split-string (car ctl) "/"))
	(setq subtype (cadr type)
	      type (car type))
	(setq
	 result
	 (cond
	  ((equal type "multipart")
	   (let ((mm-dissect-default-type (if (equal subtype "digest")
					      "message/rfc822"
					    "text/plain"))
		 (start (cdr (assq 'start (cdr ctl)))))
	     (add-text-properties 0 (length (car ctl))
				  (mm-alist-to-plist (cdr ctl)) (car ctl))

	     ;; what really needs to be done here is a way to link a
	     ;; MIME handle back to its parent MIME handle (in a multilevel
	     ;; MIME article).  That would probably require changing
	     ;; the mm-handle API so we simply store the multipart buffer
	     ;; name as a text property of the "multipart/whatever" string.
	     (add-text-properties 0 (length (car ctl))
				  (list 'buffer (mm-copy-to-buffer)
					'from from
					'start start)
				  (car ctl))
	     (cons (car ctl) (mm-dissect-multipart ctl from))))
          (t
           (let* ((handle
                   (mm-dissect-singlepart
                    ctl
                    (and cte (intern (downcase (mail-header-strip-cte cte))))
                    no-strict-mime
                    (and cd (mail-header-parse-content-disposition cd))
                    description id))
                  (intermediate-result
                   (mm-possibly-verify-or-decrypt handle ctl from)))
             (when (and (equal type "application")
                        (or (equal subtype "pkcs7-mime")
                            (equal subtype "x-pkcs7-mime")))
               (add-text-properties
                0 (length (car ctl))
                (list 'protocol
                      (concat (substring-no-properties (car ctl))
                              "_"
                              (cdr (assoc 'smime-type ctl))))
                (car ctl))
               ;; If this is a pkcs7-mime lets treat this special and
               ;; more like multipart so the pkcs7-mime part does not
               ;; get ignored.
               (setq intermediate-result
                     (cons (car ctl) (list intermediate-result))))
             intermediate-result))))
        (when id
          (when (string-match " *<\\(.*\\)> *" id)
            (setq id (match-string 1 id)))
	  (push (cons id result) mm-content-id-alist))
	result))))