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