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