diff options
| author | Katsumi Yamaoka | 2013-10-23 03:35:49 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2013-10-23 03:35:49 +0000 |
| commit | 967a72c957b41e7af82ddfae8487066d6735f5b8 (patch) | |
| tree | 90bf3eec77e848cd64e4cb141e6894891c3e065c | |
| parent | ee4282cde213499f9334c0e689e4daf1bb9928e1 (diff) | |
| download | emacs-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/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/gnus/mm-decode.el | 35 | ||||
| -rw-r--r-- | lisp/gnus/nndoc.el | 54 |
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 @@ | |||
| 1 | 2013-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 | |||
| 1 | 2013-10-22 Katsumi Yamaoka <yamaoka@jpl.org> | 8 | 2013-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 |