src/chartab.c

   1 /* chartab.c -- char-table support
   2    Copyright (C) 2001, 2002
   3      National Institute of Advanced Industrial Science and Technology (AIST)
   4      Registration Number H13PRO009
   5
   6 This file is part of GNU Emacs.
   7
   8 GNU Emacs is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 2, or (at your option)
  11 any later version.
  12
  13 GNU Emacs is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Emacs; see the file COPYING.  If not, write to
  20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 Boston, MA 02111-1307, USA.  */
  22
  23 #include <config.h>
  24 #include <lisp.h>
  25 #include <character.h>
  26 #include <charset.h>
  27 #include <ccl.h>
  28
  29 /* 64/16/32/128 */
  30
  31 /* Number of elements in Nth level char-table.  */
  32 const int chartab_size[4] =
  33   { (1 << CHARTAB_SIZE_BITS_0),
  34     (1 << CHARTAB_SIZE_BITS_1),
  35     (1 << CHARTAB_SIZE_BITS_2),
  36     (1 << CHARTAB_SIZE_BITS_3) };
  37
  38 /* Number of characters each element of Nth level char-table
  39    covers.  */
  40 const int chartab_chars[4] =
  41   { (1 << (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)),
  42     (1 << (CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)),
  43     (1 << CHARTAB_SIZE_BITS_3),
  44     1 };
  45
  46 /* Number of characters (in bits) each element of Nth level char-table
  47    covers.  */
  48 const int chartab_bits[4] =
  49   { (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3),
  50     (CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3),
  51     CHARTAB_SIZE_BITS_3,
  52     0 };
  53
  54 #define CHARTAB_IDX(c, depth, min_char)         \
  55   (((c) - (min_char)) >> chartab_bits[(depth)])
  56
  57
  58 DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
  59        doc: /* Return a newly created char-table.
  60 Each element is initialized to INIT, which defaults to nil.
  61
  62 Optional second argument PURPOSE, if non-nil, should be a symbol
  63 which has a `char-table-extra-slots' property.
  64 The property's value should be an integer between 0 and 10
  65 that specify how many extra slots the char-table has.
  66 By default, the char-table has no extra slot.  */)
  67      (purpose, init)
  68      register Lisp_Object purpose, init;
  69 {
  70   Lisp_Object vector;
  71   Lisp_Object n;
  72   int n_extras = 0;
  73   int size;
  74
  75   CHECK_SYMBOL (purpose);
  76   if (! NILP (purpose))
  77     {
  78       n = Fget (purpose, Qchar_table_extra_slots);
  79       if (INTEGERP (n))
  80         {
  81           if (XINT (n) < 0 || XINT (n) > 10)
  82             args_out_of_range (n, Qnil);
  83           n_extras = XINT (n);
  84         }
  85     }
  86
  87   size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras;
  88   vector = Fmake_vector (make_number (size), init);
  89   XCHAR_TABLE (vector)->parent = Qnil;
  90   XCHAR_TABLE (vector)->purpose = purpose;
  91   XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
  92   return vector;
  93 }
  94
  95 static Lisp_Object
  96 make_sub_char_table (depth, min_char, defalt)
  97      int depth, min_char;
  98      Lisp_Object defalt;
  99 {
 100   Lisp_Object table;
 101   int size = VECSIZE (struct Lisp_Sub_Char_Table) - 1 + chartab_size[depth];
 102   int i;
 103
 104   table = Fmake_vector (make_number (size), defalt);
 105   XSUB_CHAR_TABLE (table)->depth = make_number (depth);
 106   XSUB_CHAR_TABLE (table)->min_char = make_number (min_char);
 107   XSETSUB_CHAR_TABLE (table, XSUB_CHAR_TABLE (table));
 108
 109   return table;
 110 }
 111
 112 static Lisp_Object
 113 char_table_ascii (table)
 114      Lisp_Object table;
 115 {
 116   Lisp_Object sub;
 117
 118   sub = XCHAR_TABLE (table)->contents[0];
 119   sub = XSUB_CHAR_TABLE (sub)->contents[0];
 120   return XSUB_CHAR_TABLE (sub)->contents[0];
 121 }
 122
 123 Lisp_Object
 124 copy_sub_char_table (table)
 125      Lisp_Object table;
 126 {
 127   Lisp_Object copy;
 128   int depth = XINT (XSUB_CHAR_TABLE (table)->depth);
 129   int min_char = XINT (XSUB_CHAR_TABLE (table)->min_char);
 130   Lisp_Object val;
 131   int i;
 132
 133   copy = make_sub_char_table (depth, min_char, Qnil);
 134   /* Recursively copy any sub char-tables.  */
 135   for (i = 0; i < chartab_size[depth]; i++)
 136     {
 137       val = XSUB_CHAR_TABLE (table)->contents[i];
 138       if (SUB_CHAR_TABLE_P (val))
 139         XSUB_CHAR_TABLE (copy)->contents[i] = copy_sub_char_table (val);
 140       else
 141         XSUB_CHAR_TABLE (copy)->contents[i] = val;
 142     }
 143
 144   return copy;
 145 }
 146
 147
 148 Lisp_Object
 149 copy_char_table (table)
 150      Lisp_Object table;
 151 {
 152   Lisp_Object copy;
 153   int size = XCHAR_TABLE (table)->size & PSEUDOVECTOR_SIZE_MASK;
 154   int i;
 155
 156   copy = Fmake_vector (make_number (size), Qnil);
 157   XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (table)->defalt;
 158   XCHAR_TABLE (copy)->parent = XCHAR_TABLE (table)->parent;
 159   XCHAR_TABLE (copy)->purpose = XCHAR_TABLE (table)->purpose;
 160   XCHAR_TABLE (copy)->ascii = XCHAR_TABLE (table)->ascii;
 161   for (i = 0; i < chartab_size[0]; i++)
 162     XCHAR_TABLE (copy)->contents[i]
 163       = (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
 164          ? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
 165          : XCHAR_TABLE (table)->contents[i]);
 166   if (SUB_CHAR_TABLE_P (XCHAR_TABLE (copy)->ascii))
 167     XCHAR_TABLE (copy)->ascii = char_table_ascii (copy);
 168   size -= VECSIZE (struct Lisp_Char_Table) - 1;
 169   for (i = 0; i < size; i++)
 170     XCHAR_TABLE (copy)->extras[i] = XCHAR_TABLE (table)->extras[i];
 171
 172   XSETCHAR_TABLE (copy, XCHAR_TABLE (copy));
 173   return copy;
 174 }
 175
 176 Lisp_Object
 177 sub_char_table_ref (table, c)
 178      Lisp_Object table;
 179      int c;
 180 {
 181   struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
 182   int depth = XINT (tbl->depth);
 183   int min_char = XINT (tbl->min_char);
 184   Lisp_Object val;
 185
 186   val = tbl->contents[CHARTAB_IDX (c, depth, min_char)];
 187   if (SUB_CHAR_TABLE_P (val))
 188     val = sub_char_table_ref (val, c);
 189   return val;
 190 }
 191
 192 Lisp_Object
 193 char_table_ref (table, c)
 194      Lisp_Object table;
 195      int c;
 196 {
 197   struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
 198   Lisp_Object val;
 199
 200   if (ASCII_CHAR_P (c))
 201     {
 202       val = tbl->ascii;
 203       if (SUB_CHAR_TABLE_P (val))
 204         val = XSUB_CHAR_TABLE (val)->contents[c];
 205     }
 206   else
 207     {
 208       val = tbl->contents[CHARTAB_IDX (c, 0, 0)];
 209       if (SUB_CHAR_TABLE_P (val))
 210         val = sub_char_table_ref (val, c);
 211     }
 212   if (NILP (val))
 213     {
 214       val = tbl->defalt;
 215       if (NILP (val) && CHAR_TABLE_P (tbl->parent))
 216         val = char_table_ref (tbl->parent, c);
 217     }
 218   return val;
 219 }
 220
 221 static Lisp_Object
 222 sub_char_table_ref_and_range (table, c, from, to)
 223      Lisp_Object table;
 224      int c;
 225      int *from, *to;
 226 {
 227   struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
 228   int depth = XINT (tbl->depth);
 229   int min_char = XINT (tbl->min_char);
 230   Lisp_Object val;
 231
 232   val = tbl->contents[CHARTAB_IDX (c, depth, min_char)];
 233   if (depth == 3)
 234     {
 235       *from = *to = c;
 236     }
 237   else if (SUB_CHAR_TABLE_P (val))
 238     {
 239       val = sub_char_table_ref_and_range (val, c, from, to);
 240     }
 241   else
 242     {
 243       *from = (CHARTAB_IDX (c, depth, min_char) * chartab_chars[depth]
 244                + min_char);
 245       *to = *from + chartab_chars[depth] - 1;
 246     }
 247   return val;
 248 }
 249
 250
 251 Lisp_Object
 252 char_table_ref_and_range (table, c, from, to)
 253      Lisp_Object table;
 254      int c;
 255      int *from, *to;
 256 {
 257   struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
 258   Lisp_Object val;
 259
 260   if (ASCII_CHAR_P (c))
 261     {
 262       val = tbl->ascii;
 263       if (SUB_CHAR_TABLE_P (val))
 264         {
 265           val = XSUB_CHAR_TABLE (val)->contents[c];
 266           *from = *to = c;
 267         }
 268       else
 269         {
 270           *from = 0, *to = 127;
 271         }
 272     }
 273   else
 274     {
 275       val = tbl->contents[CHARTAB_IDX (c, 0, 0)];
 276       if (SUB_CHAR_TABLE_P (val))
 277         {
 278           val = sub_char_table_ref_and_range (val, c, from, to);
 279         }
 280       else
 281         {
 282           *from = CHARTAB_IDX (c, 0, 0) * chartab_chars[0];
 283           *to = *from + chartab_chars[0] - 1;
 284         }
 285     }
 286
 287   if (NILP (val))
 288     {
 289       val = tbl->defalt;
 290       *from = 0, *to = MAX_CHAR;
 291       if (NILP (val) && CHAR_TABLE_P (tbl->parent))
 292         val = char_table_ref_and_range (tbl->parent, c, from, to);
 293     }
 294   return val;
 295 }
 296
 297
 298 #define ASET_RANGE(ARRAY, FROM, TO, LIMIT, VAL)                         \
 299   do {                                                                  \
 300     int limit = (TO) < (LIMIT) ? (TO) : (LIMIT);                        \
 301     for (; (FROM) < limit; (FROM)++) (ARRAY)->contents[(FROM)] = (VAL); \
 302   } while (0)
 303
 304 #define GET_SUB_CHAR_TABLE(TABLE, SUBTABLE, IDX, DEPTH, MIN_CHAR)         \
 305   do {                                                                    \
 306     (SUBTABLE) = (TABLE)->contents[(IDX)];                                \
 307     if (!SUB_CHAR_TABLE_P (SUBTABLE))                                     \
 308       (SUBTABLE) = make_sub_char_table ((DEPTH), (MIN_CHAR), (SUBTABLE)); \
 309   } while (0)
 310
 311
 312 static void
 313 sub_char_table_set (table, c, val)
 314      Lisp_Object table;
 315      int c;
 316      Lisp_Object val;
 317 {
 318   struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
 319   int depth = XINT ((tbl)->depth);
 320   int min_char = XINT ((tbl)->min_char);
 321   int i = CHARTAB_IDX (c, depth, min_char);
 322   Lisp_Object sub;
 323
 324   if (depth == 3)
 325     tbl->contents[i] = val;
 326   else
 327     {
 328       sub = tbl->contents[i];
 329       if (! SUB_CHAR_TABLE_P (sub))
 330         {
 331           sub = make_sub_char_table (depth + 1,
 332                                      min_char + i * chartab_chars[depth], sub);
 333           tbl->contents[i] = sub;
 334         }
 335       sub_char_table_set (sub, c, val);
 336     }
 337 }
 338
 339 Lisp_Object
 340 char_table_set (table, c, val)
 341      Lisp_Object table;
 342      int c;
 343      Lisp_Object val;
 344 {
 345   struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
 346
 347   if (ASCII_CHAR_P (c)
 348       && SUB_CHAR_TABLE_P (tbl->ascii))
 349     {
 350       XSUB_CHAR_TABLE (tbl->ascii)->contents[c] = val;
 351     }
 352   else
 353     {
 354       int i = CHARTAB_IDX (c, 0, 0);
 355       Lisp_Object sub;
 356
 357       sub = tbl->contents[i];
 358       if (! SUB_CHAR_TABLE_P (sub))
 359         {
 360           sub = make_sub_char_table (1, i * chartab_chars[0], sub);
 361           tbl->contents[i] = sub;
 362         }
 363       sub_char_table_set (sub, c, val);
 364       if (ASCII_CHAR_P (c))
 365         tbl->ascii = char_table_ascii (tbl);
 366     }
 367   return val;
 368 }
 369
 370 static void
 371 sub_char_table_set_range (table, depth, min_char, from, to, val)
 372      Lisp_Object *table;
 373      int depth;
 374      int min_char;
 375      int from, to;
 376      Lisp_Object val;
 377 {
 378   int max_char = min_char + chartab_chars[depth] - 1;
 379
 380   if (depth == 3 || from <= min_char && to >= max_char)
 381     *table = val;
 382   else
 383     {
 384       int i, j;
 385
 386       depth++;
 387       if (! SUB_CHAR_TABLE_P (*table))
 388         *table = make_sub_char_table (depth, min_char, *table);
 389       if (from < min_char)
 390         from = min_char;
 391       if (to > max_char)
 392         to = max_char;
 393       i = CHARTAB_IDX (from, depth, min_char);
 394       j = CHARTAB_IDX (to, depth, min_char);
 395       min_char += chartab_chars[depth] * i;
 396       for (; i <= j; i++, min_char += chartab_chars[depth])
 397         sub_char_table_set_range (XSUB_CHAR_TABLE (*table)->contents + i,
 398                                   depth, min_char, from, to, val);
 399     }
 400 }
 401
 402
 403 Lisp_Object
 404 char_table_set_range (table, from, to, val)
 405      Lisp_Object table;
 406      int from, to;
 407      Lisp_Object val;
 408 {
 409   struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
 410   Lisp_Object *contents = tbl->contents;
 411   int i, min_char;
 412
 413   if (from == to)
 414     char_table_set (table, from, val);
 415   else
 416     {
 417       for (i = CHARTAB_IDX (from, 0, 0), min_char = i * chartab_chars[0];
 418            min_char <= to;
 419            i++, min_char += chartab_chars[0])
 420         sub_char_table_set_range (contents + i, 0, min_char, from, to, val);
 421       if (ASCII_CHAR_P (from))
 422         tbl->ascii = char_table_ascii (tbl);
 423     }
 424   return val;
 425 }
 426
 427 \f
 428 DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
 429        1, 1, 0,
 430        doc: /*
 431 Return the subtype of char-table CHAR-TABLE.  The value is a symbol.  */)
 432      (char_table)
 433      Lisp_Object char_table;
 434 {
 435   CHECK_CHAR_TABLE (char_table);
 436
 437   return XCHAR_TABLE (char_table)->purpose;
 438 }
 439
 440 DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
 441        1, 1, 0,
 442        doc: /* Return the parent char-table of CHAR-TABLE.
 443 The value is either nil or another char-table.
 444 If CHAR-TABLE holds nil for a given character,
 445 then the actual applicable value is inherited from the parent char-table
 446 \(or from its parents, if necessary).  */)
 447   (char_table)
 448      Lisp_Object char_table;
 449 {
 450   CHECK_CHAR_TABLE (char_table);
 451
 452   return XCHAR_TABLE (char_table)->parent;
 453 }
 454
 455 DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
 456        2, 2, 0,
 457        doc: /* Set the parent char-table of CHAR-TABLE to PARENT.
 458 PARENT must be either nil or another char-table.  */)
 459      (char_table, parent)
 460      Lisp_Object char_table, parent;
 461 {
 462   Lisp_Object temp;
 463
 464   CHECK_CHAR_TABLE (char_table);
 465
 466   if (!NILP (parent))
 467     {
 468       CHECK_CHAR_TABLE (parent);
 469
 470       for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
 471         if (EQ (temp, char_table))
 472           error ("Attempt to make a chartable be its own parent");
 473     }
 474
 475   XCHAR_TABLE (char_table)->parent = parent;
 476
 477   return parent;
 478 }
 479
 480 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
 481        2, 2, 0,
 482        doc: /* Return the value of CHAR-TABLE's extra-slot number N.  */)
 483      (char_table, n)
 484      Lisp_Object char_table, n;
 485 {
 486   CHECK_CHAR_TABLE (char_table);
 487   CHECK_NUMBER (n);
 488   if (XINT (n) < 0
 489       || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
 490     args_out_of_range (char_table, n);
 491
 492   return XCHAR_TABLE (char_table)->extras[XINT (n)];
 493 }
 494
 495 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
 496        Sset_char_table_extra_slot,
 497        3, 3, 0,
 498        doc: /* Set CHAR-TABLE's extra-slot number N to VALUE.  */)
 499      (char_table, n, value)
 500      Lisp_Object char_table, n, value;
 501 {
 502   CHECK_CHAR_TABLE (char_table);
 503   CHECK_NUMBER (n);
 504   if (XINT (n) < 0
 505       || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
 506     args_out_of_range (char_table, n);
 507
 508   return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
 509 }
 510 \f
 511 DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
 512        2, 2, 0,
 513        doc: /* Return the value in CHAR-TABLE for a range of characters RANGE.
 514 RANGE should be nil (for the default value),
 515 a cons of character codes (for characters in the range), or a character code.  */)
 516      (char_table, range)
 517      Lisp_Object char_table, range;
 518 {
 519   Lisp_Object val;
 520   CHECK_CHAR_TABLE (char_table);
 521
 522   if (EQ (range, Qnil))
 523     val = XCHAR_TABLE (char_table)->defalt;
 524   else if (INTEGERP (range))
 525     val = CHAR_TABLE_REF (char_table, XINT (range));
 526   else if (CONSP (range))
 527     {
 528       int from, to;
 529
 530       CHECK_CHARACTER (XCAR (range));
 531       CHECK_CHARACTER (XCDR (range));
 532       val = char_table_ref_and_range (char_table, XINT (XCAR (range)),
 533                                       &from, &to);
 534       /* Not yet implemented. */
 535     }
 536   else
 537     error ("Invalid RANGE argument to `char-table-range'");
 538   return val;
 539 }
 540
 541 DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
 542        3, 3, 0,
 543        doc: /*
 544 Set the value in CHAR-TABLE for characters specified by RANGE to VALUE.
 545 RANGE should be t (for all characters), nil (for the default value),
 546 a cons of character codes (for characters in the range), or a character code.  */)
 547      (char_table, range, value)
 548      Lisp_Object char_table, range, value;
 549 {
 550   CHECK_CHAR_TABLE (char_table);
 551   if (EQ (range, Qt))
 552     {
 553       int i;
 554
 555       XCHAR_TABLE (char_table)->ascii = Qnil;
 556       for (i = 0; i < chartab_size[0]; i++)
 557         XCHAR_TABLE (char_table)->contents[i] = Qnil;
 558       XCHAR_TABLE (char_table)->defalt = value;
 559     }
 560   else if (EQ (range, Qnil))
 561     XCHAR_TABLE (char_table)->defalt = value;
 562   else if (INTEGERP (range))
 563     char_table_set (char_table, XINT (range), value);
 564   else if (CONSP (range))
 565     {
 566       CHECK_CHARACTER (XCAR (range));
 567       CHECK_CHARACTER (XCDR (range));
 568       char_table_set_range (char_table,
 569                             XINT (XCAR (range)), XINT (XCDR (range)), value);
 570     }
 571   else
 572     error ("Invalid RANGE argument to `set-char-table-range'");
 573
 574   return value;
 575 }
 576
 577 DEFUN ("set-char-table-default", Fset_char_table_default,
 578        Sset_char_table_default, 3, 3, 0,
 579        doc: /*
 580 Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.
 581 The generic character specifies the group of characters.
 582 See also the documentation of make-char.  */)
 583      (char_table, ch, value)
 584      Lisp_Object char_table, ch, value;
 585 {
 586   return Qnil;
 587 }
 588
 589 /* Look up the element in TABLE at index CH, and return it as an
 590    integer.  If the element is nil, return CH itself.  (Actually we do
 591    that for any non-integer.)  */
 592
 593 int
 594 char_table_translate (table, ch)
 595      Lisp_Object table;
 596      int ch;
 597 {
 598   Lisp_Object value;
 599   value = Faref (table, make_number (ch));
 600   if (! INTEGERP (value))
 601     return ch;
 602   return XINT (value);
 603 }
 604
 605 static Lisp_Object
 606 optimize_sub_char_table (table)
 607      Lisp_Object table;
 608 {
 609   struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
 610   int depth = XINT (tbl->depth);
 611   Lisp_Object elt, this;
 612   int i;
 613
 614   elt = XSUB_CHAR_TABLE (table)->contents[0];
 615   if (SUB_CHAR_TABLE_P (elt))
 616     elt = XSUB_CHAR_TABLE (table)->contents[0] = optimize_sub_char_table (elt);
 617   if (SUB_CHAR_TABLE_P (elt))
 618     return table;
 619   for (i = 1; i < chartab_size[depth]; i++)
 620     {
 621       this = XSUB_CHAR_TABLE (table)->contents[i];
 622       if (SUB_CHAR_TABLE_P (this))
 623         this = XSUB_CHAR_TABLE (table)->contents[i]
 624           = optimize_sub_char_table (this);
 625       if (SUB_CHAR_TABLE_P (this)
 626           || NILP (Fequal (this, elt)))
 627         break;
 628     }
 629
 630   return (i < chartab_size[depth] ? table : elt);
 631 }
 632
 633 DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
 634        1, 1, 0,
 635        doc: /* Optimize CHAR-TABLE.  */)
 636      (char_table)
 637      Lisp_Object char_table;
 638 {
 639   Lisp_Object elt;
 640   int i;
 641
 642   CHECK_CHAR_TABLE (char_table);
 643
 644   for (i = 0; i < chartab_size[0]; i++)
 645     {
 646       elt = XCHAR_TABLE (char_table)->contents[i];
 647       if (SUB_CHAR_TABLE_P (elt))
 648         XCHAR_TABLE (char_table)->contents[i] = optimize_sub_char_table (elt);
 649     }
 650   return Qnil;
 651 }
 652
 653 \f
 654 static Lisp_Object
 655 map_sub_char_table (c_function, function, table, arg, val, range)
 656      void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 657      Lisp_Object function, table, arg, val, range;
 658 {
 659   struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
 660   int depth = XINT (tbl->depth);
 661   int i, c;
 662
 663   for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth];
 664        i++, c += chartab_chars[depth])
 665     {
 666       Lisp_Object this;
 667
 668       this = tbl->contents[i];
 669       if (SUB_CHAR_TABLE_P (this))
 670         val = map_sub_char_table (c_function, function, this, arg, val, range);
 671       else if (NILP (Fequal (val, this)))
 672         {
 673           if (! NILP (val))
 674             {
 675               XCDR (range) = make_number (c - 1);
 676               if (depth == 3
 677                   && EQ (XCAR (range), XCDR (range)))
 678                 {
 679                   if (c_function)
 680                     (*c_function) (arg, XCAR (range), val);
 681                   else
 682                     call2 (function, XCAR (range), val);
 683                 }
 684               else
 685                 {
 686                   if (c_function)
 687                     (*c_function) (arg, range, val);
 688                   else
 689                     call2 (function, range, val);
 690                 }
 691             }
 692           val = this;
 693           XCAR (range) = make_number (c);
 694         }
 695     }
 696   return val;
 697 }
 698
 699
 700 /* Map C_FUNCTION or FUNCTION over TABLE, calling it for each
 701    character or group of characters that share a value.
 702
 703    ARG is passed to C_FUNCTION when that is called.
 704
 705    DEPTH and INDICES are ignored.  They are removed in the new
 706    feature.  */
 707
 708 void
 709 map_char_table (c_function, function, table, arg, depth, indices)
 710      void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 711      Lisp_Object function, table, arg, *indices;
 712      int depth;
 713 {
 714   Lisp_Object range, val;
 715   int c, i;
 716
 717   range = Fcons (make_number (0), Qnil);
 718   val = char_table_ref (table, 0);
 719
 720   for (i = 0, c = 0; i < chartab_size[0]; i++, c += chartab_chars[0])
 721     {
 722       Lisp_Object this;
 723
 724       this = XCHAR_TABLE (table)->contents[i];
 725       if (SUB_CHAR_TABLE_P (this))
 726         val = map_sub_char_table (c_function, function, this, arg, val, range);
 727       else if (NILP (Fequal (val, this)))
 728         {
 729           if (! NILP (val))
 730             {
 731               XCDR (range) = make_number (c - 1);
 732               if (c_function)
 733                 (*c_function) (arg, range, val);
 734               else
 735                 call2 (function, range, val);
 736             }
 737           val = this;
 738           XCAR (range) = make_number (c);
 739         }
 740     }
 741 }
 742
 743 DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
 744   2, 2, 0,
 745        doc: /*
 746 Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.
 747 FUNCTION is called with two arguments--a key and a value.
 748 The key is always a possible IDX argument to `aref'.  */)
 749      (function, char_table)
 750      Lisp_Object function, char_table;
 751 {
 752   CHECK_CHAR_TABLE (char_table);
 753
 754   map_char_table (NULL, function, char_table, char_table, 0, NULL);
 755   return Qnil;
 756 }
 757
 758 \f
 759 #if 0
 760 Lisp_Object
 761 make_class_table (purpose)
 762      Lisp_Object purpose;
 763 {
 764   Lisp_Object table;
 765   Lisp_Object args[4];
 766
 767   args[0] = purpose;
 768   args[1] = Qnil;
 769   args[2] = QCextra_slots;
 770   args[3] = Fmake_vector (make_number (2), Qnil);
 771   ASET (args[3], 0, Fmakehash (Qequal));
 772   table = Fmake_char_table (4, args);
 773   return table;
 774 }
 775
 776 Lisp_Object
 777 modify_class_entry (c, val, table, set)
 778      int c;
 779      Lisp_Object val, table, set;
 780 {
 781   Lisp_Object classes, hash, canon;
 782   int i, ival;
 783
 784   hash = XCHAR_TABLE (table)->extras[0];
 785   classes = CHAR_TABLE_REF (table, c);
 786
 787   if (! BOOL_VECTOR_P (classes))
 788     classes = (NILP (set)
 789                ? Qnil
 790                : Fmake_bool_vector (make_number ((ival / 8) * 8 + 8), Qnil));
 791   else if (ival < XBOOL_VECTOR (classes)->size)
 792     {
 793       Lisp_Object old;
 794       old = classes;
 795       classes = Fmake_bool_vector (make_number ((ival / 8) * 8 + 8), Qnil);
 796       for (i = 0; i < XBOOL_VECTOR (classes)->size; i++)
 797         Faset (classes, make_number (i), Faref (old, make_number (i)));
 798       Faset (classes, val, set);
 799     }
 800   else if (NILP (Faref (classes, val)) != NILP (set))
 801     {
 802       classes = Fcopy_sequence (classes);
 803       Faset (classes, val, set);
 804     }
 805   else
 806     classes = Qnil;
 807
 808   if (!NILP (classes))
 809     {
 810       canon = Fgethash (classes, hash, Qnil);
 811       if (NILP (canon))
 812         {
 813           canon = classes;
 814           Fputhash (canon, canon, hash);
 815         }
 816       char_table_set (table, c, canon);
 817     }
 818
 819   return val;
 820 }
 821 #endif
 822
 823 \f
 824 void
 825 syms_of_chartab ()
 826 {
 827   defsubr (&Smake_char_table);
 828   defsubr (&Schar_table_parent);
 829   defsubr (&Schar_table_subtype);
 830   defsubr (&Sset_char_table_parent);
 831   defsubr (&Schar_table_extra_slot);
 832   defsubr (&Sset_char_table_extra_slot);
 833   defsubr (&Schar_table_range);
 834   defsubr (&Sset_char_table_range);
 835   defsubr (&Sset_char_table_default);
 836   defsubr (&Soptimize_char_table);
 837   defsubr (&Smap_char_table);
 838 }