git.chise.org Git - chise/xemacs-chise.git-/blob - src/chartab.c

   1 /* XEmacs routines to deal with char tables.
   2    Copyright (C) 1992, 1995 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Sun Microsystems, Inc.
   4    Copyright (C) 1995, 1996 Ben Wing.
   5    Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
   6    Licensed to the Free Software Foundation.
   7    Copyright (C) 1999,2000,2001,2002 MORIOKA Tomohiko
   8
   9 This file is part of XEmacs.
  10
  11 XEmacs is free software; you can redistribute it and/or modify it
  12 under the terms of the GNU General Public License as published by the
  13 Free Software Foundation; either version 2, or (at your option) any
  14 later version.
  15
  16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  18 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  19 for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with XEmacs; see the file COPYING.  If not, write to
  23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 Boston, MA 02111-1307, USA.  */
  25
  26 /* Synched up with: Mule 2.3.  Not synched with FSF.
  27
  28    This file was written independently of the FSF implementation,
  29    and is not compatible. */
  30
  31 /* Authorship:
  32
  33    Ben Wing: wrote, for 19.13 (Mule).  Some category table stuff
  34              loosely based on the original Mule.
  35    Jareth Hein: fixed a couple of bugs in the implementation, and
  36              added regex support for categories with check_category_at
  37  */
  38
  39 #include <config.h>
  40 #include "lisp.h"
  41
  42 #include "buffer.h"
  43 #include "chartab.h"
  44 #include "syntax.h"
  45 #ifdef UTF2000
  46 #include "elhash.h"
  47 #endif /* UTF2000 */
  48
  49 Lisp_Object Qchar_tablep, Qchar_table;
  50
  51 Lisp_Object Vall_syntax_tables;
  52
  53 #ifdef MULE
  54 Lisp_Object Qcategory_table_p;
  55 Lisp_Object Qcategory_designator_p;
  56 Lisp_Object Qcategory_table_value_p;
  57
  58 Lisp_Object Vstandard_category_table;
  59
  60 /* Variables to determine word boundary.  */
  61 Lisp_Object Vword_combining_categories, Vword_separating_categories;
  62 #endif /* MULE */
  63
  64 \f
  65 #ifdef UTF2000
  66
  67 #if defined(HAVE_DATABASE)
  68 EXFUN (Fload_char_attribute_table, 1);
  69 EXFUN (Fmap_char_attribute, 3);
  70 #endif
  71
  72 #define BT_UINT8_MIN            0
  73 #define BT_UINT8_MAX            (UCHAR_MAX - 4)
  74 #define BT_UINT8_t              (UCHAR_MAX - 3)
  75 #define BT_UINT8_nil            (UCHAR_MAX - 2)
  76 #define BT_UINT8_unbound        (UCHAR_MAX - 1)
  77 #define BT_UINT8_unloaded       UCHAR_MAX
  78
  79 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
  80 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
  81 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
  82 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
  83 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
  84
  85 INLINE_HEADER int
  86 INT_UINT8_P (Lisp_Object obj)
  87 {
  88   if (INTP (obj))
  89     {
  90       int num = XINT (obj);
  91
  92       return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
  93     }
  94   else
  95     return 0;
  96 }
  97
  98 INLINE_HEADER int
  99 UINT8_VALUE_P (Lisp_Object obj)
 100 {
 101   return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
 102     || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
 103 }
 104
 105 INLINE_HEADER unsigned char
 106 UINT8_ENCODE (Lisp_Object obj)
 107 {
 108   if (EQ (obj, Qunloaded))
 109     return BT_UINT8_unloaded;
 110   else if (EQ (obj, Qunbound))
 111     return BT_UINT8_unbound;
 112   else if (EQ (obj, Qnil))
 113     return BT_UINT8_nil;
 114   else if (EQ (obj, Qt))
 115     return BT_UINT8_t;
 116   else
 117     return XINT (obj);
 118 }
 119
 120 INLINE_HEADER Lisp_Object
 121 UINT8_DECODE (unsigned char n)
 122 {
 123   if (n == BT_UINT8_unloaded)
 124     return Qunloaded;
 125   else if (n == BT_UINT8_unbound)
 126     return Qunbound;
 127   else if (n == BT_UINT8_nil)
 128     return Qnil;
 129   else if (n == BT_UINT8_t)
 130     return Qt;
 131   else
 132     return make_int (n);
 133 }
 134
 135 static Lisp_Object
 136 mark_uint8_byte_table (Lisp_Object obj)
 137 {
 138   return Qnil;
 139 }
 140
 141 static void
 142 print_uint8_byte_table (Lisp_Object obj,
 143                         Lisp_Object printcharfun, int escapeflag)
 144 {
 145   Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
 146   int i;
 147   struct gcpro gcpro1, gcpro2;
 148   GCPRO2 (obj, printcharfun);
 149
 150   write_c_string ("\n#<uint8-byte-table", printcharfun);
 151   for (i = 0; i < 256; i++)
 152     {
 153       unsigned char n = bte->property[i];
 154       if ( (i & 15) == 0 )
 155         write_c_string ("\n  ", printcharfun);
 156       write_c_string (" ", printcharfun);
 157       if (n == BT_UINT8_unbound)
 158         write_c_string ("void", printcharfun);
 159       else if (n == BT_UINT8_nil)
 160         write_c_string ("nil", printcharfun);
 161       else if (n == BT_UINT8_t)
 162         write_c_string ("t", printcharfun);
 163       else
 164         {
 165           char buf[4];
 166
 167           sprintf (buf, "%hd", n);
 168           write_c_string (buf, printcharfun);
 169         }
 170     }
 171   UNGCPRO;
 172   write_c_string (">", printcharfun);
 173 }
 174
 175 static int
 176 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 177 {
 178   Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
 179   Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
 180   int i;
 181
 182   for (i = 0; i < 256; i++)
 183     if (te1->property[i] != te2->property[i])
 184       return 0;
 185   return 1;
 186 }
 187
 188 static unsigned long
 189 uint8_byte_table_hash (Lisp_Object obj, int depth)
 190 {
 191   Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
 192   int i;
 193   hashcode_t hash = 0;
 194
 195   for (i = 0; i < 256; i++)
 196     hash = HASH2 (hash, te->property[i]);
 197   return hash;
 198 }
 199
 200 static const struct lrecord_description uint8_byte_table_description[] = {
 201   { XD_END }
 202 };
 203
 204 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
 205                                mark_uint8_byte_table,
 206                                print_uint8_byte_table,
 207                                0, uint8_byte_table_equal,
 208                                uint8_byte_table_hash,
 209                                uint8_byte_table_description,
 210                                Lisp_Uint8_Byte_Table);
 211
 212 static Lisp_Object
 213 make_uint8_byte_table (unsigned char initval)
 214 {
 215   Lisp_Object obj;
 216   int i;
 217   Lisp_Uint8_Byte_Table *cte;
 218
 219   cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
 220                              &lrecord_uint8_byte_table);
 221
 222   for (i = 0; i < 256; i++)
 223     cte->property[i] = initval;
 224
 225   XSETUINT8_BYTE_TABLE (obj, cte);
 226   return obj;
 227 }
 228
 229 static Lisp_Object
 230 copy_uint8_byte_table (Lisp_Object entry)
 231 {
 232   Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
 233   Lisp_Object obj;
 234   int i;
 235   Lisp_Uint8_Byte_Table *ctenew
 236     = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
 237                            &lrecord_uint8_byte_table);
 238
 239   for (i = 0; i < 256; i++)
 240     {
 241       ctenew->property[i] = cte->property[i];
 242     }
 243
 244   XSETUINT8_BYTE_TABLE (obj, ctenew);
 245   return obj;
 246 }
 247
 248 static int
 249 uint8_byte_table_same_value_p (Lisp_Object obj)
 250 {
 251   Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
 252   unsigned char v0 = bte->property[0];
 253   int i;
 254
 255   for (i = 1; i < 256; i++)
 256     {
 257       if (bte->property[i] != v0)
 258         return 0;
 259     }
 260   return -1;
 261 }
 262
 263 static int
 264 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
 265                            Emchar ofs, int place,
 266                            int (*fn) (struct chartab_range *range,
 267                                       Lisp_Object val, void *arg),
 268                            void *arg)
 269 {
 270   struct chartab_range rainj;
 271   int i, retval;
 272   int unit = 1 << (8 * place);
 273   Emchar c = ofs;
 274   Emchar c1;
 275
 276   rainj.type = CHARTAB_RANGE_CHAR;
 277
 278   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 279     {
 280       if (ct->property[i] == BT_UINT8_unloaded)
 281         {
 282 #if 0
 283           c1 = c + unit;
 284           for (; c < c1 && retval == 0; c++)
 285             {
 286               Lisp_Object ret = get_char_id_table (root, c);
 287
 288               if (!UNBOUNDP (ret))
 289                 {
 290                   rainj.ch = c;
 291                   retval = (fn) (&rainj, ret, arg);
 292                 }
 293             }
 294 #else
 295           ct->property[i] = BT_UINT8_unbound;
 296           c += unit;
 297 #endif
 298         }
 299       else if (ct->property[i] != BT_UINT8_unbound)
 300         {
 301           c1 = c + unit;
 302           for (; c < c1 && retval == 0; c++)
 303             {
 304               rainj.ch = c;
 305               retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
 306             }
 307         }
 308       else
 309         c += unit;
 310     }
 311   return retval;
 312 }
 313
 314 #ifdef HAVE_DATABASE
 315 static void
 316 save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
 317                        Lisp_Object db,
 318                        Emchar ofs, int place)
 319 {
 320   struct chartab_range rainj;
 321   int i, retval;
 322   int unit = 1 << (8 * place);
 323   Emchar c = ofs;
 324   Emchar c1;
 325
 326   rainj.type = CHARTAB_RANGE_CHAR;
 327
 328   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 329     {
 330       if (ct->property[i] == BT_UINT8_unloaded)
 331         {
 332           c1 = c + unit;
 333         }
 334       else if (ct->property[i] != BT_UINT8_unbound)
 335         {
 336           c1 = c + unit;
 337           for (; c < c1 && retval == 0; c++)
 338             {
 339               Fput_database (Fprin1_to_string (make_char (c), Qnil),
 340                              Fprin1_to_string (UINT8_DECODE (ct->property[i]),
 341                                                Qnil),
 342                              db, Qt);
 343             }
 344         }
 345       else
 346         c += unit;
 347     }
 348 }
 349 #endif
 350
 351 #define BT_UINT16_MIN           0
 352 #define BT_UINT16_MAX           (USHRT_MAX - 4)
 353 #define BT_UINT16_t             (USHRT_MAX - 3)
 354 #define BT_UINT16_nil           (USHRT_MAX - 2)
 355 #define BT_UINT16_unbound       (USHRT_MAX - 1)
 356 #define BT_UINT16_unloaded      USHRT_MAX
 357
 358 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
 359 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
 360 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
 361 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
 362
 363 INLINE_HEADER int
 364 INT_UINT16_P (Lisp_Object obj)
 365 {
 366   if (INTP (obj))
 367     {
 368       int num = XINT (obj);
 369
 370       return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
 371     }
 372   else
 373     return 0;
 374 }
 375
 376 INLINE_HEADER int
 377 UINT16_VALUE_P (Lisp_Object obj)
 378 {
 379   return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
 380     || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
 381 }
 382
 383 INLINE_HEADER unsigned short
 384 UINT16_ENCODE (Lisp_Object obj)
 385 {
 386   if (EQ (obj, Qunloaded))
 387     return BT_UINT16_unloaded;
 388   else if (EQ (obj, Qunbound))
 389     return BT_UINT16_unbound;
 390   else if (EQ (obj, Qnil))
 391     return BT_UINT16_nil;
 392   else if (EQ (obj, Qt))
 393     return BT_UINT16_t;
 394   else
 395     return XINT (obj);
 396 }
 397
 398 INLINE_HEADER Lisp_Object
 399 UINT16_DECODE (unsigned short n)
 400 {
 401   if (n == BT_UINT16_unloaded)
 402     return Qunloaded;
 403   else if (n == BT_UINT16_unbound)
 404     return Qunbound;
 405   else if (n == BT_UINT16_nil)
 406     return Qnil;
 407   else if (n == BT_UINT16_t)
 408     return Qt;
 409   else
 410     return make_int (n);
 411 }
 412
 413 INLINE_HEADER unsigned short
 414 UINT8_TO_UINT16 (unsigned char n)
 415 {
 416   if (n == BT_UINT8_unloaded)
 417     return BT_UINT16_unloaded;
 418   else if (n == BT_UINT8_unbound)
 419     return BT_UINT16_unbound;
 420   else if (n == BT_UINT8_nil)
 421     return BT_UINT16_nil;
 422   else if (n == BT_UINT8_t)
 423     return BT_UINT16_t;
 424   else
 425     return n;
 426 }
 427
 428 static Lisp_Object
 429 mark_uint16_byte_table (Lisp_Object obj)
 430 {
 431   return Qnil;
 432 }
 433
 434 static void
 435 print_uint16_byte_table (Lisp_Object obj,
 436                          Lisp_Object printcharfun, int escapeflag)
 437 {
 438   Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
 439   int i;
 440   struct gcpro gcpro1, gcpro2;
 441   GCPRO2 (obj, printcharfun);
 442
 443   write_c_string ("\n#<uint16-byte-table", printcharfun);
 444   for (i = 0; i < 256; i++)
 445     {
 446       unsigned short n = bte->property[i];
 447       if ( (i & 15) == 0 )
 448         write_c_string ("\n  ", printcharfun);
 449       write_c_string (" ", printcharfun);
 450       if (n == BT_UINT16_unbound)
 451         write_c_string ("void", printcharfun);
 452       else if (n == BT_UINT16_nil)
 453         write_c_string ("nil", printcharfun);
 454       else if (n == BT_UINT16_t)
 455         write_c_string ("t", printcharfun);
 456       else
 457         {
 458           char buf[7];
 459
 460           sprintf (buf, "%hd", n);
 461           write_c_string (buf, printcharfun);
 462         }
 463     }
 464   UNGCPRO;
 465   write_c_string (">", printcharfun);
 466 }
 467
 468 static int
 469 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 470 {
 471   Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
 472   Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
 473   int i;
 474
 475   for (i = 0; i < 256; i++)
 476     if (te1->property[i] != te2->property[i])
 477       return 0;
 478   return 1;
 479 }
 480
 481 static unsigned long
 482 uint16_byte_table_hash (Lisp_Object obj, int depth)
 483 {
 484   Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
 485   int i;
 486   hashcode_t hash = 0;
 487
 488   for (i = 0; i < 256; i++)
 489     hash = HASH2 (hash, te->property[i]);
 490   return hash;
 491 }
 492
 493 static const struct lrecord_description uint16_byte_table_description[] = {
 494   { XD_END }
 495 };
 496
 497 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
 498                                mark_uint16_byte_table,
 499                                print_uint16_byte_table,
 500                                0, uint16_byte_table_equal,
 501                                uint16_byte_table_hash,
 502                                uint16_byte_table_description,
 503                                Lisp_Uint16_Byte_Table);
 504
 505 static Lisp_Object
 506 make_uint16_byte_table (unsigned short initval)
 507 {
 508   Lisp_Object obj;
 509   int i;
 510   Lisp_Uint16_Byte_Table *cte;
 511
 512   cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
 513                              &lrecord_uint16_byte_table);
 514
 515   for (i = 0; i < 256; i++)
 516     cte->property[i] = initval;
 517
 518   XSETUINT16_BYTE_TABLE (obj, cte);
 519   return obj;
 520 }
 521
 522 static Lisp_Object
 523 copy_uint16_byte_table (Lisp_Object entry)
 524 {
 525   Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
 526   Lisp_Object obj;
 527   int i;
 528   Lisp_Uint16_Byte_Table *ctenew
 529     = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
 530                            &lrecord_uint16_byte_table);
 531
 532   for (i = 0; i < 256; i++)
 533     {
 534       ctenew->property[i] = cte->property[i];
 535     }
 536
 537   XSETUINT16_BYTE_TABLE (obj, ctenew);
 538   return obj;
 539 }
 540
 541 static Lisp_Object
 542 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
 543 {
 544   Lisp_Object obj;
 545   int i;
 546   Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
 547   Lisp_Uint16_Byte_Table* cte;
 548
 549   cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
 550                              &lrecord_uint16_byte_table);
 551   for (i = 0; i < 256; i++)
 552     {
 553       cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
 554     }
 555   XSETUINT16_BYTE_TABLE (obj, cte);
 556   return obj;
 557 }
 558
 559 static int
 560 uint16_byte_table_same_value_p (Lisp_Object obj)
 561 {
 562   Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
 563   unsigned short v0 = bte->property[0];
 564   int i;
 565
 566   for (i = 1; i < 256; i++)
 567     {
 568       if (bte->property[i] != v0)
 569         return 0;
 570     }
 571   return -1;
 572 }
 573
 574 static int
 575 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
 576                             Emchar ofs, int place,
 577                             int (*fn) (struct chartab_range *range,
 578                                        Lisp_Object val, void *arg),
 579                             void *arg)
 580 {
 581   struct chartab_range rainj;
 582   int i, retval;
 583   int unit = 1 << (8 * place);
 584   Emchar c = ofs;
 585   Emchar c1;
 586
 587   rainj.type = CHARTAB_RANGE_CHAR;
 588
 589   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 590     {
 591       if (ct->property[i] == BT_UINT16_unloaded)
 592         {
 593 #if 0
 594           c1 = c + unit;
 595           for (; c < c1 && retval == 0; c++)
 596             {
 597               Lisp_Object ret = get_char_id_table (root, c);
 598
 599               if (!UNBOUNDP (ret))
 600                 {
 601                   rainj.ch = c;
 602                   retval = (fn) (&rainj, ret, arg);
 603                 }
 604             }
 605 #else
 606           ct->property[i] = BT_UINT16_unbound;
 607           c += unit;
 608 #endif
 609         }
 610       else if (ct->property[i] != BT_UINT16_unbound)
 611         {
 612           c1 = c + unit;
 613           for (; c < c1 && retval == 0; c++)
 614             {
 615               rainj.ch = c;
 616               retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
 617             }
 618         }
 619       else
 620         c += unit;
 621     }
 622   return retval;
 623 }
 624
 625 #ifdef HAVE_DATABASE
 626 static void
 627 save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
 628                         Lisp_Object db,
 629                         Emchar ofs, int place)
 630 {
 631   struct chartab_range rainj;
 632   int i, retval;
 633   int unit = 1 << (8 * place);
 634   Emchar c = ofs;
 635   Emchar c1;
 636
 637   rainj.type = CHARTAB_RANGE_CHAR;
 638
 639   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 640     {
 641       if (ct->property[i] == BT_UINT16_unloaded)
 642         {
 643           c1 = c + unit;
 644         }
 645       else if (ct->property[i] != BT_UINT16_unbound)
 646         {
 647           c1 = c + unit;
 648           for (; c < c1 && retval == 0; c++)
 649             {
 650               Fput_database (Fprin1_to_string (make_char (c), Qnil),
 651                              Fprin1_to_string (UINT16_DECODE (ct->property[i]),
 652                                                Qnil),
 653                              db, Qt);
 654             }
 655         }
 656       else
 657         c += unit;
 658     }
 659 }
 660 #endif
 661
 662
 663 static Lisp_Object
 664 mark_byte_table (Lisp_Object obj)
 665 {
 666   Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
 667   int i;
 668
 669   for (i = 0; i < 256; i++)
 670     {
 671       mark_object (cte->property[i]);
 672     }
 673   return Qnil;
 674 }
 675
 676 static void
 677 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 678 {
 679   Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
 680   int i;
 681   struct gcpro gcpro1, gcpro2;
 682   GCPRO2 (obj, printcharfun);
 683
 684   write_c_string ("\n#<byte-table", printcharfun);
 685   for (i = 0; i < 256; i++)
 686     {
 687       Lisp_Object elt = bte->property[i];
 688       if ( (i & 15) == 0 )
 689         write_c_string ("\n  ", printcharfun);
 690       write_c_string (" ", printcharfun);
 691       if (EQ (elt, Qunbound))
 692         write_c_string ("void", printcharfun);
 693       else
 694         print_internal (elt, printcharfun, escapeflag);
 695     }
 696   UNGCPRO;
 697   write_c_string (">", printcharfun);
 698 }
 699
 700 static int
 701 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 702 {
 703   Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
 704   Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
 705   int i;
 706
 707   for (i = 0; i < 256; i++)
 708     if (BYTE_TABLE_P (cte1->property[i]))
 709       {
 710         if (BYTE_TABLE_P (cte2->property[i]))
 711           {
 712             if (!byte_table_equal (cte1->property[i],
 713                                    cte2->property[i], depth + 1))
 714               return 0;
 715           }
 716         else
 717           return 0;
 718       }
 719     else
 720       if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
 721         return 0;
 722   return 1;
 723 }
 724
 725 static unsigned long
 726 byte_table_hash (Lisp_Object obj, int depth)
 727 {
 728   Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
 729
 730   return internal_array_hash (cte->property, 256, depth);
 731 }
 732
 733 static const struct lrecord_description byte_table_description[] = {
 734   { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
 735   { XD_END }
 736 };
 737
 738 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
 739                                mark_byte_table,
 740                                print_byte_table,
 741                                0, byte_table_equal,
 742                                byte_table_hash,
 743                                byte_table_description,
 744                                Lisp_Byte_Table);
 745
 746 static Lisp_Object
 747 make_byte_table (Lisp_Object initval)
 748 {
 749   Lisp_Object obj;
 750   int i;
 751   Lisp_Byte_Table *cte;
 752
 753   cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
 754
 755   for (i = 0; i < 256; i++)
 756     cte->property[i] = initval;
 757
 758   XSETBYTE_TABLE (obj, cte);
 759   return obj;
 760 }
 761
 762 static Lisp_Object
 763 copy_byte_table (Lisp_Object entry)
 764 {
 765   Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
 766   Lisp_Object obj;
 767   int i;
 768   Lisp_Byte_Table *ctnew
 769     = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
 770
 771   for (i = 0; i < 256; i++)
 772     {
 773       if (UINT8_BYTE_TABLE_P (cte->property[i]))
 774         {
 775           ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
 776         }
 777       else if (UINT16_BYTE_TABLE_P (cte->property[i]))
 778         {
 779           ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
 780         }
 781       else if (BYTE_TABLE_P (cte->property[i]))
 782         {
 783           ctnew->property[i] = copy_byte_table (cte->property[i]);
 784         }
 785       else
 786         ctnew->property[i] = cte->property[i];
 787     }
 788
 789   XSETBYTE_TABLE (obj, ctnew);
 790   return obj;
 791 }
 792
 793 static int
 794 byte_table_same_value_p (Lisp_Object obj)
 795 {
 796   Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
 797   Lisp_Object v0 = bte->property[0];
 798   int i;
 799
 800   for (i = 1; i < 256; i++)
 801     {
 802       if (!internal_equal (bte->property[i], v0, 0))
 803         return 0;
 804     }
 805   return -1;
 806 }
 807
 808 static int
 809 map_over_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
 810                      Emchar ofs, int place,
 811                      int (*fn) (struct chartab_range *range,
 812                                 Lisp_Object val, void *arg),
 813                      void *arg)
 814 {
 815   int i, retval;
 816   Lisp_Object v;
 817   int unit = 1 << (8 * place);
 818   Emchar c = ofs;
 819
 820   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 821     {
 822       v = ct->property[i];
 823       if (UINT8_BYTE_TABLE_P (v))
 824         {
 825           retval
 826             = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
 827                                          c, place - 1, fn, arg);
 828           c += unit;
 829         }
 830       else if (UINT16_BYTE_TABLE_P (v))
 831         {
 832           retval
 833             = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
 834                                           c, place - 1, fn, arg);
 835           c += unit;
 836         }
 837       else if (BYTE_TABLE_P (v))
 838         {
 839           retval = map_over_byte_table (XBYTE_TABLE(v), root,
 840                                         c, place - 1, fn, arg);
 841           c += unit;
 842         }
 843       else if (EQ (v, Qunloaded))
 844         {
 845 #if 0
 846           struct chartab_range rainj;
 847           Emchar c1 = c + unit;
 848
 849           rainj.type = CHARTAB_RANGE_CHAR;
 850
 851           for (; c < c1 && retval == 0; c++)
 852             {
 853               Lisp_Object ret = get_char_id_table (root, c);
 854
 855               if (!UNBOUNDP (ret))
 856                 {
 857                   rainj.ch = c;
 858                   retval = (fn) (&rainj, ret, arg);
 859                 }
 860             }
 861 #else
 862           ct->property[i] = Qunbound;
 863           c += unit;
 864 #endif
 865         }
 866       else if (!UNBOUNDP (v))
 867         {
 868           struct chartab_range rainj;
 869           Emchar c1 = c + unit;
 870
 871           rainj.type = CHARTAB_RANGE_CHAR;
 872
 873           for (; c < c1 && retval == 0; c++)
 874             {
 875               rainj.ch = c;
 876               retval = (fn) (&rainj, v, arg);
 877             }
 878         }
 879       else
 880         c += unit;
 881     }
 882   return retval;
 883 }
 884
 885 #ifdef HAVE_DATABASE
 886 static void
 887 save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
 888                  Lisp_Object db,
 889                  Emchar ofs, int place)
 890 {
 891   int i, retval;
 892   Lisp_Object v;
 893   int unit = 1 << (8 * place);
 894   Emchar c = ofs;
 895
 896   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 897     {
 898       v = ct->property[i];
 899       if (UINT8_BYTE_TABLE_P (v))
 900         {
 901           save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root, db,
 902                                  c, place - 1);
 903           c += unit;
 904         }
 905       else if (UINT16_BYTE_TABLE_P (v))
 906         {
 907           save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root, db,
 908                                   c, place - 1);
 909           c += unit;
 910         }
 911       else if (BYTE_TABLE_P (v))
 912         {
 913           save_byte_table (XBYTE_TABLE(v), root, db,
 914                            c, place - 1);
 915           c += unit;
 916         }
 917       else if (EQ (v, Qunloaded))
 918         {
 919           c += unit;
 920         }
 921       else if (!UNBOUNDP (v))
 922         {
 923           struct chartab_range rainj;
 924           Emchar c1 = c + unit;
 925
 926           rainj.type = CHARTAB_RANGE_CHAR;
 927
 928           for (; c < c1 && retval == 0; c++)
 929             {
 930               Fput_database (Fprin1_to_string (make_char (c), Qnil),
 931                              Fprin1_to_string (v, Qnil),
 932                              db, Qt);
 933             }
 934         }
 935       else
 936         c += unit;
 937     }
 938 }
 939 #endif
 940
 941 Lisp_Object
 942 get_byte_table (Lisp_Object table, unsigned char idx)
 943 {
 944   if (UINT8_BYTE_TABLE_P (table))
 945     return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
 946   else if (UINT16_BYTE_TABLE_P (table))
 947     return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
 948   else if (BYTE_TABLE_P (table))
 949     return XBYTE_TABLE(table)->property[idx];
 950   else
 951     return table;
 952 }
 953
 954 Lisp_Object
 955 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
 956 {
 957   if (UINT8_BYTE_TABLE_P (table))
 958     {
 959       if (UINT8_VALUE_P (value))
 960         {
 961           XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
 962           if (!UINT8_BYTE_TABLE_P (value) &&
 963               !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
 964               && uint8_byte_table_same_value_p (table))
 965             {
 966               return value;
 967             }
 968         }
 969       else if (UINT16_VALUE_P (value))
 970         {
 971           Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
 972
 973           XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
 974           return new;
 975         }
 976       else
 977         {
 978           Lisp_Object new = make_byte_table (Qnil);
 979           int i;
 980
 981           for (i = 0; i < 256; i++)
 982             {
 983               XBYTE_TABLE(new)->property[i]
 984                 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
 985             }
 986           XBYTE_TABLE(new)->property[idx] = value;
 987           return new;
 988         }
 989     }
 990   else if (UINT16_BYTE_TABLE_P (table))
 991     {
 992       if (UINT16_VALUE_P (value))
 993         {
 994           XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
 995           if (!UINT8_BYTE_TABLE_P (value) &&
 996               !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
 997               && uint16_byte_table_same_value_p (table))
 998             {
 999               return value;
1000             }
1001         }
1002       else
1003         {
1004           Lisp_Object new = make_byte_table (Qnil);
1005           int i;
1006
1007           for (i = 0; i < 256; i++)
1008             {
1009               XBYTE_TABLE(new)->property[i]
1010                 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
1011             }
1012           XBYTE_TABLE(new)->property[idx] = value;
1013           return new;
1014         }
1015     }
1016   else if (BYTE_TABLE_P (table))
1017     {
1018       XBYTE_TABLE(table)->property[idx] = value;
1019       if (!UINT8_BYTE_TABLE_P (value) &&
1020           !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1021           && byte_table_same_value_p (table))
1022         {
1023           return value;
1024         }
1025     }
1026   else if (!internal_equal (table, value, 0))
1027     {
1028       if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
1029         {
1030           table = make_uint8_byte_table (UINT8_ENCODE (table));
1031           XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1032         }
1033       else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
1034         {
1035           table = make_uint16_byte_table (UINT16_ENCODE (table));
1036           XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1037         }
1038       else
1039         {
1040           table = make_byte_table (table);
1041           XBYTE_TABLE(table)->property[idx] = value;
1042         }
1043     }
1044   return table;
1045 }
1046
1047
1048 Lisp_Object
1049 make_char_id_table (Lisp_Object initval)
1050 {
1051   Lisp_Object obj;
1052   obj = Fmake_char_table (Qgeneric);
1053   fill_char_table (XCHAR_TABLE (obj), initval);
1054   return obj;
1055 }
1056
1057
1058 Lisp_Object Vcharacter_composition_table;
1059 Lisp_Object Vcharacter_variant_table;
1060
1061
1062 Lisp_Object Qsystem_char_id;
1063
1064 Lisp_Object Q_decomposition;
1065 Lisp_Object Qto_ucs;
1066 Lisp_Object Q_ucs;
1067 Lisp_Object Q_ucs_variants;
1068 Lisp_Object Qcompat;
1069 Lisp_Object Qisolated;
1070 Lisp_Object Qinitial;
1071 Lisp_Object Qmedial;
1072 Lisp_Object Qfinal;
1073 Lisp_Object Qvertical;
1074 Lisp_Object QnoBreak;
1075 Lisp_Object Qfraction;
1076 Lisp_Object Qsuper;
1077 Lisp_Object Qsub;
1078 Lisp_Object Qcircle;
1079 Lisp_Object Qsquare;
1080 Lisp_Object Qwide;
1081 Lisp_Object Qnarrow;
1082 Lisp_Object Qsmall;
1083 Lisp_Object Qfont;
1084
1085 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1086
1087 Emchar
1088 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1089 {
1090   if (INTP (v))
1091     return XINT (v);
1092   if (CHARP (v))
1093     return XCHAR (v);
1094   else if (EQ (v, Qcompat))
1095     return -1;
1096   else if (EQ (v, Qisolated))
1097     return -2;
1098   else if (EQ (v, Qinitial))
1099     return -3;
1100   else if (EQ (v, Qmedial))
1101     return -4;
1102   else if (EQ (v, Qfinal))
1103     return -5;
1104   else if (EQ (v, Qvertical))
1105     return -6;
1106   else if (EQ (v, QnoBreak))
1107     return -7;
1108   else if (EQ (v, Qfraction))
1109     return -8;
1110   else if (EQ (v, Qsuper))
1111     return -9;
1112   else if (EQ (v, Qsub))
1113     return -10;
1114   else if (EQ (v, Qcircle))
1115     return -11;
1116   else if (EQ (v, Qsquare))
1117     return -12;
1118   else if (EQ (v, Qwide))
1119     return -13;
1120   else if (EQ (v, Qnarrow))
1121     return -14;
1122   else if (EQ (v, Qsmall))
1123     return -15;
1124   else if (EQ (v, Qfont))
1125     return -16;
1126   else
1127     signal_simple_error (err_msg, err_arg);
1128 }
1129
1130 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1131 Return character corresponding with list.
1132 */
1133        (list))
1134 {
1135   Lisp_Object table = Vcharacter_composition_table;
1136   Lisp_Object rest = list;
1137
1138   while (CONSP (rest))
1139     {
1140       Lisp_Object v = Fcar (rest);
1141       Lisp_Object ret;
1142       Emchar c = to_char_id (v, "Invalid value for composition", list);
1143
1144       ret = get_char_id_table (XCHAR_TABLE(table), c);
1145
1146       rest = Fcdr (rest);
1147       if (NILP (rest))
1148         {
1149           if (!CHAR_TABLEP (ret))
1150             return ret;
1151           else
1152             return Qt;
1153         }
1154       else if (!CONSP (rest))
1155         break;
1156       else if (CHAR_TABLEP (ret))
1157         table = ret;
1158       else
1159         signal_simple_error ("Invalid table is found with", list);
1160     }
1161   signal_simple_error ("Invalid value for composition", list);
1162 }
1163
1164 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1165 Return variants of CHARACTER.
1166 */
1167        (character))
1168 {
1169   Lisp_Object ret;
1170
1171   CHECK_CHAR (character);
1172   ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
1173                            XCHAR(character));
1174   if (CONSP (ret))
1175     return Fcopy_list (ret);
1176   else
1177     return Qnil;
1178 }
1179
1180 #endif
1181
1182 \f
1183 /* A char table maps from ranges of characters to values.
1184
1185    Implementing a general data structure that maps from arbitrary
1186    ranges of numbers to values is tricky to do efficiently.  As it
1187    happens, it should suffice (and is usually more convenient, anyway)
1188    when dealing with characters to restrict the sorts of ranges that
1189    can be assigned values, as follows:
1190
1191    1) All characters.
1192    2) All characters in a charset.
1193    3) All characters in a particular row of a charset, where a "row"
1194       means all characters with the same first byte.
1195    4) A particular character in a charset.
1196
1197    We use char tables to generalize the 256-element vectors now
1198    littering the Emacs code.
1199
1200    Possible uses (all should be converted at some point):
1201
1202    1) category tables
1203    2) syntax tables
1204    3) display tables
1205    4) case tables
1206    5) keyboard-translate-table?
1207
1208    We provide an
1209    abstract type to generalize the Emacs vectors and Mule
1210    vectors-of-vectors goo.
1211    */
1212
1213 /************************************************************************/
1214 /*                         Char Table object                            */
1215 /************************************************************************/
1216
1217 #if defined(MULE)&&!defined(UTF2000)
1218
1219 static Lisp_Object
1220 mark_char_table_entry (Lisp_Object obj)
1221 {
1222   Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1223   int i;
1224
1225   for (i = 0; i < 96; i++)
1226     {
1227       mark_object (cte->level2[i]);
1228     }
1229   return Qnil;
1230 }
1231
1232 static int
1233 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1234 {
1235   Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1236   Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1237   int i;
1238
1239   for (i = 0; i < 96; i++)
1240     if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1241       return 0;
1242
1243   return 1;
1244 }
1245
1246 static unsigned long
1247 char_table_entry_hash (Lisp_Object obj, int depth)
1248 {
1249   Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1250
1251   return internal_array_hash (cte->level2, 96, depth);
1252 }
1253
1254 static const struct lrecord_description char_table_entry_description[] = {
1255   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1256   { XD_END }
1257 };
1258
1259 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1260                                mark_char_table_entry, internal_object_printer,
1261                                0, char_table_entry_equal,
1262                                char_table_entry_hash,
1263                                char_table_entry_description,
1264                                Lisp_Char_Table_Entry);
1265 #endif /* MULE */
1266
1267 static Lisp_Object
1268 mark_char_table (Lisp_Object obj)
1269 {
1270   Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1271 #ifdef UTF2000
1272
1273   mark_object (ct->table);
1274   mark_object (ct->name);
1275   mark_object (ct->db);
1276 #else
1277   int i;
1278
1279   for (i = 0; i < NUM_ASCII_CHARS; i++)
1280     mark_object (ct->ascii[i]);
1281 #ifdef MULE
1282   for (i = 0; i < NUM_LEADING_BYTES; i++)
1283     mark_object (ct->level1[i]);
1284 #endif
1285 #endif
1286 #ifdef UTF2000
1287   return ct->default_value;
1288 #else
1289   return ct->mirror_table;
1290 #endif
1291 }
1292
1293 /* WARNING: All functions of this nature need to be written extremely
1294    carefully to avoid crashes during GC.  Cf. prune_specifiers()
1295    and prune_weak_hash_tables(). */
1296
1297 void
1298 prune_syntax_tables (void)
1299 {
1300   Lisp_Object rest, prev = Qnil;
1301
1302   for (rest = Vall_syntax_tables;
1303        !NILP (rest);
1304        rest = XCHAR_TABLE (rest)->next_table)
1305     {
1306       if (! marked_p (rest))
1307         {
1308           /* This table is garbage.  Remove it from the list. */
1309           if (NILP (prev))
1310             Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1311           else
1312             XCHAR_TABLE (prev)->next_table =
1313               XCHAR_TABLE (rest)->next_table;
1314         }
1315     }
1316 }
1317
1318 static Lisp_Object
1319 char_table_type_to_symbol (enum char_table_type type)
1320 {
1321   switch (type)
1322   {
1323   default: abort();
1324   case CHAR_TABLE_TYPE_GENERIC:  return Qgeneric;
1325   case CHAR_TABLE_TYPE_SYNTAX:   return Qsyntax;
1326   case CHAR_TABLE_TYPE_DISPLAY:  return Qdisplay;
1327   case CHAR_TABLE_TYPE_CHAR:     return Qchar;
1328 #ifdef MULE
1329   case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1330 #endif
1331   }
1332 }
1333
1334 static enum char_table_type
1335 symbol_to_char_table_type (Lisp_Object symbol)
1336 {
1337   CHECK_SYMBOL (symbol);
1338
1339   if (EQ (symbol, Qgeneric))  return CHAR_TABLE_TYPE_GENERIC;
1340   if (EQ (symbol, Qsyntax))   return CHAR_TABLE_TYPE_SYNTAX;
1341   if (EQ (symbol, Qdisplay))  return CHAR_TABLE_TYPE_DISPLAY;
1342   if (EQ (symbol, Qchar))     return CHAR_TABLE_TYPE_CHAR;
1343 #ifdef MULE
1344   if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1345 #endif
1346
1347   signal_simple_error ("Unrecognized char table type", symbol);
1348   return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1349 }
1350
1351 static void
1352 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1353                      Lisp_Object printcharfun)
1354 {
1355   if (first != last)
1356     {
1357       write_c_string (" (", printcharfun);
1358       print_internal (make_char (first), printcharfun, 0);
1359       write_c_string (" ", printcharfun);
1360       print_internal (make_char (last), printcharfun, 0);
1361       write_c_string (") ", printcharfun);
1362     }
1363   else
1364     {
1365       write_c_string (" ", printcharfun);
1366       print_internal (make_char (first), printcharfun, 0);
1367       write_c_string (" ", printcharfun);
1368     }
1369   print_internal (val, printcharfun, 1);
1370 }
1371
1372 #if defined(MULE)&&!defined(UTF2000)
1373
1374 static void
1375 print_chartab_charset_row (Lisp_Object charset,
1376                            int row,
1377                            Lisp_Char_Table_Entry *cte,
1378                            Lisp_Object printcharfun)
1379 {
1380   int i;
1381   Lisp_Object cat = Qunbound;
1382   int first = -1;
1383
1384   for (i = 32; i < 128; i++)
1385     {
1386       Lisp_Object pam = cte->level2[i - 32];
1387
1388       if (first == -1)
1389         {
1390           first = i;
1391           cat = pam;
1392           continue;
1393         }
1394
1395       if (!EQ (cat, pam))
1396         {
1397           if (row == -1)
1398             print_chartab_range (MAKE_CHAR (charset, first, 0),
1399                                  MAKE_CHAR (charset, i - 1, 0),
1400                                  cat, printcharfun);
1401           else
1402             print_chartab_range (MAKE_CHAR (charset, row, first),
1403                                  MAKE_CHAR (charset, row, i - 1),
1404                                  cat, printcharfun);
1405           first = -1;
1406           i--;
1407         }
1408     }
1409
1410   if (first != -1)
1411     {
1412       if (row == -1)
1413         print_chartab_range (MAKE_CHAR (charset, first, 0),
1414                              MAKE_CHAR (charset, i - 1, 0),
1415                              cat, printcharfun);
1416       else
1417         print_chartab_range (MAKE_CHAR (charset, row, first),
1418                              MAKE_CHAR (charset, row, i - 1),
1419                              cat, printcharfun);
1420     }
1421 }
1422
1423 static void
1424 print_chartab_two_byte_charset (Lisp_Object charset,
1425                                 Lisp_Char_Table_Entry *cte,
1426                                 Lisp_Object printcharfun)
1427 {
1428   int i;
1429
1430   for (i = 32; i < 128; i++)
1431     {
1432       Lisp_Object jen = cte->level2[i - 32];
1433
1434       if (!CHAR_TABLE_ENTRYP (jen))
1435         {
1436           char buf[100];
1437
1438           write_c_string (" [", printcharfun);
1439           print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1440           sprintf (buf, " %d] ", i);
1441           write_c_string (buf, printcharfun);
1442           print_internal (jen, printcharfun, 0);
1443         }
1444       else
1445         print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1446                                    printcharfun);
1447     }
1448 }
1449
1450 #endif /* MULE */
1451
1452 static void
1453 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1454 {
1455   Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1456 #ifdef UTF2000
1457   int i;
1458   struct gcpro gcpro1, gcpro2;
1459   GCPRO2 (obj, printcharfun);
1460
1461   write_c_string ("#s(char-table ", printcharfun);
1462   write_c_string (" ", printcharfun);
1463   write_c_string (string_data
1464                   (symbol_name
1465                    (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1466                   printcharfun);
1467   write_c_string ("\n ", printcharfun);
1468   print_internal (ct->default_value, printcharfun, escapeflag);
1469   for (i = 0; i < 256; i++)
1470     {
1471       Lisp_Object elt = get_byte_table (ct->table, i);
1472       if (i != 0) write_c_string ("\n  ", printcharfun);
1473       if (EQ (elt, Qunbound))
1474         write_c_string ("void", printcharfun);
1475       else
1476         print_internal (elt, printcharfun, escapeflag);
1477     }
1478   UNGCPRO;
1479 #else /* non UTF2000 */
1480   char buf[200];
1481
1482   sprintf (buf, "#s(char-table type %s data (",
1483            string_data (symbol_name (XSYMBOL
1484                                      (char_table_type_to_symbol (ct->type)))));
1485   write_c_string (buf, printcharfun);
1486
1487   /* Now write out the ASCII/Control-1 stuff. */
1488   {
1489     int i;
1490     int first = -1;
1491     Lisp_Object val = Qunbound;
1492
1493     for (i = 0; i < NUM_ASCII_CHARS; i++)
1494       {
1495         if (first == -1)
1496           {
1497             first = i;
1498             val = ct->ascii[i];
1499             continue;
1500           }
1501
1502         if (!EQ (ct->ascii[i], val))
1503           {
1504             print_chartab_range (first, i - 1, val, printcharfun);
1505             first = -1;
1506             i--;
1507           }
1508       }
1509
1510     if (first != -1)
1511       print_chartab_range (first, i - 1, val, printcharfun);
1512   }
1513
1514 #ifdef MULE
1515   {
1516     Charset_ID i;
1517
1518     for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1519          i++)
1520       {
1521         Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1522         Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1523
1524         if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1525             || i == LEADING_BYTE_CONTROL_1)
1526           continue;
1527         if (!CHAR_TABLE_ENTRYP (ann))
1528           {
1529             write_c_string (" ", printcharfun);
1530             print_internal (XCHARSET_NAME (charset),
1531                             printcharfun, 0);
1532             write_c_string (" ", printcharfun);
1533             print_internal (ann, printcharfun, 0);
1534           }
1535         else
1536           {
1537             Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1538             if (XCHARSET_DIMENSION (charset) == 1)
1539               print_chartab_charset_row (charset, -1, cte, printcharfun);
1540             else
1541               print_chartab_two_byte_charset (charset, cte, printcharfun);
1542           }
1543       }
1544   }
1545 #endif /* MULE */
1546 #endif /* non UTF2000 */
1547
1548   write_c_string ("))", printcharfun);
1549 }
1550
1551 static int
1552 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1553 {
1554   Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1555   Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1556   int i;
1557
1558   if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1559     return 0;
1560
1561 #ifdef UTF2000
1562   for (i = 0; i < 256; i++)
1563     {
1564       if (!internal_equal (get_byte_table (ct1->table, i),
1565                            get_byte_table (ct2->table, i), 0))
1566         return 0;
1567     }
1568 #else
1569   for (i = 0; i < NUM_ASCII_CHARS; i++)
1570     if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1571       return 0;
1572
1573 #ifdef MULE
1574   for (i = 0; i < NUM_LEADING_BYTES; i++)
1575     if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1576       return 0;
1577 #endif /* MULE */
1578 #endif /* non UTF2000 */
1579
1580   return 1;
1581 }
1582
1583 static unsigned long
1584 char_table_hash (Lisp_Object obj, int depth)
1585 {
1586   Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1587 #ifdef UTF2000
1588     return byte_table_hash (ct->table, depth + 1);
1589 #else
1590   unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1591                                                depth);
1592 #ifdef MULE
1593   hashval = HASH2 (hashval,
1594                    internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1595 #endif /* MULE */
1596   return hashval;
1597 #endif
1598 }
1599
1600 static const struct lrecord_description char_table_description[] = {
1601 #ifdef UTF2000
1602   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1603   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1604   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1605   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1606 #else
1607   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1608 #ifdef MULE
1609   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1610 #endif
1611 #endif
1612 #ifndef UTF2000
1613   { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1614 #endif
1615   { XD_LO_LINK,     offsetof (Lisp_Char_Table, next_table) },
1616   { XD_END }
1617 };
1618
1619 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1620                                mark_char_table, print_char_table, 0,
1621                                char_table_equal, char_table_hash,
1622                                char_table_description,
1623                                Lisp_Char_Table);
1624
1625 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1626 Return non-nil if OBJECT is a char table.
1627
1628 A char table is a table that maps characters (or ranges of characters)
1629 to values.  Char tables are specialized for characters, only allowing
1630 particular sorts of ranges to be assigned values.  Although this
1631 loses in generality, it makes for extremely fast (constant-time)
1632 lookups, and thus is feasible for applications that do an extremely
1633 large number of lookups (e.g. scanning a buffer for a character in
1634 a particular syntax, where a lookup in the syntax table must occur
1635 once per character).
1636
1637 When Mule support exists, the types of ranges that can be assigned
1638 values are
1639
1640 -- all characters
1641 -- an entire charset
1642 -- a single row in a two-octet charset
1643 -- a single character
1644
1645 When Mule support is not present, the types of ranges that can be
1646 assigned values are
1647
1648 -- all characters
1649 -- a single character
1650
1651 To create a char table, use `make-char-table'.
1652 To modify a char table, use `put-char-table' or `remove-char-table'.
1653 To retrieve the value for a particular character, use `get-char-table'.
1654 See also `map-char-table', `clear-char-table', `copy-char-table',
1655 `valid-char-table-type-p', `char-table-type-list',
1656 `valid-char-table-value-p', and `check-char-table-value'.
1657 */
1658        (object))
1659 {
1660   return CHAR_TABLEP (object) ? Qt : Qnil;
1661 }
1662
1663 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1664 Return a list of the recognized char table types.
1665 See `valid-char-table-type-p'.
1666 */
1667        ())
1668 {
1669 #ifdef MULE
1670   return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1671 #else
1672   return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1673 #endif
1674 }
1675
1676 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1677 Return t if TYPE if a recognized char table type.
1678
1679 Each char table type is used for a different purpose and allows different
1680 sorts of values.  The different char table types are
1681
1682 `category'
1683         Used for category tables, which specify the regexp categories
1684         that a character is in.  The valid values are nil or a
1685         bit vector of 95 elements.  Higher-level Lisp functions are
1686         provided for working with category tables.  Currently categories
1687         and category tables only exist when Mule support is present.
1688 `char'
1689         A generalized char table, for mapping from one character to
1690         another.  Used for case tables, syntax matching tables,
1691         `keyboard-translate-table', etc.  The valid values are characters.
1692 `generic'
1693         An even more generalized char table, for mapping from a
1694         character to anything.
1695 `display'
1696         Used for display tables, which specify how a particular character
1697         is to appear when displayed.  #### Not yet implemented.
1698 `syntax'
1699         Used for syntax tables, which specify the syntax of a particular
1700         character.  Higher-level Lisp functions are provided for
1701         working with syntax tables.  The valid values are integers.
1702
1703 */
1704        (type))
1705 {
1706   return (EQ (type, Qchar)     ||
1707 #ifdef MULE
1708           EQ (type, Qcategory) ||
1709 #endif
1710           EQ (type, Qdisplay)  ||
1711           EQ (type, Qgeneric)  ||
1712           EQ (type, Qsyntax)) ? Qt : Qnil;
1713 }
1714
1715 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1716 Return the type of CHAR-TABLE.
1717 See `valid-char-table-type-p'.
1718 */
1719        (char_table))
1720 {
1721   CHECK_CHAR_TABLE (char_table);
1722   return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1723 }
1724
1725 void
1726 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1727 {
1728 #ifdef UTF2000
1729   ct->table = Qunbound;
1730   ct->default_value = value;
1731   ct->unloaded = 0;
1732 #else
1733   int i;
1734
1735   for (i = 0; i < NUM_ASCII_CHARS; i++)
1736     ct->ascii[i] = value;
1737 #ifdef MULE
1738   for (i = 0; i < NUM_LEADING_BYTES; i++)
1739     ct->level1[i] = value;
1740 #endif /* MULE */
1741 #endif
1742
1743 #ifndef UTF2000
1744   if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1745     update_syntax_table (ct);
1746 #endif
1747 }
1748
1749 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1750 Reset CHAR-TABLE to its default state.
1751 */
1752        (char_table))
1753 {
1754   Lisp_Char_Table *ct;
1755
1756   CHECK_CHAR_TABLE (char_table);
1757   ct = XCHAR_TABLE (char_table);
1758
1759   switch (ct->type)
1760     {
1761     case CHAR_TABLE_TYPE_CHAR:
1762       fill_char_table (ct, make_char (0));
1763       break;
1764     case CHAR_TABLE_TYPE_DISPLAY:
1765     case CHAR_TABLE_TYPE_GENERIC:
1766 #ifdef MULE
1767     case CHAR_TABLE_TYPE_CATEGORY:
1768 #endif /* MULE */
1769       fill_char_table (ct, Qnil);
1770       break;
1771
1772     case CHAR_TABLE_TYPE_SYNTAX:
1773       fill_char_table (ct, make_int (Sinherit));
1774       break;
1775
1776     default:
1777       abort ();
1778     }
1779
1780   return Qnil;
1781 }
1782
1783 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1784 Return a new, empty char table of type TYPE.
1785 Currently recognized types are 'char, 'category, 'display, 'generic,
1786 and 'syntax.  See `valid-char-table-type-p'.
1787 */
1788        (type))
1789 {
1790   Lisp_Char_Table *ct;
1791   Lisp_Object obj;
1792   enum char_table_type ty = symbol_to_char_table_type (type);
1793
1794   ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1795   ct->type = ty;
1796 #ifndef UTF2000
1797   if (ty == CHAR_TABLE_TYPE_SYNTAX)
1798     {
1799       ct->mirror_table = Fmake_char_table (Qgeneric);
1800       fill_char_table (XCHAR_TABLE (ct->mirror_table),
1801                        make_int (Spunct));
1802     }
1803   else
1804     ct->mirror_table = Qnil;
1805 #else
1806   ct->name = Qnil;
1807   ct->db = Qnil;
1808 #endif
1809   ct->next_table = Qnil;
1810   XSETCHAR_TABLE (obj, ct);
1811   if (ty == CHAR_TABLE_TYPE_SYNTAX)
1812     {
1813       ct->next_table = Vall_syntax_tables;
1814       Vall_syntax_tables = obj;
1815     }
1816   Freset_char_table (obj);
1817   return obj;
1818 }
1819
1820 #if defined(MULE)&&!defined(UTF2000)
1821
1822 static Lisp_Object
1823 make_char_table_entry (Lisp_Object initval)
1824 {
1825   Lisp_Object obj;
1826   int i;
1827   Lisp_Char_Table_Entry *cte =
1828     alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1829
1830   for (i = 0; i < 96; i++)
1831     cte->level2[i] = initval;
1832
1833   XSETCHAR_TABLE_ENTRY (obj, cte);
1834   return obj;
1835 }
1836
1837 static Lisp_Object
1838 copy_char_table_entry (Lisp_Object entry)
1839 {
1840   Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1841   Lisp_Object obj;
1842   int i;
1843   Lisp_Char_Table_Entry *ctenew =
1844     alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1845
1846   for (i = 0; i < 96; i++)
1847     {
1848       Lisp_Object new = cte->level2[i];
1849       if (CHAR_TABLE_ENTRYP (new))
1850         ctenew->level2[i] = copy_char_table_entry (new);
1851       else
1852         ctenew->level2[i] = new;
1853     }
1854
1855   XSETCHAR_TABLE_ENTRY (obj, ctenew);
1856   return obj;
1857 }
1858
1859 #endif /* MULE */
1860
1861 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1862 Return a new char table which is a copy of CHAR-TABLE.
1863 It will contain the same values for the same characters and ranges
1864 as CHAR-TABLE.  The values will not themselves be copied.
1865 */
1866        (char_table))
1867 {
1868   Lisp_Char_Table *ct, *ctnew;
1869   Lisp_Object obj;
1870 #ifndef UTF2000
1871   int i;
1872 #endif
1873
1874   CHECK_CHAR_TABLE (char_table);
1875   ct = XCHAR_TABLE (char_table);
1876   ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1877   ctnew->type = ct->type;
1878 #ifdef UTF2000
1879   ctnew->default_value = ct->default_value;
1880   /* [tomo:2002-01-21] Perhaps this code seems wrong */
1881   ctnew->name = ct->name;
1882   ctnew->db = ct->db;
1883
1884   if (UINT8_BYTE_TABLE_P (ct->table))
1885     {
1886       ctnew->table = copy_uint8_byte_table (ct->table);
1887     }
1888   else if (UINT16_BYTE_TABLE_P (ct->table))
1889     {
1890       ctnew->table = copy_uint16_byte_table (ct->table);
1891     }
1892   else if (BYTE_TABLE_P (ct->table))
1893     {
1894       ctnew->table = copy_byte_table (ct->table);
1895     }
1896   else if (!UNBOUNDP (ct->table))
1897     ctnew->table = ct->table;
1898 #else /* non UTF2000 */
1899
1900   for (i = 0; i < NUM_ASCII_CHARS; i++)
1901     {
1902       Lisp_Object new = ct->ascii[i];
1903 #ifdef MULE
1904       assert (! (CHAR_TABLE_ENTRYP (new)));
1905 #endif /* MULE */
1906       ctnew->ascii[i] = new;
1907     }
1908
1909 #ifdef MULE
1910
1911   for (i = 0; i < NUM_LEADING_BYTES; i++)
1912     {
1913       Lisp_Object new = ct->level1[i];
1914       if (CHAR_TABLE_ENTRYP (new))
1915         ctnew->level1[i] = copy_char_table_entry (new);
1916       else
1917         ctnew->level1[i] = new;
1918     }
1919
1920 #endif /* MULE */
1921 #endif /* non UTF2000 */
1922
1923 #ifndef UTF2000
1924   if (CHAR_TABLEP (ct->mirror_table))
1925     ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
1926   else
1927     ctnew->mirror_table = ct->mirror_table;
1928 #endif
1929   ctnew->next_table = Qnil;
1930   XSETCHAR_TABLE (obj, ctnew);
1931   if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
1932     {
1933       ctnew->next_table = Vall_syntax_tables;
1934       Vall_syntax_tables = obj;
1935     }
1936   return obj;
1937 }
1938
1939 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
1940 INLINE_HEADER int
1941 XCHARSET_CELL_RANGE (Lisp_Object ccs)
1942 {
1943   switch (XCHARSET_CHARS (ccs))
1944     {
1945     case 94:
1946       return (33 << 8) | 126;
1947     case 96:
1948       return (32 << 8) | 127;
1949 #ifdef UTF2000
1950     case 128:
1951       return (0 << 8) | 127;
1952     case 256:
1953       return (0 << 8) | 255;
1954 #endif
1955     default:
1956       abort ();
1957       return 0;
1958     }
1959 }
1960
1961 #ifndef UTF2000
1962 static
1963 #endif
1964 void
1965 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
1966 {
1967   if (EQ (range, Qt))
1968     outrange->type = CHARTAB_RANGE_ALL;
1969   else if (EQ (range, Qnil))
1970     outrange->type = CHARTAB_RANGE_DEFAULT;
1971   else if (CHAR_OR_CHAR_INTP (range))
1972     {
1973       outrange->type = CHARTAB_RANGE_CHAR;
1974       outrange->ch = XCHAR_OR_CHAR_INT (range);
1975     }
1976 #ifndef MULE
1977   else
1978     signal_simple_error ("Range must be t or a character", range);
1979 #else /* MULE */
1980   else if (VECTORP (range))
1981     {
1982       Lisp_Vector *vec = XVECTOR (range);
1983       Lisp_Object *elts = vector_data (vec);
1984       int cell_min, cell_max;
1985
1986       outrange->type = CHARTAB_RANGE_ROW;
1987       outrange->charset = Fget_charset (elts[0]);
1988       CHECK_INT (elts[1]);
1989       outrange->row = XINT (elts[1]);
1990       if (XCHARSET_DIMENSION (outrange->charset) < 2)
1991         signal_simple_error ("Charset in row vector must be multi-byte",
1992                              outrange->charset);
1993       else
1994         {
1995           int ret = XCHARSET_CELL_RANGE (outrange->charset);
1996
1997           cell_min = ret >> 8;
1998           cell_max = ret & 0xFF;
1999         }
2000       if (XCHARSET_DIMENSION (outrange->charset) == 2)
2001         check_int_range (outrange->row, cell_min, cell_max);
2002 #ifdef UTF2000
2003       else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2004         {
2005           check_int_range (outrange->row >> 8  , cell_min, cell_max);
2006           check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2007         }
2008       else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2009         {
2010           check_int_range ( outrange->row >> 16       , cell_min, cell_max);
2011           check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2012           check_int_range ( outrange->row       & 0xFF, cell_min, cell_max);
2013         }
2014 #endif
2015       else
2016         abort ();
2017     }
2018   else
2019     {
2020       if (!CHARSETP (range) && !SYMBOLP (range))
2021         signal_simple_error
2022           ("Char table range must be t, charset, char, or vector", range);
2023       outrange->type = CHARTAB_RANGE_CHARSET;
2024       outrange->charset = Fget_charset (range);
2025     }
2026 #endif /* MULE */
2027 }
2028
2029 #if defined(MULE)&&!defined(UTF2000)
2030
2031 /* called from CHAR_TABLE_VALUE(). */
2032 Lisp_Object
2033 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2034                                Emchar c)
2035 {
2036   Lisp_Object val;
2037 #ifdef UTF2000
2038   Lisp_Object charset;
2039 #else
2040   Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2041 #endif
2042   int byte1, byte2;
2043
2044 #ifdef UTF2000
2045   BREAKUP_CHAR (c, charset, byte1, byte2);
2046 #else
2047   BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2048 #endif
2049   val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2050   if (CHAR_TABLE_ENTRYP (val))
2051     {
2052       Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2053       val = cte->level2[byte1 - 32];
2054       if (CHAR_TABLE_ENTRYP (val))
2055         {
2056           cte = XCHAR_TABLE_ENTRY (val);
2057           assert (byte2 >= 32);
2058           val = cte->level2[byte2 - 32];
2059           assert (!CHAR_TABLE_ENTRYP (val));
2060         }
2061     }
2062
2063   return val;
2064 }
2065
2066 #endif /* MULE */
2067
2068 Lisp_Object
2069 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2070 {
2071 #ifdef UTF2000
2072   return get_char_id_table (ct, ch);
2073 #elif defined(MULE)
2074   {
2075     Lisp_Object charset;
2076     int byte1, byte2;
2077     Lisp_Object val;
2078
2079     BREAKUP_CHAR (ch, charset, byte1, byte2);
2080
2081     if (EQ (charset, Vcharset_ascii))
2082       val = ct->ascii[byte1];
2083     else if (EQ (charset, Vcharset_control_1))
2084       val = ct->ascii[byte1 + 128];
2085     else
2086       {
2087         int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2088         val = ct->level1[lb];
2089         if (CHAR_TABLE_ENTRYP (val))
2090           {
2091             Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2092             val = cte->level2[byte1 - 32];
2093             if (CHAR_TABLE_ENTRYP (val))
2094               {
2095                 cte = XCHAR_TABLE_ENTRY (val);
2096                 assert (byte2 >= 32);
2097                 val = cte->level2[byte2 - 32];
2098                 assert (!CHAR_TABLE_ENTRYP (val));
2099               }
2100           }
2101       }
2102
2103     return val;
2104   }
2105 #else /* not MULE */
2106   return ct->ascii[(unsigned char)ch];
2107 #endif /* not MULE */
2108 }
2109
2110
2111 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2112 Find value for CHARACTER in CHAR-TABLE.
2113 */
2114        (character, char_table))
2115 {
2116   CHECK_CHAR_TABLE (char_table);
2117   CHECK_CHAR_COERCE_INT (character);
2118
2119   return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2120 }
2121
2122 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2123 Find value for a range in CHAR-TABLE.
2124 If there is more than one value, return MULTI (defaults to nil).
2125 */
2126        (range, char_table, multi))
2127 {
2128   Lisp_Char_Table *ct;
2129   struct chartab_range rainj;
2130
2131   if (CHAR_OR_CHAR_INTP (range))
2132     return Fget_char_table (range, char_table);
2133   CHECK_CHAR_TABLE (char_table);
2134   ct = XCHAR_TABLE (char_table);
2135
2136   decode_char_table_range (range, &rainj);
2137   switch (rainj.type)
2138     {
2139     case CHARTAB_RANGE_ALL:
2140       {
2141 #ifdef UTF2000
2142         if (UINT8_BYTE_TABLE_P (ct->table))
2143           return multi;
2144         else if (UINT16_BYTE_TABLE_P (ct->table))
2145           return multi;
2146         else if (BYTE_TABLE_P (ct->table))
2147           return multi;
2148         else
2149           return ct->table;
2150 #else /* non UTF2000 */
2151         int i;
2152         Lisp_Object first = ct->ascii[0];
2153
2154         for (i = 1; i < NUM_ASCII_CHARS; i++)
2155           if (!EQ (first, ct->ascii[i]))
2156             return multi;
2157
2158 #ifdef MULE
2159         for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2160              i++)
2161           {
2162             if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2163                 || i == LEADING_BYTE_ASCII
2164                 || i == LEADING_BYTE_CONTROL_1)
2165               continue;
2166             if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2167               return multi;
2168           }
2169 #endif /* MULE */
2170
2171         return first;
2172 #endif /* non UTF2000 */
2173       }
2174
2175 #ifdef MULE
2176     case CHARTAB_RANGE_CHARSET:
2177 #ifdef UTF2000
2178       return multi;
2179 #else
2180       if (EQ (rainj.charset, Vcharset_ascii))
2181         {
2182           int i;
2183           Lisp_Object first = ct->ascii[0];
2184
2185           for (i = 1; i < 128; i++)
2186             if (!EQ (first, ct->ascii[i]))
2187               return multi;
2188           return first;
2189         }
2190
2191       if (EQ (rainj.charset, Vcharset_control_1))
2192         {
2193           int i;
2194           Lisp_Object first = ct->ascii[128];
2195
2196           for (i = 129; i < 160; i++)
2197             if (!EQ (first, ct->ascii[i]))
2198               return multi;
2199           return first;
2200         }
2201
2202       {
2203         Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2204                                      MIN_LEADING_BYTE];
2205         if (CHAR_TABLE_ENTRYP (val))
2206           return multi;
2207         return val;
2208       }
2209 #endif
2210
2211     case CHARTAB_RANGE_ROW:
2212 #ifdef UTF2000
2213       return multi;
2214 #else
2215       {
2216         Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2217                                      MIN_LEADING_BYTE];
2218         if (!CHAR_TABLE_ENTRYP (val))
2219           return val;
2220         val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2221         if (CHAR_TABLE_ENTRYP (val))
2222           return multi;
2223         return val;
2224       }
2225 #endif /* not UTF2000 */
2226 #endif /* not MULE */
2227
2228     default:
2229       abort ();
2230     }
2231
2232   return Qnil; /* not reached */
2233 }
2234
2235 static int
2236 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2237                               Error_behavior errb)
2238 {
2239   switch (type)
2240     {
2241     case CHAR_TABLE_TYPE_SYNTAX:
2242       if (!ERRB_EQ (errb, ERROR_ME))
2243         return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2244                                 && CHAR_OR_CHAR_INTP (XCDR (value)));
2245       if (CONSP (value))
2246         {
2247           Lisp_Object cdr = XCDR (value);
2248           CHECK_INT (XCAR (value));
2249           CHECK_CHAR_COERCE_INT (cdr);
2250          }
2251       else
2252         CHECK_INT (value);
2253       break;
2254
2255 #ifdef MULE
2256     case CHAR_TABLE_TYPE_CATEGORY:
2257       if (!ERRB_EQ (errb, ERROR_ME))
2258         return CATEGORY_TABLE_VALUEP (value);
2259       CHECK_CATEGORY_TABLE_VALUE (value);
2260       break;
2261 #endif /* MULE */
2262
2263     case CHAR_TABLE_TYPE_GENERIC:
2264       return 1;
2265
2266     case CHAR_TABLE_TYPE_DISPLAY:
2267       /* #### fix this */
2268       maybe_signal_simple_error ("Display char tables not yet implemented",
2269                                  value, Qchar_table, errb);
2270       return 0;
2271
2272     case CHAR_TABLE_TYPE_CHAR:
2273       if (!ERRB_EQ (errb, ERROR_ME))
2274         return CHAR_OR_CHAR_INTP (value);
2275       CHECK_CHAR_COERCE_INT (value);
2276       break;
2277
2278     default:
2279       abort ();
2280     }
2281
2282   return 0; /* not reached */
2283 }
2284
2285 static Lisp_Object
2286 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2287 {
2288   switch (type)
2289     {
2290     case CHAR_TABLE_TYPE_SYNTAX:
2291       if (CONSP (value))
2292         {
2293           Lisp_Object car = XCAR (value);
2294           Lisp_Object cdr = XCDR (value);
2295           CHECK_CHAR_COERCE_INT (cdr);
2296           return Fcons (car, cdr);
2297         }
2298       break;
2299     case CHAR_TABLE_TYPE_CHAR:
2300       CHECK_CHAR_COERCE_INT (value);
2301       break;
2302     default:
2303       break;
2304     }
2305   return value;
2306 }
2307
2308 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2309 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2310 */
2311        (value, char_table_type))
2312 {
2313   enum char_table_type type = symbol_to_char_table_type (char_table_type);
2314
2315   return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2316 }
2317
2318 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2319 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2320 */
2321        (value, char_table_type))
2322 {
2323   enum char_table_type type = symbol_to_char_table_type (char_table_type);
2324
2325   check_valid_char_table_value (value, type, ERROR_ME);
2326   return Qnil;
2327 }
2328
2329 #ifdef UTF2000
2330 Lisp_Char_Table* char_attribute_table_to_put;
2331 Lisp_Object Qput_char_table_map_function;
2332 Lisp_Object value_to_put;
2333
2334 DEFUN ("put-char-table-map-function",
2335        Fput_char_table_map_function, 2, 2, 0, /*
2336 For internal use.  Don't use it.
2337 */
2338        (c, value))
2339 {
2340   put_char_id_table_0 (char_attribute_table_to_put, c, value_to_put);
2341   return Qnil;
2342 }
2343 #endif
2344
2345 /* Assign VAL to all characters in RANGE in char table CT. */
2346
2347 void
2348 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2349                 Lisp_Object val)
2350 {
2351   switch (range->type)
2352     {
2353     case CHARTAB_RANGE_ALL:
2354       /* printf ("put-char-table: range = all\n"); */
2355       fill_char_table (ct, val);
2356       return; /* avoid the duplicate call to update_syntax_table() below,
2357                  since fill_char_table() also did that. */
2358
2359 #ifdef UTF2000
2360     case CHARTAB_RANGE_DEFAULT:
2361       ct->default_value = val;
2362       return;
2363 #endif
2364
2365 #ifdef MULE
2366     case CHARTAB_RANGE_CHARSET:
2367 #ifdef UTF2000
2368       {
2369         Emchar c;
2370         Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2371
2372         /* printf ("put-char-table: range = charset: %d\n",
2373            XCHARSET_LEADING_BYTE (range->charset));
2374         */
2375         if ( CHAR_TABLEP (encoding_table) )
2376           {
2377 #if 1
2378             char_attribute_table_to_put = ct;
2379             value_to_put = val;
2380             Fmap_char_attribute (Qput_char_table_map_function,
2381                                  XCHAR_TABLE_NAME (encoding_table),
2382                                  Qnil);
2383 #else
2384             for (c = 0; c < 1 << 24; c++)
2385               {
2386                 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
2387                                               c)) )
2388                   put_char_id_table_0 (ct, c, val);
2389               }
2390 #endif
2391           }
2392         else
2393           {
2394             for (c = 0; c < 1 << 24; c++)
2395               {
2396                 if ( charset_code_point (range->charset, c) >= 0 )
2397                   put_char_id_table_0 (ct, c, val);
2398               }
2399           }
2400       }
2401 #else
2402       if (EQ (range->charset, Vcharset_ascii))
2403         {
2404           int i;
2405           for (i = 0; i < 128; i++)
2406             ct->ascii[i] = val;
2407         }
2408       else if (EQ (range->charset, Vcharset_control_1))
2409         {
2410           int i;
2411           for (i = 128; i < 160; i++)
2412             ct->ascii[i] = val;
2413         }
2414       else
2415         {
2416           int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2417           ct->level1[lb] = val;
2418         }
2419 #endif
2420       break;
2421
2422     case CHARTAB_RANGE_ROW:
2423 #ifdef UTF2000
2424       {
2425         int cell_min, cell_max, i;
2426
2427         i = XCHARSET_CELL_RANGE (range->charset);
2428         cell_min = i >> 8;
2429         cell_max = i & 0xFF;
2430         for (i = cell_min; i <= cell_max; i++)
2431           {
2432             Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2433
2434             if ( charset_code_point (range->charset, ch) >= 0 )
2435               put_char_id_table_0 (ct, ch, val);
2436           }
2437       }
2438 #else
2439       {
2440         Lisp_Char_Table_Entry *cte;
2441         int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2442         /* make sure that there is a separate entry for the row. */
2443         if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2444           ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2445         cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2446         cte->level2[range->row - 32] = val;
2447       }
2448 #endif /* not UTF2000 */
2449       break;
2450 #endif /* MULE */
2451
2452     case CHARTAB_RANGE_CHAR:
2453 #ifdef UTF2000
2454       /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2455       put_char_id_table_0 (ct, range->ch, val);
2456       break;
2457 #elif defined(MULE)
2458       {
2459         Lisp_Object charset;
2460         int byte1, byte2;
2461
2462         BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2463         if (EQ (charset, Vcharset_ascii))
2464           ct->ascii[byte1] = val;
2465         else if (EQ (charset, Vcharset_control_1))
2466           ct->ascii[byte1 + 128] = val;
2467         else
2468           {
2469             Lisp_Char_Table_Entry *cte;
2470             int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2471             /* make sure that there is a separate entry for the row. */
2472             if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2473               ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2474             cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2475             /* now CTE is a char table entry for the charset;
2476                each entry is for a single row (or character of
2477                a one-octet charset). */
2478             if (XCHARSET_DIMENSION (charset) == 1)
2479               cte->level2[byte1 - 32] = val;
2480             else
2481               {
2482                 /* assigning to one character in a two-octet charset. */
2483                 /* make sure that the charset row contains a separate
2484                    entry for each character. */
2485                 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2486                   cte->level2[byte1 - 32] =
2487                     make_char_table_entry (cte->level2[byte1 - 32]);
2488                 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2489                 cte->level2[byte2 - 32] = val;
2490               }
2491           }
2492       }
2493 #else /* not MULE */
2494       ct->ascii[(unsigned char) (range->ch)] = val;
2495       break;
2496 #endif /* not MULE */
2497     }
2498
2499 #ifndef UTF2000
2500   if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2501     update_syntax_table (ct);
2502 #endif
2503 }
2504
2505 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2506 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2507
2508 RANGE specifies one or more characters to be affected and should be
2509 one of the following:
2510
2511 -- t (all characters are affected)
2512 -- A charset (only allowed when Mule support is present)
2513 -- A vector of two elements: a two-octet charset and a row number
2514    (only allowed when Mule support is present)
2515 -- A single character
2516
2517 VALUE must be a value appropriate for the type of CHAR-TABLE.
2518 See `valid-char-table-type-p'.
2519 */
2520        (range, value, char_table))
2521 {
2522   Lisp_Char_Table *ct;
2523   struct chartab_range rainj;
2524
2525   CHECK_CHAR_TABLE (char_table);
2526   ct = XCHAR_TABLE (char_table);
2527   check_valid_char_table_value (value, ct->type, ERROR_ME);
2528   decode_char_table_range (range, &rainj);
2529   value = canonicalize_char_table_value (value, ct->type);
2530   put_char_table (ct, &rainj, value);
2531   return Qnil;
2532 }
2533
2534 #ifndef UTF2000
2535 /* Map FN over the ASCII chars in CT. */
2536
2537 static int
2538 map_over_charset_ascii (Lisp_Char_Table *ct,
2539                         int (*fn) (struct chartab_range *range,
2540                                    Lisp_Object val, void *arg),
2541                         void *arg)
2542 {
2543   struct chartab_range rainj;
2544   int i, retval;
2545   int start = 0;
2546 #ifdef MULE
2547   int stop = 128;
2548 #else
2549   int stop = 256;
2550 #endif
2551
2552   rainj.type = CHARTAB_RANGE_CHAR;
2553
2554   for (i = start, retval = 0; i < stop && retval == 0; i++)
2555     {
2556       rainj.ch = (Emchar) i;
2557       retval = (fn) (&rainj, ct->ascii[i], arg);
2558     }
2559
2560   return retval;
2561 }
2562
2563 #ifdef MULE
2564
2565 /* Map FN over the Control-1 chars in CT. */
2566
2567 static int
2568 map_over_charset_control_1 (Lisp_Char_Table *ct,
2569                             int (*fn) (struct chartab_range *range,
2570                                        Lisp_Object val, void *arg),
2571                             void *arg)
2572 {
2573   struct chartab_range rainj;
2574   int i, retval;
2575   int start = 128;
2576   int stop  = start + 32;
2577
2578   rainj.type = CHARTAB_RANGE_CHAR;
2579
2580   for (i = start, retval = 0; i < stop && retval == 0; i++)
2581     {
2582       rainj.ch = (Emchar) (i);
2583       retval = (fn) (&rainj, ct->ascii[i], arg);
2584     }
2585
2586   return retval;
2587 }
2588
2589 /* Map FN over the row ROW of two-byte charset CHARSET.
2590    There must be a separate value for that row in the char table.
2591    CTE specifies the char table entry for CHARSET. */
2592
2593 static int
2594 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2595                       Lisp_Object charset, int row,
2596                       int (*fn) (struct chartab_range *range,
2597                                  Lisp_Object val, void *arg),
2598                       void *arg)
2599 {
2600   Lisp_Object val = cte->level2[row - 32];
2601
2602   if (!CHAR_TABLE_ENTRYP (val))
2603     {
2604       struct chartab_range rainj;
2605
2606       rainj.type = CHARTAB_RANGE_ROW;
2607       rainj.charset = charset;
2608       rainj.row = row;
2609       return (fn) (&rainj, val, arg);
2610     }
2611   else
2612     {
2613       struct chartab_range rainj;
2614       int i, retval;
2615       int charset94_p = (XCHARSET_CHARS (charset) == 94);
2616       int start = charset94_p ?  33 :  32;
2617       int stop  = charset94_p ? 127 : 128;
2618
2619       cte = XCHAR_TABLE_ENTRY (val);
2620
2621       rainj.type = CHARTAB_RANGE_CHAR;
2622
2623       for (i = start, retval = 0; i < stop && retval == 0; i++)
2624         {
2625           rainj.ch = MAKE_CHAR (charset, row, i);
2626           retval = (fn) (&rainj, cte->level2[i - 32], arg);
2627         }
2628       return retval;
2629     }
2630 }
2631
2632
2633 static int
2634 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2635                         int (*fn) (struct chartab_range *range,
2636                                    Lisp_Object val, void *arg),
2637                         void *arg)
2638 {
2639   Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2640   Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2641
2642   if (!CHARSETP (charset)
2643       || lb == LEADING_BYTE_ASCII
2644       || lb == LEADING_BYTE_CONTROL_1)
2645     return 0;
2646
2647   if (!CHAR_TABLE_ENTRYP (val))
2648     {
2649       struct chartab_range rainj;
2650
2651       rainj.type = CHARTAB_RANGE_CHARSET;
2652       rainj.charset = charset;
2653       return (fn) (&rainj, val, arg);
2654     }
2655
2656   {
2657     Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2658     int charset94_p = (XCHARSET_CHARS (charset) == 94);
2659     int start = charset94_p ?  33 :  32;
2660     int stop  = charset94_p ? 127 : 128;
2661     int i, retval;
2662
2663     if (XCHARSET_DIMENSION (charset) == 1)
2664       {
2665         struct chartab_range rainj;
2666         rainj.type = CHARTAB_RANGE_CHAR;
2667
2668         for (i = start, retval = 0; i < stop && retval == 0; i++)
2669           {
2670             rainj.ch = MAKE_CHAR (charset, i, 0);
2671             retval = (fn) (&rainj, cte->level2[i - 32], arg);
2672           }
2673       }
2674     else
2675       {
2676         for (i = start, retval = 0; i < stop && retval == 0; i++)
2677           retval = map_over_charset_row (cte, charset, i, fn, arg);
2678       }
2679
2680     return retval;
2681   }
2682 }
2683
2684 #endif /* MULE */
2685 #endif /* not UTF2000 */
2686
2687 #ifdef UTF2000
2688 struct map_char_table_for_charset_arg
2689 {
2690   int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2691   Lisp_Char_Table *ct;
2692   void *arg;
2693 };
2694
2695 static int
2696 map_char_table_for_charset_fun (struct chartab_range *range,
2697                                 Lisp_Object val, void *arg)
2698 {
2699   struct map_char_table_for_charset_arg *closure =
2700     (struct map_char_table_for_charset_arg *) arg;
2701   Lisp_Object ret;
2702
2703   switch (range->type)
2704     {
2705     case CHARTAB_RANGE_ALL:
2706       break;
2707
2708     case CHARTAB_RANGE_DEFAULT:
2709       break;
2710
2711     case CHARTAB_RANGE_CHARSET:
2712       break;
2713
2714     case CHARTAB_RANGE_ROW:
2715       break;
2716
2717     case CHARTAB_RANGE_CHAR:
2718       ret = get_char_table (range->ch, closure->ct);
2719       if (!UNBOUNDP (ret))
2720         return (closure->fn) (range, ret, closure->arg);
2721       break;
2722
2723     default:
2724       abort ();
2725     }
2726
2727   return 0;
2728 }
2729
2730 #endif
2731
2732 /* Map FN (with client data ARG) over range RANGE in char table CT.
2733    Mapping stops the first time FN returns non-zero, and that value
2734    becomes the return value of map_char_table(). */
2735
2736 int
2737 map_char_table (Lisp_Char_Table *ct,
2738                 struct chartab_range *range,
2739                 int (*fn) (struct chartab_range *range,
2740                            Lisp_Object val, void *arg),
2741                 void *arg)
2742 {
2743   switch (range->type)
2744     {
2745     case CHARTAB_RANGE_ALL:
2746 #ifdef UTF2000
2747       if (!UNBOUNDP (ct->default_value))
2748         {
2749           struct chartab_range rainj;
2750           int retval;
2751
2752           rainj.type = CHARTAB_RANGE_DEFAULT;
2753           retval = (fn) (&rainj, ct->default_value, arg);
2754           if (retval != 0)
2755             return retval;
2756         }
2757       if (UINT8_BYTE_TABLE_P (ct->table))
2758         return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2759                                           0, 3, fn, arg);
2760       else if (UINT16_BYTE_TABLE_P (ct->table))
2761         return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2762                                            0, 3, fn, arg);
2763       else if (BYTE_TABLE_P (ct->table))
2764         return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2765                                     0, 3, fn, arg);
2766       else if (EQ (ct->table, Qunloaded))
2767         {
2768 #if 0
2769           struct chartab_range rainj;
2770           int unit = 1 << 30;
2771           Emchar c = 0;
2772           Emchar c1 = c + unit;
2773           int retval;
2774
2775           rainj.type = CHARTAB_RANGE_CHAR;
2776
2777           for (retval = 0; c < c1 && retval == 0; c++)
2778             {
2779               Lisp_Object ret = get_char_id_table (ct, c);
2780
2781               if (!UNBOUNDP (ret))
2782                 {
2783                   rainj.ch = c;
2784                   retval = (fn) (&rainj, ct->table, arg);
2785                 }
2786             }
2787           return retval;
2788 #else
2789           ct->table = Qunbound;
2790 #endif
2791         }
2792       else if (!UNBOUNDP (ct->table))
2793         return (fn) (range, ct->table, arg);
2794       return 0;
2795 #else
2796       {
2797         int retval;
2798
2799         retval = map_over_charset_ascii (ct, fn, arg);
2800         if (retval)
2801           return retval;
2802 #ifdef MULE
2803         retval = map_over_charset_control_1 (ct, fn, arg);
2804         if (retval)
2805           return retval;
2806         {
2807           Charset_ID i;
2808           Charset_ID start = MIN_LEADING_BYTE;
2809           Charset_ID stop  = start + NUM_LEADING_BYTES;
2810
2811           for (i = start, retval = 0; i < stop && retval == 0; i++)
2812             {
2813               retval = map_over_other_charset (ct, i, fn, arg);
2814             }
2815         }
2816 #endif /* MULE */
2817         return retval;
2818       }
2819 #endif
2820
2821 #ifdef UTF2000
2822     case CHARTAB_RANGE_DEFAULT:
2823       if (!UNBOUNDP (ct->default_value))
2824         return (fn) (range, ct->default_value, arg);
2825       return 0;
2826 #endif
2827
2828 #ifdef MULE
2829     case CHARTAB_RANGE_CHARSET:
2830 #ifdef UTF2000
2831       {
2832         Lisp_Object encoding_table
2833           = XCHARSET_ENCODING_TABLE (range->charset);
2834
2835         if (!NILP (encoding_table))
2836           {
2837             struct chartab_range rainj;
2838             struct map_char_table_for_charset_arg mcarg;
2839
2840 #ifdef HAVE_DATABASE
2841             if (XCHAR_TABLE_UNLOADED(encoding_table))
2842               Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2843 #endif
2844             mcarg.fn = fn;
2845             mcarg.ct = ct;
2846             mcarg.arg = arg;
2847             rainj.type = CHARTAB_RANGE_ALL;
2848             return map_char_table (XCHAR_TABLE(encoding_table),
2849                                    &rainj,
2850                                    &map_char_table_for_charset_fun,
2851                                    &mcarg);
2852           }
2853       }
2854       return 0;
2855 #else
2856       return map_over_other_charset (ct,
2857                                      XCHARSET_LEADING_BYTE (range->charset),
2858                                      fn, arg);
2859 #endif
2860
2861     case CHARTAB_RANGE_ROW:
2862 #ifdef UTF2000
2863       {
2864         int cell_min, cell_max, i;
2865         int retval;
2866         struct chartab_range rainj;
2867
2868         i = XCHARSET_CELL_RANGE (range->charset);
2869         cell_min = i >> 8;
2870         cell_max = i & 0xFF;
2871         rainj.type = CHARTAB_RANGE_CHAR;
2872         for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2873           {
2874             Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2875
2876             if ( charset_code_point (range->charset, ch) >= 0 )
2877               {
2878                 Lisp_Object val
2879                   = get_byte_table (get_byte_table
2880                                     (get_byte_table
2881                                      (get_byte_table
2882                                       (ct->table,
2883                                        (unsigned char)(ch >> 24)),
2884                                       (unsigned char) (ch >> 16)),
2885                                      (unsigned char)  (ch >> 8)),
2886                                     (unsigned char)    ch);
2887
2888                 if (UNBOUNDP (val))
2889                   val = ct->default_value;
2890                 rainj.ch = ch;
2891                 retval = (fn) (&rainj, val, arg);
2892               }
2893           }
2894         return retval;
2895       }
2896 #else
2897       {
2898         Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2899                                     - MIN_LEADING_BYTE];
2900         if (!CHAR_TABLE_ENTRYP (val))
2901           {
2902             struct chartab_range rainj;
2903
2904             rainj.type = CHARTAB_RANGE_ROW;
2905             rainj.charset = range->charset;
2906             rainj.row = range->row;
2907             return (fn) (&rainj, val, arg);
2908           }
2909         else
2910           return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
2911                                        range->charset, range->row,
2912                                        fn, arg);
2913       }
2914 #endif /* not UTF2000 */
2915 #endif /* MULE */
2916
2917     case CHARTAB_RANGE_CHAR:
2918       {
2919         Emchar ch = range->ch;
2920         Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
2921
2922         if (!UNBOUNDP (val))
2923           {
2924             struct chartab_range rainj;
2925
2926             rainj.type = CHARTAB_RANGE_CHAR;
2927             rainj.ch = ch;
2928             return (fn) (&rainj, val, arg);
2929           }
2930         return 0;
2931       }
2932
2933     default:
2934       abort ();
2935     }
2936
2937   return 0;
2938 }
2939
2940 struct slow_map_char_table_arg
2941 {
2942   Lisp_Object function;
2943   Lisp_Object retval;
2944 };
2945
2946 static int
2947 slow_map_char_table_fun (struct chartab_range *range,
2948                          Lisp_Object val, void *arg)
2949 {
2950   Lisp_Object ranjarg = Qnil;
2951   struct slow_map_char_table_arg *closure =
2952     (struct slow_map_char_table_arg *) arg;
2953
2954   switch (range->type)
2955     {
2956     case CHARTAB_RANGE_ALL:
2957       ranjarg = Qt;
2958       break;
2959
2960 #ifdef UTF2000
2961     case CHARTAB_RANGE_DEFAULT:
2962       ranjarg = Qnil;
2963       break;
2964 #endif
2965
2966 #ifdef MULE
2967     case CHARTAB_RANGE_CHARSET:
2968       ranjarg = XCHARSET_NAME (range->charset);
2969       break;
2970
2971     case CHARTAB_RANGE_ROW:
2972       ranjarg = vector2 (XCHARSET_NAME (range->charset),
2973                          make_int (range->row));
2974       break;
2975 #endif /* MULE */
2976     case CHARTAB_RANGE_CHAR:
2977       ranjarg = make_char (range->ch);
2978       break;
2979     default:
2980       abort ();
2981     }
2982
2983   closure->retval = call2 (closure->function, ranjarg, val);
2984   return !NILP (closure->retval);
2985 }
2986
2987 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
2988 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
2989 each key and value in the table.
2990
2991 RANGE specifies a subrange to map over and is in the same format as
2992 the RANGE argument to `put-range-table'.  If omitted or t, it defaults to
2993 the entire table.
2994 */
2995        (function, char_table, range))
2996 {
2997   Lisp_Char_Table *ct;
2998   struct slow_map_char_table_arg slarg;
2999   struct gcpro gcpro1, gcpro2;
3000   struct chartab_range rainj;
3001
3002   CHECK_CHAR_TABLE (char_table);
3003   ct = XCHAR_TABLE (char_table);
3004   if (NILP (range))
3005     range = Qt;
3006   decode_char_table_range (range, &rainj);
3007   slarg.function = function;
3008   slarg.retval = Qnil;
3009   GCPRO2 (slarg.function, slarg.retval);
3010   map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3011   UNGCPRO;
3012
3013   return slarg.retval;
3014 }
3015
3016 \f
3017 /************************************************************************/
3018 /*                         Character Attributes                         */
3019 /************************************************************************/
3020
3021 #ifdef UTF2000
3022
3023 Lisp_Object Vchar_attribute_hash_table;
3024
3025 /* We store the char-attributes in hash tables with the names as the
3026    key and the actual char-id-table object as the value.  Occasionally
3027    we need to use them in a list format.  These routines provide us
3028    with that. */
3029 struct char_attribute_list_closure
3030 {
3031   Lisp_Object *char_attribute_list;
3032 };
3033
3034 static int
3035 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3036                                    void *char_attribute_list_closure)
3037 {
3038   /* This function can GC */
3039   struct char_attribute_list_closure *calcl
3040     = (struct char_attribute_list_closure*) char_attribute_list_closure;
3041   Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3042
3043   *char_attribute_list = Fcons (key, *char_attribute_list);
3044   return 0;
3045 }
3046
3047 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3048 Return the list of all existing character attributes except coded-charsets.
3049 */
3050        ())
3051 {
3052   Lisp_Object char_attribute_list = Qnil;
3053   struct gcpro gcpro1;
3054   struct char_attribute_list_closure char_attribute_list_closure;
3055
3056   GCPRO1 (char_attribute_list);
3057   char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3058   elisp_maphash (add_char_attribute_to_list_mapper,
3059                  Vchar_attribute_hash_table,
3060                  &char_attribute_list_closure);
3061   UNGCPRO;
3062   return char_attribute_list;
3063 }
3064
3065 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3066 Return char-id-table corresponding to ATTRIBUTE.
3067 */
3068        (attribute))
3069 {
3070   return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3071 }
3072
3073
3074 /* We store the char-id-tables in hash tables with the attributes as
3075    the key and the actual char-id-table object as the value.  Each
3076    char-id-table stores values of an attribute corresponding with
3077    characters.  Occasionally we need to get attributes of a character
3078    in a association-list format.  These routines provide us with
3079    that. */
3080 struct char_attribute_alist_closure
3081 {
3082   Emchar char_id;
3083   Lisp_Object *char_attribute_alist;
3084 };
3085
3086 static int
3087 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3088                                  void *char_attribute_alist_closure)
3089 {
3090   /* This function can GC */
3091   struct char_attribute_alist_closure *caacl =
3092     (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3093   Lisp_Object ret
3094     = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3095   if (!UNBOUNDP (ret))
3096     {
3097       Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3098       *char_attribute_alist
3099         = Fcons (Fcons (key, ret), *char_attribute_alist);
3100     }
3101   return 0;
3102 }
3103
3104 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3105 Return the alist of attributes of CHARACTER.
3106 */
3107        (character))
3108 {
3109   struct gcpro gcpro1;
3110   struct char_attribute_alist_closure char_attribute_alist_closure;
3111   Lisp_Object alist = Qnil;
3112
3113   CHECK_CHAR (character);
3114
3115   GCPRO1 (alist);
3116   char_attribute_alist_closure.char_id = XCHAR (character);
3117   char_attribute_alist_closure.char_attribute_alist = &alist;
3118   elisp_maphash (add_char_attribute_alist_mapper,
3119                  Vchar_attribute_hash_table,
3120                  &char_attribute_alist_closure);
3121   UNGCPRO;
3122
3123   return alist;
3124 }
3125
3126 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3127 Return the value of CHARACTER's ATTRIBUTE.
3128 Return DEFAULT-VALUE if the value is not exist.
3129 */
3130        (character, attribute, default_value))
3131 {
3132   Lisp_Object table;
3133
3134   CHECK_CHAR (character);
3135
3136   if (CHARSETP (attribute))
3137     attribute = XCHARSET_NAME (attribute);
3138
3139   table = Fgethash (attribute, Vchar_attribute_hash_table,
3140                     Qunbound);
3141   if (!UNBOUNDP (table))
3142     {
3143       Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3144                                            XCHAR (character));
3145       if (!UNBOUNDP (ret))
3146         return ret;
3147     }
3148   return default_value;
3149 }
3150
3151 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3152 Store CHARACTER's ATTRIBUTE with VALUE.
3153 */
3154        (character, attribute, value))
3155 {
3156   Lisp_Object ccs = Ffind_charset (attribute);
3157
3158   if (!NILP (ccs))
3159     {
3160       CHECK_CHAR (character);
3161       value = put_char_ccs_code_point (character, ccs, value);
3162     }
3163   else if (EQ (attribute, Q_decomposition))
3164     {
3165       Lisp_Object seq;
3166
3167       CHECK_CHAR (character);
3168       if (!CONSP (value))
3169         signal_simple_error ("Invalid value for ->decomposition",
3170                              value);
3171
3172       if (CONSP (Fcdr (value)))
3173         {
3174           Lisp_Object rest = value;
3175           Lisp_Object table = Vcharacter_composition_table;
3176           size_t len;
3177           int i = 0;
3178
3179           GET_EXTERNAL_LIST_LENGTH (rest, len);
3180           seq = make_vector (len, Qnil);
3181
3182           while (CONSP (rest))
3183             {
3184               Lisp_Object v = Fcar (rest);
3185               Lisp_Object ntable;
3186               Emchar c
3187                 = to_char_id (v, "Invalid value for ->decomposition", value);
3188
3189               if (c < 0)
3190                 XVECTOR_DATA(seq)[i++] = v;
3191               else
3192                 XVECTOR_DATA(seq)[i++] = make_char (c);
3193               rest = Fcdr (rest);
3194               if (!CONSP (rest))
3195                 {
3196                   put_char_id_table (XCHAR_TABLE(table),
3197                                      make_char (c), character);
3198                   break;
3199                 }
3200               else
3201                 {
3202                   ntable = get_char_id_table (XCHAR_TABLE(table), c);
3203                   if (!CHAR_TABLEP (ntable))
3204                     {
3205                       ntable = make_char_id_table (Qnil);
3206                       put_char_id_table (XCHAR_TABLE(table),
3207                                          make_char (c), ntable);
3208                     }
3209                   table = ntable;
3210                 }
3211             }
3212         }
3213       else
3214         {
3215           Lisp_Object v = Fcar (value);
3216
3217           if (INTP (v))
3218             {
3219               Emchar c = XINT (v);
3220               Lisp_Object ret
3221                 = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3222                                      c);
3223
3224               if (!CONSP (ret))
3225                 {
3226                   put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3227                                      make_char (c), Fcons (character, Qnil));
3228                 }
3229               else if (NILP (Fmemq (v, ret)))
3230                 {
3231                   put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3232                                      make_char (c), Fcons (character, ret));
3233                 }
3234             }
3235           seq = make_vector (1, v);
3236         }
3237       value = seq;
3238     }
3239   else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
3240     {
3241       Lisp_Object ret;
3242       Emchar c;
3243
3244       CHECK_CHAR (character);
3245       if (!INTP (value))
3246         signal_simple_error ("Invalid value for ->ucs", value);
3247
3248       c = XINT (value);
3249
3250       ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
3251       if (!CONSP (ret))
3252         {
3253           put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3254                              make_char (c), Fcons (character, Qnil));
3255         }
3256       else if (NILP (Fmemq (character, ret)))
3257         {
3258           put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3259                              make_char (c), Fcons (character, ret));
3260         }
3261 #if 0
3262       if (EQ (attribute, Q_ucs))
3263         attribute = Qto_ucs;
3264 #endif
3265     }
3266   {
3267     Lisp_Object table = Fgethash (attribute,
3268                                   Vchar_attribute_hash_table,
3269                                   Qnil);
3270
3271     if (NILP (table))
3272       {
3273         table = make_char_id_table (Qunbound);
3274         Fputhash (attribute, table, Vchar_attribute_hash_table);
3275 #ifdef HAVE_DATABASE
3276         XCHAR_TABLE_NAME (table) = attribute;
3277 #endif
3278       }
3279     put_char_id_table (XCHAR_TABLE(table), character, value);
3280     return value;
3281   }
3282 }
3283
3284 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3285 Remove CHARACTER's ATTRIBUTE.
3286 */
3287        (character, attribute))
3288 {
3289   Lisp_Object ccs;
3290
3291   CHECK_CHAR (character);
3292   ccs = Ffind_charset (attribute);
3293   if (!NILP (ccs))
3294     {
3295       return remove_char_ccs (character, ccs);
3296     }
3297   else
3298     {
3299       Lisp_Object table = Fgethash (attribute,
3300                                     Vchar_attribute_hash_table,
3301                                     Qunbound);
3302       if (!UNBOUNDP (table))
3303         {
3304           put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3305           return Qt;
3306         }
3307     }
3308   return Qnil;
3309 }
3310
3311 Lisp_Object
3312 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3313                                int writing_mode)
3314 {
3315   Lisp_Object db_dir = Vexec_directory;
3316
3317   if (NILP (db_dir))
3318     db_dir = build_string ("../lib-src");
3319
3320   db_dir = Fexpand_file_name (build_string ("char-db"), db_dir);
3321   if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3322     Fmake_directory_internal (db_dir);
3323
3324   db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3325   if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3326     Fmake_directory_internal (db_dir);
3327
3328   {
3329     Lisp_Object attribute_name = Fsymbol_name (attribute);
3330     Lisp_Object dest = Qnil, ret;
3331     int base = 0;
3332     struct gcpro gcpro1, gcpro2;
3333     int len = XSTRING_CHAR_LENGTH (attribute_name);
3334     int i;
3335
3336     GCPRO2 (dest, ret);
3337     for (i = 0; i < len; i++)
3338       {
3339         Emchar c = string_char (XSTRING (attribute_name), i);
3340
3341         if ( (c == '/') || (c == '%') )
3342           {
3343             char str[4];
3344
3345             sprintf (str, "%%%02X", c);
3346             dest = concat3 (dest,
3347                             Fsubstring (attribute_name,
3348                                         make_int (base), make_int (i)),
3349                             build_string (str));
3350             base = i + 1;
3351           }
3352       }
3353     ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3354     dest = concat2 (dest, ret);
3355     UNGCPRO;
3356     return Fexpand_file_name (dest, db_dir);
3357   }
3358 #if 0
3359   return Fexpand_file_name (Fsymbol_name (attribute), db_dir);
3360 #endif
3361 }
3362
3363 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3364 Save values of ATTRIBUTE into database file.
3365 */
3366        (attribute))
3367 {
3368 #ifdef HAVE_DATABASE
3369   Lisp_Object table = Fgethash (attribute,
3370                                 Vchar_attribute_hash_table, Qunbound);
3371   Lisp_Char_Table *ct;
3372   Lisp_Object db_file;
3373   Lisp_Object db;
3374
3375   if (CHAR_TABLEP (table))
3376     ct = XCHAR_TABLE (table);
3377   else
3378     return Qnil;
3379
3380   db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3381   db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3382   if (!NILP (db))
3383     {
3384       if (UINT8_BYTE_TABLE_P (ct->table))
3385         save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct, db, 0, 3);
3386       else if (UINT16_BYTE_TABLE_P (ct->table))
3387         save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct, db, 0, 3);
3388       else if (BYTE_TABLE_P (ct->table))
3389         save_byte_table (XBYTE_TABLE(ct->table), ct, db, 0, 3);
3390       Fclose_database (db);
3391       return Qt;
3392     }
3393   else
3394     return Qnil;
3395 #else
3396   return Qnil;
3397 #endif
3398 }
3399
3400 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3401 Mount database file on char-attribute-table ATTRIBUTE.
3402 */
3403        (attribute))
3404 {
3405 #ifdef HAVE_DATABASE
3406   Lisp_Object table = Fgethash (attribute,
3407                                 Vchar_attribute_hash_table, Qunbound);
3408
3409   if (UNBOUNDP (table))
3410     {
3411       Lisp_Char_Table *ct;
3412
3413       table = make_char_id_table (Qunbound);
3414       Fputhash (attribute, table, Vchar_attribute_hash_table);
3415       XCHAR_TABLE_NAME(table) = attribute;
3416       ct = XCHAR_TABLE (table);
3417       ct->table = Qunloaded;
3418       XCHAR_TABLE_UNLOADED(table) = 1;
3419       ct->db = Qnil;
3420       return Qt;
3421     }
3422 #endif
3423   return Qnil;
3424 }
3425
3426 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3427 Close database of ATTRIBUTE.
3428 */
3429        (attribute))
3430 {
3431 #ifdef HAVE_DATABASE
3432   Lisp_Object table = Fgethash (attribute,
3433                                 Vchar_attribute_hash_table, Qunbound);
3434   Lisp_Char_Table *ct;
3435
3436   if (CHAR_TABLEP (table))
3437     ct = XCHAR_TABLE (table);
3438   else
3439     return Qnil;
3440
3441   if (!NILP (ct->db))
3442     {
3443       if (!NILP (Fdatabase_live_p (ct->db)))
3444         Fclose_database (ct->db);
3445       ct->db = Qnil;
3446     }
3447 #endif
3448   return Qnil;
3449 }
3450
3451 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3452 Reset values of ATTRIBUTE with database file.
3453 */
3454        (attribute))
3455 {
3456 #ifdef HAVE_DATABASE
3457   Lisp_Object table = Fgethash (attribute,
3458                                 Vchar_attribute_hash_table, Qunbound);
3459   Lisp_Char_Table *ct;
3460   Lisp_Object db_file
3461     = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3462
3463   if (!NILP (Ffile_exists_p (db_file)))
3464     {
3465       if (UNBOUNDP (table))
3466         {
3467           table = make_char_id_table (Qunbound);
3468           Fputhash (attribute, table, Vchar_attribute_hash_table);
3469           XCHAR_TABLE_NAME(table) = attribute;
3470         }
3471       ct = XCHAR_TABLE (table);
3472       ct->table = Qunloaded;
3473       if (!NILP (Fdatabase_live_p (ct->db)))
3474         Fclose_database (ct->db);
3475       ct->db = Qnil;
3476       XCHAR_TABLE_UNLOADED(table) = 1;
3477       return Qt;
3478     }
3479 #endif
3480   return Qnil;
3481 }
3482
3483 #ifdef HAVE_DATABASE
3484 Lisp_Object
3485 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
3486 {
3487   Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3488
3489   if (!NILP (attribute))
3490     {
3491       if (NILP (Fdatabase_live_p (cit->db)))
3492         {
3493           Lisp_Object db_file
3494             = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3495
3496           cit->db = Fopen_database (db_file, Qnil, Qnil, build_string ("r"), Qnil);
3497         }
3498       if (!NILP (cit->db))
3499         {
3500           Lisp_Object val
3501             = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3502                              cit->db, Qunbound);
3503           if (!UNBOUNDP (val))
3504             val = Fread (val);
3505           else
3506             val = Qunbound;
3507           return val;
3508         }
3509     }
3510   return Qunbound;
3511 }
3512
3513 Lisp_Char_Table* char_attribute_table_to_load;
3514
3515 Lisp_Object Qload_char_attribute_table_map_function;
3516
3517 DEFUN ("load-char-attribute-table-map-function",
3518        Fload_char_attribute_table_map_function, 2, 2, 0, /*
3519 For internal use.  Don't use it.
3520 */
3521        (key, value))
3522 {
3523   Lisp_Object c = Fread (key);
3524   Emchar code = XCHAR (c);
3525   Lisp_Object ret = get_char_id_table (char_attribute_table_to_load, code);
3526
3527   if (EQ (ret, Qunloaded))
3528     put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
3529   return Qnil;
3530 }
3531 #endif
3532
3533 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
3534 Load values of ATTRIBUTE into database file.
3535 */
3536        (attribute))
3537 {
3538 #ifdef HAVE_DATABASE
3539   Lisp_Object table = Fgethash (attribute,
3540                                 Vchar_attribute_hash_table,
3541                                 Qunbound);
3542   if (CHAR_TABLEP (table))
3543     {
3544       Lisp_Char_Table *ct = XCHAR_TABLE (table);
3545
3546       if (NILP (Fdatabase_live_p (ct->db)))
3547         {
3548           Lisp_Object db_file
3549               = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3550
3551           ct->db = Fopen_database (db_file, Qnil, Qnil, build_string ("r"), Qnil);
3552         }
3553       if (!NILP (ct->db))
3554         {
3555           struct gcpro gcpro1;
3556
3557           char_attribute_table_to_load = XCHAR_TABLE (table);
3558           GCPRO1 (table);
3559           Fmap_database (Qload_char_attribute_table_map_function, ct->db);
3560           UNGCPRO;
3561           Fclose_database (ct->db);
3562           ct->db = Qnil;
3563           XCHAR_TABLE_UNLOADED(table) = 0;
3564           return Qt;
3565         }
3566     }
3567   return Qnil;
3568 #endif
3569 }
3570
3571 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3572 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3573 each key and value in the table.
3574
3575 RANGE specifies a subrange to map over and is in the same format as
3576 the RANGE argument to `put-range-table'.  If omitted or t, it defaults to
3577 the entire table.
3578 */
3579        (function, attribute, range))
3580 {
3581   Lisp_Object ccs;
3582   Lisp_Char_Table *ct;
3583   struct slow_map_char_table_arg slarg;
3584   struct gcpro gcpro1, gcpro2;
3585   struct chartab_range rainj;
3586
3587   if (!NILP (ccs = Ffind_charset (attribute)))
3588     {
3589       Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3590
3591       if (CHAR_TABLEP (encoding_table))
3592         ct = XCHAR_TABLE (encoding_table);
3593       else
3594         return Qnil;
3595     }
3596   else
3597     {
3598       Lisp_Object table = Fgethash (attribute,
3599                                     Vchar_attribute_hash_table,
3600                                     Qunbound);
3601       if (CHAR_TABLEP (table))
3602         ct = XCHAR_TABLE (table);
3603       else
3604         return Qnil;
3605     }
3606   if (NILP (range))
3607     range = Qt;
3608   decode_char_table_range (range, &rainj);
3609 #ifdef HAVE_DATABASE
3610   if (CHAR_TABLE_UNLOADED(ct))
3611     Fload_char_attribute_table (attribute);
3612 #endif
3613   slarg.function = function;
3614   slarg.retval = Qnil;
3615   GCPRO2 (slarg.function, slarg.retval);
3616   map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3617   UNGCPRO;
3618
3619   return slarg.retval;
3620 }
3621
3622 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3623 Store character's ATTRIBUTES.
3624 */
3625        (attributes))
3626 {
3627   Lisp_Object rest = attributes;
3628   Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
3629   Lisp_Object character;
3630
3631   if (NILP (code))
3632     {
3633       while (CONSP (rest))
3634         {
3635           Lisp_Object cell = Fcar (rest);
3636           Lisp_Object ccs;
3637
3638           if (!LISTP (cell))
3639             signal_simple_error ("Invalid argument", attributes);
3640           if (!NILP (ccs = Ffind_charset (Fcar (cell)))
3641               && ((XCHARSET_FINAL (ccs) != 0) ||
3642                   (XCHARSET_MAX_CODE (ccs) > 0) ||
3643                   (EQ (ccs, Vcharset_chinese_big5))) )
3644             {
3645               cell = Fcdr (cell);
3646               if (CONSP (cell))
3647                 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3648               else
3649                 character = Fdecode_char (ccs, cell, Qnil);
3650               if (!NILP (character))
3651                 goto setup_attributes;
3652             }
3653           rest = Fcdr (rest);
3654         }
3655       if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3656            (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3657
3658         {
3659           if (!INTP (code))
3660             signal_simple_error ("Invalid argument", attributes);
3661           else
3662             character = make_char (XINT (code) + 0x100000);
3663           goto setup_attributes;
3664         }
3665       return Qnil;
3666     }
3667   else if (!INTP (code))
3668     signal_simple_error ("Invalid argument", attributes);
3669   else
3670     character = make_char (XINT (code));
3671
3672  setup_attributes:
3673   rest = attributes;
3674   while (CONSP (rest))
3675     {
3676       Lisp_Object cell = Fcar (rest);
3677
3678       if (!LISTP (cell))
3679         signal_simple_error ("Invalid argument", attributes);
3680
3681       Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3682       rest = Fcdr (rest);
3683     }
3684   return character;
3685 }
3686
3687 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3688 Retrieve the character of the given ATTRIBUTES.
3689 */
3690        (attributes))
3691 {
3692   Lisp_Object rest = attributes;
3693   Lisp_Object code;
3694
3695   while (CONSP (rest))
3696     {
3697       Lisp_Object cell = Fcar (rest);
3698       Lisp_Object ccs;
3699
3700       if (!LISTP (cell))
3701         signal_simple_error ("Invalid argument", attributes);
3702       if (!NILP (ccs = Ffind_charset (Fcar (cell))))
3703         {
3704           cell = Fcdr (cell);
3705           if (CONSP (cell))
3706             return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3707           else
3708             return Fdecode_char (ccs, cell, Qnil);
3709         }
3710       rest = Fcdr (rest);
3711     }
3712   if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3713        (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3714     {
3715       if (!INTP (code))
3716         signal_simple_error ("Invalid argument", attributes);
3717       else
3718         return make_char (XINT (code) + 0x100000);
3719     }
3720   return Qnil;
3721 }
3722
3723 #endif
3724
3725 \f
3726 /************************************************************************/
3727 /*                         Char table read syntax                       */
3728 /************************************************************************/
3729
3730 static int
3731 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
3732                        Error_behavior errb)
3733 {
3734   /* #### should deal with ERRB */
3735   symbol_to_char_table_type (value);
3736   return 1;
3737 }
3738
3739 static int
3740 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
3741                        Error_behavior errb)
3742 {
3743   Lisp_Object rest;
3744
3745   /* #### should deal with ERRB */
3746   EXTERNAL_LIST_LOOP (rest, value)
3747     {
3748       Lisp_Object range = XCAR (rest);
3749       struct chartab_range dummy;
3750
3751       rest = XCDR (rest);
3752       if (!CONSP (rest))
3753         signal_simple_error ("Invalid list format", value);
3754       if (CONSP (range))
3755         {
3756           if (!CONSP (XCDR (range))
3757               || !NILP (XCDR (XCDR (range))))
3758             signal_simple_error ("Invalid range format", range);
3759           decode_char_table_range (XCAR (range), &dummy);
3760           decode_char_table_range (XCAR (XCDR (range)), &dummy);
3761         }
3762       else
3763         decode_char_table_range (range, &dummy);
3764     }
3765
3766   return 1;
3767 }
3768
3769 static Lisp_Object
3770 chartab_instantiate (Lisp_Object data)
3771 {
3772   Lisp_Object chartab;
3773   Lisp_Object type = Qgeneric;
3774   Lisp_Object dataval = Qnil;
3775
3776   while (!NILP (data))
3777     {
3778       Lisp_Object keyw = Fcar (data);
3779       Lisp_Object valw;
3780
3781       data = Fcdr (data);
3782       valw = Fcar (data);
3783       data = Fcdr (data);
3784       if (EQ (keyw, Qtype))
3785         type = valw;
3786       else if (EQ (keyw, Qdata))
3787         dataval = valw;
3788     }
3789
3790   chartab = Fmake_char_table (type);
3791
3792   data = dataval;
3793   while (!NILP (data))
3794     {
3795       Lisp_Object range = Fcar (data);
3796       Lisp_Object val = Fcar (Fcdr (data));
3797
3798       data = Fcdr (Fcdr (data));
3799       if (CONSP (range))
3800         {
3801           if (CHAR_OR_CHAR_INTP (XCAR (range)))
3802             {
3803               Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3804               Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3805               Emchar i;
3806
3807               for (i = first; i <= last; i++)
3808                  Fput_char_table (make_char (i), val, chartab);
3809             }
3810           else
3811             abort ();
3812         }
3813       else
3814         Fput_char_table (range, val, chartab);
3815     }
3816
3817   return chartab;
3818 }
3819
3820 #ifdef MULE
3821
3822 \f
3823 /************************************************************************/
3824 /*                     Category Tables, specifically                    */
3825 /************************************************************************/
3826
3827 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
3828 Return t if OBJECT is a category table.
3829 A category table is a type of char table used for keeping track of
3830 categories.  Categories are used for classifying characters for use
3831 in regexps -- you can refer to a category rather than having to use
3832 a complicated [] expression (and category lookups are significantly
3833 faster).
3834
3835 There are 95 different categories available, one for each printable
3836 character (including space) in the ASCII charset.  Each category
3837 is designated by one such character, called a "category designator".
3838 They are specified in a regexp using the syntax "\\cX", where X is
3839 a category designator.
3840
3841 A category table specifies, for each character, the categories that
3842 the character is in.  Note that a character can be in more than one
3843 category.  More specifically, a category table maps from a character
3844 to either the value nil (meaning the character is in no categories)
3845 or a 95-element bit vector, specifying for each of the 95 categories
3846 whether the character is in that category.
3847
3848 Special Lisp functions are provided that abstract this, so you do not
3849 have to directly manipulate bit vectors.
3850 */
3851        (object))
3852 {
3853   return (CHAR_TABLEP (object) &&
3854           XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
3855     Qt : Qnil;
3856 }
3857
3858 static Lisp_Object
3859 check_category_table (Lisp_Object object, Lisp_Object default_)
3860 {
3861   if (NILP (object))
3862     object = default_;
3863   while (NILP (Fcategory_table_p (object)))
3864     object = wrong_type_argument (Qcategory_table_p, object);
3865   return object;
3866 }
3867
3868 int
3869 check_category_char (Emchar ch, Lisp_Object table,
3870                      unsigned int designator, unsigned int not_p)
3871 {
3872   REGISTER Lisp_Object temp;
3873   Lisp_Char_Table *ctbl;
3874 #ifdef ERROR_CHECK_TYPECHECK
3875   if (NILP (Fcategory_table_p (table)))
3876     signal_simple_error ("Expected category table", table);
3877 #endif
3878   ctbl = XCHAR_TABLE (table);
3879   temp = get_char_table (ch, ctbl);
3880   if (NILP (temp))
3881     return not_p;
3882
3883   designator -= ' ';
3884   return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
3885 }
3886
3887 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
3888 Return t if category of the character at POSITION includes DESIGNATOR.
3889 Optional third arg BUFFER specifies which buffer to use, and defaults
3890 to the current buffer.
3891 Optional fourth arg CATEGORY-TABLE specifies the category table to
3892 use, and defaults to BUFFER's category table.
3893 */
3894        (position, designator, buffer, category_table))
3895 {
3896   Lisp_Object ctbl;
3897   Emchar ch;
3898   unsigned int des;
3899   struct buffer *buf = decode_buffer (buffer, 0);
3900
3901   CHECK_INT (position);
3902   CHECK_CATEGORY_DESIGNATOR (designator);
3903   des = XCHAR (designator);
3904   ctbl = check_category_table (category_table, Vstandard_category_table);
3905   ch = BUF_FETCH_CHAR (buf, XINT (position));
3906   return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3907 }
3908
3909 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
3910 Return t if category of CHARACTER includes DESIGNATOR, else nil.
3911 Optional third arg CATEGORY-TABLE specifies the category table to use,
3912 and defaults to the standard category table.
3913 */
3914        (character, designator, category_table))
3915 {
3916   Lisp_Object ctbl;
3917   Emchar ch;
3918   unsigned int des;
3919
3920   CHECK_CATEGORY_DESIGNATOR (designator);
3921   des = XCHAR (designator);
3922   CHECK_CHAR (character);
3923   ch = XCHAR (character);
3924   ctbl = check_category_table (category_table, Vstandard_category_table);
3925   return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3926 }
3927
3928 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
3929 Return BUFFER's current category table.
3930 BUFFER defaults to the current buffer.
3931 */
3932        (buffer))
3933 {
3934   return decode_buffer (buffer, 0)->category_table;
3935 }
3936
3937 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3938 Return the standard category table.
3939 This is the one used for new buffers.
3940 */
3941        ())
3942 {
3943   return Vstandard_category_table;
3944 }
3945
3946 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
3947 Return a new category table which is a copy of CATEGORY-TABLE.
3948 CATEGORY-TABLE defaults to the standard category table.
3949 */
3950        (category_table))
3951 {
3952   if (NILP (Vstandard_category_table))
3953     return Fmake_char_table (Qcategory);
3954
3955   category_table =
3956     check_category_table (category_table, Vstandard_category_table);
3957   return Fcopy_char_table (category_table);
3958 }
3959
3960 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
3961 Select CATEGORY-TABLE as the new category table for BUFFER.
3962 BUFFER defaults to the current buffer if omitted.
3963 */
3964        (category_table, buffer))
3965 {
3966   struct buffer *buf = decode_buffer (buffer, 0);
3967   category_table = check_category_table (category_table, Qnil);
3968   buf->category_table = category_table;
3969   /* Indicate that this buffer now has a specified category table.  */
3970   buf->local_var_flags |= XINT (buffer_local_flags.category_table);
3971   return category_table;
3972 }
3973
3974 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
3975 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
3976 */
3977        (object))
3978 {
3979   return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
3980 }
3981
3982 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
3983 Return t if OBJECT is a category table value.
3984 Valid values are nil or a bit vector of size 95.
3985 */
3986        (object))
3987 {
3988   return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
3989 }
3990
3991
3992 #define CATEGORYP(x) \
3993   (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3994
3995 #define CATEGORY_SET(c)                                         \
3996   (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
3997
3998 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3999    The faster version of `!NILP (Faref (category_set, category))'.  */
4000 #define CATEGORY_MEMBER(category, category_set)                 \
4001   (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4002
4003 /* Return 1 if there is a word boundary between two word-constituent
4004    characters C1 and C2 if they appear in this order, else return 0.
4005    Use the macro WORD_BOUNDARY_P instead of calling this function
4006    directly.  */
4007
4008 int word_boundary_p (Emchar c1, Emchar c2);
4009 int
4010 word_boundary_p (Emchar c1, Emchar c2)
4011 {
4012   Lisp_Object category_set1, category_set2;
4013   Lisp_Object tail;
4014   int default_result;
4015
4016 #if 0
4017   if (COMPOSITE_CHAR_P (c1))
4018     c1 = cmpchar_component (c1, 0, 1);
4019   if (COMPOSITE_CHAR_P (c2))
4020     c2 = cmpchar_component (c2, 0, 1);
4021 #endif
4022
4023   if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4024     {
4025       tail = Vword_separating_categories;
4026       default_result = 0;
4027     }
4028   else
4029     {
4030       tail = Vword_combining_categories;
4031       default_result = 1;
4032     }
4033
4034   category_set1 = CATEGORY_SET (c1);
4035   if (NILP (category_set1))
4036     return default_result;
4037   category_set2 = CATEGORY_SET (c2);
4038   if (NILP (category_set2))
4039     return default_result;
4040
4041   for (; CONSP (tail); tail = XCONS (tail)->cdr)
4042     {
4043       Lisp_Object elt = XCONS(tail)->car;
4044
4045       if (CONSP (elt)
4046           && CATEGORYP (XCONS (elt)->car)
4047           && CATEGORYP (XCONS (elt)->cdr)
4048           && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4049           && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4050         return !default_result;
4051     }
4052   return default_result;
4053 }
4054 #endif /* MULE */
4055
4056 \f
4057 void
4058 syms_of_chartab (void)
4059 {
4060 #ifdef UTF2000
4061   INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4062   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4063   INIT_LRECORD_IMPLEMENTATION (byte_table);
4064
4065   defsymbol (&Qsystem_char_id,          "system-char-id");
4066
4067   defsymbol (&Qto_ucs,                  "=>ucs");
4068   defsymbol (&Q_ucs,                    "->ucs");
4069   defsymbol (&Q_ucs_variants,           "->ucs-variants");
4070   defsymbol (&Q_decomposition,          "->decomposition");
4071   defsymbol (&Qcompat,                  "compat");
4072   defsymbol (&Qisolated,                "isolated");
4073   defsymbol (&Qinitial,                 "initial");
4074   defsymbol (&Qmedial,                  "medial");
4075   defsymbol (&Qfinal,                   "final");
4076   defsymbol (&Qvertical,                "vertical");
4077   defsymbol (&QnoBreak,                 "noBreak");
4078   defsymbol (&Qfraction,                "fraction");
4079   defsymbol (&Qsuper,                   "super");
4080   defsymbol (&Qsub,                     "sub");
4081   defsymbol (&Qcircle,                  "circle");
4082   defsymbol (&Qsquare,                  "square");
4083   defsymbol (&Qwide,                    "wide");
4084   defsymbol (&Qnarrow,                  "narrow");
4085   defsymbol (&Qsmall,                   "small");
4086   defsymbol (&Qfont,                    "font");
4087
4088   DEFSUBR (Fchar_attribute_list);
4089   DEFSUBR (Ffind_char_attribute_table);
4090   defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4091   DEFSUBR (Fput_char_table_map_function);
4092   DEFSUBR (Fsave_char_attribute_table);
4093   DEFSUBR (Fmount_char_attribute_table);
4094   DEFSUBR (Freset_char_attribute_table);
4095   DEFSUBR (Fclose_char_attribute_table);
4096 #ifdef HAVE_DATABASE
4097   defsymbol (&Qload_char_attribute_table_map_function,
4098              "load-char-attribute-table-map-function");
4099   DEFSUBR (Fload_char_attribute_table_map_function);
4100 #endif
4101   DEFSUBR (Fload_char_attribute_table);
4102   DEFSUBR (Fchar_attribute_alist);
4103   DEFSUBR (Fget_char_attribute);
4104   DEFSUBR (Fput_char_attribute);
4105   DEFSUBR (Fremove_char_attribute);
4106   DEFSUBR (Fmap_char_attribute);
4107   DEFSUBR (Fdefine_char);
4108   DEFSUBR (Ffind_char);
4109   DEFSUBR (Fchar_variants);
4110
4111   DEFSUBR (Fget_composite_char);
4112 #endif
4113
4114   INIT_LRECORD_IMPLEMENTATION (char_table);
4115
4116 #ifdef MULE
4117 #ifndef UTF2000
4118   INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4119 #endif
4120
4121   defsymbol (&Qcategory_table_p, "category-table-p");
4122   defsymbol (&Qcategory_designator_p, "category-designator-p");
4123   defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4124 #endif /* MULE */
4125
4126   defsymbol (&Qchar_table, "char-table");
4127   defsymbol (&Qchar_tablep, "char-table-p");
4128
4129   DEFSUBR (Fchar_table_p);
4130   DEFSUBR (Fchar_table_type_list);
4131   DEFSUBR (Fvalid_char_table_type_p);
4132   DEFSUBR (Fchar_table_type);
4133   DEFSUBR (Freset_char_table);
4134   DEFSUBR (Fmake_char_table);
4135   DEFSUBR (Fcopy_char_table);
4136   DEFSUBR (Fget_char_table);
4137   DEFSUBR (Fget_range_char_table);
4138   DEFSUBR (Fvalid_char_table_value_p);
4139   DEFSUBR (Fcheck_valid_char_table_value);
4140   DEFSUBR (Fput_char_table);
4141   DEFSUBR (Fmap_char_table);
4142
4143 #ifdef MULE
4144   DEFSUBR (Fcategory_table_p);
4145   DEFSUBR (Fcategory_table);
4146   DEFSUBR (Fstandard_category_table);
4147   DEFSUBR (Fcopy_category_table);
4148   DEFSUBR (Fset_category_table);
4149   DEFSUBR (Fcheck_category_at);
4150   DEFSUBR (Fchar_in_category_p);
4151   DEFSUBR (Fcategory_designator_p);
4152   DEFSUBR (Fcategory_table_value_p);
4153 #endif /* MULE */
4154
4155 }
4156
4157 void
4158 vars_of_chartab (void)
4159 {
4160 #ifdef UTF2000
4161   staticpro (&Vcharacter_composition_table);
4162   Vcharacter_composition_table = make_char_id_table (Qnil);
4163
4164   staticpro (&Vcharacter_variant_table);
4165   Vcharacter_variant_table = make_char_id_table (Qunbound);
4166 #endif
4167   /* DO NOT staticpro this.  It works just like Vweak_hash_tables. */
4168   Vall_syntax_tables = Qnil;
4169   dump_add_weak_object_chain (&Vall_syntax_tables);
4170 }
4171
4172 void
4173 structure_type_create_chartab (void)
4174 {
4175   struct structure_type *st;
4176
4177   st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4178
4179   define_structure_type_keyword (st, Qtype, chartab_type_validate);
4180   define_structure_type_keyword (st, Qdata, chartab_data_validate);
4181 }
4182
4183 void
4184 complex_vars_of_chartab (void)
4185 {
4186 #ifdef UTF2000
4187   staticpro (&Vchar_attribute_hash_table);
4188   Vchar_attribute_hash_table
4189     = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4190 #ifdef HAVE_DATABASE
4191   Fputhash (Q_ucs_variants, Vcharacter_variant_table,
4192             Vchar_attribute_hash_table);
4193   XCHAR_TABLE_NAME (Vcharacter_variant_table) = Q_ucs_variants;
4194 #endif /* HAVE_DATABASE */
4195 #endif /* UTF2000 */
4196 #ifdef MULE
4197   /* Set this now, so first buffer creation can refer to it. */
4198   /* Make it nil before calling copy-category-table
4199      so that copy-category-table will know not to try to copy from garbage */
4200   Vstandard_category_table = Qnil;
4201   Vstandard_category_table = Fcopy_category_table (Qnil);
4202   staticpro (&Vstandard_category_table);
4203
4204   DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4205 List of pair (cons) of categories to determine word boundary.
4206
4207 Emacs treats a sequence of word constituent characters as a single
4208 word (i.e. finds no word boundary between them) iff they belongs to
4209 the same charset.  But, exceptions are allowed in the following cases.
4210
4211 \(1) The case that characters are in different charsets is controlled
4212 by the variable `word-combining-categories'.
4213
4214 Emacs finds no word boundary between characters of different charsets
4215 if they have categories matching some element of this list.
4216
4217 More precisely, if an element of this list is a cons of category CAT1
4218 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4219 C2 which has CAT2, there's no word boundary between C1 and C2.
4220
4221 For instance, to tell that ASCII characters and Latin-1 characters can
4222 form a single word, the element `(?l . ?l)' should be in this list
4223 because both characters have the category `l' (Latin characters).
4224
4225 \(2) The case that character are in the same charset is controlled by
4226 the variable `word-separating-categories'.
4227
4228 Emacs find a word boundary between characters of the same charset
4229 if they have categories matching some element of this list.
4230
4231 More precisely, if an element of this list is a cons of category CAT1
4232 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4233 C2 which has CAT2, there's a word boundary between C1 and C2.
4234
4235 For instance, to tell that there's a word boundary between Japanese
4236 Hiragana and Japanese Kanji (both are in the same charset), the
4237 element `(?H . ?C) should be in this list.
4238 */ );
4239
4240   Vword_combining_categories = Qnil;
4241
4242   DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4243 List of pair (cons) of categories to determine word boundary.
4244 See the documentation of the variable `word-combining-categories'.
4245 */ );
4246
4247   Vword_separating_categories = Qnil;
4248 #endif /* MULE */
4249 }