}
-Lisp_Object Vcharacter_attribute_table;
-Lisp_Object Vcharacter_name_table;
-Lisp_Object Vcharacter_ideographic_radical_table;
-Lisp_Object Vcharacter_ideographic_strokes_table;
-Lisp_Object Vcharacter_total_strokes_table;
-Lisp_Object Vcharacter_decomposition_table;
+Lisp_Object Vchar_attribute_hash_table;
Lisp_Object Vcharacter_composition_table;
Lisp_Object Vcharacter_variant_table;
-Lisp_Object Qname;
-Lisp_Object Qideographic_radical, Qideographic_strokes;
-Lisp_Object Qtotal_strokes;
+Lisp_Object Qideograph_daikanwa;
Lisp_Object Q_decomposition;
Lisp_Object Qucs;
Lisp_Object Q_ucs;
Lisp_Object ccs, Lisp_Object value);
Lisp_Object remove_char_ccs (Lisp_Object character, Lisp_Object ccs);
-Lisp_Object put_char_attribute (Lisp_Object character,
- Lisp_Object attribute, Lisp_Object value);
-Lisp_Object remove_char_attribute (Lisp_Object character,
- Lisp_Object attribute);
-
-
Emchar
to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
{
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;
+}
+
+
+/* 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, ret;
+ Lisp_Object alist = Qnil;
int i;
CHECK_CHAR (character);
- alist = Fcopy_alist (get_char_id_table (XCHAR (character),
- Vcharacter_attribute_table));
-
- ret = get_char_id_table (XCHAR (character), Vcharacter_name_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Qname, ret), alist);
-
- ret = get_char_id_table (XCHAR (character),
- Vcharacter_ideographic_radical_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Qideographic_radical, ret), alist);
-
- ret = get_char_id_table (XCHAR (character),
- Vcharacter_ideographic_strokes_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Qideographic_strokes, ret), alist);
-
- ret = get_char_id_table (XCHAR (character), Vcharacter_total_strokes_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Qtotal_strokes, ret), alist);
-
- ret = get_char_id_table (XCHAR (character),
- Vcharacter_decomposition_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Q_decomposition, ret), alist);
+ {
+ 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++)
{
if (!NILP (ccs))
{
-#if 0
- int code_point = charset_code_point (ccs, XCHAR (character));
-
- if (code_point >= 0)
- {
- alist = Fcons (Fcons (ccs, make_int (code_point)), alist);
- }
-#else
Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
Lisp_Object cpos;
{
alist = Fcons (Fcons (ccs, cpos), alist);
}
-#endif
}
}
return alist;
else
return Qnil;
}
- else if (EQ (attribute, Qname))
- {
- return get_char_id_table (XCHAR (character), Vcharacter_name_table);
- }
- else if (EQ (attribute, Qideographic_radical))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_ideographic_radical_table);
- }
- else if (EQ (attribute, Qideographic_strokes))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_ideographic_strokes_table);
- }
- else if (EQ (attribute, Qtotal_strokes))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_total_strokes_table);
- }
- else if (EQ (attribute, Q_decomposition))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_decomposition_table);
- }
else
{
- Lisp_Object ret
- = get_char_id_table (XCHAR (character), Vcharacter_attribute_table);
-
- if (EQ (ret, Qnil))
- return Qnil;
- else
- return Fcdr (Fassq (attribute, ret));
+ 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 Qnil;
}
DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
{
return put_char_ccs_code_point (character, ccs, value);
}
- else if (EQ (attribute, Qname))
- {
- CHECK_STRING (value);
- put_char_id_table (XCHAR (character), value, Vcharacter_name_table);
- return value;
- }
- else if (EQ (attribute, Qideographic_radical))
- {
- CHECK_INT (value);
- put_char_id_table (XCHAR (character), value,
- Vcharacter_ideographic_radical_table);
- return value;
- }
- else if (EQ (attribute, Qideographic_strokes))
- {
- CHECK_INT (value);
- put_char_id_table (XCHAR (character), value,
- Vcharacter_ideographic_strokes_table);
- return value;
- }
- else if (EQ (attribute, Qtotal_strokes))
- {
- CHECK_INT (value);
- put_char_id_table (XCHAR (character), value,
- Vcharacter_total_strokes_table);
- return value;
- }
else if (EQ (attribute, Q_decomposition))
{
Lisp_Object seq;
int i = 0;
GET_EXTERNAL_LIST_LENGTH (rest, len);
- seq = make_older_vector (len, Qnil);
+ seq = make_vector (len, Qnil);
while (CONSP (rest))
{
Vcharacter_variant_table);
}
}
- seq = make_older_vector (1, v);
+ seq = make_vector (1, v);
}
- put_char_id_table (XCHAR (character), seq,
- Vcharacter_decomposition_table);
- return value;
+ value = seq;
}
else if (EQ (attribute, Q_ucs))
{
Vcharacter_variant_table);
}
}
- return put_char_attribute (character, attribute, value);
+ {
+ Lisp_Object table = Fgethash (attribute,
+ Vchar_attribute_hash_table,
+ Qnil);
+
+ if (NILP (table))
+ {
+ table = make_char_id_table (Qunbound, 0);
+ 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, /*
{
return remove_char_ccs (character, ccs);
}
- return remove_char_attribute (character, attribute);
+ 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;
}
INLINE_HEADER int CHARSET_BYTE_SIZE (Lisp_Charset* cs);
return Qt;
}
-Lisp_Object
-put_char_attribute (Lisp_Object character, Lisp_Object attribute,
- Lisp_Object value)
-{
- Emchar char_id = XCHAR (character);
- Lisp_Object ret = get_char_id_table (char_id, Vcharacter_attribute_table);
- Lisp_Object cell;
-
- cell = Fassq (attribute, ret);
-
- if (NILP (cell))
- {
- ret = Fcons (Fcons (attribute, value), ret);
- }
- else if (!EQ (Fcdr (cell), value))
- {
- Fsetcdr (cell, value);
- }
- put_char_id_table (char_id, ret, Vcharacter_attribute_table);
- return ret;
-}
-
-Lisp_Object
-remove_char_attribute (Lisp_Object character, Lisp_Object attribute)
-{
- Emchar char_id = XCHAR (character);
- Lisp_Object alist = get_char_id_table (char_id, Vcharacter_attribute_table);
-
- if (EQ (attribute, Fcar (Fcar (alist))))
- {
- alist = Fcdr (alist);
- }
- else
- {
- Lisp_Object pr = alist;
- Lisp_Object r = Fcdr (alist);
-
- while (!NILP (r))
- {
- if (EQ (attribute, Fcar (Fcar (r))))
- {
- XCDR (pr) = Fcdr (r);
- break;
- }
- pr = r;
- r = Fcdr (r);
- }
- }
- put_char_id_table (char_id, alist, Vcharacter_attribute_table);
- return alist;
-}
-
EXFUN (Fmake_char, 3);
EXFUN (Fdecode_char, 2);
Lisp_Object rest = attributes;
Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
Lisp_Object character;
+#if 0
+ Lisp_Object daikanwa = Qnil;
+#endif
if (NILP (code))
{
while (CONSP (rest))
{
Lisp_Object cell = Fcar (rest);
+#if 0
+ Lisp_Object key = Fcar (cell);
+ Lisp_Object value = Fcdr (cell);
+#endif
if (!LISTP (cell))
signal_simple_error ("Invalid argument", attributes);
+
+#if 0
+ if (EQ (key, Qmorohashi_daikanwa))
+ {
+ size_t len;
+ GET_EXTERNAL_LIST_LENGTH (value, len);
+
+ if (len == 1)
+ {
+ if (NILP (daikanwa))
+ daikanwa = Fcdr (Fassq (Qideograph_daikanwa, rest));
+ if (EQ (Fcar (value), daikanwa))
+ goto ignored;
+ }
+ }
+ else if (EQ (key, Qideograph_daikanwa))
+ daikanwa = value;
+#endif
+
Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
+#if 0
+ ignored:
+#endif
rest = Fcdr (rest);
}
- return
- get_char_id_table (XCHAR (character), Vcharacter_attribute_table);
+ return character;
}
Lisp_Object Vutf_2000_version;
Qlatin_viscii_upper,
Qvietnamese_viscii_lower,
Qvietnamese_viscii_upper,
- Qideograph_daikanwa,
Qmojikyo,
Qmojikyo_pj_1,
Qmojikyo_pj_2,
if (NILP (table))
{
+ if (VECTORP (CHARSET_DECODING_TABLE(cs)))
+ make_vector_newer (CHARSET_DECODING_TABLE(cs));
CHARSET_DECODING_TABLE(cs) = Qnil;
return table;
}
c &= 0x7F7F7F7F;
return make_char (DECODE_CHAR (charset, c));
}
+
+DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
+Make a builtin character from CHARSET and code-point CODE.
+*/
+ (charset, code))
+{
+ int c;
+ int final;
+
+ charset = Fget_charset (charset);
+ CHECK_INT (code);
+ c = XINT (code);
+
+ if ((final = XCHARSET_FINAL (charset)) >= '0')
+ {
+ if (XCHARSET_DIMENSION (charset) == 1)
+ {
+ switch (XCHARSET_CHARS (charset))
+ {
+ case 94:
+ return
+ make_char (MIN_CHAR_94 + (final - '0') * 94
+ + ((c & 0x7F) - 33));
+ case 96:
+ return
+ make_char (MIN_CHAR_96 + (final - '0') * 96
+ + ((c & 0x7F) - 32));
+ default:
+ return Fdecode_char (charset, code);
+ }
+ }
+ else
+ {
+ switch (XCHARSET_CHARS (charset))
+ {
+ case 94:
+ return
+ make_char (MIN_CHAR_94x94
+ + (final - '0') * 94 * 94
+ + (((c >> 8) & 0x7F) - 33) * 94
+ + ((c & 0x7F) - 33));
+ case 96:
+ return
+ make_char (MIN_CHAR_96x96
+ + (final - '0') * 96 * 96
+ + (((c >> 8) & 0x7F) - 32) * 96
+ + ((c & 0x7F) - 32));
+ default:
+ return Fdecode_char (charset, code);
+ }
+ }
+ }
+ else if (XCHARSET_UCS_MAX (charset))
+ {
+ Emchar cid
+ = (XCHARSET_DIMENSION (charset) == 1
+ ?
+ c - XCHARSET_BYTE_OFFSET (charset)
+ :
+ ((c >> 8) - XCHARSET_BYTE_OFFSET (charset))
+ * XCHARSET_CHARS (charset)
+ + (c & 0xFF) - XCHARSET_BYTE_OFFSET (charset))
+ - XCHARSET_CODE_OFFSET (charset) + XCHARSET_UCS_MIN (charset);
+ if ((cid < XCHARSET_UCS_MIN (charset))
+ || (XCHARSET_UCS_MAX (charset) < cid))
+ return Fdecode_char (charset, code);
+ return make_char (cid);
+ }
+ else
+ return Fdecode_char (charset, code);
+}
#endif
DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
DEFSUBR (Fset_charset_ccl_program);
DEFSUBR (Fset_charset_registry);
#ifdef UTF2000
+ DEFSUBR (Fchar_attribute_list);
DEFSUBR (Fchar_attribute_alist);
DEFSUBR (Fget_char_attribute);
DEFSUBR (Fput_char_attribute);
#ifdef UTF2000
DEFSUBR (Fdecode_char);
+ DEFSUBR (Fdecode_builtin_char);
#endif
DEFSUBR (Fmake_char);
DEFSUBR (Fchar_charset);
defsymbol (&Qchinese_cns11643_1, "chinese-cns11643-1");
defsymbol (&Qchinese_cns11643_2, "chinese-cns11643-2");
#ifdef UTF2000
- defsymbol (&Qname, "name");
- defsymbol (&Qideographic_radical, "ideographic-radical");
- defsymbol (&Qideographic_strokes, "ideographic-strokes");
- defsymbol (&Qtotal_strokes, "total-strokes");
defsymbol (&Q_ucs, "->ucs");
defsymbol (&Q_decomposition, "->decomposition");
defsymbol (&Qcompat, "compat");
#endif
#ifdef UTF2000
- Vutf_2000_version = build_string("0.15 (Sangō)");
+ Vutf_2000_version = build_string("0.16 (Ōji)");
DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
Version number of UTF-2000.
*/ );
- staticpro (&Vcharacter_attribute_table);
- Vcharacter_attribute_table = make_char_id_table (Qnil, 0);
-
- staticpro (&Vcharacter_name_table);
- Vcharacter_name_table = make_char_id_table (Qnil, 0);
-
- /* staticpro (&Vcharacter_ideographic_radical_table); */
- Vcharacter_ideographic_radical_table = make_char_id_table (Qnil, -1);
-
- /* staticpro (&Vcharacter_ideographic_strokes_table); */
- Vcharacter_ideographic_strokes_table = make_char_id_table (Qnil, -1);
-
- /* staticpro (&Vcharacter_total_strokes_table); */
- Vcharacter_total_strokes_table = make_char_id_table (Qnil, -1);
-
- /* staticpro (&Vcharacter_decomposition_table); */
- Vcharacter_decomposition_table = make_char_id_table (Qnil, -1);
-
- /* staticpro (&Vcharacter_composition_table); */
+ staticpro (&Vcharacter_composition_table);
Vcharacter_composition_table = make_char_id_table (Qnil, -1);
staticpro (&Vcharacter_variant_table);
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,
projects / chise / xemacs-chise.git- / blobdiff