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