Merge from gnus--rel--5.10

Patches applied:

 * gnus--rel--5.10  (patch 128)

   - Update from CVS

2006-09-01  Katsumi Yamaoka  <yamaoka@jpl.org>

   * lisp/gnus/rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings):
   Use standard-syntax-table.

2006-09-01  Katsumi Yamaoka  <yamaoka@jpl.org>

   * lisp/gnus/gnus-art.el (gnus-decode-address-function): New variable.
   (article-decode-encoded-words): Use it to decode headers which are
   assumed to contain addresses.
   (gnus-mime-delete-part): Remove useless `or'.

   * lisp/gnus/gnus-sum.el (gnus-decode-encoded-address-function): New variable.
   (gnus-summary-from-or-to-or-newsgroups): Use it to decode To header.
   (gnus-nov-parse-line): Use it to decode From header.
   (gnus-get-newsgroup-headers): Ditto.
   (gnus-summary-enter-digest-group): Use it to decode `to-address'.

   * lisp/gnus/mail-parse.el (mail-decode-encoded-address-region): New alias.
   (mail-decode-encoded-address-string): New alias.

   * lisp/gnus/rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings):
   New function.
   (rfc2047-encode-message-header, rfc2047-encode-region): Use it.
   (rfc2047-strip-backslashes-in-quoted-strings): New fnction.
   (rfc2047-decode-region): Use it; add optional argument `address-mime'.
   (rfc2047-decode-string): Ditto.
   (rfc2047-decode-address-region): New function.
   (rfc2047-decode-address-string): New function.

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-418

5 files changed, 166 insertions, 28 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 6927e3bfbac..87f00faef76 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,33 @@
+2006-09-01  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings):
+        Use standard-syntax-table.
+
+2006-09-01  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * gnus-art.el (gnus-decode-address-function): New variable.
+        (article-decode-encoded-words): Use it to decode headers which are
+        assumed to contain addresses.
+        (gnus-mime-delete-part): Remove useless `or'.
+
+        * gnus-sum.el (gnus-decode-encoded-address-function): New variable.
+        (gnus-summary-from-or-to-or-newsgroups): Use it to decode To header.
+        (gnus-nov-parse-line): Use it to decode From header.
+        (gnus-get-newsgroup-headers): Ditto.
+        (gnus-summary-enter-digest-group): Use it to decode `to-address'.
+
+        * mail-parse.el (mail-decode-encoded-address-region): New alias.
+        (mail-decode-encoded-address-string): New alias.
+
+        * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings):
+        New function.
+        (rfc2047-encode-message-header, rfc2047-encode-region): Use it.
+        (rfc2047-strip-backslashes-in-quoted-strings): New fnction.
+        (rfc2047-decode-region): Use it; add optional argument `address-mime'.
+        (rfc2047-decode-string): Ditto.
+        (rfc2047-decode-address-region): New function.
+        (rfc2047-decode-address-string): New function.
+
 2006-08-23  Andreas Seltenreich  <uwi7@rz.uni-karlsruhe.de>
 
         [ Backported bug fix from No Gnus. ]
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 39292e33a1f..17cbbeb0a75 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -853,6 +853,9 @@ be displayed by the first non-nil matching CONTENT face."
 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
   "Function used to decode headers.")
 
+(defvar gnus-decode-address-function 'mail-decode-encoded-address-region
+  "Function used to decode addresses.")
+
 (defvar gnus-article-dumbquotes-map
   '(("\200" "EUR")
     ("\202" ",")
@@ -2377,10 +2380,23 @@ If PROMPT (the prefix), prompt for a coding system to use."
                              (set-buffer gnus-summary-buffer)
                            (error))
                          gnus-newsgroup-ignored-charsets))
-        (inhibit-read-only t))
+        (inhibit-read-only t)
+        start)
     (save-restriction
       (article-narrow-to-head)
-      (funcall gnus-decode-header-function (point-min) (point-max)))))
+      (while (not (eobp))
+        (setq start (point))
+        (if (prog1
+                (looking-at "\
+\\(?:Resent-\\)?\\(?:From\\|Cc\\|To\\|Bcc\\|\\(?:In-\\)?Reply-To\\|Sender\
+\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\):")
+              (while (progn
+                       (forward-line)
+                       (if (eobp)
+                           nil
+                         (memq (char-after) '(?\t ? ))))))
+            (funcall gnus-decode-address-function start (point))
+          (funcall gnus-decode-header-function start (point)))))))
 
 (defun article-decode-group-name ()
   "Decode group names in `Newsgroups:'."
@@ -4324,9 +4340,8 @@ Deleting parts may malfunction or destroy the article; continue? ")
            (handles gnus-article-mime-handles)
            (none "(none)")
            (description
-            (or
-             (mail-decode-encoded-word-string (or (mm-handle-description data)
-                                                  none))))
+            (mail-decode-encoded-word-string (or (mm-handle-description data)
+                                                 none)))
            (filename
             (or (mail-content-type-get (mm-handle-disposition data) 'filename)
                 none))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index b94d093329a..7d91d4db5aa 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -992,7 +992,11 @@ which it may alter in any way."
   :group 'gnus-summary)
 
 (defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
-  "Variable that says which function should be used to decode a string with encoded words.")
+  "Function used to decode a string with encoded words.")
+
+(defvar gnus-decode-encoded-address-function
+  'mail-decode-encoded-address-string
+  "Function used to decode addresses with encoded words.")
 
 (defcustom gnus-extra-headers '(To Newsgroups)
   "*Extra headers to parse."
@@ -1001,7 +1005,7 @@ which it may alter in any way."
   :type '(repeat symbol))
 
 (defcustom gnus-ignored-from-addresses
-  (and user-mail-address  
+  (and user-mail-address
        (not (string= user-mail-address ""))
        (regexp-quote user-mail-address))
   "*Regexp of From headers that may be suppressed in favor of To headers."
@@ -3436,7 +3440,7 @@ buffer that was in action when the last article was fetched."
               (concat "-> "
                       (inline
                         (gnus-summary-extract-address-component
-                         (funcall gnus-decode-encoded-word-function to)))))
+                         (funcall gnus-decode-encoded-address-function to)))))
              ((setq newsgroups (cdr (assq 'Newsgroups extra-headers)))
               (concat "=> " newsgroups)))))
      (inline (gnus-summary-extract-address-component gnus-tmp-from)))))
