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

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