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

   1 /* XEmacs routines to deal with char tables.
   2    Copyright (C) 1992, 1995 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Sun Microsystems, Inc.
   4    Copyright (C) 1995, 1996 Ben Wing.
   5    Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
   6    Licensed to the Free Software Foundation.
   7    Copyright (C) 1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko
   8
   9 This file is part of XEmacs.
  10
  11 XEmacs is free software; you can redistribute it and/or modify it
  12 under the terms of the GNU General Public License as published by the
  13 Free Software Foundation; either version 2, or (at your option) any
  14 later version.
  15
  16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  18 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  19 for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with XEmacs; see the file COPYING.  If not, write to
  23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 Boston, MA 02111-1307, USA.  */
  25
  26 /* Synched up with: Mule 2.3.  Not synched with FSF.
  27
  28    This file was written independently of the FSF implementation,
  29    and is not compatible. */
  30
  31 /* Authorship:
  32
  33    Ben Wing: wrote, for 19.13 (Mule).  Some category table stuff
  34              loosely based on the original Mule.
  35    Jareth Hein: fixed a couple of bugs in the implementation, and
  36              added regex support for categories with check_category_at
  37    MORIOKA Tomohiko: Rewritten for XEmacs CHISE
  38  */
  39
  40 #include <config.h>
  41 #include "lisp.h"
  42
  43 #include "buffer.h"
  44 #include "chartab.h"
  45 #include "syntax.h"
  46 #ifdef UTF2000
  47 #include "elhash.h"
  48 #endif /* UTF2000 */
  49
  50 Lisp_Object Qchar_tablep, Qchar_table;
  51
  52 Lisp_Object Vall_syntax_tables;
  53
  54 #ifdef MULE
  55 Lisp_Object Qcategory_table_p;
  56 Lisp_Object Qcategory_designator_p;
  57 Lisp_Object Qcategory_table_value_p;
  58
  59 Lisp_Object Vstandard_category_table;
  60
  61 /* Variables to determine word boundary.  */
  62 Lisp_Object Vword_combining_categories, Vword_separating_categories;
  63 #endif /* MULE */
  64
  65 \f
  66 #ifdef HAVE_LIBCHISE
  67 Lisp_Object Vchise_db_directory;
  68 Lisp_Object Vchise_system_db_directory;
  69
  70 CHISE_DS *default_chise_data_source = NULL;
  71 #endif
  72
  73 #ifdef UTF2000
  74
  75 EXFUN (Fchar_refs_simplify_char_specs, 1);
  76 extern Lisp_Object Qideographic_structure;
  77
  78 Lisp_Object Vnext_defined_char_id;
  79 EXFUN (Fdefine_char, 1);
  80
  81 EXFUN (Fmap_char_attribute, 3);
  82
  83 #ifdef HAVE_LIBCHISE
  84 EXFUN (Fmount_char_attribute_table, 1);
  85 #endif
  86
  87 #ifdef HAVE_CHISE
  88 EXFUN (Fload_char_attribute_table, 1);
  89
  90 Lisp_Object Vchar_db_stingy_mode;
  91 #endif
  92
  93 #define BT_UINT8_MIN            0
  94 #define BT_UINT8_MAX            (UCHAR_MAX - 4)
  95 #define BT_UINT8_t              (UCHAR_MAX - 3)
  96 #define BT_UINT8_nil            (UCHAR_MAX - 2)
  97 #define BT_UINT8_unbound        (UCHAR_MAX - 1)
  98 #define BT_UINT8_unloaded       UCHAR_MAX
  99
 100 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
 101 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
 102 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
 103 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
 104 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
 105
 106 INLINE_HEADER int
 107 INT_UINT8_P (Lisp_Object obj)
 108 {
 109   if (INTP (obj))
 110     {
 111       int num = XINT (obj);
 112
 113       return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
 114     }
 115   else
 116     return 0;
 117 }
 118
 119 INLINE_HEADER int
 120 UINT8_VALUE_P (Lisp_Object obj)
 121 {
 122   return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
 123     || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
 124 }
 125
 126 INLINE_HEADER unsigned char
 127 UINT8_ENCODE (Lisp_Object obj)
 128 {
 129   if (EQ (obj, Qunloaded))
 130     return BT_UINT8_unloaded;
 131   else if (EQ (obj, Qunbound))
 132     return BT_UINT8_unbound;
 133   else if (EQ (obj, Qnil))
 134     return BT_UINT8_nil;
 135   else if (EQ (obj, Qt))
 136     return BT_UINT8_t;
 137   else
 138     return XINT (obj);
 139 }
 140
 141 INLINE_HEADER Lisp_Object
 142 UINT8_DECODE (unsigned char n)
 143 {
 144   if (n == BT_UINT8_unloaded)
 145     return Qunloaded;
 146   else if (n == BT_UINT8_unbound)
 147     return Qunbound;
 148   else if (n == BT_UINT8_nil)
 149     return Qnil;
 150   else if (n == BT_UINT8_t)
 151     return Qt;
 152   else
 153     return make_int (n);
 154 }
 155
 156 static Lisp_Object
 157 mark_uint8_byte_table (Lisp_Object obj)
 158 {
 159   return Qnil;
 160 }
 161
 162 static void
 163 print_uint8_byte_table (Lisp_Object obj,
 164                         Lisp_Object printcharfun, int escapeflag)
 165 {
 166   Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
 167   int i;
 168   struct gcpro gcpro1, gcpro2;
 169   GCPRO2 (obj, printcharfun);
 170
 171   write_c_string ("\n#<uint8-byte-table", printcharfun);
 172   for (i = 0; i < 256; i++)
 173     {
 174       unsigned char n = bte->property[i];
 175       if ( (i & 15) == 0 )
 176         write_c_string ("\n  ", printcharfun);
 177       write_c_string (" ", printcharfun);
 178       if (n == BT_UINT8_unbound)
 179         write_c_string ("void", printcharfun);
 180       else if (n == BT_UINT8_nil)
 181         write_c_string ("nil", printcharfun);
 182       else if (n == BT_UINT8_t)
 183         write_c_string ("t", printcharfun);
 184       else
 185         {
 186           char buf[4];
 187
 188           sprintf (buf, "%hd", n);
 189           write_c_string (buf, printcharfun);
 190         }
 191     }
 192   UNGCPRO;
 193   write_c_string (">", printcharfun);
 194 }
 195
 196 static int
 197 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 198 {
 199   Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
 200   Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
 201   int i;
 202
 203   for (i = 0; i < 256; i++)
 204     if (te1->property[i] != te2->property[i])
 205       return 0;
 206   return 1;
 207 }
 208
 209 static unsigned long
 210 uint8_byte_table_hash (Lisp_Object obj, int depth)
 211 {
 212   Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
 213   int i;
 214   hashcode_t hash = 0;
 215
 216   for (i = 0; i < 256; i++)
 217     hash = HASH2 (hash, te->property[i]);
 218   return hash;
 219 }
 220
 221 static const struct lrecord_description uint8_byte_table_description[] = {
 222   { XD_END }
 223 };
 224
 225 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
 226                                mark_uint8_byte_table,
 227                                print_uint8_byte_table,
 228                                0, uint8_byte_table_equal,
 229                                uint8_byte_table_hash,
 230                                uint8_byte_table_description,
 231                                Lisp_Uint8_Byte_Table);
 232
 233 static Lisp_Object
 234 make_uint8_byte_table (unsigned char initval)
 235 {
 236   Lisp_Object obj;
 237   int i;
 238   Lisp_Uint8_Byte_Table *cte;
 239
 240   cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
 241                              &lrecord_uint8_byte_table);
 242
 243   for (i = 0; i < 256; i++)
 244     cte->property[i] = initval;
 245
 246   XSETUINT8_BYTE_TABLE (obj, cte);
 247   return obj;
 248 }
 249
 250 static Lisp_Object
 251 copy_uint8_byte_table (Lisp_Object entry)
 252 {
 253   Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
 254   Lisp_Object obj;
 255   int i;
 256   Lisp_Uint8_Byte_Table *ctenew
 257     = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
 258                            &lrecord_uint8_byte_table);
 259
 260   for (i = 0; i < 256; i++)
 261     {
 262       ctenew->property[i] = cte->property[i];
 263     }
 264
 265   XSETUINT8_BYTE_TABLE (obj, ctenew);
 266   return obj;
 267 }
 268
 269 static int
 270 uint8_byte_table_same_value_p (Lisp_Object obj)
 271 {
 272   Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
 273   unsigned char v0 = bte->property[0];
 274   int i;
 275
 276   for (i = 1; i < 256; i++)
 277     {
 278       if (bte->property[i] != v0)
 279         return 0;
 280     }
 281   return -1;
 282 }
 283
 284 static int
 285 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
 286                            Emchar ofs, int place,
 287                            int (*fn) (struct chartab_range *range,
 288                                       Lisp_Object val, void *arg),
 289                            void *arg)
 290 {
 291   struct chartab_range rainj;
 292   int i, retval;
 293   int unit = 1 << (8 * place);
 294   Emchar c = ofs;
 295   Emchar c1;
 296
 297   rainj.type = CHARTAB_RANGE_CHAR;
 298
 299   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 300     {
 301       if (ct->property[i] == BT_UINT8_unloaded)
 302         {
 303 #if 0
 304           c1 = c + unit;
 305           for (; c < c1 && retval == 0; c++)
 306             {
 307               Lisp_Object ret = get_char_id_table (root, c);
 308
 309               if (!UNBOUNDP (ret))
 310                 {
 311                   rainj.ch = c;
 312                   retval = (fn) (&rainj, ret, arg);
 313                 }
 314             }
 315 #else
 316           ct->property[i] = BT_UINT8_unbound;
 317           c += unit;
 318 #endif
 319         }
 320       else if (ct->property[i] != BT_UINT8_unbound)
 321         {
 322           c1 = c + unit;
 323           for (; c < c1 && retval == 0; c++)
 324             {
 325               rainj.ch = c;
 326               retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
 327             }
 328         }
 329       else
 330         c += unit;
 331     }
 332   return retval;
 333 }
 334
 335 #ifdef HAVE_CHISE
 336 static void
 337 save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
 338 #ifdef HAVE_LIBCHISE
 339                        CHISE_Feature feature,
 340 #else
 341                        Lisp_Object db,
 342 #endif
 343                        Emchar ofs, int place,
 344                        Lisp_Object (*filter)(Lisp_Object value))
 345 {
 346   struct chartab_range rainj;
 347   int i, retval;
 348   int unit = 1 << (8 * place);
 349   Emchar c = ofs;
 350   Emchar c1;
 351
 352   rainj.type = CHARTAB_RANGE_CHAR;
 353
 354   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 355     {
 356       if (ct->property[i] == BT_UINT8_unloaded)
 357         {
 358           c1 = c + unit;
 359         }
 360       else if (ct->property[i] != BT_UINT8_unbound)
 361         {
 362           c1 = c + unit;
 363           for (; c < c1 && retval == 0; c++)
 364             {
 365 #ifdef HAVE_LIBCHISE
 366               chise_char_set_feature_value
 367                 (c, feature,
 368                  XSTRING_DATA
 369                  (Fprin1_to_string (UINT8_DECODE (ct->property[i]),
 370                                     Qnil)));
 371 #else
 372               Fput_database (Fprin1_to_string (make_char (c), Qnil),
 373                              Fprin1_to_string (UINT8_DECODE (ct->property[i]),
 374                                                Qnil),
 375                              db, Qt);
 376 #endif
 377             }
 378         }
 379       else
 380         c += unit;
 381     }
 382 }
 383 #endif
 384
 385 #define BT_UINT16_MIN           0
 386 #define BT_UINT16_MAX           (USHRT_MAX - 4)
 387 #define BT_UINT16_t             (USHRT_MAX - 3)
 388 #define BT_UINT16_nil           (USHRT_MAX - 2)
 389 #define BT_UINT16_unbound       (USHRT_MAX - 1)
 390 #define BT_UINT16_unloaded      USHRT_MAX
 391
 392 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
 393 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
 394 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
 395 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
 396
 397 INLINE_HEADER int
 398 INT_UINT16_P (Lisp_Object obj)
 399 {
 400   if (INTP (obj))
 401     {
 402       int num = XINT (obj);
 403
 404       return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
 405     }
 406   else
 407     return 0;
 408 }
 409
 410 INLINE_HEADER int
 411 UINT16_VALUE_P (Lisp_Object obj)
 412 {
 413   return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
 414     || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
 415 }
 416
 417 INLINE_HEADER unsigned short
 418 UINT16_ENCODE (Lisp_Object obj)
 419 {
 420   if (EQ (obj, Qunloaded))
 421     return BT_UINT16_unloaded;
 422   else if (EQ (obj, Qunbound))
 423     return BT_UINT16_unbound;
 424   else if (EQ (obj, Qnil))
 425     return BT_UINT16_nil;
 426   else if (EQ (obj, Qt))
 427     return BT_UINT16_t;
 428   else
 429     return XINT (obj);
 430 }
 431
 432 INLINE_HEADER Lisp_Object
 433 UINT16_DECODE (unsigned short n)
 434 {
 435   if (n == BT_UINT16_unloaded)
 436     return Qunloaded;
 437   else if (n == BT_UINT16_unbound)
 438     return Qunbound;
 439   else if (n == BT_UINT16_nil)
 440     return Qnil;
 441   else if (n == BT_UINT16_t)
 442     return Qt;
 443   else
 444     return make_int (n);
 445 }
 446
 447 INLINE_HEADER unsigned short
 448 UINT8_TO_UINT16 (unsigned char n)
 449 {
 450   if (n == BT_UINT8_unloaded)
 451     return BT_UINT16_unloaded;
 452   else if (n == BT_UINT8_unbound)
 453     return BT_UINT16_unbound;
 454   else if (n == BT_UINT8_nil)
 455     return BT_UINT16_nil;
 456   else if (n == BT_UINT8_t)
 457     return BT_UINT16_t;
 458   else
 459     return n;
 460 }
 461
 462 static Lisp_Object
 463 mark_uint16_byte_table (Lisp_Object obj)
 464 {
 465   return Qnil;
 466 }
 467
 468 static void
 469 print_uint16_byte_table (Lisp_Object obj,
 470                          Lisp_Object printcharfun, int escapeflag)
 471 {
 472   Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
 473   int i;
 474   struct gcpro gcpro1, gcpro2;
 475   GCPRO2 (obj, printcharfun);
 476
 477   write_c_string ("\n#<uint16-byte-table", printcharfun);
 478   for (i = 0; i < 256; i++)
 479     {
 480       unsigned short n = bte->property[i];
 481       if ( (i & 15) == 0 )
 482         write_c_string ("\n  ", printcharfun);
 483       write_c_string (" ", printcharfun);
 484       if (n == BT_UINT16_unbound)
 485         write_c_string ("void", printcharfun);
 486       else if (n == BT_UINT16_nil)
 487         write_c_string ("nil", printcharfun);
 488       else if (n == BT_UINT16_t)
 489         write_c_string ("t", printcharfun);
 490       else
 491         {
 492           char buf[7];
 493
 494           sprintf (buf, "%hd", n);
 495           write_c_string (buf, printcharfun);
 496         }
 497     }
 498   UNGCPRO;
 499   write_c_string (">", printcharfun);
 500 }
 501
 502 static int
 503 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 504 {
 505   Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
 506   Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
 507   int i;
 508
 509   for (i = 0; i < 256; i++)
 510     if (te1->property[i] != te2->property[i])
 511       return 0;
 512   return 1;
 513 }
 514
 515 static unsigned long
 516 uint16_byte_table_hash (Lisp_Object obj, int depth)
 517 {
 518   Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
 519   int i;
 520   hashcode_t hash = 0;
 521
 522   for (i = 0; i < 256; i++)
 523     hash = HASH2 (hash, te->property[i]);
 524   return hash;
 525 }
 526
 527 static const struct lrecord_description uint16_byte_table_description[] = {
 528   { XD_END }
 529 };
 530
 531 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
 532                                mark_uint16_byte_table,
 533                                print_uint16_byte_table,
 534                                0, uint16_byte_table_equal,
 535                                uint16_byte_table_hash,
 536                                uint16_byte_table_description,
 537                                Lisp_Uint16_Byte_Table);
 538
 539 static Lisp_Object
 540 make_uint16_byte_table (unsigned short initval)
 541 {
 542   Lisp_Object obj;
 543   int i;
 544   Lisp_Uint16_Byte_Table *cte;
 545
 546   cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
 547                              &lrecord_uint16_byte_table);
 548
 549   for (i = 0; i < 256; i++)
 550     cte->property[i] = initval;
 551
 552   XSETUINT16_BYTE_TABLE (obj, cte);
 553   return obj;
 554 }
 555
 556 static Lisp_Object
 557 copy_uint16_byte_table (Lisp_Object entry)
 558 {
 559   Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
 560   Lisp_Object obj;
 561   int i;
 562   Lisp_Uint16_Byte_Table *ctenew
 563     = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
 564                            &lrecord_uint16_byte_table);
 565
 566   for (i = 0; i < 256; i++)
 567     {
 568       ctenew->property[i] = cte->property[i];
 569     }
 570
 571   XSETUINT16_BYTE_TABLE (obj, ctenew);
 572   return obj;
 573 }
 574
 575 static Lisp_Object
 576 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
 577 {
 578   Lisp_Object obj;
 579   int i;
 580   Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
 581   Lisp_Uint16_Byte_Table* cte;
 582
 583   cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
 584                              &lrecord_uint16_byte_table);
 585   for (i = 0; i < 256; i++)
 586     {
 587       cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
 588     }
 589   XSETUINT16_BYTE_TABLE (obj, cte);
 590   return obj;
 591 }
 592
 593 static int
 594 uint16_byte_table_same_value_p (Lisp_Object obj)
 595 {
 596   Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
 597   unsigned short v0 = bte->property[0];
 598   int i;
 599
 600   for (i = 1; i < 256; i++)
 601     {
 602       if (bte->property[i] != v0)
 603         return 0;
 604     }
 605   return -1;
 606 }
 607
 608 static int
 609 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
 610                             Emchar ofs, int place,
 611                             int (*fn) (struct chartab_range *range,
 612                                        Lisp_Object val, void *arg),
 613                             void *arg)
 614 {
 615   struct chartab_range rainj;
 616   int i, retval;
 617   int unit = 1 << (8 * place);
 618   Emchar c = ofs;
 619   Emchar c1;
 620
 621   rainj.type = CHARTAB_RANGE_CHAR;
 622
 623   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 624     {
 625       if (ct->property[i] == BT_UINT16_unloaded)
 626         {
 627 #if 0
 628           c1 = c + unit;
 629           for (; c < c1 && retval == 0; c++)
 630             {
 631               Lisp_Object ret = get_char_id_table (root, c);
 632
 633               if (!UNBOUNDP (ret))
 634                 {
 635                   rainj.ch = c;
 636                   retval = (fn) (&rainj, ret, arg);
 637                 }
 638             }
 639 #else
 640           ct->property[i] = BT_UINT16_unbound;
 641           c += unit;
 642 #endif
 643         }
 644       else if (ct->property[i] != BT_UINT16_unbound)
 645         {
 646           c1 = c + unit;
 647           for (; c < c1 && retval == 0; c++)
 648             {
 649               rainj.ch = c;
 650               retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
 651             }
 652         }
 653       else
 654         c += unit;
 655     }
 656   return retval;
 657 }
 658
 659 #ifdef HAVE_CHISE
 660 static void
 661 save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
 662 #ifdef HAVE_LIBCHISE
 663                         CHISE_Feature feature,
 664 #else
 665                         Lisp_Object db,
 666 #endif
 667                         Emchar ofs, int place,
 668                         Lisp_Object (*filter)(Lisp_Object value))
 669 {
 670   struct chartab_range rainj;
 671   int i, retval;
 672   int unit = 1 << (8 * place);
 673   Emchar c = ofs;
 674   Emchar c1;
 675
 676   rainj.type = CHARTAB_RANGE_CHAR;
 677
 678   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 679     {
 680       if (ct->property[i] == BT_UINT16_unloaded)
 681         {
 682           c1 = c + unit;
 683         }
 684       else if (ct->property[i] != BT_UINT16_unbound)
 685         {
 686           c1 = c + unit;
 687           for (; c < c1 && retval == 0; c++)
 688             {
 689 #ifdef HAVE_LIBCHISE
 690               chise_char_set_feature_value
 691                 (c, feature,
 692                  XSTRING_DATA
 693                  (Fprin1_to_string (UINT16_DECODE (ct->property[i]),
 694                                     Qnil)));
 695 #else
 696               Fput_database (Fprin1_to_string (make_char (c), Qnil),
 697                              Fprin1_to_string (UINT16_DECODE (ct->property[i]),
 698                                                Qnil),
 699                              db, Qt);
 700 #endif
 701             }
 702         }
 703       else
 704         c += unit;
 705     }
 706 }
 707 #endif
 708
 709
 710 static Lisp_Object
 711 mark_byte_table (Lisp_Object obj)
 712 {
 713   Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
 714   int i;
 715
 716   for (i = 0; i < 256; i++)
 717     {
 718       mark_object (cte->property[i]);
 719     }
 720   return Qnil;
 721 }
 722
 723 static void
 724 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 725 {
 726   Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
 727   int i;
 728   struct gcpro gcpro1, gcpro2;
 729   GCPRO2 (obj, printcharfun);
 730
 731   write_c_string ("\n#<byte-table", printcharfun);
 732   for (i = 0; i < 256; i++)
 733     {
 734       Lisp_Object elt = bte->property[i];
 735       if ( (i & 15) == 0 )
 736         write_c_string ("\n  ", printcharfun);
 737       write_c_string (" ", printcharfun);
 738       if (EQ (elt, Qunbound))
 739         write_c_string ("void", printcharfun);
 740       else
 741         print_internal (elt, printcharfun, escapeflag);
 742     }
 743   UNGCPRO;
 744   write_c_string (">", printcharfun);
 745 }
 746
 747 static int
 748 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 749 {
 750   Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
 751   Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
 752   int i;
 753
 754   for (i = 0; i < 256; i++)
 755     if (BYTE_TABLE_P (cte1->property[i]))
 756       {
 757         if (BYTE_TABLE_P (cte2->property[i]))
 758           {
 759             if (!byte_table_equal (cte1->property[i],
 760                                    cte2->property[i], depth + 1))
 761               return 0;
 762           }
 763         else
 764           return 0;
 765       }
 766     else
 767       if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
 768         return 0;
 769   return 1;
 770 }
 771
 772 static unsigned long
 773 byte_table_hash (Lisp_Object obj, int depth)
 774 {
 775   Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
 776
 777   return internal_array_hash (cte->property, 256, depth);
 778 }
 779
 780 static const struct lrecord_description byte_table_description[] = {
 781   { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
 782   { XD_END }
 783 };
 784
 785 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
 786                                mark_byte_table,
 787                                print_byte_table,
 788                                0, byte_table_equal,
 789                                byte_table_hash,
 790                                byte_table_description,
 791                                Lisp_Byte_Table);
 792
 793 static Lisp_Object
 794 make_byte_table (Lisp_Object initval)
 795 {
 796   Lisp_Object obj;
 797   int i;
 798   Lisp_Byte_Table *cte;
 799
 800   cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
 801
 802   for (i = 0; i < 256; i++)
 803     cte->property[i] = initval;
 804
 805   XSETBYTE_TABLE (obj, cte);
 806   return obj;
 807 }
 808
 809 static Lisp_Object
 810 copy_byte_table (Lisp_Object entry)
 811 {
 812   Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
 813   Lisp_Object obj;
 814   int i;
 815   Lisp_Byte_Table *ctnew
 816     = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
 817
 818   for (i = 0; i < 256; i++)
 819     {
 820       if (UINT8_BYTE_TABLE_P (cte->property[i]))
 821         {
 822           ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
 823         }
 824       else if (UINT16_BYTE_TABLE_P (cte->property[i]))
 825         {
 826           ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
 827         }
 828       else if (BYTE_TABLE_P (cte->property[i]))
 829         {
 830           ctnew->property[i] = copy_byte_table (cte->property[i]);
 831         }
 832       else
 833         ctnew->property[i] = cte->property[i];
 834     }
 835
 836   XSETBYTE_TABLE (obj, ctnew);
 837   return obj;
 838 }
 839
 840 static int
 841 byte_table_same_value_p (Lisp_Object obj)
 842 {
 843   Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
 844   Lisp_Object v0 = bte->property[0];
 845   int i;
 846
 847   for (i = 1; i < 256; i++)
 848     {
 849       if (!internal_equal (bte->property[i], v0, 0))
 850         return 0;
 851     }
 852   return -1;
 853 }
 854
 855 static int
 856 map_over_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
 857                      Emchar ofs, int place,
 858                      int (*fn) (struct chartab_range *range,
 859                                 Lisp_Object val, void *arg),
 860                      void *arg)
 861 {
 862   int i, retval;
 863   Lisp_Object v;
 864   int unit = 1 << (8 * place);
 865   Emchar c = ofs;
 866
 867   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 868     {
 869       v = ct->property[i];
 870       if (UINT8_BYTE_TABLE_P (v))
 871         {
 872           retval
 873             = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
 874                                          c, place - 1, fn, arg);
 875           c += unit;
 876         }
 877       else if (UINT16_BYTE_TABLE_P (v))
 878         {
 879           retval
 880             = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
 881                                           c, place - 1, fn, arg);
 882           c += unit;
 883         }
 884       else if (BYTE_TABLE_P (v))
 885         {
 886           retval = map_over_byte_table (XBYTE_TABLE(v), root,
 887                                         c, place - 1, fn, arg);
 888           c += unit;
 889         }
 890       else if (EQ (v, Qunloaded))
 891         {
 892 #if 0
 893           struct chartab_range rainj;
 894           Emchar c1 = c + unit;
 895
 896           rainj.type = CHARTAB_RANGE_CHAR;
 897
 898           for (; c < c1 && retval == 0; c++)
 899             {
 900               Lisp_Object ret = get_char_id_table (root, c);
 901
 902               if (!UNBOUNDP (ret))
 903                 {
 904                   rainj.ch = c;
 905                   retval = (fn) (&rainj, ret, arg);
 906                 }
 907             }
 908 #else
 909           ct->property[i] = Qunbound;
 910           c += unit;
 911 #endif
 912         }
 913       else if (!UNBOUNDP (v))
 914         {
 915           struct chartab_range rainj;
 916           Emchar c1 = c + unit;
 917
 918           rainj.type = CHARTAB_RANGE_CHAR;
 919
 920           for (; c < c1 && retval == 0; c++)
 921             {
 922               rainj.ch = c;
 923               retval = (fn) (&rainj, v, arg);
 924             }
 925         }
 926       else
 927         c += unit;
 928     }
 929   return retval;
 930 }
 931
 932 #ifdef HAVE_CHISE
 933 static void
 934 save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
 935 #ifdef HAVE_LIBCHISE
 936                  CHISE_Feature feature,
 937 #else
 938                  Lisp_Object db,
 939 #endif
 940                  Emchar ofs, int place,
 941                  Lisp_Object (*filter)(Lisp_Object value))
 942 {
 943   int i, retval;
 944   Lisp_Object v;
 945   int unit = 1 << (8 * place);
 946   Emchar c = ofs;
 947
 948   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
 949     {
 950       v = ct->property[i];
 951       if (UINT8_BYTE_TABLE_P (v))
 952         {
 953           save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
 954 #ifdef HAVE_LIBCHISE
 955                                  feature,
 956 #else
 957                                  db,
 958 #endif
 959                                  c, place - 1, filter);
 960           c += unit;
 961         }
 962       else if (UINT16_BYTE_TABLE_P (v))
 963         {
 964           save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
 965 #ifdef HAVE_LIBCHISE
 966                                   feature,
 967 #else
 968                                   db,
 969 #endif
 970                                   c, place - 1, filter);
 971           c += unit;
 972         }
 973       else if (BYTE_TABLE_P (v))
 974         {
 975           save_byte_table (XBYTE_TABLE(v), root,
 976 #ifdef HAVE_LIBCHISE
 977                            feature,
 978 #else
 979                            db,
 980 #endif
 981                            c, place - 1, filter);
 982           c += unit;
 983         }
 984       else if (EQ (v, Qunloaded))
 985         {
 986           c += unit;
 987         }
 988       else if (!UNBOUNDP (v))
 989         {
 990           struct chartab_range rainj;
 991           Emchar c1 = c + unit;
 992
 993           if (filter != NULL)
 994             v = (*filter)(v);
 995
 996           rainj.type = CHARTAB_RANGE_CHAR;
 997
 998           for (; c < c1 && retval == 0; c++)
 999             {
1000 #ifdef HAVE_LIBCHISE
1001               chise_char_set_feature_value
1002                 (c, feature, XSTRING_DATA (Fprin1_to_string (v, Qnil)));
1003 #else
1004               Fput_database (Fprin1_to_string (make_char (c), Qnil),
1005                              Fprin1_to_string (v, Qnil),
1006                              db, Qt);
1007 #endif
1008             }
1009         }
1010       else
1011         c += unit;
1012     }
1013 }
1014 #endif
1015
1016 Lisp_Object
1017 get_byte_table (Lisp_Object table, unsigned char idx)
1018 {
1019   if (UINT8_BYTE_TABLE_P (table))
1020     return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
1021   else if (UINT16_BYTE_TABLE_P (table))
1022     return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
1023   else if (BYTE_TABLE_P (table))
1024     return XBYTE_TABLE(table)->property[idx];
1025   else
1026     return table;
1027 }
1028
1029 Lisp_Object
1030 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
1031 {
1032   if (UINT8_BYTE_TABLE_P (table))
1033     {
1034       if (UINT8_VALUE_P (value))
1035         {
1036           XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1037           if (!UINT8_BYTE_TABLE_P (value) &&
1038               !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1039               && uint8_byte_table_same_value_p (table))
1040             {
1041               return value;
1042             }
1043         }
1044       else if (UINT16_VALUE_P (value))
1045         {
1046           Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
1047
1048           XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
1049           return new;
1050         }
1051       else
1052         {
1053           Lisp_Object new = make_byte_table (Qnil);
1054           int i;
1055
1056           for (i = 0; i < 256; i++)
1057             {
1058               XBYTE_TABLE(new)->property[i]
1059                 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
1060             }
1061           XBYTE_TABLE(new)->property[idx] = value;
1062           return new;
1063         }
1064     }
1065   else if (UINT16_BYTE_TABLE_P (table))
1066     {
1067       if (UINT16_VALUE_P (value))
1068         {
1069           XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1070           if (!UINT8_BYTE_TABLE_P (value) &&
1071               !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1072               && uint16_byte_table_same_value_p (table))
1073             {
1074               return value;
1075             }
1076         }
1077       else
1078         {
1079           Lisp_Object new = make_byte_table (Qnil);
1080           int i;
1081
1082           for (i = 0; i < 256; i++)
1083             {
1084               XBYTE_TABLE(new)->property[i]
1085                 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
1086             }
1087           XBYTE_TABLE(new)->property[idx] = value;
1088           return new;
1089         }
1090     }
1091   else if (BYTE_TABLE_P (table))
1092     {
1093       XBYTE_TABLE(table)->property[idx] = value;
1094       if (!UINT8_BYTE_TABLE_P (value) &&
1095           !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1096           && byte_table_same_value_p (table))
1097         {
1098           return value;
1099         }
1100     }
1101   else if (!internal_equal (table, value, 0))
1102     {
1103       if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
1104         {
1105           table = make_uint8_byte_table (UINT8_ENCODE (table));
1106           XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1107         }
1108       else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
1109         {
1110           table = make_uint16_byte_table (UINT16_ENCODE (table));
1111           XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1112         }
1113       else
1114         {
1115           table = make_byte_table (table);
1116           XBYTE_TABLE(table)->property[idx] = value;
1117         }
1118     }
1119   return table;
1120 }
1121
1122
1123 Lisp_Object
1124 make_char_id_table (Lisp_Object initval)
1125 {
1126   Lisp_Object obj;
1127   obj = Fmake_char_table (Qgeneric);
1128   fill_char_table (XCHAR_TABLE (obj), initval);
1129   return obj;
1130 }
1131
1132
1133 #if defined(HAVE_CHISE) && !defined(HAVE_LIBCHISE_LIBCHISE)
1134 Lisp_Object Qsystem_char_id;
1135 #endif
1136
1137 Lisp_Object Qcomposition;
1138 Lisp_Object Q_decomposition;
1139 Lisp_Object Q_identical;
1140 Lisp_Object Q_identical_from;
1141 Lisp_Object Q_denotational;
1142 Lisp_Object Q_denotational_from;
1143 Lisp_Object Q_subsumptive;
1144 Lisp_Object Q_subsumptive_from;
1145 Lisp_Object Q_component;
1146 Lisp_Object Q_component_of;
1147 Lisp_Object Q_same;
1148 Lisp_Object Q_same_of;
1149 Lisp_Object Qto_ucs;
1150 Lisp_Object Q_ucs_unified;
1151 Lisp_Object Qcompat;
1152 Lisp_Object Qisolated;
1153 Lisp_Object Qinitial;
1154 Lisp_Object Qmedial;
1155 Lisp_Object Qfinal;
1156 Lisp_Object Qvertical;
1157 Lisp_Object QnoBreak;
1158 Lisp_Object Qfraction;
1159 Lisp_Object Qsuper;
1160 Lisp_Object Qsub;
1161 Lisp_Object Qcircle;
1162 Lisp_Object Qsquare;
1163 Lisp_Object Qwide;
1164 Lisp_Object Qnarrow;
1165 Lisp_Object Qsmall;
1166 Lisp_Object Qfont;
1167
1168 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1169
1170 Emchar
1171 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1172 {
1173   if (INTP (v))
1174     return XINT (v);
1175   if (CHARP (v))
1176     return XCHAR (v);
1177   else if (EQ (v, Qcompat))
1178     return -1;
1179   else if (EQ (v, Qisolated))
1180     return -2;
1181   else if (EQ (v, Qinitial))
1182     return -3;
1183   else if (EQ (v, Qmedial))
1184     return -4;
1185   else if (EQ (v, Qfinal))
1186     return -5;
1187   else if (EQ (v, Qvertical))
1188     return -6;
1189   else if (EQ (v, QnoBreak))
1190     return -7;
1191   else if (EQ (v, Qfraction))
1192     return -8;
1193   else if (EQ (v, Qsuper))
1194     return -9;
1195   else if (EQ (v, Qsub))
1196     return -10;
1197   else if (EQ (v, Qcircle))
1198     return -11;
1199   else if (EQ (v, Qsquare))
1200     return -12;
1201   else if (EQ (v, Qwide))
1202     return -13;
1203   else if (EQ (v, Qnarrow))
1204     return -14;
1205   else if (EQ (v, Qsmall))
1206     return -15;
1207   else if (EQ (v, Qfont))
1208     return -16;
1209   else
1210     signal_simple_error (err_msg, err_arg);
1211 }
1212
1213 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1214 Return character corresponding with list.
1215 */
1216        (list))
1217 {
1218   Lisp_Object base, modifier;
1219   Lisp_Object rest;
1220
1221   if (!CONSP (list))
1222     signal_simple_error ("Invalid value for composition", list);
1223   base = Fcar (list);
1224   rest = Fcdr (list);
1225   while (!NILP (rest))
1226     {
1227       if (!CHARP (base))
1228         return Qnil;
1229       if (!CONSP (rest))
1230         signal_simple_error ("Invalid value for composition", list);
1231       modifier = Fcar (rest);
1232       rest = Fcdr (rest);
1233       base = Fcdr (Fassq (modifier,
1234                           Fchar_feature (base, Qcomposition, Qnil,
1235                                          Qnil, Qnil)));
1236     }
1237   return base;
1238 }
1239
1240 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1241 Return variants of CHARACTER.
1242 */
1243        (character))
1244 {
1245   Lisp_Object ret;
1246
1247   CHECK_CHAR (character);
1248   ret = Fchar_feature (character, Q_ucs_unified, Qnil,
1249                        Qnil, Qnil);
1250   if (CONSP (ret))
1251     return Fcopy_list (ret);
1252   else
1253     return Qnil;
1254 }
1255
1256 #endif
1257
1258 \f
1259 /* A char table maps from ranges of characters to values.
1260
1261    Implementing a general data structure that maps from arbitrary
1262    ranges of numbers to values is tricky to do efficiently.  As it
1263    happens, it should suffice (and is usually more convenient, anyway)
1264    when dealing with characters to restrict the sorts of ranges that
1265    can be assigned values, as follows:
1266
1267    1) All characters.
1268    2) All characters in a charset.
1269    3) All characters in a particular row of a charset, where a "row"
1270       means all characters with the same first byte.
1271    4) A particular character in a charset.
1272
1273    We use char tables to generalize the 256-element vectors now
1274    littering the Emacs code.
1275
1276    Possible uses (all should be converted at some point):
1277
1278    1) category tables
1279    2) syntax tables
1280    3) display tables
1281    4) case tables
1282    5) keyboard-translate-table?
1283
1284    We provide an
1285    abstract type to generalize the Emacs vectors and Mule
1286    vectors-of-vectors goo.
1287    */
1288
1289 /************************************************************************/
1290 /*                         Char Table object                            */
1291 /************************************************************************/
1292
1293 #if defined(MULE)&&!defined(UTF2000)
1294
1295 static Lisp_Object
1296 mark_char_table_entry (Lisp_Object obj)
1297 {
1298   Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1299   int i;
1300
1301   for (i = 0; i < 96; i++)
1302     {
1303       mark_object (cte->level2[i]);
1304     }
1305   return Qnil;
1306 }
1307
1308 static int
1309 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1310 {
1311   Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1312   Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1313   int i;
1314
1315   for (i = 0; i < 96; i++)
1316     if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1317       return 0;
1318
1319   return 1;
1320 }
1321
1322 static unsigned long
1323 char_table_entry_hash (Lisp_Object obj, int depth)
1324 {
1325   Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1326
1327   return internal_array_hash (cte->level2, 96, depth);
1328 }
1329
1330 static const struct lrecord_description char_table_entry_description[] = {
1331   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1332   { XD_END }
1333 };
1334
1335 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1336                                mark_char_table_entry, internal_object_printer,
1337                                0, char_table_entry_equal,
1338                                char_table_entry_hash,
1339                                char_table_entry_description,
1340                                Lisp_Char_Table_Entry);
1341 #endif /* MULE */
1342
1343 static Lisp_Object
1344 mark_char_table (Lisp_Object obj)
1345 {
1346   Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1347 #ifdef UTF2000
1348
1349   mark_object (ct->table);
1350   mark_object (ct->name);
1351 #ifndef HAVE_LIBCHISE
1352   mark_object (ct->db);
1353 #endif
1354 #else
1355   int i;
1356
1357   for (i = 0; i < NUM_ASCII_CHARS; i++)
1358     mark_object (ct->ascii[i]);
1359 #ifdef MULE
1360   for (i = 0; i < NUM_LEADING_BYTES; i++)
1361     mark_object (ct->level1[i]);
1362 #endif
1363 #endif
1364 #ifdef UTF2000
1365   return ct->default_value;
1366 #else
1367   return ct->mirror_table;
1368 #endif
1369 }
1370
1371 /* WARNING: All functions of this nature need to be written extremely
1372    carefully to avoid crashes during GC.  Cf. prune_specifiers()
1373    and prune_weak_hash_tables(). */
1374
1375 void
1376 prune_syntax_tables (void)
1377 {
1378   Lisp_Object rest, prev = Qnil;
1379
1380   for (rest = Vall_syntax_tables;
1381        !NILP (rest);
1382        rest = XCHAR_TABLE (rest)->next_table)
1383     {
1384       if (! marked_p (rest))
1385         {
1386           /* This table is garbage.  Remove it from the list. */
1387           if (NILP (prev))
1388             Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1389           else
1390             XCHAR_TABLE (prev)->next_table =
1391               XCHAR_TABLE (rest)->next_table;
1392         }
1393     }
1394 }
1395
1396 static Lisp_Object
1397 char_table_type_to_symbol (enum char_table_type type)
1398 {
1399   switch (type)
1400   {
1401   default: abort();
1402   case CHAR_TABLE_TYPE_GENERIC:  return Qgeneric;
1403   case CHAR_TABLE_TYPE_SYNTAX:   return Qsyntax;
1404   case CHAR_TABLE_TYPE_DISPLAY:  return Qdisplay;
1405   case CHAR_TABLE_TYPE_CHAR:     return Qchar;
1406 #ifdef MULE
1407   case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1408 #endif
1409   }
1410 }
1411
1412 static enum char_table_type
1413 symbol_to_char_table_type (Lisp_Object symbol)
1414 {
1415   CHECK_SYMBOL (symbol);
1416
1417   if (EQ (symbol, Qgeneric))  return CHAR_TABLE_TYPE_GENERIC;
1418   if (EQ (symbol, Qsyntax))   return CHAR_TABLE_TYPE_SYNTAX;
1419   if (EQ (symbol, Qdisplay))  return CHAR_TABLE_TYPE_DISPLAY;
1420   if (EQ (symbol, Qchar))     return CHAR_TABLE_TYPE_CHAR;
1421 #ifdef MULE
1422   if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1423 #endif
1424
1425   signal_simple_error ("Unrecognized char table type", symbol);
1426   return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1427 }
1428
1429 #ifndef UTF2000
1430 static void
1431 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1432                      Lisp_Object printcharfun)
1433 {
1434   if (first != last)
1435     {
1436       write_c_string (" (", printcharfun);
1437       print_internal (make_char (first), printcharfun, 0);
1438       write_c_string (" ", printcharfun);
1439       print_internal (make_char (last), printcharfun, 0);
1440       write_c_string (") ", printcharfun);
1441     }
1442   else
1443     {
1444       write_c_string (" ", printcharfun);
1445       print_internal (make_char (first), printcharfun, 0);
1446       write_c_string (" ", printcharfun);
1447     }
1448   print_internal (val, printcharfun, 1);
1449 }
1450 #endif
1451
1452 #if defined(MULE)&&!defined(UTF2000)
1453
1454 static void
1455 print_chartab_charset_row (Lisp_Object charset,
1456                            int row,
1457                            Lisp_Char_Table_Entry *cte,
1458                            Lisp_Object printcharfun)
1459 {
1460   int i;
1461   Lisp_Object cat = Qunbound;
1462   int first = -1;
1463
1464   for (i = 32; i < 128; i++)
1465     {
1466       Lisp_Object pam = cte->level2[i - 32];
1467
1468       if (first == -1)
1469         {
1470           first = i;
1471           cat = pam;
1472           continue;
1473         }
1474
1475       if (!EQ (cat, pam))
1476         {
1477           if (row == -1)
1478             print_chartab_range (MAKE_CHAR (charset, first, 0),
1479                                  MAKE_CHAR (charset, i - 1, 0),
1480                                  cat, printcharfun);
1481           else
1482             print_chartab_range (MAKE_CHAR (charset, row, first),
1483                                  MAKE_CHAR (charset, row, i - 1),
1484                                  cat, printcharfun);
1485           first = -1;
1486           i--;
1487         }
1488     }
1489
1490   if (first != -1)
1491     {
1492       if (row == -1)
1493         print_chartab_range (MAKE_CHAR (charset, first, 0),
1494                              MAKE_CHAR (charset, i - 1, 0),
1495                              cat, printcharfun);
1496       else
1497         print_chartab_range (MAKE_CHAR (charset, row, first),
1498                              MAKE_CHAR (charset, row, i - 1),
1499                              cat, printcharfun);
1500     }
1501 }
1502
1503 static void
1504 print_chartab_two_byte_charset (Lisp_Object charset,
1505                                 Lisp_Char_Table_Entry *cte,
1506                                 Lisp_Object printcharfun)
1507 {
1508   int i;
1509
1510   for (i = 32; i < 128; i++)
1511     {
1512       Lisp_Object jen = cte->level2[i - 32];
1513
1514       if (!CHAR_TABLE_ENTRYP (jen))
1515         {
1516           char buf[100];
1517
1518           write_c_string (" [", printcharfun);
1519           print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1520           sprintf (buf, " %d] ", i);
1521           write_c_string (buf, printcharfun);
1522           print_internal (jen, printcharfun, 0);
1523         }
1524       else
1525         print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1526                                    printcharfun);
1527     }
1528 }
1529
1530 #endif /* MULE */
1531
1532 static void
1533 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1534 {
1535   Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1536 #ifdef UTF2000
1537   int i;
1538   struct gcpro gcpro1, gcpro2;
1539   GCPRO2 (obj, printcharfun);
1540
1541   write_c_string ("#s(char-table ", printcharfun);
1542   write_c_string (" ", printcharfun);
1543   write_c_string (string_data
1544                   (symbol_name
1545                    (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1546                   printcharfun);
1547   write_c_string ("\n ", printcharfun);
1548   print_internal (ct->default_value, printcharfun, escapeflag);
1549   for (i = 0; i < 256; i++)
1550     {
1551       Lisp_Object elt = get_byte_table (ct->table, i);
1552       if (i != 0) write_c_string ("\n  ", printcharfun);
1553       if (EQ (elt, Qunbound))
1554         write_c_string ("void", printcharfun);
1555       else
1556         print_internal (elt, printcharfun, escapeflag);
1557     }
1558   UNGCPRO;
1559 #else /* non UTF2000 */
1560   char buf[200];
1561
1562   sprintf (buf, "#s(char-table type %s data (",
1563            string_data (symbol_name (XSYMBOL
1564                                      (char_table_type_to_symbol (ct->type)))));
1565   write_c_string (buf, printcharfun);
1566
1567   /* Now write out the ASCII/Control-1 stuff. */
1568   {
1569     int i;
1570     int first = -1;
1571     Lisp_Object val = Qunbound;
1572
1573     for (i = 0; i < NUM_ASCII_CHARS; i++)
1574       {
1575         if (first == -1)
1576           {
1577             first = i;
1578             val = ct->ascii[i];
1579             continue;
1580           }
1581
1582         if (!EQ (ct->ascii[i], val))
1583           {
1584             print_chartab_range (first, i - 1, val, printcharfun);
1585             first = -1;
1586             i--;
1587           }
1588       }
1589
1590     if (first != -1)
1591       print_chartab_range (first, i - 1, val, printcharfun);
1592   }
1593
1594 #ifdef MULE
1595   {
1596     Charset_ID i;
1597
1598     for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1599          i++)
1600       {
1601         Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1602         Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1603
1604         if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1605             || i == LEADING_BYTE_CONTROL_1)
1606           continue;
1607         if (!CHAR_TABLE_ENTRYP (ann))
1608           {
1609             write_c_string (" ", printcharfun);
1610             print_internal (XCHARSET_NAME (charset),
1611                             printcharfun, 0);
1612             write_c_string (" ", printcharfun);
1613             print_internal (ann, printcharfun, 0);
1614           }
1615         else
1616           {
1617             Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1618             if (XCHARSET_DIMENSION (charset) == 1)
1619               print_chartab_charset_row (charset, -1, cte, printcharfun);
1620             else
1621               print_chartab_two_byte_charset (charset, cte, printcharfun);
1622           }
1623       }
1624   }
1625 #endif /* MULE */
1626 #endif /* non UTF2000 */
1627
1628   write_c_string ("))", printcharfun);
1629 }
1630
1631 static int
1632 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1633 {
1634   Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1635   Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1636   int i;
1637
1638   if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1639     return 0;
1640
1641 #ifdef UTF2000
1642   for (i = 0; i < 256; i++)
1643     {
1644       if (!internal_equal (get_byte_table (ct1->table, i),
1645                            get_byte_table (ct2->table, i), 0))
1646         return 0;
1647     }
1648 #else
1649   for (i = 0; i < NUM_ASCII_CHARS; i++)
1650     if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1651       return 0;
1652
1653 #ifdef MULE
1654   for (i = 0; i < NUM_LEADING_BYTES; i++)
1655     if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1656       return 0;
1657 #endif /* MULE */
1658 #endif /* non UTF2000 */
1659
1660   return 1;
1661 }
1662
1663 static unsigned long
1664 char_table_hash (Lisp_Object obj, int depth)
1665 {
1666   Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1667 #ifdef UTF2000
1668     return byte_table_hash (ct->table, depth + 1);
1669 #else
1670   unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1671                                                depth);
1672 #ifdef MULE
1673   hashval = HASH2 (hashval,
1674                    internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1675 #endif /* MULE */
1676   return hashval;
1677 #endif
1678 }
1679
1680 static const struct lrecord_description char_table_description[] = {
1681 #ifdef UTF2000
1682   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1683   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1684   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1685 #ifndef HAVE_LIBCHISE
1686   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1687 #endif
1688 #else
1689   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1690 #ifdef MULE
1691   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1692 #endif
1693 #endif
1694 #ifndef UTF2000
1695   { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1696 #endif
1697   { XD_LO_LINK,     offsetof (Lisp_Char_Table, next_table) },
1698   { XD_END }
1699 };
1700
1701 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1702                                mark_char_table, print_char_table, 0,
1703                                char_table_equal, char_table_hash,
1704                                char_table_description,
1705                                Lisp_Char_Table);
1706
1707 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1708 Return non-nil if OBJECT is a char table.
1709
1710 A char table is a table that maps characters (or ranges of characters)
1711 to values.  Char tables are specialized for characters, only allowing
1712 particular sorts of ranges to be assigned values.  Although this
1713 loses in generality, it makes for extremely fast (constant-time)
1714 lookups, and thus is feasible for applications that do an extremely
1715 large number of lookups (e.g. scanning a buffer for a character in
1716 a particular syntax, where a lookup in the syntax table must occur
1717 once per character).
1718
1719 When Mule support exists, the types of ranges that can be assigned
1720 values are
1721
1722 -- all characters
1723 -- an entire charset
1724 -- a single row in a two-octet charset
1725 -- a single character
1726
1727 When Mule support is not present, the types of ranges that can be
1728 assigned values are
1729
1730 -- all characters
1731 -- a single character
1732
1733 To create a char table, use `make-char-table'.
1734 To modify a char table, use `put-char-table' or `remove-char-table'.
1735 To retrieve the value for a particular character, use `get-char-table'.
1736 See also `map-char-table', `clear-char-table', `copy-char-table',
1737 `valid-char-table-type-p', `char-table-type-list',
1738 `valid-char-table-value-p', and `check-char-table-value'.
1739 */
1740        (object))
1741 {
1742   return CHAR_TABLEP (object) ? Qt : Qnil;
1743 }
1744
1745 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1746 Return a list of the recognized char table types.
1747 See `valid-char-table-type-p'.
1748 */
1749        ())
1750 {
1751 #ifdef MULE
1752   return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1753 #else
1754   return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1755 #endif
1756 }
1757
1758 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1759 Return t if TYPE if a recognized char table type.
1760
1761 Each char table type is used for a different purpose and allows different
1762 sorts of values.  The different char table types are
1763
1764 `category'
1765         Used for category tables, which specify the regexp categories
1766         that a character is in.  The valid values are nil or a
1767         bit vector of 95 elements.  Higher-level Lisp functions are
1768         provided for working with category tables.  Currently categories
1769         and category tables only exist when Mule support is present.
1770 `char'
1771         A generalized char table, for mapping from one character to
1772         another.  Used for case tables, syntax matching tables,
1773         `keyboard-translate-table', etc.  The valid values are characters.
1774 `generic'
1775         An even more generalized char table, for mapping from a
1776         character to anything.
1777 `display'
1778         Used for display tables, which specify how a particular character
1779         is to appear when displayed.  #### Not yet implemented.
1780 `syntax'
1781         Used for syntax tables, which specify the syntax of a particular
1782         character.  Higher-level Lisp functions are provided for
1783         working with syntax tables.  The valid values are integers.
1784
1785 */
1786        (type))
1787 {
1788   return (EQ (type, Qchar)     ||
1789 #ifdef MULE
1790           EQ (type, Qcategory) ||
1791 #endif
1792           EQ (type, Qdisplay)  ||
1793           EQ (type, Qgeneric)  ||
1794           EQ (type, Qsyntax)) ? Qt : Qnil;
1795 }
1796
1797 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1798 Return the type of CHAR-TABLE.
1799 See `valid-char-table-type-p'.
1800 */
1801        (char_table))
1802 {
1803   CHECK_CHAR_TABLE (char_table);
1804   return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1805 }
1806
1807 void
1808 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1809 {
1810 #ifdef UTF2000
1811   ct->table = Qunbound;
1812   ct->default_value = value;
1813   ct->unloaded = 0;
1814 #else
1815   int i;
1816
1817   for (i = 0; i < NUM_ASCII_CHARS; i++)
1818     ct->ascii[i] = value;
1819 #ifdef MULE
1820   for (i = 0; i < NUM_LEADING_BYTES; i++)
1821     ct->level1[i] = value;
1822 #endif /* MULE */
1823 #endif
1824
1825 #ifndef UTF2000
1826   if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1827     update_syntax_table (ct);
1828 #endif
1829 }
1830
1831 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1832 Reset CHAR-TABLE to its default state.
1833 */
1834        (char_table))
1835 {
1836   Lisp_Char_Table *ct;
1837
1838   CHECK_CHAR_TABLE (char_table);
1839   ct = XCHAR_TABLE (char_table);
1840
1841   switch (ct->type)
1842     {
1843     case CHAR_TABLE_TYPE_CHAR:
1844       fill_char_table (ct, make_char (0));
1845       break;
1846     case CHAR_TABLE_TYPE_DISPLAY:
1847     case CHAR_TABLE_TYPE_GENERIC:
1848 #ifdef MULE
1849     case CHAR_TABLE_TYPE_CATEGORY:
1850 #endif /* MULE */
1851       fill_char_table (ct, Qnil);
1852       break;
1853
1854     case CHAR_TABLE_TYPE_SYNTAX:
1855       fill_char_table (ct, make_int (Sinherit));
1856       break;
1857
1858     default:
1859       abort ();
1860     }
1861
1862   return Qnil;
1863 }
1864
1865 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1866 Return a new, empty char table of type TYPE.
1867 Currently recognized types are 'char, 'category, 'display, 'generic,
1868 and 'syntax.  See `valid-char-table-type-p'.
1869 */
1870        (type))
1871 {
1872   Lisp_Char_Table *ct;
1873   Lisp_Object obj;
1874   enum char_table_type ty = symbol_to_char_table_type (type);
1875
1876   ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1877   ct->type = ty;
1878 #ifndef UTF2000
1879   if (ty == CHAR_TABLE_TYPE_SYNTAX)
1880     {
1881       ct->mirror_table = Fmake_char_table (Qgeneric);
1882       fill_char_table (XCHAR_TABLE (ct->mirror_table),
1883                        make_int (Spunct));
1884     }
1885   else
1886     ct->mirror_table = Qnil;
1887 #else
1888   ct->name = Qnil;
1889 #ifndef HAVE_LIBCHISE
1890   ct->db = Qnil;
1891 #endif
1892 #endif
1893   ct->next_table = Qnil;
1894   XSETCHAR_TABLE (obj, ct);
1895   if (ty == CHAR_TABLE_TYPE_SYNTAX)
1896     {
1897       ct->next_table = Vall_syntax_tables;
1898       Vall_syntax_tables = obj;
1899     }
1900   Freset_char_table (obj);
1901   return obj;
1902 }
1903
1904 #if defined(MULE)&&!defined(UTF2000)
1905
1906 static Lisp_Object
1907 make_char_table_entry (Lisp_Object initval)
1908 {
1909   Lisp_Object obj;
1910   int i;
1911   Lisp_Char_Table_Entry *cte =
1912     alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1913
1914   for (i = 0; i < 96; i++)
1915     cte->level2[i] = initval;
1916
1917   XSETCHAR_TABLE_ENTRY (obj, cte);
1918   return obj;
1919 }
1920
1921 static Lisp_Object
1922 copy_char_table_entry (Lisp_Object entry)
1923 {
1924   Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1925   Lisp_Object obj;
1926   int i;
1927   Lisp_Char_Table_Entry *ctenew =
1928     alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1929
1930   for (i = 0; i < 96; i++)
1931     {
1932       Lisp_Object new = cte->level2[i];
1933       if (CHAR_TABLE_ENTRYP (new))
1934         ctenew->level2[i] = copy_char_table_entry (new);
1935       else
1936         ctenew->level2[i] = new;
1937     }
1938
1939   XSETCHAR_TABLE_ENTRY (obj, ctenew);
1940   return obj;
1941 }
1942
1943 #endif /* MULE */
1944
1945 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1946 Return a new char table which is a copy of CHAR-TABLE.
1947 It will contain the same values for the same characters and ranges
1948 as CHAR-TABLE.  The values will not themselves be copied.
1949 */
1950        (char_table))
1951 {
1952   Lisp_Char_Table *ct, *ctnew;
1953   Lisp_Object obj;
1954 #ifndef UTF2000
1955   int i;
1956 #endif
1957
1958   CHECK_CHAR_TABLE (char_table);
1959   ct = XCHAR_TABLE (char_table);
1960   ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1961   ctnew->type = ct->type;
1962 #ifdef UTF2000
1963   ctnew->default_value = ct->default_value;
1964   /* [tomo:2002-01-21] Perhaps this code seems wrong */
1965   ctnew->name = ct->name;
1966 #ifndef HAVE_LIBCHISE
1967   ctnew->db = ct->db;
1968 #endif
1969
1970   if (UINT8_BYTE_TABLE_P (ct->table))
1971     {
1972       ctnew->table = copy_uint8_byte_table (ct->table);
1973     }
1974   else if (UINT16_BYTE_TABLE_P (ct->table))
1975     {
1976       ctnew->table = copy_uint16_byte_table (ct->table);
1977     }
1978   else if (BYTE_TABLE_P (ct->table))
1979     {
1980       ctnew->table = copy_byte_table (ct->table);
1981     }
1982   else if (!UNBOUNDP (ct->table))
1983     ctnew->table = ct->table;
1984 #else /* non UTF2000 */
1985
1986   for (i = 0; i < NUM_ASCII_CHARS; i++)
1987     {
1988       Lisp_Object new = ct->ascii[i];
1989 #ifdef MULE
1990       assert (! (CHAR_TABLE_ENTRYP (new)));
1991 #endif /* MULE */
1992       ctnew->ascii[i] = new;
1993     }
1994
1995 #ifdef MULE
1996
1997   for (i = 0; i < NUM_LEADING_BYTES; i++)
1998     {
1999       Lisp_Object new = ct->level1[i];
2000       if (CHAR_TABLE_ENTRYP (new))
2001         ctnew->level1[i] = copy_char_table_entry (new);
2002       else
2003         ctnew->level1[i] = new;
2004     }
2005
2006 #endif /* MULE */
2007 #endif /* non UTF2000 */
2008
2009 #ifndef UTF2000
2010   if (CHAR_TABLEP (ct->mirror_table))
2011     ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
2012   else
2013     ctnew->mirror_table = ct->mirror_table;
2014 #endif
2015   ctnew->next_table = Qnil;
2016   XSETCHAR_TABLE (obj, ctnew);
2017   if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2018     {
2019       ctnew->next_table = Vall_syntax_tables;
2020       Vall_syntax_tables = obj;
2021     }
2022   return obj;
2023 }
2024
2025 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2026 INLINE_HEADER int
2027 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2028 {
2029   switch (XCHARSET_CHARS (ccs))
2030     {
2031     case 94:
2032       return (33 << 8) | 126;
2033     case 96:
2034       return (32 << 8) | 127;
2035 #ifdef UTF2000
2036     case 128:
2037       return (0 << 8) | 127;
2038     case 256:
2039       return (0 << 8) | 255;
2040 #endif
2041     default:
2042       abort ();
2043       return 0;
2044     }
2045 }
2046
2047 #ifndef UTF2000
2048 static
2049 #endif
2050 void
2051 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2052 {
2053   if (EQ (range, Qt))
2054     outrange->type = CHARTAB_RANGE_ALL;
2055 #ifdef UTF2000
2056   else if (EQ (range, Qnil))
2057     outrange->type = CHARTAB_RANGE_DEFAULT;
2058 #endif
2059   else if (CHAR_OR_CHAR_INTP (range))
2060     {
2061       outrange->type = CHARTAB_RANGE_CHAR;
2062       outrange->ch = XCHAR_OR_CHAR_INT (range);
2063     }
2064 #ifndef MULE
2065   else
2066     signal_simple_error ("Range must be t or a character", range);
2067 #else /* MULE */
2068   else if (VECTORP (range))
2069     {
2070       Lisp_Vector *vec = XVECTOR (range);
2071       Lisp_Object *elts = vector_data (vec);
2072       int cell_min, cell_max;
2073
2074       outrange->type = CHARTAB_RANGE_ROW;
2075       outrange->charset = Fget_charset (elts[0]);
2076       CHECK_INT (elts[1]);
2077       outrange->row = XINT (elts[1]);
2078       if (XCHARSET_DIMENSION (outrange->charset) < 2)
2079         signal_simple_error ("Charset in row vector must be multi-byte",
2080                              outrange->charset);
2081       else
2082         {
2083           int ret = XCHARSET_CELL_RANGE (outrange->charset);
2084
2085           cell_min = ret >> 8;
2086           cell_max = ret & 0xFF;
2087         }
2088       if (XCHARSET_DIMENSION (outrange->charset) == 2)
2089         check_int_range (outrange->row, cell_min, cell_max);
2090 #ifdef UTF2000
2091       else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2092         {
2093           check_int_range (outrange->row >> 8  , cell_min, cell_max);
2094           check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2095         }
2096       else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2097         {
2098           check_int_range ( outrange->row >> 16       , cell_min, cell_max);
2099           check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2100           check_int_range ( outrange->row       & 0xFF, cell_min, cell_max);
2101         }
2102 #endif
2103       else
2104         abort ();
2105     }
2106   else
2107     {
2108       if (!CHARSETP (range) && !SYMBOLP (range))
2109         signal_simple_error
2110           ("Char table range must be t, charset, char, or vector", range);
2111       outrange->type = CHARTAB_RANGE_CHARSET;
2112       outrange->charset = Fget_charset (range);
2113     }
2114 #endif /* MULE */
2115 }
2116
2117 #if defined(MULE)&&!defined(UTF2000)
2118
2119 /* called from CHAR_TABLE_VALUE(). */
2120 Lisp_Object
2121 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2122                                Emchar c)
2123 {
2124   Lisp_Object val;
2125 #ifdef UTF2000
2126   Lisp_Object charset;
2127 #else
2128   Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2129 #endif
2130   int byte1, byte2;
2131
2132 #ifdef UTF2000
2133   BREAKUP_CHAR (c, charset, byte1, byte2);
2134 #else
2135   BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2136 #endif
2137   val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2138   if (CHAR_TABLE_ENTRYP (val))
2139     {
2140       Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2141       val = cte->level2[byte1 - 32];
2142       if (CHAR_TABLE_ENTRYP (val))
2143         {
2144           cte = XCHAR_TABLE_ENTRY (val);
2145           assert (byte2 >= 32);
2146           val = cte->level2[byte2 - 32];
2147           assert (!CHAR_TABLE_ENTRYP (val));
2148         }
2149     }
2150
2151   return val;
2152 }
2153
2154 #endif /* MULE */
2155
2156 Lisp_Object
2157 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2158 {
2159 #ifdef UTF2000
2160   {
2161     Lisp_Object ret = get_char_id_table (ct, ch);
2162
2163 #ifdef HAVE_CHISE
2164     if (NILP (ret))
2165       {
2166         if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2167           ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
2168                                Qnil, Qnil);
2169         else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2170           ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
2171                                Qnil, Qnil);
2172         if (CONSP (ret))
2173           {
2174             ret = XCAR (ret);
2175             if (CONSP (ret))
2176               ret = Ffind_char (ret);
2177           }
2178       }
2179 #endif
2180     return ret;
2181   }
2182 #elif defined(MULE)
2183   {
2184     Lisp_Object charset;
2185     int byte1, byte2;
2186     Lisp_Object val;
2187
2188     BREAKUP_CHAR (ch, charset, byte1, byte2);
2189
2190     if (EQ (charset, Vcharset_ascii))
2191       val = ct->ascii[byte1];
2192     else if (EQ (charset, Vcharset_control_1))
2193       val = ct->ascii[byte1 + 128];
2194     else
2195       {
2196         int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2197         val = ct->level1[lb];
2198         if (CHAR_TABLE_ENTRYP (val))
2199           {
2200             Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2201             val = cte->level2[byte1 - 32];
2202             if (CHAR_TABLE_ENTRYP (val))
2203               {
2204                 cte = XCHAR_TABLE_ENTRY (val);
2205                 assert (byte2 >= 32);
2206                 val = cte->level2[byte2 - 32];
2207                 assert (!CHAR_TABLE_ENTRYP (val));
2208               }
2209           }
2210       }
2211
2212     return val;
2213   }
2214 #else /* not MULE */
2215   return ct->ascii[(unsigned char)ch];
2216 #endif /* not MULE */
2217 }
2218
2219
2220 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2221 Find value for CHARACTER in CHAR-TABLE.
2222 */
2223        (character, char_table))
2224 {
2225   CHECK_CHAR_TABLE (char_table);
2226   CHECK_CHAR_COERCE_INT (character);
2227
2228   return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2229 }
2230
2231 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2232 Find value for a range in CHAR-TABLE.
2233 If there is more than one value, return MULTI (defaults to nil).
2234 */
2235        (range, char_table, multi))
2236 {
2237   Lisp_Char_Table *ct;
2238   struct chartab_range rainj;
2239
2240   if (CHAR_OR_CHAR_INTP (range))
2241     return Fget_char_table (range, char_table);
2242   CHECK_CHAR_TABLE (char_table);
2243   ct = XCHAR_TABLE (char_table);
2244
2245   decode_char_table_range (range, &rainj);
2246   switch (rainj.type)
2247     {
2248     case CHARTAB_RANGE_ALL:
2249       {
2250 #ifdef UTF2000
2251         if (UINT8_BYTE_TABLE_P (ct->table))
2252           return multi;
2253         else if (UINT16_BYTE_TABLE_P (ct->table))
2254           return multi;
2255         else if (BYTE_TABLE_P (ct->table))
2256           return multi;
2257         else
2258           return ct->table;
2259 #else /* non UTF2000 */
2260         int i;
2261         Lisp_Object first = ct->ascii[0];
2262
2263         for (i = 1; i < NUM_ASCII_CHARS; i++)
2264           if (!EQ (first, ct->ascii[i]))
2265             return multi;
2266
2267 #ifdef MULE
2268         for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2269              i++)
2270           {
2271             if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2272                 || i == LEADING_BYTE_ASCII
2273                 || i == LEADING_BYTE_CONTROL_1)
2274               continue;
2275             if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2276               return multi;
2277           }
2278 #endif /* MULE */
2279
2280         return first;
2281 #endif /* non UTF2000 */
2282       }
2283
2284 #ifdef MULE
2285     case CHARTAB_RANGE_CHARSET:
2286 #ifdef UTF2000
2287       return multi;
2288 #else
2289       if (EQ (rainj.charset, Vcharset_ascii))
2290         {
2291           int i;
2292           Lisp_Object first = ct->ascii[0];
2293
2294           for (i = 1; i < 128; i++)
2295             if (!EQ (first, ct->ascii[i]))
2296               return multi;
2297           return first;
2298         }
2299
2300       if (EQ (rainj.charset, Vcharset_control_1))
2301         {
2302           int i;
2303           Lisp_Object first = ct->ascii[128];
2304
2305           for (i = 129; i < 160; i++)
2306             if (!EQ (first, ct->ascii[i]))
2307               return multi;
2308           return first;
2309         }
2310
2311       {
2312         Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2313                                      MIN_LEADING_BYTE];
2314         if (CHAR_TABLE_ENTRYP (val))
2315           return multi;
2316         return val;
2317       }
2318 #endif
2319
2320     case CHARTAB_RANGE_ROW:
2321 #ifdef UTF2000
2322       return multi;
2323 #else
2324       {
2325         Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2326                                      MIN_LEADING_BYTE];
2327         if (!CHAR_TABLE_ENTRYP (val))
2328           return val;
2329         val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2330         if (CHAR_TABLE_ENTRYP (val))
2331           return multi;
2332         return val;
2333       }
2334 #endif /* not UTF2000 */
2335 #endif /* not MULE */
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 = XINT (v);
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, Q_decomposition))
3489     put_char_composition (character, value);
3490   else if (EQ (attribute, Qto_ucs))
3491     {
3492       Lisp_Object ret;
3493       Emchar c;
3494
3495       if (!INTP (value))
3496         signal_simple_error ("Invalid value for =>ucs", value);
3497
3498       c = XINT (value);
3499
3500       ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3501                            Qnil, Qnil);
3502       if (!CONSP (ret))
3503         put_char_attribute (make_char (c), Q_ucs_unified,
3504                             list1 (character));
3505       else if (NILP (Fmemq (character, ret)))
3506         Fput_char_attribute (make_char (c), Q_ucs_unified,
3507                              Fcons (character, ret));
3508     }
3509   else if ( EQ (attribute, Q_subsumptive) ||
3510             EQ (attribute, Q_subsumptive_from) ||
3511             EQ (attribute, Q_denotational) ||
3512             EQ (attribute, Q_denotational_from) ||
3513             EQ (attribute, Q_identical) ||
3514             EQ (attribute, Q_identical_from) ||
3515             EQ (attribute, Q_component) ||
3516             EQ (attribute, Q_component_of) ||
3517             EQ (attribute, Q_same) ||
3518             EQ (attribute, Q_same_of) ||
3519             !NILP (Fstring_match
3520                    (build_string ("^\\(<-\\|->\\)\\(simplified"
3521                                   "\\|vulgar\\|wrong"
3522                                   "\\)[^*]*$"),
3523                     Fsymbol_name (attribute),
3524                     Qnil, Qnil)) )
3525     {
3526       Lisp_Object rest = value;
3527       Lisp_Object ret;
3528       Lisp_Object rev_feature = Qnil;
3529       struct gcpro gcpro1;
3530       GCPRO1 (rev_feature);
3531
3532       if (EQ (attribute, Q_identical))
3533         rev_feature = Q_identical_from;
3534       else if (EQ (attribute, Q_identical_from))
3535         rev_feature = Q_identical;
3536       else if (EQ (attribute, Q_subsumptive))
3537         rev_feature = Q_subsumptive_from;
3538       else if (EQ (attribute, Q_subsumptive_from))
3539         rev_feature = Q_subsumptive;
3540       else if (EQ (attribute, Q_denotational))
3541         rev_feature = Q_denotational_from;
3542       else if (EQ (attribute, Q_denotational_from))
3543         rev_feature = Q_denotational;
3544       else if (EQ (attribute, Q_component))
3545         rev_feature = Q_component_of;
3546       else if (EQ (attribute, Q_component_of))
3547         rev_feature = Q_component;
3548       else if (EQ (attribute, Q_same))
3549         rev_feature = Q_same_of;
3550       else if (EQ (attribute, Q_same_of))
3551         rev_feature = Q_same;
3552       else
3553         {
3554           Lisp_String* name = symbol_name (XSYMBOL (attribute));
3555           Bufbyte *name_str = string_data (name);
3556
3557           if ( (name_str[0] == '<' && name_str[1] == '-') ||
3558                (name_str[0] == '-' && name_str[1] == '>') )
3559             {
3560               Bytecount length = string_length (name);
3561               Bufbyte *rev_name_str = alloca (length + 1);
3562
3563               memcpy (rev_name_str + 2, name_str + 2, length - 2);
3564               if (name_str[0] == '<')
3565                 {
3566                   rev_name_str[0] = '-';
3567                   rev_name_str[1] = '>';
3568                 }
3569               else
3570                 {
3571                   rev_name_str[0] = '<';
3572                   rev_name_str[1] = '-';
3573                 }
3574               rev_name_str[length] = 0;
3575               rev_feature = intern (rev_name_str);
3576             }
3577         }
3578
3579       while (CONSP (rest))
3580         {
3581           ret = XCAR (rest);
3582
3583           if (CONSP (ret))
3584             ret = Fdefine_char (ret);
3585
3586           if ( !NILP (ret) && !EQ (ret, character) )
3587             {
3588               Lisp_Object ffv;
3589
3590               ffv = Fget_char_attribute (ret, rev_feature, Qnil);
3591               if (!CONSP (ffv))
3592                 put_char_attribute (ret, rev_feature, list1 (character));
3593               else if (NILP (Fmemq (character, ffv)))
3594                 put_char_attribute (ret, rev_feature,
3595                                     Fcons (character, ffv));
3596               Fsetcar (rest, ret);
3597             }
3598           rest = XCDR (rest);
3599         }
3600       UNGCPRO;
3601     }
3602 #if 1
3603   else if (EQ (attribute, Qideographic_structure))
3604     value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3605 #endif
3606   return put_char_attribute (character, attribute, value);
3607 }
3608
3609 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3610 Remove CHARACTER's ATTRIBUTE.
3611 */
3612        (character, attribute))
3613 {
3614   Lisp_Object ccs;
3615
3616   CHECK_CHAR (character);
3617   ccs = Ffind_charset (attribute);
3618   if (!NILP (ccs))
3619     {
3620       return remove_char_ccs (character, ccs);
3621     }
3622   else
3623     {
3624       Lisp_Object table = Fgethash (attribute,
3625                                     Vchar_attribute_hash_table,
3626                                     Qunbound);
3627       if (!UNBOUNDP (table))
3628         {
3629           put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3630           return Qt;
3631         }
3632     }
3633   return Qnil;
3634 }
3635
3636 #ifdef HAVE_CHISE
3637
3638 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3639 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3640 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3641
3642 #ifdef HAVE_LIBCHISE
3643 int
3644 open_chise_data_source_maybe ()
3645 {
3646   if (default_chise_data_source == NULL)
3647     {
3648       Lisp_Object db_dir = Vexec_directory;
3649       int modemask = 0755;              /* rwxr-xr-x */
3650
3651       if (NILP (db_dir))
3652         db_dir = build_string ("../lib-src");
3653       db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3654
3655       default_chise_data_source
3656         = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3657                          0 /* DB_HASH */, modemask);
3658       if (default_chise_data_source == NULL)
3659         return -1;
3660     }
3661   return 0;
3662 }
3663 #endif /* HAVE_LIBCHISE */
3664
3665 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3666 Close data-source of CHISE.
3667 */
3668        ())
3669 {
3670 #ifdef HAVE_LIBCHISE
3671   int status = CHISE_DS_close (default_chise_data_source);
3672
3673   default_chise_data_source = NULL;
3674   if (status)
3675     return Qt;
3676 #endif /* HAVE_LIBCHISE */
3677   return Qnil;
3678 }
3679
3680 int
3681 char_table_open_db_maybe (Lisp_Char_Table* cit)
3682 {
3683   Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3684
3685   if (!NILP (attribute))
3686     {
3687 #ifdef HAVE_LIBCHISE
3688       if ( open_chise_data_source_maybe () )
3689         return -1;
3690 #else /* HAVE_LIBCHISE */
3691       if (NILP (Fdatabase_live_p (cit->db)))
3692         {
3693           Lisp_Object db_file
3694             = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3695
3696           cit->db = Fopen_database (db_file, Qnil, Qnil,
3697                                     build_string ("r"), Qnil);
3698           if (NILP (cit->db))
3699             return -1;
3700         }
3701 #endif /* not HAVE_LIBCHISE */
3702       return 0;
3703     }
3704   else
3705     return -1;
3706 }
3707
3708 void
3709 char_table_close_db_maybe (Lisp_Char_Table* cit)
3710 {
3711 #ifndef HAVE_LIBCHISE
3712   if (!NILP (cit->db))
3713     {
3714       if (!NILP (Fdatabase_live_p (cit->db)))
3715         Fclose_database (cit->db);
3716       cit->db = Qnil;
3717     }
3718 #endif /* not HAVE_LIBCHISE */
3719 }
3720
3721 Lisp_Object
3722 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3723 {
3724   Lisp_Object val;
3725 #ifdef HAVE_LIBCHISE
3726   CHISE_Value value;
3727   int status
3728     = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3729                                         XSTRING_DATA(Fsymbol_name
3730                                                      (cit->name)),
3731                                         &value);
3732
3733   if (!status)
3734     {
3735       val = Fread (make_string (chise_value_data (&value),
3736                                 chise_value_size (&value) ));
3737     }
3738   else
3739     val = Qunbound;
3740 #else /* HAVE_LIBCHISE */
3741   val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3742                        cit->db, Qunbound);
3743   if (!UNBOUNDP (val))
3744     val = Fread (val);
3745   else
3746     val = Qunbound;
3747 #endif /* not HAVE_LIBCHISE */
3748   return val;
3749 }
3750
3751 #ifndef HAVE_LIBCHISE
3752 Lisp_Object
3753 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3754                                int writing_mode)
3755 {
3756   Lisp_Object db_dir = Vexec_directory;
3757
3758   if (NILP (db_dir))
3759     db_dir = build_string ("../lib-src");
3760
3761   db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3762   if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3763     Fmake_directory_internal (db_dir);
3764
3765   db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3766   if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3767     Fmake_directory_internal (db_dir);
3768
3769   {
3770     Lisp_Object attribute_name = Fsymbol_name (attribute);
3771     Lisp_Object dest = Qnil, ret;
3772     int base = 0;
3773     struct gcpro gcpro1, gcpro2;
3774     int len = XSTRING_CHAR_LENGTH (attribute_name);
3775     int i;
3776
3777     GCPRO2 (dest, ret);
3778     for (i = 0; i < len; i++)
3779       {
3780         Emchar c = string_char (XSTRING (attribute_name), i);
3781
3782         if ( (c == '/') || (c == '%') )
3783           {
3784             char str[4];
3785
3786             sprintf (str, "%%%02X", c);
3787             dest = concat3 (dest,
3788                             Fsubstring (attribute_name,
3789                                         make_int (base), make_int (i)),
3790                             build_string (str));
3791             base = i + 1;
3792           }
3793       }
3794     ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3795     dest = concat2 (dest, ret);
3796     UNGCPRO;
3797     return Fexpand_file_name (dest, db_dir);
3798   }
3799 }
3800 #endif /* not HAVE_LIBCHISE */
3801
3802 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3803 Save values of ATTRIBUTE into database file.
3804 */
3805        (attribute))
3806 {
3807   Lisp_Object table = Fgethash (attribute,
3808                                 Vchar_attribute_hash_table, Qunbound);
3809   Lisp_Char_Table *ct;
3810 #ifdef HAVE_LIBCHISE
3811   CHISE_Feature feature;
3812 #else /* HAVE_LIBCHISE */
3813   Lisp_Object db_file;
3814   Lisp_Object db;
3815 #endif /* not HAVE_LIBCHISE */
3816
3817   if (CHAR_TABLEP (table))
3818     ct = XCHAR_TABLE (table);
3819   else
3820     return Qnil;
3821
3822 #ifdef HAVE_LIBCHISE
3823   if ( open_chise_data_source_maybe () )
3824     return -1;
3825   feature
3826     = chise_ds_get_feature (default_chise_data_source,
3827                             XSTRING_DATA (Fsymbol_name (attribute)));
3828 #else /* HAVE_LIBCHISE */
3829   db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3830   db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3831 #endif /* not HAVE_LIBCHISE */
3832   if (
3833 #ifdef HAVE_LIBCHISE
3834       feature != NULL
3835 #else /* HAVE_LIBCHISE */
3836       !NILP (db)
3837 #endif /* not HAVE_LIBCHISE */
3838       )
3839     {
3840       Lisp_Object (*filter)(Lisp_Object value);
3841
3842       if ( EQ (attribute, Qideographic_structure)
3843            || EQ (attribute, Q_identical)
3844            || EQ (attribute, Q_identical_from)
3845            || EQ (attribute, Q_same)
3846            || EQ (attribute, Q_same_of)
3847            || !NILP (Fstring_match
3848                      (build_string ("^\\(<-\\|->\\)\\(simplified"
3849                                     "\\|vulgar\\|wrong"
3850                                     "\\)[^*]*$"),
3851                       Fsymbol_name (attribute),
3852                       Qnil, Qnil)) )
3853         filter = &Fchar_refs_simplify_char_specs;
3854       else
3855         filter = NULL;
3856
3857       if (UINT8_BYTE_TABLE_P (ct->table))
3858         save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3859 #ifdef HAVE_LIBCHISE
3860                                feature,
3861 #else /* HAVE_LIBCHISE */
3862                                db,
3863 #endif /* not HAVE_LIBCHISE */
3864                                0, 3, filter);
3865       else if (UINT16_BYTE_TABLE_P (ct->table))
3866         save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3867 #ifdef HAVE_LIBCHISE
3868                                 feature,
3869 #else /* HAVE_LIBCHISE */
3870                                 db,
3871 #endif /* not HAVE_LIBCHISE */
3872                                 0, 3, filter);
3873       else if (BYTE_TABLE_P (ct->table))
3874         save_byte_table (XBYTE_TABLE(ct->table), ct,
3875 #ifdef HAVE_LIBCHISE
3876                          feature,
3877 #else /* HAVE_LIBCHISE */
3878                          db,
3879 #endif /* not HAVE_LIBCHISE */
3880                          0, 3, filter);
3881 #ifdef HAVE_LIBCHISE
3882       chise_feature_sync (feature);
3883 #else /* HAVE_LIBCHISE */
3884       Fclose_database (db);
3885 #endif /* not HAVE_LIBCHISE */
3886       return Qt;
3887     }
3888   else
3889     return Qnil;
3890 }
3891
3892 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3893 Mount database file on char-attribute-table ATTRIBUTE.
3894 */
3895        (attribute))
3896 {
3897   Lisp_Object table = Fgethash (attribute,
3898                                 Vchar_attribute_hash_table, Qunbound);
3899
3900   if (UNBOUNDP (table))
3901     {
3902       Lisp_Char_Table *ct;
3903
3904       table = make_char_id_table (Qunbound);
3905       Fputhash (attribute, table, Vchar_attribute_hash_table);
3906       XCHAR_TABLE_NAME(table) = attribute;
3907       ct = XCHAR_TABLE (table);
3908       ct->table = Qunloaded;
3909       XCHAR_TABLE_UNLOADED(table) = 1;
3910 #ifndef HAVE_LIBCHISE
3911       ct->db = Qnil;
3912 #endif /* not HAVE_LIBCHISE */
3913       return Qt;
3914     }
3915   return Qnil;
3916 }
3917
3918 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3919 Close database of ATTRIBUTE.
3920 */
3921        (attribute))
3922 {
3923   Lisp_Object table = Fgethash (attribute,
3924                                 Vchar_attribute_hash_table, Qunbound);
3925   Lisp_Char_Table *ct;
3926
3927   if (CHAR_TABLEP (table))
3928     ct = XCHAR_TABLE (table);
3929   else
3930     return Qnil;
3931   char_table_close_db_maybe (ct);
3932   return Qnil;
3933 }
3934
3935 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3936 Reset values of ATTRIBUTE with database file.
3937 */
3938        (attribute))
3939 {
3940 #ifdef HAVE_LIBCHISE
3941   CHISE_Feature feature
3942     = chise_ds_get_feature (default_chise_data_source,
3943                             XSTRING_DATA (Fsymbol_name
3944                                           (attribute)));
3945
3946   if (feature == NULL)
3947     return Qnil;
3948
3949   if (chise_feature_setup_db (feature, 0) == 0)
3950     {
3951       Lisp_Object table = Fgethash (attribute,
3952                                     Vchar_attribute_hash_table, Qunbound);
3953       Lisp_Char_Table *ct;
3954
3955       chise_feature_sync (feature);
3956       if (UNBOUNDP (table))
3957         {
3958           table = make_char_id_table (Qunbound);
3959           Fputhash (attribute, table, Vchar_attribute_hash_table);
3960           XCHAR_TABLE_NAME(table) = attribute;
3961         }
3962       ct = XCHAR_TABLE (table);
3963       ct->table = Qunloaded;
3964       char_table_close_db_maybe (ct);
3965       XCHAR_TABLE_UNLOADED(table) = 1;
3966       return Qt;
3967     }
3968 #else
3969   Lisp_Object table = Fgethash (attribute,
3970                                 Vchar_attribute_hash_table, Qunbound);
3971   Lisp_Char_Table *ct;
3972   Lisp_Object db_file
3973     = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3974
3975   if (!NILP (Ffile_exists_p (db_file)))
3976     {
3977       if (UNBOUNDP (table))
3978         {
3979           table = make_char_id_table (Qunbound);
3980           Fputhash (attribute, table, Vchar_attribute_hash_table);
3981           XCHAR_TABLE_NAME(table) = attribute;
3982         }
3983       ct = XCHAR_TABLE (table);
3984       ct->table = Qunloaded;
3985       char_table_close_db_maybe (ct);
3986       XCHAR_TABLE_UNLOADED(table) = 1;
3987       return Qt;
3988     }
3989 #endif
3990   return Qnil;
3991 }
3992
3993 Lisp_Object
3994 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
3995 {
3996   Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3997
3998   if (!NILP (attribute))
3999     {
4000       Lisp_Object val;
4001
4002       if (char_table_open_db_maybe (cit))
4003         return Qunbound;
4004
4005       val = char_table_get_db (cit, ch);
4006
4007       if (!NILP (Vchar_db_stingy_mode))
4008         char_table_close_db_maybe (cit);
4009
4010       return val;
4011     }
4012   return Qunbound;
4013 }
4014
4015 Lisp_Char_Table* char_attribute_table_to_load;
4016
4017 #ifdef HAVE_LIBCHISE
4018 int
4019 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4020                                     CHISE_Feature feature,
4021                                     CHISE_Value *value);
4022 int
4023 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4024                                     CHISE_Feature feature,
4025                                     CHISE_Value *value)
4026 {
4027   Emchar code = cid;
4028   Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4029
4030   if (EQ (ret, Qunloaded))
4031     put_char_id_table_0 (char_attribute_table_to_load, code,
4032                          Fread (make_string ((Bufbyte *) value->data,
4033                                              value->size)));
4034   return 0;
4035 }
4036 #else /* HAVE_LIBCHISE */
4037 Lisp_Object Qload_char_attribute_table_map_function;
4038
4039 DEFUN ("load-char-attribute-table-map-function",
4040        Fload_char_attribute_table_map_function, 2, 2, 0, /*
4041 For internal use.  Don't use it.
4042 */
4043        (key, value))
4044 {
4045   Lisp_Object c = Fread (key);
4046   Emchar code = XCHAR (c);
4047   Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4048
4049   if (EQ (ret, Qunloaded))
4050     put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
4051   return Qnil;
4052 }
4053 #endif /* not HAVE_LIBCHISE */
4054
4055 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
4056 Load values of ATTRIBUTE into database file.
4057 */
4058        (attribute))
4059 {
4060   Lisp_Object table = Fgethash (attribute,
4061                                 Vchar_attribute_hash_table,
4062                                 Qunbound);
4063   if (CHAR_TABLEP (table))
4064     {
4065       Lisp_Char_Table *cit = XCHAR_TABLE (table);
4066
4067       if (char_table_open_db_maybe (cit))
4068         return Qnil;
4069
4070       char_attribute_table_to_load = XCHAR_TABLE (table);
4071       {
4072         struct gcpro gcpro1;
4073
4074         GCPRO1 (table);
4075 #ifdef HAVE_LIBCHISE
4076         chise_feature_foreach_char_with_value
4077           (chise_ds_get_feature (default_chise_data_source,
4078                                  XSTRING_DATA (Fsymbol_name (cit->name))),
4079            &load_char_attribute_table_map_func);
4080 #else /* HAVE_LIBCHISE */
4081         Fmap_database (Qload_char_attribute_table_map_function, cit->db);
4082 #endif /* not HAVE_LIBCHISE */
4083         UNGCPRO;
4084       }
4085       char_table_close_db_maybe (cit);
4086       XCHAR_TABLE_UNLOADED(table) = 0;
4087       return Qt;
4088     }
4089   return Qnil;
4090 }
4091 #endif /* HAVE_CHISE */
4092
4093 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
4094 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
4095 each key and value in the table.
4096
4097 RANGE specifies a subrange to map over and is in the same format as
4098 the RANGE argument to `put-range-table'.  If omitted or t, it defaults to
4099 the entire table.
4100 */
4101        (function, attribute, range))
4102 {
4103   Lisp_Object ccs;
4104   Lisp_Char_Table *ct;
4105   struct slow_map_char_table_arg slarg;
4106   struct gcpro gcpro1, gcpro2;
4107   struct chartab_range rainj;
4108
4109   if (!NILP (ccs = Ffind_charset (attribute)))
4110     {
4111       Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
4112
4113       if (CHAR_TABLEP (encoding_table))
4114         ct = XCHAR_TABLE (encoding_table);
4115       else
4116         return Qnil;
4117     }
4118   else
4119     {
4120       Lisp_Object table = Fgethash (attribute,
4121                                     Vchar_attribute_hash_table,
4122                                     Qunbound);
4123       if (CHAR_TABLEP (table))
4124         ct = XCHAR_TABLE (table);
4125       else
4126         return Qnil;
4127     }
4128   if (NILP (range))
4129     range = Qt;
4130   decode_char_table_range (range, &rainj);
4131 #ifdef HAVE_CHISE
4132   if (CHAR_TABLE_UNLOADED(ct))
4133     Fload_char_attribute_table (attribute);
4134 #endif
4135   slarg.function = function;
4136   slarg.retval = Qnil;
4137   GCPRO2 (slarg.function, slarg.retval);
4138   map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
4139   UNGCPRO;
4140
4141   return slarg.retval;
4142 }
4143
4144 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
4145 Store character's ATTRIBUTES.
4146 */
4147        (attributes))
4148 {
4149   Lisp_Object rest;
4150   Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
4151   Lisp_Object character;
4152
4153   if (NILP (code))
4154     code = Fcdr (Fassq (Qucs, attributes));
4155
4156   if (NILP (code))
4157     {
4158       rest = attributes;
4159       while (CONSP (rest))
4160         {
4161           Lisp_Object cell = Fcar (rest);
4162           Lisp_Object ccs;
4163
4164           if ( !LISTP (cell) )
4165             signal_simple_error ("Invalid argument", attributes);
4166
4167           ccs = Ffind_charset (Fcar (cell));
4168           if (!NILP (ccs))
4169             {
4170               cell = Fcdr (cell);
4171               if (INTP (cell))
4172                 {
4173                   character = Fdecode_char (ccs, cell, Qt, Qt);
4174                   if (!NILP (character))
4175                     goto setup_attributes;
4176                 }
4177               if ( (XCHARSET_FINAL (ccs) != 0) ||
4178                    (XCHARSET_MAX_CODE (ccs) > 0) ||
4179                    (EQ (ccs, Vcharset_chinese_big5)) )
4180                 {
4181                   if (CONSP (cell))
4182                     character
4183                       = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4184                   else
4185                     character = Fdecode_char (ccs, cell, Qnil, Qt);
4186                   if (!NILP (character))
4187                     goto setup_attributes;
4188                 }
4189             }
4190           rest = Fcdr (rest);
4191         }
4192 #if 1
4193       {
4194         int cid = XINT (Vnext_defined_char_id);
4195
4196         if (cid <= 0xE00000)
4197           {
4198             character = make_char (cid);
4199             Vnext_defined_char_id = make_int (cid + 1);
4200             goto setup_attributes;
4201           }
4202       }
4203 #else
4204       if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4205         {
4206           if (!INTP (code))
4207             signal_simple_error ("Invalid argument", attributes);
4208           else
4209             character = make_char (XINT (code) + 0x100000);
4210           goto setup_attributes;
4211         }
4212 #endif
4213       return Qnil;
4214     }
4215   else if (!INTP (code))
4216     signal_simple_error ("Invalid argument", attributes);
4217   else
4218     character = make_char (XINT (code));
4219
4220  setup_attributes:
4221   rest = attributes;
4222   while (CONSP (rest))
4223     {
4224       Lisp_Object cell = Fcar (rest);
4225
4226       if (!LISTP (cell))
4227         signal_simple_error ("Invalid argument", attributes);
4228
4229       Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
4230       rest = Fcdr (rest);
4231     }
4232   return character;
4233 }
4234
4235 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
4236 Retrieve the character of the given ATTRIBUTES.
4237 */
4238        (attributes))
4239 {
4240   Lisp_Object rest = attributes;
4241   Lisp_Object code;
4242
4243   while (CONSP (rest))
4244     {
4245       Lisp_Object cell = Fcar (rest);
4246       Lisp_Object ccs;
4247
4248       if (!LISTP (cell))
4249         signal_simple_error ("Invalid argument", attributes);
4250       if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4251         {
4252           cell = Fcdr (cell);
4253           if (CONSP (cell))
4254             return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4255           else
4256             return Fdecode_char (ccs, cell, Qnil, Qnil);
4257         }
4258       rest = Fcdr (rest);
4259     }
4260   if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4261     {
4262       if (!INTP (code))
4263         signal_simple_error ("Invalid argument", attributes);
4264       else
4265         return make_char (XINT (code) + 0x100000);
4266     }
4267   return Qnil;
4268 }
4269
4270 #endif
4271
4272 \f
4273 /************************************************************************/
4274 /*                         Char table read syntax                       */
4275 /************************************************************************/
4276
4277 static int
4278 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4279                        Error_behavior errb)
4280 {
4281   /* #### should deal with ERRB */
4282   symbol_to_char_table_type (value);
4283   return 1;
4284 }
4285
4286 static int
4287 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4288                        Error_behavior errb)
4289 {
4290   Lisp_Object rest;
4291
4292   /* #### should deal with ERRB */
4293   EXTERNAL_LIST_LOOP (rest, value)
4294     {
4295       Lisp_Object range = XCAR (rest);
4296       struct chartab_range dummy;
4297
4298       rest = XCDR (rest);
4299       if (!CONSP (rest))
4300         signal_simple_error ("Invalid list format", value);
4301       if (CONSP (range))
4302         {
4303           if (!CONSP (XCDR (range))
4304               || !NILP (XCDR (XCDR (range))))
4305             signal_simple_error ("Invalid range format", range);
4306           decode_char_table_range (XCAR (range), &dummy);
4307           decode_char_table_range (XCAR (XCDR (range)), &dummy);
4308         }
4309       else
4310         decode_char_table_range (range, &dummy);
4311     }
4312
4313   return 1;
4314 }
4315
4316 static Lisp_Object
4317 chartab_instantiate (Lisp_Object data)
4318 {
4319   Lisp_Object chartab;
4320   Lisp_Object type = Qgeneric;
4321   Lisp_Object dataval = Qnil;
4322
4323   while (!NILP (data))
4324     {
4325       Lisp_Object keyw = Fcar (data);
4326       Lisp_Object valw;
4327
4328       data = Fcdr (data);
4329       valw = Fcar (data);
4330       data = Fcdr (data);
4331       if (EQ (keyw, Qtype))
4332         type = valw;
4333       else if (EQ (keyw, Qdata))
4334         dataval = valw;
4335     }
4336
4337   chartab = Fmake_char_table (type);
4338
4339   data = dataval;
4340   while (!NILP (data))
4341     {
4342       Lisp_Object range = Fcar (data);
4343       Lisp_Object val = Fcar (Fcdr (data));
4344
4345       data = Fcdr (Fcdr (data));
4346       if (CONSP (range))
4347         {
4348           if (CHAR_OR_CHAR_INTP (XCAR (range)))
4349             {
4350               Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4351               Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4352               Emchar i;
4353
4354               for (i = first; i <= last; i++)
4355                  Fput_char_table (make_char (i), val, chartab);
4356             }
4357           else
4358             abort ();
4359         }
4360       else
4361         Fput_char_table (range, val, chartab);
4362     }
4363
4364   return chartab;
4365 }
4366
4367 #ifdef MULE
4368
4369 \f
4370 /************************************************************************/
4371 /*                     Category Tables, specifically                    */
4372 /************************************************************************/
4373
4374 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4375 Return t if OBJECT is a category table.
4376 A category table is a type of char table used for keeping track of
4377 categories.  Categories are used for classifying characters for use
4378 in regexps -- you can refer to a category rather than having to use
4379 a complicated [] expression (and category lookups are significantly
4380 faster).
4381
4382 There are 95 different categories available, one for each printable
4383 character (including space) in the ASCII charset.  Each category
4384 is designated by one such character, called a "category designator".
4385 They are specified in a regexp using the syntax "\\cX", where X is
4386 a category designator.
4387
4388 A category table specifies, for each character, the categories that
4389 the character is in.  Note that a character can be in more than one
4390 category.  More specifically, a category table maps from a character
4391 to either the value nil (meaning the character is in no categories)
4392 or a 95-element bit vector, specifying for each of the 95 categories
4393 whether the character is in that category.
4394
4395 Special Lisp functions are provided that abstract this, so you do not
4396 have to directly manipulate bit vectors.
4397 */
4398        (object))
4399 {
4400   return (CHAR_TABLEP (object) &&
4401           XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4402     Qt : Qnil;
4403 }
4404
4405 static Lisp_Object
4406 check_category_table (Lisp_Object object, Lisp_Object default_)
4407 {
4408   if (NILP (object))
4409     object = default_;
4410   while (NILP (Fcategory_table_p (object)))
4411     object = wrong_type_argument (Qcategory_table_p, object);
4412   return object;
4413 }
4414
4415 int
4416 check_category_char (Emchar ch, Lisp_Object table,
4417                      unsigned int designator, unsigned int not_p)
4418 {
4419   REGISTER Lisp_Object temp;
4420   Lisp_Char_Table *ctbl;
4421 #ifdef ERROR_CHECK_TYPECHECK
4422   if (NILP (Fcategory_table_p (table)))
4423     signal_simple_error ("Expected category table", table);
4424 #endif
4425   ctbl = XCHAR_TABLE (table);
4426   temp = get_char_table (ch, ctbl);
4427   if (NILP (temp))
4428     return not_p;
4429
4430   designator -= ' ';
4431   return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4432 }
4433
4434 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4435 Return t if category of the character at POSITION includes DESIGNATOR.
4436 Optional third arg BUFFER specifies which buffer to use, and defaults
4437 to the current buffer.
4438 Optional fourth arg CATEGORY-TABLE specifies the category table to
4439 use, and defaults to BUFFER's category table.
4440 */
4441        (position, designator, buffer, category_table))
4442 {
4443   Lisp_Object ctbl;
4444   Emchar ch;
4445   unsigned int des;
4446   struct buffer *buf = decode_buffer (buffer, 0);
4447
4448   CHECK_INT (position);
4449   CHECK_CATEGORY_DESIGNATOR (designator);
4450   des = XCHAR (designator);
4451   ctbl = check_category_table (category_table, Vstandard_category_table);
4452   ch = BUF_FETCH_CHAR (buf, XINT (position));
4453   return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4454 }
4455
4456 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4457 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4458 Optional third arg CATEGORY-TABLE specifies the category table to use,
4459 and defaults to the standard category table.
4460 */
4461        (character, designator, category_table))
4462 {
4463   Lisp_Object ctbl;
4464   Emchar ch;
4465   unsigned int des;
4466
4467   CHECK_CATEGORY_DESIGNATOR (designator);
4468   des = XCHAR (designator);
4469   CHECK_CHAR (character);
4470   ch = XCHAR (character);
4471   ctbl = check_category_table (category_table, Vstandard_category_table);
4472   return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4473 }
4474
4475 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4476 Return BUFFER's current category table.
4477 BUFFER defaults to the current buffer.
4478 */
4479        (buffer))
4480 {
4481   return decode_buffer (buffer, 0)->category_table;
4482 }
4483
4484 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4485 Return the standard category table.
4486 This is the one used for new buffers.
4487 */
4488        ())
4489 {
4490   return Vstandard_category_table;
4491 }
4492
4493 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4494 Return a new category table which is a copy of CATEGORY-TABLE.
4495 CATEGORY-TABLE defaults to the standard category table.
4496 */
4497        (category_table))
4498 {
4499   if (NILP (Vstandard_category_table))
4500     return Fmake_char_table (Qcategory);
4501
4502   category_table =
4503     check_category_table (category_table, Vstandard_category_table);
4504   return Fcopy_char_table (category_table);
4505 }
4506
4507 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4508 Select CATEGORY-TABLE as the new category table for BUFFER.
4509 BUFFER defaults to the current buffer if omitted.
4510 */
4511        (category_table, buffer))
4512 {
4513   struct buffer *buf = decode_buffer (buffer, 0);
4514   category_table = check_category_table (category_table, Qnil);
4515   buf->category_table = category_table;
4516   /* Indicate that this buffer now has a specified category table.  */
4517   buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4518   return category_table;
4519 }
4520
4521 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4522 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4523 */
4524        (object))
4525 {
4526   return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4527 }
4528
4529 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4530 Return t if OBJECT is a category table value.
4531 Valid values are nil or a bit vector of size 95.
4532 */
4533        (object))
4534 {
4535   return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4536 }
4537
4538
4539 #define CATEGORYP(x) \
4540   (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4541
4542 #define CATEGORY_SET(c)                                         \
4543   (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4544
4545 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4546    The faster version of `!NILP (Faref (category_set, category))'.  */
4547 #define CATEGORY_MEMBER(category, category_set)                 \
4548   (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4549
4550 /* Return 1 if there is a word boundary between two word-constituent
4551    characters C1 and C2 if they appear in this order, else return 0.
4552    Use the macro WORD_BOUNDARY_P instead of calling this function
4553    directly.  */
4554
4555 int word_boundary_p (Emchar c1, Emchar c2);
4556 int
4557 word_boundary_p (Emchar c1, Emchar c2)
4558 {
4559   Lisp_Object category_set1, category_set2;
4560   Lisp_Object tail;
4561   int default_result;
4562
4563 #if 0
4564   if (COMPOSITE_CHAR_P (c1))
4565     c1 = cmpchar_component (c1, 0, 1);
4566   if (COMPOSITE_CHAR_P (c2))
4567     c2 = cmpchar_component (c2, 0, 1);
4568 #endif
4569
4570 #ifndef UTF2000
4571   if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4572 #endif
4573     {
4574       tail = Vword_separating_categories;
4575       default_result = 0;
4576     }
4577 #ifndef UTF2000
4578   else
4579     {
4580       tail = Vword_combining_categories;
4581       default_result = 1;
4582     }
4583 #endif
4584
4585   category_set1 = CATEGORY_SET (c1);
4586   if (NILP (category_set1))
4587     return default_result;
4588   category_set2 = CATEGORY_SET (c2);
4589   if (NILP (category_set2))
4590     return default_result;
4591
4592   for (; CONSP (tail); tail = XCONS (tail)->cdr)
4593     {
4594       Lisp_Object elt = XCONS(tail)->car;
4595
4596       if (CONSP (elt)
4597           && CATEGORYP (XCONS (elt)->car)
4598           && CATEGORYP (XCONS (elt)->cdr)
4599           && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4600           && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4601         return !default_result;
4602     }
4603   return default_result;
4604 }
4605 #endif /* MULE */
4606
4607 \f
4608 void
4609 syms_of_chartab (void)
4610 {
4611 #ifdef UTF2000
4612   INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4613   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4614   INIT_LRECORD_IMPLEMENTATION (byte_table);
4615
4616   defsymbol (&Qto_ucs,                  "=>ucs");
4617   defsymbol (&Q_ucs_unified,            "->ucs-unified");
4618   defsymbol (&Q_subsumptive,            "->subsumptive");
4619   defsymbol (&Q_subsumptive_from,       "<-subsumptive");
4620   defsymbol (&Q_denotational,           "->denotational");
4621   defsymbol (&Q_denotational_from,      "<-denotational");
4622   defsymbol (&Q_identical,              "->identical");
4623   defsymbol (&Q_identical_from,         "<-identical");
4624   defsymbol (&Q_component,              "->ideographic-component-forms");
4625   defsymbol (&Q_component_of,           "<-ideographic-component-forms");
4626   defsymbol (&Q_same,                   "->same");
4627   defsymbol (&Q_same_of,                "<-same");
4628   defsymbol (&Qcomposition,             "composition");
4629   defsymbol (&Q_decomposition,          "->decomposition");
4630   defsymbol (&Qcompat,                  "compat");
4631   defsymbol (&Qisolated,                "isolated");
4632   defsymbol (&Qinitial,                 "initial");
4633   defsymbol (&Qmedial,                  "medial");
4634   defsymbol (&Qfinal,                   "final");
4635   defsymbol (&Qvertical,                "vertical");
4636   defsymbol (&QnoBreak,                 "noBreak");
4637   defsymbol (&Qfraction,                "fraction");
4638   defsymbol (&Qsuper,                   "super");
4639   defsymbol (&Qsub,                     "sub");
4640   defsymbol (&Qcircle,                  "circle");
4641   defsymbol (&Qsquare,                  "square");
4642   defsymbol (&Qwide,                    "wide");
4643   defsymbol (&Qnarrow,                  "narrow");
4644   defsymbol (&Qsmall,                   "small");
4645   defsymbol (&Qfont,                    "font");
4646
4647   DEFSUBR (Fchar_attribute_list);
4648   DEFSUBR (Ffind_char_attribute_table);
4649   defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4650   DEFSUBR (Fput_char_table_map_function);
4651 #ifdef HAVE_CHISE
4652   DEFSUBR (Fsave_char_attribute_table);
4653   DEFSUBR (Fmount_char_attribute_table);
4654   DEFSUBR (Freset_char_attribute_table);
4655   DEFSUBR (Fclose_char_attribute_table);
4656   DEFSUBR (Fclose_char_data_source);
4657 #ifndef HAVE_LIBCHISE
4658   defsymbol (&Qload_char_attribute_table_map_function,
4659              "load-char-attribute-table-map-function");
4660   DEFSUBR (Fload_char_attribute_table_map_function);
4661 #endif
4662   DEFSUBR (Fload_char_attribute_table);
4663 #endif
4664   DEFSUBR (Fchar_feature);
4665   DEFSUBR (Fchar_attribute_alist);
4666   DEFSUBR (Fget_char_attribute);
4667   DEFSUBR (Fput_char_attribute);
4668   DEFSUBR (Fremove_char_attribute);
4669   DEFSUBR (Fmap_char_attribute);
4670   DEFSUBR (Fdefine_char);
4671   DEFSUBR (Ffind_char);
4672   DEFSUBR (Fchar_variants);
4673
4674   DEFSUBR (Fget_composite_char);
4675 #endif
4676
4677   INIT_LRECORD_IMPLEMENTATION (char_table);
4678
4679 #ifdef MULE
4680 #ifndef UTF2000
4681   INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4682 #endif
4683
4684   defsymbol (&Qcategory_table_p, "category-table-p");
4685   defsymbol (&Qcategory_designator_p, "category-designator-p");
4686   defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4687 #endif /* MULE */
4688
4689   defsymbol (&Qchar_table, "char-table");
4690   defsymbol (&Qchar_tablep, "char-table-p");
4691
4692   DEFSUBR (Fchar_table_p);
4693   DEFSUBR (Fchar_table_type_list);
4694   DEFSUBR (Fvalid_char_table_type_p);
4695   DEFSUBR (Fchar_table_type);
4696   DEFSUBR (Freset_char_table);
4697   DEFSUBR (Fmake_char_table);
4698   DEFSUBR (Fcopy_char_table);
4699   DEFSUBR (Fget_char_table);
4700   DEFSUBR (Fget_range_char_table);
4701   DEFSUBR (Fvalid_char_table_value_p);
4702   DEFSUBR (Fcheck_valid_char_table_value);
4703   DEFSUBR (Fput_char_table);
4704   DEFSUBR (Fmap_char_table);
4705
4706 #ifdef MULE
4707   DEFSUBR (Fcategory_table_p);
4708   DEFSUBR (Fcategory_table);
4709   DEFSUBR (Fstandard_category_table);
4710   DEFSUBR (Fcopy_category_table);
4711   DEFSUBR (Fset_category_table);
4712   DEFSUBR (Fcheck_category_at);
4713   DEFSUBR (Fchar_in_category_p);
4714   DEFSUBR (Fcategory_designator_p);
4715   DEFSUBR (Fcategory_table_value_p);
4716 #endif /* MULE */
4717
4718 }
4719
4720 void
4721 vars_of_chartab (void)
4722 {
4723 #ifdef UTF2000
4724   DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
4725 */ );
4726   Vnext_defined_char_id = make_int (0x0F0000);
4727 #endif
4728
4729 #ifdef HAVE_CHISE
4730   DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4731 */ );
4732   Vchar_db_stingy_mode = Qt;
4733
4734 #ifdef HAVE_LIBCHISE
4735   Vchise_db_directory = build_string(chise_db_dir);
4736   DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4737 Directory of CHISE character databases.
4738 */ );
4739
4740   Vchise_system_db_directory = build_string(chise_system_db_dir);
4741   DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4742 Directory of system character database of CHISE.
4743 */ );
4744 #endif
4745
4746 #endif /* HAVE_CHISE */
4747   /* DO NOT staticpro this.  It works just like Vweak_hash_tables. */
4748   Vall_syntax_tables = Qnil;
4749   dump_add_weak_object_chain (&Vall_syntax_tables);
4750 }
4751
4752 void
4753 structure_type_create_chartab (void)
4754 {
4755   struct structure_type *st;
4756
4757   st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4758
4759   define_structure_type_keyword (st, Qtype, chartab_type_validate);
4760   define_structure_type_keyword (st, Qdata, chartab_data_validate);
4761 }
4762
4763 void
4764 complex_vars_of_chartab (void)
4765 {
4766 #ifdef UTF2000
4767   staticpro (&Vchar_attribute_hash_table);
4768   Vchar_attribute_hash_table
4769     = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4770 #endif /* UTF2000 */
4771 #ifdef MULE
4772   /* Set this now, so first buffer creation can refer to it. */
4773   /* Make it nil before calling copy-category-table
4774      so that copy-category-table will know not to try to copy from garbage */
4775   Vstandard_category_table = Qnil;
4776   Vstandard_category_table = Fcopy_category_table (Qnil);
4777   staticpro (&Vstandard_category_table);
4778
4779   DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4780 List of pair (cons) of categories to determine word boundary.
4781
4782 Emacs treats a sequence of word constituent characters as a single
4783 word (i.e. finds no word boundary between them) iff they belongs to
4784 the same charset.  But, exceptions are allowed in the following cases.
4785
4786 \(1) The case that characters are in different charsets is controlled
4787 by the variable `word-combining-categories'.
4788
4789 Emacs finds no word boundary between characters of different charsets
4790 if they have categories matching some element of this list.
4791
4792 More precisely, if an element of this list is a cons of category CAT1
4793 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4794 C2 which has CAT2, there's no word boundary between C1 and C2.
4795
4796 For instance, to tell that ASCII characters and Latin-1 characters can
4797 form a single word, the element `(?l . ?l)' should be in this list
4798 because both characters have the category `l' (Latin characters).
4799
4800 \(2) The case that character are in the same charset is controlled by
4801 the variable `word-separating-categories'.
4802
4803 Emacs find a word boundary between characters of the same charset
4804 if they have categories matching some element of this list.
4805
4806 More precisely, if an element of this list is a cons of category CAT1
4807 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4808 C2 which has CAT2, there's a word boundary between C1 and C2.
4809
4810 For instance, to tell that there's a word boundary between Japanese
4811 Hiragana and Japanese Kanji (both are in the same charset), the
4812 element `(?H . ?C) should be in this list.
4813 */ );
4814
4815   Vword_combining_categories = Qnil;
4816
4817   DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4818 List of pair (cons) of categories to determine word boundary.
4819 See the documentation of the variable `word-combining-categories'.
4820 */ );
4821
4822   Vword_separating_categories = Qnil;
4823 #endif /* MULE */
4824 }