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