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

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