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

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