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