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

   1 /* Declarations having to do with Mule char tables.
   2    Copyright (C) 1992 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Sun Microsystems, Inc.
   4    Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2010, 2013, 2016
   5      MORIOKA Tomohiko
   6
   7 This file is part of XEmacs.
   8
   9 XEmacs is free software; you can redistribute it and/or modify it
  10 under the terms of the GNU General Public License as published by the
  11 Free Software Foundation; either version 2, or (at your option) any
  12 later version.
  13
  14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17 for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with XEmacs; see the file COPYING.  If not, write to
  21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 Boston, MA 02111-1307, USA.  */
  23
  24 /* Synched up with: Mule 2.3.  Not synched with FSF.
  25
  26    This file was written independently of the FSF implementation,
  27    and is not compatible. */
  28
  29 #ifndef INCLUDED_chartab_h_
  30 #define INCLUDED_chartab_h_
  31
  32
  33 #ifdef UTF2000
  34
  35 #ifdef HAVE_CHISE
  36 #  ifdef HAVE_LIBCHISE
  37 #    include <chise.h>
  38 #  else /* HAVE_LIBCHISE */
  39 #    include "database.h"
  40 #  endif /* not HAVE_LIBCHISE */
  41 #  define USE_CONCORD_OBJECT_SYSTEM 1
  42 #  define USE_CONCORD_OBJECT_SYSTEM_TO_COMPOSE 1
  43 #endif
  44
  45 EXFUN (Fmake_char, 3);
  46 EXFUN (Fdecode_char, 4);
  47
  48 EXFUN (Fput_char_attribute, 3);
  49
  50 EXFUN (Fdefine_char, 1);
  51
  52 EXFUN (Ffind_char, 1);
  53
  54 extern Lisp_Object Qdowncase, Qflippedcase, Q_lowercase, Q_uppercase;
  55
  56 #ifdef HAVE_LIBCHISE
  57 extern CHISE_DS *default_chise_data_source;
  58
  59 int open_chise_data_source_maybe (void);
  60 #endif
  61
  62 #if defined(UTF2000) || defined(HAVE_CONCORD)
  63 extern Lisp_Object Q_denotational;
  64 extern Lisp_Object Q_denotational_from;
  65 extern Lisp_Object Q_subsumptive;
  66 extern Lisp_Object Q_subsumptive_from;
  67 #endif
  68
  69 #ifdef HAVE_CONCORD
  70 extern Lisp_Object Vchise_system_db_directory;
  71 #endif
  72
  73 /************************************************************************/
  74 /*                          Char-ID Tables                              */
  75 /************************************************************************/
  76
  77 struct Lisp_Uint8_Byte_Table
  78 {
  79   struct lcrecord_header header;
  80
  81   unsigned char property[256];
  82 };
  83 typedef struct Lisp_Uint8_Byte_Table Lisp_Uint8_Byte_Table;
  84
  85 DECLARE_LRECORD (uint8_byte_table, Lisp_Uint8_Byte_Table);
  86 #define XUINT8_BYTE_TABLE(x) \
  87    XRECORD (x, uint8_byte_table, Lisp_Uint8_Byte_Table)
  88 #define XSETUINT8_BYTE_TABLE(x, p) XSETRECORD (x, p, uint8_byte_table)
  89 #define UINT8_BYTE_TABLE_P(x) RECORDP (x, uint8_byte_table)
  90 #define GC_UINT8_BYTE_TABLE_P(x) GC_RECORDP (x, uint8_byte_table)
  91 /* #define CHECK_UINT8_BYTE_TABLE(x) CHECK_RECORD (x, uint8_byte_table)
  92    char table entries should never escape to Lisp */
  93
  94
  95 struct Lisp_Uint16_Byte_Table
  96 {
  97   struct lcrecord_header header;
  98
  99   unsigned short property[256];
 100 };
 101 typedef struct Lisp_Uint16_Byte_Table Lisp_Uint16_Byte_Table;
 102
 103 DECLARE_LRECORD (uint16_byte_table, Lisp_Uint16_Byte_Table);
 104 #define XUINT16_BYTE_TABLE(x) \
 105    XRECORD (x, uint16_byte_table, Lisp_Uint16_Byte_Table)
 106 #define XSETUINT16_BYTE_TABLE(x, p) XSETRECORD (x, p, uint16_byte_table)
 107 #define UINT16_BYTE_TABLE_P(x) RECORDP (x, uint16_byte_table)
 108 #define GC_UINT16_BYTE_TABLE_P(x) GC_RECORDP (x, uint16_byte_table)
 109 /* #define CHECK_UINT16_BYTE_TABLE(x) CHECK_RECORD (x, uint16_byte_table)
 110    char table entries should never escape to Lisp */
 111
 112
 113 struct Lisp_Byte_Table
 114 {
 115   struct lcrecord_header header;
 116
 117   Lisp_Object property[256];
 118 };
 119 typedef struct Lisp_Byte_Table Lisp_Byte_Table;
 120
 121 DECLARE_LRECORD (byte_table, Lisp_Byte_Table);
 122 #define XBYTE_TABLE(x) XRECORD (x, byte_table, Lisp_Byte_Table)
 123 #define XSETBYTE_TABLE(x, p) XSETRECORD (x, p, byte_table)
 124 #define BYTE_TABLE_P(x) RECORDP (x, byte_table)
 125 #define GC_BYTE_TABLE_P(x) GC_RECORDP (x, byte_table)
 126 /* #define CHECK_BYTE_TABLE(x) CHECK_RECORD (x, byte_table)
 127    char table entries should never escape to Lisp */
 128
 129 Lisp_Object get_byte_table (Lisp_Object table, unsigned char idx);
 130
 131 Lisp_Object put_byte_table (Lisp_Object table, unsigned char idx,
 132                             Lisp_Object value);
 133
 134
 135 Lisp_Object make_char_id_table (Lisp_Object initval);
 136
 137 #endif
 138
 139
 140 /************************************************************************/
 141 /*                               Char Tables                            */
 142 /************************************************************************/
 143
 144 /* Under Mule, we use a complex representation (see below).
 145    When not under Mule, there are only 256 possible characters
 146    so we just represent them directly. */
 147
 148 #if defined(MULE)&&!defined(UTF2000)
 149
 150 struct Lisp_Char_Table_Entry
 151 {
 152   struct lcrecord_header header;
 153
 154   /* In the interests of simplicity, we just use a fixed 96-entry
 155      table.  If we felt like being smarter, we could make this
 156      variable-size and add an offset value into this structure. */
 157   Lisp_Object level2[96];
 158 };
 159 typedef struct Lisp_Char_Table_Entry Lisp_Char_Table_Entry;
 160
 161 DECLARE_LRECORD (char_table_entry, Lisp_Char_Table_Entry);
 162 #define XCHAR_TABLE_ENTRY(x) \
 163   XRECORD (x, char_table_entry, Lisp_Char_Table_Entry)
 164 #define XSETCHAR_TABLE_ENTRY(x, p) XSETRECORD (x, p, char_table_entry)
 165 #define CHAR_TABLE_ENTRYP(x) RECORDP (x, char_table_entry)
 166 /* #define CHECK_CHAR_TABLE_ENTRY(x) CHECK_RECORD (x, char_table_entry)
 167    char table entries should never escape to Lisp */
 168
 169 #endif /* MULE */
 170
 171 enum char_table_type
 172 {
 173   CHAR_TABLE_TYPE_GENERIC,
 174 #ifdef MULE
 175   CHAR_TABLE_TYPE_CATEGORY,
 176 #endif
 177   CHAR_TABLE_TYPE_SYNTAX,
 178   CHAR_TABLE_TYPE_DISPLAY,
 179   CHAR_TABLE_TYPE_CHAR
 180 };
 181
 182 #ifndef UTF2000
 183 #ifdef MULE
 184 #define NUM_ASCII_CHARS 160
 185 #else
 186 #define NUM_ASCII_CHARS 256
 187 #endif
 188 #endif
 189
 190 struct Lisp_Char_Table
 191 {
 192   struct lcrecord_header header;
 193
 194 #ifdef UTF2000
 195   Lisp_Object table;
 196   Lisp_Object default_value;
 197   Lisp_Object name;
 198 #ifndef HAVE_LIBCHISE
 199   Lisp_Object db;
 200 #endif
 201   unsigned char unloaded;
 202 #else
 203   Lisp_Object ascii[NUM_ASCII_CHARS];
 204
 205 #ifdef MULE
 206   /* We basically duplicate the Mule vectors-of-vectors implementation.
 207      We can do this because we know a great deal about the sorts of
 208      things we are going to be indexing.
 209
 210      The current implementation is as follows:
 211
 212      ascii[0-159] is used for ASCII and Control-1 characters.
 213
 214      level1[0 .. (NUM_LEADING_BYTES-1)] indexes charsets by leading
 215      byte (subtract MIN_LEADING_BYTE from the leading byte).  If the
 216      value of this is not an opaque, then it specifies a value for all
 217      characters in the charset.  Otherwise, it will be a
 218      96-Lisp-Object opaque that we created, specifying a value for
 219      each row.  If the value of this is not an opaque, then it
 220      specifies a value for all characters in the row.  Otherwise, it
 221      will be a 96-Lisp-Object opaque that we created, specifying a
 222      value for each character.
 223
 224      NOTE: 1) This will fail if some C routine passes an opaque to
 225               Fput_char_table().  Currently this is not a problem
 226               since all char tables that are created are Lisp-visible
 227               and thus no one should ever be putting an opaque in
 228               a char table.  Another possibility is to consider
 229               adding a type to */
 230
 231   Lisp_Object level1[NUM_LEADING_BYTES];
 232
 233 #endif /* MULE */
 234 #endif /* non UTF2000 */
 235
 236   enum char_table_type type;
 237
 238 #ifndef UTF2000
 239   /* stuff used for syntax tables */
 240   Lisp_Object mirror_table;
 241 #endif
 242   Lisp_Object next_table; /* DO NOT mark through this. */
 243 };
 244 typedef struct Lisp_Char_Table Lisp_Char_Table;
 245
 246 DECLARE_LRECORD (char_table, Lisp_Char_Table);
 247 #define XCHAR_TABLE(x) XRECORD (x, char_table, Lisp_Char_Table)
 248 #define XSETCHAR_TABLE(x, p) XSETRECORD (x, p, char_table)
 249 #define CHAR_TABLEP(x) RECORDP (x, char_table)
 250 #define CHECK_CHAR_TABLE(x) CHECK_RECORD (x, char_table)
 251 #define CONCHECK_CHAR_TABLE(x) CONCHECK_RECORD (x, char_table)
 252
 253 #define CHAR_TABLE_TYPE(ct) ((ct)->type)
 254 #define XCHAR_TABLE_TYPE(ct) CHAR_TABLE_TYPE (XCHAR_TABLE (ct))
 255
 256 #ifdef UTF2000
 257
 258 #define CHAR_TABLE_NAME(ct) ((ct)->name)
 259 #define XCHAR_TABLE_NAME(ct) CHAR_TABLE_NAME (XCHAR_TABLE (ct))
 260
 261 #define CHAR_TABLE_UNLOADED(ct) ((ct)->unloaded)
 262 #define XCHAR_TABLE_UNLOADED(ct) CHAR_TABLE_UNLOADED (XCHAR_TABLE (ct))
 263
 264 INLINE_HEADER Lisp_Object
 265 CHAR_TABLE_VALUE_UNSAFE (Lisp_Char_Table *ct, Emchar ch);
 266 INLINE_HEADER Lisp_Object
 267 CHAR_TABLE_VALUE_UNSAFE (Lisp_Char_Table *ct, Emchar ch)
 268 {
 269   Lisp_Object val = get_byte_table (get_byte_table
 270                                     (get_byte_table
 271                                      (get_byte_table
 272                                       (ct->table,
 273                                        (unsigned char)(ch >> 24)),
 274                                       (unsigned char) (ch >> 16)),
 275                                      (unsigned char)  (ch >> 8)),
 276                                     (unsigned char)    ch);
 277   if (UNBOUNDP (val))
 278     return ct->default_value;
 279   else
 280     return val;
 281 }
 282
 283 #elif defined(MULE)
 284
 285 Lisp_Object get_non_ascii_char_table_value (Lisp_Char_Table *ct,
 286                                             Charset_ID leading_byte,
 287                                             Emchar c);
 288
 289 INLINE_HEADER Lisp_Object
 290 CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (Lisp_Char_Table *ct, Emchar ch);
 291 INLINE_HEADER Lisp_Object
 292 CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (Lisp_Char_Table *ct, Emchar ch)
 293 {
 294 #ifdef UTF2000
 295   Charset_ID lb = CHAR_CHARSET_ID (ch);
 296 #else
 297   Charset_ID lb = CHAR_LEADING_BYTE (ch);
 298 #endif
 299   if (!CHAR_TABLE_ENTRYP ((ct)->level1[lb - MIN_LEADING_BYTE]))
 300     return (ct)->level1[lb - MIN_LEADING_BYTE];
 301   else
 302     return get_non_ascii_char_table_value (ct, lb, ch);
 303 }
 304
 305 #define CHAR_TABLE_VALUE_UNSAFE(ct, ch)         \
 306   ((ch) < NUM_ASCII_CHARS                       \
 307    ? (ct)->ascii[ch]                            \
 308    : CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (ct, ch))
 309
 310 #else /* not MULE */
 311
 312 #define CHAR_TABLE_VALUE_UNSAFE(ct, ch) ((ct)->ascii[(unsigned char) (ch)])
 313
 314 #endif /* not MULE */
 315
 316 #define XCHAR_TABLE_VALUE_UNSAFE(ct, ch) \
 317   CHAR_TABLE_VALUE_UNSAFE (XCHAR_TABLE (ct), ch)
 318
 319 enum chartab_range_type
 320 {
 321   CHARTAB_RANGE_ALL,
 322 #ifdef UTF2000
 323   CHARTAB_RANGE_DEFAULT,
 324 #endif
 325 #ifdef MULE
 326   CHARTAB_RANGE_CHARSET,
 327   CHARTAB_RANGE_ROW,
 328 #endif
 329   CHARTAB_RANGE_CHAR
 330 };
 331
 332 struct chartab_range
 333 {
 334   enum chartab_range_type type;
 335   Emchar ch;
 336   Lisp_Object charset;
 337   int row;
 338 };
 339
 340 void fill_char_table (Lisp_Char_Table *ct, Lisp_Object value);
 341 void put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
 342                      Lisp_Object val);
 343 Lisp_Object get_char_table (Emchar, Lisp_Char_Table *);
 344 int map_char_table (Lisp_Char_Table *ct,
 345                     struct chartab_range *range,
 346                     int (*fn) (struct chartab_range *range,
 347                                Lisp_Object val, void *arg),
 348                     void *arg);
 349 void prune_syntax_tables (void);
 350
 351 EXFUN (Fcopy_char_table, 1);
 352 EXFUN (Fmake_char_table, 1);
 353 EXFUN (Fput_char_table, 3);
 354 EXFUN (Fget_char_table, 2);
 355
 356 extern Lisp_Object Vall_syntax_tables;
 357
 358 \f
 359 #ifdef UTF2000
 360
 361 INLINE_HEADER void
 362 put_char_id_table_0 (Lisp_Char_Table* cit, Emchar code, Lisp_Object value);
 363 INLINE_HEADER void
 364 put_char_id_table_0 (Lisp_Char_Table* cit, Emchar code, Lisp_Object value)
 365 {
 366   Lisp_Object table1, table2, table3, table4;
 367
 368   table1 = cit->table;
 369   table2 = get_byte_table (table1, (unsigned char)(code >> 24));
 370   table3 = get_byte_table (table2, (unsigned char)(code >> 16));
 371   table4 = get_byte_table (table3, (unsigned char)(code >>  8));
 372
 373   table4     = put_byte_table (table4, (unsigned char) code, value);
 374   table3     = put_byte_table (table3, (unsigned char)(code >>  8), table4);
 375   table2     = put_byte_table (table2, (unsigned char)(code >> 16), table3);
 376   cit->table = put_byte_table (table1, (unsigned char)(code >> 24), table2);
 377 }
 378
 379 #ifdef HAVE_CHISE
 380 Lisp_Object load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch);
 381
 382 #ifdef USE_CONCORD_OBJECT_SYSTEM
 383 COS_object load_char_attribute_maybe_cos (Lisp_Char_Table* cit, Emchar ch);
 384 #endif
 385
 386 #ifndef HAVE_LIBCHISE
 387 extern Lisp_Object Qsystem_char_id;
 388
 389 Lisp_Object
 390 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
 391                                int writing_mode);
 392 #endif /* not HAVE_LIBCHISE */
 393 #endif /* HAVE_CHISE */
 394
 395 INLINE_HEADER Lisp_Object
 396 get_char_id_table_0 (Lisp_Char_Table* cit, Emchar ch);
 397 INLINE_HEADER Lisp_Object
 398 get_char_id_table_0 (Lisp_Char_Table* cit, Emchar ch)
 399 {
 400   return get_byte_table (get_byte_table
 401                          (get_byte_table
 402                           (get_byte_table
 403                            (cit->table,
 404                             (unsigned char)(ch >> 24)),
 405                            (unsigned char) (ch >> 16)),
 406                           (unsigned char)  (ch >> 8)),
 407                          (unsigned char)    ch);
 408 }
 409
 410 INLINE_HEADER Lisp_Object
 411 get_char_id_table (Lisp_Char_Table* cit, Emchar ch);
 412 INLINE_HEADER Lisp_Object
 413 get_char_id_table (Lisp_Char_Table* cit, Emchar ch)
 414 {
 415   Lisp_Object val = get_char_id_table_0 (cit, ch);
 416
 417 #ifdef HAVE_CHISE
 418   if (EQ (val, Qunloaded))
 419     {
 420       val = load_char_attribute_maybe (cit, ch);
 421       put_char_id_table_0 (cit, ch, val);
 422     }
 423 #endif /* HAVE_CHISE */
 424   if (UNBOUNDP (val))
 425     return cit->default_value;
 426   else
 427     return val;
 428 }
 429
 430 #ifdef USE_CONCORD_OBJECT_SYSTEM
 431 INLINE_HEADER Lisp_Object
 432 get_char_id_table_ce (Lisp_Char_Table* cit, Emchar ch);
 433 INLINE_HEADER Lisp_Object
 434 get_char_id_table_ce (Lisp_Char_Table* cit, Emchar ch)
 435 {
 436   Lisp_Object val = get_char_id_table_0 (cit, ch);
 437
 438   if (EQ (val, Qunloaded))
 439     {
 440 #if 0
 441       val = load_char_attribute_maybe (cit, ch);
 442 #else
 443       COS_object ret = load_char_attribute_maybe_cos (cit, ch);
 444       if ( ret == NULL )
 445         return cit->default_value;
 446       else
 447         return ret;
 448 #endif
 449     }
 450   if (UNBOUNDP (val))
 451     return cit->default_value;
 452   else
 453     return val;
 454 }
 455 #else
 456 #define get_char_id_table_ce(cit, ch) get_char_id_table(cit, ch)
 457 #endif
 458
 459 void
 460 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange);
 461
 462 INLINE_HEADER void
 463 put_char_id_table (Lisp_Char_Table* table,
 464                    Lisp_Object character, Lisp_Object value);
 465 INLINE_HEADER void
 466 put_char_id_table (Lisp_Char_Table* table,
 467                    Lisp_Object character, Lisp_Object value)
 468 {
 469   struct chartab_range range;
 470
 471   decode_char_table_range (character, &range);
 472   put_char_table (table, &range, value);
 473 }
 474
 475
 476 EXFUN (Fget_char_attribute, 3);
 477 EXFUN (Fchar_feature, 5);
 478
 479 #endif
 480 \f
 481
 482 #ifdef MULE
 483 int check_category_char(Emchar ch, Lisp_Object ctbl,
 484                         unsigned int designator, unsigned int not_p);
 485
 486 extern Lisp_Object Vstandard_category_table;
 487
 488 #define CATEGORY_DESIGNATORP(x) \
 489  (CHARP (x) && XCHAR (x) >= 32 && XCHAR (x) <= 126)
 490
 491 #define CHECK_CATEGORY_DESIGNATOR(x) do {                       \
 492   if (!CATEGORY_DESIGNATORP (x))                                \
 493     dead_wrong_type_argument (Qcategory_designator_p, x);       \
 494 } while (0)
 495
 496 #define CONCHECK_CATEGORY_DESIGNATOR(x) do {                    \
 497   if (!CATEGORY_DESIGNATORP (x))                                \
 498     x = wrong_type_argument (Qcategory_designator_p, x);        \
 499 } while (0)
 500
 501 #define CATEGORY_TABLE_VALUEP(x) \
 502  (NILP (x) || (BIT_VECTORP (x) && (bit_vector_length (XBIT_VECTOR (x)) == 95)))
 503
 504 #define CHECK_CATEGORY_TABLE_VALUE(x) do {                      \
 505   if (!CATEGORY_TABLE_VALUEP (x))                               \
 506     dead_wrong_type_argument (Qcategory_table_value_p, x);      \
 507 } while (0)
 508
 509 #define CONCHECK_CATEGORY_TABLE_VALUE(x) do {                   \
 510   if (!CATEGORY_TABLE_VALUEP (x))                               \
 511     x = wrong_type_argument (Qcategory_table_value_p, x);       \
 512 } while (0)
 513
 514 #endif /* MULE */
 515
 516 #endif /* INCLUDED_chartab_h_ */