aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/gnus/gnus-art.el5
-rw-r--r--lisp/gnus/gnus-sum.el2
-rw-r--r--lisp/gnus/mm-decode.el6
-rw-r--r--lisp/gnus/nndoc.el4
-rw-r--r--lisp/mail/ietf-drums.el15
-rw-r--r--lisp/mail/mail-parse.el1
-rw-r--r--lisp/mh-e/mh-mime.el7
7 files changed, 26 insertions, 14 deletions
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 920ef1e2494..e1af859516c 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2508,7 +2508,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
2508 (mail-content-type-get ctl 'charset))) 2508 (mail-content-type-get ctl 'charset)))
2509 format (and ctl (mail-content-type-get ctl 'format))) 2509 format (and ctl (mail-content-type-get ctl 'format)))
2510 (when cte 2510 (when cte
2511 (setq cte (mail-header-strip cte))) 2511 (setq cte (mail-header-strip-cte cte)))
2512 (if (and ctl (not (string-match "/" (car ctl)))) 2512 (if (and ctl (not (string-match "/" (car ctl))))
2513 (setq ctl nil)) 2513 (setq ctl nil))
2514 (goto-char (point-max))) 2514 (goto-char (point-max)))
@@ -2523,8 +2523,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
2523 (equal (car ctl) "text/plain")) 2523 (equal (car ctl) "text/plain"))
2524 (not format)) ;; article with format will decode later. 2524 (not format)) ;; article with format will decode later.
2525 (mm-decode-body 2525 (mm-decode-body
2526 charset (and cte (intern (downcase 2526 charset (and cte (intern (downcase cte)))
2527 (gnus-strip-whitespace cte))))
2528 (car ctl))))))) 2527 (car ctl)))))))
2529 2528
2530(defun article-decode-encoded-words () 2529(defun article-decode-encoded-words ()
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index c28557af765..72e902a11f8 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9211,7 +9211,7 @@ To control what happens when you exit the group, see the
9211 (widen) 9211 (widen)
9212 (narrow-to-region (point) (point-max)) 9212 (narrow-to-region (point) (point-max))
9213 (mm-decode-content-transfer-encoding 9213 (mm-decode-content-transfer-encoding
9214 (intern (downcase (mail-header-strip encoding)))))) 9214 (intern (downcase (mail-header-strip-cte encoding))))))
9215 (widen)) 9215 (widen))
9216 (unwind-protect 9216 (unwind-protect
9217 (if (let ((gnus-newsgroup-ephemeral-charset 9217 (if (let ((gnus-newsgroup-ephemeral-charset
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index c3fdc75a4cc..579222f0f65 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -655,9 +655,9 @@ MIME-Version header before proceeding."
655 description))))) 655 description)))))
656 (if (or (not ctl) 656 (if (or (not ctl)
657 (not (string-match "/" (car ctl)))) 657 (not (string-match "/" (car ctl))))
658 (mm-dissect-singlepart 658 (mm-dissect-singlepart
659 (list mm-dissect-default-type) 659 (list mm-dissect-default-type)
660 (and cte (intern (downcase (mail-header-strip cte)))) 660 (and cte (intern (downcase (mail-header-strip-cte cte))))
661 no-strict-mime 661 no-strict-mime
662 (and cd (mail-header-parse-content-disposition cd)) 662 (and cd (mail-header-parse-content-disposition cd))
663 description) 663 description)
@@ -690,7 +690,7 @@ MIME-Version header before proceeding."
690 (mm-possibly-verify-or-decrypt 690 (mm-possibly-verify-or-decrypt
691 (mm-dissect-singlepart 691 (mm-dissect-singlepart
692 ctl 692 ctl
693 (and cte (intern (downcase (mail-header-strip cte)))) 693 (and cte (intern (downcase (mail-header-strip-cte cte))))
694 no-strict-mime 694 no-strict-mime
695 (and cd (mail-header-parse-content-disposition cd)) 695 (and cd (mail-header-parse-content-disposition cd))
696 description id) 696 description id)
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index f32a3e70c99..ede118d6eb6 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -495,7 +495,7 @@ from the document.")
495 (save-restriction 495 (save-restriction
496 (narrow-to-region (point) (point-max)) 496 (narrow-to-region (point) (point-max))
497 (mm-decode-content-transfer-encoding 497 (mm-decode-content-transfer-encoding
498 (intern (downcase (mail-header-strip encoding)))))))) 498 (intern (downcase (mail-header-strip-cte encoding))))))))
499 499
500(defun nndoc-babyl-type-p () 500(defun nndoc-babyl-type-p ()
501 (when (re-search-forward "\^_\^L *\n" nil t) 501 (when (re-search-forward "\^_\^L *\n" nil t)
@@ -558,7 +558,7 @@ from the document.")
558 (save-restriction 558 (save-restriction
559 (narrow-to-region begin (point-max)) 559 (narrow-to-region begin (point-max))
560 (mm-decode-content-transfer-encoding 560 (mm-decode-content-transfer-encoding
561 (intern (downcase (mail-header-strip encoding)))))) 561 (intern (downcase (mail-header-strip-cte encoding))))))
562 (when head 562 (when head
563 (goto-char begin) 563 (goto-char begin)
564 (when (search-forward "\n\n" nil t) 564 (when (search-forward "\n\n" nil t)
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index 8c84158a51a..a3e53cfe793 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -143,7 +143,7 @@ backslash and doublequote.")
143 (forward-sexp 1)) 143 (forward-sexp 1))
144 ((eq c ?\() 144 ((eq c ?\()
145 (forward-sexp 1)) 145 (forward-sexp 1))
146 ((memq c '(?\ ?\t ?\n)) 146 ((memq c '(?\ ?\t ?\n ?\r))
147 (delete-char 1)) 147 (delete-char 1))
148 (t 148 (t
149 (forward-char 1)))) 149 (forward-char 1))))
@@ -172,6 +172,19 @@ backslash and doublequote.")
172 "Remove comments and whitespace from STRING." 172 "Remove comments and whitespace from STRING."
173 (ietf-drums-remove-whitespace (ietf-drums-remove-comments string))) 173 (ietf-drums-remove-whitespace (ietf-drums-remove-comments string)))
174 174
175(defun ietf-drums-remove-garbage (string)
176 "Remove some garbage from STRING."
177 (while (string-match "[][()<>@,;:\\\"/?=]+" string)
178 (setq string (concat (substring string 0 (match-beginning 0))
179 (substring string (match-end 0)))))
180 string)
181
182(defun ietf-drums-strip-cte (string)
183 "Remove comments, whitespace and garbage from STRING.
184STRING is assumed to be a string that is extracted from
185the Content-Transfer-Encoding header of a mail."
186 (ietf-drums-remove-garbage (inline (ietf-drums-strip string))))
187
175(defun ietf-drums-parse-address (string) 188(defun ietf-drums-parse-address (string)
176 "Parse STRING and return a MAILBOX / DISPLAY-NAME pair." 189 "Parse STRING and return a MAILBOX / DISPLAY-NAME pair."
177 (with-temp-buffer 190 (with-temp-buffer
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index 546673db6fd..0578b98c933 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -49,6 +49,7 @@
49(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments) 49(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments)
50(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace) 50(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace)
51(defalias 'mail-header-strip 'ietf-drums-strip) 51(defalias 'mail-header-strip 'ietf-drums-strip)
52(defalias 'mail-header-strip-cte 'ietf-drums-strip-cte)
52(defalias 'mail-header-get-comment 'ietf-drums-get-comment) 53(defalias 'mail-header-get-comment 'ietf-drums-get-comment)
53(defalias 'mail-header-parse-address 'ietf-drums-parse-address) 54(defalias 'mail-header-parse-address 'ietf-drums-parse-address)
54(defalias 'mail-header-parse-addresses 'ietf-drums-parse-addresses) 55(defalias 'mail-header-parse-addresses 'ietf-drums-parse-addresses)
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 01fa5a18c44..7238de08b9b 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -56,7 +56,7 @@
56(autoload 'mail-content-type-get "mail-parse") 56(autoload 'mail-content-type-get "mail-parse")
57(autoload 'mail-decode-encoded-word-string "mail-parse") 57(autoload 'mail-decode-encoded-word-string "mail-parse")
58(autoload 'mail-header-parse-content-type "mail-parse") 58(autoload 'mail-header-parse-content-type "mail-parse")
59(autoload 'mail-header-strip "mail-parse") 59(autoload 'mail-header-strip-cte "mail-parse")
60(autoload 'mail-strip-quoted-names "mail-utils") 60(autoload 'mail-strip-quoted-names "mail-utils")
61(autoload 'message-options-get "message") 61(autoload 'message-options-get "message")
62(autoload 'message-options-set "message") 62(autoload 'message-options-set "message")
@@ -580,14 +580,13 @@ If message has been encoded for transfer take that into account."
580 (message-fetch-field "Content-Type" t))) 580 (message-fetch-field "Content-Type" t)))
581 charset (mail-content-type-get ct 'charset) 581 charset (mail-content-type-get ct 'charset)
582 cte (message-fetch-field "Content-Transfer-Encoding"))) 582 cte (message-fetch-field "Content-Transfer-Encoding")))
583 (when (stringp cte) (setq cte (mail-header-strip cte))) 583 (when (stringp cte) (setq cte (mail-header-strip-cte cte)))
584 (when (or (not ct) (equal (car ct) "text/plain")) 584 (when (or (not ct) (equal (car ct) "text/plain"))
585 (save-restriction 585 (save-restriction
586 (narrow-to-region (min (1+ (mh-mail-header-end)) (point-max)) 586 (narrow-to-region (min (1+ (mh-mail-header-end)) (point-max))
587 (point-max)) 587 (point-max))
588 (mm-decode-body charset 588 (mm-decode-body charset
589 (and cte (intern (downcase 589 (and cte (intern (downcase cte)))
590 (gnus-strip-whitespace cte))))
591 (car ct)))))) 590 (car ct))))))
592 591
593(defun mh-mime-display-part (handle) 592(defun mh-mime-display-part (handle)