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