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.
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))))
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))))
38 (if (fboundp 'encode-coding-region)
39 (fset 'mm-encode-coding-region 'encode-coding-region)
40 (fset 'mm-encode-coding-string 'ignore)))
43 (if (fboundp 'decode-coding-region)
44 (fset 'mm-decode-coding-region 'decode-coding-region)
45 (fset 'mm-decode-coding-string 'ignore)))
48 (if (fboundp 'coding-system-list)
49 (fset 'mm-coding-system-list 'coding-system-list)
50 (fset 'mm-coding-system-list 'ignore)))
53 (if (fboundp 'coding-system-equal)
54 (fset 'mm-coding-system-equal 'coding-system-equal)
55 (fset 'mm-coding-system-equal 'equal)))
57 (defvar mm-mime-mule-charset-alist
59 (iso-8859-1 latin-iso8859-1)
60 (iso-8859-2 latin-iso8859-2)
61 (iso-8859-3 latin-iso8859-3)
62 (iso-8859-4 latin-iso8859-4)
63 (iso-8859-5 cyrillic-iso8859-5)
64 (koi8-r cyrillic-iso8859-5)
65 (iso-8859-6 arabic-iso8859-6)
66 (iso-8859-7 greek-iso8859-7)
67 (iso-8859-8 hebrew-iso8859-8)
68 (iso-8859-9 latin-iso8859-9)
69 (iso-2022-jp latin-jisx0201
70 japanese-jisx0208-1978 japanese-jisx0208)
71 (euc-kr korean-ksc5601)
72 (cn-gb-2312 chinese-gb2312)
73 (cn-big5 chinese-big5-1 chinese-big5-2)
74 (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
75 latin-jisx0201 japanese-jisx0208-1978
76 chinese-gb2312 japanese-jisx0208
77 korean-ksc5601 japanese-jisx0212)
78 (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
79 latin-jisx0201 japanese-jisx0208-1978
80 chinese-gb2312 japanese-jisx0208
81 korean-ksc5601 japanese-jisx0212
82 chinese-cns11643-1 chinese-cns11643-2)
83 (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
84 cyrillic-iso8859-5 greek-iso8859-7
85 latin-jisx0201 japanese-jisx0208-1978
86 chinese-gb2312 japanese-jisx0208
87 korean-ksc5601 japanese-jisx0212
88 chinese-cns11643-1 chinese-cns11643-2
89 chinese-cns11643-3 chinese-cns11643-4
90 chinese-cns11643-5 chinese-cns11643-6
92 "Alist of MIME-charset/MULE-charsets.")
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.")
110 (defun mm-mule-charset-to-mime-charset (charset)
111 "Return the MIME charset corresponding to MULE CHARSET."
112 (let ((alist mm-mime-mule-charset-alist)
115 (when (memq charset (cdar alist))
116 (setq out (caar alist)
121 (defun mm-charset-to-coding-system (charset &optional lbt)
122 "Return coding-system corresponding to CHARSET.
123 CHARSET is a symbol naming a MIME charset.
124 If optional argument LBT (`unix', `dos' or `mac') is specified, it is
125 used as the line break code type of the coding system."
126 (when (stringp charset)
127 (setq charset (intern (downcase charset))))
129 (or (cdr (assq charset mm-charset-coding-system-alist))
132 (setq charset (intern (format "%s-%s" charset lbt))))
134 ;; Running in a non-MULE environment.
135 ((and (null (mm-coding-system-list))
136 (eq charset 'iso-8859-1))
138 ;; Check to see whether we can handle this charset.
139 ((memq charset (mm-coding-system-list))
145 (defun mm-replace-chars-in-string (string from to)
146 "Replace characters in STRING from FROM to TO."
147 (let ((string (substring string 0)) ;Copy string.
148 (len (length string))
150 ;; Replace all occurrences of FROM with TO.
152 (when (= (aref string idx) from)
153 (aset string idx to))
157 (defun mm-enable-multibyte ()
158 "Enable multibyte in the current buffer."
159 (when (fboundp 'set-buffer-multibyte)
160 (set-buffer-multibyte t)))
162 (defun mm-insert-rfc822-headers (charset encoding)
163 "Insert text/plain headers with CHARSET and ENCODING."
164 (insert "MIME-Version: 1.0\n")
165 (insert "Content-Type: text/plain; charset=\""
166 (downcase (symbol-name charset)) "\"\n")
167 (insert "Content-Transfer-Encoding: "
168 (downcase (symbol-name encoding)) "\n"))
170 (defun mm-content-type-charset (header)
171 "Return the charset parameter from HEADER."
172 (when (string-match "charset *= *\"? *\\([-0-9a-zA-Z_]+\\)\"? *$" header)
173 (intern (downcase (match-string 1 header)))))
175 (defun mm-read-coding-system (prompt)
176 "Prompt the user for a coding system."
178 prompt (mapcar (lambda (s) (list (symbol-name (car s))))
179 mm-mime-mule-charset-alist)))
183 ;;; mm-util.el ends here