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