913eb3ef867b0e92003fa88c51550e961a964bc1
[elisp/apel.git] / emu-x20.el
1 ;;; emu-x20.el --- emu API implementation for XEmacs with mule
2
3 ;; Copyright (C) 1994,1995,1996,1997,1998 MORIOKA Tomohiko
4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Keywords: emulation, compatibility, Mule, XEmacs
7
8 ;; This file is part of emu.
9
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.
14
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.
19
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.
24
25 ;;; Commentary:
26
27 ;;    This module requires XEmacs 20.3-b5 or later with mule.
28
29 ;;; Code:
30
31 (require 'emu-xemacs)
32 (require 'emu-20)
33
34
35 (and (coding-system-property 'iso-2022-jp 'input-charset-conversion)
36      (copy-coding-system 'iso-2022-7bit 'iso-2022-jp))
37
38
39 ;;; @ binary access
40 ;;;
41
42 (defun insert-binary-file-contents (filename &optional visit beg end replace)
43   "Like `insert-file-contents', q.v., but don't code and format conversion."
44   (let ((coding-system-for-read 'binary)
45         format-alist)
46     (insert-file-contents filename visit beg end replace)
47     ))
48
49 (defun insert-binary-file-contents-literally (filename
50                                               &optional visit beg end replace)
51   "Like `insert-file-contents-literally', q.v., but don't code conversion.
52 A buffer may be modified in several ways after reading into the buffer due
53 to advanced Emacs features, such as file-name-handlers, format decoding,
54 find-file-hooks, etc.
55   This function ensures that none of these modifications will take place."
56   (let ((coding-system-for-read 'binary))
57     (insert-file-contents-literally filename visit beg end replace)
58     ))
59
60     
61 ;;; @ MIME charset
62 ;;;
63
64 (defsubst encode-mime-charset-region (start end charset)
65   "Encode the text between START and END as MIME CHARSET."
66   (let ((cs (mime-charset-to-coding-system charset)))
67     (if cs
68         (encode-coding-region start end cs)
69       )))
70
71 (defsubst decode-mime-charset-region (start end charset)
72   "Decode the text between START and END as MIME CHARSET."
73   (let ((cs (mime-charset-to-coding-system charset)))
74     (if cs
75         (decode-coding-region start end cs)
76       )))
77
78 (defsubst encode-mime-charset-string (string charset)
79   "Encode the STRING as MIME CHARSET."
80   (let ((cs (mime-charset-to-coding-system charset)))
81     (if cs
82         (encode-coding-string string cs)
83       string)))
84
85 (defsubst decode-mime-charset-string (string charset)
86   "Decode the STRING as MIME CHARSET."
87   (let ((cs (mime-charset-to-coding-system charset)))
88     (if cs
89         (decode-coding-string string cs)
90       string)))
91
92
93 (defvar charsets-mime-charset-alist
94   '(((ascii)                                            . us-ascii)
95     ((ascii latin-iso8859-1)                            . iso-8859-1)
96     ((ascii latin-iso8859-2)                            . iso-8859-2)
97     ((ascii latin-iso8859-3)                            . iso-8859-3)
98     ((ascii latin-iso8859-4)                            . iso-8859-4)
99     ((ascii cyrillic-iso8859-5)                         . iso-8859-5)
100 ;;; ((ascii cyrillic-iso8859-5)                         . koi8-r)
101     ((ascii arabic-iso8859-6)                           . iso-8859-6)
102     ((ascii greek-iso8859-7)                            . iso-8859-7)
103     ((ascii hebrew-iso8859-8)                           . iso-8859-8)
104     ((ascii latin-iso8859-9)                            . iso-8859-9)
105     ((ascii latin-jisx0201
106             japanese-jisx0208-1978 japanese-jisx0208)   . iso-2022-jp)
107     ((ascii korean-ksc5601)                             . euc-kr)
108     ((ascii chinese-gb2312)                             . cn-gb-2312)
109     ((ascii chinese-big5-1 chinese-big5-2)              . cn-big5)
110     ((ascii latin-iso8859-1 greek-iso8859-7
111             latin-jisx0201 japanese-jisx0208-1978
112             chinese-gb2312 japanese-jisx0208
113             korean-ksc5601 japanese-jisx0212)           . iso-2022-jp-2)
114     ((ascii latin-iso8859-1 greek-iso8859-7
115             latin-jisx0201 japanese-jisx0208-1978
116             chinese-gb2312 japanese-jisx0208
117             korean-ksc5601 japanese-jisx0212
118             chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
119     ((ascii latin-iso8859-1 latin-iso8859-2
120             cyrillic-iso8859-5 greek-iso8859-7
121             latin-jisx0201 japanese-jisx0208-1978
122             chinese-gb2312 japanese-jisx0208
123             korean-ksc5601 japanese-jisx0212
124             chinese-cns11643-1 chinese-cns11643-2
125             chinese-cns11643-3 chinese-cns11643-4
126             chinese-cns11643-5 chinese-cns11643-6
127             chinese-cns11643-7)                         . iso-2022-int-1)
128     ))
129
130 (defun detect-mime-charset-region (start end)
131   "Return MIME charset for region between START and END."
132   (charsets-to-mime-charset (charsets-in-region start end)))
133
134
135 ;;; @ character
136 ;;;
137
138 ;;; @@ Mule emulating aliases
139 ;;;
140 ;;; You should not use them.
141
142 (defalias 'char-leading-char 'char-charset)
143
144 (defun char-category (character)
145   "Return string of category mnemonics for CHAR in TABLE.
146 CHAR can be any multilingual character
147 TABLE defaults to the current buffer's category table."
148   (mapconcat (lambda (chr)
149                (char-to-string (int-char chr))
150                )
151              (char-category-list character)
152              ""))
153
154
155 ;;; @ string
156 ;;;
157
158 (defun string-to-int-list (str)
159   (mapcar #'char-int str)
160   )
161
162
163 ;;; @ end
164 ;;;
165
166 (provide 'emu-x20)
167
168 ;;; emu-x20.el ends here