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