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

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