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-known-charsets '(iso-8859-1)
28 "List of known charsets.")
30 (defvar mm-mime-mule-charset-alist
32 (iso-8859-1 latin-iso8859-1)
33 (iso-8859-2 latin-iso8859-2)
34 (iso-8859-3 latin-iso8859-3)
35 (iso-8859-4 latin-iso8859-4)
36 (iso-8859-5 cyrillic-iso8859-5)
37 (koi8-r cyrillic-iso8859-5)
38 (iso-8859-6 arabic-iso8859-6)
39 (iso-8859-7 greek-iso8859-7)
40 (iso-8859-8 hebrew-iso8859-8)
41 (iso-8859-9 latin-iso8859-9)
42 (iso-2022-jp latin-jisx0201
43 japanese-jisx0208-1978 japanese-jisx0208)
44 (euc-kr korean-ksc5601)
45 (cn-gb-2312 chinese-gb2312)
46 (cn-big5 chinese-big5-1 chinese-big5-2)
47 (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
48 latin-jisx0201 japanese-jisx0208-1978
49 chinese-gb2312 japanese-jisx0208
50 korean-ksc5601 japanese-jisx0212)
51 (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
52 latin-jisx0201 japanese-jisx0208-1978
53 chinese-gb2312 japanese-jisx0208
54 korean-ksc5601 japanese-jisx0212
55 chinese-cns11643-1 chinese-cns11643-2)
56 (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
57 cyrillic-iso8859-5 greek-iso8859-7
58 latin-jisx0201 japanese-jisx0208-1978
59 chinese-gb2312 japanese-jisx0208
60 korean-ksc5601 japanese-jisx0212
61 chinese-cns11643-1 chinese-cns11643-2
62 chinese-cns11643-3 chinese-cns11643-4
63 chinese-cns11643-5 chinese-cns11643-6
65 "Alist of MIME-charset/MULE-charsets.")
71 (let ((nfunc (intern (format "mm-%s" (car elem)))))
72 (if (fboundp (car elem))
73 (fset nfunc (car elem))
74 (fset nfunc (cdr elem)))))
75 '((decode-coding-string . (lambda (s a) s))
76 (encode-coding-string . (lambda (s a) s))
77 (encode-coding-region . ignore)
78 (decode-coding-region . ignore)
79 (coding-system-list . ignore)
81 (device-type . ignore)
82 (coding-system-equal . equal)
83 (annotationp . ignore)
85 . (lambda (charset int)
89 "Prompt the user for a coding system."
91 prompt (mapcar (lambda (s) (list (symbol-name (car s))))
92 mm-mime-mule-charset-alist)))))))
94 (defvar mm-charset-coding-system-alist
96 '((us-ascii . iso-8859-1)
98 (iso-2022-jp-2 . iso-2022-7bit-ss2)
100 (systems (mm-coding-system-list))
103 (let ((pair (car rest)))
104 (unless (memq (car pair) systems)
105 (setq dest (cons pair dest))))
106 (setq rest (cdr rest)))
108 "Charset/coding system alist.")
111 (defun mm-mule-charset-to-mime-charset (charset)
112 "Return the MIME charset corresponding to MULE CHARSET."
113 (let ((alist mm-mime-mule-charset-alist)
116 (when (memq charset (cdar alist))
117 (setq out (caar alist)
122 (defun mm-charset-to-coding-system (charset &optional lbt)
123 "Return coding-system corresponding to CHARSET.
124 CHARSET is a symbol naming a MIME charset.
125 If optional argument LBT (`unix', `dos' or `mac') is specified, it is
126 used as the line break code type of the coding system."
127 (when (stringp charset)
128 (setq charset (intern (downcase charset))))
130 (or (cdr (assq charset mm-charset-coding-system-alist))
133 (setq charset (intern (format "%s-%s" charset lbt))))
135 ;; Running in a non-MULE environment.
136 ((and (null (mm-coding-system-list))
137 (memq charset mm-known-charsets))
139 ;; Check to see whether we can handle this charset.
140 ((memq charset (mm-coding-system-list))
146 (defun mm-replace-chars-in-string (string from to)
147 "Replace characters in STRING from FROM to TO."
148 (let ((string (substring string 0)) ;Copy string.
149 (len (length string))
151 ;; Replace all occurrences of FROM with TO.
153 (when (= (aref string idx) from)
154 (aset string idx to))
158 (defsubst mm-enable-multibyte ()
159 "Enable multibyte in the current buffer."
160 (when (fboundp 'set-buffer-multibyte)
161 (set-buffer-multibyte t)))
163 (defun mm-insert-rfc822-headers (charset encoding)
164 "Insert text/plain headers with CHARSET and ENCODING."
165 (insert "MIME-Version: 1.0\n")
166 (insert "Content-Type: text/plain; charset=\""
167 (downcase (symbol-name charset)) "\"\n")
168 (insert "Content-Transfer-Encoding: "
169 (downcase (symbol-name encoding)) "\n"))
171 (defun mm-mime-charset (charset b e)
172 (if (fboundp 'coding-system-get)
175 (get-charset-property charset 'prefered-coding-system)
177 (car (memq charset (find-coding-systems-region
178 (point-min) (point-max)))))
179 (mm-mule-charset-to-mime-charset charset)))
181 (defsubst mm-multibyte-p ()
182 "Say whether multibyte is enabled."
183 (and (boundp 'enable-multibyte-characters)
184 enable-multibyte-characters))
186 (defmacro mm-with-unibyte-buffer (&rest forms)
187 "Create a temporary buffer, and evaluate FORMS there like `progn'.
188 See also `with-temp-file' and `with-output-to-string'."
189 (let ((temp-buffer (make-symbol "temp-buffer"))
190 (multibyte (make-symbol "multibyte")))
191 `(if (not (boundp 'enable-multibyte-characters))
192 (with-temp-buffer ,@forms)
193 (let ((,multibyte (default-value enable-multibyte-characters))
195 (setq-default enable-multibyte-characters nil)
197 (get-buffer-create (generate-new-buffer-name " *temp*")))
199 (with-current-buffer ,temp-buffer
201 (and (buffer-name ,temp-buffer)
202 (kill-buffer ,temp-buffer))
203 (setq-default enable-multibyte-characters ,multibyte))))))
207 ;;; mm-util.el ends here