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