Add the thread headers to gnus-newsgroup-headers.

[gnus] / lisp / mm-util.el

diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index 76dc108..b16e1d9 100644 (file)
--- a/lisp/mm-util.el
+++ b/lisp/mm-util.el
@@ -1,31 +1,33 @@
 ;;; mm-util.el --- Utility functions for Mule and low level things
 
 ;;; mm-util.el --- Utility functions for Mule and low level things
 

-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;;   2007, 2008, 2009, 2010  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 2, 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:
 
 ;;; Code:
 
 
 ;;; Commentary:
 
 ;;; Code:
 

+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+

 (eval-when-compile (require 'cl))
 (require 'mail-prsvr)
 
 (eval-when-compile (require 'cl))
 (require 'mail-prsvr)
 


@@ -36,50 +38,64 @@
        (require 'timer))
     (require 'timer)))
 
        (require 'timer))
     (require 'timer)))
 

+(defvar mm-mime-mule-charset-alist )
+
+;; Emulate functions that are not available in every (X)Emacs version.
+;; The name of a function is prefixed with mm-, like `mm-char-int' for
+;; `char-int' that is a native XEmacs function, not available in Emacs.
+;; Gnus programs all should use mm- functions, not the original ones.

 (eval-and-compile
 (eval-and-compile

-  (mapcar
+  (mapc

    (lambda (elem)
      (let ((nfunc (intern (format "mm-%s" (car elem)))))
        (if (fboundp (car elem))
           (defalias nfunc (car elem))
         (defalias nfunc (cdr elem)))))
    (lambda (elem)
      (let ((nfunc (intern (format "mm-%s" (car elem)))))
        (if (fboundp (car elem))
           (defalias nfunc (car elem))
         (defalias nfunc (cdr elem)))))

-   '((decode-coding-string . (lambda (s a) s))
-     (encode-coding-string . (lambda (s a) s))
-     (encode-coding-region . ignore)
+   `(;; `coding-system-list' is not available in XEmacs 21.4 built
+     ;; without the `file-coding' feature.

      (coding-system-list . ignore)
      (coding-system-list . ignore)

-     (decode-coding-region . ignore)
+     ;; `char-int' is an XEmacs function, not available in Emacs.

      (char-int . identity)
      (char-int . identity)

+     ;; `coding-system-equal' is an Emacs function, not available in XEmacs.

      (coding-system-equal . equal)
      (coding-system-equal . equal)

+     ;; `annotationp' is an XEmacs function, not available in Emacs.

      (annotationp . ignore)
      (annotationp . ignore)

+     ;; `set-buffer-file-coding-system' is not available in XEmacs 21.4
+     ;; built without the `file-coding' feature.

      (set-buffer-file-coding-system . ignore)
      (set-buffer-file-coding-system . ignore)

+     ;; `read-charset' is an Emacs function, not available in XEmacs.

      (read-charset
      (read-charset

-      . (lambda (prompt)
-         "Return a charset."
-         (intern
-          (completing-read
-           prompt
-           (mapcar (lambda (e) (list (symbol-name (car e))))
-                   mm-mime-mule-charset-alist)
-           nil t))))
+      . ,(lambda (prompt)
+          "Return a charset."
+          (intern
+           (gnus-completing-read
+            prompt
+            (mapcar (lambda (e) (symbol-name (car e)))
+                    mm-mime-mule-charset-alist)
+            t))))
+     ;; `subst-char-in-string' is not available in XEmacs 21.4.

      (subst-char-in-string
      (subst-char-in-string

-      . (lambda (from to string &optional inplace)
-         ;; stolen (and renamed) from nnheader.el
-         "Replace characters in STRING from FROM to TO.
+      . ,(lambda (from to string &optional inplace)
+          ;; stolen (and renamed) from nnheader.el
+          "Replace characters in STRING from FROM to TO.

          Unless optional argument INPLACE is non-nil, return a new string."
          Unless optional argument INPLACE is non-nil, return a new string."

-         (let ((string (if inplace string (copy-sequence string)))
-               (len (length string))
-               (idx 0))
-           ;; Replace all occurrences of FROM with TO.
-           (while (< idx len)
-             (when (= (aref string idx) from)
-               (aset string idx to))
-             (setq idx (1+ idx)))
-           string)))
+          (let ((string (if inplace string (copy-sequence string)))
+                (len (length string))
+                (idx 0))
+            ;; Replace all occurrences of FROM with TO.
+            (while (< idx len)
+              (when (= (aref string idx) from)
+                (aset string idx to))
+              (setq idx (1+ idx)))
+            string)))
+     ;; `replace-in-string' is an XEmacs function, not available in Emacs.

      (replace-in-string
      (replace-in-string

-      . (lambda (string regexp rep &optional literal)
-         "See `replace-regexp-in-string', only the order of args differs."
-         (replace-regexp-in-string regexp rep string nil literal)))
+      . ,(lambda (string regexp rep &optional literal)
+          "See `replace-regexp-in-string', only the order of args differs."
+          (replace-regexp-in-string regexp rep string nil literal)))
+     ;; `string-as-unibyte' is an Emacs function, not available in XEmacs.

      (string-as-unibyte . identity)
      (string-as-unibyte . identity)

+     ;; `string-make-unibyte' is an Emacs function, not available in XEmacs.

      (string-make-unibyte . identity)
      ;; string-as-multibyte often doesn't really do what you think it does.
      ;; Example:
      (string-make-unibyte . identity)
      ;; string-as-multibyte often doesn't really do what you think it does.
      ;; Example:


@@ -99,32 +115,108 @@
      ;; (string-as-multibyte s)   ~= (decode-coding-string s 'emacs-mule)
      ;; (string-to-multibyte s)   ~= (decode-coding-string s 'binary)
      ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system)
      ;; (string-as-multibyte s)   ~= (decode-coding-string s 'emacs-mule)
      ;; (string-to-multibyte s)   ~= (decode-coding-string s 'binary)
      ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system)

+     ;; `string-as-multibyte' is an Emacs function, not available in XEmacs.

      (string-as-multibyte . identity)
      (string-as-multibyte . identity)

-     (string-to-multibyte
-      . (lambda (string)
-         "Return a multibyte string with the same individual chars as string."
-         (mapconcat
-          (lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
-          string "")))
+     ;; `multibyte-string-p' is an Emacs function, not available in XEmacs.

      (multibyte-string-p . ignore)
      (multibyte-string-p . ignore)

+     ;; `insert-byte' is available only in Emacs 23.1 or greater.

      (insert-byte . insert-char)
      (insert-byte . insert-char)

+     ;; `multibyte-char-to-unibyte' is an Emacs function, not available
+     ;; in XEmacs.

      (multibyte-char-to-unibyte . identity)
      (multibyte-char-to-unibyte . identity)

+     ;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs.
+     (set-buffer-multibyte . ignore)
+     ;; `special-display-p' is an Emacs function, not available in XEmacs.

      (special-display-p
      (special-display-p

-      . (lambda (buffer-name)
-         "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
-         (and special-display-function
-              (or (and (member buffer-name special-display-buffer-names) t)
-                  (cdr (assoc buffer-name special-display-buffer-names))
-                  (catch 'return
-                    (dolist (elem special-display-regexps)
-                      (and (stringp elem)
-                           (string-match elem buffer-name)
-                           (throw 'return t))
-                      (and (consp elem)
-                           (stringp (car elem))
-                           (string-match (car elem) buffer-name)
-                           (throw 'return (cdr elem))))))))))))
+      . ,(lambda (buffer-name)
+          "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
+          (and special-display-function
+               (or (and (member buffer-name special-display-buffer-names) t)
+                   (cdr (assoc buffer-name special-display-buffer-names))
+                   (catch 'return
+                     (dolist (elem special-display-regexps)
+                       (and (stringp elem)
+                            (string-match elem buffer-name)
+                            (throw 'return t))
+                       (and (consp elem)
+                            (stringp (car elem))
+                            (string-match (car elem) buffer-name)
+                            (throw 'return (cdr elem)))))))))
+     ;; `substring-no-properties' is available only in Emacs 22.1 or greater.
+     (substring-no-properties
+      . ,(lambda (string &optional from to)
+          "Return a substring of STRING, without text properties.
+It starts at index FROM and ending before TO.
+TO may be nil or omitted; then the substring runs to the end of STRING.
+If FROM is nil or omitted, the substring starts at the beginning of STRING.
+If FROM or TO is negative, it counts from the end.
+
+With one argument, just copy STRING without its properties."
+          (setq string (substring string (or from 0) to))
+          (set-text-properties 0 (length string) nil string)
+          string))
+     ;; `line-number-at-pos' is available only in Emacs 22.1 or greater
+     ;; and XEmacs 21.5.
+     (line-number-at-pos
+      . ,(lambda (&optional pos)
+          "Return (narrowed) buffer line number at position POS.
+If POS is nil, use current buffer location.
+Counting starts at (point-min), so the value refers
+to the contents of the accessible portion of the buffer."
+          (let ((opoint (or pos (point))) start)
+            (save-excursion
+              (goto-char (point-min))
+              (setq start (point))
+              (goto-char opoint)
+              (forward-line 0)
+              (1+ (count-lines start (point))))))))))
+
+;; `decode-coding-string', `encode-coding-string', `decode-coding-region'
+;; and `encode-coding-region' are available in Emacs and XEmacs built with
+;; the `file-coding' feature, but the XEmacs versions treat nil, that is
+;; given as the `coding-system' argument, as the `binary' coding system.
+(eval-and-compile
+  (if (featurep 'xemacs)
+      (if (featurep 'file-coding)
+         (progn
+           (defun mm-decode-coding-string (str coding-system)
+             (if coding-system
+                 (decode-coding-string str coding-system)
+               str))
+           (defun mm-encode-coding-string (str coding-system)
+             (if coding-system
+                 (encode-coding-string str coding-system)
+               str))
+           (defun mm-decode-coding-region (start end coding-system)
+             (if coding-system
+                 (decode-coding-region start end coding-system)))
+           (defun mm-encode-coding-region (start end coding-system)
+             (if coding-system
+                 (encode-coding-region start end coding-system))))
+       (defun mm-decode-coding-string (str coding-system) str)
+       (defun mm-encode-coding-string (str coding-system) str)
+       (defalias 'mm-decode-coding-region 'ignore)
+       (defalias 'mm-encode-coding-region 'ignore))
+    (defalias 'mm-decode-coding-string 'decode-coding-string)
+    (defalias 'mm-encode-coding-string 'encode-coding-string)
+    (defalias 'mm-decode-coding-region 'decode-coding-region)
+    (defalias 'mm-encode-coding-region 'encode-coding-region)))
+
+;; `string-to-multibyte' is available only in Emacs 22.1 or greater.
+(defalias 'mm-string-to-multibyte
+  (cond
+   ((featurep 'xemacs)
+    'identity)
+   ((fboundp 'string-to-multibyte)
+    'string-to-multibyte)
+   (t
+    (lambda (string)
+      "Return a multibyte string with the same individual chars as STRING."
+      (mapconcat
+       (lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
+       string "")))))

 
 

+;; `char-or-char-int-p' is an XEmacs function, not available in Emacs.

 (eval-and-compile
   (defalias 'mm-char-or-char-int-p
     (cond
 (eval-and-compile
   (defalias 'mm-char-or-char-int-p
     (cond


@@ -132,6 +224,44 @@
      ((fboundp 'char-valid-p) 'char-valid-p)
      (t 'identity))))
 
      ((fboundp 'char-valid-p) 'char-valid-p)
      (t 'identity))))
 

+;; `ucs-to-char' is a function that Mule-UCS provides.
+(if (featurep 'xemacs)
+    (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5.
+               (subrp (symbol-function 'unicode-to-char)))
+          (if (featurep 'mule)
+              (defalias 'mm-ucs-to-char 'unicode-to-char)
+            (defun mm-ucs-to-char (codepoint)
+              "Convert Unicode codepoint to character."
+              (or (unicode-to-char codepoint) ?#))))
+         ((featurep 'mule)
+          (defun mm-ucs-to-char (codepoint)
+            "Convert Unicode codepoint to character."
+            (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded.
+                (progn
+                  (defalias 'mm-ucs-to-char
+                    (lambda (codepoint)
+                      "Convert Unicode codepoint to character."
+                      (condition-case nil
+                          (or (ucs-to-char codepoint) ?#)
+                        (error ?#))))
+                  (mm-ucs-to-char codepoint))
+              (condition-case nil
+                  (or (int-to-char codepoint) ?#)
+                (error ?#)))))
+         (t
+          (defun mm-ucs-to-char (codepoint)
+            "Convert Unicode codepoint to character."
+            (condition-case nil
+                (or (int-to-char codepoint) ?#)
+              (error ?#)))))
+  (if (let ((char (make-char 'japanese-jisx0208 36 34)))
+       (eq char (decode-char 'ucs char)))
+      ;; Emacs 23.
+      (defalias 'mm-ucs-to-char 'identity)
+    (defun mm-ucs-to-char (codepoint)
+      "Convert Unicode codepoint to character."
+      (or (decode-char 'ucs codepoint) ?#))))
+

 ;; Fixme:  This seems always to be used to read a MIME charset, so it
 ;; should be re-named and fixed (in Emacs) to offer completion only on
 ;; proper charset names (base coding systems which have a
 ;; Fixme:  This seems always to be used to read a MIME charset, so it
 ;; should be re-named and fixed (in Emacs) to offer completion only on
 ;; proper charset names (base coding systems which have a


@@ -151,8 +281,8 @@
        'read-coding-system))
      (t (lambda (prompt &optional default-coding-system)
          "Prompt the user for a coding system."
        'read-coding-system))
      (t (lambda (prompt &optional default-coding-system)
          "Prompt the user for a coding system."

-         (completing-read
-          prompt (mapcar (lambda (s) (list (symbol-name (car s))))
+         (gnus-completing-read
+          prompt (mapcar (lambda (s) (symbol-name (car s)))

                          mm-mime-mule-charset-alist)))))))
 
 (defvar mm-coding-system-list nil)
                          mm-mime-mule-charset-alist)))))))
 
 (defvar mm-coding-system-list nil)


@@ -182,16 +312,21 @@ non-nil, an alias is created and added to
 the alias.  Else windows-NUMBER is used."
   (interactive
    (let ((completion-ignore-case t)
 the alias.  Else windows-NUMBER is used."
   (interactive
    (let ((completion-ignore-case t)

-        (candidates (cp-supported-codepages)))
-     (list (completing-read "Setup DOS Codepage: (default 437) " candidates
-                           nil t nil nil "437"))))
+        (candidates (if (fboundp 'cp-supported-codepages)
+                        (cp-supported-codepages)
+                      ;; Removed in Emacs 23 (unicode), so signal an error:
+                      (error "`codepage-setup' not present in this Emacs version"))))
+     (list (gnus-completing-read "Setup DOS Codepage" candidates
+                                 t nil nil "437"))))

   (when alias
     (setq alias (if (stringp alias)
                    (intern alias)
                  (intern (format "windows-%s" number)))))
   (let* ((cp (intern (format "cp%s" number))))
     (unless (mm-coding-system-p cp)
   (when alias
     (setq alias (if (stringp alias)
                    (intern alias)
                  (intern (format "windows-%s" number)))))
   (let* ((cp (intern (format "cp%s" number))))
     (unless (mm-coding-system-p cp)

-      (codepage-setup number))
+      (if (fboundp 'codepage-setup)    ; silence compiler
+         (codepage-setup number)
+       (error "`codepage-setup' not present in this Emacs version")))

     (when (and alias
               ;; Don't add alias if setup of cp failed.
               (mm-coding-system-p cp))
     (when (and alias
               ;; Don't add alias if setup of cp failed.
               (mm-coding-system-p cp))


@@ -202,62 +337,164 @@ the alias.  Else windows-NUMBER is used."
     ;; Not in XEmacs, but it's not a proper MIME charset anyhow.
     ,@(unless (mm-coding-system-p 'x-ctext)
        '((x-ctext . ctext)))
     ;; Not in XEmacs, but it's not a proper MIME charset anyhow.
     ,@(unless (mm-coding-system-p 'x-ctext)
        '((x-ctext . ctext)))

-    ;; ISO-8859-15 is very similar to ISO-8859-1.  But it's _different_!
+    ;; ISO-8859-15 is very similar to ISO-8859-1.  But it's _different_ in 8
+    ;; positions!

     ,@(unless (mm-coding-system-p 'iso-8859-15)
        '((iso-8859-15 . iso-8859-1)))
     ;; BIG-5HKSCS is similar to, but different than, BIG-5.
     ,@(unless (mm-coding-system-p 'big5-hkscs)
        '((big5-hkscs . big5)))
     ,@(unless (mm-coding-system-p 'iso-8859-15)
        '((iso-8859-15 . iso-8859-1)))
     ;; BIG-5HKSCS is similar to, but different than, BIG-5.
     ,@(unless (mm-coding-system-p 'big5-hkscs)
        '((big5-hkscs . big5)))

-    ;; Windows-1252 is actually a superset of Latin-1.  See also
-    ;; `gnus-article-dumbquotes-map'.
-    ,@(unless (mm-coding-system-p 'windows-1252)
-       (if (mm-coding-system-p 'cp1252)
-           '((windows-1252 . cp1252))
-         '((windows-1252 . iso-8859-1))))
-    ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
-    ;; Outlook users in Czech republic. Use this to allow reading of their
-    ;; e-mails. cp1250 should be defined by M-x codepage-setup.
-    ,@(if (and (not (mm-coding-system-p 'windows-1250))
-              (mm-coding-system-p 'cp1250))
-         '((windows-1250 . cp1250)))

     ;; A Microsoft misunderstanding.
     ;; A Microsoft misunderstanding.

-    ,@(if (and (not (mm-coding-system-p 'unicode))
-              (mm-coding-system-p 'utf-16-le))
-         '((unicode . utf-16-le)))
+    ,@(when (and (not (mm-coding-system-p 'unicode))
+                (mm-coding-system-p 'utf-16-le))
+       '((unicode . utf-16-le)))

     ;; A Microsoft misunderstanding.
     ,@(unless (mm-coding-system-p 'ks_c_5601-1987)
        (if (mm-coding-system-p 'cp949)
            '((ks_c_5601-1987 . cp949))
          '((ks_c_5601-1987 . euc-kr))))
     ;; Windows-31J is Windows Codepage 932.
     ;; A Microsoft misunderstanding.
     ,@(unless (mm-coding-system-p 'ks_c_5601-1987)
        (if (mm-coding-system-p 'cp949)
            '((ks_c_5601-1987 . cp949))
          '((ks_c_5601-1987 . euc-kr))))
     ;; Windows-31J is Windows Codepage 932.

-    ,@(if (and (not (mm-coding-system-p 'windows-31j))
-              (mm-coding-system-p 'cp932))
-         '((windows-31j . cp932)))
+    ,@(when (and (not (mm-coding-system-p 'windows-31j))
+                (mm-coding-system-p 'cp932))
+       '((windows-31j . cp932)))
+    ;; Charset name: GBK, Charset aliases: CP936, MS936, windows-936
+    ;; http://www.iana.org/assignments/charset-reg/GBK
+    ;; Emacs 22.1 has cp936, but not gbk, so we alias it:
+    ,@(when (and (not (mm-coding-system-p 'gbk))
+                (mm-coding-system-p 'cp936))
+       '((gbk . cp936)))
+    ;; UTF8 is a bogus name for UTF-8
+    ,@(when (and (not (mm-coding-system-p 'utf8))
+                (mm-coding-system-p 'utf-8))
+       '((utf8 . utf-8)))
+    ;; ISO8859-1 is a bogus name for ISO-8859-1
+    ,@(when (and (not (mm-coding-system-p 'iso8859-1))
+                (mm-coding-system-p 'iso-8859-1))
+       '((iso8859-1 . iso-8859-1)))
+    ;; ISO_8859-1 is a bogus name for ISO-8859-1
+    ,@(when (and (not (mm-coding-system-p 'iso_8859-1))
+                (mm-coding-system-p 'iso-8859-1))
+       '((iso_8859-1 . iso-8859-1)))

     )
     )

-  "A mapping from unknown or invalid charset names to the real charset names.")
-
-(defcustom mm-charset-override-alist
-  `((iso-8859-1 . windows-1252))
-  "A mapping from undesired charset names to their replacement.
+  "A mapping from unknown or invalid charset names to the real charset names.
+
+See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.")
+
+(defcustom mm-codepage-iso-8859-list
+  (list 1250 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
+       ;; Outlook users in Czech republic.  Use this to allow reading of
+       ;; their e-mails.
+       '(1252 . 1) ;; Windows-1252 is a superset of iso-8859-1 (West
+                   ;; Europe).  See also `gnus-article-dumbquotes-map'.
+       '(1254 . 9) ;; Windows-1254 is a superset of iso-8859-9 (Turkish).
+       '(1255 . 8));; Windows-1255 is a superset of iso-8859-8 (Hebrew).
+  "A list of Windows codepage numbers and iso-8859 charset numbers.
+
+If an element is a number corresponding to a supported windows
+codepage, appropriate entries to `mm-charset-synonym-alist' are
+added by `mm-setup-codepage-iso-8859'.  An element may also be a
+cons cell where the car is a codepage number and the cdr is the
+corresponding number of an iso-8859 charset."
+  :type '(list (set :inline t
+                   (const 1250 :tag "Central and East European")
+                   (const (1252 . 1) :tag "West European")
+                   (const (1254 . 9) :tag "Turkish")
+                   (const (1255 . 8) :tag "Hebrew"))
+              (repeat :inline t
+                      :tag "Other options"
+                      (choice
+                       (integer :tag "Windows codepage number")
+                       (cons (integer :tag "Windows codepage number")
+                             (integer :tag "iso-8859 charset  number")))))
+  :version "22.1" ;; Gnus 5.10.9
+  :group 'mime)

 
 

-You may add pairs like (iso-8859-1 . windows-1252) here,
-i.e. treat iso-8859-1 as windows-1252.  windows-1252 is a
-superset of iso-8859-1."
+(defcustom mm-codepage-ibm-list
+  (list 437 ;; (US etc.)
+       860 ;; (Portugal)
+       861 ;; (Iceland)
+       862 ;; (Israel)
+       863 ;; (Canadian French)
+       865 ;; (Nordic)
+       852 ;;
+       850 ;; (Latin 1)
+       855 ;; (Cyrillic)
+       866 ;; (Cyrillic - Russian)
+       857 ;; (Turkish)
+       864 ;; (Arabic)
+       869 ;; (Greek)
+       874);; (Thai)
+  ;; In Emacs 23 (unicode), cp... and ibm... are aliases.
+  ;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de
+  "List of IBM codepage numbers.
+
+The codepage mappings slighly differ between IBM and other vendors.
+See \"ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/IBM/README.TXT\".
+
+If an element is a number corresponding to a supported windows
+codepage, appropriate entries to `mm-charset-synonym-alist' are
+added by `mm-setup-codepage-ibm'."

   :type '(list (set :inline t
   :type '(list (set :inline t

-                   (const (iso-8859-1 . windows-1252))
-                   (const (undecided  . windows-1252)))
+                   (const 437 :tag "US etc.")
+                   (const 860 :tag "Portugal")
+                   (const 861 :tag "Iceland")
+                   (const 862 :tag "Israel")
+                   (const 863 :tag "Canadian French")
+                   (const 865 :tag "Nordic")
+                   (const 852)
+                   (const 850 :tag "Latin 1")
+                   (const 855 :tag "Cyrillic")
+                   (const 866 :tag "Cyrillic - Russian")
+                   (const 857 :tag "Turkish")
+                   (const 864 :tag "Arabic")
+                   (const 869 :tag "Greek")
+                   (const 874 :tag "Thai"))

               (repeat :inline t
                       :tag "Other options"
               (repeat :inline t
                       :tag "Other options"

-                      (cons (symbol :tag "From charset")
-                            (symbol :tag "To charset"))))
-  :version "23.0" ;; No Gnus
+                      (integer :tag "Codepage number")))
+  :version "22.1" ;; Gnus 5.10.9

   :group 'mime)
 
   :group 'mime)
 

+(defun mm-setup-codepage-iso-8859 (&optional list)
+  "Add appropriate entries to `mm-charset-synonym-alist'.
+Unless LIST is given, `mm-codepage-iso-8859-list' is used."
+  (unless list
+    (setq list mm-codepage-iso-8859-list))
+  (dolist (i list)
+    (let (cp windows iso)
+      (if (consp i)
+         (setq cp (intern (format "cp%d" (car i)))
+               windows (intern (format "windows-%d" (car i)))
+               iso (intern (format "iso-8859-%d" (cdr i))))
+       (setq cp (intern (format "cp%d" i))
+             windows (intern (format "windows-%d" i))))
+      (unless (mm-coding-system-p windows)
+       (if (mm-coding-system-p cp)
+           (add-to-list 'mm-charset-synonym-alist (cons windows cp))
+         (add-to-list 'mm-charset-synonym-alist (cons windows iso)))))))
+
+(defun mm-setup-codepage-ibm (&optional list)
+  "Add appropriate entries to `mm-charset-synonym-alist'.
+Unless LIST is given, `mm-codepage-ibm-list' is used."
+  (unless list
+    (setq list mm-codepage-ibm-list))
+  (dolist (number list)
+    (let ((ibm (intern (format "ibm%d" number)))
+         (cp  (intern (format "cp%d" number))))
+      (when (and (not (mm-coding-system-p ibm))
+                (mm-coding-system-p cp))
+       (add-to-list 'mm-charset-synonym-alist (cons ibm cp))))))
+
+;; Initialize:
+(mm-setup-codepage-iso-8859)
+(mm-setup-codepage-ibm)
+
+;; Note: this has to be defined before `mm-charset-to-coding-system'.

 (defcustom mm-charset-eval-alist
   (if (featurep 'xemacs)
       nil ;; I don't know what would be useful for XEmacs.
 (defcustom mm-charset-eval-alist
   (if (featurep 'xemacs)
       nil ;; I don't know what would be useful for XEmacs.

-    '(;; Emacs 21 offers 1250 1251 1253 1257.  Emacs 22 provides autoloads for
-      ;; 1250-1258 (i.e. `mm-codepage-setup' does nothing).
+    '(;; Emacs 22 provides autoloads for 1250-1258
+      ;; (i.e. `mm-codepage-setup' does nothing).

       (windows-1250 . (mm-codepage-setup 1250 t))
       (windows-1251 . (mm-codepage-setup 1251 t))
       (windows-1253 . (mm-codepage-setup 1253 t))
       (windows-1250 . (mm-codepage-setup 1250 t))
       (windows-1251 . (mm-codepage-setup 1251 t))
       (windows-1253 . (mm-codepage-setup 1253 t))


@@ -267,7 +504,7 @@ If an article is encoded in an unknown CHARSET, FORM is