the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
-/* Synched up with: FSF 20.3. Not in FSF. */
-
/* Rewritten by Ben Wing <ben@xemacs.org>. */
+/* Rewritten by MORIOKA Tomohiko <tomo@m17n.org> for XEmacs UTF-2000. */
+
#include <config.h>
#ifdef UTF2000
#include <limits.h>
#include "buffer.h"
#include "chartab.h"
-#include "elhash.h"
-#include "lstream.h"
-#include "device.h"
-#include "faces.h"
-#include "mule-ccl.h"
-
-/* The various pre-defined charsets. */
-
-Lisp_Object Vcharset_ascii;
-Lisp_Object Vcharset_control_1;
-Lisp_Object Vcharset_latin_iso8859_1;
-Lisp_Object Vcharset_latin_iso8859_2;
-Lisp_Object Vcharset_latin_iso8859_3;
-Lisp_Object Vcharset_latin_iso8859_4;
-Lisp_Object Vcharset_thai_tis620;
-Lisp_Object Vcharset_greek_iso8859_7;
-Lisp_Object Vcharset_arabic_iso8859_6;
-Lisp_Object Vcharset_hebrew_iso8859_8;
-Lisp_Object Vcharset_katakana_jisx0201;
-Lisp_Object Vcharset_latin_jisx0201;
-Lisp_Object Vcharset_cyrillic_iso8859_5;
-Lisp_Object Vcharset_latin_iso8859_9;
-Lisp_Object Vcharset_japanese_jisx0208_1978;
-Lisp_Object Vcharset_chinese_gb2312;
-Lisp_Object Vcharset_chinese_gb12345;
-Lisp_Object Vcharset_japanese_jisx0208;
-Lisp_Object Vcharset_japanese_jisx0208_1990;
-Lisp_Object Vcharset_korean_ksc5601;
-Lisp_Object Vcharset_japanese_jisx0212;
-Lisp_Object Vcharset_chinese_cns11643_1;
-Lisp_Object Vcharset_chinese_cns11643_2;
-#ifdef UTF2000
-Lisp_Object Vcharset_ucs;
-Lisp_Object Vcharset_ucs_bmp;
-Lisp_Object Vcharset_ucs_cns;
-Lisp_Object Vcharset_latin_viscii;
-Lisp_Object Vcharset_latin_tcvn5712;
-Lisp_Object Vcharset_latin_viscii_lower;
-Lisp_Object Vcharset_latin_viscii_upper;
-Lisp_Object Vcharset_chinese_big5;
-Lisp_Object Vcharset_ideograph_gt;
-Lisp_Object Vcharset_ideograph_gt_pj_1;
-Lisp_Object Vcharset_ideograph_gt_pj_2;
-Lisp_Object Vcharset_ideograph_gt_pj_3;
-Lisp_Object Vcharset_ideograph_gt_pj_4;
-Lisp_Object Vcharset_ideograph_gt_pj_5;
-Lisp_Object Vcharset_ideograph_gt_pj_6;
-Lisp_Object Vcharset_ideograph_gt_pj_7;
-Lisp_Object Vcharset_ideograph_gt_pj_8;
-Lisp_Object Vcharset_ideograph_gt_pj_9;
-Lisp_Object Vcharset_ideograph_gt_pj_10;
-Lisp_Object Vcharset_ideograph_gt_pj_11;
-Lisp_Object Vcharset_ideograph_daikanwa;
-Lisp_Object Vcharset_mojikyo;
-Lisp_Object Vcharset_mojikyo_2022_1;
-Lisp_Object Vcharset_mojikyo_pj_1;
-Lisp_Object Vcharset_mojikyo_pj_2;
-Lisp_Object Vcharset_mojikyo_pj_3;
-Lisp_Object Vcharset_mojikyo_pj_4;
-Lisp_Object Vcharset_mojikyo_pj_5;
-Lisp_Object Vcharset_mojikyo_pj_6;
-Lisp_Object Vcharset_mojikyo_pj_7;
-Lisp_Object Vcharset_mojikyo_pj_8;
-Lisp_Object Vcharset_mojikyo_pj_9;
-Lisp_Object Vcharset_mojikyo_pj_10;
-Lisp_Object Vcharset_mojikyo_pj_11;
-Lisp_Object Vcharset_mojikyo_pj_12;
-Lisp_Object Vcharset_mojikyo_pj_13;
-Lisp_Object Vcharset_mojikyo_pj_14;
-Lisp_Object Vcharset_mojikyo_pj_15;
-Lisp_Object Vcharset_mojikyo_pj_16;
-Lisp_Object Vcharset_mojikyo_pj_17;
-Lisp_Object Vcharset_mojikyo_pj_18;
-Lisp_Object Vcharset_mojikyo_pj_19;
-Lisp_Object Vcharset_mojikyo_pj_20;
-Lisp_Object Vcharset_mojikyo_pj_21;
-Lisp_Object Vcharset_ethiopic_ucs;
-#endif
-Lisp_Object Vcharset_chinese_big5_1;
-Lisp_Object Vcharset_chinese_big5_2;
-
-#ifdef ENABLE_COMPOSITE_CHARS
-Lisp_Object Vcharset_composite;
-
-/* Hash tables for composite chars. One maps string representing
- composed chars to their equivalent chars; one goes the
- other way. */
-Lisp_Object Vcomposite_char_char2string_hash_table;
-Lisp_Object Vcomposite_char_string2char_hash_table;
-
-static int composite_char_row_next;
-static int composite_char_col_next;
-
-#endif /* ENABLE_COMPOSITE_CHARS */
-
-struct charset_lookup *chlook;
-
-static const struct lrecord_description charset_lookup_description_1[] = {
- { XD_LISP_OBJECT_ARRAY, offsetof (struct charset_lookup, charset_by_leading_byte),
-#ifdef UTF2000
- 128+4*128
-#else
- 128+4*128*2
-#endif
- }, { XD_END }
-};
-
-static const struct struct_description charset_lookup_description = {
- sizeof (struct charset_lookup),
- charset_lookup_description_1
-};
-
-#ifndef UTF2000
-/* Table of number of bytes in the string representation of a character
- indexed by the first byte of that representation.
-
- rep_bytes_by_first_byte(c) is more efficient than the equivalent
- canonical computation:
-
- XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c)) */
-
-const Bytecount rep_bytes_by_first_byte[0xA0] =
-{ /* 0x00 - 0x7f are for straight ASCII */
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
- /* 0x80 - 0x8f are for Dimension-1 official charsets */
-#ifdef CHAR_IS_UCS4
- 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
-#else
- 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
-#endif
- /* 0x90 - 0x9d are for Dimension-2 official charsets */
- /* 0x9e is for Dimension-1 private charsets */
- /* 0x9f is for Dimension-2 private charsets */
- 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
-};
-#endif
-
-#ifdef UTF2000
-
-#define BT_UINT8_MIN 0
-#define BT_UINT8_MAX (UCHAR_MAX - 3)
-#define BT_UINT8_t (UCHAR_MAX - 2)
-#define BT_UINT8_nil (UCHAR_MAX - 1)
-#define BT_UINT8_unbound UCHAR_MAX
-
-INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
-INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
-INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
-INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
-INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
-
-INLINE_HEADER int
-INT_UINT8_P (Lisp_Object obj)
-{
- if (INTP (obj))
- {
- int num = XINT (obj);
-
- return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
- }
- else
- return 0;
-}
-
-INLINE_HEADER int
-UINT8_VALUE_P (Lisp_Object obj)
-{
- return EQ (obj, Qunbound)
- || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
-}
-
-INLINE_HEADER unsigned char
-UINT8_ENCODE (Lisp_Object obj)
-{
- if (EQ (obj, Qunbound))
- return BT_UINT8_unbound;
- else if (EQ (obj, Qnil))
- return BT_UINT8_nil;
- else if (EQ (obj, Qt))
- return BT_UINT8_t;
- else
- return XINT (obj);
-}
-
-INLINE_HEADER Lisp_Object
-UINT8_DECODE (unsigned char n)
-{
- if (n == BT_UINT8_unbound)
- return Qunbound;
- else if (n == BT_UINT8_nil)
- return Qnil;
- else if (n == BT_UINT8_t)
- return Qt;
- else
- return make_int (n);
-}
-
-static Lisp_Object
-mark_uint8_byte_table (Lisp_Object obj)
-{
- return Qnil;
-}
-
-static void
-print_uint8_byte_table (Lisp_Object obj,
- Lisp_Object printcharfun, int escapeflag)
-{
- Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
- int i;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (obj, printcharfun);
-
- write_c_string ("\n#<uint8-byte-table", printcharfun);
- for (i = 0; i < 256; i++)
- {
- unsigned char n = bte->property[i];
- if ( (i & 15) == 0 )
- write_c_string ("\n ", printcharfun);
- write_c_string (" ", printcharfun);
- if (n == BT_UINT8_unbound)
- write_c_string ("void", printcharfun);
- else if (n == BT_UINT8_nil)
- write_c_string ("nil", printcharfun);
- else if (n == BT_UINT8_t)
- write_c_string ("t", printcharfun);
- else
- {
- char buf[4];
-
- sprintf (buf, "%hd", n);
- write_c_string (buf, printcharfun);
- }
- }
- UNGCPRO;
- write_c_string (">", printcharfun);
-}
-
-static int
-uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
-{
- Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
- Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
- int i;
-
- for (i = 0; i < 256; i++)
- if (te1->property[i] != te2->property[i])
- return 0;
- return 1;
-}
-
-static unsigned long
-uint8_byte_table_hash (Lisp_Object obj, int depth)
-{
- Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
- int i;
- hashcode_t hash = 0;
-
- for (i = 0; i < 256; i++)
- hash = HASH2 (hash, te->property[i]);
- return hash;
-}
-
-DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
- mark_uint8_byte_table,
- print_uint8_byte_table,
- 0, uint8_byte_table_equal,
- uint8_byte_table_hash,
- 0 /* uint8_byte_table_description */,
- Lisp_Uint8_Byte_Table);
-
-static Lisp_Object
-make_uint8_byte_table (unsigned char initval)
-{
- Lisp_Object obj;
- int i;
- Lisp_Uint8_Byte_Table *cte;
-
- cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
- &lrecord_uint8_byte_table);
-
- for (i = 0; i < 256; i++)
- cte->property[i] = initval;
-
- XSETUINT8_BYTE_TABLE (obj, cte);
- return obj;
-}
-
-static int
-uint8_byte_table_same_value_p (Lisp_Object obj)
-{
- Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
- unsigned char v0 = bte->property[0];
- int i;
-
- for (i = 1; i < 256; i++)
- {
- if (bte->property[i] != v0)
- return 0;
- }
- return -1;
-}
-
-
-#define BT_UINT16_MIN 0
-#define BT_UINT16_MAX (USHRT_MAX - 3)
-#define BT_UINT16_t (USHRT_MAX - 2)
-#define BT_UINT16_nil (USHRT_MAX - 1)
-#define BT_UINT16_unbound USHRT_MAX
-
-INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
-INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
-INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
-INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
-
-INLINE_HEADER int
-INT_UINT16_P (Lisp_Object obj)
-{
- if (INTP (obj))
- {
- int num = XINT (obj);
-
- return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
- }
- else
- return 0;
-}
-
-INLINE_HEADER int
-UINT16_VALUE_P (Lisp_Object obj)
-{
- return EQ (obj, Qunbound)
- || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
-}
-
-INLINE_HEADER unsigned short
-UINT16_ENCODE (Lisp_Object obj)
-{
- if (EQ (obj, Qunbound))
- return BT_UINT16_unbound;
- else if (EQ (obj, Qnil))
- return BT_UINT16_nil;
- else if (EQ (obj, Qt))
- return BT_UINT16_t;
- else
- return XINT (obj);
-}
-
-INLINE_HEADER Lisp_Object
-UINT16_DECODE (unsigned short n)
-{
- if (n == BT_UINT16_unbound)
- return Qunbound;
- else if (n == BT_UINT16_nil)
- return Qnil;
- else if (n == BT_UINT16_t)
- return Qt;
- else
- return make_int (n);
-}
-
-INLINE_HEADER unsigned short
-UINT8_TO_UINT16 (unsigned char n)
-{
- if (n == BT_UINT8_unbound)
- return BT_UINT16_unbound;
- else if (n == BT_UINT8_nil)
- return BT_UINT16_nil;
- else if (n == BT_UINT8_t)
- return BT_UINT16_t;
- else
- return n;
-}
-
-static Lisp_Object
-mark_uint16_byte_table (Lisp_Object obj)
-{
- return Qnil;
-}
-
-static void
-print_uint16_byte_table (Lisp_Object obj,
- Lisp_Object printcharfun, int escapeflag)
-{
- Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
- int i;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (obj, printcharfun);
-
- write_c_string ("\n#<uint16-byte-table", printcharfun);
- for (i = 0; i < 256; i++)
- {
- unsigned short n = bte->property[i];
- if ( (i & 15) == 0 )
- write_c_string ("\n ", printcharfun);
- write_c_string (" ", printcharfun);
- if (n == BT_UINT16_unbound)
- write_c_string ("void", printcharfun);
- else if (n == BT_UINT16_nil)
- write_c_string ("nil", printcharfun);
- else if (n == BT_UINT16_t)
- write_c_string ("t", printcharfun);
- else
- {
- char buf[7];
-
- sprintf (buf, "%hd", n);
- write_c_string (buf, printcharfun);
- }
- }
- UNGCPRO;
- write_c_string (">", printcharfun);
-}
-
-static int
-uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
-{
- Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
- Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
- int i;
-
- for (i = 0; i < 256; i++)
- if (te1->property[i] != te2->property[i])
- return 0;
- return 1;
-}
-
-static unsigned long
-uint16_byte_table_hash (Lisp_Object obj, int depth)
-{
- Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
- int i;
- hashcode_t hash = 0;
-
- for (i = 0; i < 256; i++)
- hash = HASH2 (hash, te->property[i]);
- return hash;
-}
-
-DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
- mark_uint16_byte_table,
- print_uint16_byte_table,
- 0, uint16_byte_table_equal,
- uint16_byte_table_hash,
- 0 /* uint16_byte_table_description */,
- Lisp_Uint16_Byte_Table);
-
-static Lisp_Object
-make_uint16_byte_table (unsigned short initval)
-{
- Lisp_Object obj;
- int i;
- Lisp_Uint16_Byte_Table *cte;
-
- cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
- &lrecord_uint16_byte_table);
-
- for (i = 0; i < 256; i++)
- cte->property[i] = initval;
-
- XSETUINT16_BYTE_TABLE (obj, cte);
- return obj;
-}
-
-static Lisp_Object
-expand_uint8_byte_table_to_uint16 (Lisp_Object table)
-{
- Lisp_Object obj;
- int i;
- Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
- Lisp_Uint16_Byte_Table* cte;
-
- cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
- &lrecord_uint16_byte_table);
- for (i = 0; i < 256; i++)
- {
- cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
- }
- XSETUINT16_BYTE_TABLE (obj, cte);
- return obj;
-}
-
-static int
-uint16_byte_table_same_value_p (Lisp_Object obj)
-{
- Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
- unsigned short v0 = bte->property[0];
- int i;
-
- for (i = 1; i < 256; i++)
- {
- if (bte->property[i] != v0)
- return 0;
- }
- return -1;
-}
-
-
-static Lisp_Object
-mark_byte_table (Lisp_Object obj)
-{
- Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
- int i;
-
- for (i = 0; i < 256; i++)
- {
- mark_object (cte->property[i]);
- }
- return Qnil;
-}
-
-static void
-print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
-{
- Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
- int i;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (obj, printcharfun);
-
- write_c_string ("\n#<byte-table", printcharfun);
- for (i = 0; i < 256; i++)
- {
- Lisp_Object elt = bte->property[i];
- if ( (i & 15) == 0 )
- write_c_string ("\n ", printcharfun);
- write_c_string (" ", printcharfun);
- if (EQ (elt, Qunbound))
- write_c_string ("void", printcharfun);
- else
- print_internal (elt, printcharfun, escapeflag);
- }
- UNGCPRO;
- write_c_string (">", printcharfun);
-}
-
-static int
-byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
-{
- Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
- Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
- int i;
-
- for (i = 0; i < 256; i++)
- if (BYTE_TABLE_P (cte1->property[i]))
- {
- if (BYTE_TABLE_P (cte2->property[i]))
- {
- if (!byte_table_equal (cte1->property[i],
- cte2->property[i], depth + 1))
- return 0;
- }
- else
- return 0;
- }
- else
- if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
- return 0;
- return 1;
-}
-
-static unsigned long
-byte_table_hash (Lisp_Object obj, int depth)
-{
- Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
-
- return internal_array_hash (cte->property, 256, depth);
-}
-
-static const struct lrecord_description byte_table_description[] = {
- { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
- { XD_END }
-};
-
-DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
- mark_byte_table,
- print_byte_table,
- 0, byte_table_equal,
- byte_table_hash,
- byte_table_description,
- Lisp_Byte_Table);
-
-static Lisp_Object
-make_byte_table (Lisp_Object initval)
-{
- Lisp_Object obj;
- int i;
- Lisp_Byte_Table *cte;
-
- cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
-
- for (i = 0; i < 256; i++)
- cte->property[i] = initval;
-
- XSETBYTE_TABLE (obj, cte);
- return obj;
-}
-
-static int
-byte_table_same_value_p (Lisp_Object obj)
-{
- Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
- Lisp_Object v0 = bte->property[0];
- int i;
-
- for (i = 1; i < 256; i++)
- {
- if (!internal_equal (bte->property[i], v0, 0))
- return 0;
- }
- return -1;
-}
-
-
-Lisp_Object get_byte_table (Lisp_Object table, unsigned char idx);
-Lisp_Object put_byte_table (Lisp_Object table, unsigned char idx,
- Lisp_Object value);
-
-Lisp_Object
-get_byte_table (Lisp_Object table, unsigned char idx)
-{
- if (UINT8_BYTE_TABLE_P (table))
- return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
- else if (UINT16_BYTE_TABLE_P (table))
- return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
- else if (BYTE_TABLE_P (table))
- return XBYTE_TABLE(table)->property[idx];
- else
- return table;
-}
-
-Lisp_Object
-put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
-{
- if (UINT8_BYTE_TABLE_P (table))
- {
- if (UINT8_VALUE_P (value))
- {
- XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
- if (!UINT8_BYTE_TABLE_P (value) &&
- !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
- && uint8_byte_table_same_value_p (table))
- {
- return value;
- }
- }
- else if (UINT16_VALUE_P (value))
- {
- Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
-
- XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
- return new;
- }
- else
- {
- Lisp_Object new = make_byte_table (Qnil);
- int i;
-
- for (i = 0; i < 256; i++)
- {
- XBYTE_TABLE(new)->property[i]
- = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
- }
- XBYTE_TABLE(new)->property[idx] = value;
- return new;
- }
- }
- else if (UINT16_BYTE_TABLE_P (table))
- {
- if (UINT16_VALUE_P (value))
- {
- XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
- if (!UINT8_BYTE_TABLE_P (value) &&
- !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
- && uint16_byte_table_same_value_p (table))
- {
- return value;
- }
- }
- else
- {
- Lisp_Object new = make_byte_table (Qnil);
- int i;
-
- for (i = 0; i < 256; i++)
- {
- XBYTE_TABLE(new)->property[i]
- = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
- }
- XBYTE_TABLE(new)->property[idx] = value;
- return new;
- }
- }
- else if (BYTE_TABLE_P (table))
- {
- XBYTE_TABLE(table)->property[idx] = value;
- if (!UINT8_BYTE_TABLE_P (value) &&
- !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
- && byte_table_same_value_p (table))
- {
- return value;
- }
- }
- else if (!internal_equal (table, value, 0))
- {
- if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
- {
- table = make_uint8_byte_table (UINT8_ENCODE (table));
- XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
- }
- else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
- {
- table = make_uint16_byte_table (UINT16_ENCODE (table));
- XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
- }
- else
- {
- table = make_byte_table (table);
- XBYTE_TABLE(table)->property[idx] = value;
- }
- }
- return table;
-}
-
-static Lisp_Object
-mark_char_id_table (Lisp_Object obj)
-{
- Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (obj);
-
- return cte->table;
-}
-
-static void
-print_char_id_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
-{
- Lisp_Object table = XCHAR_ID_TABLE (obj)->table;
- int i;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (obj, printcharfun);
-
- write_c_string ("#<char-id-table ", printcharfun);
- for (i = 0; i < 256; i++)
- {
- Lisp_Object elt = get_byte_table (table, i);
- if (i != 0) write_c_string ("\n ", printcharfun);
- if (EQ (elt, Qunbound))
- write_c_string ("void", printcharfun);
- else
- print_internal (elt, printcharfun, escapeflag);
- }
- UNGCPRO;
- write_c_string (">", printcharfun);
-}
-
-static int
-char_id_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
-{
- Lisp_Object table1 = XCHAR_ID_TABLE (obj1)->table;
- Lisp_Object table2 = XCHAR_ID_TABLE (obj2)->table;
- int i;
-
- for (i = 0; i < 256; i++)
- {
- if (!internal_equal (get_byte_table (table1, i),
- get_byte_table (table2, i), 0))
- return 0;
- }
- return -1;
-}
-
-static unsigned long
-char_id_table_hash (Lisp_Object obj, int depth)
-{
- Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (obj);
-
- return char_id_table_hash (cte->table, depth + 1);
-}
-
-static const struct lrecord_description char_id_table_description[] = {
- { XD_LISP_OBJECT, offsetof(Lisp_Char_ID_Table, table) },
- { XD_END }
-};
-
-DEFINE_LRECORD_IMPLEMENTATION ("char-id-table", char_id_table,
- mark_char_id_table,
- print_char_id_table,
- 0, char_id_table_equal,
- char_id_table_hash,
- char_id_table_description,
- Lisp_Char_ID_Table);
-
-static Lisp_Object
-make_char_id_table (Lisp_Object initval)
-{
- Lisp_Object obj;
- Lisp_Char_ID_Table *cte;
-
- cte = alloc_lcrecord_type (Lisp_Char_ID_Table, &lrecord_char_id_table);
-
- cte->table = make_byte_table (initval);
-
- XSETCHAR_ID_TABLE (obj, cte);
- return obj;
-}
-
-
-Lisp_Object
-get_char_id_table (Emchar ch, Lisp_Object table)
-{
- unsigned int code = ch;
-
- return
- get_byte_table
- (get_byte_table
- (get_byte_table
- (get_byte_table
- (XCHAR_ID_TABLE (table)->table,
- (unsigned char)(code >> 24)),
- (unsigned char) (code >> 16)),
- (unsigned char) (code >> 8)),
- (unsigned char) code);
-}
-
-void put_char_id_table (Emchar ch, Lisp_Object value, Lisp_Object table);
-void
-put_char_id_table (Emchar ch, Lisp_Object value, Lisp_Object table)
-{
- unsigned int code = ch;
- Lisp_Object table1, table2, table3, table4;
-
- table1 = XCHAR_ID_TABLE (table)->table;
- table2 = get_byte_table (table1, (unsigned char)(code >> 24));
- table3 = get_byte_table (table2, (unsigned char)(code >> 16));
- table4 = get_byte_table (table3, (unsigned char)(code >> 8));
-
- table4 = put_byte_table (table4, (unsigned char)code, value);
- table3 = put_byte_table (table3, (unsigned char)(code >> 8), table4);
- table2 = put_byte_table (table2, (unsigned char)(code >> 16), table3);
- XCHAR_ID_TABLE (table)->table
- = put_byte_table (table1, (unsigned char)(code >> 24), table2);
-}
-
-
-Lisp_Object Vchar_attribute_hash_table;
-Lisp_Object Vcharacter_composition_table;
-Lisp_Object Vcharacter_variant_table;
-
-Lisp_Object Qideograph_daikanwa;
-Lisp_Object Q_decomposition;
-Lisp_Object Qucs;
-Lisp_Object Q_ucs;
-Lisp_Object Qcompat;
-Lisp_Object Qisolated;
-Lisp_Object Qinitial;
-Lisp_Object Qmedial;
-Lisp_Object Qfinal;
-Lisp_Object Qvertical;
-Lisp_Object QnoBreak;
-Lisp_Object Qfraction;
-Lisp_Object Qsuper;
-Lisp_Object Qsub;
-Lisp_Object Qcircle;
-Lisp_Object Qsquare;
-Lisp_Object Qwide;
-Lisp_Object Qnarrow;
-Lisp_Object Qsmall;
-Lisp_Object Qfont;
-
-Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
-
-Lisp_Object put_char_ccs_code_point (Lisp_Object character,
- Lisp_Object ccs, Lisp_Object value);
-Lisp_Object remove_char_ccs (Lisp_Object character, Lisp_Object ccs);
-
-Emchar
-to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
-{
- if (INTP (v))
- return XINT (v);
- if (CHARP (v))
- return XCHAR (v);
- else if (EQ (v, Qcompat))
- return -1;
- else if (EQ (v, Qisolated))
- return -2;
- else if (EQ (v, Qinitial))
- return -3;
- else if (EQ (v, Qmedial))
- return -4;
- else if (EQ (v, Qfinal))
- return -5;
- else if (EQ (v, Qvertical))
- return -6;
- else if (EQ (v, QnoBreak))
- return -7;
- else if (EQ (v, Qfraction))
- return -8;
- else if (EQ (v, Qsuper))
- return -9;
- else if (EQ (v, Qsub))
- return -10;
- else if (EQ (v, Qcircle))
- return -11;
- else if (EQ (v, Qsquare))
- return -12;
- else if (EQ (v, Qwide))
- return -13;
- else if (EQ (v, Qnarrow))
- return -14;
- else if (EQ (v, Qsmall))
- return -15;
- else if (EQ (v, Qfont))
- return -16;
- else
- signal_simple_error (err_msg, err_arg);
-}
-
-DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
-Return character corresponding with list.
-*/
- (list))
-{
- Lisp_Object table = Vcharacter_composition_table;
- Lisp_Object rest = list;
-
- while (CONSP (rest))
- {
- Lisp_Object v = Fcar (rest);
- Lisp_Object ret;
- Emchar c = to_char_id (v, "Invalid value for composition", list);
-
- ret = get_char_id_table (c, table);
-
- rest = Fcdr (rest);
- if (NILP (rest))
- {
- if (!CHAR_ID_TABLE_P (ret))
- return ret;
- else
- return Qt;
- }
- else if (!CONSP (rest))
- break;
- else if (CHAR_ID_TABLE_P (ret))
- table = ret;
- else
- signal_simple_error ("Invalid table is found with", list);
- }
- signal_simple_error ("Invalid value for composition", list);
-}
-
-DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
-Return variants of CHARACTER.
-*/
- (character))
-{
- CHECK_CHAR (character);
- return Fcopy_list (get_char_id_table (XCHAR (character),
- Vcharacter_variant_table));
-}
-
-
-/* We store the char-attributes in hash tables with the names as the
- key and the actual char-id-table object as the value. Occasionally
- we need to use them in a list format. These routines provide us
- with that. */
-struct char_attribute_list_closure
-{
- Lisp_Object *char_attribute_list;
-};
-
-static int
-add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
- void *char_attribute_list_closure)
-{
- /* This function can GC */
- struct char_attribute_list_closure *calcl
- = (struct char_attribute_list_closure*) char_attribute_list_closure;
- Lisp_Object *char_attribute_list = calcl->char_attribute_list;
-
- *char_attribute_list = Fcons (key, *char_attribute_list);
- return 0;
-}
-
-DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
-Return the list of all existing character attributes except coded-charsets.
-*/
- ())
-{
- Lisp_Object char_attribute_list = Qnil;
- struct gcpro gcpro1;
- struct char_attribute_list_closure char_attribute_list_closure;
-
- GCPRO1 (char_attribute_list);
- char_attribute_list_closure.char_attribute_list = &char_attribute_list;
- elisp_maphash (add_char_attribute_to_list_mapper,
- Vchar_attribute_hash_table,
- &char_attribute_list_closure);
- UNGCPRO;
- return char_attribute_list;
-}
-
-DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
-Return char-id-table corresponding to ATTRIBUTE.
-*/
- (attribute))
-{
- return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
-}
-
-
-/* We store the char-id-tables in hash tables with the attributes as
- the key and the actual char-id-table object as the value. Each
- char-id-table stores values of an attribute corresponding with
- characters. Occasionally we need to get attributes of a character
- in a association-list format. These routines provide us with
- that. */
-struct char_attribute_alist_closure
-{
- Emchar char_id;
- Lisp_Object *char_attribute_alist;
-};
-
-static int
-add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
- void *char_attribute_alist_closure)
-{
- /* This function can GC */
- struct char_attribute_alist_closure *caacl =
- (struct char_attribute_alist_closure*) char_attribute_alist_closure;
- Lisp_Object ret = get_char_id_table (caacl->char_id, value);
- if (!UNBOUNDP (ret))
- {
- Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
- *char_attribute_alist
- = Fcons (Fcons (key, ret), *char_attribute_alist);
- }
- return 0;
-}
-
-DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
-Return the alist of attributes of CHARACTER.
-*/
- (character))
-{
- Lisp_Object alist = Qnil;
- int i;
-
- CHECK_CHAR (character);
- {
- struct gcpro gcpro1;
- struct char_attribute_alist_closure char_attribute_alist_closure;
-
- GCPRO1 (alist);
- char_attribute_alist_closure.char_id = XCHAR (character);
- char_attribute_alist_closure.char_attribute_alist = &alist;
- elisp_maphash (add_char_attribute_alist_mapper,
- Vchar_attribute_hash_table,
- &char_attribute_alist_closure);
- UNGCPRO;
- }
-
- for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
- {
- Lisp_Object ccs = chlook->charset_by_leading_byte[i];
-
- if (!NILP (ccs))
- {
- Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
- Lisp_Object cpos;
-
- if ( CHAR_ID_TABLE_P (encoding_table)
- && INTP (cpos = get_char_id_table (XCHAR (character),
- encoding_table)) )
- {
- alist = Fcons (Fcons (ccs, cpos), alist);
- }
- }
- }
- return alist;
-}
-
-DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
-Return the value of CHARACTER's ATTRIBUTE.
-Return DEFAULT-VALUE if the value is not exist.
-*/
- (character, attribute, default_value))
-{
- Lisp_Object ccs;
-
- CHECK_CHAR (character);
- if (!NILP (ccs = Ffind_charset (attribute)))
- {
- Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
+#include "elhash.h"
+#include "lstream.h"
+#include "device.h"
+#include "faces.h"
+#include "mule-ccl.h"
- if (CHAR_ID_TABLE_P (encoding_table))
- return get_char_id_table (XCHAR (character), encoding_table);
- }
- else
- {
- Lisp_Object table = Fgethash (attribute,
- Vchar_attribute_hash_table,
- Qunbound);
- if (!UNBOUNDP (table))
- {
- Lisp_Object ret = get_char_id_table (XCHAR (character), table);
- if (!UNBOUNDP (ret))
- return ret;
- }
- }
- return default_value;
-}
+/* The various pre-defined charsets. */
-DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
-Store CHARACTER's ATTRIBUTE with VALUE.
-*/
- (character, attribute, value))
-{
- Lisp_Object ccs;
+Lisp_Object Vcharset_ascii;
+Lisp_Object Vcharset_control_1;
+Lisp_Object Vcharset_latin_iso8859_1;
+Lisp_Object Vcharset_latin_iso8859_2;
+Lisp_Object Vcharset_latin_iso8859_3;
+Lisp_Object Vcharset_latin_iso8859_4;
+Lisp_Object Vcharset_thai_tis620;
+Lisp_Object Vcharset_greek_iso8859_7;
+Lisp_Object Vcharset_arabic_iso8859_6;
+Lisp_Object Vcharset_hebrew_iso8859_8;
+Lisp_Object Vcharset_katakana_jisx0201;
+Lisp_Object Vcharset_latin_jisx0201;
+Lisp_Object Vcharset_cyrillic_iso8859_5;
+Lisp_Object Vcharset_latin_iso8859_9;
+Lisp_Object Vcharset_japanese_jisx0208_1978;
+Lisp_Object Vcharset_chinese_gb2312;
+Lisp_Object Vcharset_chinese_gb12345;
+Lisp_Object Vcharset_japanese_jisx0208;
+Lisp_Object Vcharset_japanese_jisx0208_1990;
+Lisp_Object Vcharset_korean_ksc5601;
+Lisp_Object Vcharset_japanese_jisx0212;
+Lisp_Object Vcharset_chinese_cns11643_1;
+Lisp_Object Vcharset_chinese_cns11643_2;
+#ifdef UTF2000
+Lisp_Object Vcharset_ucs;
+Lisp_Object Vcharset_ucs_bmp;
+Lisp_Object Vcharset_ucs_cns;
+Lisp_Object Vcharset_ucs_jis;
+Lisp_Object Vcharset_ucs_big5;
+Lisp_Object Vcharset_latin_viscii;
+Lisp_Object Vcharset_latin_tcvn5712;
+Lisp_Object Vcharset_latin_viscii_lower;
+Lisp_Object Vcharset_latin_viscii_upper;
+Lisp_Object Vcharset_chinese_big5;
+Lisp_Object Vcharset_chinese_big5_cdp;
+Lisp_Object Vcharset_ideograph_hanziku_1;
+Lisp_Object Vcharset_ideograph_hanziku_2;
+Lisp_Object Vcharset_ideograph_hanziku_3;
+Lisp_Object Vcharset_ideograph_hanziku_4;
+Lisp_Object Vcharset_ideograph_hanziku_5;
+Lisp_Object Vcharset_ideograph_hanziku_6;
+Lisp_Object Vcharset_ideograph_hanziku_7;
+Lisp_Object Vcharset_ideograph_hanziku_8;
+Lisp_Object Vcharset_ideograph_hanziku_9;
+Lisp_Object Vcharset_ideograph_hanziku_10;
+Lisp_Object Vcharset_ideograph_hanziku_11;
+Lisp_Object Vcharset_ideograph_hanziku_12;
+Lisp_Object Vcharset_china3_jef;
+Lisp_Object Vcharset_ideograph_cbeta;
+Lisp_Object Vcharset_ideograph_gt;
+Lisp_Object Vcharset_ideograph_gt_pj_1;
+Lisp_Object Vcharset_ideograph_gt_pj_2;
+Lisp_Object Vcharset_ideograph_gt_pj_3;
+Lisp_Object Vcharset_ideograph_gt_pj_4;
+Lisp_Object Vcharset_ideograph_gt_pj_5;
+Lisp_Object Vcharset_ideograph_gt_pj_6;
+Lisp_Object Vcharset_ideograph_gt_pj_7;
+Lisp_Object Vcharset_ideograph_gt_pj_8;
+Lisp_Object Vcharset_ideograph_gt_pj_9;
+Lisp_Object Vcharset_ideograph_gt_pj_10;
+Lisp_Object Vcharset_ideograph_gt_pj_11;
+Lisp_Object Vcharset_ideograph_daikanwa;
+Lisp_Object Vcharset_mojikyo;
+Lisp_Object Vcharset_mojikyo_2022_1;
+Lisp_Object Vcharset_mojikyo_pj_1;
+Lisp_Object Vcharset_mojikyo_pj_2;
+Lisp_Object Vcharset_mojikyo_pj_3;
+Lisp_Object Vcharset_mojikyo_pj_4;
+Lisp_Object Vcharset_mojikyo_pj_5;
+Lisp_Object Vcharset_mojikyo_pj_6;
+Lisp_Object Vcharset_mojikyo_pj_7;
+Lisp_Object Vcharset_mojikyo_pj_8;
+Lisp_Object Vcharset_mojikyo_pj_9;
+Lisp_Object Vcharset_mojikyo_pj_10;
+Lisp_Object Vcharset_mojikyo_pj_11;
+Lisp_Object Vcharset_mojikyo_pj_12;
+Lisp_Object Vcharset_mojikyo_pj_13;
+Lisp_Object Vcharset_mojikyo_pj_14;
+Lisp_Object Vcharset_mojikyo_pj_15;
+Lisp_Object Vcharset_mojikyo_pj_16;
+Lisp_Object Vcharset_mojikyo_pj_17;
+Lisp_Object Vcharset_mojikyo_pj_18;
+Lisp_Object Vcharset_mojikyo_pj_19;
+Lisp_Object Vcharset_mojikyo_pj_20;
+Lisp_Object Vcharset_mojikyo_pj_21;
+Lisp_Object Vcharset_ethiopic_ucs;
+#endif
+Lisp_Object Vcharset_chinese_big5_1;
+Lisp_Object Vcharset_chinese_big5_2;
- CHECK_CHAR (character);
- ccs = Ffind_charset (attribute);
- if (!NILP (ccs))
- {
- return put_char_ccs_code_point (character, ccs, value);
- }
- else if (EQ (attribute, Q_decomposition))
- {
- Lisp_Object seq;
+#ifdef ENABLE_COMPOSITE_CHARS
+Lisp_Object Vcharset_composite;
- if (!CONSP (value))
- signal_simple_error ("Invalid value for ->decomposition",
- value);
+/* Hash tables for composite chars. One maps string representing
+ composed chars to their equivalent chars; one goes the
+ other way. */
+Lisp_Object Vcomposite_char_char2string_hash_table;
+Lisp_Object Vcomposite_char_string2char_hash_table;
- if (CONSP (Fcdr (value)))
- {
- Lisp_Object rest = value;
- Lisp_Object table = Vcharacter_composition_table;
- size_t len;
- int i = 0;
+static int composite_char_row_next;
+static int composite_char_col_next;
- GET_EXTERNAL_LIST_LENGTH (rest, len);
- seq = make_vector (len, Qnil);
+#endif /* ENABLE_COMPOSITE_CHARS */
- while (CONSP (rest))
- {
- Lisp_Object v = Fcar (rest);
- Lisp_Object ntable;
- Emchar c
- = to_char_id (v, "Invalid value for ->decomposition", value);
-
- if (c < 0)
- XVECTOR_DATA(seq)[i++] = v;
- else
- XVECTOR_DATA(seq)[i++] = make_char (c);
- rest = Fcdr (rest);
- if (!CONSP (rest))
- {
- put_char_id_table (c, character, table);
- break;
- }
- else
- {
- ntable = get_char_id_table (c, table);
- if (!CHAR_ID_TABLE_P (ntable))
- {
- ntable = make_char_id_table (Qnil);
- put_char_id_table (c, ntable, table);
- }
- table = ntable;
- }
- }
- }
- else
- {
- Lisp_Object v = Fcar (value);
+struct charset_lookup *chlook;
- if (INTP (v))
- {
- Emchar c = XINT (v);
- Lisp_Object ret
- = get_char_id_table (c, Vcharacter_variant_table);
+static const struct lrecord_description charset_lookup_description_1[] = {
+ { XD_LISP_OBJECT_ARRAY, offsetof (struct charset_lookup, charset_by_leading_byte),
+#ifdef UTF2000
+ 128+4*128
+#else
+ 128+4*128*2
+#endif
+ }, { XD_END }
+};
- if (NILP (Fmemq (v, ret)))
- {
- put_char_id_table (c, Fcons (character, ret),
- Vcharacter_variant_table);
- }
- }
- seq = make_vector (1, v);
- }
- value = seq;
- }
- else if (EQ (attribute, Q_ucs))
- {
- Lisp_Object ret;
- Emchar c;
+static const struct struct_description charset_lookup_description = {
+ sizeof (struct charset_lookup),
+ charset_lookup_description_1
+};
- if (!INTP (value))
- signal_simple_error ("Invalid value for ->ucs", value);
+#ifndef UTF2000
+/* Table of number of bytes in the string representation of a character
+ indexed by the first byte of that representation.
- c = XINT (value);
+ rep_bytes_by_first_byte(c) is more efficient than the equivalent
+ canonical computation:
- ret = get_char_id_table (c, Vcharacter_variant_table);
- if (NILP (Fmemq (character, ret)))
- {
- put_char_id_table (c, Fcons (character, ret),
- Vcharacter_variant_table);
- }
- }
- {
- Lisp_Object table = Fgethash (attribute,
- Vchar_attribute_hash_table,
- Qnil);
+ XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c)) */
- if (NILP (table))
- {
- table = make_char_id_table (Qunbound);
- Fputhash (attribute, table, Vchar_attribute_hash_table);
- }
- put_char_id_table (XCHAR (character), value, table);
- return value;
- }
-}
-
-DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
-Remove CHARACTER's ATTRIBUTE.
-*/
- (character, attribute))
-{
- Lisp_Object ccs;
+const Bytecount rep_bytes_by_first_byte[0xA0] =
+{ /* 0x00 - 0x7f are for straight ASCII */
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ /* 0x80 - 0x8f are for Dimension-1 official charsets */
+#ifdef CHAR_IS_UCS4
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
+#else
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+#endif
+ /* 0x90 - 0x9d are for Dimension-2 official charsets */
+ /* 0x9e is for Dimension-1 private charsets */
+ /* 0x9f is for Dimension-2 private charsets */
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
+};
+#endif
- CHECK_CHAR (character);
- ccs = Ffind_charset (attribute);
- if (!NILP (ccs))
- {
- return remove_char_ccs (character, ccs);
- }
- else
- {
- Lisp_Object table = Fgethash (attribute,
- Vchar_attribute_hash_table,
- Qunbound);
- if (!UNBOUNDP (table))
- {
- put_char_id_table (XCHAR (character), Qunbound, table);
- return Qt;
- }
- }
- return Qnil;
-}
+#ifdef UTF2000
INLINE_HEADER int CHARSET_BYTE_SIZE (Lisp_Charset* cs);
INLINE_HEADER int
XCHARSET_ENCODING_TABLE (ccs)
= encoding_table = make_char_id_table (Qnil);
}
- put_char_id_table (XCHAR (character), value, encoding_table);
+ put_char_id_table (XCHAR_TABLE(encoding_table), character, value);
return Qt;
}
XINT (cpos));
}
}
- if (CHAR_ID_TABLE_P (encoding_table))
+ if (CHAR_TABLEP (encoding_table))
{
- put_char_id_table (XCHAR (character), Qnil, encoding_table);
+ put_char_id_table (XCHAR_TABLE(encoding_table), character, Qnil);
}
return Qt;
}
-EXFUN (Fmake_char, 3);
-EXFUN (Fdecode_char, 2);
-
-DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
-Store character's ATTRIBUTES.
-*/
- (attributes))
-{
- Lisp_Object rest = attributes;
- Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
- Lisp_Object character;
-
- if (NILP (code))
- {
- while (CONSP (rest))
- {
- Lisp_Object cell = Fcar (rest);
- Lisp_Object ccs;
-
- if (!LISTP (cell))
- signal_simple_error ("Invalid argument", attributes);
- if (!NILP (ccs = Ffind_charset (Fcar (cell)))
- && ((XCHARSET_FINAL (ccs) != 0) ||
- (XCHARSET_UCS_MAX (ccs) > 0)) )
- {
- cell = Fcdr (cell);
- if (CONSP (cell))
- character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
- else
- character = Fdecode_char (ccs, cell);
- if (!NILP (character))
- goto setup_attributes;
- }
- rest = Fcdr (rest);
- }
- if (!NILP (code = Fcdr (Fassq (Q_ucs, attributes))))
- {
- if (!INTP (code))
- signal_simple_error ("Invalid argument", attributes);
- else
- character = make_char (XINT (code) + 0x100000);
- goto setup_attributes;
- }
- return Qnil;
- }
- else if (!INTP (code))
- signal_simple_error ("Invalid argument", attributes);
- else
- character = make_char (XINT (code));
-
- setup_attributes:
- rest = attributes;
- while (CONSP (rest))
- {
- Lisp_Object cell = Fcar (rest);
-
- if (!LISTP (cell))
- signal_simple_error ("Invalid argument", attributes);
-
- Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
- rest = Fcdr (rest);
- }
- return character;
-}
-
-Lisp_Object Vutf_2000_version;
#endif
#ifndef UTF2000
Qchinese_cns11643_1,
Qchinese_cns11643_2,
#ifdef UTF2000
+ Qucs,
Qucs_bmp,
Qucs_cns,
+ Qucs_jis,
+ Qucs_big5,
Qlatin_viscii,
Qlatin_tcvn5712,
Qlatin_viscii_lower,
Qvietnamese_viscii_lower,
Qvietnamese_viscii_upper,
Qchinese_big5,
+ Qchinese_big5_cdp,
+ Qideograph_hanziku_1,
+ Qideograph_hanziku_2,
+ Qideograph_hanziku_3,
+ Qideograph_hanziku_4,
+ Qideograph_hanziku_5,
+ Qideograph_hanziku_6,
+ Qideograph_hanziku_7,
+ Qideograph_hanziku_8,
+ Qideograph_hanziku_9,
+ Qideograph_hanziku_10,
+ Qideograph_hanziku_11,
+ Qideograph_hanziku_12,
+ Qchina3_jef,
+ Qideograph_cbeta,
+ Qideograph_daikanwa,
Qideograph_gt,
Qideograph_gt_pj_1,
Qideograph_gt_pj_2,
{
int c1 = code_point >> 8;
int c2 = code_point & 0xFF;
- unsigned int I
- = (c1 - 0xA1) * BIG5_SAME_ROW
- + c2 - (c2 < 0x7F ? 0x40 : 0x62);
+ unsigned int I;
- if (c1 < 0xC9)
- {
- charset = Vcharset_chinese_big5_1;
- }
- else
+ if ( ( (0xA1 <= c1) && (c1 <= 0xFE) )
+ &&
+ ( ((0x40 <= c2) && (c2 <= 0x7E)) ||
+ ((0xA1 <= c2) && (c2 <= 0xFE)) ) )
{
- charset = Vcharset_chinese_big5_2;
- I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1);
+ I = (c1 - 0xA1) * BIG5_SAME_ROW
+ + c2 - (c2 < 0x7F ? 0x40 : 0x62);
+
+ if (c1 < 0xC9)
+ {
+ charset = Vcharset_chinese_big5_1;
+ }
+ else
+ {
+ charset = Vcharset_chinese_big5_2;
+ I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1);
+ }
+ code_point = ((I / 94 + 33) << 8) | (I % 94 + 33);
}
- code_point = ((I / 94 + 33) << 8) | (I % 94 + 33);
}
if ((final = XCHARSET_FINAL (charset)) >= '0')
{
return c & 0x7F;
}
/*
- else if ((MIN_CHAR_GREEK <= c) && (c <= MAX_CHAR_GREEK))
- {
- *charset = Vcharset_greek_iso8859_7;
- return c - MIN_CHAR_GREEK + 0x20;
- }
- else if ((MIN_CHAR_CYRILLIC <= c) && (c <= MAX_CHAR_CYRILLIC))
- {
- *charset = Vcharset_cyrillic_iso8859_5;
- return c - MIN_CHAR_CYRILLIC + 0x20;
- }
- */
else if ((MIN_CHAR_HEBREW <= c) && (c <= MAX_CHAR_HEBREW))
{
*charset = Vcharset_hebrew_iso8859_8;
return c - MIN_CHAR_HEBREW + 0x20;
}
+ */
else if ((MIN_CHAR_THAI <= c) && (c <= MAX_CHAR_THAI))
{
*charset = Vcharset_thai_tis620;
*charset = Vcharset_ideograph_daikanwa;
return c - MIN_CHAR_DAIKANWA;
}
+ /*
else if (c <= MAX_CHAR_MOJIKYO_0)
{
*charset = Vcharset_mojikyo;
return c - MIN_CHAR_MOJIKYO_0;
}
+ */
else if (c < MIN_CHAR_94)
{
*charset = Vcharset_ucs;
return c;
}
}
+ /*
else if (c < MIN_CHAR_MOJIKYO)
{
*charset = Vcharset_ucs;
*charset = Vcharset_mojikyo;
return c - MIN_CHAR_MOJIKYO;
}
+ else if (c < MIN_CHAR_CHINA3_JEF)
+ {
+ *charset = Vcharset_ucs;
+ return c;
+ }
+ else if (c <= MAX_CHAR_CHINA3_JEF)
+ {
+ *charset = Vcharset_china3_jef;
+ return c - MIN_CHAR_CHINA3_JEF;
+ }
+ else if (c <= MAX_CHAR_CBETA)
+ {
+ *charset = Vcharset_ideograph_cbeta;
+ return c - MIN_CHAR_CBETA;
+ }
+ */
else
{
*charset = Vcharset_ucs;
/************************************************************************/
#ifdef UTF2000
-DEFUN ("decode-char", Fdecode_char, 2, 2, 0, /*
+DEFUN ("decode-char", Fdecode_char, 2, 3, 0, /*
Make a character from CHARSET and code-point CODE.
+If DEFINED_ONLY is non-nil, builtin character is not returned.
+If corresponding character is not found, nil is returned.
*/
- (charset, code))
+ (charset, code, defined_only))
{
int c;
c = XINT (code);
if (XCHARSET_GRAPHIC (charset) == 1)
c &= 0x7F7F7F7F;
- c = DECODE_CHAR (charset, c);
- return c ? make_char (c) : Qnil;
+ if (NILP (defined_only))
+ c = DECODE_CHAR (charset, c);
+ else
+ c = DECODE_DEFINED_CHAR (charset, c);
+ return c >= 0 ? make_char (c) : Qnil;
}
DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
CHECK_INT (code);
if (EQ (charset, Vcharset_latin_viscii))
{
- Lisp_Object chr = Fdecode_char (charset, code);
+ Lisp_Object chr = Fdecode_char (charset, code, Qnil);
Lisp_Object ret;
if (!NILP (chr))
c &= 0x7F7F7F7F;
#endif
c = decode_builtin_char (charset, c);
- return c >= 0 ? make_char (c) : Fdecode_char (charset, code);
+ return c >= 0 ? make_char (c) : Fdecode_char (charset, code, Qnil);
}
#endif
void
syms_of_mule_charset (void)
{
-#ifdef UTF2000
- INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
- INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
- INIT_LRECORD_IMPLEMENTATION (byte_table);
- INIT_LRECORD_IMPLEMENTATION (char_id_table);
-#endif
INIT_LRECORD_IMPLEMENTATION (charset);
DEFSUBR (Fcharsetp);
DEFSUBR (Fset_charset_ccl_program);
DEFSUBR (Fset_charset_registry);
#ifdef UTF2000
- DEFSUBR (Fchar_attribute_list);
- DEFSUBR (Ffind_char_attribute_table);
- DEFSUBR (Fchar_attribute_alist);
- DEFSUBR (Fget_char_attribute);
- DEFSUBR (Fput_char_attribute);
- DEFSUBR (Fremove_char_attribute);
- DEFSUBR (Fdefine_char);
- DEFSUBR (Fchar_variants);
- DEFSUBR (Fget_composite_char);
DEFSUBR (Fcharset_mapping_table);
DEFSUBR (Fset_charset_mapping_table);
#endif
defsymbol (&Qchinese_cns11643_1, "chinese-cns11643-1");
defsymbol (&Qchinese_cns11643_2, "chinese-cns11643-2");
#ifdef UTF2000
- defsymbol (&Q_ucs, "->ucs");
- defsymbol (&Q_decomposition, "->decomposition");
- defsymbol (&Qcompat, "compat");
- defsymbol (&Qisolated, "isolated");
- defsymbol (&Qinitial, "initial");
- defsymbol (&Qmedial, "medial");
- defsymbol (&Qfinal, "final");
- defsymbol (&Qvertical, "vertical");
- defsymbol (&QnoBreak, "noBreak");
- defsymbol (&Qfraction, "fraction");
- defsymbol (&Qsuper, "super");
- defsymbol (&Qsub, "sub");
- defsymbol (&Qcircle, "circle");
- defsymbol (&Qsquare, "square");
- defsymbol (&Qwide, "wide");
- defsymbol (&Qnarrow, "narrow");
- defsymbol (&Qsmall, "small");
- defsymbol (&Qfont, "font");
defsymbol (&Qucs, "ucs");
defsymbol (&Qucs_bmp, "ucs-bmp");
defsymbol (&Qucs_cns, "ucs-cns");
+ defsymbol (&Qucs_jis, "ucs-jis");
+ defsymbol (&Qucs_big5, "ucs-big5");
defsymbol (&Qlatin_viscii, "latin-viscii");
defsymbol (&Qlatin_tcvn5712, "latin-tcvn5712");
defsymbol (&Qlatin_viscii_lower, "latin-viscii-lower");
defsymbol (&Qideograph_gt_pj_11, "ideograph-gt-pj-11");
defsymbol (&Qideograph_daikanwa, "ideograph-daikanwa");
defsymbol (&Qchinese_big5, "chinese-big5");
+ defsymbol (&Qchinese_big5_cdp, "chinese-big5-cdp");
+ defsymbol (&Qideograph_hanziku_1, "ideograph-hanziku-1");
+ defsymbol (&Qideograph_hanziku_2, "ideograph-hanziku-2");
+ defsymbol (&Qideograph_hanziku_3, "ideograph-hanziku-3");
+ defsymbol (&Qideograph_hanziku_4, "ideograph-hanziku-4");
+ defsymbol (&Qideograph_hanziku_5, "ideograph-hanziku-5");
+ defsymbol (&Qideograph_hanziku_6, "ideograph-hanziku-6");
+ defsymbol (&Qideograph_hanziku_7, "ideograph-hanziku-7");
+ defsymbol (&Qideograph_hanziku_8, "ideograph-hanziku-8");
+ defsymbol (&Qideograph_hanziku_9, "ideograph-hanziku-9");
+ defsymbol (&Qideograph_hanziku_10, "ideograph-hanziku-10");
+ defsymbol (&Qideograph_hanziku_11, "ideograph-hanziku-11");
+ defsymbol (&Qideograph_hanziku_12, "ideograph-hanziku-12");
+ defsymbol (&Qchina3_jef, "china3-jef");
+ defsymbol (&Qideograph_cbeta, "ideograph-cbeta");
defsymbol (&Qmojikyo, "mojikyo");
defsymbol (&Qmojikyo_2022_1, "mojikyo-2022-1");
defsymbol (&Qmojikyo_pj_1, "mojikyo-pj-1");
int k;
#endif
- chlook = xnew (struct charset_lookup);
- dumpstruct (&chlook, &charset_lookup_description);
+ chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */
+ dump_add_root_struct_ptr (&chlook, &charset_lookup_description);
/* Table of charsets indexed by leading byte. */
for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
#endif
#ifdef UTF2000
- Vutf_2000_version = build_string("0.17 (Hōryūji)");
- DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
-Version number of UTF-2000.
-*/ );
-
- staticpro (&Vcharacter_composition_table);
- Vcharacter_composition_table = make_char_id_table (Qnil);
-
- staticpro (&Vcharacter_variant_table);
- Vcharacter_variant_table = make_char_id_table (Qnil);
-
Vdefault_coded_charset_priority_list = Qnil;
DEFVAR_LISP ("default-coded-charset-priority-list",
&Vdefault_coded_charset_priority_list /*
ease of access. */
#ifdef UTF2000
- staticpro (&Vchar_attribute_hash_table);
- Vchar_attribute_hash_table
- = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
-
staticpro (&Vcharset_ucs);
Vcharset_ucs =
make_charset (LEADING_BYTE_UCS, Qucs, 256, 4,
build_string ("ISO/IEC 10646 for CNS 11643"),
build_string (""),
Qnil, 0, 0, 0, 0);
+ staticpro (&Vcharset_ucs_jis);
+ Vcharset_ucs_jis =
+ make_charset (LEADING_BYTE_UCS_JIS, Qucs_jis, 256, 3,
+ 1, 2, 0, CHARSET_LEFT_TO_RIGHT,
+ build_string ("UCS for JIS"),
+ build_string ("UCS for JIS X 0208, 0212 and 0213"),
+ build_string ("ISO/IEC 10646 for JIS X 0208, 0212 and 0213"),
+ build_string (""),
+ Qnil, 0, 0, 0, 0);
+ staticpro (&Vcharset_ucs_big5);
+ Vcharset_ucs_big5 =
+ make_charset (LEADING_BYTE_UCS_BIG5, Qucs_big5, 256, 3,
+ 1, 2, 0, CHARSET_LEFT_TO_RIGHT,
+ build_string ("UCS for Big5"),
+ build_string ("UCS for Big5"),
+ build_string ("ISO/IEC 10646 for Big5"),
+ build_string (""),
+ Qnil, 0, 0, 0, 0);
#else
# define MIN_CHAR_THAI 0
# define MAX_CHAR_THAI 0
-# define MIN_CHAR_HEBREW 0
-# define MAX_CHAR_HEBREW 0
+ /* # define MIN_CHAR_HEBREW 0 */
+ /* # define MAX_CHAR_HEBREW 0 */
# define MIN_CHAR_HALFWIDTH_KATAKANA 0
# define MAX_CHAR_HALFWIDTH_KATAKANA 0
#endif
build_string ("ISO8859-7 (Greek)"),
build_string ("ISO8859-7 (Greek)"),
build_string ("iso8859-7"),
- Qnil,
- 0 /* MIN_CHAR_GREEK */,
- 0 /* MAX_CHAR_GREEK */, 0, 32);
+ Qnil, 0, 0, 0, 32);
staticpro (&Vcharset_arabic_iso8859_6);
Vcharset_arabic_iso8859_6 =
make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
build_string ("ISO8859-8 (Hebrew)"),
build_string ("ISO8859-8 (Hebrew)"),
build_string ("iso8859-8"),
- Qnil, MIN_CHAR_HEBREW, MAX_CHAR_HEBREW, 0, 32);
+ Qnil,
+ 0 /* MIN_CHAR_HEBREW */,
+ 0 /* MAX_CHAR_HEBREW */, 0, 32);
staticpro (&Vcharset_katakana_jisx0201);
Vcharset_katakana_jisx0201 =
make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 94, 1,
build_string ("ISO8859-5 (Cyrillic)"),
build_string ("ISO8859-5 (Cyrillic)"),
build_string ("iso8859-5"),
- Qnil,
- 0 /* MIN_CHAR_CYRILLIC */,
- 0 /* MAX_CHAR_CYRILLIC */, 0, 32);
+ Qnil, 0, 0, 0, 32);
staticpro (&Vcharset_latin_iso8859_9);
Vcharset_latin_iso8859_9 =
make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
build_string ("TCVN 5712"),
build_string ("TCVN 5712 (VSCII-2)"),
build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
- build_string ("tcvn5712-1"),
+ build_string ("tcvn5712\\(\\.1993\\)?-1"),
Qnil, 0, 0, 0, 32);
staticpro (&Vcharset_latin_viscii_lower);
Vcharset_latin_viscii_lower =
build_string ("Big5"),
build_string ("Big5 Chinese traditional"),
build_string ("big5"),
- Qnil, 0, 0, 0, 0);
+ Qnil,
+ /* 0 */ MIN_CHAR_BIG5_CDP,
+ /* 0 */ MAX_CHAR_BIG5_CDP, 0, 0);
+ staticpro (&Vcharset_chinese_big5_cdp);
+ Vcharset_chinese_big5_cdp =
+ make_charset (LEADING_BYTE_CHINESE_BIG5_CDP, Qchinese_big5_cdp, 256, 2,
+ 2, 2, 0, CHARSET_LEFT_TO_RIGHT,
+ build_string ("Big5-CDP"),
+ build_string ("Big5 + CDP extension"),
+ build_string ("Big5 with CDP extension"),
+ build_string ("big5\\.cdp-0"),
+ Qnil, MIN_CHAR_BIG5_CDP, MAX_CHAR_BIG5_CDP, 0, 0);
+#define DEF_HANZIKU(n) \
+ staticpro (&Vcharset_ideograph_hanziku_##n); \
+ Vcharset_ideograph_hanziku_##n = \
+ make_charset (LEADING_BYTE_HANZIKU_##n, Qideograph_hanziku_##n, 256, 2, \
+ 2, 2, 0, CHARSET_LEFT_TO_RIGHT, \
+ build_string ("HZK-"#n), \
+ build_string ("HANZIKU-"#n), \
+ build_string ("HANZIKU (pseudo BIG5 encoding) part "#n), \
+ build_string \
+ ("hanziku-"#n"$"), \
+ Qnil, MIN_CHAR_HANZIKU_##n, MAX_CHAR_HANZIKU_##n, 0, 0);
+ DEF_HANZIKU (1);
+ DEF_HANZIKU (2);
+ DEF_HANZIKU (3);
+ DEF_HANZIKU (4);
+ DEF_HANZIKU (5);
+ DEF_HANZIKU (6);
+ DEF_HANZIKU (7);
+ DEF_HANZIKU (8);
+ DEF_HANZIKU (9);
+ DEF_HANZIKU (10);
+ DEF_HANZIKU (11);
+ DEF_HANZIKU (12);
+ staticpro (&Vcharset_china3_jef);
+ Vcharset_china3_jef =
+ make_charset (LEADING_BYTE_CHINA3_JEF, Qchina3_jef, 256, 2,
+ 2, 2, 0, CHARSET_LEFT_TO_RIGHT,
+ build_string ("JC3"),
+ build_string ("JEF + CHINA3"),
+ build_string ("JEF + CHINA3 private characters"),
+ build_string ("china3jef-0"),
+ Qnil, MIN_CHAR_CHINA3_JEF, MAX_CHAR_CHINA3_JEF, 0, 0);
+ staticpro (&Vcharset_ideograph_cbeta);
+ Vcharset_ideograph_cbeta =
+ make_charset (LEADING_BYTE_CBETA, Qideograph_cbeta, 256, 2,
+ 2, 2, 0, CHARSET_LEFT_TO_RIGHT,
+ build_string ("CB"),
+ build_string ("CBETA"),
+ build_string ("CBETA private characters"),
+ build_string ("cbeta-0"),
+ Qnil, MIN_CHAR_CBETA, MAX_CHAR_CBETA, 0, 0);
staticpro (&Vcharset_ideograph_gt);
Vcharset_ideograph_gt =
make_charset (LEADING_BYTE_GT, Qideograph_gt, 256, 3,
build_string ("GT (pseudo JIS encoding) part "#n), \
build_string ("GT 2000 (pseudo JIS encoding) part "#n), \
build_string \
- ("\\(GT2000PJ-"#n "\\|jisx0208\\.GT2000-"#n "\\)$"), \
+ ("\\(GTpj-"#n "\\|jisx0208\\.GT-"#n "\\)$"), \
Qnil, 0, 0, 0, 33);
DEF_GT_PJ (1);
DEF_GT_PJ (2);