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