}
-Lisp_Object Vcharacter_attribute_table;
-Lisp_Object Vcharacter_name_table;
+Lisp_Object Vchar_attribute_hash_table;
Lisp_Object Vcharacter_ideographic_radical_table;
Lisp_Object Vcharacter_ideographic_strokes_table;
Lisp_Object Vcharacter_total_strokes_table;
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-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;
+ Lisp_Object ret;
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);
-
+ {
+ 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;
+ }
ret = get_char_id_table (XCHAR (character),
Vcharacter_ideographic_radical_table);
if (!NILP (ret))
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),
}
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);
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);
ignored:
rest = Fcdr (rest);
}
- return
- get_char_id_table (XCHAR (character), Vcharacter_attribute_table);
+ return character;
}
Lisp_Object Vutf_2000_version;
#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);
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