67018f4baf6dcedd0c5218e6996a6e29a2f2a6d6
[gnus] / lisp / mm-util.el
1 ;;; mm-util.el --- Utility functions for MIME things
2 ;; Copyright (C) 1998 Free Software Foundation, Inc.
3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; This file is part of GNU Emacs.
7
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
11 ;; any later version.
12
13 ;; GNU Emacs is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;; GNU General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;; Boston, MA 02111-1307, USA.
22
23 ;;; Commentary:
24
25 ;;; Code:
26
27 (eval-and-compile
28   (if (fboundp 'decode-coding-string)
29       (fset 'mm-decode-coding-string 'decode-coding-string)
30     (fset 'mm-decode-coding-string (lambda (s a) s))))
31
32 (eval-and-compile
33   (if (fboundp 'encode-coding-string)
34       (fset 'mm-encode-coding-string 'encode-coding-string)
35     (fset 'mm-encode-coding-string (lambda (s a) s))))
36
37 (eval-and-compile
38   (if (fboundp 'coding-system-list)
39       (fset 'mm-coding-system-list 'coding-system-list)
40     (fset 'mm-coding-system-list 'ignore)))
41
42 (defvar mm-mime-mule-charset-alist
43   '((us-ascii ascii)
44     (iso-8859-1 latin-iso8859-1)
45     (iso-8859-2 latin-iso8859-2)
46     (iso-8859-3 latin-iso8859-3)
47     (iso-8859-4 latin-iso8859-4)
48     (iso-8859-5 cyrillic-iso8859-5)
49     (koi8-r cyrillic-iso8859-5)
50     (iso-8859-6 arabic-iso8859-6)
51     (iso-8859-7 greek-iso8859-7)
52     (iso-8859-8 hebrew-iso8859-8)
53     (iso-8859-9 latin-iso8859-9)
54     (iso-2022-jp latin-jisx0201
55                  japanese-jisx0208-1978 japanese-jisx0208)
56     (euc-kr korean-ksc5601)
57     (cn-gb-2312 chinese-gb2312)
58     (cn-big5 chinese-big5-1 chinese-big5-2)
59     (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
60                    latin-jisx0201 japanese-jisx0208-1978
61                    chinese-gb2312 japanese-jisx0208
62                    korean-ksc5601 japanese-jisx0212)
63     (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
64                     latin-jisx0201 japanese-jisx0208-1978
65                     chinese-gb2312 japanese-jisx0208
66                     korean-ksc5601 japanese-jisx0212
67                     chinese-cns11643-1 chinese-cns11643-2)
68     (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
69                     cyrillic-iso8859-5 greek-iso8859-7
70                     latin-jisx0201 japanese-jisx0208-1978
71                     chinese-gb2312 japanese-jisx0208
72                     korean-ksc5601 japanese-jisx0212
73                     chinese-cns11643-1 chinese-cns11643-2
74                     chinese-cns11643-3 chinese-cns11643-4
75                     chinese-cns11643-5 chinese-cns11643-6
76                     chinese-cns11643-7))
77   "Alist of MIME-charset/MULE-charsets.")
78
79 (defvar mm-charset-coding-system-alist
80   (let ((rest
81          '((us-ascii . iso-8859-1)
82            (gb2312 . cn-gb-2312)
83            (iso-2022-jp-2 . iso-2022-7bit-ss2)
84            (x-ctext . ctext)))
85         (systems (mm-coding-system-list))
86         dest)
87     (while rest
88       (let ((pair (car rest)))
89         (unless (memq (car pair) systems)
90           (setq dest (cons pair dest))))
91       (setq rest (cdr rest)))
92     dest)
93   "Charset/coding system alist.")
94
95 (defun mm-mule-charset-to-mime-charset (charset)
96   "Return the MIME charset corresponding to MULE CHARSET."
97   (let ((alist mm-mime-mule-charset-alist)
98         out)
99     (while alist
100       (when (memq charset (cdar alist))
101         (setq out (caar alist)
102               alist nil))
103       (pop alist))
104     out))
105
106 (defun mm-charset-to-coding-system (charset &optional lbt)
107   "Return coding-system corresponding to CHARSET.
108 CHARSET is a symbol naming a MIME charset.
109 If optional argument LBT (`unix', `dos' or `mac') is specified, it is
110 used as the line break code type of the coding system."
111   (when (stringp charset)
112     (setq charset (intern (downcase charset))))
113   (setq charset
114         (or (cdr (assq charset mm-charset-coding-system-alist))
115             charset))
116   (when lbt
117     (setq charset (intern (format "%s-%s" charset lbt))))
118   (cond
119    ;; Running in a non-MULE environment.
120    ((and (null (mm-coding-system-list))
121          (eq charset 'iso-8859-1))
122     charset)
123    ;; Check to see whether we can handle this charset.
124    ((memq charset (mm-coding-system-list))
125     charset)
126    ;; Nope.
127    (t
128     nil)))
129
130 (defun mm-replace-chars-in-string (string from to)
131   "Replace characters in STRING from FROM to TO."
132   (let ((string (substring string 0))   ;Copy string.
133         (len (length string))
134         (idx 0))
135     ;; Replace all occurrences of FROM with TO.
136     (while (< idx len)
137       (when (= (aref string idx) from)
138         (aset string idx to))
139       (setq idx (1+ idx)))
140     string))
141
142 (provide 'mm-util)
143
144 ;;; mm-util.el ends here