Mercurial > hg > xemacs-beta

comparison lisp/apel/emu-x20.el @ 155:43dd3413c7c7 r20-3b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b4
author cvs
date Mon, 13 Aug 2007 09:39:39 +0200
parents
children 3bb7ccffb0c0
comparison
equal deleted inserted replaced
154:94141801dd7e 155:43dd3413c7c7
1 ;;; emu-x20.el --- emu API implementation for XEmacs 20 with mule
2
3 ;; Copyright (C) 1994,1995,1996,1997 MORIOKA Tomohiko
4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Version: $Id: emu-x20.el,v 1.1 1997/06/03 04:18:35 steve Exp $
7 ;; Keywords: emulation, compatibility, Mule, XEmacs
8
9 ;; This file is part of XEmacs.
10
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
15
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU XEmacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Commentary:
27
28 ;; This module requires XEmacs 20.1 b12 or later with mule.
29
30 ;;; Code:
31
32 (require 'cyrillic)
33 (require 'emu-xemacs)
34
35
36 ;;; @ coding-system
37 ;;;
38
39 (defconst *noconv* 'binary)
40
41 (defmacro as-binary-process (&rest body)
42 `(let (selective-display ; Disable ^M to nl translation.
43 (coding-system-for-read 'binary)
44 (coding-system-for-write 'binary))
45 ,@body))
46
47 (defmacro as-binary-input-file (&rest body)
48 `(let ((coding-system-for-read 'binary))
49 ,@body))
50
51 (defmacro as-binary-output-file (&rest body)
52 `(let ((coding-system-for-write 'binary))
53 ,@body))
54
55
56 ;;; @ binary access
57 ;;;
58
59 (defun insert-binary-file-contents-literally
60 (filename &optional visit beg end replace)
61 "Like `insert-file-contents-literally', q.v., but don't code conversion.
62 A buffer may be modified in several ways after reading into the buffer due
63 to advanced Emacs features, such as file-name-handlers, format decoding,
64 find-file-hooks, etc.
65 This function ensures that none of these modifications will take place."
66 (let ((coding-system-for-read 'binary))
67 (insert-file-contents-literally filename visit beg end replace)
68 ))
69
70
71 ;;; @ MIME charset
72 ;;;
73
74 (defvar charsets-mime-charset-alist
75 '(((ascii) . us-ascii)
76 ((ascii latin-iso8859-1) . iso-8859-1)
77 ((ascii latin-iso8859-2) . iso-8859-2)
78 ((ascii latin-iso8859-3) . iso-8859-3)
79 ((ascii latin-iso8859-4) . iso-8859-4)
80 ;;; ((ascii cyrillic-iso8859-5) . iso-8859-5)
81 ((ascii cyrillic-iso8859-5) . koi8-r)
82 ((ascii arabic-iso8859-6) . iso-8859-6)
83 ((ascii greek-iso8859-7) . iso-8859-7)
84 ((ascii hebrew-iso8859-8) . iso-8859-8)
85 ((ascii latin-iso8859-9) . iso-8859-9)
86 ((ascii latin-jisx0201
87 japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
88 ((ascii korean-ksc5601) . euc-kr)
89 ((ascii chinese-gb2312) . cn-gb-2312)
90 ((ascii chinese-big5-1 chinese-big5-2) . cn-big5)
91 ((ascii latin-iso8859-1 greek-iso8859-7
92 latin-jisx0201 japanese-jisx0208-1978
93 chinese-gb2312 japanese-jisx0208
94 korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
95 ((ascii latin-iso8859-1 greek-iso8859-7
96 latin-jisx0201 japanese-jisx0208-1978
97 chinese-gb2312 japanese-jisx0208
98 korean-ksc5601 japanese-jisx0212
99 chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
100 ((ascii latin-iso8859-1 latin-iso8859-2
101 cyrillic-iso8859-5 greek-iso8859-7
102 latin-jisx0201 japanese-jisx0208-1978
103 chinese-gb2312 japanese-jisx0208
104 korean-ksc5601 japanese-jisx0212
105 chinese-cns11643-1 chinese-cns11643-2
106 chinese-cns11643-3 chinese-cns11643-4
107 chinese-cns11643-5 chinese-cns11643-6
108 chinese-cns11643-7) . iso-2022-int-1)
109 ))
110
111 (defvar default-mime-charset 'x-ctext)
112
113 (defvar mime-charset-coding-system-alist
114 '((iso-8859-1 . ctext)
115 (x-ctext . ctext)
116 (hz-gb-2312 . hz)
117 (cn-gb-2312 . euc-china)
118 (gb2312 . euc-china)
119 (cn-big5 . big5)
120 (koi8-r . koi8)
121 (iso-2022-jp-2 . iso-2022-ss2-7)
122 ))
123
124 (defun mime-charset-to-coding-system (charset)
125 "Return coding-system by MIME charset."
126 (if (stringp charset)
127 (setq charset (intern (downcase charset)))
128 )
129 (or (cdr (assq charset mime-charset-coding-system-alist))
130 (and (memq charset (coding-system-list)) charset)
131 ))
132
133 (defun detect-mime-charset-region (start end)
134 "Return MIME charset for region between START and END."
135 (charsets-to-mime-charset (charsets-in-region start end)))
136
137 (defun encode-mime-charset-region (start end charset)
138 "Encode the text between START and END as MIME CHARSET."
139 (let ((cs (mime-charset-to-coding-system charset)))
140 (if cs
141 (encode-coding-region start end cs)
142 )))
143
144 (defun decode-mime-charset-region (start end charset)
145 "Decode the text between START and END as MIME CHARSET."
146 (let ((cs (mime-charset-to-coding-system charset)))
147 (if cs
148 (decode-coding-region start end cs)
149 )))
150
151 (defun encode-mime-charset-string (string charset)
152 "Encode the STRING as MIME CHARSET."
153 (let ((cs (mime-charset-to-coding-system charset)))
154 (if cs
155 (encode-coding-string string cs)
156 string)))
157
158 (defun decode-mime-charset-string (string charset)
159 "Decode the STRING as MIME CHARSET."
160 (let ((cs (mime-charset-to-coding-system charset)))
161 (if cs
162 (decode-coding-string string cs)
163 string)))
164
165
166 ;;; @ character
167 ;;;
168
169 ;;; @@ Mule emulating aliases
170 ;;;
171 ;;; You should not use them.
172
173 (defalias 'char-leading-char 'char-charset)
174
175 (defun char-category (character)
176 "Return string of category mnemonics for CHAR in TABLE.
177 CHAR can be any multilingual character
178 TABLE defaults to the current buffer's category table."
179 (mapconcat (lambda (chr)
180 (char-to-string (int-char chr))
181 )
182 (char-category-list character)
183 ""))
184
185
186 ;;; @ string
187 ;;;
188
189 (defun string-to-int-list (str)
190 (mapcar #'char-int str)
191 )
192
193
194 ;;; @ end
195 ;;;
196
197 (provide 'emu-x20)
198
199 ;;; emu-x20.el ends here