(GT-00010): Separate U+624D, G0-3245 and C1-445F; use
[chise/xemacs-chise.git] / lisp / mule / mule-charset.el
1 ;;; mule-charset.el --- Charset functions for Mule.
2
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Amdahl Corporation.
5 ;; Copyright (C) 1996 Sun Microsystems.
6 ;; Copyright (C) 1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko
7
8 ;; Author: Unknown
9 ;; Keywords: i18n, mule, internal
10
11 ;; This file is part of XEmacs.
12
13 ;; XEmacs is free software; you can redistribute it and/or modify it
14 ;; under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; any later version.
17
18 ;; XEmacs is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 ;; General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with XEmacs; see the file COPYING.  If not, write to the 
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
27
28 ;;; Synched up with: Not synched.  API at source level synched with FSF 20.3.9.
29
30 ;;; Commentary:
31
32 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
33 ;; and they never will be.  -sb [1999-05-26]
34
35 ;;; Code:
36 \f
37 ;;;; Classifying text according to charsets
38
39 (defun charsets-in-region (start end &optional buffer)
40   "Return a list of the charsets in the region between START and END.
41 BUFFER defaults to the current buffer if omitted."
42   (let (list)
43     (save-excursion
44       (if buffer
45           (set-buffer buffer))
46       (save-restriction
47         (narrow-to-region start end)
48         (goto-char (point-min))
49         (while (not (eobp))
50           (let* (prev-charset
51                  (ch (char-after (point)))
52                  (charset (char-charset ch)))
53             (if (not (eq prev-charset charset))
54                 (progn
55                   (setq prev-charset charset)
56                   (or (memq charset list)
57                       (setq list (cons charset list))))))
58           (forward-char))))
59     list))
60
61 (defun charsets-in-string (string)
62   "Return a list of the charsets in STRING."
63   (let ((i 0)
64         (len (length string))
65         prev-charset charset list)
66     (while (< i len)
67       (setq charset (char-charset (aref string i)))
68       (if (not (eq prev-charset charset))
69           (progn
70             (setq prev-charset charset)
71             (or (memq charset list)
72                 (setq list (cons charset list)))))
73       (setq i (1+ i)))
74     list))
75
76 \f
77 ;;;; Charset accessors
78
79 (defun charset-iso-graphic-plane (charset)
80   "Return the `graphic' property of CHARSET.
81 See `make-charset'."
82   (charset-property charset 'graphic))
83
84 (defun charset-iso-final-char (charset)
85   "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
86   (charset-property charset 'final))
87
88 (defun charset-chars (charset)
89   "Return the number of characters per dimension of CHARSET."
90   (charset-property charset 'chars))
91
92 (defun charset-width (charset)
93   "Return the number of display columns per character of CHARSET.
94 This only applies to TTY mode (under X, the actual display width can
95 be automatically determined)."
96   (charset-property charset 'columns))
97
98 ;; #### FSFmacs returns 0
99 (defun charset-direction (charset)
100   "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET.
101 Only left-to-right is currently implemented."
102   (if (eq (charset-property charset 'direction) 'l2r)
103       0
104     1))
105
106 ;; Not in Emacs/Mule
107 (defun charset-registry (charset)
108   "Return the registry of CHARSET.
109 This is a regular expression matching the registry field of fonts
110 that can display the characters in CHARSET."
111   (charset-property charset 'registry))
112
113 (defun charset-ccl-program (charset)
114   "Return the CCL program of CHARSET.
115 See `make-charset'."
116   (charset-property charset 'ccl-program))
117
118 (defun charset-bytes (charset)
119   "Useless in XEmacs, returns 1."
120    1)
121
122 (define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409
123 (define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409
124 (define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409
125 (define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409
126
127 ;;;; Define setf methods for all settable Charset properties
128
129 (defsetf charset-registry    set-charset-registry)
130 (defsetf charset-ccl-program set-charset-ccl-program)
131
132 ;;; FSF compatibility functions
133 (defun charset-after (&optional pos)
134   "Return charset of a character in current buffer at position POS.
135 If POS is nil, it defauls to the current point.
136 If POS is out of range, the value is nil."
137   (when (null pos)
138     (setq pos (point)))
139   (check-argument-type 'integerp pos)
140   (unless (or (< pos (point-min))
141               (> pos (point-max)))
142     (char-charset (char-after pos))))
143
144 ;; Yuck!
145 ;; We're not going to support this.
146 ;(defun charset-info (charset)
147 ;  "Return a vector of information of CHARSET.
148 ;The elements of the vector are:
149 ;        CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
150 ;        LEADING-CODE-BASE, LEADING-CODE-EXT,
151 ;        ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
152 ;        REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
153 ;        PLIST,
154 ;where
155 ;CHARSET-ID (integer) is the identification number of the charset.
156 ;BYTES (integer) is the length of multi-byte form of a character in
157 ;  the charset: one of 1, 2, 3, and 4.
158 ;DIMENSION (integer) is the number of bytes to represent a character of
159 ;the charset: 1 or 2.
160 ;CHARS (integer) is the number of characters in a dimension: 94 or 96.
161 ;WIDTH (integer) is the number of columns a character in the charset
162 ;  occupies on the screen: one of 0, 1, and 2.
163 ;DIRECTION (integer) is the rendering direction of characters in the
164 ;  charset when rendering.  If 0, render from left to right, else
165 ;  render from right to left.
166 ;LEADING-CODE-BASE (integer) is the base leading-code for the
167 ;  charset.
168 ;LEADING-CODE-EXT (integer) is the extended leading-code for the
169 ;  charset.  All charsets of less than 0xA0 has the value 0.
170 ;ISO-FINAL-CHAR (character) is the final character of the
171 ;  corresponding ISO 2022 charset.
172 ;ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
173 ;  while encoding to variants of ISO 2022 coding system, one of the
174 ;  following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
175 ;REVERSE-CHARSET (integer) is the charset which differs only in
176 ;  LEFT-TO-RIGHT value from the charset.  If there's no such a
177 ;  charset, the value is -1.
178 ;SHORT-NAME (string) is the short name to refer to the charset.
179 ;LONG-NAME (string) is the long name to refer to the charset
180 ;DESCRIPTION (string) is the description string of the charset.
181 ;PLIST (property list) may contain any type of information a user
182 ;  want to put and get by functions `put-charset-property' and
183 ;  `get-charset-property' respectively."
184 ;  (vector
185 ;   (charset-id charset)
186 ;   1
187 ;   (charset-dimension charset)
188 ;   (charset-chars charset)
189 ;   (charset-width charset)
190 ;   (charset-direction charset)
191 ;   nil ;; (charset-leading-code-base (charset))
192 ;   nil ;; (charset-leading-code-ext (charset))
193 ;   (charset-iso-final-char charset)
194 ;   (charset-iso-graphic-plane charset)
195 ;   -1
196 ;   (charset-short-name charset)
197 ;   (charset-long-name charset)
198 ;   (charset-description charset)
199 ;   (charset-plist charset)))
200
201 ;(make-compatible 'charset-info "Don't use this if you can help it.")
202
203 (defun define-charset (charset-id charset property-vector)
204   "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
205 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
206  treated as a private charset.
207 INFO-VECTOR is a vector of the format:
208    [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
209     SHORT-NAME LONG-NAME DESCRIPTION]
210 The meanings of each elements is as follows:
211 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
212 CHARS (integer) is the number of characters in a dimension: 94 or 96.
213 WIDTH (integer) is the number of columns a character in the charset
214 occupies on the screen: one of 0, 1, and 2.
215
216 DIRECTION (integer) is the rendering direction of characters in the
217 charset when rendering.  If 0, render from left to right, else
218 render from right to left.
219
220 ISO-FINAL-CHAR (character) is the final character of the
221 corresponding ISO 2022 charset.
222
223 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
224 while encoding to variants of ISO 2022 coding system, one of the
225 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
226
227
228 SHORT-NAME (string) is the short name to refer to the charset.
229
230 LONG-NAME (string) is the long name to refer to the charset.
231
232 DESCRIPTION (string) is the description string of the charset."
233   (make-charset charset (aref property-vector 8)
234                 (list
235                  'short-name (aref property-vector 6)
236                  'long-name (aref property-vector 7)
237                  'dimension (aref property-vector 0)
238                  'columns (aref property-vector 2)
239                  'chars (aref property-vector 1)
240                  'final (aref property-vector 4)
241                  'graphic (aref property-vector 5)
242                  'direction (aref property-vector 3))))
243
244 (make-compatible 'define-charset "")
245
246 ;;; Charset property
247
248 (defalias 'get-charset-property 'get)
249 (defalias 'put-charset-property 'put)
250 (defalias 'charset-plist 'object-plist)
251 (defalias 'set-charset-plist 'setplist)
252
253 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
254 ;; SPACE and NEWLIE are already set.
255 ;; (let ((l '(katakana-jisx0201
256 ;;            japanese-jisx0208 japanese-jisx0212
257 ;;            chinese-gb2312 chinese-big5-1 chinese-big5-2)))
258 ;;   (while l
259 ;;     (put-char-table (car l) t auto-fill-chars)
260 ;;     (setq l (cdr l))))
261
262
263 ;;; @ Coded character set
264 ;;;
265
266 (when (featurep 'utf-2000)
267   (setq default-coded-charset-priority-list
268         '(ascii
269           control-1
270           latin-iso8859-1
271           latin-iso8859-2
272           latin-iso8859-3
273           latin-iso8859-4
274           latin-iso8859-9
275           latin-jisx0201
276           cyrillic-iso8859-5
277           greek-iso8859-7
278           thai-tis620
279           =jis-x0208
280           =gt-pj-2
281           =gt-pj-3
282           =gt-pj-4
283           =gt-pj-5
284           =gt-pj-6
285           =gt-pj-7
286           =gt-pj-8
287           =gt-pj-9
288           =gt-pj-10
289           =gt-pj-11
290           =gt-pj-k1
291           =gt-pj-k2
292           =big5-cdp
293           japanese-jisx0208
294           =jis-x0208-1990
295           japanese-jisx0212
296           japanese-jisx0208-1978
297           chinese-gb2312
298           korean-ksc5601
299           chinese-cns11643-1
300           chinese-cns11643-2
301           chinese-cns11643-3
302           chinese-cns11643-4
303           chinese-cns11643-5
304           chinese-cns11643-6
305           chinese-cns11643-7
306           =jis-x0213-1-2000
307           =jis-x0213-2-2000
308           ;; chinese-gb12345
309           chinese-isoir165
310           katakana-jisx0201
311           hebrew-iso8859-8
312           latin-viscii
313           latin-viscii-lower
314           latin-viscii-upper
315           ipa
316           lao
317           ethiopic-ucs
318           ethiopic
319           arabic-digit
320           arabic-1-column
321           arabic-2-column
322           =gt-pj-1
323           chinese-big5-eten-a
324           chinese-big5-eten-b
325           chinese-big5
326           =ucs-radicals
327           =ucs-radicals@unicode
328           =ucs-bmp-cjk
329           =ucs-bmp-cjk@unicode
330           =ucs-sip-ext-b
331           =ucs-sip-ext-b@iso
332           =ruimoku-v6
333           ideograph-daikanwa-2
334           ideograph-daikanwa
335           =hanziku-1
336           =hanziku-2
337           =hanziku-3
338           =hanziku-4
339           =hanziku-5
340           =hanziku-6
341           =hanziku-7
342           =hanziku-8
343           =hanziku-9
344           =hanziku-10
345           =hanziku-11
346           =hanziku-12
347           =cbeta
348           ucs-bmp
349           =jef-china3
350           arabic-iso8859-6
351           chinese-big5-1
352           chinese-big5-2
353           ucs-sip)))
354
355 ;;; mule-charset.el ends here