-The generated article should use MESSAGE-ID and REFERENCES field values."
- ;; Note: `case-fold-search' is already `t' from the calling function.
- (let ((head-begin begin)
- (body-end end)
- head-end body-begin type subtype composite comment)
- (save-excursion
- ;; Gracefully handle a missing body.
- (goto-char head-begin)
- (if (search-forward "\n\n" body-end t)
- (setq head-end (1- (point))
- body-begin (point))
- (setq head-end end
- body-begin end))
- ;; Save MIME attributes.
- (goto-char head-begin)
- (if (re-search-forward "\
-^Content-Type: *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)"
- head-end t)
- (setq type (downcase (match-string 1))
- subtype (downcase (match-string 2)))
- (setq type "text"
- subtype "plain"))
- (setq composite (string= type "multipart")
- comment (concat position
- (when (and position composite) ".")
- (when composite "*")
- (when (or position composite) " ")
- (cond ((string= subtype "plain") type)
- ((string= subtype "basic") type)
- (t subtype))))
- ;; 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)
- comment message-id references)
- nndoc-dissection-alist)
- ;; Recurse for all sub-entities, if any.
- (goto-char head-begin)
- (when (re-search-forward
- (concat "\
-^Content-Type: *multipart/\\([a-z]+\\);\\(.*;\\)*"
- "[ \t\n]*[ \t]boundary=\"?\\([^\"\n]*[^\" \t\n]\\)")
- head-end t)
- (let ((boundary (concat "\n--" (match-string 3) "\\(--\\)?[ \t]*\n"))
- (part-counter 0)
- begin end eof-flag)
- (goto-char head-end)
- (setq eof-flag (not (re-search-forward boundary body-end t)))
+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)))