+\f
+DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
+ 1, 1, 0,
+ "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
+ (char_table)
+ Lisp_Object char_table;
+{
+ CHECK_CHAR_TABLE (char_table, 0);
+
+ return XCHAR_TABLE (char_table)->purpose;
+}
+
+DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
+ 1, 1, 0,
+ "Return the parent char-table of CHAR-TABLE.\n\
+The value is either nil or another char-table.\n\
+If CHAR-TABLE holds nil for a given character,\n\
+then the actual applicable value is inherited from the parent char-table\n\
+\(or from its parents, if necessary).")
+ (char_table)
+ Lisp_Object char_table;
+{
+ CHECK_CHAR_TABLE (char_table, 0);
+
+ return XCHAR_TABLE (char_table)->parent;
+}
+
+DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
+ 2, 2, 0,
+ "Set the parent char-table of CHAR-TABLE to PARENT.\n\
+PARENT must be either nil or another char-table.")
+ (char_table, parent)
+ Lisp_Object char_table, parent;
+{
+ Lisp_Object temp;
+
+ CHECK_CHAR_TABLE (char_table, 0);
+
+ if (!NILP (parent))
+ {
+ CHECK_CHAR_TABLE (parent, 0);
+
+ for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
+ if (EQ (temp, char_table))
+ error ("Attempt to make a chartable be its own parent");
+ }
+
+ XCHAR_TABLE (char_table)->parent = parent;
+
+ return parent;
+}
+
+DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
+ 2, 2, 0,
+ "Return the value of CHAR-TABLE's extra-slot number N.")
+ (char_table, n)
+ Lisp_Object char_table, n;
+{
+ CHECK_CHAR_TABLE (char_table, 1);
+ CHECK_NUMBER (n, 2);
+ if (XINT (n) < 0
+ || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
+ args_out_of_range (char_table, n);
+
+ return XCHAR_TABLE (char_table)->extras[XINT (n)];
+}
+
+DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
+ Sset_char_table_extra_slot,
+ 3, 3, 0,
+ "Set CHAR-TABLE's extra-slot number N to VALUE.")
+ (char_table, n, value)
+ Lisp_Object char_table, n, value;
+{
+ CHECK_CHAR_TABLE (char_table, 1);
+ CHECK_NUMBER (n, 2);
+ if (XINT (n) < 0
+ || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
+ args_out_of_range (char_table, n);
+
+ return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
+}
+\f
+DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
+ 2, 2, 0,
+ "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
+RANGE should be nil (for the default value)\n\
+a vector which identifies a character set or a row of a character set,\n\
+a character set name, or a character code.")
+ (char_table, range)
+ Lisp_Object char_table, range;
+{
+ int i;
+
+ CHECK_CHAR_TABLE (char_table, 0);
+
+ if (EQ (range, Qnil))
+ return XCHAR_TABLE (char_table)->defalt;
+ else if (INTEGERP (range))
+ return Faref (char_table, range);
+ else if (SYMBOLP (range))
+ {
+ Lisp_Object charset_info;
+
+ charset_info = Fget (range, Qcharset);
+ CHECK_VECTOR (charset_info, 0);
+
+ return Faref (char_table,
+ make_number (XINT (XVECTOR (charset_info)->contents[0])
+ + 128));
+ }
+ else if (VECTORP (range))
+ {
+ if (XVECTOR (range)->size == 1)
+ return Faref (char_table,
+ make_number (XINT (XVECTOR (range)->contents[0]) + 128));
+ else
+ {
+ int size = XVECTOR (range)->size;
+ Lisp_Object *val = XVECTOR (range)->contents;
+ Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
+ size <= 1 ? Qnil : val[1],
+ size <= 2 ? Qnil : val[2]);
+ return Faref (char_table, ch);
+ }
+ }
+ else
+ error ("Invalid RANGE argument to `char-table-range'");
+}
+
+DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
+ 3, 3, 0,
+ "Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.\n\
+RANGE should be t (for all characters), nil (for the default value)\n\
+a vector which identifies a character set or a row of a character set,\n\
+a coding system, or a character code.")
+ (char_table, range, value)
+ Lisp_Object char_table, range, value;
+{
+ int i;
+
+ CHECK_CHAR_TABLE (char_table, 0);
+
+ if (EQ (range, Qt))
+ for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
+ XCHAR_TABLE (char_table)->contents[i] = value;
+ else if (EQ (range, Qnil))
+ XCHAR_TABLE (char_table)->defalt = value;
+ else if (SYMBOLP (range))
+ {
+ Lisp_Object charset_info;
+
+ charset_info = Fget (range, Qcharset);
+ CHECK_VECTOR (charset_info, 0);
+
+ return Faset (char_table,
+ make_number (XINT (XVECTOR (charset_info)->contents[0])
+ + 128),
+ value);
+ }
+ else if (INTEGERP (range))
+ Faset (char_table, range, value);
+ else if (VECTORP (range))
+ {
+ if (XVECTOR (range)->size == 1)
+ return Faset (char_table,
+ make_number (XINT (XVECTOR (range)->contents[0]) + 128),
+ value);
+ else
+ {
+ int size = XVECTOR (range)->size;
+ Lisp_Object *val = XVECTOR (range)->contents;
+ Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
+ size <= 1 ? Qnil : val[1],
+ size <= 2 ? Qnil : val[2]);
+ return Faset (char_table, ch, value);
+ }
+ }
+ else
+ error ("Invalid RANGE argument to `set-char-table-range'");
+
+ return value;
+}
+
+DEFUN ("set-char-table-default", Fset_char_table_default,
+ Sset_char_table_default, 3, 3, 0,
+ "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
+The generic character specifies the group of characters.\n\
+See also the documentation of make-char.")
+ (char_table, ch, value)
+ Lisp_Object char_table, ch, value;
+{
+ int c, i, charset, code1, code2;
+ Lisp_Object temp;
+
+ CHECK_CHAR_TABLE (char_table, 0);
+ CHECK_NUMBER (ch, 1);
+
+ c = XINT (ch);
+ SPLIT_NON_ASCII_CHAR (c, charset, code1, code2);
+ if (! CHARSET_DEFINED_P (charset))
+ invalid_character (c);
+
+ if (charset == CHARSET_ASCII)
+ return (XCHAR_TABLE (char_table)->defalt = value);
+
+ /* Even if C is not a generic char, we had better behave as if a
+ generic char is specified. */
+ if (CHARSET_DIMENSION (charset) == 1)
+ code1 = 0;
+ temp = XCHAR_TABLE (char_table)->contents[charset + 128];
+ if (!code1)
+ {
+ if (SUB_CHAR_TABLE_P (temp))
+ XCHAR_TABLE (temp)->defalt = value;
+ else
+ XCHAR_TABLE (char_table)->contents[charset + 128] = value;
+ return value;
+ }
+ char_table = temp;
+ if (! SUB_CHAR_TABLE_P (char_table))
+ char_table = (XCHAR_TABLE (char_table)->contents[charset + 128]
+ = make_sub_char_table (temp));
+ temp = XCHAR_TABLE (char_table)->contents[code1];
+ if (SUB_CHAR_TABLE_P (temp))
+ XCHAR_TABLE (temp)->defalt = value;
+ else
+ XCHAR_TABLE (char_table)->contents[code1] = value;
+ return value;
+}
+
+/* Look up the element in TABLE at index CH,
+ and return it as an integer.
+ If the element is nil, return CH itself.
+ (Actually we do that for any non-integer.) */
+
+int
+char_table_translate (table, ch)
+ Lisp_Object table;
+ int ch;
+{
+ Lisp_Object value;
+ value = Faref (table, make_number (ch));
+ if (! INTEGERP (value))
+ return ch;
+ return XINT (value);
+}
+\f
+/* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
+ character or group of characters that share a value.
+ DEPTH is the current depth in the originally specified
+ chartable, and INDICES contains the vector indices
+ for the levels our callers have descended.
+
+ ARG is passed to C_FUNCTION when that is called. */
+
+void
+map_char_table (c_function, function, subtable, arg, depth, indices)
+ void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
+ Lisp_Object function, subtable, arg, *indices;
+ int depth;
+{
+ int i, to;
+
+ if (depth == 0)
+ {
+ /* At first, handle ASCII and 8-bit European characters. */
+ for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
+ {
+ Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
+ if (c_function)
+ (*c_function) (arg, make_number (i), elt);
+ else
+ call2 (function, make_number (i), elt);
+ }
+#if 0 /* If the char table has entries for higher characters,
+ we should report them. */
+ if (NILP (current_buffer->enable_multibyte_characters))
+ return;
+#endif
+ to = CHAR_TABLE_ORDINARY_SLOTS;
+ }
+ else
+ {
+ i = 32;
+ to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
+ }
+
+ for (; i < to; i++)
+ {
+ Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
+
+ XSETFASTINT (indices[depth], i);
+
+ if (SUB_CHAR_TABLE_P (elt))
+ {
+ if (depth >= 3)
+ error ("Too deep char table");
+ map_char_table (c_function, function, elt, arg, depth + 1, indices);
+ }
+ else
+ {
+ int charset = XFASTINT (indices[0]) - 128, c1, c2, c;
+
+ if (CHARSET_DEFINED_P (charset))
+ {
+ c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
+ c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
+ c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
+ if (c_function)
+ (*c_function) (arg, make_number (c), elt);
+ else
+ call2 (function, make_number (c), elt);
+ }
+ }
+ }
+}
+
+DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
+ 2, 2, 0,
+ "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
+FUNCTION is called with two arguments--a key and a value.\n\
+The key is always a possible IDX argument to `aref'.")
+ (function, char_table)
+ Lisp_Object function, char_table;
+{
+ /* The depth of char table is at most 3. */
+ Lisp_Object indices[3];