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