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

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