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 Vcharacter_morohashi_daikanwa_table;
-Lisp_Object Vcharacter_decomposition_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 Qmorohashi_daikanwa;
Lisp_Object Qideograph_daikanwa;
Lisp_Object Q_decomposition;
Lisp_Object Qucs;
}
+/* 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
(character))
{
Lisp_Object alist = Qnil;
- Lisp_Object ret;
int i;
CHECK_CHAR (character);
&char_attribute_alist_closure);
UNGCPRO;
}
- 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_morohashi_daikanwa_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Qmorohashi_daikanwa, ret), alist);
-
- ret = get_char_id_table (XCHAR (character),
- Vcharacter_decomposition_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Q_decomposition, ret), alist);
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, 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, Qmorohashi_daikanwa))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_morohashi_daikanwa_table);
- }
- else if (EQ (attribute, Q_decomposition))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_decomposition_table);
- }
else
{
Lisp_Object table = Fgethash (attribute,
{
return put_char_ccs_code_point (character, ccs, 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, Qmorohashi_daikanwa))
- {
- CHECK_LIST (value);
- put_char_id_table (XCHAR (character), value,
- Vcharacter_morohashi_daikanwa_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))
{
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;
}
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 character;
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 (&Qmorohashi_daikanwa, "morohashi-daikanwa");
defsymbol (&Q_ucs, "->ucs");
defsymbol (&Q_decomposition, "->decomposition");
defsymbol (&Qcompat, "compat");
Version number of UTF-2000.
*/ );
- /* 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_morohashi_daikanwa_table);
- Vcharacter_morohashi_daikanwa_table = make_char_id_table (Qnil, 0);
-
- /* 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);
projects / chise / xemacs-chise.git- / blobdiff