Function: nndoc-dissect-mime-parts-sub

nndoc-dissect-mime-parts-sub is a byte-compiled function defined in nndoc.el.gz.

Signature

(nndoc-dissect-mime-parts-sub HEAD-BEGIN BODY-END ARTICLE-INSERT POSITION PARENT)

Documentation

Dissect an entity, within a composite MIME message.

The complete message or MIME entity extends from HEAD-BEGIN to BODY-END. ARTICLE-INSERT should be added at beginning for generating a full article. The string POSITION holds a dotted decimal representation of the article position in the hierarchical structure, it is nil for the outer entity. PARENT is the message-ID of the parent summary line, or nil for none.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nndoc.el.gz
(defun nndoc-dissect-mime-parts-sub (head-begin body-end article-insert
						position parent)
  "Dissect an entity, within a composite MIME message.
The complete message or MIME entity extends from HEAD-BEGIN to BODY-END.
ARTICLE-INSERT should be added at beginning for generating a full article.
The string POSITION holds a dotted decimal representation of the article
position in the hierarchical structure, it is nil for the outer entity.
PARENT is the message-ID of the parent summary line, or nil for none."
  (let ((case-fold-search t)
	(message-id (nnmail-message-id))
	head-end body-begin summary-insert message-rfc822 multipart-any
	subject content-type type subtype boundary-regexp)
    ;; Gracefully handle a missing body.
    (goto-char head-begin)
    (if (or (and (eq (char-after) ?\n) (or (forward-char 1) t))
	    (search-forward "\n\n" body-end t))
	(setq head-end (1- (point))
	      body-begin (point))
      (setq head-end body-end
	    body-begin body-end))
    (narrow-to-region head-begin head-end)
    ;; Save MIME attributes.
    (goto-char head-begin)
    (setq content-type (message-fetch-field "Content-Type"))
    (when content-type
      (when (string-match
	     "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type)
	(setq type (downcase (match-string 1 content-type))
	      subtype (downcase (match-string 2 content-type))
	      message-rfc822 (and (string= type "message")
				  (string= subtype "rfc822"))
	      multipart-any (string= type "multipart")))
      (when (string-match ";[ \t\n]*name=\\([^ \t\n;]+\\)" content-type)
	(setq subject (match-string 1 content-type)))
      (when (string-match "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)" content-type)
	(setq boundary-regexp (concat "^--"
				      (regexp-quote
				       (match-string 1 content-type))
				      "\\(--\\)?[ \t]*\n"))))
    (unless subject
      (when (or multipart-any (not article-insert))
	(setq subject (message-fetch-field "Subject"))))
    (unless type
      (setq type "text"
	    subtype "plain"))
    ;; Prepare the article and summary inserts.
    (unless article-insert
      (setq article-insert (buffer-string)
	    head-end head-begin))
    ;; Fix MIME-Version
    (unless (string-match "MIME-Version:" article-insert)
      (setq article-insert
	    (concat article-insert "MIME-Version: 1.0\n")))
    (setq summary-insert article-insert)
    ;; - summary Subject.
    (setq summary-insert
	  (let ((line (concat "Subject: <" position
			      (and position multipart-any ".")
			      (and multipart-any "*")
			      (and (or position multipart-any) " ")
			      (cond ((string= subtype "plain") type)
				    ((string= subtype "basic") type)
				    (t subtype))
			      ">"
			      (and subject " ")
			      subject
			      "\n")))
	    (if (string-match "Subject:.*\n\\([ \t].*\n\\)*" summary-insert)
		(replace-match line t t summary-insert)
	      (concat summary-insert line))))
    ;; - summary Message-ID.
    (setq summary-insert
	  (let ((line (concat "Message-ID: " message-id "\n")))
	    (if (string-match "Message-ID:.*\n\\([ \t].*\n\\)*" summary-insert)
		(replace-match line t t summary-insert)
	      (concat summary-insert line))))
    ;; - summary References.
    (when parent
      (setq summary-insert
	    (let ((line (concat "References: " parent "\n")))
	      (if (string-match "References:.*\n\\([ \t].*\n\\)*"
				summary-insert)
		  (replace-match line t t summary-insert)
		(concat summary-insert line)))))
    ;; Generate dissection information for this entity.
    (push (list (incf nndoc-mime-split-ordinal)
		head-begin head-end body-begin body-end
		(count-lines body-begin body-end)
		article-insert summary-insert)
	  nndoc-dissection-alist)
    ;; Recurse for all sub-entities, if any.
    (widen)
    (cond
     (message-rfc822
      (save-excursion
	(nndoc-dissect-mime-parts-sub body-begin body-end nil
				      position message-id)))
     ((and multipart-any boundary-regexp)
      (let ((part-counter 0)
	    part-begin part-end eof-flag)
	(while (string-match "\
^\\(Lines\\|Content-\\(Type\\|Transfer-Encoding\\|Disposition\\)\\):.*\n\\([ \t].*\n\\)*"
			     article-insert)
	  (setq article-insert (replace-match "" t t article-insert)))
	(let ((case-fold-search nil))
	  (goto-char body-begin)
	  (setq eof-flag (not (re-search-forward boundary-regexp body-end t)))
	  (while (not eof-flag)
	    (setq part-begin (point))
	    (cond ((re-search-forward boundary-regexp body-end t)
		   (or (not (match-string 1))
		       (string= (match-string 1) "")
		       (setq eof-flag t))
		   (forward-line -1)
		   (setq part-end (point))
		   (forward-line 1))
		  (t (setq part-end body-end
			   eof-flag t)))
	    (save-excursion
	      (nndoc-dissect-mime-parts-sub
	       part-begin part-end article-insert
	       (concat position
		       (and position ".")
                       (format "%d" (incf part-counter)))
	       message-id)))))))))