1 ;;; emu-x20.el --- emu API implementation for XEmacs with mule
3 ;; Copyright (C) 1994,1995,1996,1997,1998 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Keywords: emulation, compatibility, Mule, XEmacs
8 ;; This file is part of emu.
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; This module requires XEmacs 20.3-b5 or later with mule.
31 ;; (require 'emu-xemacs)
35 (and (coding-system-property 'iso-2022-jp 'input-charset-conversion)
36 (copy-coding-system 'iso-2022-7bit 'iso-2022-jp))
42 (defun insert-file-contents-as-binary (filename
43 &optional visit beg end replace)
44 "Like `insert-file-contents', q.v., but don't code and format conversion.
45 Like `insert-file-contents-literary', but it allows find-file-hooks,
46 automatic uncompression, etc.
48 Namely this function ensures that only format decoding and character
49 code conversion will not take place."
50 (let ((coding-system-for-read 'binary)
52 (insert-file-contents filename visit beg end replace)
55 (define-obsolete-function-alias 'insert-binary-file-contents
56 'insert-file-contents-as-binary)
58 (defun insert-binary-file-contents-literally (filename
59 &optional visit beg end replace)
60 "Like `insert-file-contents-literally', q.v., but don't code conversion.
61 A buffer may be modified in several ways after reading into the buffer due
62 to advanced Emacs features, such as file-name-handlers, format decoding,
64 This function ensures that none of these modifications will take place."
65 (let ((coding-system-for-read 'binary))
66 (insert-file-contents-literally filename visit beg end replace)
73 (defun encode-mime-charset-region (start end charset)
74 "Encode the text between START and END as MIME CHARSET."
75 (let ((cs (mime-charset-to-coding-system charset)))
77 (encode-coding-region start end cs)
80 (defcustom mime-charset-decoder-alist
81 '((iso-2022-jp . decode-mime-charset-region-with-iso646-unification)
82 (iso-2022-jp-2 . decode-mime-charset-region-with-iso646-unification)
83 (x-ctext . decode-mime-charset-region-with-iso646-unification)
84 (hz-gb-2312 . decode-mime-charset-region-for-hz)
85 (t . decode-mime-charset-region-default))
86 "Alist MIME-charset vs. decoder function."
88 :type '(repeat (cons mime-charset function)))
90 (defsubst decode-mime-charset-region-default (start end charset)
91 (let ((cs (mime-charset-to-coding-system charset)))
93 (decode-coding-region start end cs)
96 (defcustom mime-iso646-character-unification-alist
101 (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
108 (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
113 "Alist unified string vs. canonical string."
115 :type '(repeat (cons string string)))
117 (defcustom mime-unified-character-face nil
118 "*Face of unified character."
122 (defun decode-mime-charset-region-with-iso646-unification (start end charset)
123 (decode-mime-charset-region-default start end charset)
125 (let ((rest mime-iso646-character-unification-alist))
127 (let ((pair (car rest)))
128 (goto-char (point-min))
129 (while (search-forward (car pair) nil t)
130 (let ((str (cdr pair)))
131 (put-text-property 0 (length str)
132 'face mime-unified-character-face str)
133 (replace-match str 'fixed-case 'literal)
136 (setq rest (cdr rest))))))
138 (defun decode-mime-charset-region-for-hz (start end charset)
139 (decode-hz-region start end))
141 (defun decode-mime-charset-region (start end charset)
142 "Decode the text between START and END as MIME CHARSET."
143 (if (stringp charset)
144 (setq charset (intern (downcase charset)))
146 (let ((func (cdr (or (assq charset mime-charset-decoder-alist)
147 (assq t mime-charset-decoder-alist)))))
148 (funcall func start end charset)
151 (defsubst encode-mime-charset-string (string charset)
152 "Encode the STRING as MIME CHARSET."
153 (let ((cs (mime-charset-to-coding-system charset)))
155 (encode-coding-string string cs)
158 ;; (defsubst decode-mime-charset-string (string charset)
159 ;; "Decode the STRING as MIME CHARSET."
160 ;; (let ((cs (mime-charset-to-coding-system charset)))
162 ;; (decode-coding-string string cs)
164 (defun decode-mime-charset-string (string charset)
165 "Decode the STRING as MIME CHARSET."
168 (decode-mime-charset-region (point-min)(point-max) charset)
173 (defvar charsets-mime-charset-alist
174 '(((ascii) . us-ascii)
175 ((ascii latin-iso8859-1) . iso-8859-1)
176 ((ascii latin-iso8859-2) . iso-8859-2)
177 ((ascii latin-iso8859-3) . iso-8859-3)
178 ((ascii latin-iso8859-4) . iso-8859-4)
179 ((ascii cyrillic-iso8859-5) . iso-8859-5)
180 ;;; ((ascii cyrillic-iso8859-5) . koi8-r)
181 ((ascii arabic-iso8859-6) . iso-8859-6)
182 ((ascii greek-iso8859-7) . iso-8859-7)
183 ((ascii hebrew-iso8859-8) . iso-8859-8)
184 ((ascii latin-iso8859-9) . iso-8859-9)
185 ((ascii latin-jisx0201
186 japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
187 ((ascii latin-jisx0201
188 katakana-jisx0201 japanese-jisx0208) . shift_jis)
189 ((ascii korean-ksc5601) . euc-kr)
190 ((ascii chinese-gb2312) . cn-gb-2312)
191 ((ascii chinese-big5-1 chinese-big5-2) . cn-big5)
192 ((ascii latin-iso8859-1 greek-iso8859-7
193 latin-jisx0201 japanese-jisx0208-1978
194 chinese-gb2312 japanese-jisx0208
195 korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
196 ((ascii latin-iso8859-1 greek-iso8859-7
197 latin-jisx0201 japanese-jisx0208-1978
198 chinese-gb2312 japanese-jisx0208
199 korean-ksc5601 japanese-jisx0212
200 chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
201 ((ascii latin-iso8859-1 latin-iso8859-2
202 cyrillic-iso8859-5 greek-iso8859-7
203 latin-jisx0201 japanese-jisx0208-1978
204 chinese-gb2312 japanese-jisx0208
205 korean-ksc5601 japanese-jisx0212
206 chinese-cns11643-1 chinese-cns11643-2
207 chinese-cns11643-3 chinese-cns11643-4
208 chinese-cns11643-5 chinese-cns11643-6
209 chinese-cns11643-7) . iso-2022-int-1)
212 (defun detect-mime-charset-region (start end)
213 "Return MIME charset for region between START and END."
214 (charsets-to-mime-charset (charsets-in-region start end)))
220 (defmacro char-next-index (char index)
221 "Return index of character succeeding CHAR whose index is INDEX."
224 ;;; @@ Mule emulating aliases
226 ;;; You should not use them.
228 ;;(defalias 'char-leading-char 'char-charset)
230 (defun char-category (character)
231 "Return string of category mnemonics for CHAR in TABLE.
232 CHAR can be any multilingual character
233 TABLE defaults to the current buffer's category table."
234 (mapconcat (lambda (chr)
235 (char-to-string (int-char chr))
237 (char-category-list character)
244 (defun string-to-int-list (str)
245 (mapcar #'char-int str)
254 ;;; emu-x20.el ends here