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