@@ -4182,7 +4186,7 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
                    (error x))
                  (condition-case ()     ; from
                      (gnus-remove-odd-characters
-                      (funcall gnus-decode-encoded-word-function
+                      (funcall gnus-decode-encoded-address-function
                                (setq x (nnheader-nov-field))))
                    (error x))
                  (nnheader-nov-field)   ; date
@@ -5956,7 +5960,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
             (progn
               (goto-char p)
               (if (search-forward "\nfrom:" nil t)
-                  (funcall gnus-decode-encoded-word-function
+                  (funcall gnus-decode-encoded-address-function
                            (nnheader-header-value))
                 "(nobody)"))
             ;; Date.
@@ -8449,10 +8453,11 @@ to guess what the document format is."
         ;; the parent article.
         (when (setq to-address (or (gnus-fetch-field "reply-to")
                                    (gnus-fetch-field "from")))
-          (setq params (append
-                        (list (cons 'to-address
-                                    (funcall gnus-decode-encoded-word-function
-                                             to-address))))))
+          (setq params
+                (append
+                 (list (cons 'to-address
+                             (funcall gnus-decode-encoded-address-function
+                                      to-address))))))
         (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
         (insert-buffer-substring gnus-original-article-buffer)
         ;; Remove lines that may lead nndoc to misinterpret the
diff --git a/lisp/gnus/mail-parse.el b/lisp/gnus/mail-parse.el
index 6a9a4755bb2..3c1aa8111c2 100644
--- a/lisp/gnus/mail-parse.el
+++ b/lisp/gnus/mail-parse.el
@@ -70,6 +70,8 @@
 (defalias 'mail-encode-encoded-word-string 'rfc2047-encode-string)
 (defalias 'mail-decode-encoded-word-region 'rfc2047-decode-region)
 (defalias 'mail-decode-encoded-word-string 'rfc2047-decode-string)
+(defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region)
+(defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string)
 
 (provide 'mail-parse)
 
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index aa30d9ba783..dc51a104c2f 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -171,6 +171,40 @@ 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."
+  (goto-char (point-min))
+  (let ((tspecials (concat "[" ietf-drums-tspecials "]"))
+        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)
+                  (unless (and encodable-regexp
+                               (re-search-forward encodable-regexp nil t))
+                    (while (re-search-forward tspecials nil 'move)
+                      (unless (and (eq (char-before) ?\\) ;; Already quoted.
+                                   (looking-at tspecials))
+                        (goto-char (match-beginning 0))
+                        (unless (or (eq (char-before) ?\\)
+                                    (and rfc2047-encode-encoded-words
+                                         (eq (char-after) ??)
+                                         (eq (char-before) ?=)))
+                          (insert "\\")))
+                      (forward-char)))))
+            (error
+             (goto-char beg))))))))
+
 (defvar rfc2047-encoding-type 'address-mime
   "The type of encoding done by `rfc2047-encode-region'.
 This should be dynamically bound around calls to
@@ -187,8 +221,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
@@ -209,14 +253,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)
@@ -347,6 +383,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
@@ -821,6 +858,29 @@ 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.  `\\\"' and `\\\\' remain."
+  (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."
@@ -898,8 +958,10 @@ ENCODED-WORD)."
 ;; 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)
         (eword-regexp (eval-when-compile
@@ -910,6 +972,8 @@ ENCODED-WORD)."
     (save-excursion
       (save-restriction
         (narrow-to-region start end)
+        (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))
@@ -995,8 +1059,16 @@ ENCODED-WORD)."
                    (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
@@ -1010,8 +1082,16 @@ ENCODED-WORD)."
             (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
@@ -1033,6 +1113,12 @@ ENCODED-WORD)."
             (mm-decode-coding-string string mail-parse-charset))
         (mm-string-as-multibyte string)))))
 
+(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."
   ;; Be more liberal to accept buggy base64 strings. If