X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Frfc2047.el;h=4f63cae9eec6e9d098d4ed034930ed81c038b4ab;hb=9b139a13c0650a18872ebd64849560a97554afa8;hp=eac48158ae1d7cc4d9d8c1c0e7731c62d0c4f636;hpb=ebbec28068b0d0ee0d0769973d3d0d940a242103;p=gnus

diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index eac48158a..4f63cae9e 100644
--- a/lisp/rfc2047.el
+++ b/lisp/rfc2047.el
@@ -1,7 +1,7 @@
 ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
 
-;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004
-;;        Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -9,7 +9,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -19,8 +19,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -35,16 +35,17 @@
 
 (require 'qp)
 (require 'mm-util)
+(require 'ietf-drums)
 ;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus.
 (require 'mail-prsvr)
-(require 'base64)
+(require 'rfc2045) ;; rfc2045-encode-string
 (autoload 'mm-body-7-or-8 "mm-bodies")
 
 (defvar rfc2047-header-encoding-alist
   '(("Newsgroups" . nil)
     ("Followup-To" . nil)
     ("Message-ID" . nil)
-    ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\
+    ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\
 \\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime)
     (t . mime))
   "*Header/encoding method alist.
@@ -141,6 +142,55 @@ This is either `base64' or `quoted-printable'."
       (re-search-forward ":[ \t\n]*" nil t)
       (buffer-substring-no-properties (point) (point-max)))))
 
+(defun rfc2047-quote-special-characters-in-quoted-strings (&optional
+							   encodable-regexp)
+  "Quote special characters with `\\'s in quoted strings.
+Quoting will not be done in a quoted string if it contains characters
+matching ENCODABLE-REGEXP or it is within parentheses."
+  (goto-char (point-min))
+  (let ((tspecials (concat "[" ietf-drums-tspecials "]"))
+	(start (point))
+	beg end)
+    (with-syntax-table (standard-syntax-table)
+      (while (not (eobp))
+	(if (ignore-errors
+	      (forward-list 1)
+	      (eq (char-before) ?\)))
+	    (forward-list -1)
+	  (goto-char (point-max)))
+	(save-restriction
+	  (narrow-to-region start (point))
+	  (goto-char start)
+	  (while (search-forward "\"" nil t)
+	    (setq beg (match-beginning 0))
+	    (unless (eq (char-before beg) ?\\)
+	      (goto-char beg)
+	      (setq beg (1+ beg))
+	      (condition-case nil
+		  (progn
+		    (forward-sexp)
+		    (setq end (1- (point)))
+		    (goto-char beg)
+		    (if (and encodable-regexp
+			     (re-search-forward encodable-regexp end t))
+			(goto-char (1+ end))
+		      (save-restriction
+			(narrow-to-region beg end)
+			(while (re-search-forward tspecials nil 'move)
+			  (if (eq (char-before) ?\\)
+			      (if (looking-at tspecials) ;; Already quoted.
+				  (forward-char)
+				(insert "\\"))
+			    (goto-char (match-beginning 0))
+			    (insert "\\")
+			    (forward-char))))
+		      (forward-char)))
+		(error
+		 (goto-char beg)))))
+	  (goto-char (point-max)))
+	(forward-list 1)
+	(setq start (point))))))
+
 (defvar rfc2047-encoding-type 'address-mime
   "The type of encoding done by `rfc2047-encode-region'.
 This should be dynamically bound around calls to
@@ -157,8 +207,18 @@ Should be called narrowed to the head of the message."
       (while (not (eobp))
 	(save-restriction
 	  (rfc2047-narrow-to-field)
+	  (setq method nil
+		alist rfc2047-header-encoding-alist)
+	  (while (setq elem (pop alist))
+	    (when (or (and (stringp (car elem))
+			   (looking-at (car elem)))
+		      (eq (car elem) t))
+	      (setq alist nil
+		    method (cdr elem))))
 	  (if (not (rfc2047-encodable-p))
-	      (prog1
+	      (prog2
+		  (when (eq method 'address-mime)
+		    (rfc2047-quote-special-characters-in-quoted-strings))
 		  (if (and (eq (mm-body-7-or-8) '8bit)
 			   (mm-multibyte-p)
 			   (mm-coding-system-p
@@ -179,14 +239,6 @@ Should be called narrowed to the head of the message."
 		     (point))
 		   (point-max))))
 	    ;; We found something that may perhaps be encoded.
-	    (setq method nil
-		  alist rfc2047-header-encoding-alist)
-	    (while (setq elem (pop alist))
-	      (when (or (and (stringp (car elem))
-			     (looking-at (car elem)))
-			(eq (car elem) t))
-		(setq alist nil
-		      method (cdr elem))))
 	    (re-search-forward "^[^:]+: *" nil t)
 	    (cond
 	     ((eq method 'address-mime)
@@ -222,9 +274,10 @@ Should be called narrowed to the head of the message."
 ;;; 		  (rfc2047-encode-region (point-min) (point-max))
 ;;; 		(error "Cannot send unencoded text")))
 	     ((mm-coding-system-p method)
-	      (if (and (featurep 'mule)
-		       (if (boundp 'default-enable-multibyte-characters)
-			   default-enable-multibyte-characters))
+	      (if (or (and (featurep 'mule)
+			   (if (boundp 'default-enable-multibyte-characters)
+			       default-enable-multibyte-characters))
+		      (featurep 'file-coding))
 		  (mm-encode-coding-region (point) (point-max) method)))
 	     ;; Hm.
 	     (t)))
@@ -317,6 +370,7 @@ Dynamically bind `rfc2047-encoding-type' to change that."
 		  (rfc2047-encode start (point))
 		(goto-char end))))
 	;; `address-mime' case -- take care of quoted words, comments.
+	(rfc2047-quote-special-characters-in-quoted-strings encodable-regexp)
 	(with-syntax-table rfc2047-syntax-table
 	  (goto-char (point-min))
 	  (condition-case err		; in case of unbalanced quotes
@@ -369,8 +423,8 @@ Dynamically bind `rfc2047-encoding-type' to change that."
 		  (forward-list)
 		  ;; Encode text as an unstructured field.
 		  (let ((rfc2047-encoding-type 'mime))
-		    (rfc2047-encode-region (1+ start) (1- (point)))
-		    (forward-char)))
+		    (rfc2047-encode-region (1+ start) (1- (point))))
+		  (skip-chars-forward ")"))
 		 (t		    ; normal token/whitespace sequence
 		  ;; Find the end.
 		  ;; Skip one ASCII word, or encode continuous words
@@ -422,7 +476,9 @@ Dynamically bind `rfc2047-encoding-type' to change that."
 			      ;; to be encoded so that MTAs may parse
 			      ;; them safely.
 			      (cond ((= end (point)))
-				    ((looking-at encodable-regexp)
+				    ((looking-at (concat "\\sw*\\("
+							 encodable-regexp
+							 "\\)"))
 				     (setq end nil))
 				    (t
 				     (goto-char (1- (match-end 0)))
@@ -442,12 +498,20 @@ Dynamically bind `rfc2047-encoding-type' to change that."
 		  (goto-char start)
 		  (if (re-search-forward encodable-regexp end 'move)
 		      (progn
-			(goto-char start)
-			(unless (memq (char-before) '(nil ?\t ? ))
-			  ;; Separate encodable text and delimiter.
-			  (insert " ")
-			  (setq end (1+ end)))
-			(rfc2047-encode (point) end)
+			(unless (memq (char-before start) '(nil ?\t ? ))
+			  (if (progn
+				(goto-char start)
+				(skip-chars-backward "^ \t\n")
+				(and (looking-at "\\Sw+")
+				     (= (match-end 0) start)))
+			      ;; Also encode bogus delimiters.
+			      (setq start (point))
+			    ;; Separate encodable text and delimiter.
+			    (goto-char start)
+			    (insert " ")
+			    (setq start (1+ start)
+				  end (1+ end))))
+			(rfc2047-encode start end)
 			(setq last-encoded t))
 		    (setq last-encoded nil)))))
 	    (error
@@ -472,7 +536,8 @@ By default, the string is treated as containing addresses (see
 If it is nil, encoded-words will not be folded.  Too small value may
 cause an error.  Don't change this for no particular reason.")
 
-(defun rfc2047-encode-1 (column string cs encoder start space &optional eword)
+(defun rfc2047-encode-1 (column string cs encoder start crest tail
+				&optional eword)
   "Subroutine used by `rfc2047-encode'."
   (cond ((string-equal string "")
 	 (or eword ""))
@@ -483,17 +548,21 @@ cause an error.  Don't change this for no particular reason.")
 				    string))
 		 "?="))
 	((>= column rfc2047-encode-max-chars)
-	 (when (and eword
-		    (string-match "\n[ \t]+\\'" eword))
-	   ;; Reomove a superfluous empty line.
-	   (setq eword (substring eword 0 (match-beginning 0))))
-	 (rfc2047-encode-1 (length space) string cs encoder start " "
-			   (concat eword "\n" space)))
+	 (when eword
+	   (cond ((string-match "\n[ \t]+\\'" eword)
+		  ;; Reomove a superfluous empty line.
+		  (setq eword (substring eword 0 (match-beginning 0))))
+		 ((string-match "(+\\'" eword)
+		  ;; Break the line before the open parenthesis.
+		  (setq crest (concat crest (match-string 0 eword))
+			eword (substring eword 0 (match-beginning 0))))))
+	 (rfc2047-encode-1 (length crest) string cs encoder start " " tail
+			   (concat eword "\n" crest)))
 	(t
 	 (let ((index 0)
 	       (limit (1- (length string)))
 	       (prev "")
-	       next)
+	       next len)
 	   (while (and prev
 		       (<= index limit))
 	     (setq next (concat start
@@ -503,27 +572,48 @@ cause an error.  Don't change this for no particular reason.")
 					      (substring string 0 (1+ index))
 					      cs)
 					   (substring string 0 (1+ index))))
-				"?="))
-	     (if (<= (+ column (length next)) rfc2047-encode-max-chars)
-		 (setq prev next
-		       index (1+ index))
-	       (setq next prev
-		     prev nil)))
-	   (setq eword (concat eword next))
+				"?=")
+		   len (+ column (length next)))
+	     (if (> len rfc2047-encode-max-chars)
+		 (setq next prev
+		       prev nil)
+	       (if (or (< index limit)
+		       (<= (+ len (or (string-match "\n" tail)
+				      (length tail)))
+			   rfc2047-encode-max-chars))
+		   (setq prev next
+			 index (1+ index))
+		 (if (string-match "\\`)+" tail)
+		     ;; Break the line after the close parenthesis.
+		     (setq tail (concat (substring tail 0 (match-end 0))
+					"\n "
+					(substring tail (match-end 0)))
+			   prev next
+			   index (1+ index))
+		   (setq next prev
+			 prev nil)))))
 	   (if (> index limit)
-	       eword
+	       (concat eword next tail)
+	     (if (= 0 index)
+		 (if (and eword
+			  (string-match "(+\\'" eword))
+		     (setq crest (concat crest (match-string 0 eword))
+			   eword (substring eword 0 (match-beginning 0)))
+		   (setq eword (concat eword next)))
+	       (setq crest " "
+		     eword (concat eword next)))
 	     (when (string-match "\n[ \t]+\\'" eword)
 	       ;; Reomove a superfluous empty line.
 	       (setq eword (substring eword 0 (match-beginning 0))))
-	     (rfc2047-encode-1 (length space) (substring string index)
-			       cs encoder start " "
-			       (concat eword "\n" space)))))))
+	     (rfc2047-encode-1 (length crest) (substring string index)
+			       cs encoder start " " tail
+			       (concat eword "\n" crest)))))))
 
 (defun rfc2047-encode (b e)
   "Encode the word(s) in the region B to E.
 Point moves to the end of the region."
   (let ((mime-charset (or (mm-find-mime-charset-region b e) (list 'us-ascii)))
-	cs encoding space eword)
+	cs encoding tail crest eword)
     (cond ((> (length mime-charset) 1)
 	   (error "Can't rfc2047-encode `%s'"
 		  (buffer-substring-no-properties b e)))
@@ -544,12 +634,19 @@ Point moves to the end of the region."
 			   'B
 			 'Q)))
 	     (widen)
+	     (goto-char e)
+	     (skip-chars-forward "^ \t\n")
+	     ;; `tail' may contain a close parenthesis.
+	     (setq tail (buffer-substring-no-properties e (point)))
 	     (goto-char b)
 	     (setq b (point-marker)
 		   e (set-marker (make-marker) e))
 	     (rfc2047-fold-region (point-at-bol) b)
+	     (goto-char b)
+	     (skip-chars-backward "^ \t\n")
 	     (unless (= 0 (skip-chars-backward " \t"))
-	       (setq space (buffer-substring-no-properties (point) b)))
+	       ;; `crest' may contain whitespace and an open parenthesis.
+	       (setq crest (buffer-substring-no-properties (point) b)))
 	     (setq eword (rfc2047-encode-1
 			  (- b (point-at-bol))
 			  (mm-replace-in-string
@@ -561,15 +658,21 @@ Point moves to the end of the region."
 			      'identity)
 			  (concat "=?" (downcase (symbol-name mime-charset))
 				  "?" (upcase (symbol-name encoding)) "?")
-			  (or space " ")))
+			  (or crest " ")
+			  tail))
 	     (delete-region (if (eq (aref eword 0) ?\n)
-				(point)
+				(if (bolp)
+				    ;; The line was folded before encoding.
+				    (1- (point))
+				  (point))
 			      (goto-char b))
-			    e)
+			    (+ e (length tail)))
+	     ;; `eword' contains `crest' and `tail'.
 	     (insert eword)
 	     (set-marker b nil)
 	     (set-marker e nil)
-	     (unless (or (eolp)
+	     (unless (or (/= 0 (length tail))
+			 (eobp)
 			 (looking-at "[ \t\n)]"))
 	       (insert " "))))
 	  (t
@@ -640,9 +743,10 @@ Point moves to the end of the region."
 	(goto-char (or break qword-break))
 	(setq break nil
 	      qword-break nil)
-	  (if (looking-at "[ \t]")
-	      (insert ?\n)
-	    (insert "\n "))
+	(if (or (> 0 (skip-chars-backward " \t"))
+		(looking-at "[ \t]"))
+	    (insert ?\n)
+	  (insert "\n "))
 	(setq bol (1- (point)))
 	;; Don't break before the first non-LWSP characters.
 	(skip-chars-forward " \t")
@@ -713,13 +817,9 @@ it, put the following line in your ~/.gnus.el file:
 
 \(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter)
 "
-  (let* ((rfc2047-encoding-type 'mime)
-	 (rfc2047-encode-max-chars nil)
-	 (string (rfc2047-encode-string value)))
-    (if (string-match "[][()<>@,;:\\\"/?=]" ;; tspecials
-		      string)
-	(format "%s=%S" param string)
-      (concat param "=" string))))
+  (let ((rfc2047-encoding-type 'mime)
+	(rfc2047-encode-max-chars nil))
+    (rfc2045-encode-string param (rfc2047-encode-string value))))
 
 ;;;
 ;;; Functions for decoding RFC2047 messages
@@ -730,6 +830,108 @@ it, put the following line in your ~/.gnus.el file:
     "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\
 \\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?="))
 
+(defvar rfc2047-quote-decoded-words-containing-tspecials nil
+  "If non-nil, quote decoded words containing special characters.")
+
+(defvar rfc2047-allow-incomplete-encoded-text t
+  "*Non-nil means allow incomplete encoded-text in successive encoded-words.
+Dividing of encoded-text in the place other than character boundaries
+violates RFC2047 section 5, while we have a capability to decode it.
+If it is non-nil, the decoder will decode B- or Q-encoding in each
+encoded-word, concatenate them, and decode it by charset.  Otherwise,
+the decoder will fully decode each encoded-word before concatenating
+them.")
+
+(defun rfc2047-strip-backslashes-in-quoted-strings ()
+  "Strip backslashes in quoted strings.  `\\\"' remains."
+  (goto-char (point-min))
+  (let (beg)
+    (with-syntax-table (standard-syntax-table)
+      (while (search-forward "\"" nil t)
+	(unless (eq (char-before) ?\\)
+	  (setq beg (match-end 0))
+	  (goto-char (match-beginning 0))
+	  (condition-case nil
+	      (progn
+		(forward-sexp)
+		(save-restriction
+		  (narrow-to-region beg (1- (point)))
+		  (goto-char beg)
+		  (while (search-forward "\\" nil 'move)
+		    (unless (memq (char-after) '(?\"))
+		      (delete-backward-char 1))
+		    (forward-char)))
+		(forward-char))
+	    (error
+	     (goto-char beg))))))))
+
+(defun rfc2047-charset-to-coding-system (charset)
+  "Return coding-system corresponding to MIME CHARSET.
+If your Emacs implementation can't decode CHARSET, return nil."
+  (when (stringp charset)
+    (setq charset (intern (downcase charset))))
+  (when (or (not charset)
+	    (eq 'gnus-all mail-parse-ignored-charsets)
+	    (memq 'gnus-all mail-parse-ignored-charsets)
+	    (memq charset mail-parse-ignored-charsets))
+    (setq charset mail-parse-charset))
+  (let ((cs (mm-charset-to-coding-system charset)))
+    (cond ((eq cs 'ascii)
+	   (setq cs (or (mm-charset-to-coding-system mail-parse-charset)
+			'raw-text)))
+	  ((mm-coding-system-p cs))
+	  ((and charset
+		(listp mail-parse-ignored-charsets)
+		(memq 'gnus-unknown mail-parse-ignored-charsets))
+	   (setq cs (mm-charset-to-coding-system mail-parse-charset))))
+    (if (eq cs 'ascii)
+	'raw-text
+      cs)))
+
+(defun rfc2047-decode-encoded-words (words)
+  "Decode successive encoded-words in WORDS and return a decoded string.
+Each element of WORDS looks like (CHARSET ENCODING ENCODED-TEXT
+ENCODED-WORD)."
+  (let (word charset cs encoding text rest)
+    (while words
+      (setq word (pop words))
+      (if (and (setq cs (rfc2047-charset-to-coding-system
+			 (setq charset (car word))))
+	       (condition-case code
+		   (cond ((char-equal ?B (nth 1 word))
+			  (setq text (base64-decode-string
+				      (rfc2047-pad-base64 (nth 2 word)))))
+			 ((char-equal ?Q (nth 1 word))
+			  (setq text (quoted-printable-decode-string
+				      (mm-subst-char-in-string
+				       ?_ ?  (nth 2 word) t)))))
+		 (error
+		  (message "%s" (error-message-string code))
+		  nil)))
+	  (if (and rfc2047-allow-incomplete-encoded-text
+		   (eq cs (caar rest)))
+	      ;; Concatenate text of which the charset is the same.
+	      (setcdr (car rest) (concat (cdar rest) text))
+	    (push (cons cs text) rest))
+	;; Don't decode encoded-word.
+	(push (cons nil (nth 3 word)) rest)))
+    (while rest
+      (setq words (concat
+		   (or (and (setq cs (caar rest))
+			    (condition-case code
+				(mm-decode-coding-string (cdar rest) cs)
+			      (error
+			       (message "%s" (error-message-string code))
+			       nil)))
+		       (concat (when (cdr rest) " ")
+			       (cdar rest)
+			       (when (and words
+					  (not (eq (string-to-char words) ? )))
+				 " ")))
+		   words)
+	    rest (cdr rest)))
+    words))
+
 ;; Fixme: This should decode in place, not cons intermediate strings.
 ;; Also check whether it needs to worry about delimiting fields like
 ;; encoding.
@@ -740,38 +942,94 @@ it, put the following line in your ~/.gnus.el file:
 ;; and worthwhile (is it more correct or not?), e.g. something like
 ;; `=?iso-8859-1?q?foo?=@'.
 
-(defun rfc2047-decode-region (start end)
-  "Decode MIME-encoded words in region between START and END."
+(defun rfc2047-decode-region (start end &optional address-mime)
+  "Decode MIME-encoded words in region between START and END.
+If ADDRESS-MIME is non-nil, strip backslashes which precede characters
+other than `\"' and `\\' in quoted strings."
   (interactive "r")
   (let ((case-fold-search t)
-	b e)
+	(eword-regexp (eval-when-compile
+			;; Ignore whitespace between encoded-words.
+			(concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp
+				"\\)")))
+	b e match words)
     (save-excursion
       (save-restriction
 	(narrow-to-region start end)
-	(goto-char (point-min))
-	;; Remove whitespace between encoded words.
-	(while (re-search-forward
-		(eval-when-compile
-		  (concat "\\(" rfc2047-encoded-word-regexp "\\)"
-			  "\\(\n?[ \t]\\)+"
-			  "\\(" rfc2047-encoded-word-regexp "\\)"))
-		nil t)
-	  (delete-region (goto-char (match-end 1)) (match-beginning 6)))
-	;; Decode the encoded words.
-	(setq b (goto-char (point-min)))
-	(while (re-search-forward rfc2047-encoded-word-regexp nil t)
-	  (setq e (match-beginning 0))
-	  (insert (rfc2047-parse-and-decode
-		   (prog1
-		       (match-string 0)
-		     (delete-region (match-beginning 0) (match-end 0)))))
-	  ;; Remove newlines between decoded words, though such things
-	  ;; essentially must not be there.
+	(when address-mime
+	  (rfc2047-strip-backslashes-in-quoted-strings))
+	(goto-char (setq b start))
+	;; Look for the encoded-words.
+	(while (setq match (re-search-forward eword-regexp nil t))
+	  (setq e (match-beginning 1)
+		end (match-end 0)
+		words nil)
+	  (while match
+	    (push (list (match-string 2) ;; charset
+			(char-after (match-beginning 3)) ;; encoding
+			(match-string 4) ;; encoded-text
+			(match-string 1)) ;; encoded-word
+		  words)
+	    ;; Look for the subsequent encoded-words.
+	    (when (setq match (looking-at eword-regexp))
+	      (goto-char (setq end (match-end 0)))))
+	  ;; Replace the encoded-words with the decoded one.
+	  (delete-region e end)
+	  (insert (rfc2047-decode-encoded-words (nreverse words)))
 	  (save-restriction
 	    (narrow-to-region e (point))
 	    (goto-char e)
+	    ;; Remove newlines between decoded words, though such
+	    ;; things essentially must not be there.
 	    (while (re-search-forward "[\n\r]+" nil t)
 	      (replace-match " "))
+	    ;; Quote decoded words if there are special characters
+	    ;; which might violate RFC2822.
+	    (when (and rfc2047-quote-decoded-words-containing-tspecials
+		       (let ((regexp (car (rassq
+					   'address-mime
+					   rfc2047-header-encoding-alist))))
+			 (when regexp
+			   (save-restriction
+			     (widen)
+			     (beginning-of-line)
+			     (while (and (memq (char-after) '(?  ?\t))
+					 (zerop (forward-line -1))))
+			     (looking-at regexp)))))
+	      (let (quoted)
+		(goto-char e)
+		(skip-chars-forward " \t")
+		(setq start (point))
+		(setq quoted (eq (char-after) ?\"))
+		(goto-char (point-max))
+		(skip-chars-backward " \t")
+		(if (setq quoted (and quoted
+				      (> (point) (1+ start))
+				      (eq (char-before) ?\")))
+		    (progn
+		      (backward-char)
+		      (setq start (1+ start)
+			    end (point-marker)))
+		  (setq end (point-marker)))
+		(goto-char start)
+		(while (search-forward "\"" end t)
+		  (when (prog2
+			    (backward-char)
+			    (zerop (% (skip-chars-backward "\\\\") 2))
+			  (goto-char (match-beginning 0)))
+		    (insert "\\"))
+		  (forward-char))
+		(when (and (not quoted)
+			   (progn
+			     (goto-char start)
+			     (re-search-forward
+			      (concat "[" ietf-drums-tspecials "]")
+			      end t)))
+		  (goto-char start)
+		  (insert "\"")
+		  (goto-char end)
+		  (insert "\""))
+		(set-marker end nil)))
 	    (goto-char (point-max)))
 	  (when (and (mm-multibyte-p)
 		     mail-parse-charset
@@ -785,8 +1043,16 @@ it, put the following line in your ~/.gnus.el file:
 		   (not (eq mail-parse-charset 'gnus-decoded)))
 	  (mm-decode-coding-region b (point-max) mail-parse-charset))))))
 
-(defun rfc2047-decode-string (string)
-  "Decode the quoted-printable-encoded STRING and return the results."
+(defun rfc2047-decode-address-region (start end)
+  "Decode MIME-encoded words in region between START and END.
+Backslashes which precede characters other than `\"' and `\\' in quoted
+strings are stripped."
+  (rfc2047-decode-region start end t))
+
+(defun rfc2047-decode-string (string &optional address-mime)
+  "Decode MIME-encoded STRING and return the result.
+If ADDRESS-MIME is non-nil, strip backslashes which precede characters
+other than `\"' and `\\' in quoted strings."
   (let ((m (mm-multibyte-p)))
     (if (string-match "=\\?" string)
 	(with-temp-buffer
@@ -800,8 +1066,16 @@ it, put the following line in your ~/.gnus.el file:
 	    (mm-enable-multibyte))
 	  (insert string)
 	  (inline
-	    (rfc2047-decode-region (point-min) (point-max)))
+	    (rfc2047-decode-region (point-min) (point-max) address-mime))
 	  (buffer-string))
+      (when address-mime
+	(setq string
+	      (with-temp-buffer
+		(when (mm-multibyte-string-p string)
+		  (mm-enable-multibyte))
+		(insert string)
+		(rfc2047-strip-backslashes-in-quoted-strings)
+		(buffer-string))))
       ;; Fixme: As above, `m' here is inappropriate.
       (if (and m
 	       mail-parse-charset
@@ -823,20 +1097,11 @@ it, put the following line in your ~/.gnus.el file:
 	    (mm-decode-coding-string string mail-parse-charset))
 	(mm-string-as-multibyte string)))))
 
-(defun rfc2047-parse-and-decode (word)
-  "Decode WORD and return it if it is an encoded word.
-Return WORD if it is not not an encoded word or if the charset isn't
-decodable."
-  (if (not (string-match rfc2047-encoded-word-regexp word))
-      word
-    (or
-     (condition-case nil
-	 (rfc2047-decode
-	  (match-string 1 word)
-	  (string-to-char (match-string 2 word))
-	  (match-string 3 word))
-       (error word))
-     word)))				; un-decodable
+(defun rfc2047-decode-address-string (string)
+  "Decode MIME-encoded STRING and return the result.
+Backslashes which precede characters other than `\"' and `\\' in quoted
+strings are stripped."
+  (rfc2047-decode-string string t))
 
 (defun rfc2047-pad-base64 (string)
   "Pad STRING to quartets."
@@ -853,36 +1118,6 @@ decodable."
       (2 (concat string "=="))
       (3 (concat string "=")))))
 
-(defun rfc2047-decode (charset encoding string)
-  "Decode STRING from the given MIME CHARSET in the given ENCODING.
-Valid ENCODINGs are the characters \"B\" and \"Q\".
-If your Emacs implementation can't decode CHARSET, return nil."
-  (if (stringp charset)
-      (setq charset (intern (downcase charset))))
-  (if (or (not charset)
-	  (eq 'gnus-all mail-parse-ignored-charsets)
-	  (memq 'gnus-all mail-parse-ignored-charsets)
-	  (memq charset mail-parse-ignored-charsets))
-      (setq charset mail-parse-charset))
-  (let ((cs (mm-charset-to-coding-system charset)))
-    (if (and (not cs) charset
-	     (listp mail-parse-ignored-charsets)
-	     (memq 'gnus-unknown mail-parse-ignored-charsets))
-	(setq cs (mm-charset-to-coding-system mail-parse-charset)))
-    (when cs
-      (when (eq cs 'ascii)
-	(setq cs (or mail-parse-charset 'raw-text)))
-      (mm-decode-coding-string
-       (cond
-	((char-equal ?B encoding)
-	 (base64-decode-string
-	  (rfc2047-pad-base64 string)))
-	((char-equal ?Q encoding)
-	 (quoted-printable-decode-string
-	  (mm-subst-char-in-string ?_ ? string t)))
-	(t (error "Invalid encoding: %c" encoding)))
-       cs))))
-
 (provide 'rfc2047)
 
 ;;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6