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 #else
1274   int i;
1275
1276   for (i = 0; i < NUM_ASCII_CHARS; i++)
1277     mark_object (ct->ascii[i]);
1278 #ifdef MULE
1279   for (i = 0; i < NUM_LEADING_BYTES; i++)
1280     mark_object (ct->level1[i]);
1281 #endif
1282 #endif
1283 #ifdef UTF2000
1284   return ct->default_value;
1285 #else
1286   return ct->mirror_table;
1287 #endif
1288 }
1289
1290 /* WARNING: All functions of this nature need to be written extremely
1291    carefully to avoid crashes during GC.  Cf. prune_specifiers()
1292    and prune_weak_hash_tables(). */
1293
1294 void
1295 prune_syntax_tables (void)
1296 {
1297   Lisp_Object rest, prev = Qnil;
1298
1299   for (rest = Vall_syntax_tables;
1300        !NILP (rest);
1301        rest = XCHAR_TABLE (rest)->next_table)
1302     {
1303       if (! marked_p (rest))
1304         {
1305           /* This table is garbage.  Remove it from the list. */
1306           if (NILP (prev))
1307             Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1308           else
1309             XCHAR_TABLE (prev)->next_table =
1310               XCHAR_TABLE (rest)->next_table;
1311         }
1312     }
1313 }
1314
1315 static Lisp_Object
1316 char_table_type_to_symbol (enum char_table_type type)
1317 {
1318   switch (type)
1319   {
1320   default: abort();
1321   case CHAR_TABLE_TYPE_GENERIC:  return Qgeneric;
1322   case CHAR_TABLE_TYPE_SYNTAX:   return Qsyntax;
1323   case CHAR_TABLE_TYPE_DISPLAY:  return Qdisplay;
1324   case CHAR_TABLE_TYPE_CHAR:     return Qchar;
1325 #ifdef MULE
1326   case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1327 #endif
1328   }
1329 }
1330
1331 static enum char_table_type
1332 symbol_to_char_table_type (Lisp_Object symbol)
1333 {
1334   CHECK_SYMBOL (symbol);
1335
1336   if (EQ (symbol, Qgeneric))  return CHAR_TABLE_TYPE_GENERIC;
1337   if (EQ (symbol, Qsyntax))   return CHAR_TABLE_TYPE_SYNTAX;
1338   if (EQ (symbol, Qdisplay))  return CHAR_TABLE_TYPE_DISPLAY;
1339   if (EQ (symbol, Qchar))     return CHAR_TABLE_TYPE_CHAR;
1340 #ifdef MULE
1341   if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1342 #endif
1343
1344   signal_simple_error ("Unrecognized char table type", symbol);
1345   return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1346 }
1347
1348 static void
1349 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1350                      Lisp_Object printcharfun)
1351 {
1352   if (first != last)
1353     {
1354       write_c_string (" (", printcharfun);
1355       print_internal (make_char (first), printcharfun, 0);
1356       write_c_string (" ", printcharfun);
1357       print_internal (make_char (last), printcharfun, 0);
1358       write_c_string (") ", printcharfun);
1359     }
1360   else
1361     {
1362       write_c_string (" ", printcharfun);
1363       print_internal (make_char (first), printcharfun, 0);
1364       write_c_string (" ", printcharfun);
1365     }
1366   print_internal (val, printcharfun, 1);
1367 }
1368
1369 #if defined(MULE)&&!defined(UTF2000)
1370
1371 static void
1372 print_chartab_charset_row (Lisp_Object charset,
1373                            int row,
1374                            Lisp_Char_Table_Entry *cte,
1375                            Lisp_Object printcharfun)
1376 {
1377   int i;
1378   Lisp_Object cat = Qunbound;
1379   int first = -1;
1380
1381   for (i = 32; i < 128; i++)
1382     {
1383       Lisp_Object pam = cte->level2[i - 32];
1384
1385       if (first == -1)
1386         {
1387           first = i;
1388           cat = pam;
1389           continue;
1390         }
1391
1392       if (!EQ (cat, pam))
1393         {
1394           if (row == -1)
1395             print_chartab_range (MAKE_CHAR (charset, first, 0),
1396                                  MAKE_CHAR (charset, i - 1, 0),
1397                                  cat, printcharfun);
1398           else
1399             print_chartab_range (MAKE_CHAR (charset, row, first),
1400                                  MAKE_CHAR (charset, row, i - 1),
1401                                  cat, printcharfun);
1402           first = -1;
1403           i--;
1404         }
1405     }
1406
1407   if (first != -1)
1408     {
1409       if (row == -1)
1410         print_chartab_range (MAKE_CHAR (charset, first, 0),
1411                              MAKE_CHAR (charset, i - 1, 0),
1412                              cat, printcharfun);
1413       else
1414         print_chartab_range (MAKE_CHAR (charset, row, first),
1415                              MAKE_CHAR (charset, row, i - 1),
1416                              cat, printcharfun);
1417     }
1418 }
1419
1420 static void
1421 print_chartab_two_byte_charset (Lisp_Object charset,
1422                                 Lisp_Char_Table_Entry *cte,
1423                                 Lisp_Object printcharfun)
1424 {
1425   int i;
1426
1427   for (i = 32; i < 128; i++)
1428     {
1429       Lisp_Object jen = cte->level2[i - 32];
1430
1431       if (!CHAR_TABLE_ENTRYP (jen))
1432         {
1433           char buf[100];
1434
1435           write_c_string (" [", printcharfun);
1436           print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1437           sprintf (buf, " %d] ", i);
1438           write_c_string (buf, printcharfun);
1439           print_internal (jen, printcharfun, 0);
1440         }
1441       else
1442         print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1443                                    printcharfun);
1444     }
1445 }
1446
1447 #endif /* MULE */
1448
1449 static void
1450 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1451 {
1452   Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1453 #ifdef UTF2000
1454   int i;
1455   struct gcpro gcpro1, gcpro2;
1456   GCPRO2 (obj, printcharfun);
1457
1458   write_c_string ("#s(char-table ", printcharfun);
1459   write_c_string (" ", printcharfun);
1460   write_c_string (string_data
1461                   (symbol_name
1462                    (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1463                   printcharfun);
1464   write_c_string ("\n ", printcharfun);
1465   print_internal (ct->default_value, printcharfun, escapeflag);
1466   for (i = 0; i < 256; i++)
1467     {
1468       Lisp_Object elt = get_byte_table (ct->table, i);
1469       if (i != 0) write_c_string ("\n  ", printcharfun);
1470       if (EQ (elt, Qunbound))
1471         write_c_string ("void", printcharfun);
1472       else
1473         print_internal (elt, printcharfun, escapeflag);
1474     }
1475   UNGCPRO;
1476 #else /* non UTF2000 */
1477   char buf[200];
1478
1479   sprintf (buf, "#s(char-table type %s data (",
1480            string_data (symbol_name (XSYMBOL
1481                                      (char_table_type_to_symbol (ct->type)))));
1482   write_c_string (buf, printcharfun);
1483
1484   /* Now write out the ASCII/Control-1 stuff. */
1485   {
1486     int i;
1487     int first = -1;
1488     Lisp_Object val = Qunbound;
1489
1490     for (i = 0; i < NUM_ASCII_CHARS; i++)
1491       {
1492         if (first == -1)
1493           {
1494             first = i;
1495             val = ct->ascii[i];
1496             continue;
1497           }
1498
1499         if (!EQ (ct->ascii[i], val))
1500           {
1501             print_chartab_range (first, i - 1, val, printcharfun);
1502             first = -1;
1503             i--;
1504           }
1505       }
1506
1507     if (first != -1)
1508       print_chartab_range (first, i - 1, val, printcharfun);
1509   }
1510
1511 #ifdef MULE
1512   {
1513     Charset_ID i;
1514
1515     for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1516          i++)
1517       {
1518         Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1519         Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1520
1521         if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1522             || i == LEADING_BYTE_CONTROL_1)
1523           continue;
1524         if (!CHAR_TABLE_ENTRYP (ann))
1525           {
1526             write_c_string (" ", printcharfun);
1527             print_internal (XCHARSET_NAME (charset),
1528                             printcharfun, 0);
1529             write_c_string (" ", printcharfun);
1530             print_internal (ann, printcharfun, 0);
1531           }
1532         else
1533           {
1534             Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1535             if (XCHARSET_DIMENSION (charset) == 1)
1536               print_chartab_charset_row (charset, -1, cte, printcharfun);
1537             else
1538               print_chartab_two_byte_charset (charset, cte, printcharfun);
1539           }
1540       }
1541   }
1542 #endif /* MULE */
1543 #endif /* non UTF2000 */
1544
1545   write_c_string ("))", printcharfun);
1546 }
1547
1548 static int
1549 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1550 {
1551   Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1552   Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1553   int i;
1554
1555   if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1556     return 0;
1557
1558 #ifdef UTF2000
1559   for (i = 0; i < 256; i++)
1560     {
1561       if (!internal_equal (get_byte_table (ct1->table, i),
1562                            get_byte_table (ct2->table, i), 0))
1563         return 0;
1564     }
1565 #else
1566   for (i = 0; i < NUM_ASCII_CHARS; i++)
1567     if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1568       return 0;
1569
1570 #ifdef MULE
1571   for (i = 0; i < NUM_LEADING_BYTES; i++)
1572     if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1573       return 0;
1574 #endif /* MULE */
1575 #endif /* non UTF2000 */
1576
1577   return 1;
1578 }
1579
1580 static unsigned long
1581 char_table_hash (Lisp_Object obj, int depth)
1582 {
1583   Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1584 #ifdef UTF2000
1585     return byte_table_hash (ct->table, depth + 1);
1586 #else
1587   unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1588                                                depth);
1589 #ifdef MULE
1590   hashval = HASH2 (hashval,
1591                    internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1592 #endif /* MULE */
1593   return hashval;
1594 #endif
1595 }
1596
1597 static const struct lrecord_description char_table_description[] = {
1598 #ifdef UTF2000
1599   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1600   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1601   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1602 #else
1603   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1604 #ifdef MULE
1605   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1606 #endif
1607 #endif
1608 #ifndef UTF2000
1609   { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1610 #endif
1611   { XD_LO_LINK,     offsetof (Lisp_Char_Table, next_table) },
1612   { XD_END }
1613 };
1614
1615 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1616                                mark_char_table, print_char_table, 0,
1617                                char_table_equal, char_table_hash,
1618                                char_table_description,
1619                                Lisp_Char_Table);
1620
1621 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1622 Return non-nil if OBJECT is a char table.
1623
1624 A char table is a table that maps characters (or ranges of characters)
1625 to values.  Char tables are specialized for characters, only allowing
1626 particular sorts of ranges to be assigned values.  Although this
1627 loses in generality, it makes for extremely fast (constant-time)
1628 lookups, and thus is feasible for applications that do an extremely
1629 large number of lookups (e.g. scanning a buffer for a character in
1630 a particular syntax, where a lookup in the syntax table must occur
1631 once per character).
1632
1633 When Mule support exists, the types of ranges that can be assigned
1634 values are
1635
1636 -- all characters
1637 -- an entire charset
1638 -- a single row in a two-octet charset
1639 -- a single character
1640
1641 When Mule support is not present, the types of ranges that can be
1642 assigned values are
1643
1644 -- all characters
1645 -- a single character
1646
1647 To create a char table, use `make-char-table'.
1648 To modify a char table, use `put-char-table' or `remove-char-table'.
1649 To retrieve the value for a particular character, use `get-char-table'.
1650 See also `map-char-table', `clear-char-table', `copy-char-table',
1651 `valid-char-table-type-p', `char-table-type-list',
1652 `valid-char-table-value-p', and `check-char-table-value'.
1653 */
1654        (object))
1655 {
1656   return CHAR_TABLEP (object) ? Qt : Qnil;
1657 }
1658
1659 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1660 Return a list of the recognized char table types.
1661 See `valid-char-table-type-p'.
1662 */
1663        ())
1664 {
1665 #ifdef MULE
1666   return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1667 #else
1668   return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1669 #endif
1670 }
1671
1672 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1673 Return t if TYPE if a recognized char table type.
1674
1675 Each char table type is used for a different purpose and allows different
1676 sorts of values.  The different char table types are
1677
1678 `category'
1679         Used for category tables, which specify the regexp categories
1680         that a character is in.  The valid values are nil or a
1681         bit vector of 95 elements.  Higher-level Lisp functions are
1682         provided for working with category tables.  Currently categories
1683         and category tables only exist when Mule support is present.
1684 `char'
1685         A generalized char table, for mapping from one character to
1686         another.  Used for case tables, syntax matching tables,
1687         `keyboard-translate-table', etc.  The valid values are characters.
1688 `generic'
1689         An even more generalized char table, for mapping from a
1690         character to anything.
1691 `display'
1692         Used for display tables, which specify how a particular character
1693         is to appear when displayed.  #### Not yet implemented.
1694 `syntax'
1695         Used for syntax tables, which specify the syntax of a particular
1696         character.  Higher-level Lisp functions are provided for
1697         working with syntax tables.  The valid values are integers.
1698
1699 */
1700        (type))
1701 {
1702   return (EQ (type, Qchar)     ||
1703 #ifdef MULE
1704           EQ (type, Qcategory) ||
1705 #endif
1706           EQ (type, Qdisplay)  ||
1707           EQ (type, Qgeneric)  ||
1708           EQ (type, Qsyntax)) ? Qt : Qnil;
1709 }
1710
1711 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1712 Return the type of CHAR-TABLE.
1713 See `valid-char-table-type-p'.
1714 */
1715        (char_table))
1716 {
1717   CHECK_CHAR_TABLE (char_table);
1718   return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1719 }
1720
1721 void
1722 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1723 {
1724 #ifdef UTF2000
1725   ct->table = Qunbound;
1726   ct->default_value = value;
1727   ct->unloaded = 0;
1728 #else
1729   int i;
1730
1731   for (i = 0; i < NUM_ASCII_CHARS; i++)
1732     ct->ascii[i] = value;
1733 #ifdef MULE
1734   for (i = 0; i < NUM_LEADING_BYTES; i++)
1735     ct->level1[i] = value;
1736 #endif /* MULE */
1737 #endif
1738
1739 #ifndef UTF2000
1740   if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1741     update_syntax_table (ct);
1742 #endif
1743 }
1744
1745 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1746 Reset CHAR-TABLE to its default state.
1747 */
1748        (char_table))
1749 {
1750   Lisp_Char_Table *ct;
1751
1752   CHECK_CHAR_TABLE (char_table);
1753   ct = XCHAR_TABLE (char_table);
1754
1755   switch (ct->type)
1756     {
1757     case CHAR_TABLE_TYPE_CHAR:
1758       fill_char_table (ct, make_char (0));
1759       break;
1760     case CHAR_TABLE_TYPE_DISPLAY:
1761     case CHAR_TABLE_TYPE_GENERIC:
1762 #ifdef MULE
1763     case CHAR_TABLE_TYPE_CATEGORY:
1764 #endif /* MULE */
1765       fill_char_table (ct, Qnil);
1766       break;
1767
1768     case CHAR_TABLE_TYPE_SYNTAX:
1769       fill_char_table (ct, make_int (Sinherit));
1770       break;
1771
1772     default:
1773       abort ();
1774     }
1775
1776   return Qnil;
1777 }
1778
1779 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1780 Return a new, empty char table of type TYPE.
1781 Currently recognized types are 'char, 'category, 'display, 'generic,
1782 and 'syntax.  See `valid-char-table-type-p'.
1783 */
1784        (type))
1785 {
1786   Lisp_Char_Table *ct;
1787   Lisp_Object obj;
1788   enum char_table_type ty = symbol_to_char_table_type (type);
1789
1790   ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1791   ct->type = ty;
1792 #ifndef UTF2000
1793   if (ty == CHAR_TABLE_TYPE_SYNTAX)
1794     {
1795       ct->mirror_table = Fmake_char_table (Qgeneric);
1796       fill_char_table (XCHAR_TABLE (ct->mirror_table),
1797                        make_int (Spunct));
1798     }
1799   else
1800     ct->mirror_table = Qnil;
1801 #else
1802   ct->name = Qnil;
1803 #endif
1804   ct->next_table = Qnil;
1805   XSETCHAR_TABLE (obj, ct);
1806   if (ty == CHAR_TABLE_TYPE_SYNTAX)
1807     {
1808       ct->next_table = Vall_syntax_tables;
1809       Vall_syntax_tables = obj;
1810     }
1811   Freset_char_table (obj);
1812   return obj;
1813 }
1814
1815 #if defined(MULE)&&!defined(UTF2000)
1816
1817 static Lisp_Object
1818 make_char_table_entry (Lisp_Object initval)
1819 {
1820   Lisp_Object obj;
1821   int i;
1822   Lisp_Char_Table_Entry *cte =
1823     alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1824
1825   for (i = 0; i < 96; i++)
1826     cte->level2[i] = initval;
1827
1828   XSETCHAR_TABLE_ENTRY (obj, cte);
1829   return obj;
1830 }
1831
1832 static Lisp_Object
1833 copy_char_table_entry (Lisp_Object entry)
1834 {
1835   Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1836   Lisp_Object obj;
1837   int i;
1838   Lisp_Char_Table_Entry *ctenew =
1839     alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1840
1841   for (i = 0; i < 96; i++)
1842     {
1843       Lisp_Object new = cte->level2[i];
1844       if (CHAR_TABLE_ENTRYP (new))
1845         ctenew->level2[i] = copy_char_table_entry (new);
1846       else
1847         ctenew->level2[i] = new;
1848     }
1849
1850   XSETCHAR_TABLE_ENTRY (obj, ctenew);
1851   return obj;
1852 }
1853
1854 #endif /* MULE */
1855
1856 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1857 Return a new char table which is a copy of CHAR-TABLE.
1858 It will contain the same values for the same characters and ranges
1859 as CHAR-TABLE.  The values will not themselves be copied.
1860 */
1861        (char_table))
1862 {
1863   Lisp_Char_Table *ct, *ctnew;
1864   Lisp_Object obj;
1865 #ifndef UTF2000
1866   int i;
1867 #endif
1868
1869   CHECK_CHAR_TABLE (char_table);
1870   ct = XCHAR_TABLE (char_table);
1871   ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1872   ctnew->type = ct->type;
1873 #ifdef UTF2000
1874   ctnew->default_value = ct->default_value;
1875   /* [tomo:2002-01-21] Perhaps this code seems wrong */
1876   ctnew->name = ct->name;
1877
1878   if (UINT8_BYTE_TABLE_P (ct->table))
1879     {
1880       ctnew->table = copy_uint8_byte_table (ct->table);
1881     }
1882   else if (UINT16_BYTE_TABLE_P (ct->table))
1883     {
1884       ctnew->table = copy_uint16_byte_table (ct->table);
1885     }
1886   else if (BYTE_TABLE_P (ct->table))
1887     {
1888       ctnew->table = copy_byte_table (ct->table);
1889     }
1890   else if (!UNBOUNDP (ct->table))
1891     ctnew->table = ct->table;
1892 #else /* non UTF2000 */
1893
1894   for (i = 0; i < NUM_ASCII_CHARS; i++)
1895     {
1896       Lisp_Object new = ct->ascii[i];
1897 #ifdef MULE
1898       assert (! (CHAR_TABLE_ENTRYP (new)));
1899 #endif /* MULE */
1900       ctnew->ascii[i] = new;
1901     }
1902
1903 #ifdef MULE
1904
1905   for (i = 0; i < NUM_LEADING_BYTES; i++)
1906     {
1907       Lisp_Object new = ct->level1[i];
1908       if (CHAR_TABLE_ENTRYP (new))
1909         ctnew->level1[i] = copy_char_table_entry (new);
1910       else
1911         ctnew->level1[i] = new;
1912     }
1913
1914 #endif /* MULE */
1915 #endif /* non UTF2000 */
1916
1917 #ifndef UTF2000
1918   if (CHAR_TABLEP (ct->mirror_table))
1919     ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
1920   else
1921     ctnew->mirror_table = ct->mirror_table;
1922 #endif
1923   ctnew->next_table = Qnil;
1924   XSETCHAR_TABLE (obj, ctnew);
1925   if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
1926     {
1927       ctnew->next_table = Vall_syntax_tables;
1928       Vall_syntax_tables = obj;
1929     }
1930   return obj;
1931 }
1932
1933 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
1934 INLINE_HEADER int
1935 XCHARSET_CELL_RANGE (Lisp_Object ccs)
1936 {
1937   switch (XCHARSET_CHARS (ccs))
1938     {
1939     case 94:
1940       return (33 << 8) | 126;
1941     case 96:
1942       return (32 << 8) | 127;
1943 #ifdef UTF2000
1944     case 128:
1945       return (0 << 8) | 127;
1946     case 256:
1947       return (0 << 8) | 255;
1948 #endif
1949     default:
1950       abort ();
1951       return 0;
1952     }
1953 }
1954
1955 #ifndef UTF2000
1956 static
1957 #endif
1958 void
1959 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
1960 {
1961   if (EQ (range, Qt))
1962     outrange->type = CHARTAB_RANGE_ALL;
1963   else if (EQ (range, Qnil))
1964     outrange->type = CHARTAB_RANGE_DEFAULT;
1965   else if (CHAR_OR_CHAR_INTP (range))
1966     {
1967       outrange->type = CHARTAB_RANGE_CHAR;
1968       outrange->ch = XCHAR_OR_CHAR_INT (range);
1969     }
1970 #ifndef MULE
1971   else
1972     signal_simple_error ("Range must be t or a character", range);
1973 #else /* MULE */
1974   else if (VECTORP (range))
1975     {
1976       Lisp_Vector *vec = XVECTOR (range);
1977       Lisp_Object *elts = vector_data (vec);
1978       int cell_min, cell_max;
1979
1980       outrange->type = CHARTAB_RANGE_ROW;
1981       outrange->charset = Fget_charset (elts[0]);
1982       CHECK_INT (elts[1]);
1983       outrange->row = XINT (elts[1]);
1984       if (XCHARSET_DIMENSION (outrange->charset) < 2)
1985         signal_simple_error ("Charset in row vector must be multi-byte",
1986                              outrange->charset);
1987       else
1988         {
1989           int ret = XCHARSET_CELL_RANGE (outrange->charset);
1990
1991           cell_min = ret >> 8;
1992           cell_max = ret & 0xFF;
1993         }
1994       if (XCHARSET_DIMENSION (outrange->charset) == 2)
1995         check_int_range (outrange->row, cell_min, cell_max);
1996 #ifdef UTF2000
1997       else if (XCHARSET_DIMENSION (outrange->charset) == 3)
1998         {
1999           check_int_range (outrange->row >> 8  , cell_min, cell_max);
2000           check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2001         }
2002       else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2003         {
2004           check_int_range ( outrange->row >> 16       , cell_min, cell_max);
2005           check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2006           check_int_range ( outrange->row       & 0xFF, cell_min, cell_max);
2007         }
2008 #endif
2009       else
2010         abort ();
2011     }
2012   else
2013     {
2014       if (!CHARSETP (range) && !SYMBOLP (range))
2015         signal_simple_error
2016           ("Char table range must be t, charset, char, or vector", range);
2017       outrange->type = CHARTAB_RANGE_CHARSET;
2018       outrange->charset = Fget_charset (range);
2019     }
2020 #endif /* MULE */
2021 }
2022
2023 #if defined(MULE)&&!defined(UTF2000)
2024
2025 /* called from CHAR_TABLE_VALUE(). */
2026 Lisp_Object
2027 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2028                                Emchar c)
2029 {
2030   Lisp_Object val;
2031 #ifdef UTF2000
2032   Lisp_Object charset;
2033 #else
2034   Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2035 #endif
2036   int byte1, byte2;
2037
2038 #ifdef UTF2000
2039   BREAKUP_CHAR (c, charset, byte1, byte2);
2040 #else
2041   BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2042 #endif
2043   val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2044   if (CHAR_TABLE_ENTRYP (val))
2045     {
2046       Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2047       val = cte->level2[byte1 - 32];
2048       if (CHAR_TABLE_ENTRYP (val))
2049         {
2050           cte = XCHAR_TABLE_ENTRY (val);
2051           assert (byte2 >= 32);
2052           val = cte->level2[byte2 - 32];
2053           assert (!CHAR_TABLE_ENTRYP (val));
2054         }
2055     }
2056
2057   return val;
2058 }
2059
2060 #endif /* MULE */
2061
2062 Lisp_Object
2063 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2064 {
2065 #ifdef UTF2000
2066   return get_char_id_table (ct, ch);
2067 #elif defined(MULE)
2068   {
2069     Lisp_Object charset;
2070     int byte1, byte2;
2071     Lisp_Object val;
2072
2073     BREAKUP_CHAR (ch, charset, byte1, byte2);
2074
2075     if (EQ (charset, Vcharset_ascii))
2076       val = ct->ascii[byte1];
2077     else if (EQ (charset, Vcharset_control_1))
2078       val = ct->ascii[byte1 + 128];
2079     else
2080       {
2081         int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2082         val = ct->level1[lb];
2083         if (CHAR_TABLE_ENTRYP (val))
2084           {
2085             Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2086             val = cte->level2[byte1 - 32];
2087             if (CHAR_TABLE_ENTRYP (val))
2088               {
2089                 cte = XCHAR_TABLE_ENTRY (val);
2090                 assert (byte2 >= 32);
2091                 val = cte->level2[byte2 - 32];
2092                 assert (!CHAR_TABLE_ENTRYP (val));
2093               }
2094           }
2095       }
2096
2097     return val;
2098   }
2099 #else /* not MULE */
2100   return ct->ascii[(unsigned char)ch];
2101 #endif /* not MULE */
2102 }
2103
2104
2105 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2106 Find value for CHARACTER in CHAR-TABLE.
2107 */
2108        (character, char_table))
2109 {
2110   CHECK_CHAR_TABLE (char_table);
2111   CHECK_CHAR_COERCE_INT (character);
2112
2113   return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2114 }
2115
2116 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2117 Find value for a range in CHAR-TABLE.
2118 If there is more than one value, return MULTI (defaults to nil).
2119 */
2120        (range, char_table, multi))
2121 {
2122   Lisp_Char_Table *ct;
2123   struct chartab_range rainj;
2124
2125   if (CHAR_OR_CHAR_INTP (range))
2126     return Fget_char_table (range, char_table);
2127   CHECK_CHAR_TABLE (char_table);
2128   ct = XCHAR_TABLE (char_table);
2129
2130   decode_char_table_range (range, &rainj);
2131   switch (rainj.type)
2132     {
2133     case CHARTAB_RANGE_ALL:
2134       {
2135 #ifdef UTF2000
2136         if (UINT8_BYTE_TABLE_P (ct->table))
2137           return multi;
2138         else if (UINT16_BYTE_TABLE_P (ct->table))
2139           return multi;
2140         else if (BYTE_TABLE_P (ct->table))
2141           return multi;
2142         else
2143           return ct->table;
2144 #else /* non UTF2000 */
2145         int i;
2146         Lisp_Object first = ct->ascii[0];
2147
2148         for (i = 1; i < NUM_ASCII_CHARS; i++)
2149           if (!EQ (first, ct->ascii[i]))
2150             return multi;
2151
2152 #ifdef MULE
2153         for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2154              i++)
2155           {
2156             if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2157                 || i == LEADING_BYTE_ASCII
2158                 || i == LEADING_BYTE_CONTROL_1)
2159               continue;
2160             if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2161               return multi;
2162           }
2163 #endif /* MULE */
2164
2165         return first;
2166 #endif /* non UTF2000 */
2167       }
2168
2169 #ifdef MULE
2170     case CHARTAB_RANGE_CHARSET:
2171 #ifdef UTF2000
2172       return multi;
2173 #else
2174       if (EQ (rainj.charset, Vcharset_ascii))
2175         {
2176           int i;
2177           Lisp_Object first = ct->ascii[0];
2178
2179           for (i = 1; i < 128; i++)
2180             if (!EQ (first, ct->ascii[i]))
2181               return multi;
2182           return first;
2183         }
2184
2185       if (EQ (rainj.charset, Vcharset_control_1))
2186         {
2187           int i;
2188           Lisp_Object first = ct->ascii[128];
2189
2190           for (i = 129; i < 160; i++)
2191             if (!EQ (first, ct->ascii[i]))
2192               return multi;
2193           return first;
2194         }
2195
2196       {
2197         Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2198                                      MIN_LEADING_BYTE];
2199         if (CHAR_TABLE_ENTRYP (val))
2200           return multi;
2201         return val;
2202       }
2203 #endif
2204
2205     case CHARTAB_RANGE_ROW:
2206 #ifdef UTF2000
2207       return multi;
2208 #else
2209       {
2210         Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2211                                      MIN_LEADING_BYTE];
2212         if (!CHAR_TABLE_ENTRYP (val))
2213           return val;
2214         val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2215         if (CHAR_TABLE_ENTRYP (val))
2216           return multi;
2217         return val;
2218       }
2219 #endif /* not UTF2000 */
2220 #endif /* not MULE */
2221
2222     default:
2223       abort ();
2224     }
2225
2226   return Qnil; /* not reached */
2227 }
2228
2229 static int
2230 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2231                               Error_behavior errb)
2232 {
2233   switch (type)
2234     {
2235     case CHAR_TABLE_TYPE_SYNTAX:
2236       if (!ERRB_EQ (errb, ERROR_ME))
2237         return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2238                                 && CHAR_OR_CHAR_INTP (XCDR (value)));
2239       if (CONSP (value))
2240         {
2241           Lisp_Object cdr = XCDR (value);
2242           CHECK_INT (XCAR (value));
2243           CHECK_CHAR_COERCE_INT (cdr);
2244          }
2245       else
2246         CHECK_INT (value);
2247       break;
2248
2249 #ifdef MULE
2250     case CHAR_TABLE_TYPE_CATEGORY:
2251       if (!ERRB_EQ (errb, ERROR_ME))
2252         return CATEGORY_TABLE_VALUEP (value);
2253       CHECK_CATEGORY_TABLE_VALUE (value);
2254       break;
2255 #endif /* MULE */
2256
2257     case CHAR_TABLE_TYPE_GENERIC:
2258       return 1;
2259
2260     case CHAR_TABLE_TYPE_DISPLAY:
2261       /* #### fix this */
2262       maybe_signal_simple_error ("Display char tables not yet implemented",
2263                                  value, Qchar_table, errb);
2264       return 0;
2265
2266     case CHAR_TABLE_TYPE_CHAR:
2267       if (!ERRB_EQ (errb, ERROR_ME))
2268         return CHAR_OR_CHAR_INTP (value);
2269       CHECK_CHAR_COERCE_INT (value);
2270       break;
2271
2272     default:
2273       abort ();
2274     }
2275
2276   return 0; /* not reached */
2277 }
2278
2279 static Lisp_Object
2280 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2281 {
2282   switch (type)
2283     {
2284     case CHAR_TABLE_TYPE_SYNTAX:
2285       if (CONSP (value))
2286         {
2287           Lisp_Object car = XCAR (value);
2288           Lisp_Object cdr = XCDR (value);
2289           CHECK_CHAR_COERCE_INT (cdr);
2290           return Fcons (car, cdr);
2291         }
2292       break;
2293     case CHAR_TABLE_TYPE_CHAR:
2294       CHECK_CHAR_COERCE_INT (value);
2295       break;
2296     default:
2297       break;
2298     }
2299   return value;
2300 }
2301
2302 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2303 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2304 */
2305        (value, char_table_type))
2306 {
2307   enum char_table_type type = symbol_to_char_table_type (char_table_type);
2308
2309   return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2310 }
2311
2312 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2313 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2314 */
2315        (value, char_table_type))
2316 {
2317   enum char_table_type type = symbol_to_char_table_type (char_table_type);
2318
2319   check_valid_char_table_value (value, type, ERROR_ME);
2320   return Qnil;
2321 }
2322
2323 #ifdef UTF2000
2324 Lisp_Char_Table* char_attribute_table_to_put;
2325 Lisp_Object Qput_char_table_map_function;
2326 Lisp_Object value_to_put;
2327
2328 DEFUN ("put-char-table-map-function",
2329        Fput_char_table_map_function, 2, 2, 0, /*
2330 For internal use.  Don't use it.
2331 */
2332        (c, value))
2333 {
2334   put_char_id_table_0 (char_attribute_table_to_put, c, value_to_put);
2335   return Qnil;
2336 }
2337 #endif
2338
2339 /* Assign VAL to all characters in RANGE in char table CT. */
2340
2341 void
2342 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2343                 Lisp_Object val)
2344 {
2345   switch (range->type)
2346     {
2347     case CHARTAB_RANGE_ALL:
2348       /* printf ("put-char-table: range = all\n"); */
2349       fill_char_table (ct, val);
2350       return; /* avoid the duplicate call to update_syntax_table() below,
2351                  since fill_char_table() also did that. */
2352
2353 #ifdef UTF2000
2354     case CHARTAB_RANGE_DEFAULT:
2355       ct->default_value = val;
2356       return;
2357 #endif
2358
2359 #ifdef MULE
2360     case CHARTAB_RANGE_CHARSET:
2361 #ifdef UTF2000
2362       {
2363         Emchar c;
2364         Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2365
2366         /* printf ("put-char-table: range = charset: %d\n",
2367            XCHARSET_LEADING_BYTE (range->charset));
2368         */
2369         if ( CHAR_TABLEP (encoding_table) )
2370           {
2371 #if 1
2372             char_attribute_table_to_put = ct;
2373             value_to_put = val;
2374             Fmap_char_attribute (Qput_char_table_map_function,
2375                                  XCHAR_TABLE_NAME (encoding_table),
2376                                  Qnil);
2377 #else
2378             for (c = 0; c < 1 << 24; c++)
2379               {
2380                 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
2381                                               c)) )
2382                   put_char_id_table_0 (ct, c, val);
2383               }
2384 #endif
2385           }
2386         else
2387           {
2388             for (c = 0; c < 1 << 24; c++)
2389               {
2390                 if ( charset_code_point (range->charset, c) >= 0 )
2391                   put_char_id_table_0 (ct, c, val);
2392               }
2393           }
2394       }
2395 #else
2396       if (EQ (range->charset, Vcharset_ascii))
2397         {
2398           int i;
2399           for (i = 0; i < 128; i++)
2400             ct->ascii[i] = val;
2401         }
2402       else if (EQ (range->charset, Vcharset_control_1))
2403         {
2404           int i;
2405           for (i = 128; i < 160; i++)
2406             ct->ascii[i] = val;
2407         }
2408       else
2409         {
2410           int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2411           ct->level1[lb] = val;
2412         }
2413 #endif
2414       break;
2415
2416     case CHARTAB_RANGE_ROW:
2417 #ifdef UTF2000
2418       {
2419         int cell_min, cell_max, i;
2420
2421         i = XCHARSET_CELL_RANGE (range->charset);
2422         cell_min = i >> 8;
2423         cell_max = i & 0xFF;
2424         for (i = cell_min; i <= cell_max; i++)
2425           {
2426             Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2427
2428             if ( charset_code_point (range->charset, ch) >= 0 )
2429               put_char_id_table_0 (ct, ch, val);
2430           }
2431       }
2432 #else
2433       {
2434         Lisp_Char_Table_Entry *cte;
2435         int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2436         /* make sure that there is a separate entry for the row. */
2437         if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2438           ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2439         cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2440         cte->level2[range->row - 32] = val;
2441       }
2442 #endif /* not UTF2000 */
2443       break;
2444 #endif /* MULE */
2445
2446     case CHARTAB_RANGE_CHAR:
2447 #ifdef UTF2000
2448       /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2449       put_char_id_table_0 (ct, range->ch, val);
2450       break;
2451 #elif defined(MULE)
2452       {
2453         Lisp_Object charset;
2454         int byte1, byte2;
2455
2456         BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2457         if (EQ (charset, Vcharset_ascii))
2458           ct->ascii[byte1] = val;
2459         else if (EQ (charset, Vcharset_control_1))
2460           ct->ascii[byte1 + 128] = val;
2461         else
2462           {
2463             Lisp_Char_Table_Entry *cte;
2464             int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2465             /* make sure that there is a separate entry for the row. */
2466             if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2467               ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2468             cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2469             /* now CTE is a char table entry for the charset;
2470                each entry is for a single row (or character of
2471                a one-octet charset). */
2472             if (XCHARSET_DIMENSION (charset) == 1)
2473               cte->level2[byte1 - 32] = val;
2474             else
2475               {
2476                 /* assigning to one character in a two-octet charset. */
2477                 /* make sure that the charset row contains a separate
2478                    entry for each character. */
2479                 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2480                   cte->level2[byte1 - 32] =
2481                     make_char_table_entry (cte->level2[byte1 - 32]);
2482                 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2483                 cte->level2[byte2 - 32] = val;
2484               }
2485           }
2486       }
2487 #else /* not MULE */
2488       ct->ascii[(unsigned char) (range->ch)] = val;
2489       break;
2490 #endif /* not MULE */
2491     }
2492
2493 #ifndef UTF2000
2494   if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2495     update_syntax_table (ct);
2496 #endif
2497 }
2498
2499 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2500 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2501
2502 RANGE specifies one or more characters to be affected and should be
2503 one of the following:
2504
2505 -- t (all characters are affected)
2506 -- A charset (only allowed when Mule support is present)
2507 -- A vector of two elements: a two-octet charset and a row number
2508    (only allowed when Mule support is present)
2509 -- A single character
2510
2511 VALUE must be a value appropriate for the type of CHAR-TABLE.
2512 See `valid-char-table-type-p'.
2513 */
2514        (range, value, char_table))
2515 {
2516   Lisp_Char_Table *ct;
2517   struct chartab_range rainj;
2518
2519   CHECK_CHAR_TABLE (char_table);
2520   ct = XCHAR_TABLE (char_table);
2521   check_valid_char_table_value (value, ct->type, ERROR_ME);
2522   decode_char_table_range (range, &rainj);
2523   value = canonicalize_char_table_value (value, ct->type);
2524   put_char_table (ct, &rainj, value);
2525   return Qnil;
2526 }
2527
2528 #ifndef UTF2000
2529 /* Map FN over the ASCII chars in CT. */
2530
2531 static int
2532 map_over_charset_ascii (Lisp_Char_Table *ct,
2533                         int (*fn) (struct chartab_range *range,
2534                                    Lisp_Object val, void *arg),
2535                         void *arg)
2536 {
2537   struct chartab_range rainj;
2538   int i, retval;
2539   int start = 0;
2540 #ifdef MULE
2541   int stop = 128;
2542 #else
2543   int stop = 256;
2544 #endif
2545
2546   rainj.type = CHARTAB_RANGE_CHAR;
2547
2548   for (i = start, retval = 0; i < stop && retval == 0; i++)
2549     {
2550       rainj.ch = (Emchar) i;
2551       retval = (fn) (&rainj, ct->ascii[i], arg);
2552     }
2553
2554   return retval;
2555 }
2556
2557 #ifdef MULE
2558
2559 /* Map FN over the Control-1 chars in CT. */
2560
2561 static int
2562 map_over_charset_control_1 (Lisp_Char_Table *ct,
2563                             int (*fn) (struct chartab_range *range,
2564                                        Lisp_Object val, void *arg),
2565                             void *arg)
2566 {
2567   struct chartab_range rainj;
2568   int i, retval;
2569   int start = 128;
2570   int stop  = start + 32;
2571
2572   rainj.type = CHARTAB_RANGE_CHAR;
2573
2574   for (i = start, retval = 0; i < stop && retval == 0; i++)
2575     {
2576       rainj.ch = (Emchar) (i);
2577       retval = (fn) (&rainj, ct->ascii[i], arg);
2578     }
2579
2580   return retval;
2581 }
2582
2583 /* Map FN over the row ROW of two-byte charset CHARSET.
2584    There must be a separate value for that row in the char table.
2585    CTE specifies the char table entry for CHARSET. */
2586
2587 static int
2588 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2589                       Lisp_Object charset, int row,
2590                       int (*fn) (struct chartab_range *range,
2591                                  Lisp_Object val, void *arg),
2592                       void *arg)
2593 {
2594   Lisp_Object val = cte->level2[row - 32];
2595
2596   if (!CHAR_TABLE_ENTRYP (val))
2597     {
2598       struct chartab_range rainj;
2599
2600       rainj.type = CHARTAB_RANGE_ROW;
2601       rainj.charset = charset;
2602       rainj.row = row;
2603       return (fn) (&rainj, val, arg);
2604     }
2605   else
2606     {
2607       struct chartab_range rainj;
2608       int i, retval;
2609       int charset94_p = (XCHARSET_CHARS (charset) == 94);
2610       int start = charset94_p ?  33 :  32;
2611       int stop  = charset94_p ? 127 : 128;
2612
2613       cte = XCHAR_TABLE_ENTRY (val);
2614
2615       rainj.type = CHARTAB_RANGE_CHAR;
2616
2617       for (i = start, retval = 0; i < stop && retval == 0; i++)
2618         {
2619           rainj.ch = MAKE_CHAR (charset, row, i);
2620           retval = (fn) (&rainj, cte->level2[i - 32], arg);
2621         }
2622       return retval;
2623     }
2624 }
2625
2626
2627 static int
2628 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2629                         int (*fn) (struct chartab_range *range,
2630                                    Lisp_Object val, void *arg),
2631                         void *arg)
2632 {
2633   Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2634   Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2635
2636   if (!CHARSETP (charset)
2637       || lb == LEADING_BYTE_ASCII
2638       || lb == LEADING_BYTE_CONTROL_1)
2639     return 0;
2640
2641   if (!CHAR_TABLE_ENTRYP (val))
2642     {
2643       struct chartab_range rainj;
2644
2645       rainj.type = CHARTAB_RANGE_CHARSET;
2646       rainj.charset = charset;
2647       return (fn) (&rainj, val, arg);
2648     }
2649
2650   {
2651     Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2652     int charset94_p = (XCHARSET_CHARS (charset) == 94);
2653     int start = charset94_p ?  33 :  32;
2654     int stop  = charset94_p ? 127 : 128;
2655     int i, retval;
2656
2657     if (XCHARSET_DIMENSION (charset) == 1)
2658       {
2659         struct chartab_range rainj;
2660         rainj.type = CHARTAB_RANGE_CHAR;
2661
2662         for (i = start, retval = 0; i < stop && retval == 0; i++)
2663           {
2664             rainj.ch = MAKE_CHAR (charset, i, 0);
2665             retval = (fn) (&rainj, cte->level2[i - 32], arg);
2666           }
2667       }
2668     else
2669       {
2670         for (i = start, retval = 0; i < stop && retval == 0; i++)
2671           retval = map_over_charset_row (cte, charset, i, fn, arg);
2672       }
2673
2674     return retval;
2675   }
2676 }
2677
2678 #endif /* MULE */
2679 #endif /* not UTF2000 */
2680
2681 #ifdef UTF2000
2682 struct map_char_table_for_charset_arg
2683 {
2684   int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2685   Lisp_Char_Table *ct;
2686   void *arg;
2687 };
2688
2689 static int
2690 map_char_table_for_charset_fun (struct chartab_range *range,
2691                                 Lisp_Object val, void *arg)
2692 {
2693   struct map_char_table_for_charset_arg *closure =
2694     (struct map_char_table_for_charset_arg *) arg;
2695   Lisp_Object ret;
2696
2697   switch (range->type)
2698     {
2699     case CHARTAB_RANGE_ALL:
2700       break;
2701
2702     case CHARTAB_RANGE_DEFAULT:
2703       break;
2704
2705     case CHARTAB_RANGE_CHARSET:
2706       break;
2707
2708     case CHARTAB_RANGE_ROW:
2709       break;
2710
2711     case CHARTAB_RANGE_CHAR:
2712       ret = get_char_table (range->ch, closure->ct);
2713       if (!UNBOUNDP (ret))
2714         return (closure->fn) (range, ret, closure->arg);
2715       break;
2716
2717     default:
2718       abort ();
2719     }
2720
2721   return 0;
2722 }
2723
2724 #if defined(HAVE_DATABASE)
2725 EXFUN (Fload_char_attribute_table, 1);
2726 #endif
2727
2728 #endif
2729
2730 /* Map FN (with client data ARG) over range RANGE in char table CT.
2731    Mapping stops the first time FN returns non-zero, and that value
2732    becomes the return value of map_char_table(). */
2733
2734 int
2735 map_char_table (Lisp_Char_Table *ct,
2736                 struct chartab_range *range,
2737                 int (*fn) (struct chartab_range *range,
2738                            Lisp_Object val, void *arg),
2739                 void *arg)
2740 {
2741   switch (range->type)
2742     {
2743     case CHARTAB_RANGE_ALL:
2744 #ifdef UTF2000
2745       if (!UNBOUNDP (ct->default_value))
2746         {
2747           struct chartab_range rainj;
2748           int retval;
2749
2750           rainj.type = CHARTAB_RANGE_DEFAULT;
2751           retval = (fn) (&rainj, ct->default_value, arg);
2752           if (retval != 0)
2753             return retval;
2754         }
2755       if (UINT8_BYTE_TABLE_P (ct->table))
2756         return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2757                                           0, 3, fn, arg);
2758       else if (UINT16_BYTE_TABLE_P (ct->table))
2759         return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2760                                            0, 3, fn, arg);
2761       else if (BYTE_TABLE_P (ct->table))
2762         return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2763                                     0, 3, fn, arg);
2764       else if (EQ (ct->table, Qunloaded))
2765         {
2766 #if 0
2767           struct chartab_range rainj;
2768           int unit = 1 << 30;
2769           Emchar c = 0;
2770           Emchar c1 = c + unit;
2771           int retval;
2772
2773           rainj.type = CHARTAB_RANGE_CHAR;
2774
2775           for (retval = 0; c < c1 && retval == 0; c++)
2776             {
2777               Lisp_Object ret = get_char_id_table (ct, c);
2778
2779               if (!UNBOUNDP (ret))
2780                 {
2781                   rainj.ch = c;
2782                   retval = (fn) (&rainj, ct->table, arg);
2783                 }
2784             }
2785           return retval;
2786 #else
2787           ct->table = Qunbound;
2788 #endif
2789         }
2790       else if (!UNBOUNDP (ct->table))
2791         return (fn) (range, ct->table, arg);
2792       return 0;
2793 #else
2794       {
2795         int retval;
2796
2797         retval = map_over_charset_ascii (ct, fn, arg);
2798         if (retval)
2799           return retval;
2800 #ifdef MULE
2801         retval = map_over_charset_control_1 (ct, fn, arg);
2802         if (retval)
2803           return retval;
2804         {
2805           Charset_ID i;
2806           Charset_ID start = MIN_LEADING_BYTE;
2807           Charset_ID stop  = start + NUM_LEADING_BYTES;
2808
2809           for (i = start, retval = 0; i < stop && retval == 0; i++)
2810             {
2811               retval = map_over_other_charset (ct, i, fn, arg);
2812             }
2813         }
2814 #endif /* MULE */
2815         return retval;
2816       }
2817 #endif
2818
2819 #ifdef UTF2000
2820     case CHARTAB_RANGE_DEFAULT:
2821       if (!UNBOUNDP (ct->default_value))
2822         return (fn) (range, ct->default_value, arg);
2823       return 0;
2824 #endif
2825
2826 #ifdef MULE
2827     case CHARTAB_RANGE_CHARSET:
2828 #ifdef UTF2000
2829       {
2830         Lisp_Object encoding_table
2831           = XCHARSET_ENCODING_TABLE (range->charset);
2832
2833         if (!NILP (encoding_table))
2834           {
2835             struct chartab_range rainj;
2836             struct map_char_table_for_charset_arg mcarg;
2837
2838 #ifdef HAVE_DATABASE
2839             if (XCHAR_TABLE_UNLOADED(encoding_table))
2840               Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2841 #endif
2842             mcarg.fn = fn;
2843             mcarg.ct = ct;
2844             mcarg.arg = arg;
2845             rainj.type = CHARTAB_RANGE_ALL;
2846             return map_char_table (XCHAR_TABLE(encoding_table),
2847                                    &rainj,
2848                                    &map_char_table_for_charset_fun,
2849                                    &mcarg);
2850           }
2851       }
2852       return 0;
2853 #else
2854       return map_over_other_charset (ct,
2855                                      XCHARSET_LEADING_BYTE (range->charset),
2856                                      fn, arg);
2857 #endif
2858
2859     case CHARTAB_RANGE_ROW:
2860 #ifdef UTF2000
2861       {
2862         int cell_min, cell_max, i;
2863         int retval;
2864         struct chartab_range rainj;
2865
2866         i = XCHARSET_CELL_RANGE (range->charset);
2867         cell_min = i >> 8;
2868         cell_max = i & 0xFF;
2869         rainj.type = CHARTAB_RANGE_CHAR;
2870         for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2871           {
2872             Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2873
2874             if ( charset_code_point (range->charset, ch) >= 0 )
2875               {
2876                 Lisp_Object val
2877                   = get_byte_table (get_byte_table
2878                                     (get_byte_table
2879                                      (get_byte_table
2880                                       (ct->table,
2881                                        (unsigned char)(ch >> 24)),
2882                                       (unsigned char) (ch >> 16)),
2883                                      (unsigned char)  (ch >> 8)),
2884                                     (unsigned char)    ch);
2885
2886                 if (UNBOUNDP (val))
2887                   val = ct->default_value;
2888                 rainj.ch = ch;
2889                 retval = (fn) (&rainj, val, arg);
2890               }
2891           }
2892         return retval;
2893       }
2894 #else
2895       {
2896         Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2897                                     - MIN_LEADING_BYTE];
2898         if (!CHAR_TABLE_ENTRYP (val))
2899           {
2900             struct chartab_range rainj;
2901
2902             rainj.type = CHARTAB_RANGE_ROW;
2903             rainj.charset = range->charset;
2904             rainj.row = range->row;
2905             return (fn) (&rainj, val, arg);
2906           }
2907         else
2908           return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
2909                                        range->charset, range->row,
2910                                        fn, arg);
2911       }
2912 #endif /* not UTF2000 */
2913 #endif /* MULE */
2914
2915     case CHARTAB_RANGE_CHAR:
2916       {
2917         Emchar ch = range->ch;
2918         Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
2919
2920         if (!UNBOUNDP (val))
2921           {
2922             struct chartab_range rainj;
2923
2924             rainj.type = CHARTAB_RANGE_CHAR;
2925             rainj.ch = ch;
2926             return (fn) (&rainj, val, arg);
2927           }
2928         return 0;
2929       }
2930
2931     default:
2932       abort ();
2933     }
2934
2935   return 0;
2936 }
2937
2938 struct slow_map_char_table_arg
2939 {
2940   Lisp_Object function;
2941   Lisp_Object retval;
2942 };
2943
2944 static int
2945 slow_map_char_table_fun (struct chartab_range *range,
2946                          Lisp_Object val, void *arg)
2947 {
2948   Lisp_Object ranjarg = Qnil;
2949   struct slow_map_char_table_arg *closure =
2950     (struct slow_map_char_table_arg *) arg;
2951
2952   switch (range->type)
2953     {
2954     case CHARTAB_RANGE_ALL:
2955       ranjarg = Qt;
2956       break;
2957
2958 #ifdef UTF2000
2959     case CHARTAB_RANGE_DEFAULT:
2960       ranjarg = Qnil;
2961       break;
2962 #endif
2963
2964 #ifdef MULE
2965     case CHARTAB_RANGE_CHARSET:
2966       ranjarg = XCHARSET_NAME (range->charset);
2967       break;
2968
2969     case CHARTAB_RANGE_ROW:
2970       ranjarg = vector2 (XCHARSET_NAME (range->charset),
2971                          make_int (range->row));
2972       break;
2973 #endif /* MULE */
2974     case CHARTAB_RANGE_CHAR:
2975       ranjarg = make_char (range->ch);
2976       break;
2977     default:
2978       abort ();
2979     }
2980
2981   closure->retval = call2 (closure->function, ranjarg, val);
2982   return !NILP (closure->retval);
2983 }
2984
2985 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
2986 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
2987 each key and value in the table.
2988
2989 RANGE specifies a subrange to map over and is in the same format as
2990 the RANGE argument to `put-range-table'.  If omitted or t, it defaults to
2991 the entire table.
2992 */
2993        (function, char_table, range))
2994 {
2995   Lisp_Char_Table *ct;
2996   struct slow_map_char_table_arg slarg;
2997   struct gcpro gcpro1, gcpro2;
2998   struct chartab_range rainj;
2999
3000   CHECK_CHAR_TABLE (char_table);
3001   ct = XCHAR_TABLE (char_table);
3002   if (NILP (range))
3003     range = Qt;
3004   decode_char_table_range (range, &rainj);
3005   slarg.function = function;
3006   slarg.retval = Qnil;
3007   GCPRO2 (slarg.function, slarg.retval);
3008   map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3009   UNGCPRO;
3010
3011   return slarg.retval;
3012 }
3013
3014 \f
3015 /************************************************************************/
3016 /*                         Character Attributes                         */
3017 /************************************************************************/
3018
3019 #ifdef UTF2000
3020
3021 Lisp_Object Vchar_attribute_hash_table;
3022
3023 /* We store the char-attributes in hash tables with the names as the
3024    key and the actual char-id-table object as the value.  Occasionally
3025    we need to use them in a list format.  These routines provide us
3026    with that. */
3027 struct char_attribute_list_closure
3028 {
3029   Lisp_Object *char_attribute_list;
3030 };
3031
3032 static int
3033 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3034                                    void *char_attribute_list_closure)
3035 {
3036   /* This function can GC */
3037   struct char_attribute_list_closure *calcl
3038     = (struct char_attribute_list_closure*) char_attribute_list_closure;
3039   Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3040
3041   *char_attribute_list = Fcons (key, *char_attribute_list);
3042   return 0;
3043 }
3044
3045 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3046 Return the list of all existing character attributes except coded-charsets.
3047 */
3048        ())
3049 {
3050   Lisp_Object char_attribute_list = Qnil;
3051   struct gcpro gcpro1;
3052   struct char_attribute_list_closure char_attribute_list_closure;
3053
3054   GCPRO1 (char_attribute_list);
3055   char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3056   elisp_maphash (add_char_attribute_to_list_mapper,
3057                  Vchar_attribute_hash_table,
3058                  &char_attribute_list_closure);
3059   UNGCPRO;
3060   return char_attribute_list;
3061 }
3062
3063 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3064 Return char-id-table corresponding to ATTRIBUTE.
3065 */
3066        (attribute))
3067 {
3068   return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3069 }
3070
3071
3072 /* We store the char-id-tables in hash tables with the attributes as
3073    the key and the actual char-id-table object as the value.  Each
3074    char-id-table stores values of an attribute corresponding with
3075    characters.  Occasionally we need to get attributes of a character
3076    in a association-list format.  These routines provide us with
3077    that. */
3078 struct char_attribute_alist_closure
3079 {
3080   Emchar char_id;
3081   Lisp_Object *char_attribute_alist;
3082 };
3083
3084 static int
3085 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3086                                  void *char_attribute_alist_closure)
3087 {
3088   /* This function can GC */
3089   struct char_attribute_alist_closure *caacl =
3090     (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3091   Lisp_Object ret
3092     = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3093   if (!UNBOUNDP (ret))
3094     {
3095       Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3096       *char_attribute_alist
3097         = Fcons (Fcons (key, ret), *char_attribute_alist);
3098     }
3099   return 0;
3100 }
3101
3102 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3103 Return the alist of attributes of CHARACTER.
3104 */
3105        (character))
3106 {
3107   struct gcpro gcpro1;
3108   struct char_attribute_alist_closure char_attribute_alist_closure;
3109   Lisp_Object alist = Qnil;
3110
3111   CHECK_CHAR (character);
3112
3113   GCPRO1 (alist);
3114   char_attribute_alist_closure.char_id = XCHAR (character);
3115   char_attribute_alist_closure.char_attribute_alist = &alist;
3116   elisp_maphash (add_char_attribute_alist_mapper,
3117                  Vchar_attribute_hash_table,
3118                  &char_attribute_alist_closure);
3119   UNGCPRO;
3120
3121   return alist;
3122 }
3123
3124 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3125 Return the value of CHARACTER's ATTRIBUTE.
3126 Return DEFAULT-VALUE if the value is not exist.
3127 */
3128        (character, attribute, default_value))
3129 {
3130   Lisp_Object table;
3131
3132   CHECK_CHAR (character);
3133
3134   if (CHARSETP (attribute))
3135     attribute = XCHARSET_NAME (attribute);
3136
3137   table = Fgethash (attribute, Vchar_attribute_hash_table,
3138                     Qunbound);
3139   if (!UNBOUNDP (table))
3140     {
3141       Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3142                                            XCHAR (character));
3143       if (!UNBOUNDP (ret))
3144         return ret;
3145     }
3146   return default_value;
3147 }
3148
3149 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3150 Store CHARACTER's ATTRIBUTE with VALUE.
3151 */
3152        (character, attribute, value))
3153 {
3154   Lisp_Object ccs = Ffind_charset (attribute);
3155
3156   if (!NILP (ccs))
3157     {
3158       CHECK_CHAR (character);
3159       value = put_char_ccs_code_point (character, ccs, value);
3160     }
3161   else if (EQ (attribute, Q_decomposition))
3162     {
3163       Lisp_Object seq;
3164
3165       CHECK_CHAR (character);
3166       if (!CONSP (value))
3167         signal_simple_error ("Invalid value for ->decomposition",
3168                              value);
3169
3170       if (CONSP (Fcdr (value)))
3171         {
3172           Lisp_Object rest = value;
3173           Lisp_Object table = Vcharacter_composition_table;
3174           size_t len;
3175           int i = 0;
3176
3177           GET_EXTERNAL_LIST_LENGTH (rest, len);
3178           seq = make_vector (len, Qnil);
3179
3180           while (CONSP (rest))
3181             {
3182               Lisp_Object v = Fcar (rest);
3183               Lisp_Object ntable;
3184               Emchar c
3185                 = to_char_id (v, "Invalid value for ->decomposition", value);
3186
3187               if (c < 0)
3188                 XVECTOR_DATA(seq)[i++] = v;
3189               else
3190                 XVECTOR_DATA(seq)[i++] = make_char (c);
3191               rest = Fcdr (rest);
3192               if (!CONSP (rest))
3193                 {
3194                   put_char_id_table (XCHAR_TABLE(table),
3195                                      make_char (c), character);
3196                   break;
3197                 }
3198               else
3199                 {
3200                   ntable = get_char_id_table (XCHAR_TABLE(table), c);
3201                   if (!CHAR_TABLEP (ntable))
3202                     {
3203                       ntable = make_char_id_table (Qnil);
3204                       put_char_id_table (XCHAR_TABLE(table),
3205                                          make_char (c), ntable);
3206                     }
3207                   table = ntable;
3208                 }
3209             }
3210         }
3211       else
3212         {
3213           Lisp_Object v = Fcar (value);
3214
3215           if (INTP (v))
3216             {
3217               Emchar c = XINT (v);
3218               Lisp_Object ret
3219                 = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3220                                      c);
3221
3222               if (!CONSP (ret))
3223                 {
3224                   put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3225                                      make_char (c), Fcons (character, Qnil));
3226                 }
3227               else if (NILP (Fmemq (v, ret)))
3228                 {
3229                   put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3230                                      make_char (c), Fcons (character, ret));
3231                 }
3232             }
3233           seq = make_vector (1, v);
3234         }
3235       value = seq;
3236     }
3237   else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
3238     {
3239       Lisp_Object ret;
3240       Emchar c;
3241
3242       CHECK_CHAR (character);
3243       if (!INTP (value))
3244         signal_simple_error ("Invalid value for ->ucs", value);
3245
3246       c = XINT (value);
3247
3248       ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
3249       if (!CONSP (ret))
3250         {
3251           put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3252                              make_char (c), Fcons (character, Qnil));
3253         }
3254       else if (NILP (Fmemq (character, ret)))
3255         {
3256           put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3257                              make_char (c), Fcons (character, ret));
3258         }
3259 #if 0
3260       if (EQ (attribute, Q_ucs))
3261         attribute = Qto_ucs;
3262 #endif
3263     }
3264   {
3265     Lisp_Object table = Fgethash (attribute,
3266                                   Vchar_attribute_hash_table,
3267                                   Qnil);
3268
3269     if (NILP (table))
3270       {
3271         table = make_char_id_table (Qunbound);
3272         Fputhash (attribute, table, Vchar_attribute_hash_table);
3273 #ifdef HAVE_DATABASE
3274         XCHAR_TABLE_NAME (table) = attribute;
3275 #endif
3276       }
3277     put_char_id_table (XCHAR_TABLE(table), character, value);
3278     return value;
3279   }
3280 }
3281
3282 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3283 Remove CHARACTER's ATTRIBUTE.
3284 */
3285        (character, attribute))
3286 {
3287   Lisp_Object ccs;
3288
3289   CHECK_CHAR (character);
3290   ccs = Ffind_charset (attribute);
3291   if (!NILP (ccs))
3292     {
3293       return remove_char_ccs (character, ccs);
3294     }
3295   else
3296     {
3297       Lisp_Object table = Fgethash (attribute,
3298                                     Vchar_attribute_hash_table,
3299                                     Qunbound);
3300       if (!UNBOUNDP (table))
3301         {
3302           put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3303           return Qt;
3304         }
3305     }
3306   return Qnil;
3307 }
3308
3309 Lisp_Object
3310 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3311                                int writing_mode)
3312 {
3313   Lisp_Object db_dir = Vexec_directory;
3314
3315   if (NILP (db_dir))
3316     db_dir = build_string ("../lib-src");
3317
3318   db_dir = Fexpand_file_name (build_string ("char-db"), db_dir);
3319   if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3320     Fmake_directory_internal (db_dir);
3321
3322   db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3323   if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3324     Fmake_directory_internal (db_dir);
3325
3326   {
3327     Lisp_Object attribute_name = Fsymbol_name (attribute);
3328     Lisp_Object dest = Qnil, ret;
3329     int base = 0;
3330     struct gcpro gcpro1, gcpro2;
3331     int len = XSTRING_CHAR_LENGTH (attribute_name);
3332     int i;
3333
3334     GCPRO2 (dest, ret);
3335     for (i = 0; i < len; i++)
3336       {
3337         Emchar c = string_char (XSTRING (attribute_name), i);
3338
3339         if ( (c == '/') || (c == '%') )
3340           {
3341             char str[4];
3342
3343             sprintf (str, "%%%02X", c);
3344             dest = concat3 (dest,
3345                             Fsubstring (attribute_name,
3346                                         make_int (base), make_int (i)),
3347                             build_string (str));
3348             base = i + 1;
3349           }
3350       }
3351     ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3352     dest = concat2 (dest, ret);
3353     UNGCPRO;
3354     return Fexpand_file_name (dest, db_dir);
3355   }
3356 #if 0
3357   return Fexpand_file_name (Fsymbol_name (attribute), db_dir);
3358 #endif
3359 }
3360
3361 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3362 Save values of ATTRIBUTE into database file.
3363 */
3364        (attribute))
3365 {
3366 #ifdef HAVE_DATABASE
3367   Lisp_Object table = Fgethash (attribute,
3368                                 Vchar_attribute_hash_table, Qunbound);
3369   Lisp_Char_Table *ct;
3370   Lisp_Object db;
3371   Lisp_Object db_file;
3372
3373   if (CHAR_TABLEP (table))
3374     ct = XCHAR_TABLE (table);
3375   else
3376     return Qnil;
3377
3378   db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3379   db = Fopen_database (db_file, Qnil, Qnil, Qnil, Qnil);
3380   if (!NILP (db))
3381     {
3382       if (UINT8_BYTE_TABLE_P (ct->table))
3383         save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct, db, 0, 3);
3384       else if (UINT16_BYTE_TABLE_P (ct->table))
3385         save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct, db, 0, 3);
3386       else if (BYTE_TABLE_P (ct->table))
3387         save_byte_table (XBYTE_TABLE(ct->table), ct, db, 0, 3);
3388       Fclose_database (db);
3389       return Qt;
3390     }
3391   else
3392     return Qnil;
3393 #else
3394   return Qnil;
3395 #endif
3396 }
3397
3398 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3399 Reset values of ATTRIBUTE with database file.
3400 */
3401        (attribute))
3402 {
3403 #ifdef HAVE_DATABASE
3404   Lisp_Object table = Fgethash (attribute,
3405                                 Vchar_attribute_hash_table, Qunbound);
3406   Lisp_Char_Table *ct;
3407   Lisp_Object db_file
3408     = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3409
3410   if (!NILP (Ffile_exists_p (db_file)))
3411     {
3412       if (UNBOUNDP (table))
3413         {
3414           table = make_char_id_table (Qunbound);
3415           Fputhash (attribute, table, Vchar_attribute_hash_table);
3416           XCHAR_TABLE_NAME(table) = attribute;
3417         }
3418       ct = XCHAR_TABLE (table);
3419       ct->table = Qunloaded;
3420       XCHAR_TABLE_UNLOADED(table) = 1;
3421       return Qt;
3422     }
3423 #endif
3424   return Qnil;
3425 }
3426
3427 #ifdef HAVE_DATABASE
3428 Lisp_Object
3429 load_char_attribute_maybe (Emchar ch, Lisp_Object attribute)
3430 {
3431   Lisp_Object db;
3432   Lisp_Object db_file
3433     = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3434
3435   db = Fopen_database (db_file, Qnil, Qnil, Qnil, Qnil);
3436   if (!NILP (db))
3437     {
3438       Lisp_Object val
3439         = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3440                          db, Qunbound);
3441       if (!UNBOUNDP (val))
3442         val = Fread (val);
3443       else
3444         val = Qunbound;
3445       Fclose_database (db);
3446       return val;
3447     }
3448   else
3449     return Qunbound;
3450 }
3451
3452 Lisp_Char_Table* char_attribute_table_to_load;
3453
3454 Lisp_Object Qload_char_attribute_table_map_function;
3455
3456 DEFUN ("load-char-attribute-table-map-function",
3457        Fload_char_attribute_table_map_function, 2, 2, 0, /*
3458 For internal use.  Don't use it.
3459 */
3460        (key, value))
3461 {
3462   Lisp_Object c = Fread (key);
3463   Emchar code = XCHAR (c);
3464   Lisp_Object ret = get_char_id_table (char_attribute_table_to_load, code);
3465
3466   if (EQ (ret, Qunloaded))
3467     put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
3468   return Qnil;
3469 }
3470 #endif
3471
3472 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
3473 Load values of ATTRIBUTE into database file.
3474 */
3475        (attribute))
3476 {
3477 #ifdef HAVE_DATABASE
3478   Lisp_Object db;
3479   Lisp_Object db_file
3480     = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3481
3482   db = Fopen_database (db_file, Qnil, Qnil, Qnil, Qnil);
3483   if (!NILP (db))
3484     {
3485       Lisp_Object table = Fgethash (attribute,
3486                                     Vchar_attribute_hash_table,
3487                                     Qunbound);
3488       struct gcpro gcpro1, gcpro2;
3489
3490       if (CHAR_TABLEP (table))
3491         char_attribute_table_to_load = XCHAR_TABLE (table);
3492       else
3493         {
3494           Fclose_database (db);
3495           return Qnil;
3496         }
3497       GCPRO2 (db, table);
3498       Fmap_database (Qload_char_attribute_table_map_function, db);
3499       UNGCPRO;
3500       Fclose_database (db);
3501       XCHAR_TABLE_UNLOADED(table) = 0;
3502       return Qt;
3503     }
3504   else
3505     return Qnil;
3506 #endif
3507 }
3508
3509 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3510 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3511 each key and value in the table.
3512
3513 RANGE specifies a subrange to map over and is in the same format as
3514 the RANGE argument to `put-range-table'.  If omitted or t, it defaults to
3515 the entire table.
3516 */
3517        (function, attribute, range))
3518 {
3519   Lisp_Object ccs;
3520   Lisp_Char_Table *ct;
3521   struct slow_map_char_table_arg slarg;
3522   struct gcpro gcpro1, gcpro2;
3523   struct chartab_range rainj;
3524
3525   if (!NILP (ccs = Ffind_charset (attribute)))
3526     {
3527       Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3528
3529       if (CHAR_TABLEP (encoding_table))
3530         ct = XCHAR_TABLE (encoding_table);
3531       else
3532         return Qnil;
3533     }
3534   else
3535     {
3536       Lisp_Object table = Fgethash (attribute,
3537                                     Vchar_attribute_hash_table,
3538                                     Qunbound);
3539       if (CHAR_TABLEP (table))
3540         ct = XCHAR_TABLE (table);
3541       else
3542         return Qnil;
3543     }
3544   if (NILP (range))
3545     range = Qt;
3546   decode_char_table_range (range, &rainj);
3547 #ifdef HAVE_DATABASE
3548   if (CHAR_TABLE_UNLOADED(ct))
3549     Fload_char_attribute_table (attribute);
3550 #endif
3551   slarg.function = function;
3552   slarg.retval = Qnil;
3553   GCPRO2 (slarg.function, slarg.retval);
3554   map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3555   UNGCPRO;
3556
3557   return slarg.retval;
3558 }
3559
3560 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3561 Store character's ATTRIBUTES.
3562 */
3563        (attributes))
3564 {
3565   Lisp_Object rest = attributes;
3566   Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
3567   Lisp_Object character;
3568
3569   if (NILP (code))
3570     {
3571       while (CONSP (rest))
3572         {
3573           Lisp_Object cell = Fcar (rest);
3574           Lisp_Object ccs;
3575
3576           if (!LISTP (cell))
3577             signal_simple_error ("Invalid argument", attributes);
3578           if (!NILP (ccs = Ffind_charset (Fcar (cell)))
3579               && ((XCHARSET_FINAL (ccs) != 0) ||
3580                   (XCHARSET_MAX_CODE (ccs) > 0) ||
3581                   (EQ (ccs, Vcharset_chinese_big5))) )
3582             {
3583               cell = Fcdr (cell);
3584               if (CONSP (cell))
3585                 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3586               else
3587                 character = Fdecode_char (ccs, cell, Qnil);
3588               if (!NILP (character))
3589                 goto setup_attributes;
3590             }
3591           rest = Fcdr (rest);
3592         }
3593       if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3594            (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3595
3596         {
3597           if (!INTP (code))
3598             signal_simple_error ("Invalid argument", attributes);
3599           else
3600             character = make_char (XINT (code) + 0x100000);
3601           goto setup_attributes;
3602         }
3603       return Qnil;
3604     }
3605   else if (!INTP (code))
3606     signal_simple_error ("Invalid argument", attributes);
3607   else
3608     character = make_char (XINT (code));
3609
3610  setup_attributes:
3611   rest = attributes;
3612   while (CONSP (rest))
3613     {
3614       Lisp_Object cell = Fcar (rest);
3615
3616       if (!LISTP (cell))
3617         signal_simple_error ("Invalid argument", attributes);
3618
3619       Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3620       rest = Fcdr (rest);
3621     }
3622   return character;
3623 }
3624
3625 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3626 Retrieve the character of the given ATTRIBUTES.
3627 */
3628        (attributes))
3629 {
3630   Lisp_Object rest = attributes;
3631   Lisp_Object code;
3632
3633   while (CONSP (rest))
3634     {
3635       Lisp_Object cell = Fcar (rest);
3636       Lisp_Object ccs;
3637
3638       if (!LISTP (cell))
3639         signal_simple_error ("Invalid argument", attributes);
3640       if (!NILP (ccs = Ffind_charset (Fcar (cell))))
3641         {
3642           cell = Fcdr (cell);
3643           if (CONSP (cell))
3644             return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3645           else
3646             return Fdecode_char (ccs, cell, Qnil);
3647         }
3648       rest = Fcdr (rest);
3649     }
3650   if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3651        (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3652     {
3653       if (!INTP (code))
3654         signal_simple_error ("Invalid argument", attributes);
3655       else
3656         return make_char (XINT (code) + 0x100000);
3657     }
3658   return Qnil;
3659 }
3660
3661 #endif
3662
3663 \f
3664 /************************************************************************/
3665 /*                         Char table read syntax                       */
3666 /************************************************************************/
3667
3668 static int
3669 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
3670                        Error_behavior errb)
3671 {
3672   /* #### should deal with ERRB */
3673   symbol_to_char_table_type (value);
3674   return 1;
3675 }
3676
3677 static int
3678 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
3679                        Error_behavior errb)
3680 {
3681   Lisp_Object rest;
3682
3683   /* #### should deal with ERRB */
3684   EXTERNAL_LIST_LOOP (rest, value)
3685     {
3686       Lisp_Object range = XCAR (rest);
3687       struct chartab_range dummy;
3688
3689       rest = XCDR (rest);
3690       if (!CONSP (rest))
3691         signal_simple_error ("Invalid list format", value);
3692       if (CONSP (range))
3693         {
3694           if (!CONSP (XCDR (range))
3695               || !NILP (XCDR (XCDR (range))))
3696             signal_simple_error ("Invalid range format", range);
3697           decode_char_table_range (XCAR (range), &dummy);
3698           decode_char_table_range (XCAR (XCDR (range)), &dummy);
3699         }
3700       else
3701         decode_char_table_range (range, &dummy);
3702     }
3703
3704   return 1;
3705 }
3706
3707 static Lisp_Object
3708 chartab_instantiate (Lisp_Object data)
3709 {
3710   Lisp_Object chartab;
3711   Lisp_Object type = Qgeneric;
3712   Lisp_Object dataval = Qnil;
3713
3714   while (!NILP (data))
3715     {
3716       Lisp_Object keyw = Fcar (data);
3717       Lisp_Object valw;
3718
3719       data = Fcdr (data);
3720       valw = Fcar (data);
3721       data = Fcdr (data);
3722       if (EQ (keyw, Qtype))
3723         type = valw;
3724       else if (EQ (keyw, Qdata))
3725         dataval = valw;
3726     }
3727
3728   chartab = Fmake_char_table (type);
3729
3730   data = dataval;
3731   while (!NILP (data))
3732     {
3733       Lisp_Object range = Fcar (data);
3734       Lisp_Object val = Fcar (Fcdr (data));
3735
3736       data = Fcdr (Fcdr (data));
3737       if (CONSP (range))
3738         {
3739           if (CHAR_OR_CHAR_INTP (XCAR (range)))
3740             {
3741               Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3742               Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3743               Emchar i;
3744
3745               for (i = first; i <= last; i++)
3746                  Fput_char_table (make_char (i), val, chartab);
3747             }
3748           else
3749             abort ();
3750         }
3751       else
3752         Fput_char_table (range, val, chartab);
3753     }
3754
3755   return chartab;
3756 }
3757
3758 #ifdef MULE
3759
3760 \f
3761 /************************************************************************/
3762 /*                     Category Tables, specifically                    */
3763 /************************************************************************/
3764
3765 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
3766 Return t if OBJECT is a category table.
3767 A category table is a type of char table used for keeping track of
3768 categories.  Categories are used for classifying characters for use
3769 in regexps -- you can refer to a category rather than having to use
3770 a complicated [] expression (and category lookups are significantly
3771 faster).
3772
3773 There are 95 different categories available, one for each printable
3774 character (including space) in the ASCII charset.  Each category
3775 is designated by one such character, called a "category designator".
3776 They are specified in a regexp using the syntax "\\cX", where X is
3777 a category designator.
3778
3779 A category table specifies, for each character, the categories that
3780 the character is in.  Note that a character can be in more than one
3781 category.  More specifically, a category table maps from a character
3782 to either the value nil (meaning the character is in no categories)
3783 or a 95-element bit vector, specifying for each of the 95 categories
3784 whether the character is in that category.
3785
3786 Special Lisp functions are provided that abstract this, so you do not
3787 have to directly manipulate bit vectors.
3788 */
3789        (object))
3790 {
3791   return (CHAR_TABLEP (object) &&
3792           XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
3793     Qt : Qnil;
3794 }
3795
3796 static Lisp_Object
3797 check_category_table (Lisp_Object object, Lisp_Object default_)
3798 {
3799   if (NILP (object))
3800     object = default_;
3801   while (NILP (Fcategory_table_p (object)))
3802     object = wrong_type_argument (Qcategory_table_p, object);
3803   return object;
3804 }
3805
3806 int
3807 check_category_char (Emchar ch, Lisp_Object table,
3808                      unsigned int designator, unsigned int not_p)
3809 {
3810   REGISTER Lisp_Object temp;
3811   Lisp_Char_Table *ctbl;
3812 #ifdef ERROR_CHECK_TYPECHECK
3813   if (NILP (Fcategory_table_p (table)))
3814     signal_simple_error ("Expected category table", table);
3815 #endif
3816   ctbl = XCHAR_TABLE (table);
3817   temp = get_char_table (ch, ctbl);
3818   if (NILP (temp))
3819     return not_p;
3820
3821   designator -= ' ';
3822   return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
3823 }
3824
3825 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
3826 Return t if category of the character at POSITION includes DESIGNATOR.
3827 Optional third arg BUFFER specifies which buffer to use, and defaults
3828 to the current buffer.
3829 Optional fourth arg CATEGORY-TABLE specifies the category table to
3830 use, and defaults to BUFFER's category table.
3831 */
3832        (position, designator, buffer, category_table))
3833 {
3834   Lisp_Object ctbl;
3835   Emchar ch;
3836   unsigned int des;
3837   struct buffer *buf = decode_buffer (buffer, 0);
3838
3839   CHECK_INT (position);
3840   CHECK_CATEGORY_DESIGNATOR (designator);
3841   des = XCHAR (designator);
3842   ctbl = check_category_table (category_table, Vstandard_category_table);
3843   ch = BUF_FETCH_CHAR (buf, XINT (position));
3844   return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3845 }
3846
3847 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
3848 Return t if category of CHARACTER includes DESIGNATOR, else nil.
3849 Optional third arg CATEGORY-TABLE specifies the category table to use,
3850 and defaults to the standard category table.
3851 */
3852        (character, designator, category_table))
3853 {
3854   Lisp_Object ctbl;
3855   Emchar ch;
3856   unsigned int des;
3857
3858   CHECK_CATEGORY_DESIGNATOR (designator);
3859   des = XCHAR (designator);
3860   CHECK_CHAR (character);
3861   ch = XCHAR (character);
3862   ctbl = check_category_table (category_table, Vstandard_category_table);
3863   return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3864 }
3865
3866 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
3867 Return BUFFER's current category table.
3868 BUFFER defaults to the current buffer.
3869 */
3870        (buffer))
3871 {
3872   return decode_buffer (buffer, 0)->category_table;
3873 }
3874
3875 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3876 Return the standard category table.
3877 This is the one used for new buffers.
3878 */
3879        ())
3880 {
3881   return Vstandard_category_table;
3882 }
3883
3884 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
3885 Return a new category table which is a copy of CATEGORY-TABLE.
3886 CATEGORY-TABLE defaults to the standard category table.
3887 */
3888        (category_table))
3889 {
3890   if (NILP (Vstandard_category_table))
3891     return Fmake_char_table (Qcategory);
3892
3893   category_table =
3894     check_category_table (category_table, Vstandard_category_table);
3895   return Fcopy_char_table (category_table);
3896 }
3897
3898 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
3899 Select CATEGORY-TABLE as the new category table for BUFFER.
3900 BUFFER defaults to the current buffer if omitted.
3901 */
3902        (category_table, buffer))
3903 {
3904   struct buffer *buf = decode_buffer (buffer, 0);
3905   category_table = check_category_table (category_table, Qnil);
3906   buf->category_table = category_table;
3907   /* Indicate that this buffer now has a specified category table.  */
3908   buf->local_var_flags |= XINT (buffer_local_flags.category_table);
3909   return category_table;
3910 }
3911
3912 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
3913 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
3914 */
3915        (object))
3916 {
3917   return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
3918 }
3919
3920 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
3921 Return t if OBJECT is a category table value.
3922 Valid values are nil or a bit vector of size 95.
3923 */
3924        (object))
3925 {
3926   return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
3927 }
3928
3929
3930 #define CATEGORYP(x) \
3931   (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3932
3933 #define CATEGORY_SET(c)                                         \
3934   (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
3935
3936 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3937    The faster version of `!NILP (Faref (category_set, category))'.  */
3938 #define CATEGORY_MEMBER(category, category_set)                 \
3939   (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
3940
3941 /* Return 1 if there is a word boundary between two word-constituent
3942    characters C1 and C2 if they appear in this order, else return 0.
3943    Use the macro WORD_BOUNDARY_P instead of calling this function
3944    directly.  */
3945
3946 int word_boundary_p (Emchar c1, Emchar c2);
3947 int
3948 word_boundary_p (Emchar c1, Emchar c2)
3949 {
3950   Lisp_Object category_set1, category_set2;
3951   Lisp_Object tail;
3952   int default_result;
3953
3954 #if 0
3955   if (COMPOSITE_CHAR_P (c1))
3956     c1 = cmpchar_component (c1, 0, 1);
3957   if (COMPOSITE_CHAR_P (c2))
3958     c2 = cmpchar_component (c2, 0, 1);
3959 #endif
3960
3961   if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
3962     {
3963       tail = Vword_separating_categories;
3964       default_result = 0;
3965     }
3966   else
3967     {
3968       tail = Vword_combining_categories;
3969       default_result = 1;
3970     }
3971
3972   category_set1 = CATEGORY_SET (c1);
3973   if (NILP (category_set1))
3974     return default_result;
3975   category_set2 = CATEGORY_SET (c2);
3976   if (NILP (category_set2))
3977     return default_result;
3978
3979   for (; CONSP (tail); tail = XCONS (tail)->cdr)
3980     {
3981       Lisp_Object elt = XCONS(tail)->car;
3982
3983       if (CONSP (elt)
3984           && CATEGORYP (XCONS (elt)->car)
3985           && CATEGORYP (XCONS (elt)->cdr)
3986           && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
3987           && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
3988         return !default_result;
3989     }
3990   return default_result;
3991 }
3992 #endif /* MULE */
3993
3994 \f
3995 void
3996 syms_of_chartab (void)
3997 {
3998 #ifdef UTF2000
3999   INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4000   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4001   INIT_LRECORD_IMPLEMENTATION (byte_table);
4002
4003   defsymbol (&Qsystem_char_id,          "system-char-id");
4004
4005   defsymbol (&Qto_ucs,                  "=>ucs");
4006   defsymbol (&Q_ucs,                    "->ucs");
4007   defsymbol (&Q_ucs_variants,           "->ucs-variants");
4008   defsymbol (&Q_decomposition,          "->decomposition");
4009   defsymbol (&Qcompat,                  "compat");
4010   defsymbol (&Qisolated,                "isolated");
4011   defsymbol (&Qinitial,                 "initial");
4012   defsymbol (&Qmedial,                  "medial");
4013   defsymbol (&Qfinal,                   "final");
4014   defsymbol (&Qvertical,                "vertical");
4015   defsymbol (&QnoBreak,                 "noBreak");
4016   defsymbol (&Qfraction,                "fraction");
4017   defsymbol (&Qsuper,                   "super");
4018   defsymbol (&Qsub,                     "sub");
4019   defsymbol (&Qcircle,                  "circle");
4020   defsymbol (&Qsquare,                  "square");
4021   defsymbol (&Qwide,                    "wide");
4022   defsymbol (&Qnarrow,                  "narrow");
4023   defsymbol (&Qsmall,                   "small");
4024   defsymbol (&Qfont,                    "font");
4025
4026   DEFSUBR (Fchar_attribute_list);
4027   DEFSUBR (Ffind_char_attribute_table);
4028   defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4029   DEFSUBR (Fput_char_table_map_function);
4030   DEFSUBR (Fsave_char_attribute_table);
4031   DEFSUBR (Freset_char_attribute_table);
4032 #ifdef HAVE_DATABASE
4033   defsymbol (&Qload_char_attribute_table_map_function,
4034              "load-char-attribute-table-map-function");
4035   DEFSUBR (Fload_char_attribute_table_map_function);
4036 #endif
4037   DEFSUBR (Fload_char_attribute_table);
4038   DEFSUBR (Fchar_attribute_alist);
4039   DEFSUBR (Fget_char_attribute);
4040   DEFSUBR (Fput_char_attribute);
4041   DEFSUBR (Fremove_char_attribute);
4042   DEFSUBR (Fmap_char_attribute);
4043   DEFSUBR (Fdefine_char);
4044   DEFSUBR (Ffind_char);
4045   DEFSUBR (Fchar_variants);
4046
4047   DEFSUBR (Fget_composite_char);
4048 #endif
4049
4050   INIT_LRECORD_IMPLEMENTATION (char_table);
4051
4052 #ifdef MULE
4053 #ifndef UTF2000
4054   INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4055 #endif
4056
4057   defsymbol (&Qcategory_table_p, "category-table-p");
4058   defsymbol (&Qcategory_designator_p, "category-designator-p");
4059   defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4060 #endif /* MULE */
4061
4062   defsymbol (&Qchar_table, "char-table");
4063   defsymbol (&Qchar_tablep, "char-table-p");
4064
4065   DEFSUBR (Fchar_table_p);
4066   DEFSUBR (Fchar_table_type_list);
4067   DEFSUBR (Fvalid_char_table_type_p);
4068   DEFSUBR (Fchar_table_type);
4069   DEFSUBR (Freset_char_table);
4070   DEFSUBR (Fmake_char_table);
4071   DEFSUBR (Fcopy_char_table);
4072   DEFSUBR (Fget_char_table);
4073   DEFSUBR (Fget_range_char_table);
4074   DEFSUBR (Fvalid_char_table_value_p);
4075   DEFSUBR (Fcheck_valid_char_table_value);
4076   DEFSUBR (Fput_char_table);
4077   DEFSUBR (Fmap_char_table);
4078
4079 #ifdef MULE
4080   DEFSUBR (Fcategory_table_p);
4081   DEFSUBR (Fcategory_table);
4082   DEFSUBR (Fstandard_category_table);
4083   DEFSUBR (Fcopy_category_table);
4084   DEFSUBR (Fset_category_table);
4085   DEFSUBR (Fcheck_category_at);
4086   DEFSUBR (Fchar_in_category_p);
4087   DEFSUBR (Fcategory_designator_p);
4088   DEFSUBR (Fcategory_table_value_p);
4089 #endif /* MULE */
4090
4091 }
4092
4093 void
4094 vars_of_chartab (void)
4095 {
4096 #ifdef UTF2000
4097   staticpro (&Vcharacter_composition_table);
4098   Vcharacter_composition_table = make_char_id_table (Qnil);
4099
4100   staticpro (&Vcharacter_variant_table);
4101   Vcharacter_variant_table = make_char_id_table (Qunbound);
4102 #endif
4103   /* DO NOT staticpro this.  It works just like Vweak_hash_tables. */
4104   Vall_syntax_tables = Qnil;
4105   dump_add_weak_object_chain (&Vall_syntax_tables);
4106 }
4107
4108 void
4109 structure_type_create_chartab (void)
4110 {
4111   struct structure_type *st;
4112
4113   st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4114
4115   define_structure_type_keyword (st, Qtype, chartab_type_validate);
4116   define_structure_type_keyword (st, Qdata, chartab_data_validate);
4117 }
4118
4119 void
4120 complex_vars_of_chartab (void)
4121 {
4122 #ifdef UTF2000
4123   staticpro (&Vchar_attribute_hash_table);
4124   Vchar_attribute_hash_table
4125     = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4126 #ifdef HAVE_DATABASE
4127   Fputhash (Q_ucs_variants, Vcharacter_variant_table,
4128             Vchar_attribute_hash_table);
4129   XCHAR_TABLE_NAME (Vcharacter_variant_table) = Q_ucs_variants;
4130 #endif /* HAVE_DATABASE */
4131 #endif /* UTF2000 */
4132 #ifdef MULE
4133   /* Set this now, so first buffer creation can refer to it. */
4134   /* Make it nil before calling copy-category-table
4135      so that copy-category-table will know not to try to copy from garbage */
4136   Vstandard_category_table = Qnil;
4137   Vstandard_category_table = Fcopy_category_table (Qnil);
4138   staticpro (&Vstandard_category_table);
4139
4140   DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4141 List of pair (cons) of categories to determine word boundary.
4142
4143 Emacs treats a sequence of word constituent characters as a single
4144 word (i.e. finds no word boundary between them) iff they belongs to
4145 the same charset.  But, exceptions are allowed in the following cases.
4146
4147 \(1) The case that characters are in different charsets is controlled
4148 by the variable `word-combining-categories'.
4149
4150 Emacs finds no word boundary between characters of different charsets
4151 if they have categories matching some element of this list.
4152
4153 More precisely, if an element of this list is a cons of category CAT1
4154 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4155 C2 which has CAT2, there's no word boundary between C1 and C2.
4156
4157 For instance, to tell that ASCII characters and Latin-1 characters can
4158 form a single word, the element `(?l . ?l)' should be in this list
4159 because both characters have the category `l' (Latin characters).
4160
4161 \(2) The case that character are in the same charset is controlled by
4162 the variable `word-separating-categories'.
4163
4164 Emacs find a word boundary between characters of the same charset
4165 if they have categories matching some element of this list.
4166
4167 More precisely, if an element of this list is a cons of category CAT1
4168 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4169 C2 which has CAT2, there's a word boundary between C1 and C2.
4170
4171 For instance, to tell that there's a word boundary between Japanese
4172 Hiragana and Japanese Kanji (both are in the same charset), the
4173 element `(?H . ?C) should be in this list.
4174 */ );
4175
4176   Vword_combining_categories = Qnil;
4177
4178   DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4179 List of pair (cons) of categories to determine word boundary.
4180 See the documentation of the variable `word-combining-categories'.
4181 */ );
4182
4183   Vword_separating_categories = Qnil;
4184 #endif /* MULE */
4185 }