(dired-pop-to-buffer): Try to make this behave the

[gnu-emacs] / lisp / gnus / rfc2047.el

diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index 45f251d4edde242e460cbec82fb5f40b9c23ea52..c0bdec3c0253248f27efd65acf2d17c88cbd3d9c 100644 (file)
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -1,26 +1,24 @@
 ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
 ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,

-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of

-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -293,7 +291,7 @@ Should be called narrowed to the head of the message."
             ;; 8-bit names.  The group name mail copy just got
             ;; unconditionally encoded.  Previously, it would ask
             ;; whether to encode, which was quite confusing for the
             ;; 8-bit names.  The group name mail copy just got
             ;; unconditionally encoded.  Previously, it would ask
             ;; whether to encode, which was quite confusing for the

-            ;; user.  If the new behaviour is wrong, tell me. I have
+            ;; user.  If the new behavior is wrong, tell me. I have

             ;; left the old code commented out below.
             ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
             ;; Modified by Dave Love, with the commented-out code changed
             ;; left the old code commented out below.
             ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
             ;; Modified by Dave Love, with the commented-out code changed


@@ -904,9 +902,13 @@ them.")
            (error
             (goto-char beg))))))))
 
            (error
             (goto-char beg))))))))
 

-(defun rfc2047-charset-to-coding-system (charset)
+(defun rfc2047-charset-to-coding-system (charset &optional allow-override)

   "Return coding-system corresponding to MIME CHARSET.
   "Return coding-system corresponding to MIME CHARSET.

-If your Emacs implementation can't decode CHARSET, return nil."
+If your Emacs implementation can't decode CHARSET, return nil.
+
+If allow-override is given, use `mm-charset-override-alist' to
+map undesired charset names to their replacement.  This should
+only be used for decoding, not for encoding."

   (when (stringp charset)
     (setq charset (intern (downcase charset))))
   (when (or (not charset)
   (when (stringp charset)
     (setq charset (intern (downcase charset))))
   (when (or (not charset)


@@ -914,7 +916,7 @@ If your Emacs implementation can't decode CHARSET, return nil."
            (memq 'gnus-all mail-parse-ignored-charsets)
            (memq charset mail-parse-ignored-charsets))
     (setq charset mail-parse-charset))
            (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)))
+  (let ((cs (mm-charset-to-coding-system charset nil allow-override)))

     (cond ((eq cs 'ascii)
           (setq cs (or (mm-charset-to-coding-system mail-parse-charset)
                        'raw-text)))
     (cond ((eq cs 'ascii)
           (setq cs (or (mm-charset-to-coding-system mail-parse-charset)
                        'raw-text)))


@@ -935,7 +937,7 @@ ENCODED-WORD)."
     (while words
       (setq word (pop words))
       (if (and (setq cs (rfc2047-charset-to-coding-system
     (while words
       (setq word (pop words))
       (if (and (setq cs (rfc2047-charset-to-coding-system

-                        (setq charset (car word))))
+                        (setq charset (car word)) t))

               (condition-case code
                   (cond ((char-equal ?B (nth 1 word))
                          (setq text (base64-decode-string
               (condition-case code
                   (cond ((char-equal ?B (nth 1 word))
                          (setq text (base64-decode-string


@@ -1043,7 +1045,7 @@ other than `\"' and `\\' in quoted strings."
                (setq start (point))
                (setq quoted (eq (char-after) ?\"))
                (goto-char (point-max))
                (setq start (point))
                (setq quoted (eq (char-after) ?\"))
                (goto-char (point-max))

-               (skip-chars-backward " \t")
+               (skip-chars-backward " \t" start)

                (if (setq quoted (and quoted
                                      (> (point) (1+ start))
                                      (eq (char-before) ?\")))
                (if (setq quoted (and quoted
                                      (> (point) (1+ start))
                                      (eq (char-before) ?\")))


@@ -1094,17 +1096,17 @@ strings are stripped."
   "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."
   "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)))
+  ;; (let ((m (mm-multibyte-p)))

     (if (string-match "=\\?" string)
        (with-temp-buffer
     (if (string-match "=\\?" string)
        (with-temp-buffer

-         ;; Fixme: This logic is wrong, but seems to be required by
-         ;; Gnus summary buffer generation.  The value of `m' depends
-         ;; on the current buffer, not global multibyteness or that
-         ;; of the string.  Also the string returned should always be
-         ;; multibyte in a multibyte session, i.e. the buffer should
-         ;; be multibyte before `buffer-string' is called.
-         (when m
-           (mm-enable-multibyte))
+          ;; We used to only call mm-enable-multibyte if `m' is non-nil,
+          ;; but this can't be the right criterion.  Don't just revert this
+          ;; change if it encounters a bug.  Please help me fix it
+          ;; right instead.  --Stef
+          ;; The string returned should always be multibyte in a multibyte
+         ;; session, i.e. the buffer should be multibyte before
+         ;; `buffer-string' is called.
+          (mm-enable-multibyte)

          (insert string)
          (inline
            (rfc2047-decode-region (point-min) (point-max) address-mime))
          (insert string)
          (inline
            (rfc2047-decode-region (point-min) (point-max) address-mime))


@@ -1118,7 +1120,7 @@ other than `\"' and `\\' in quoted strings."
                (rfc2047-strip-backslashes-in-quoted-strings)
                (buffer-string))))
       ;; Fixme: As above, `m' here is inappropriate.
                (rfc2047-strip-backslashes-in-quoted-strings)
                (buffer-string))))
       ;; Fixme: As above, `m' here is inappropriate.

-      (if (and m
+      (if (and ;; m

               mail-parse-charset
               (not (eq mail-parse-charset 'us-ascii))
               (not (eq mail-parse-charset 'gnus-decoded)))
               mail-parse-charset
               (not (eq mail-parse-charset 'us-ascii))
               (not (eq mail-parse-charset 'gnus-decoded)))


@@ -1134,9 +1136,9 @@ other than `\"' and `\\' in quoted strings."
          (if (and (fboundp 'detect-coding-string)
                   ;; string is purely ASCII
                   (eq (detect-coding-string string t) 'undecided))
          (if (and (fboundp 'detect-coding-string)
                   ;; string is purely ASCII
                   (eq (detect-coding-string string t) 'undecided))

-             string
-           (mm-decode-coding-string string mail-parse-charset))
-       (mm-string-as-multibyte string)))))
+              string
+            (mm-decode-coding-string string mail-parse-charset))
+        (mm-string-to-multibyte string)))) ;; )

 
 (defun rfc2047-decode-address-string (string)
   "Decode MIME-encoded STRING and return the result.
 
 (defun rfc2047-decode-address-string (string)
   "Decode MIME-encoded STRING and return the result.


@@ -1161,5 +1163,5 @@ strings are stripped."
 
 (provide 'rfc2047)
 
 
 (provide 'rfc2047)
 

-;;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6
+;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6

 ;;; rfc2047.el ends here
 ;;; rfc2047.el ends here