aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKatsumi Yamaoka2013-10-23 03:35:49 +0000
committerKatsumi Yamaoka2013-10-23 03:35:49 +0000
commit967a72c957b41e7af82ddfae8487066d6735f5b8 (patch)
tree90bf3eec77e848cd64e4cb141e6894891c3e065c
parentee4282cde213499f9334c0e689e4daf1bb9928e1 (diff)
downloademacs-967a72c957b41e7af82ddfae8487066d6735f5b8.tar.gz
emacs-967a72c957b41e7af82ddfae8487066d6735f5b8.zip
lisp/gnus/mm-decode.el (mm-dissect-buffer): Revert last change
lisp/gnus/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.
-rw-r--r--lisp/gnus/ChangeLog7
-rw-r--r--lisp/gnus/mm-decode.el35
-rw-r--r--lisp/gnus/nndoc.el54
3 files changed, 15 insertions, 81 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index d3b524785f4..92e3d8ff5c5 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,10 @@
12013-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * mm-decode.el (mm-dissect-buffer): Revert last change.
4 * nndoc.el (nndoc-dissect-mime-parts-sub): Ditto.
5 The problem that motivated those changes was attributed to a broken
6 mail sender, and has been fixed.
7
12013-10-22 Katsumi Yamaoka <yamaoka@jpl.org> 82013-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
2 9
3 * mm-decode.el (mm-dissect-buffer): Guess content-type if the first 10 * mm-decode.el (mm-dissect-buffer): Guess content-type if the first
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 4a9007a06ec..26d18fc678e 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -672,39 +672,12 @@ MIME-Version header before proceeding."
672 description))))) 672 description)))))
673 (if (or (not ctl) 673 (if (or (not ctl)
674 (not (string-match "/" (car ctl)))) 674 (not (string-match "/" (car ctl))))
675 (let ((cdl (and cd (mail-header-parse-content-disposition cd))))
676 (mm-dissect-singlepart 675 (mm-dissect-singlepart
677 ;; Guess Content-Type from the file name extention. 676 (list mm-dissect-default-type)
678 ;; Some mailer sends a part without type like this:
679 ;; Content-Type: ; name="IMG_3156.JPG"
680 ;; Content-Disposition: attachment; filename="IMG_3156.JPG"
681 (list (or
682 (let ((tem
683 (or (mail-content-type-get cdl 'filename)
684 (and ct
685 (with-temp-buffer
686 (insert ct)
687 (goto-char (point-min))
688 (and (re-search-forward "\
689;[\t\n ]*name=\\([\"']\\|\\([^\t\n\r ]+\\)\\)" nil t)
690 (or (match-string 2)
691 (progn
692 (goto-char (match-beginning 1))
693 (condition-case nil
694 (progn
695 (forward-sexp 1)
696 (buffer-substring
697 (1+ (match-beginning 1))
698 (1- (point))))
699 (error nil))))))))))
700 (and tem
701 (setq tem (file-name-extension tem))
702 (require 'mailcap)
703 (cdr (assoc (concat "." (downcase tem))
704 mailcap-mime-extensions))))
705 mm-dissect-default-type))
706 (and cte (intern (downcase (mail-header-strip cte)))) 677 (and cte (intern (downcase (mail-header-strip cte))))
707 no-strict-mime cdl description)) 678 no-strict-mime
679 (and cd (mail-header-parse-content-disposition cd))
680 description)
708 (setq type (split-string (car ctl) "/")) 681 (setq type (split-string (car ctl) "/"))
709 (setq subtype (cadr type) 682 (setq subtype (cadr type)
710 type (car type)) 683 type (car type))
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 9c28cb12807..b17a7a6ecd8 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -968,61 +968,15 @@ PARENT is the message-ID of the parent summary line, or nil for none."
968 (goto-char head-begin) 968 (goto-char head-begin)
969 (setq content-type (message-fetch-field "Content-Type")) 969 (setq content-type (message-fetch-field "Content-Type"))
970 (when content-type 970 (when content-type
971 (with-temp-buffer 971 (when (string-match
972 (insert content-type) 972 "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type)
973 (goto-char (point-min))
974 (when (re-search-forward ";[\t\n ]*name=\\([\"']\\|\\([^\t\n\r ]+\\)\\)"
975 nil t)
976 (setq subject (or (match-string 2)
977 (progn
978 (goto-char (match-beginning 1))
979 (condition-case nil
980 (progn
981 (forward-sexp 1)
982 (buffer-substring
983 (1+ (match-beginning 1)) (1- (point))))
984 (error nil)))))))
985 (when (or (string-match "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)"
986 content-type)
987 ;; Guess Content-Type from the file name extention.
988 ;; Some mailer sends a part without type like this:
989 ;; Content-Type: ; name="IMG_3156.JPG"
990 ;; Content-Disposition: attachment; filename="IMG_3156.JPG"
991 (let ((tem (message-fetch-field "Content-Disposition"))
992 (case-fold-search t)
993 len)
994 (when (and
995 (setq tem
996 (or (and tem
997 (mail-content-type-get
998 (mail-header-parse-content-disposition
999 tem)
1000 'filename))
1001 subject))
1002 (setq tem (file-name-extension tem))
1003 (require 'mailcap)
1004 (setq content-type
1005 (cdr (assoc (concat "." (downcase tem))
1006 mailcap-mime-extensions)))
1007 (string-match "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)"
1008 content-type))
1009 (save-match-data
1010 (goto-char (point-min))
1011 (when (re-search-forward "^Content-Type:\\([^;]*\\);"
1012 nil t)
1013 (setq len (- (match-end 1) (match-beginning 1)
1014 (length content-type) 1)
1015 head-end (- head-end len)
1016 body-begin (- body-begin len)
1017 body-end (- body-end len))
1018 (replace-match (concat "Content-Type: " content-type
1019 ";"))))
1020 t)))
1021 (setq type (downcase (match-string 1 content-type)) 973 (setq type (downcase (match-string 1 content-type))
1022 subtype (downcase (match-string 2 content-type)) 974 subtype (downcase (match-string 2 content-type))
1023 message-rfc822 (and (string= type "message") 975 message-rfc822 (and (string= type "message")
1024 (string= subtype "rfc822")) 976 (string= subtype "rfc822"))
1025 multipart-any (string= type "multipart"))) 977 multipart-any (string= type "multipart")))
978 (when (string-match ";[ \t\n]*name=\\([^ \t\n;]+\\)" content-type)
979 (setq subject (match-string 1 content-type)))
1026 (when (string-match "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)" content-type) 980 (when (string-match "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)" content-type)
1027 (setq boundary-regexp (concat "^--" 981 (setq boundary-regexp (concat "^--"
1028 (regexp-quote 982 (regexp-quote