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