diff src/chartab.c @ 89483:2f877ed80fa6

*** empty log message ***

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/chartab.c	Mon Sep 08 12:53:41 2003 +0000
@@ -0,0 +1,965 @@
+/* chartab.c -- char-table support
+   Copyright (C) 2003
+     National Institute of Advanced Industrial Science and Technology (AIST)
+     Registration Number H13PRO009
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include <config.h>
+#include "lisp.h"
+#include "character.h"
+#include "charset.h"
+#include "ccl.h"
+
+/* 64/16/32/128 */
+
+/* Number of elements in Nth level char-table.  */
+const int chartab_size[4] =
+  { (1 << CHARTAB_SIZE_BITS_0),
+    (1 << CHARTAB_SIZE_BITS_1),
+    (1 << CHARTAB_SIZE_BITS_2),
+    (1 << CHARTAB_SIZE_BITS_3) };
+
+/* Number of characters each element of Nth level char-table
+   covers.  */
+const int chartab_chars[4] =
+  { (1 << (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)),
+    (1 << (CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)),
+    (1 << CHARTAB_SIZE_BITS_3),
+    1 };
+
+/* Number of characters (in bits) each element of Nth level char-table
+   covers.  */
+const int chartab_bits[4] =
+  { (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3),
+    (CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3),
+    CHARTAB_SIZE_BITS_3,
+    0 };
+
+#define CHARTAB_IDX(c, depth, min_char)		\
+  (((c) - (min_char)) >> chartab_bits[(depth)])
+
+
+DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
+       doc: /* Return a newly created char-table, with purpose PURPOSE.
+Each element is initialized to INIT, which defaults to nil.
+
+PURPOSE should be a symbol.  If it has a `char-table-extra-slots'
+property, the property's value should be an integer between 0 and 10
+that specifies how many extra slots the char-table has.  Otherwise,
+the char-table has no extra slot.  */)
+     (purpose, init)
+     register Lisp_Object purpose, init;
+{
+  Lisp_Object vector;
+  Lisp_Object n;
+  int n_extras;
+  int size;
+
+  CHECK_SYMBOL (purpose);
+  n = Fget (purpose, Qchar_table_extra_slots);
+  if (NILP (n))
+    n_extras = 0;
+  else
+    {
+      CHECK_NATNUM (n);
+      n_extras = XINT (n);
+      if (n_extras > 10)
+	args_out_of_range (n, Qnil);
+    }
+
+  size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras;
+  vector = Fmake_vector (make_number (size), init);
+  XCHAR_TABLE (vector)->parent = Qnil;
+  XCHAR_TABLE (vector)->purpose = purpose;
+  XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
+  return vector;
+}
+
+static Lisp_Object
+make_sub_char_table (depth, min_char, defalt)
+     int depth, min_char;
+     Lisp_Object defalt;
+{
+  Lisp_Object table;
+  int size = VECSIZE (struct Lisp_Sub_Char_Table) - 1 + chartab_size[depth];
+
+  table = Fmake_vector (make_number (size), defalt);
+  XSUB_CHAR_TABLE (table)->depth = make_number (depth);
+  XSUB_CHAR_TABLE (table)->min_char = make_number (min_char);
+  XSETSUB_CHAR_TABLE (table, XSUB_CHAR_TABLE (table));
+
+  return table;
+}
+
+static Lisp_Object
+char_table_ascii (table)
+     Lisp_Object table;
+{
+  Lisp_Object sub;
+
+  sub = XCHAR_TABLE (table)->contents[0];
+  if (! SUB_CHAR_TABLE_P (sub))
+    return sub;
+  sub = XSUB_CHAR_TABLE (sub)->contents[0];
+  if (! SUB_CHAR_TABLE_P (sub))
+    return sub;
+  return XSUB_CHAR_TABLE (sub)->contents[0];
+}
+
+Lisp_Object
+copy_sub_char_table (table)
+     Lisp_Object table;
+{
+  Lisp_Object copy;
+  int depth = XINT (XSUB_CHAR_TABLE (table)->depth);
+  int min_char = XINT (XSUB_CHAR_TABLE (table)->min_char);
+  Lisp_Object val;
+  int i;
+
+  copy = make_sub_char_table (depth, min_char, Qnil);
+  /* Recursively copy any sub char-tables.  */
+  for (i = 0; i < chartab_size[depth]; i++)
+    {
+      val = XSUB_CHAR_TABLE (table)->contents[i];
+      if (SUB_CHAR_TABLE_P (val))
+	XSUB_CHAR_TABLE (copy)->contents[i] = copy_sub_char_table (val);
+      else
+	XSUB_CHAR_TABLE (copy)->contents[i] = val;
+    }
+
+  return copy;
+}
+
+
+Lisp_Object
+copy_char_table (table)
+     Lisp_Object table;
+{
+  Lisp_Object copy;
+  int size = XCHAR_TABLE (table)->size & PSEUDOVECTOR_SIZE_MASK;
+  int i;
+
+  copy = Fmake_vector (make_number (size), Qnil);
+  XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (table)->defalt;
+  XCHAR_TABLE (copy)->parent = XCHAR_TABLE (table)->parent;
+  XCHAR_TABLE (copy)->purpose = XCHAR_TABLE (table)->purpose;
+  XCHAR_TABLE (copy)->ascii = XCHAR_TABLE (table)->ascii;
+  for (i = 0; i < chartab_size[0]; i++)
+    XCHAR_TABLE (copy)->contents[i]
+      = (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
+	 ? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
+	 : XCHAR_TABLE (table)->contents[i]);
+  if (SUB_CHAR_TABLE_P (XCHAR_TABLE (copy)->ascii))
+    XCHAR_TABLE (copy)->ascii = char_table_ascii (copy);
+  size -= VECSIZE (struct Lisp_Char_Table) - 1;
+  for (i = 0; i < size; i++)
+    XCHAR_TABLE (copy)->extras[i] = XCHAR_TABLE (table)->extras[i];
+
+  XSETCHAR_TABLE (copy, XCHAR_TABLE (copy));
+  return copy;
+}
+
+Lisp_Object
+sub_char_table_ref (table, c)
+     Lisp_Object table;
+     int c;
+{
+  struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+  int depth = XINT (tbl->depth);
+  int min_char = XINT (tbl->min_char);
+  Lisp_Object val;
+
+  val = tbl->contents[CHARTAB_IDX (c, depth, min_char)];
+  if (SUB_CHAR_TABLE_P (val))
+    val = sub_char_table_ref (val, c);
+  return val;
+}
+
+Lisp_Object
+char_table_ref (table, c)
+     Lisp_Object table;
+     int c;
+{
+  struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
+  Lisp_Object val;
+
+  if (ASCII_CHAR_P (c))
+    {
+      val = tbl->ascii;
+      if (SUB_CHAR_TABLE_P (val))
+	val = XSUB_CHAR_TABLE (val)->contents[c];
+    }
+  else
+    {
+      val = tbl->contents[CHARTAB_IDX (c, 0, 0)];
+      if (SUB_CHAR_TABLE_P (val))
+	val = sub_char_table_ref (val, c);
+    }
+  if (NILP (val))
+    {
+      val = tbl->defalt;
+      if (NILP (val) && CHAR_TABLE_P (tbl->parent))
+	val = char_table_ref (tbl->parent, c);
+    }
+  return val;
+}
+
+static Lisp_Object
+sub_char_table_ref_and_range (table, c, from, to, defalt)
+     Lisp_Object table;
+     int c;
+     int *from, *to;
+     Lisp_Object defalt;
+{
+  struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+  int depth = XINT (tbl->depth);
+  int min_char = XINT (tbl->min_char);
+  int max_char = min_char + chartab_chars[depth - 1] - 1;
+  int index = CHARTAB_IDX (c, depth, min_char);
+  Lisp_Object val;
+
+  val = tbl->contents[index];
+  *from = min_char + index * chartab_chars[depth];
+  *to = *from + chartab_chars[depth] - 1;
+  if (SUB_CHAR_TABLE_P (val))
+    val = sub_char_table_ref_and_range (val, c, from, to, defalt);
+  else if (NILP (val))
+    val = defalt;
+
+  while (*from > min_char
+	 && *from == min_char + index * chartab_chars[depth])
+    {
+      Lisp_Object this_val;
+      int this_from = *from - chartab_chars[depth];
+      int this_to = *from - 1;
+
+      index--;
+      this_val = tbl->contents[index];
+      if (SUB_CHAR_TABLE_P (this_val))
+	this_val = sub_char_table_ref_and_range (this_val, this_to,
+						 &this_from, &this_to,
+						 defalt);
+      else if (NILP (this_val))
+	this_val = defalt;
+
+      if (! EQ (this_val, val))
+	break;
+      *from = this_from;
+    }
+  index = CHARTAB_IDX (c, depth, min_char);
+  while (*to < max_char
+	 && *to == min_char + (index + 1) * chartab_chars[depth] - 1)
+    {
+      Lisp_Object this_val;
+      int this_from = *to + 1;
+      int this_to = this_from + chartab_chars[depth] - 1;
+
+      index++;
+      this_val = tbl->contents[index];
+      if (SUB_CHAR_TABLE_P (this_val))
+	this_val = sub_char_table_ref_and_range (this_val, this_from,
+						 &this_from, &this_to,
+						 defalt);
+      else if (NILP (this_val))
+	this_val = defalt;
+      if (! EQ (this_val, val))
+	break;
+      *to = this_to;
+    }
+
+  return val;
+}
+
+
+/* Return the value for C in char-table TABLE.  Set *FROM and *TO to
+   the range of characters (containing C) that have the same value as
+   C.  It is not assured that the value of (*FROM - 1) and (*TO + 1)
+   is different from that of C.  */
+
+Lisp_Object
+char_table_ref_and_range (table, c, from, to)
+     Lisp_Object table;
+     int c;
+     int *from, *to;
+{
+  struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
+  int index = CHARTAB_IDX (c, 0, 0);
+  Lisp_Object val;
+
+  val = tbl->contents[index];
+  *from = index * chartab_chars[0];
+  *to = *from + chartab_chars[0] - 1;
+  if (SUB_CHAR_TABLE_P (val))
+    val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt);
+  else if (NILP (val))
+    val = tbl->defalt;
+
+  while (*from > 0 && *from == index * chartab_chars[0])
+    {
+      Lisp_Object this_val;
+      int this_from = *from - chartab_chars[0];
+      int this_to = *from - 1;
+
+      index--;
+      this_val = tbl->contents[index];
+      if (SUB_CHAR_TABLE_P (this_val))
+	this_val = sub_char_table_ref_and_range (this_val, this_to,
+						 &this_from, &this_to,
+						 tbl->defalt);
+      else if (NILP (this_val))
+	this_val = tbl->defalt;
+
+      if (! EQ (this_val, val))
+	break;
+      *from = this_from;
+    }
+  while (*to < MAX_CHAR && *to == (index + 1) * chartab_chars[0] - 1)
+    {
+      Lisp_Object this_val;
+      int this_from = *to + 1;
+      int this_to = this_from + chartab_chars[0] - 1;
+
+      index++;
+      this_val = tbl->contents[index];
+      if (SUB_CHAR_TABLE_P (this_val))
+	this_val = sub_char_table_ref_and_range (this_val, this_from,
+						 &this_from, &this_to,
+						 tbl->defalt);
+      else if (NILP (this_val))
+	this_val = tbl->defalt;
+      if (! EQ (this_val, val))
+	break;
+      *to = this_to;
+    }
+
+  return val;
+}
+
+
+#define ASET_RANGE(ARRAY, FROM, TO, LIMIT, VAL)				\
+  do {									\
+    int limit = (TO) < (LIMIT) ? (TO) : (LIMIT);			\
+    for (; (FROM) < limit; (FROM)++) (ARRAY)->contents[(FROM)] = (VAL);	\
+  } while (0)
+
+#define GET_SUB_CHAR_TABLE(TABLE, SUBTABLE, IDX, DEPTH, MIN_CHAR)	  \
+  do {									  \
+    (SUBTABLE) = (TABLE)->contents[(IDX)];				  \
+    if (!SUB_CHAR_TABLE_P (SUBTABLE))					  \
+      (SUBTABLE) = make_sub_char_table ((DEPTH), (MIN_CHAR), (SUBTABLE)); \
+  } while (0)
+
+
+static void
+sub_char_table_set (table, c, val)
+     Lisp_Object table;
+     int c;
+     Lisp_Object val;
+{
+  struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+  int depth = XINT ((tbl)->depth);
+  int min_char = XINT ((tbl)->min_char);
+  int i = CHARTAB_IDX (c, depth, min_char);
+  Lisp_Object sub;
+
+  if (depth == 3)
+    tbl->contents[i] = val;
+  else
+    {
+      sub = tbl->contents[i];
+      if (! SUB_CHAR_TABLE_P (sub))
+	{
+	  sub = make_sub_char_table (depth + 1,
+				     min_char + i * chartab_chars[depth], sub);
+	  tbl->contents[i] = sub;
+	}
+      sub_char_table_set (sub, c, val);
+    }
+}
+
+Lisp_Object
+char_table_set (table, c, val)
+     Lisp_Object table;
+     int c;
+     Lisp_Object val;
+{
+  struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
+
+  if (ASCII_CHAR_P (c)
+      && SUB_CHAR_TABLE_P (tbl->ascii))
+    {
+      XSUB_CHAR_TABLE (tbl->ascii)->contents[c] = val;
+    }
+  else
+    {
+      int i = CHARTAB_IDX (c, 0, 0);
+      Lisp_Object sub;
+
+      sub = tbl->contents[i];
+      if (! SUB_CHAR_TABLE_P (sub))
+	{
+	  sub = make_sub_char_table (1, i * chartab_chars[0], sub);
+	  tbl->contents[i] = sub;
+	}
+      sub_char_table_set (sub, c, val);
+      if (ASCII_CHAR_P (c))
+	tbl->ascii = char_table_ascii (table);
+    }
+  return val;
+}
+
+static void
+sub_char_table_set_range (table, depth, min_char, from, to, val)
+     Lisp_Object *table;
+     int depth;
+     int min_char;
+     int from, to;
+     Lisp_Object val;
+{
+  int max_char = min_char + chartab_chars[depth] - 1;
+
+  if (depth == 3 || (from <= min_char && to >= max_char))
+    *table = val;
+  else
+    {
+      int i, j;
+
+      depth++;
+      if (! SUB_CHAR_TABLE_P (*table))
+	*table = make_sub_char_table (depth, min_char, *table);
+      if (from < min_char)
+	from = min_char;
+      if (to > max_char)
+	to = max_char;
+      i = CHARTAB_IDX (from, depth, min_char);
+      j = CHARTAB_IDX (to, depth, min_char);
+      min_char += chartab_chars[depth] * i;
+      for (; i <= j; i++, min_char += chartab_chars[depth])
+	sub_char_table_set_range (XSUB_CHAR_TABLE (*table)->contents + i,
+				  depth, min_char, from, to, val);
+    }
+}
+
+
+Lisp_Object
+char_table_set_range (table, from, to, val)
+     Lisp_Object table;
+     int from, to;
+     Lisp_Object val;
+{
+  struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
+  Lisp_Object *contents = tbl->contents;
+  int i, min_char;
+
+  if (from == to)
+    char_table_set (table, from, val);
+  else
+    {
+      for (i = CHARTAB_IDX (from, 0, 0), min_char = i * chartab_chars[0];
+	   min_char <= to;
+	   i++, min_char += chartab_chars[0])
+	sub_char_table_set_range (contents + i, 0, min_char, from, to, val);
+      if (ASCII_CHAR_P (from))
+	tbl->ascii = char_table_ascii (table);
+    }
+  return val;
+}
+
+
+DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
+       1, 1, 0,
+       doc: /*
+Return the subtype of char-table CHAR-TABLE.  The value is a symbol.  */)
+     (char_table)
+     Lisp_Object char_table;
+{
+  CHECK_CHAR_TABLE (char_table);
+
+  return XCHAR_TABLE (char_table)->purpose;
+}
+
+DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
+       1, 1, 0,
+       doc: /* Return the parent char-table of CHAR-TABLE.
+The value is either nil or another char-table.
+If CHAR-TABLE holds nil for a given character,
+then the actual applicable value is inherited from the parent char-table
+\(or from its parents, if necessary).  */)
+  (char_table)
+     Lisp_Object char_table;
+{
+  CHECK_CHAR_TABLE (char_table);
+
+  return XCHAR_TABLE (char_table)->parent;
+}
+
+DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
+       2, 2, 0,
+       doc: /* Set the parent char-table of CHAR-TABLE to PARENT.
+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);
+
+  if (!NILP (parent))
+    {
+      CHECK_CHAR_TABLE (parent);
+
+      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,
+       doc: /* Return the value of CHAR-TABLE's extra-slot number N.  */)
+     (char_table, n)
+     Lisp_Object char_table, n;
+{
+  CHECK_CHAR_TABLE (char_table);
+  CHECK_NUMBER (n);
+  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,
+       doc: /* 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);
+  CHECK_NUMBER (n);
+  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;
+}
+
+DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
+       2, 2, 0,
+       doc: /* Return the value in CHAR-TABLE for a range of characters RANGE.
+RANGE should be nil (for the default value),
+a cons of character codes (for characters in the range), or a character code.  */)
+     (char_table, range)
+     Lisp_Object char_table, range;
+{
+  Lisp_Object val;
+  CHECK_CHAR_TABLE (char_table);
+
+  if (EQ (range, Qnil))
+    val = XCHAR_TABLE (char_table)->defalt;
+  else if (INTEGERP (range))
+    val = CHAR_TABLE_REF (char_table, XINT (range));
+  else if (CONSP (range))
+    {
+      int from, to;
+
+      CHECK_CHARACTER_CAR (range);
+      CHECK_CHARACTER_CDR (range);
+      val = char_table_ref_and_range (char_table, XINT (XCAR (range)),
+				      &from, &to);
+      /* Not yet implemented. */
+    }
+  else
+    error ("Invalid RANGE argument to `char-table-range'");
+  return val;
+}
+
+DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
+       3, 3, 0,
+       doc: /*
+Set the value in CHAR-TABLE for characters specified by RANGE to VALUE.
+RANGE should be t (for all characters), nil (for the default value),
+a cons of character codes (for characters in the range), or a character code.  */)
+     (char_table, range, value)
+     Lisp_Object char_table, range, value;
+{
+  CHECK_CHAR_TABLE (char_table);
+  if (EQ (range, Qt))
+    {
+      int i;
+
+      XCHAR_TABLE (char_table)->ascii = Qnil;
+      for (i = 0; i < chartab_size[0]; i++)
+	XCHAR_TABLE (char_table)->contents[i] = Qnil;
+      XCHAR_TABLE (char_table)->defalt = value;
+    }
+  else if (EQ (range, Qnil))
+    XCHAR_TABLE (char_table)->defalt = value;
+  else if (INTEGERP (range))
+    char_table_set (char_table, XINT (range), value);
+  else if (CONSP (range))
+    {
+      CHECK_CHARACTER_CAR (range);
+      CHECK_CHARACTER_CDR (range);
+      char_table_set_range (char_table,
+			    XINT (XCAR (range)), XINT (XCDR (range)), 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,
+       doc: /*
+This function is obsolete and has no effect.  */)
+     (char_table, ch, value)
+     Lisp_Object char_table, ch, value;
+{
+  return Qnil;
+}
+
+/* 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))	/* fixme: use CHARACTERP? */
+    return ch;
+  return XINT (value);
+}
+
+static Lisp_Object
+optimize_sub_char_table (table)
+     Lisp_Object table;
+{
+  struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+  int depth = XINT (tbl->depth);
+  Lisp_Object elt, this;
+  int i;
+
+  elt = XSUB_CHAR_TABLE (table)->contents[0];
+  if (SUB_CHAR_TABLE_P (elt))
+    elt = XSUB_CHAR_TABLE (table)->contents[0] = optimize_sub_char_table (elt);
+  if (SUB_CHAR_TABLE_P (elt))
+    return table;
+  for (i = 1; i < chartab_size[depth]; i++)
+    {
+      this = XSUB_CHAR_TABLE (table)->contents[i];
+      if (SUB_CHAR_TABLE_P (this))
+	this = XSUB_CHAR_TABLE (table)->contents[i]
+	  = optimize_sub_char_table (this);
+      if (SUB_CHAR_TABLE_P (this)
+	  || NILP (Fequal (this, elt)))
+	break;
+    }
+
+  return (i < chartab_size[depth] ? table : elt);
+}
+
+DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
+       1, 1, 0,
+       doc: /* Optimize CHAR-TABLE.  */)
+     (char_table)
+     Lisp_Object char_table;
+{
+  Lisp_Object elt;
+  int i;
+
+  CHECK_CHAR_TABLE (char_table);
+
+  for (i = 0; i < chartab_size[0]; i++)
+    {
+      elt = XCHAR_TABLE (char_table)->contents[i];
+      if (SUB_CHAR_TABLE_P (elt))
+	XCHAR_TABLE (char_table)->contents[i] = optimize_sub_char_table (elt);
+    }
+  return Qnil;
+}
+
+
+static Lisp_Object
+map_sub_char_table (c_function, function, table, arg, val, range,
+		    default_val, parent)
+     void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
+     Lisp_Object function, table, arg, val, range, default_val, parent;
+{
+  struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+  int depth = XINT (tbl->depth);
+  int i, c;
+
+  for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth];
+       i++, c += chartab_chars[depth])
+    {
+      Lisp_Object this;
+
+      this = tbl->contents[i];
+      if (SUB_CHAR_TABLE_P (this))
+	val = map_sub_char_table (c_function, function, this, arg, val, range,
+				  default_val, parent);
+      else
+	{
+	  if (NILP (this))
+	    this = default_val;
+	  if (NILP (this) && ! NILP (parent))
+	    this = CHAR_TABLE_REF (parent, c);
+	  if (NILP (Fequal (val, this)))
+	    {
+	      if (! NILP (val))
+		{
+		  XSETCDR (range, make_number (c - 1));
+		  if (depth == 3
+		      && EQ (XCAR (range), XCDR (range)))
+		    {
+		      if (c_function)
+			(*c_function) (arg, XCAR (range), val);
+		      else
+			call2 (function, XCAR (range), val);
+		    }
+		  else
+		    {
+		      if (c_function)
+			(*c_function) (arg, range, val);
+		      else
+			call2 (function, range, val);
+		    }
+		}
+	      val = this;
+	      XSETCAR (range, make_number (c));
+	    }
+	}
+    }
+  return val;
+}
+
+
+/* Map C_FUNCTION or FUNCTION over TABLE, calling it for each
+   character or group of characters that share a value.
+
+   ARG is passed to C_FUNCTION when that is called.  */
+
+void
+map_char_table (c_function, function, table, arg)
+     void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
+     Lisp_Object function, table, arg;
+{
+  Lisp_Object range, val;
+  int c, i;
+
+  range = Fcons (make_number (0), Qnil);
+  val = XCHAR_TABLE (table)->ascii;
+  if (SUB_CHAR_TABLE_P (val))
+    val = XSUB_CHAR_TABLE (val)->contents[0];
+
+  for (i = 0, c = 0; i < chartab_size[0]; i++, c += chartab_chars[0])
+    {
+      Lisp_Object this;
+
+      this = XCHAR_TABLE (table)->contents[i];
+      if (SUB_CHAR_TABLE_P (this))
+	val = map_sub_char_table (c_function, function, this, arg, val, range,
+				  XCHAR_TABLE (table)->defalt,
+				  XCHAR_TABLE (table)->parent);
+      else
+	{
+	  if (NILP (this))
+	    this = XCHAR_TABLE (table)->defalt;
+	  if (NILP (this) && ! NILP (XCHAR_TABLE (table)->parent))
+	    this = CHAR_TABLE_REF (XCHAR_TABLE (table)->parent, c);
+	  if (NILP (Fequal (val, this)))
+	    {
+	      if (! NILP (val))
+		{
+		  XSETCDR (range, make_number (c - 1));
+		  if (c_function)
+		    (*c_function) (arg, range, val);
+		  else
+		    call2 (function, range, val);
+		}
+	      val = this;
+	      XSETCAR (range, make_number (c));
+	    }
+	}
+    }
+
+  if (! NILP (val))
+    {
+      XSETCDR (range, make_number (c - 1));
+      if (c_function)
+	(*c_function) (arg, range, val);
+      else
+	call2 (function, range, val);
+    }
+}
+
+DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
+  2, 2, 0,
+       doc: /*
+Call FUNCTION for each character in CHAR-TABLE that has non-nil value.
+FUNCTION is called with two arguments--a key and a value.
+The key is a character code or a cons of character codes specifying a
+range of characters that have the same value.  */)
+     (function, char_table)
+     Lisp_Object function, char_table;
+{
+  CHECK_CHAR_TABLE (char_table);
+
+  map_char_table (NULL, function, char_table, char_table);
+  return Qnil;
+}
+
+
+static void
+map_sub_char_table_for_charset (c_function, function, table, arg, range,
+				charset, from, to)
+     void (*c_function) P_ ((Lisp_Object, Lisp_Object));
+     Lisp_Object function, table, arg, range;
+     struct charset *charset;
+     unsigned from, to;
+{
+  struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+  int depth = XINT (tbl->depth);
+  int c, i;
+
+  if (depth < 3)
+    for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth];
+	 i++, c += chartab_chars[depth])
+      {
+	Lisp_Object this;
+
+	this = tbl->contents[i];
+	if (SUB_CHAR_TABLE_P (this))
+	  map_sub_char_table_for_charset (c_function, function, this, arg,
+					  range, charset, from, to);
+	else
+	  {
+	    if (! NILP (XCAR (range)))
+	      {
+		XSETCDR (range, make_number (c - 1));
+		if (c_function)
+		  (*c_function) (arg, range);
+		else
+		  call2 (function, range, arg);
+	      }
+	    XSETCAR (range, Qnil);
+	  }
+      }
+  else
+    for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth]; i++, c ++)
+      {
+	Lisp_Object this;
+	unsigned code;
+
+	this = tbl->contents[i];
+	if (NILP (this)
+	    || (charset
+		&& (code = ENCODE_CHAR (charset, c),
+		    (code < from || code > to))))
+	  {
+	    if (! NILP (XCAR (range)))
+	      {
+		XSETCDR (range, make_number (c - 1));
+		if (c_function)
+		  (*c_function) (range, arg);
+		else
+		  call2 (function, range, arg);
+		XSETCAR (range, Qnil);
+	      }
+	  }
+	else
+	  {
+	    if (NILP (XCAR (range)))
+	      XSETCAR (range, make_number (c));
+	  }
+      }
+}
+
+
+void
+map_char_table_for_charset (c_function, function, table, arg,
+			    charset, from, to)
+     void (*c_function) P_ ((Lisp_Object, Lisp_Object));
+     Lisp_Object function, table, arg;
+     struct charset *charset;
+     unsigned from, to;
+{
+  Lisp_Object range;
+  int c, i;
+
+  range = Fcons (Qnil, Qnil);
+
+  for (i = 0, c = 0; i < chartab_size[0]; i++, c += chartab_chars[0])
+    {
+      Lisp_Object this;
+
+      this = XCHAR_TABLE (table)->contents[i];
+      if (SUB_CHAR_TABLE_P (this))
+	map_sub_char_table_for_charset (c_function, function, this, arg,
+					range, charset, from, to);
+      else
+	{
+	  if (! NILP (XCAR (range)))
+	    {
+	      XSETCDR (range, make_number (c - 1));
+	      if (c_function)
+		(*c_function) (arg, range);
+	      else
+		call2 (function, range, arg);
+	    }
+	  XSETCAR (range, Qnil);
+	}
+    }
+  if (! NILP (XCAR (range)))
+    {
+      XSETCDR (range, make_number (c - 1));
+      if (c_function)
+	(*c_function) (arg, range);
+      else
+	call2 (function, range, arg);
+    }
+}
+
+
+void
+syms_of_chartab ()
+{
+  defsubr (&Smake_char_table);
+  defsubr (&Schar_table_parent);
+  defsubr (&Schar_table_subtype);
+  defsubr (&Sset_char_table_parent);
+  defsubr (&Schar_table_extra_slot);
+  defsubr (&Sset_char_table_extra_slot);
+  defsubr (&Schar_table_range);
+  defsubr (&Sset_char_table_range);
+  defsubr (&Sset_char_table_default);
+  defsubr (&Soptimize_char_table);
+  defsubr (&Smap_char_table);
+}