1 ;;; mm-util.el --- Utility functions for MIME things
2 ;; Copyright (C) 1998 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; This file is part of GNU Emacs.
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)
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.
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.
27 (defvar mm-mime-mule-charset-alist
29 (iso-8859-1 latin-iso8859-1)
30 (iso-8859-2 latin-iso8859-2)
31 (iso-8859-3 latin-iso8859-3)
32 (iso-8859-4 latin-iso8859-4)
33 (iso-8859-5 cyrillic-iso8859-5)
34 (koi8-r cyrillic-iso8859-5)
35 (iso-8859-6 arabic-iso8859-6)
36 (iso-8859-7 greek-iso8859-7)
37 (iso-8859-8 hebrew-iso8859-8)
38 (iso-8859-9 latin-iso8859-9)
39 (iso-2022-jp latin-jisx0201
40 japanese-jisx0208-1978 japanese-jisx0208)
41 (euc-kr korean-ksc5601)
42 (cn-gb-2312 chinese-gb2312)
43 (cn-big5 chinese-big5-1 chinese-big5-2)
44 (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
45 latin-jisx0201 japanese-jisx0208-1978
46 chinese-gb2312 japanese-jisx0208
47 korean-ksc5601 japanese-jisx0212)
48 (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
49 latin-jisx0201 japanese-jisx0208-1978
50 chinese-gb2312 japanese-jisx0208
51 korean-ksc5601 japanese-jisx0212
52 chinese-cns11643-1 chinese-cns11643-2)
53 (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
54 cyrillic-iso8859-5 greek-iso8859-7
55 latin-jisx0201 japanese-jisx0208-1978
56 chinese-gb2312 japanese-jisx0208
57 korean-ksc5601 japanese-jisx0212
58 chinese-cns11643-1 chinese-cns11643-2
59 chinese-cns11643-3 chinese-cns11643-4
60 chinese-cns11643-5 chinese-cns11643-6
62 "Alist of MIME-charset/MULE-charsets.")
66 (if (fboundp 'decode-coding-string)
67 (fset 'mm-decode-coding-string 'decode-coding-string)
68 (fset 'mm-decode-coding-string (lambda (s a) s)))
70 (if (fboundp 'encode-coding-string)
71 (fset 'mm-encode-coding-string 'encode-coding-string)
72 (fset 'mm-encode-coding-string (lambda (s a) s)))
74 (if (fboundp 'encode-coding-region)
75 (fset 'mm-encode-coding-region 'encode-coding-region)
76 (fset 'mm-encode-coding-region 'ignore))
78 (if (fboundp 'decode-coding-region)
79 (fset 'mm-decode-coding-region 'decode-coding-region)
80 (fset 'mm-decode-coding-region 'ignore))
82 (if (fboundp 'coding-system-list)
83 (fset 'mm-coding-system-list 'coding-system-list)
84 (fset 'mm-coding-system-list 'ignore))
86 (if (fboundp 'coding-system-equal)
87 (fset 'mm-coding-system-equal 'coding-system-equal)
88 (fset 'mm-coding-system-equal 'equal))
90 (if (fboundp 'read-coding-system)
91 (fset 'mm-read-coding-system 'read-coding-system)
92 (defun mm-read-coding-system (prompt)
93 "Prompt the user for a coding system."
95 prompt (mapcar (lambda (s) (list (symbol-name (car s))))
96 mm-mime-mule-charset-alist)))))
99 (defvar mm-charset-coding-system-alist
101 '((us-ascii . iso-8859-1)
102 (gb2312 . cn-gb-2312)
103 (iso-2022-jp-2 . iso-2022-7bit-ss2)
105 (systems (mm-coding-system-list))
108 (let ((pair (car rest)))
109 (unless (memq (car pair) systems)
110 (setq dest (cons pair dest))))
111 (setq rest (cdr rest)))
113 "Charset/coding system alist.")
116 (defun mm-mule-charset-to-mime-charset (charset)
117 "Return the MIME charset corresponding to MULE CHARSET."
118 (let ((alist mm-mime-mule-charset-alist)
121 (when (memq charset (cdar alist))
122 (setq out (caar alist)
127 (defun mm-charset-to-coding-system (charset &optional lbt)
128 "Return coding-system corresponding to CHARSET.
129 CHARSET is a symbol naming a MIME charset.
130 If optional argument LBT (`unix', `dos' or `mac') is specified, it is
131 used as the line break code type of the coding system."
132 (when (stringp charset)
133 (setq charset (intern (downcase charset))))
135 (or (cdr (assq charset mm-charset-coding-system-alist))
138 (setq charset (intern (format "%s-%s" charset lbt))))
140 ;; Running in a non-MULE environment.
141 ((and (null (mm-coding-system-list))
142 (eq charset 'iso-8859-1))
144 ;; Check to see whether we can handle this charset.
145 ((memq charset (mm-coding-system-list))
151 (defun mm-replace-chars-in-string (string from to)
152 "Replace characters in STRING from FROM to TO."
153 (let ((string (substring string 0)) ;Copy string.
154 (len (length string))
156 ;; Replace all occurrences of FROM with TO.
158 (when (= (aref string idx) from)
159 (aset string idx to))
163 (defun mm-enable-multibyte ()
164 "Enable multibyte in the current buffer."
165 (when (fboundp 'set-buffer-multibyte)
166 (set-buffer-multibyte t)))
168 (defun mm-insert-rfc822-headers (charset encoding)
169 "Insert text/plain headers with CHARSET and ENCODING."
170 (insert "MIME-Version: 1.0\n")
171 (insert "Content-Type: text/plain; charset=\""
172 (downcase (symbol-name charset)) "\"\n")
173 (insert "Content-Transfer-Encoding: "
174 (downcase (symbol-name encoding)) "\n"))
176 (defun mm-content-type-charset (header)
177 "Return the charset parameter from HEADER."
178 (when (string-match "charset *= *\"? *\\([-0-9a-zA-Z_]+\\)\"? *$" header)
179 (intern (downcase (match-string 1 header)))))
183 ;;; mm-util.el ends here