]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/rfc2047.el
(dired-pop-to-buffer): Try to make this behave the
[gnu-emacs] / lisp / gnus / rfc2047.el
index 55d60ae3fb7c6535e82e3b4b1e6281c6bc7fe57c..c0bdec3c0253248f27efd65acf2d17c88cbd3d9c 100644 (file)
@@ -1,26 +1,24 @@
 ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 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.
 
-;; 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
-;; 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
-;; 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
-;; 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:
 
@@ -78,6 +76,8 @@ The values can be:
     (iso-2022-jp . B)
     (iso-2022-kr . B)
     (gb2312 . B)
+    (gbk . B)
+    (gb18030 . B)
     (big5 . B)
     (cn-big5 . B)
     (cn-gb . B)
@@ -291,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
-            ;; 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
@@ -344,7 +344,7 @@ The buffer may be narrowed."
   ;; (make-char-table 'syntax-table '(2)) only works in Emacs.
   (let ((table (make-syntax-table)))
     ;; The following is done to work for setting all elements of the table
-    ;; in Emacs 21 and 22 and XEmacs; it appears to be the cleanest way.
+    ;; in Emacs 21-23 and XEmacs; it appears to be the cleanest way.
     ;; Play safe and don't assume the form of the word syntax entry --
     ;; copy it from ?a.
     (if (fboundp 'set-char-table-range)        ; Emacs
@@ -902,9 +902,13 @@ them.")
            (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.
-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)
@@ -912,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))
-  (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)))
@@ -933,7 +937,7 @@ ENCODED-WORD)."
     (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
@@ -1041,7 +1045,7 @@ other than `\"' and `\\' in quoted strings."
                (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) ?\")))
@@ -1092,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."
-  (let ((m (mm-multibyte-p)))
+  ;; (let ((m (mm-multibyte-p)))
     (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))
@@ -1116,7 +1120,7 @@ other than `\"' and `\\' in quoted strings."
                (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)))
@@ -1132,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))
-             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.
@@ -1159,5 +1163,5 @@ strings are stripped."
 
 (provide 'rfc2047)
 
-;;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6
+;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6
 ;;; rfc2047.el ends here