+2013-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-dissect-buffer): Revert last change.
+ * nndoc.el (nndoc-dissect-mime-parts-sub): Ditto.
+ The problem that motivated those changes was attributed to a broken
+ mail sender, and has been fixed.
+
2013-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-decode.el (mm-dissect-buffer): Guess content-type if the first
description)))))
(if (or (not ctl)
(not (string-match "/" (car ctl))))
- (let ((cdl (and cd (mail-header-parse-content-disposition cd))))
(mm-dissect-singlepart
- ;; Guess Content-Type from the file name extention.
- ;; Some mailer sends a part without type like this:
- ;; Content-Type: ; name="IMG_3156.JPG"
- ;; Content-Disposition: attachment; filename="IMG_3156.JPG"
- (list (or
- (let ((tem
- (or (mail-content-type-get cdl 'filename)
- (and ct
- (with-temp-buffer
- (insert ct)
- (goto-char (point-min))
- (and (re-search-forward "\
-;[\t\n ]*name=\\([\"']\\|\\([^\t\n\r ]+\\)\\)" nil t)
- (or (match-string 2)
- (progn
- (goto-char (match-beginning 1))
- (condition-case nil
- (progn
- (forward-sexp 1)
- (buffer-substring
- (1+ (match-beginning 1))
- (1- (point))))
- (error nil))))))))))
- (and tem
- (setq tem (file-name-extension tem))
- (require 'mailcap)
- (cdr (assoc (concat "." (downcase tem))
- mailcap-mime-extensions))))
- mm-dissect-default-type))
+ (list mm-dissect-default-type)
(and cte (intern (downcase (mail-header-strip cte))))
- no-strict-mime cdl description))
+ 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))
(goto-char head-begin)
(setq content-type (message-fetch-field "Content-Type"))
(when content-type
- (with-temp-buffer
- (insert content-type)
- (goto-char (point-min))
- (when (re-search-forward ";[\t\n ]*name=\\([\"']\\|\\([^\t\n\r ]+\\)\\)"
- nil t)
- (setq subject (or (match-string 2)
- (progn
- (goto-char (match-beginning 1))
- (condition-case nil
- (progn
- (forward-sexp 1)
- (buffer-substring
- (1+ (match-beginning 1)) (1- (point))))
- (error nil)))))))
- (when (or (string-match "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)"
- content-type)
- ;; Guess Content-Type from the file name extention.
- ;; Some mailer sends a part without type like this:
- ;; Content-Type: ; name="IMG_3156.JPG"
- ;; Content-Disposition: attachment; filename="IMG_3156.JPG"
- (let ((tem (message-fetch-field "Content-Disposition"))
- (case-fold-search t)
- len)
- (when (and
- (setq tem
- (or (and tem
- (mail-content-type-get
- (mail-header-parse-content-disposition
- tem)
- 'filename))
- subject))
- (setq tem (file-name-extension tem))
- (require 'mailcap)
- (setq content-type
- (cdr (assoc (concat "." (downcase tem))
- mailcap-mime-extensions)))
- (string-match "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)"
- content-type))
- (save-match-data
- (goto-char (point-min))
- (when (re-search-forward "^Content-Type:\\([^;]*\\);"
- nil t)
- (setq len (- (match-end 1) (match-beginning 1)
- (length content-type) 1)
- head-end (- head-end len)
- body-begin (- body-begin len)
- body-end (- body-end len))
- (replace-match (concat "Content-Type: " content-type
- ";"))))
- t)))
+ (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