Mercurial > hg > xemacs-beta
annotate src/mule-charset.c @ 5178:97eb4942aec8
merge
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 29 Mar 2010 21:28:13 -0500 |
parents | 8b2f75cecb89 1fae11d56ad2 |
children | 71ee43b8a74d |
rev | line source |
---|---|
428 | 1 /* Functions to handle multilingual characters. |
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc. | |
3 Copyright (C) 1995 Sun Microsystems, Inc. | |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
4 Copyright (C) 2001, 2002, 2004, 2005, 2010 Ben Wing. |
428 | 5 |
6 This file is part of XEmacs. | |
7 | |
8 XEmacs is free software; you can redistribute it and/or modify it | |
9 under the terms of the GNU General Public License as published by the | |
10 Free Software Foundation; either version 2, or (at your option) any | |
11 later version. | |
12 | |
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
19 along with XEmacs; see the file COPYING. If not, write to | |
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 Boston, MA 02111-1307, USA. */ | |
22 | |
23 /* Synched up with: FSF 20.3. Not in FSF. */ | |
24 | |
25 /* Rewritten by Ben Wing <ben@xemacs.org>. */ | |
26 | |
27 #include <config.h> | |
28 #include "lisp.h" | |
29 | |
30 #include "buffer.h" | |
31 #include "chartab.h" | |
32 #include "elhash.h" | |
33 #include "device.h" | |
34 #include "faces.h" | |
771 | 35 #include "lstream.h" |
428 | 36 #include "mule-ccl.h" |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
37 #include "fontcolor.h" |
3659 | 38 #include "specifier.h" |
428 | 39 |
40 /* The various pre-defined charsets. */ | |
41 | |
42 Lisp_Object Vcharset_ascii; | |
43 Lisp_Object Vcharset_control_1; | |
44 Lisp_Object Vcharset_latin_iso8859_1; | |
45 Lisp_Object Vcharset_latin_iso8859_2; | |
46 Lisp_Object Vcharset_latin_iso8859_3; | |
47 Lisp_Object Vcharset_latin_iso8859_4; | |
48 Lisp_Object Vcharset_thai_tis620; | |
49 Lisp_Object Vcharset_greek_iso8859_7; | |
4805
980575c76541
Move the arabic-iso8859-6 character set back to C, otherwise X11 lookup fails.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4745
diff
changeset
|
50 Lisp_Object Vcharset_arabic_iso8859_6; |
428 | 51 Lisp_Object Vcharset_hebrew_iso8859_8; |
52 Lisp_Object Vcharset_katakana_jisx0201; | |
53 Lisp_Object Vcharset_latin_jisx0201; | |
54 Lisp_Object Vcharset_cyrillic_iso8859_5; | |
55 Lisp_Object Vcharset_latin_iso8859_9; | |
728 | 56 Lisp_Object Vcharset_latin_iso8859_15; |
428 | 57 Lisp_Object Vcharset_japanese_jisx0208_1978; |
58 Lisp_Object Vcharset_chinese_gb2312; | |
59 Lisp_Object Vcharset_japanese_jisx0208; | |
60 Lisp_Object Vcharset_korean_ksc5601; | |
61 Lisp_Object Vcharset_japanese_jisx0212; | |
62 Lisp_Object Vcharset_chinese_cns11643_1; | |
63 Lisp_Object Vcharset_chinese_cns11643_2; | |
64 Lisp_Object Vcharset_chinese_big5_1; | |
65 Lisp_Object Vcharset_chinese_big5_2; | |
66 Lisp_Object Vcharset_composite; | |
67 | |
68 struct charset_lookup *chlook; | |
69 | |
1204 | 70 static const struct memory_description charset_lookup_description_1[] = { |
771 | 71 { XD_LISP_OBJECT_ARRAY, offsetof (struct charset_lookup, charset_by_leading_byte), NUM_LEADING_BYTES+4*128*2 }, |
428 | 72 { XD_END } |
73 }; | |
74 | |
1204 | 75 static const struct sized_memory_description charset_lookup_description = { |
440 | 76 sizeof (struct charset_lookup), |
428 | 77 charset_lookup_description_1 |
78 }; | |
79 | |
80 Lisp_Object Qcharsetp; | |
81 | |
3664 | 82 /* Qdoc_string, Qdimension, Qchars, Qfinal defined in general.c */ |
83 Lisp_Object Qregistries, Qgraphic, Qregistry; | |
428 | 84 Lisp_Object Qdirection; |
85 Lisp_Object Qreverse_direction_charset; | |
86 Lisp_Object Qshort_name, Qlong_name; | |
87 | |
4691
3ba90c659d01
Move Qfrom_unicode to general-slots.h, fix the native Win32 build.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4491
diff
changeset
|
88 Lisp_Object Qto_unicode; |
771 | 89 |
90 Lisp_Object | |
428 | 91 Qlatin_iso8859_1, |
92 Qlatin_iso8859_2, | |
93 Qlatin_iso8859_3, | |
94 Qlatin_iso8859_4, | |
95 Qthai_tis620, | |
96 Qgreek_iso8859_7, | |
4805
980575c76541
Move the arabic-iso8859-6 character set back to C, otherwise X11 lookup fails.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4745
diff
changeset
|
97 Qarabic_iso8859_6, |
428 | 98 Qhebrew_iso8859_8, |
99 Qkatakana_jisx0201, | |
100 Qlatin_jisx0201, | |
101 Qcyrillic_iso8859_5, | |
102 Qlatin_iso8859_9, | |
728 | 103 Qlatin_iso8859_15, |
428 | 104 Qjapanese_jisx0208_1978, |
105 Qchinese_gb2312, | |
106 Qjapanese_jisx0208, | |
107 Qkorean_ksc5601, | |
108 Qjapanese_jisx0212, | |
109 Qchinese_cns11643_1, | |
110 Qchinese_cns11643_2, | |
111 Qchinese_big5_1, | |
112 Qchinese_big5_2, | |
113 Qcomposite; | |
114 | |
115 Lisp_Object Ql2r, Qr2l; | |
116 | |
117 Lisp_Object Vcharset_hash_table; | |
118 | |
119 | |
120 /************************************************************************/ | |
121 /* charset object */ | |
122 /************************************************************************/ | |
123 | |
124 static Lisp_Object | |
125 mark_charset (Lisp_Object obj) | |
126 { | |
440 | 127 Lisp_Charset *cs = XCHARSET (obj); |
428 | 128 |
129 mark_object (cs->short_name); | |
130 mark_object (cs->long_name); | |
131 mark_object (cs->doc_string); | |
3659 | 132 mark_object (cs->registries); |
428 | 133 mark_object (cs->ccl_program); |
134 return cs->name; | |
135 } | |
136 | |
137 static void | |
2286 | 138 print_charset (Lisp_Object obj, Lisp_Object printcharfun, |
139 int UNUSED (escapeflag)) | |
428 | 140 { |
440 | 141 Lisp_Charset *cs = XCHARSET (obj); |
428 | 142 |
143 if (print_readably) | |
5142
f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
144 printing_unreadable_lisp_object |
4846 | 145 (obj, XSTRING_DATA (XSYMBOL (XCHARSET_NAME (obj))->name)); |
428 | 146 |
771 | 147 write_fmt_string_lisp (printcharfun, "#<charset %s %S %S %S", 4, |
148 CHARSET_NAME (cs), CHARSET_SHORT_NAME (cs), | |
149 CHARSET_LONG_NAME (cs), CHARSET_DOC_STRING (cs)); | |
150 write_fmt_string (printcharfun, " %s %s cols=%d g%d final='%c' reg=", | |
151 CHARSET_TYPE (cs) == CHARSET_TYPE_94 ? "94" : | |
152 CHARSET_TYPE (cs) == CHARSET_TYPE_96 ? "96" : | |
153 CHARSET_TYPE (cs) == CHARSET_TYPE_94X94 ? "94x94" : | |
154 "96x96", | |
155 CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? "l2r" : | |
156 "r2l", | |
157 CHARSET_COLUMNS (cs), | |
158 CHARSET_GRAPHIC (cs), | |
159 CHARSET_FINAL (cs)); | |
3659 | 160 print_internal (CHARSET_REGISTRIES (cs), printcharfun, 0); |
5146
88bd4f3ef8e4
make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
161 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
771 | 162 } |
163 | |
1204 | 164 static const struct memory_description charset_description[] = { |
165 { XD_INT, offsetof (Lisp_Charset, dimension) }, | |
166 { XD_INT, offsetof (Lisp_Charset, from_unicode_levels) }, | |
440 | 167 { XD_LISP_OBJECT, offsetof (Lisp_Charset, name) }, |
168 { XD_LISP_OBJECT, offsetof (Lisp_Charset, doc_string) }, | |
3659 | 169 { XD_LISP_OBJECT, offsetof (Lisp_Charset, registries) }, |
440 | 170 { XD_LISP_OBJECT, offsetof (Lisp_Charset, short_name) }, |
171 { XD_LISP_OBJECT, offsetof (Lisp_Charset, long_name) }, | |
172 { XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) }, | |
173 { XD_LISP_OBJECT, offsetof (Lisp_Charset, ccl_program) }, | |
771 | 174 { XD_UNION, offsetof (Lisp_Charset, to_unicode_table), |
2775 | 175 XD_INDIRECT (0, 0), { &to_unicode_description }, XD_FLAG_NO_KKCC }, |
771 | 176 { XD_UNION, offsetof (Lisp_Charset, from_unicode_table), |
2775 | 177 XD_INDIRECT (1, 0), { &from_unicode_description }, XD_FLAG_NO_KKCC }, |
428 | 178 { XD_END } |
179 }; | |
180 | |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
181 DEFINE_DUMPABLE_LISP_OBJECT ("charset", charset, |
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
182 mark_charset, print_charset, 0, |
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
183 0, 0, charset_description, Lisp_Charset); |
428 | 184 /* Make a new charset. */ |
446 | 185 /* #### SJT Should generic properties be allowed? */ |
428 | 186 static Lisp_Object |
771 | 187 make_charset (int id, Lisp_Object name, int rep_bytes, |
188 int type, int columns, int graphic, | |
867 | 189 Ibyte final, int direction, Lisp_Object short_name, |
428 | 190 Lisp_Object long_name, Lisp_Object doc, |
3439 | 191 Lisp_Object reg, int overwrite, int encode_as_utf_8) |
428 | 192 { |
193 Lisp_Object obj; | |
771 | 194 Lisp_Charset *cs; |
195 | |
196 if (!overwrite) | |
197 { | |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
198 obj = ALLOC_NORMAL_LISP_OBJECT (charset); |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
199 cs = XCHARSET (obj); |
771 | 200 |
201 if (final) | |
202 { | |
203 /* some charsets do not have final characters. This includes | |
204 ASCII, Control-1, Composite, and the two faux private | |
205 charsets. */ | |
206 assert (NILP (chlook-> | |
207 charset_by_attributes[type][final][direction])); | |
208 chlook->charset_by_attributes[type][final][direction] = obj; | |
209 } | |
440 | 210 |
771 | 211 assert (NILP (chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE])); |
212 chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE] = obj; | |
213 } | |
214 else | |
215 { | |
216 Lisp_Object ret; | |
217 /* Actually overwrite the properties of the existing charset. | |
218 We do this because until now charsets could never be "deleted", | |
219 so parts of the code don't bother to GC charsets. */ | |
220 obj = chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE]; | |
221 cs = XCHARSET (obj); | |
222 assert (EQ (chlook->charset_by_attributes[type][final][direction], | |
223 obj)); | |
224 | |
225 ret = Fremhash (XCHARSET_NAME (obj), Vcharset_hash_table); | |
226 assert (!NILP (ret)); | |
227 } | |
428 | 228 |
229 CHARSET_ID (cs) = id; | |
230 CHARSET_NAME (cs) = name; | |
231 CHARSET_SHORT_NAME (cs) = short_name; | |
232 CHARSET_LONG_NAME (cs) = long_name; | |
233 CHARSET_REP_BYTES (cs) = rep_bytes; | |
234 CHARSET_DIRECTION (cs) = direction; | |
235 CHARSET_TYPE (cs) = type; | |
236 CHARSET_COLUMNS (cs) = columns; | |
237 CHARSET_GRAPHIC (cs) = graphic; | |
238 CHARSET_FINAL (cs) = final; | |
239 CHARSET_DOC_STRING (cs) = doc; | |
3659 | 240 CHECK_VECTOR(reg); |
241 CHARSET_REGISTRIES (cs) = reg; | |
3439 | 242 CHARSET_ENCODE_AS_UTF_8 (cs) = encode_as_utf_8 ? 1 : 0; |
428 | 243 CHARSET_CCL_PROGRAM (cs) = Qnil; |
244 CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil; | |
245 | |
771 | 246 CHARSET_DIMENSION (cs) = (CHARSET_TYPE (cs) == CHARSET_TYPE_94 || |
247 CHARSET_TYPE (cs) == CHARSET_TYPE_96) ? 1 : 2; | |
248 CHARSET_CHARS (cs) = (CHARSET_TYPE (cs) == CHARSET_TYPE_94 || | |
249 CHARSET_TYPE (cs) == CHARSET_TYPE_94X94) ? 94 : 96; | |
428 | 250 |
771 | 251 if (id == LEADING_BYTE_ASCII || id == LEADING_BYTE_CONTROL_1 |
252 #ifdef ENABLE_COMPOSITE_CHARS | |
253 || id == LEADING_BYTE_COMPOSITE | |
254 #endif | |
255 ) | |
256 assert (!overwrite); | |
257 else | |
428 | 258 { |
771 | 259 if (overwrite) |
260 free_charset_unicode_tables (obj); | |
261 init_charset_unicode_tables (obj); | |
428 | 262 } |
263 | |
264 /* Some charsets are "faux" and don't have names or really exist at | |
265 all except in the leading-byte table. */ | |
266 if (!NILP (name)) | |
771 | 267 { |
268 assert (NILP (Fgethash (name, Vcharset_hash_table, Qnil))); | |
269 Fputhash (name, obj, Vcharset_hash_table); | |
270 } | |
271 | |
272 recalculate_unicode_precedence (); | |
3659 | 273 setup_charset_initial_specifier_tags (obj); |
274 | |
428 | 275 return obj; |
276 } | |
277 | |
278 static int | |
279 get_unallocated_leading_byte (int dimension) | |
280 { | |
281 int lb; | |
282 | |
283 if (dimension == 1) | |
284 { | |
771 | 285 if (chlook->next_allocated_1_byte_leading_byte > |
286 MAX_LEADING_BYTE_PRIVATE_1) | |
428 | 287 lb = 0; |
288 else | |
442 | 289 lb = chlook->next_allocated_1_byte_leading_byte++; |
428 | 290 } |
291 else | |
292 { | |
1747 | 293 /* awfully fragile, but correct */ |
294 #if MAX_LEADING_BYTE_PRIVATE_2 == 255 | |
295 if (chlook->next_allocated_2_byte_leading_byte == 0) | |
1749 | 296 #else |
771 | 297 if (chlook->next_allocated_2_byte_leading_byte > |
298 MAX_LEADING_BYTE_PRIVATE_2) | |
1747 | 299 #endif |
428 | 300 lb = 0; |
301 else | |
442 | 302 lb = chlook->next_allocated_2_byte_leading_byte++; |
428 | 303 } |
304 | |
305 if (!lb) | |
563 | 306 invalid_operation |
771 | 307 ("No more character sets free for this dimension", make_int (dimension)); |
428 | 308 |
309 return lb; | |
310 } | |
311 | |
312 | |
313 /************************************************************************/ | |
314 /* Basic charset Lisp functions */ | |
315 /************************************************************************/ | |
316 | |
788 | 317 void |
318 get_charset_limits (Lisp_Object charset, int *low, int *high) | |
319 { | |
320 Lisp_Charset *cs = XCHARSET (charset); | |
321 | |
322 if (EQ (charset, Vcharset_ascii)) *low = 0, *high = 127; | |
323 else if (EQ (charset, Vcharset_control_1)) *low = 0, *high = 31; | |
324 else if (CHARSET_CHARS (cs) == 94) *low = 33, *high = 126; | |
325 else /* CHARSET_CHARS (cs) == 96) */ *low = 32, *high = 127; | |
326 } | |
327 | |
428 | 328 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /* |
329 Return non-nil if OBJECT is a charset. | |
330 */ | |
331 (object)) | |
332 { | |
333 return CHARSETP (object) ? Qt : Qnil; | |
334 } | |
335 | |
336 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /* | |
337 Retrieve the charset of the given name. | |
338 If CHARSET-OR-NAME is a charset object, it is simply returned. | |
339 Otherwise, CHARSET-OR-NAME should be a symbol. If there is no such charset, | |
340 nil is returned. Otherwise the associated charset object is returned. | |
341 */ | |
342 (charset_or_name)) | |
343 { | |
344 if (CHARSETP (charset_or_name)) | |
345 return charset_or_name; | |
346 | |
347 CHECK_SYMBOL (charset_or_name); | |
348 return Fgethash (charset_or_name, Vcharset_hash_table, Qnil); | |
349 } | |
350 | |
351 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /* | |
352 Retrieve the charset of the given name. | |
353 Same as `find-charset' except an error is signalled if there is no such | |
354 charset instead of returning nil. | |
355 */ | |
356 (name)) | |
357 { | |
358 Lisp_Object charset = Ffind_charset (name); | |
359 | |
360 if (NILP (charset)) | |
563 | 361 invalid_argument ("No such charset", name); |
428 | 362 return charset; |
363 } | |
364 | |
365 /* We store the charsets in hash tables with the names as the key and the | |
366 actual charset object as the value. Occasionally we need to use them | |
367 in a list format. These routines provide us with that. */ | |
368 struct charset_list_closure | |
369 { | |
370 Lisp_Object *charset_list; | |
371 }; | |
372 | |
373 static int | |
2286 | 374 add_charset_to_list_mapper (Lisp_Object UNUSED (key), Lisp_Object value, |
428 | 375 void *charset_list_closure) |
376 { | |
377 /* This function can GC */ | |
378 struct charset_list_closure *chcl = | |
379 (struct charset_list_closure*) charset_list_closure; | |
380 Lisp_Object *charset_list = chcl->charset_list; | |
381 | |
382 *charset_list = Fcons (XCHARSET_NAME (value), *charset_list); | |
383 return 0; | |
384 } | |
385 | |
386 DEFUN ("charset-list", Fcharset_list, 0, 0, 0, /* | |
387 Return a list of the names of all defined charsets. | |
388 */ | |
389 ()) | |
390 { | |
391 Lisp_Object charset_list = Qnil; | |
392 struct gcpro gcpro1; | |
393 struct charset_list_closure charset_list_closure; | |
394 | |
395 GCPRO1 (charset_list); | |
396 charset_list_closure.charset_list = &charset_list; | |
397 elisp_maphash (add_charset_to_list_mapper, Vcharset_hash_table, | |
398 &charset_list_closure); | |
399 UNGCPRO; | |
400 | |
401 return charset_list; | |
402 } | |
403 | |
404 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /* | |
444 | 405 Return the name of charset CHARSET. |
428 | 406 */ |
407 (charset)) | |
408 { | |
409 return XCHARSET_NAME (Fget_charset (charset)); | |
410 } | |
411 | |
446 | 412 /* #### SJT Should generic properties be allowed? */ |
428 | 413 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /* |
414 Define a new character set. | |
415 This function is for use with Mule support. | |
416 NAME is a symbol, the name by which the character set is normally referred. | |
417 DOC-STRING is a string describing the character set. | |
418 PROPS is a property list, describing the specific nature of the | |
419 character set. Recognized properties are: | |
420 | |
3025 | 421 `short-name' Short version of the charset name (ex: Latin-1) |
422 `long-name' Long version of the charset name (ex: ISO8859-1 (Latin-1)) | |
3659 | 423 `registries' A vector of possible XLFD REGISTRY-ENCODING combinations for |
424 this character set. Note that this is not a regular expression. | |
3025 | 425 `dimension' Number of octets used to index a character in this charset. |
428 | 426 Either 1 or 2. Defaults to 1. |
3025 | 427 `columns' Number of columns used to display a character in this charset. |
428 | 428 Only used in TTY mode. (Under X, the actual width of a |
429 character can be derived from the font used to display the | |
430 characters.) If unspecified, defaults to the dimension | |
431 (this is almost always the correct value). | |
3025 | 432 `chars' Number of characters in each dimension (94 or 96). |
428 | 433 Defaults to 94. Note that if the dimension is 2, the |
434 character set thus described is 94x94 or 96x96. | |
3025 | 435 `final' Final byte of ISO 2022 escape sequence. Must be |
428 | 436 supplied. Each combination of (DIMENSION, CHARS) defines a |
437 separate namespace for final bytes. Note that ISO | |
438 2022 restricts the final byte to the range | |
439 0x30 - 0x7E if dimension == 1, and 0x30 - 0x5F if | |
440 dimension == 2. Note also that final bytes in the range | |
441 0x30 - 0x3F are reserved for user-defined (not official) | |
442 character sets. | |
3025 | 443 `graphic' 0 (use left half of font on output) or 1 (use right half |
428 | 444 of font on output). Defaults to 0. For example, for |
445 a font whose registry is ISO8859-1, the left half | |
446 (octets 0x20 - 0x7F) is the `ascii' character set, while | |
447 the right half (octets 0xA0 - 0xFF) is the `latin-1' | |
3025 | 448 character set. With `graphic' set to 0, the octets |
428 | 449 will have their high bit cleared; with it set to 1, |
450 the octets will have their high bit set. | |
3025 | 451 `direction' `l2r' (left-to-right) or `r2l' (right-to-left). |
452 Defaults to `l2r'. | |
453 `ccl-program' A compiled CCL program used to convert a character in | |
428 | 454 this charset into an index into the font. This is in |
3025 | 455 addition to the `graphic' property. The CCL program |
428 | 456 is passed the octets of the character, with the high |
457 bit cleared and set depending upon whether the value | |
3025 | 458 of the `graphic' property is 0 or 1. |
3439 | 459 `encode-as-utf-8' |
460 If non-nil, the charset will be written out using the UTF-8 | |
461 escape syntax in ISO 2022-oriented coding systems. Used for | |
462 supporting characters we know are part of Unicode but not of | |
463 any other known character set in escape-quoted and compound | |
464 text. | |
428 | 465 */ |
466 (name, doc_string, props)) | |
467 { | |
771 | 468 int id, dimension = 1, chars = 94, graphic = 0, columns = -1; |
867 | 469 Ibyte final = 0; |
428 | 470 int direction = CHARSET_LEFT_TO_RIGHT; |
471 int type; | |
3659 | 472 Lisp_Object registries = Qnil; |
771 | 473 Lisp_Object charset = Qnil; |
428 | 474 Lisp_Object ccl_program = Qnil; |
475 Lisp_Object short_name = Qnil, long_name = Qnil; | |
3439 | 476 int encode_as_utf_8 = 0; |
771 | 477 Lisp_Object existing_charset; |
478 int temporary = UNBOUNDP (name); | |
428 | 479 |
771 | 480 /* NOTE: name == Qunbound is a directive from the iso2022 code to |
481 create a temporary charset for an unknown final. We allow the final | |
482 to be overwritten with a real charset later on. */ | |
483 | |
428 | 484 if (!NILP (doc_string)) |
485 CHECK_STRING (doc_string); | |
771 | 486 if (!UNBOUNDP (name)) |
487 { | |
488 CHECK_SYMBOL (name); | |
428 | 489 |
771 | 490 charset = Ffind_charset (name); |
491 if (!NILP (charset)) | |
492 invalid_operation ("Cannot redefine existing charset", name); | |
493 } | |
428 | 494 |
442 | 495 { |
496 EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, props) | |
497 { | |
498 if (EQ (keyword, Qshort_name)) | |
499 { | |
500 CHECK_STRING (value); | |
501 short_name = value; | |
502 } | |
428 | 503 |
519 | 504 else if (EQ (keyword, Qlong_name)) |
442 | 505 { |
506 CHECK_STRING (value); | |
507 long_name = value; | |
508 } | |
428 | 509 |
442 | 510 else if (EQ (keyword, Qdimension)) |
511 { | |
512 CHECK_INT (value); | |
513 dimension = XINT (value); | |
514 if (dimension < 1 || dimension > 2) | |
3025 | 515 invalid_constant ("Invalid value for `dimension'", value); |
442 | 516 } |
428 | 517 |
442 | 518 else if (EQ (keyword, Qchars)) |
519 { | |
520 CHECK_INT (value); | |
521 chars = XINT (value); | |
522 if (chars != 94 && chars != 96) | |
3025 | 523 invalid_constant ("Invalid value for `chars'", value); |
442 | 524 } |
428 | 525 |
442 | 526 else if (EQ (keyword, Qcolumns)) |
527 { | |
528 CHECK_INT (value); | |
529 columns = XINT (value); | |
530 if (columns != 1 && columns != 2) | |
3025 | 531 invalid_constant ("Invalid value for `columns'", value); |
442 | 532 } |
428 | 533 |
442 | 534 else if (EQ (keyword, Qgraphic)) |
535 { | |
536 CHECK_INT (value); | |
537 graphic = XINT (value); | |
538 if (graphic < 0 || graphic > 1) | |
3025 | 539 invalid_constant ("Invalid value for `graphic'", value); |
442 | 540 } |
428 | 541 |
3659 | 542 else if (EQ (keyword, Qregistries)) |
543 { | |
544 CHECK_VECTOR (value); | |
545 registries = value; | |
546 } | |
547 | |
442 | 548 else if (EQ (keyword, Qregistry)) |
549 { | |
3659 | 550 Lisp_Object quoted_registry; |
551 | |
442 | 552 CHECK_STRING (value); |
3659 | 553 quoted_registry = Fregexp_quote(value); |
3662 | 554 if (qxestrcmp(XSTRING_DATA(quoted_registry), |
3659 | 555 XSTRING_DATA(value))) |
556 { | |
557 warn_when_safe | |
558 (Qregistry, Qwarning, | |
559 "Regexps no longer allowed for charset-registry. " | |
560 "Treating %s as string", XSTRING_DATA(value)); | |
561 } | |
562 registries = vector1(value); | |
442 | 563 } |
428 | 564 |
442 | 565 else if (EQ (keyword, Qdirection)) |
566 { | |
567 if (EQ (value, Ql2r)) | |
568 direction = CHARSET_LEFT_TO_RIGHT; | |
569 else if (EQ (value, Qr2l)) | |
570 direction = CHARSET_RIGHT_TO_LEFT; | |
571 else | |
3025 | 572 invalid_constant ("Invalid value for `direction'", value); |
442 | 573 } |
428 | 574 |
3439 | 575 else if (EQ (keyword, Qencode_as_utf_8)) |
576 { | |
577 encode_as_utf_8 = NILP (value) ? 0 : 1; | |
578 } | |
579 | |
442 | 580 else if (EQ (keyword, Qfinal)) |
581 { | |
582 CHECK_CHAR_COERCE_INT (value); | |
583 final = XCHAR (value); | |
584 if (final < '0' || final > '~') | |
3025 | 585 invalid_constant ("Invalid value for `final'", value); |
442 | 586 } |
587 else if (EQ (keyword, Qccl_program)) | |
588 { | |
4745
0c54de4c4b9d
Resolve the unregistered-CCL-programs-get-garbage-collected problem correctly
Aidan Kehoe <kehoea@parhasard.net>
parents:
4691
diff
changeset
|
589 /* This errors if VALUE is not a valid CCL program. */ |
0c54de4c4b9d
Resolve the unregistered-CCL-programs-get-garbage-collected problem correctly
Aidan Kehoe <kehoea@parhasard.net>
parents:
4691
diff
changeset
|
590 ccl_program = get_ccl_program (value); |
442 | 591 } |
592 else | |
563 | 593 invalid_constant ("Unrecognized property", keyword); |
442 | 594 } |
595 } | |
428 | 596 |
597 if (!final) | |
3025 | 598 invalid_argument ("`final' must be specified", Qunbound); |
428 | 599 if (dimension == 2 && final > 0x5F) |
563 | 600 invalid_constant |
428 | 601 ("Final must be in the range 0x30 - 0x5F for dimension == 2", |
602 make_char (final)); | |
603 | |
604 if (dimension == 1) | |
605 type = (chars == 94) ? CHARSET_TYPE_94 : CHARSET_TYPE_96; | |
606 else | |
607 type = (chars == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96; | |
608 | |
826 | 609 existing_charset = charset_by_attributes (type, final, direction); |
771 | 610 |
611 if (!NILP (existing_charset) && !XCHARSET (existing_charset)->temporary) | |
578 | 612 invalid_argument |
793 | 613 ("Character set already defined for this DIMENSION/CHARS/FINAL/DIRECTION combo", |
771 | 614 existing_charset); |
615 | |
616 if (!NILP (existing_charset)) | |
617 /* Reuse same leading byte */ | |
618 id = XCHARSET_ID (existing_charset); | |
619 else | |
620 id = get_unallocated_leading_byte (dimension); | |
428 | 621 |
771 | 622 if (temporary) |
623 { | |
867 | 624 Ibyte tempname[80]; |
428 | 625 |
771 | 626 qxesprintf (tempname, "___temporary___%d__", id); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
627 name = Fmake_symbol (build_istring (tempname)); /* Uninterned. */ |
771 | 628 } |
428 | 629 if (NILP (doc_string)) |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
630 doc_string = build_ascstring (""); |
3659 | 631 if (NILP (registries)) |
632 registries = make_vector(0, Qnil); | |
428 | 633 if (NILP (short_name)) |
793 | 634 short_name = XSYMBOL (name)->name; |
428 | 635 if (NILP (long_name)) |
636 long_name = doc_string; | |
637 if (columns == -1) | |
638 columns = dimension; | |
771 | 639 |
428 | 640 charset = make_charset (id, name, dimension + 2, type, columns, graphic, |
771 | 641 final, direction, short_name, long_name, |
3659 | 642 doc_string, registries, !NILP (existing_charset), |
3439 | 643 encode_as_utf_8); |
771 | 644 |
645 XCHARSET (charset)->temporary = temporary; | |
428 | 646 if (!NILP (ccl_program)) |
647 XCHARSET_CCL_PROGRAM (charset) = ccl_program; | |
771 | 648 |
793 | 649 { |
650 Lisp_Object revdircs = | |
826 | 651 charset_by_attributes (type, final, |
793 | 652 direction == CHARSET_LEFT_TO_RIGHT ? |
653 CHARSET_RIGHT_TO_LEFT : CHARSET_LEFT_TO_RIGHT); | |
654 if (!NILP (revdircs)) | |
655 { | |
656 XCHARSET_REVERSE_DIRECTION_CHARSET (revdircs) = charset; | |
657 XCHARSET_REVERSE_DIRECTION_CHARSET (charset) = revdircs; | |
658 } | |
659 } | |
660 | |
428 | 661 return charset; |
662 } | |
663 | |
664 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset, | |
665 2, 2, 0, /* | |
666 Make a charset equivalent to CHARSET but which goes in the opposite direction. | |
667 NEW-NAME is the name of the new charset. Return the new charset. | |
668 */ | |
669 (charset, new_name)) | |
670 { | |
671 Lisp_Object new_charset = Qnil; | |
3439 | 672 int id, dimension, columns, graphic, encode_as_utf_8; |
867 | 673 Ibyte final; |
428 | 674 int direction, type; |
3659 | 675 Lisp_Object registries, doc_string, short_name, long_name; |
440 | 676 Lisp_Charset *cs; |
428 | 677 |
678 charset = Fget_charset (charset); | |
679 if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset))) | |
563 | 680 invalid_operation ("Charset already has reverse-direction charset", |
793 | 681 charset); |
428 | 682 |
683 CHECK_SYMBOL (new_name); | |
684 if (!NILP (Ffind_charset (new_name))) | |
563 | 685 invalid_operation ("Cannot redefine existing charset", new_name); |
428 | 686 |
687 cs = XCHARSET (charset); | |
688 | |
689 type = CHARSET_TYPE (cs); | |
690 columns = CHARSET_COLUMNS (cs); | |
691 dimension = CHARSET_DIMENSION (cs); | |
692 id = get_unallocated_leading_byte (dimension); | |
693 | |
694 graphic = CHARSET_GRAPHIC (cs); | |
695 final = CHARSET_FINAL (cs); | |
696 direction = CHARSET_RIGHT_TO_LEFT; | |
697 if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT) | |
698 direction = CHARSET_LEFT_TO_RIGHT; | |
699 doc_string = CHARSET_DOC_STRING (cs); | |
700 short_name = CHARSET_SHORT_NAME (cs); | |
701 long_name = CHARSET_LONG_NAME (cs); | |
3659 | 702 registries = CHARSET_REGISTRIES (cs); |
3439 | 703 encode_as_utf_8 = CHARSET_ENCODE_AS_UTF_8 (cs); |
428 | 704 |
705 new_charset = make_charset (id, new_name, dimension + 2, type, columns, | |
706 graphic, final, direction, short_name, long_name, | |
3659 | 707 doc_string, registries, 0, encode_as_utf_8); |
428 | 708 |
709 CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset; | |
710 XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset; | |
711 | |
712 return new_charset; | |
713 } | |
714 | |
715 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset, | |
716 1, 1, 0, /* | |
717 Return the reverse-direction charset parallel to CHARSET, if any. | |
718 This is the charset with the same properties (in particular, the same | |
719 dimension, number of characters per dimension, and final byte) as | |
720 CHARSET but whose characters are displayed in the opposite direction. | |
721 */ | |
722 (charset)) | |
723 { | |
724 charset = Fget_charset (charset); | |
725 return XCHARSET_REVERSE_DIRECTION_CHARSET (charset); | |
726 } | |
727 | |
728 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /* | |
729 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION. | |
730 If DIRECTION is omitted, both directions will be checked (left-to-right | |
731 will be returned if character sets exist for both directions). | |
732 */ | |
733 (dimension, chars, final, direction)) | |
734 { | |
735 int dm, ch, fi, di = -1; | |
736 int type; | |
737 Lisp_Object obj = Qnil; | |
738 | |
739 CHECK_INT (dimension); | |
740 dm = XINT (dimension); | |
741 if (dm < 1 || dm > 2) | |
563 | 742 invalid_constant ("Invalid value for DIMENSION", dimension); |
428 | 743 |
744 CHECK_INT (chars); | |
745 ch = XINT (chars); | |
746 if (ch != 94 && ch != 96) | |
563 | 747 invalid_constant ("Invalid value for CHARS", chars); |
428 | 748 |
749 CHECK_CHAR_COERCE_INT (final); | |
750 fi = XCHAR (final); | |
751 if (fi < '0' || fi > '~') | |
563 | 752 invalid_constant ("Invalid value for FINAL", final); |
428 | 753 |
754 if (EQ (direction, Ql2r)) | |
755 di = CHARSET_LEFT_TO_RIGHT; | |
756 else if (EQ (direction, Qr2l)) | |
757 di = CHARSET_RIGHT_TO_LEFT; | |
758 else if (!NILP (direction)) | |
563 | 759 invalid_constant ("Invalid value for DIRECTION", direction); |
428 | 760 |
761 if (dm == 2 && fi > 0x5F) | |
563 | 762 invalid_constant |
428 | 763 ("Final must be in the range 0x30 - 0x5F for dimension == 2", final); |
764 | |
765 if (dm == 1) | |
766 type = (ch == 94) ? CHARSET_TYPE_94 : CHARSET_TYPE_96; | |
767 else | |
768 type = (ch == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96; | |
769 | |
770 if (di == -1) | |
771 { | |
826 | 772 obj = charset_by_attributes (type, fi, CHARSET_LEFT_TO_RIGHT); |
428 | 773 if (NILP (obj)) |
826 | 774 obj = charset_by_attributes (type, fi, CHARSET_RIGHT_TO_LEFT); |
428 | 775 } |
776 else | |
826 | 777 obj = charset_by_attributes (type, fi, di); |
428 | 778 |
779 if (CHARSETP (obj)) | |
780 return XCHARSET_NAME (obj); | |
781 return obj; | |
782 } | |
783 | |
784 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /* | |
785 Return short name of CHARSET. | |
786 */ | |
787 (charset)) | |
788 { | |
789 return XCHARSET_SHORT_NAME (Fget_charset (charset)); | |
790 } | |
791 | |
792 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /* | |
793 Return long name of CHARSET. | |
794 */ | |
795 (charset)) | |
796 { | |
797 return XCHARSET_LONG_NAME (Fget_charset (charset)); | |
798 } | |
799 | |
800 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /* | |
801 Return description of CHARSET. | |
802 */ | |
803 (charset)) | |
804 { | |
805 return XCHARSET_DOC_STRING (Fget_charset (charset)); | |
806 } | |
807 | |
808 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /* | |
809 Return dimension of CHARSET. | |
810 */ | |
811 (charset)) | |
812 { | |
813 return make_int (XCHARSET_DIMENSION (Fget_charset (charset))); | |
814 } | |
815 | |
816 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /* | |
446 | 817 Return property PROP of CHARSET, a charset object or symbol naming a charset. |
428 | 818 Recognized properties are those listed in `make-charset', as well as |
3025 | 819 `name' and `doc-string'. |
428 | 820 */ |
821 (charset, prop)) | |
822 { | |
440 | 823 Lisp_Charset *cs; |
428 | 824 |
825 charset = Fget_charset (charset); | |
826 cs = XCHARSET (charset); | |
827 | |
828 CHECK_SYMBOL (prop); | |
829 if (EQ (prop, Qname)) return CHARSET_NAME (cs); | |
830 if (EQ (prop, Qshort_name)) return CHARSET_SHORT_NAME (cs); | |
831 if (EQ (prop, Qlong_name)) return CHARSET_LONG_NAME (cs); | |
832 if (EQ (prop, Qdoc_string)) return CHARSET_DOC_STRING (cs); | |
833 if (EQ (prop, Qdimension)) return make_int (CHARSET_DIMENSION (cs)); | |
834 if (EQ (prop, Qcolumns)) return make_int (CHARSET_COLUMNS (cs)); | |
835 if (EQ (prop, Qgraphic)) return make_int (CHARSET_GRAPHIC (cs)); | |
836 if (EQ (prop, Qfinal)) return make_char (CHARSET_FINAL (cs)); | |
837 if (EQ (prop, Qchars)) return make_int (CHARSET_CHARS (cs)); | |
3659 | 838 if (EQ (prop, Qregistries)) return CHARSET_REGISTRIES (cs); |
3439 | 839 if (EQ (prop, Qencode_as_utf_8)) |
840 return CHARSET_ENCODE_AS_UTF_8 (cs) ? Qt : Qnil; | |
428 | 841 if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs); |
842 if (EQ (prop, Qdirection)) | |
843 return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l; | |
844 if (EQ (prop, Qreverse_direction_charset)) | |
845 { | |
846 Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs); | |
446 | 847 /* #### Is this translation OK? If so, error checking sufficient? */ |
848 return CHARSETP (obj) ? XCHARSET_NAME (obj) : obj; | |
428 | 849 } |
563 | 850 invalid_constant ("Unrecognized charset property name", prop); |
1204 | 851 RETURN_NOT_REACHED (Qnil); |
428 | 852 } |
853 | |
854 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /* | |
855 Return charset identification number of CHARSET. | |
856 */ | |
857 (charset)) | |
858 { | |
793 | 859 return make_int (XCHARSET_LEADING_BYTE (Fget_charset (charset))); |
428 | 860 } |
861 | |
862 /* #### We need to figure out which properties we really want to | |
863 allow to be set. */ | |
864 | |
865 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /* | |
3025 | 866 Set the `ccl-program' property of CHARSET to CCL-PROGRAM. |
428 | 867 */ |
868 (charset, ccl_program)) | |
869 { | |
870 charset = Fget_charset (charset); | |
4745
0c54de4c4b9d
Resolve the unregistered-CCL-programs-get-garbage-collected problem correctly
Aidan Kehoe <kehoea@parhasard.net>
parents:
4691
diff
changeset
|
871 XCHARSET_CCL_PROGRAM (charset) = get_ccl_program (ccl_program); |
0c54de4c4b9d
Resolve the unregistered-CCL-programs-get-garbage-collected problem correctly
Aidan Kehoe <kehoea@parhasard.net>
parents:
4691
diff
changeset
|
872 |
510 | 873 face_property_was_changed (Vdefault_face, Qfont, Qglobal); |
428 | 874 return Qnil; |
875 } | |
876 | |
3676 | 877 void |
878 set_charset_registries(Lisp_Object charset, Lisp_Object registries) | |
879 { | |
880 XCHARSET_REGISTRIES (charset) = registries; | |
881 invalidate_charset_font_caches (charset); | |
882 face_property_was_changed (Vdefault_face, Qfont, Qglobal); | |
883 } | |
884 | |
3711 | 885 DEFUN ("set-charset-registries", Fset_charset_registries, 2, 3, 0, /* |
3659 | 886 Set the `registries' property of CHARSET to REGISTRIES. |
887 | |
888 REGISTRIES is an ordered vector of strings that describe the X11 | |
889 CHARSET_REGISTRY and the CHARSET_ENCODINGs appropriate for this charset. | |
890 Separate each registry from the corresponding encoding with a dash. The | |
891 strings are not regular expressions, in contrast to the old behavior of | |
892 the `charset-registry' property. | |
893 | |
894 One reason to call this function might be if you're in Japan and you'd | |
895 prefer the backslash to display as a Yen sign; the corresponding syntax | |
896 would be: | |
897 | |
898 (set-charset-registries 'ascii ["jisx0201.1976-0"]) | |
899 | |
3711 | 900 If optional argument FORCE is non-nil, avoid sanity-checking the elements of |
901 REGISTRIES. Normally the strings are checked to make sure they contain no | |
902 XLFD wild cards and that they contain at least one hyphen; the only context | |
903 in which one might want not to do this is in order to use a font which | |
904 doesn't have a full XLFD--and thus, an effective | |
905 CHARSET_REGISTRY-CHARSET_ENCODING of ""--to display ASCII. | |
906 | |
907 We recommend strongly that you specify a full XLFD, since this makes | |
908 multilingual and variant font handling work much better. To get the full | |
909 XLFD of any font, start xfd with the short name as the pattern argument: | |
910 | |
911 xfd -fn 8x16kana | |
912 | |
913 and use the text that appears at the top of the window. | |
428 | 914 */ |
3711 | 915 (charset, registries, force)) |
428 | 916 { |
3659 | 917 int i; |
428 | 918 charset = Fget_charset (charset); |
3659 | 919 CHECK_VECTOR (registries); |
920 | |
921 for (i = 0; i < XVECTOR_LENGTH(registries); ++i) | |
922 { | |
923 CHECK_STRING (XVECTOR_DATA(registries)[i]); | |
3711 | 924 |
925 if (!NILP(force)) | |
926 { | |
927 continue; | |
928 } | |
929 | |
3659 | 930 if (NULL == qxestrchr(XSTRING_DATA(XVECTOR_DATA(registries)[i]), '-')) |
931 { | |
932 invalid_argument("Not an X11 REGISTRY-ENCODING combination", | |
933 XVECTOR_DATA(registries)[i]); | |
934 } | |
3676 | 935 |
936 if (qxestrchr(XSTRING_DATA(XVECTOR_DATA(registries)[i]), '*') || | |
937 qxestrchr(XSTRING_DATA(XVECTOR_DATA(registries)[i]), '?')) | |
938 { | |
939 invalid_argument | |
940 ("XLFD wildcards not allowed in charset-registries", | |
941 XVECTOR_DATA(registries)[i]); | |
942 | |
943 } | |
3659 | 944 } |
945 | |
3676 | 946 set_charset_registries(charset, registries); |
947 | |
428 | 948 return Qnil; |
949 } | |
950 | |
3681 | 951 DEFUN ("charsets-in-region", Fcharsets_in_region, 2, 3, 0, /* |
952 Return a list of the charsets in the region between START and END. | |
953 BUFFER defaults to the current buffer if omitted. | |
954 */ | |
955 (start, end, buffer)) | |
956 { | |
957 /* This function can GC */ | |
958 struct buffer *buf = decode_buffer (buffer, 1); | |
959 Charbpos pos, stop; /* Limits of the region. */ | |
960 Lisp_Object res = Qnil; | |
961 int charsets[NUM_LEADING_BYTES]; | |
962 Ibyte lb; | |
963 struct gcpro gcpro1; | |
964 | |
965 memset(charsets, 0, sizeof(charsets)); | |
966 get_buffer_range_char (buf, start, end, &pos, &stop, 0); | |
967 | |
968 GCPRO1 (res); | |
969 while (pos < stop) | |
970 { | |
971 lb = ichar_leading_byte(BUF_FETCH_CHAR (buf, pos)); | |
972 if (0 == charsets[lb - MIN_LEADING_BYTE]) | |
973 { | |
974 charsets[lb - MIN_LEADING_BYTE] = 1; | |
975 res = Fcons (XCHARSET_NAME(charset_by_leading_byte(lb)), res); | |
976 } | |
977 ++pos; | |
978 } | |
979 UNGCPRO; | |
980 | |
981 return res; | |
982 } | |
983 | |
428 | 984 |
985 /************************************************************************/ | |
771 | 986 /* memory usage */ |
428 | 987 /************************************************************************/ |
988 | |
771 | 989 #ifdef MEMORY_USAGE_STATS |
428 | 990 |
771 | 991 struct charset_stats |
992 { | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
993 struct usage_stats u; |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
994 Bytecount from_unicode; |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
995 Bytecount to_unicode; |
771 | 996 }; |
428 | 997 |
771 | 998 static void |
999 compute_charset_usage (Lisp_Object charset, struct charset_stats *stats, | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1000 struct usage_stats *ustats) |
428 | 1001 { |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1002 stats->from_unicode += compute_from_unicode_table_size (charset, ustats); |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1003 stats->to_unicode += compute_to_unicode_table_size (charset, ustats); |
438 | 1004 } |
1005 | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1006 static void |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1007 charset_memory_usage (Lisp_Object charset, struct generic_usage_stats *gustats) |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1008 { |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1009 struct charset_stats *stats = (struct charset_stats *) gustats; |
428 | 1010 |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1011 compute_charset_usage (charset, stats, &stats->u); |
428 | 1012 } |
1013 | |
771 | 1014 #endif /* MEMORY_USAGE_STATS */ |
428 | 1015 |
1016 | |
1017 /************************************************************************/ | |
1018 /* initialization */ | |
1019 /************************************************************************/ | |
1020 | |
1021 void | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1022 mule_charset_objects_create (void) |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1023 { |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1024 #ifdef MEMORY_USAGE_STATS |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1025 OBJECT_HAS_METHOD (charset, memory_usage); |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1026 #endif |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1027 } |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1028 |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1029 void |
428 | 1030 syms_of_mule_charset (void) |
1031 { | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1032 INIT_LISP_OBJECT (charset); |
442 | 1033 |
428 | 1034 DEFSUBR (Fcharsetp); |
1035 DEFSUBR (Ffind_charset); | |
1036 DEFSUBR (Fget_charset); | |
1037 DEFSUBR (Fcharset_list); | |
1038 DEFSUBR (Fcharset_name); | |
1039 DEFSUBR (Fmake_charset); | |
1040 DEFSUBR (Fmake_reverse_direction_charset); | |
793 | 1041 DEFSUBR (Fcharset_reverse_direction_charset); |
428 | 1042 DEFSUBR (Fcharset_from_attributes); |
1043 DEFSUBR (Fcharset_short_name); | |
1044 DEFSUBR (Fcharset_long_name); | |
1045 DEFSUBR (Fcharset_description); | |
1046 DEFSUBR (Fcharset_dimension); | |
1047 DEFSUBR (Fcharset_property); | |
1048 DEFSUBR (Fcharset_id); | |
1049 DEFSUBR (Fset_charset_ccl_program); | |
3659 | 1050 DEFSUBR (Fset_charset_registries); |
3681 | 1051 DEFSUBR (Fcharsets_in_region); |
428 | 1052 |
563 | 1053 DEFSYMBOL (Qcharsetp); |
3659 | 1054 DEFSYMBOL (Qregistries); |
563 | 1055 DEFSYMBOL (Qfinal); |
1056 DEFSYMBOL (Qgraphic); | |
3659 | 1057 DEFSYMBOL (Qregistry); |
563 | 1058 DEFSYMBOL (Qdirection); |
1059 DEFSYMBOL (Qreverse_direction_charset); | |
1060 DEFSYMBOL (Qshort_name); | |
1061 DEFSYMBOL (Qlong_name); | |
428 | 1062 |
771 | 1063 DEFSYMBOL (Qto_unicode); |
1064 | |
563 | 1065 DEFSYMBOL (Ql2r); |
1066 DEFSYMBOL (Qr2l); | |
428 | 1067 |
1068 /* Charsets, compatible with FSF 20.3 | |
1069 Naming convention is Script-Charset[-Edition] */ | |
563 | 1070 DEFSYMBOL (Qlatin_iso8859_1); |
1071 DEFSYMBOL (Qlatin_iso8859_2); | |
1072 DEFSYMBOL (Qlatin_iso8859_3); | |
1073 DEFSYMBOL (Qlatin_iso8859_4); | |
1074 DEFSYMBOL (Qthai_tis620); | |
1075 DEFSYMBOL (Qgreek_iso8859_7); | |
4805
980575c76541
Move the arabic-iso8859-6 character set back to C, otherwise X11 lookup fails.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4745
diff
changeset
|
1076 DEFSYMBOL (Qarabic_iso8859_6); |
563 | 1077 DEFSYMBOL (Qhebrew_iso8859_8); |
1078 DEFSYMBOL (Qkatakana_jisx0201); | |
1079 DEFSYMBOL (Qlatin_jisx0201); | |
1080 DEFSYMBOL (Qcyrillic_iso8859_5); | |
1081 DEFSYMBOL (Qlatin_iso8859_9); | |
728 | 1082 DEFSYMBOL (Qlatin_iso8859_15); |
563 | 1083 DEFSYMBOL (Qjapanese_jisx0208_1978); |
1084 DEFSYMBOL (Qchinese_gb2312); | |
1085 DEFSYMBOL (Qjapanese_jisx0208); | |
1086 DEFSYMBOL (Qkorean_ksc5601); | |
1087 DEFSYMBOL (Qjapanese_jisx0212); | |
1088 DEFSYMBOL (Qchinese_cns11643_1); | |
1089 DEFSYMBOL (Qchinese_cns11643_2); | |
1090 DEFSYMBOL (Qchinese_big5_1); | |
1091 DEFSYMBOL (Qchinese_big5_2); | |
428 | 1092 |
563 | 1093 DEFSYMBOL (Qcomposite); |
428 | 1094 } |
1095 | |
1096 void | |
1097 vars_of_mule_charset (void) | |
1098 { | |
1099 int i, j, k; | |
1100 | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1101 #ifdef MEMORY_USAGE_STATS |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1102 OBJECT_HAS_PROPERTY |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1103 (charset, memusage_stats_list, list2 (Qfrom_unicode, Qto_unicode)); |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1104 #endif /* MEMORY_USAGE_STATS */ |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
1105 |
452 | 1106 chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */ |
2367 | 1107 dump_add_root_block_ptr (&chlook, &charset_lookup_description); |
428 | 1108 |
1109 /* Table of charsets indexed by leading byte. */ | |
1110 for (i = 0; i < countof (chlook->charset_by_leading_byte); i++) | |
1111 chlook->charset_by_leading_byte[i] = Qnil; | |
1112 | |
1113 /* Table of charsets indexed by type/final-byte/direction. */ | |
1114 for (i = 0; i < countof (chlook->charset_by_attributes); i++) | |
1115 for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++) | |
1116 for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++) | |
1117 chlook->charset_by_attributes[i][j][k] = Qnil; | |
1118 | |
442 | 1119 chlook->next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1; |
1120 chlook->next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2; | |
771 | 1121 |
1122 staticpro (&Vcharset_hash_table); | |
1123 Vcharset_hash_table = | |
1124 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
428 | 1125 } |
1126 | |
1127 void | |
1128 complex_vars_of_mule_charset (void) | |
1129 { | |
1130 /* Predefined character sets. We store them into variables for | |
1131 ease of access. */ | |
1132 | |
1133 staticpro (&Vcharset_ascii); | |
1134 Vcharset_ascii = | |
1135 make_charset (LEADING_BYTE_ASCII, Qascii, 1, | |
1136 CHARSET_TYPE_94, 1, 0, 'B', | |
1137 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1138 build_ascstring ("ASCII"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1139 build_defer_string ("ASCII"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1140 build_defer_string ("ASCII (ISO646 IRV)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1141 vector1(build_ascstring("iso8859-1")), 0, 0); |
428 | 1142 staticpro (&Vcharset_control_1); |
1143 Vcharset_control_1 = | |
1144 make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 2, | |
1145 CHARSET_TYPE_94, 1, 1, 0, | |
1146 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1147 build_ascstring ("C1"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1148 build_defer_string ("Control characters"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1149 build_defer_string ("Control characters 128-191"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1150 vector1(build_ascstring("iso8859-1")), 0, 0); |
428 | 1151 staticpro (&Vcharset_latin_iso8859_1); |
1152 Vcharset_latin_iso8859_1 = | |
1153 make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 2, | |
1154 CHARSET_TYPE_96, 1, 1, 'A', | |
1155 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1156 build_ascstring ("Latin-1"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1157 build_defer_string ("ISO8859-1 (Latin-1)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1158 build_defer_string ("ISO8859-1 (Latin-1)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1159 vector1(build_ascstring("iso8859-1")), 0, 0); |
428 | 1160 staticpro (&Vcharset_latin_iso8859_2); |
1161 Vcharset_latin_iso8859_2 = | |
1162 make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 2, | |
1163 CHARSET_TYPE_96, 1, 1, 'B', | |
1164 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1165 build_ascstring ("Latin-2"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1166 build_defer_string ("ISO8859-2 (Latin-2)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1167 build_defer_string ("ISO8859-2 (Latin-2)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1168 vector1(build_ascstring("iso8859-2")), 0, 0); |
428 | 1169 staticpro (&Vcharset_latin_iso8859_3); |
1170 Vcharset_latin_iso8859_3 = | |
1171 make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 2, | |
1172 CHARSET_TYPE_96, 1, 1, 'C', | |
1173 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1174 build_ascstring ("Latin-3"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1175 build_defer_string ("ISO8859-3 (Latin-3)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1176 build_defer_string ("ISO8859-3 (Latin-3)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1177 vector1(build_ascstring("iso8859-3")), 0, 0); |
428 | 1178 staticpro (&Vcharset_latin_iso8859_4); |
1179 Vcharset_latin_iso8859_4 = | |
1180 make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 2, | |
1181 CHARSET_TYPE_96, 1, 1, 'D', | |
1182 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1183 build_ascstring ("Latin-4"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1184 build_defer_string ("ISO8859-4 (Latin-4)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1185 build_defer_string ("ISO8859-4 (Latin-4)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1186 vector1(build_ascstring("iso8859-4")), 0, 0); |
428 | 1187 staticpro (&Vcharset_thai_tis620); |
1188 Vcharset_thai_tis620 = | |
1189 make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 2, | |
1190 CHARSET_TYPE_96, 1, 1, 'T', | |
1191 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1192 build_ascstring ("TIS620"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1193 build_defer_string ("TIS620 (Thai)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1194 build_defer_string ("TIS620.2529 (Thai)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1195 vector1(build_ascstring("tis620.2529-1")), 0, 0); |
428 | 1196 staticpro (&Vcharset_greek_iso8859_7); |
1197 Vcharset_greek_iso8859_7 = | |
1198 make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 2, | |
1199 CHARSET_TYPE_96, 1, 1, 'F', | |
1200 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1201 build_ascstring ("ISO8859-7"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1202 build_defer_string ("ISO8859-7 (Greek)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1203 build_defer_string ("ISO8859-7 (Greek)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1204 vector1(build_ascstring("iso8859-7")), 0, 0); |
4805
980575c76541
Move the arabic-iso8859-6 character set back to C, otherwise X11 lookup fails.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4745
diff
changeset
|
1205 staticpro (&Vcharset_arabic_iso8859_6); |
980575c76541
Move the arabic-iso8859-6 character set back to C, otherwise X11 lookup fails.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4745
diff
changeset
|
1206 Vcharset_arabic_iso8859_6 = |
980575c76541
Move the arabic-iso8859-6 character set back to C, otherwise X11 lookup fails.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4745
diff
changeset
|
1207 make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 2, |
980575c76541
Move the arabic-iso8859-6 character set back to C, otherwise X11 lookup fails.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4745
diff
changeset
|
1208 CHARSET_TYPE_96, 1, 1, 'G', |
980575c76541
Move the arabic-iso8859-6 character set back to C, otherwise X11 lookup fails.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4745
diff
changeset
|
1209 CHARSET_RIGHT_TO_LEFT, |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1210 build_ascstring ("ISO8859-6"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1211 build_defer_string ("ISO8859-6 (Arabic)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1212 build_defer_string ("ISO8859-6 (Arabic)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1213 vector1(build_ascstring ("iso8859-6")), 0, 0); |
428 | 1214 staticpro (&Vcharset_hebrew_iso8859_8); |
1215 Vcharset_hebrew_iso8859_8 = | |
1216 make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 2, | |
1217 CHARSET_TYPE_96, 1, 1, 'H', | |
1218 CHARSET_RIGHT_TO_LEFT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1219 build_ascstring ("ISO8859-8"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1220 build_defer_string ("ISO8859-8 (Hebrew)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1221 build_defer_string ("ISO8859-8 (Hebrew)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1222 vector1(build_ascstring ("iso8859-8")), 0, 0); |
428 | 1223 staticpro (&Vcharset_katakana_jisx0201); |
1224 Vcharset_katakana_jisx0201 = | |
1225 make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 2, | |
1226 CHARSET_TYPE_94, 1, 1, 'I', | |
1227 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1228 build_ascstring ("JISX0201 Kana"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1229 build_defer_string ("JISX0201.1976 (Japanese Kana)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1230 build_defer_string ("JISX0201.1976 Japanese Kana"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1231 vector1(build_ascstring ("jisx0201.1976-0")), 0, 0); |
428 | 1232 staticpro (&Vcharset_latin_jisx0201); |
1233 Vcharset_latin_jisx0201 = | |
1234 make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 2, | |
1235 CHARSET_TYPE_94, 1, 0, 'J', | |
1236 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1237 build_ascstring ("JISX0201 Roman"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1238 build_defer_string ("JISX0201.1976 (Japanese Roman)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1239 build_defer_string ("JISX0201.1976 Japanese Roman"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1240 vector1(build_ascstring ("jisx0201.1976-0")), 0, 0); |
428 | 1241 staticpro (&Vcharset_cyrillic_iso8859_5); |
1242 Vcharset_cyrillic_iso8859_5 = | |
1243 make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 2, | |
1244 CHARSET_TYPE_96, 1, 1, 'L', | |
1245 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1246 build_ascstring ("ISO8859-5"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1247 build_defer_string ("ISO8859-5 (Cyrillic)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1248 build_defer_string ("ISO8859-5 (Cyrillic)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1249 vector1(build_ascstring ("iso8859-5")), 0, 0); |
428 | 1250 staticpro (&Vcharset_latin_iso8859_9); |
1251 Vcharset_latin_iso8859_9 = | |
1252 make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 2, | |
1253 CHARSET_TYPE_96, 1, 1, 'M', | |
1254 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1255 build_ascstring ("Latin-5"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1256 build_defer_string ("ISO8859-9 (Latin-5)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1257 build_defer_string ("ISO8859-9 (Latin-5)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1258 vector1(build_ascstring ("iso8859-9")), 0, 0); |
728 | 1259 staticpro (&Vcharset_latin_iso8859_15); |
1260 Vcharset_latin_iso8859_15 = | |
1261 make_charset (LEADING_BYTE_LATIN_ISO8859_15, Qlatin_iso8859_15, 2, | |
1262 CHARSET_TYPE_96, 1, 1, 'b', | |
1263 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1264 build_ascstring ("Latin-9"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1265 build_defer_string ("ISO8859-15 (Latin-9)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1266 build_defer_string ("ISO8859-15 (Latin-9)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1267 vector1(build_ascstring ("iso8859-15")), 0, 0); |
428 | 1268 staticpro (&Vcharset_japanese_jisx0208_1978); |
1269 Vcharset_japanese_jisx0208_1978 = | |
1270 make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978, Qjapanese_jisx0208_1978, 3, | |
1271 CHARSET_TYPE_94X94, 2, 0, '@', | |
1272 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1273 build_ascstring ("JISX0208.1978"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1274 build_defer_string ("JISX0208.1978 (Japanese)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1275 build_defer_string |
428 | 1276 ("JISX0208.1978 Japanese Kanji (so called \"old JIS\")"), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1277 vector2(build_ascstring("jisx0208.1978-0"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1278 build_ascstring("jisc6226.1978-0")), 0, 0); |
428 | 1279 staticpro (&Vcharset_chinese_gb2312); |
1280 Vcharset_chinese_gb2312 = | |
1281 make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 3, | |
1282 CHARSET_TYPE_94X94, 2, 0, 'A', | |
1283 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1284 build_ascstring ("GB2312"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1285 build_defer_string ("GB2312)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1286 build_defer_string ("GB2312 Chinese simplified"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1287 vector2(build_ascstring("gb2312.1980-0"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1288 build_ascstring("gb2312.80&gb8565.88-0")), 0, 0); |
428 | 1289 staticpro (&Vcharset_japanese_jisx0208); |
1290 Vcharset_japanese_jisx0208 = | |
1291 make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 3, | |
1292 CHARSET_TYPE_94X94, 2, 0, 'B', | |
1293 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1294 build_ascstring ("JISX0208"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1295 build_defer_string ("JISX0208.1983/1990 (Japanese)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1296 build_defer_string ("JISX0208.1983/1990 Japanese Kanji"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1297 vector2(build_ascstring("jisx0208.1983-0"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1298 build_ascstring("jisx0208.1990-0")), 0, 0); |
428 | 1299 staticpro (&Vcharset_korean_ksc5601); |
1300 Vcharset_korean_ksc5601 = | |
1301 make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 3, | |
1302 CHARSET_TYPE_94X94, 2, 0, 'C', | |
1303 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1304 build_ascstring ("KSC5601"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1305 build_defer_string ("KSC5601 (Korean"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1306 build_defer_string ("KSC5601 Korean Hangul and Hanja"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1307 vector1(build_ascstring("ksc5601.1987-0")), 0, 0); |
428 | 1308 staticpro (&Vcharset_japanese_jisx0212); |
1309 Vcharset_japanese_jisx0212 = | |
1310 make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 3, | |
1311 CHARSET_TYPE_94X94, 2, 0, 'D', | |
1312 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1313 build_ascstring ("JISX0212"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1314 build_defer_string ("JISX0212 (Japanese)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1315 build_defer_string ("JISX0212 Japanese Supplement"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1316 vector1(build_ascstring("jisx0212.1990-0")), 0, 0); |
428 | 1317 |
3659 | 1318 #define CHINESE_CNS_PLANE(n) "cns11643.1992-" n |
428 | 1319 staticpro (&Vcharset_chinese_cns11643_1); |
1320 Vcharset_chinese_cns11643_1 = | |
1321 make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 3, | |
1322 CHARSET_TYPE_94X94, 2, 0, 'G', | |
1323 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1324 build_ascstring ("CNS11643-1"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1325 build_defer_string ("CNS11643-1 (Chinese traditional)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1326 build_defer_string |
428 | 1327 ("CNS 11643 Plane 1 Chinese traditional"), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1328 vector1(build_ascstring (CHINESE_CNS_PLANE("1"))), 0, 0); |
428 | 1329 staticpro (&Vcharset_chinese_cns11643_2); |
1330 Vcharset_chinese_cns11643_2 = | |
1331 make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 3, | |
1332 CHARSET_TYPE_94X94, 2, 0, 'H', | |
1333 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1334 build_ascstring ("CNS11643-2"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1335 build_defer_string ("CNS11643-2 (Chinese traditional)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1336 build_defer_string |
428 | 1337 ("CNS 11643 Plane 2 Chinese traditional"), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1338 vector1(build_ascstring (CHINESE_CNS_PLANE("2"))), 0, 0); |
428 | 1339 staticpro (&Vcharset_chinese_big5_1); |
1340 Vcharset_chinese_big5_1 = | |
1341 make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 3, | |
1342 CHARSET_TYPE_94X94, 2, 0, '0', | |
1343 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1344 build_ascstring ("Big5"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1345 build_defer_string ("Big5 (Level-1)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1346 build_defer_string |
428 | 1347 ("Big5 Level-1 Chinese traditional"), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1348 vector1(build_ascstring ("big5.eten-0")), 0, 0); |
428 | 1349 staticpro (&Vcharset_chinese_big5_2); |
1350 Vcharset_chinese_big5_2 = | |
1351 make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 3, | |
1352 CHARSET_TYPE_94X94, 2, 0, '1', | |
1353 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1354 build_ascstring ("Big5"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1355 build_defer_string ("Big5 (Level-2)"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1356 build_defer_string |
428 | 1357 ("Big5 Level-2 Chinese traditional"), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1358 vector1(build_ascstring ("big5.eten-0")), 0, 0); |
428 | 1359 |
1360 | |
1361 #ifdef ENABLE_COMPOSITE_CHARS | |
1362 /* #### For simplicity, we put composite chars into a 96x96 charset. | |
1363 This is going to lead to problems because you can run out of | |
1364 room, esp. as we don't yet recycle numbers. */ | |
1365 staticpro (&Vcharset_composite); | |
1366 Vcharset_composite = | |
1367 make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 3, | |
1368 CHARSET_TYPE_96X96, 2, 0, 0, | |
1369 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1370 build_ascstring ("Composite"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1371 build_defer_string ("Composite characters"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1372 build_defer_string ("Composite characters"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1373 vector1(build_ascstring ("")), 0, 0); |
771 | 1374 #else |
1375 /* We create a hack so that we have a way of storing ESC 0 and ESC 1 | |
1376 sequences as "characters", so that they will be output correctly. */ | |
1377 staticpro (&Vcharset_composite); | |
1378 Vcharset_composite = | |
1379 make_charset (LEADING_BYTE_COMPOSITE_REPLACEMENT, Qcomposite, 2, | |
1380 CHARSET_TYPE_96, 1, 1, '|', | |
1381 CHARSET_LEFT_TO_RIGHT, | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1382 build_ascstring ("Composite hack"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1383 build_defer_string ("Composite characters hack"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1384 build_defer_string ("Composite characters hack"), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1385 vector1(build_ascstring ("")), 0, 0); |
428 | 1386 #endif /* ENABLE_COMPOSITE_CHARS */ |
1387 } |