X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fchartab.c;h=bf58ee42902f74f8a9c9fc7b7c17e7c0344ddee1;hp=f5eddc91a470f6fce0fa60db2a2f69e1a14dcdce;hb=0298dde5c47a900f2542bc7ec6c9dafc92ce3015;hpb=976b002b16336930724ae22476014583ad022e7d diff --git a/src/chartab.c b/src/chartab.c index f5eddc9..bf58ee4 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -2,6 +2,8 @@ Copyright (C) 1992, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN. + Licensed to the Free Software Foundation. This file is part of XEmacs. @@ -50,6 +52,9 @@ Lisp_Object Qcategory_designator_p; Lisp_Object Qcategory_table_value_p; Lisp_Object Vstandard_category_table; + +/* Variables to determine word boundary. */ +Lisp_Object Vword_combining_categories, Vword_separating_categories; #endif /* MULE */ @@ -90,14 +95,14 @@ Lisp_Object Vstandard_category_table; #ifdef MULE static Lisp_Object -mark_char_table_entry (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_char_table_entry (Lisp_Object obj) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); int i; for (i = 0; i < 96; i++) { - markobj (cte->level2[i]); + mark_object (cte->level2[i]); } return Qnil; } @@ -105,8 +110,8 @@ mark_char_table_entry (Lisp_Object obj, void (*markobj) (Lisp_Object)) static int char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1); - struct Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2); + Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1); + Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2); int i; for (i = 0; i < 96; i++) @@ -119,29 +124,35 @@ char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) static unsigned long char_table_entry_hash (Lisp_Object obj, int depth) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); return internal_array_hash (cte->level2, 96, depth); } +static const struct lrecord_description char_table_entry_description[] = { + { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry, mark_char_table_entry, internal_object_printer, 0, char_table_entry_equal, char_table_entry_hash, - struct Lisp_Char_Table_Entry); + char_table_entry_description, + Lisp_Char_Table_Entry); #endif /* MULE */ static Lisp_Object -mark_char_table (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_char_table (Lisp_Object obj) { - struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); + Lisp_Char_Table *ct = XCHAR_TABLE (obj); int i; for (i = 0; i < NUM_ASCII_CHARS; i++) - markobj (ct->ascii[i]); + mark_object (ct->ascii[i]); #ifdef MULE for (i = 0; i < NUM_LEADING_BYTES; i++) - markobj (ct->level1[i]); + mark_object (ct->level1[i]); #endif return ct->mirror_table; } @@ -151,18 +162,18 @@ mark_char_table (Lisp_Object obj, void (*markobj) (Lisp_Object)) and prune_weak_hash_tables(). */ void -prune_syntax_tables (int (*obj_marked_p) (Lisp_Object)) +prune_syntax_tables (void) { Lisp_Object rest, prev = Qnil; for (rest = Vall_syntax_tables; - !GC_NILP (rest); + !NILP (rest); rest = XCHAR_TABLE (rest)->next_table) { - if (! obj_marked_p (rest)) + if (! marked_p (rest)) { /* This table is garbage. Remove it from the list. */ - if (GC_NILP (prev)) + if (NILP (prev)) Vall_syntax_tables = XCHAR_TABLE (rest)->next_table; else XCHAR_TABLE (prev)->next_table = @@ -176,7 +187,7 @@ char_table_type_to_symbol (enum char_table_type type) { switch (type) { - default: abort(); + default: ABORT(); case CHAR_TABLE_TYPE_GENERIC: return Qgeneric; case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax; case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay; @@ -230,7 +241,7 @@ print_chartab_range (Emchar first, Emchar last, Lisp_Object val, static void print_chartab_charset_row (Lisp_Object charset, int row, - struct Lisp_Char_Table_Entry *cte, + Lisp_Char_Table_Entry *cte, Lisp_Object printcharfun) { int i; @@ -278,7 +289,7 @@ print_chartab_charset_row (Lisp_Object charset, static void print_chartab_two_byte_charset (Lisp_Object charset, - struct Lisp_Char_Table_Entry *cte, + Lisp_Char_Table_Entry *cte, Lisp_Object printcharfun) { int i; @@ -308,7 +319,7 @@ print_chartab_two_byte_charset (Lisp_Object charset, static void print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); + Lisp_Char_Table *ct = XCHAR_TABLE (obj); char buf[200]; sprintf (buf, "#s(char-table type %s data (", @@ -366,7 +377,7 @@ print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) } else { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann); if (XCHARSET_DIMENSION (charset) == 1) print_chartab_charset_row (charset, -1, cte, printcharfun); else @@ -382,8 +393,8 @@ print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) static int char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); - struct Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); + Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); + Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); int i; if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) @@ -405,7 +416,7 @@ char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) static unsigned long char_table_hash (Lisp_Object obj, int depth) { - struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); + Lisp_Char_Table *ct = XCHAR_TABLE (obj); unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, depth); #ifdef MULE @@ -415,10 +426,21 @@ char_table_hash (Lisp_Object obj, int depth) return hashval; } +static const struct lrecord_description char_table_description[] = { + { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS }, +#ifdef MULE + { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES }, +#endif + { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, + { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, mark_char_table, print_char_table, 0, char_table_equal, char_table_hash, - struct Lisp_Char_Table); + char_table_description, + Lisp_Char_Table); DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* Return non-nil if OBJECT is a char table. @@ -435,23 +457,25 @@ once per character). When Mule support exists, the types of ranges that can be assigned values are --- all characters +-- all characters (represented by t) -- an entire charset --- a single row in a two-octet charset +-- a single row in a two-octet charset (represented by a vector of two + elements: a two-octet charset and a row number; the row must be an + integer, not a character) -- a single character When Mule support is not present, the types of ranges that can be assigned values are --- all characters +-- all characters (represented by t) -- a single character -To create a char table, use `make-char-table'. To modify a char -table, use `put-char-table' or `remove-char-table'. To retrieve the -value for a particular character, use `get-char-table'. See also -`map-char-table', `clear-char-table', `copy-char-table', -`valid-char-table-type-p', `char-table-type-list', `valid-char-table-value-p', -and `check-char-table-value'. +To create a char table, use `make-char-table'. +To modify a char table, use `put-char-table' or `remove-char-table'. +To retrieve the value for a particular character, use `get-char-table'. +See also `map-char-table', `clear-char-table', `copy-char-table', +`valid-char-table-type-p', `char-table-type-list', +`valid-char-table-value-p', and `check-char-table-value'. */ (object)) { @@ -511,17 +535,17 @@ sorts of values. The different char table types are } DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /* -Return the type of char table TABLE. +Return the type of CHAR-TABLE. See `valid-char-table-type-p'. */ - (table)) + (char_table)) { - CHECK_CHAR_TABLE (table); - return char_table_type_to_symbol (XCHAR_TABLE (table)->type); + CHECK_CHAR_TABLE (char_table); + return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type); } void -fill_char_table (struct Lisp_Char_Table *ct, Lisp_Object value) +fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) { int i; @@ -537,14 +561,14 @@ fill_char_table (struct Lisp_Char_Table *ct, Lisp_Object value) } DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* -Reset a char table to its default state. +Reset CHAR-TABLE to its default state. */ - (table)) + (char_table)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); + CHECK_CHAR_TABLE (char_table); + ct = XCHAR_TABLE (char_table); switch (ct->type) { @@ -564,7 +588,7 @@ Reset a char table to its default state. break; default: - abort (); + ABORT (); } return Qnil; @@ -577,11 +601,11 @@ and 'syntax. See `valid-char-table-type-p'. */ (type)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; Lisp_Object obj; enum char_table_type ty = symbol_to_char_table_type (type); - ct = alloc_lcrecord_type (struct Lisp_Char_Table, &lrecord_char_table); + ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); ct->type = ty; if (ty == CHAR_TABLE_TYPE_SYNTAX) { @@ -609,9 +633,8 @@ make_char_table_entry (Lisp_Object initval) { Lisp_Object obj; int i; - struct Lisp_Char_Table_Entry *cte = - alloc_lcrecord_type (struct Lisp_Char_Table_Entry, - &lrecord_char_table_entry); + Lisp_Char_Table_Entry *cte = + alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); for (i = 0; i < 96; i++) cte->level2[i] = initval; @@ -623,12 +646,11 @@ make_char_table_entry (Lisp_Object initval) static Lisp_Object copy_char_table_entry (Lisp_Object entry) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); Lisp_Object obj; int i; - struct Lisp_Char_Table_Entry *ctenew = - alloc_lcrecord_type (struct Lisp_Char_Table_Entry, - &lrecord_char_table_entry); + Lisp_Char_Table_Entry *ctenew = + alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); for (i = 0; i < 96; i++) { @@ -646,19 +668,19 @@ copy_char_table_entry (Lisp_Object entry) #endif /* MULE */ DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /* -Make a new char table which is a copy of OLD-TABLE. +Return a new char table which is a copy of CHAR-TABLE. It will contain the same values for the same characters and ranges -as OLD-TABLE. The values will not themselves be copied. +as CHAR-TABLE. The values will not themselves be copied. */ - (old_table)) + (char_table)) { - struct Lisp_Char_Table *ct, *ctnew; + Lisp_Char_Table *ct, *ctnew; Lisp_Object obj; int i; - CHECK_CHAR_TABLE (old_table); - ct = XCHAR_TABLE (old_table); - ctnew = alloc_lcrecord_type (struct Lisp_Char_Table, &lrecord_char_table); + CHECK_CHAR_TABLE (char_table); + ct = XCHAR_TABLE (char_table); + ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); ctnew->type = ct->type; for (i = 0; i < NUM_ASCII_CHARS; i++) @@ -687,7 +709,13 @@ as OLD-TABLE. The values will not themselves be copied. ctnew->mirror_table = Fcopy_char_table (ct->mirror_table); else ctnew->mirror_table = ct->mirror_table; + ctnew->next_table = Qnil; XSETCHAR_TABLE (obj, ctnew); + if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX) + { + ctnew->next_table = Vall_syntax_tables; + Vall_syntax_tables = obj; + } return obj; } @@ -707,7 +735,7 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) #else /* MULE */ else if (VECTORP (range)) { - struct Lisp_Vector *vec = XVECTOR (range); + Lisp_Vector *vec = XVECTOR (range); Lisp_Object *elts = vector_data (vec); if (vector_length (vec) != 2) signal_simple_error ("Length of charset row vector must be 2", @@ -729,7 +757,7 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) check_int_range (outrange->row, 32, 127); break; default: - abort (); + ABORT (); } } else @@ -747,7 +775,7 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) /* called from CHAR_TABLE_VALUE(). */ Lisp_Object -get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, int leading_byte, +get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, Emchar c) { Lisp_Object val; @@ -758,7 +786,7 @@ get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, int leading_byte, val = ct->level1[leading_byte - MIN_LEADING_BYTE]; if (CHAR_TABLE_ENTRYP (val)) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); val = cte->level2[byte1 - 32]; if (CHAR_TABLE_ENTRYP (val)) { @@ -775,7 +803,7 @@ get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, int leading_byte, #endif /* MULE */ Lisp_Object -get_char_table (Emchar ch, struct Lisp_Char_Table *ct) +get_char_table (Emchar ch, Lisp_Char_Table *ct) { #ifdef MULE { @@ -795,7 +823,7 @@ get_char_table (Emchar ch, struct Lisp_Char_Table *ct) val = ct->level1[lb]; if (CHAR_TABLE_ENTRYP (val)) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); val = cte->level2[byte1 - 32]; if (CHAR_TABLE_ENTRYP (val)) { @@ -816,32 +844,32 @@ get_char_table (Emchar ch, struct Lisp_Char_Table *ct) DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* -Find value for char CH in TABLE. +Find value for CHARACTER in CHAR-TABLE. */ - (ch, table)) + (character, char_table)) { - struct Lisp_Char_Table *ct; - - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); - CHECK_CHAR_COERCE_INT (ch); + CHECK_CHAR_TABLE (char_table); + CHECK_CHAR_COERCE_INT (character); - return get_char_table (XCHAR (ch), ct); + return get_char_table (XCHAR (character), XCHAR_TABLE (char_table)); } DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /* -Find value for a range in TABLE. +Find value for RANGE in CHAR-TABLE. If there is more than one value, return MULTI (defaults to nil). + +Valid values for RANGE are single characters, charsets, a row in a +two-octet charset, and all characters. See `put-char-table'. */ - (range, table, multi)) + (range, char_table, multi)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; struct chartab_range rainj; if (CHAR_OR_CHAR_INTP (range)) - return Fget_char_table (range, table); - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); + return Fget_char_table (range, char_table); + CHECK_CHAR_TABLE (char_table); + ct = XCHAR_TABLE (char_table); decode_char_table_range (range, &rainj); switch (rainj.type) @@ -917,7 +945,7 @@ If there is more than one value, return MULTI (defaults to nil). #endif /* not MULE */ default: - abort (); + ABORT (); } return Qnil; /* not reached */ @@ -967,7 +995,7 @@ check_valid_char_table_value (Lisp_Object value, enum char_table_type type, break; default: - abort (); + ABORT (); } return 0; /* not reached */ @@ -1020,7 +1048,7 @@ Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE. /* Assign VAL to all characters in RANGE in char table CT. */ void -put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, +put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, Lisp_Object val) { switch (range->type) @@ -1053,7 +1081,7 @@ put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, case CHARTAB_RANGE_ROW: { - struct Lisp_Char_Table_Entry *cte; + Lisp_Char_Table_Entry *cte; int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; /* make sure that there is a separate entry for the row. */ if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) @@ -1077,7 +1105,7 @@ put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, ct->ascii[byte1 + 128] = val; else { - struct Lisp_Char_Table_Entry *cte; + Lisp_Char_Table_Entry *cte; int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; /* make sure that there is a separate entry for the row. */ if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) @@ -1112,38 +1140,39 @@ put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, } DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /* -Set the value for chars in RANGE to be VAL in TABLE. +Set the value for chars in RANGE to be VALUE in CHAR-TABLE. RANGE specifies one or more characters to be affected and should be one of the following: -- t (all characters are affected) -- A charset (only allowed when Mule support is present) --- A vector of two elements: a two-octet charset and a row number - (only allowed when Mule support is present) +-- A vector of two elements: a two-octet charset and a row number; the row + must be an integer, not a character (only allowed when Mule support is + present) -- A single character -VAL must be a value appropriate for the type of TABLE. +VALUE must be a value appropriate for the type of CHAR-TABLE. See `valid-char-table-type-p'. */ - (range, val, table)) + (range, value, char_table)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; struct chartab_range rainj; - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); - check_valid_char_table_value (val, ct->type, ERROR_ME); + CHECK_CHAR_TABLE (char_table); + ct = XCHAR_TABLE (char_table); + check_valid_char_table_value (value, ct->type, ERROR_ME); decode_char_table_range (range, &rainj); - val = canonicalize_char_table_value (val, ct->type); - put_char_table (ct, &rainj, val); + value = canonicalize_char_table_value (value, ct->type); + put_char_table (ct, &rainj, value); return Qnil; } /* Map FN over the ASCII chars in CT. */ static int -map_over_charset_ascii (struct Lisp_Char_Table *ct, +map_over_charset_ascii (Lisp_Char_Table *ct, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -1173,7 +1202,7 @@ map_over_charset_ascii (struct Lisp_Char_Table *ct, /* Map FN over the Control-1 chars in CT. */ static int -map_over_charset_control_1 (struct Lisp_Char_Table *ct, +map_over_charset_control_1 (Lisp_Char_Table *ct, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -1199,7 +1228,7 @@ map_over_charset_control_1 (struct Lisp_Char_Table *ct, CTE specifies the char table entry for CHARSET. */ static int -map_over_charset_row (struct Lisp_Char_Table_Entry *cte, +map_over_charset_row (Lisp_Char_Table_Entry *cte, Lisp_Object charset, int row, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), @@ -1239,7 +1268,7 @@ map_over_charset_row (struct Lisp_Char_Table_Entry *cte, static int -map_over_other_charset (struct Lisp_Char_Table *ct, int lb, +map_over_other_charset (Lisp_Char_Table *ct, int lb, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -1262,7 +1291,7 @@ map_over_other_charset (struct Lisp_Char_Table *ct, int lb, } { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); int charset94_p = (XCHARSET_CHARS (charset) == 94); int start = charset94_p ? 33 : 32; int stop = charset94_p ? 127 : 128; @@ -1296,7 +1325,7 @@ map_over_other_charset (struct Lisp_Char_Table *ct, int lb, becomes the return value of map_char_table(). */ int -map_char_table (struct Lisp_Char_Table *ct, +map_char_table (Lisp_Char_Table *ct, struct chartab_range *range, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), @@ -1366,7 +1395,7 @@ map_char_table (struct Lisp_Char_Table *ct, } default: - abort (); + ABORT (); } return 0; @@ -1406,7 +1435,7 @@ slow_map_char_table_fun (struct chartab_range *range, ranjarg = make_char (range->ch); break; default: - abort (); + ABORT (); } closure->retval = call2 (closure->function, ranjarg, val); @@ -1414,22 +1443,28 @@ slow_map_char_table_fun (struct chartab_range *range, } DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /* -Map FUNCTION over entries in TABLE, calling it with two args, -each key and value in the table. +Map FUNCTION over CHAR-TABLE until it returns non-nil; return that value. +FUNCTION is called with two arguments, each key and entry in the table. -RANGE specifies a subrange to map over and is in the same format as -the RANGE argument to `put-range-table'. If omitted or t, it defaults to +RANGE specifies a subrange to map over. If omitted or t, it defaults to the entire table. + +Both RANGE and the keys passed to FUNCTION are in the same format as the +RANGE argument to `put-char-table'. N.B. This function does NOT map over +all characters in RANGE, but over the subranges that have been assigned to. +Thus this function is most suitable for searching a char-table, or for +populating one char-table based on the contents of another. The current +implementation does not coalesce ranges all of whose values are the same. */ - (function, table, range)) + (function, char_table, range)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; struct slow_map_char_table_arg slarg; struct gcpro gcpro1, gcpro2; struct chartab_range rainj; - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); + CHECK_CHAR_TABLE (char_table); + ct = XCHAR_TABLE (char_table); if (NILP (range)) range = Qt; decode_char_table_range (range, &rainj); @@ -1529,7 +1564,7 @@ chartab_instantiate (Lisp_Object data) Fput_char_table (make_char (i), val, chartab); } else - abort (); + ABORT (); } else Fput_char_table (range, val, chartab); @@ -1546,7 +1581,7 @@ chartab_instantiate (Lisp_Object data) /************************************************************************/ DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /* -Return t if ARG is a category table. +Return t if OBJECT is a category table. A category table is a type of char table used for keeping track of categories. Categories are used for classifying characters for use in regexps -- you can refer to a category rather than having to use @@ -1569,29 +1604,29 @@ whether the character is in that category. Special Lisp functions are provided that abstract this, so you do not have to directly manipulate bit vectors. */ - (obj)) + (object)) { - return (CHAR_TABLEP (obj) && - XCHAR_TABLE_TYPE (obj) == CHAR_TABLE_TYPE_CATEGORY) ? + return (CHAR_TABLEP (object) && + XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ? Qt : Qnil; } static Lisp_Object -check_category_table (Lisp_Object obj, Lisp_Object def) +check_category_table (Lisp_Object object, Lisp_Object default_) { - if (NILP (obj)) - obj = def; - while (NILP (Fcategory_table_p (obj))) - obj = wrong_type_argument (Qcategory_table_p, obj); - return obj; + if (NILP (object)) + object = default_; + while (NILP (Fcategory_table_p (object))) + object = wrong_type_argument (Qcategory_table_p, object); + return object; } int check_category_char (Emchar ch, Lisp_Object table, - unsigned int designator, unsigned int not) + unsigned int designator, unsigned int not_p) { REGISTER Lisp_Object temp; - struct Lisp_Char_Table *ctbl; + Lisp_Char_Table *ctbl; #ifdef ERROR_CHECK_TYPECHECK if (NILP (Fcategory_table_p (table))) signal_simple_error ("Expected category table", table); @@ -1599,39 +1634,40 @@ check_category_char (Emchar ch, Lisp_Object table, ctbl = XCHAR_TABLE (table); temp = get_char_table (ch, ctbl); if (NILP (temp)) - return not; + return not_p; designator -= ' '; - return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not; + return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p; } DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /* -Return t if category of a character at POS includes DESIGNATOR, -else return nil. Optional third arg specifies which buffer -\(defaulting to current), and fourth specifies the CATEGORY-TABLE, -\(defaulting to the buffer's category table). +Return t if category of the character at POSITION includes DESIGNATOR. +Optional third arg BUFFER specifies which buffer to use, and defaults +to the current buffer. +Optional fourth arg CATEGORY-TABLE specifies the category table to +use, and defaults to BUFFER's category table. */ - (pos, designator, buffer, category_table)) + (position, designator, buffer, category_table)) { Lisp_Object ctbl; Emchar ch; unsigned int des; struct buffer *buf = decode_buffer (buffer, 0); - CHECK_INT (pos); + CHECK_INT (position); CHECK_CATEGORY_DESIGNATOR (designator); des = XCHAR (designator); ctbl = check_category_table (category_table, Vstandard_category_table); - ch = BUF_FETCH_CHAR (buf, XINT (pos)); + ch = BUF_FETCH_CHAR (buf, XINT (position)); return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; } DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /* -Return t if category of character CHR includes DESIGNATOR, else nil. -Optional third arg specifies the CATEGORY-TABLE to use, -which defaults to the system default table. +Return t if category of CHARACTER includes DESIGNATOR, else nil. +Optional third arg CATEGORY-TABLE specifies the category table to use, +and defaults to the standard category table. */ - (chr, designator, category_table)) + (character, designator, category_table)) { Lisp_Object ctbl; Emchar ch; @@ -1639,16 +1675,15 @@ which defaults to the system default table. CHECK_CATEGORY_DESIGNATOR (designator); des = XCHAR (designator); - CHECK_CHAR (chr); - ch = XCHAR (chr); + CHECK_CHAR (character); + ch = XCHAR (character); ctbl = check_category_table (category_table, Vstandard_category_table); return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; } DEFUN ("category-table", Fcategory_table, 0, 1, 0, /* -Return the current category table. -This is the one specified by the current buffer, or by BUFFER if it -is non-nil. +Return BUFFER's current category table. +BUFFER defaults to the current buffer. */ (buffer)) { @@ -1665,57 +1700,124 @@ This is the one used for new buffers. } DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /* -Construct a new category table and return it. -It is a copy of the TABLE, which defaults to the standard category table. +Return a new category table which is a copy of CATEGORY-TABLE. +CATEGORY-TABLE defaults to the standard category table. */ - (table)) + (category_table)) { if (NILP (Vstandard_category_table)) return Fmake_char_table (Qcategory); - table = check_category_table (table, Vstandard_category_table); - return Fcopy_char_table (table); + category_table = + check_category_table (category_table, Vstandard_category_table); + return Fcopy_char_table (category_table); } DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /* -Select a new category table for BUFFER. -One argument, a category table. +Select CATEGORY-TABLE as the new category table for BUFFER. BUFFER defaults to the current buffer if omitted. */ - (table, buffer)) + (category_table, buffer)) { struct buffer *buf = decode_buffer (buffer, 0); - table = check_category_table (table, Qnil); - buf->category_table = table; + category_table = check_category_table (category_table, Qnil); + buf->category_table = category_table; /* Indicate that this buffer now has a specified category table. */ buf->local_var_flags |= XINT (buffer_local_flags.category_table); - return table; + return category_table; } DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /* -Return t if ARG is a category designator (a char in the range ' ' to '~'). +Return t if OBJECT is a category designator (a char in the range ' ' to '~'). */ - (obj)) + (object)) { - return CATEGORY_DESIGNATORP (obj) ? Qt : Qnil; + return CATEGORY_DESIGNATORP (object) ? Qt : Qnil; } DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /* -Return t if ARG is a category table value. +Return t if OBJECT is a category table value. Valid values are nil or a bit vector of size 95. */ - (obj)) + (object)) { - return CATEGORY_TABLE_VALUEP (obj) ? Qt : Qnil; + return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil; } + +#define CATEGORYP(x) \ + (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E) + +#define CATEGORY_SET(c) \ + (get_char_table(c, XCHAR_TABLE(current_buffer->category_table))) + +/* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. + The faster version of `!NILP (Faref (category_set, category))'. */ +#define CATEGORY_MEMBER(category, category_set) \ + (bit_vector_bit(XBIT_VECTOR (category_set), category - 32)) + +/* Return 1 if there is a word boundary between two word-constituent + characters C1 and C2 if they appear in this order, else return 0. + Use the macro WORD_BOUNDARY_P instead of calling this function + directly. */ + +int word_boundary_p (Emchar c1, Emchar c2); +int +word_boundary_p (Emchar c1, Emchar c2) +{ + Lisp_Object category_set1, category_set2; + Lisp_Object tail; + int default_result; + +#if 0 + if (COMPOSITE_CHAR_P (c1)) + c1 = cmpchar_component (c1, 0, 1); + if (COMPOSITE_CHAR_P (c2)) + c2 = cmpchar_component (c2, 0, 1); +#endif + + if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2))) + { + tail = Vword_separating_categories; + default_result = 0; + } + else + { + tail = Vword_combining_categories; + default_result = 1; + } + + category_set1 = CATEGORY_SET (c1); + if (NILP (category_set1)) + return default_result; + category_set2 = CATEGORY_SET (c2); + if (NILP (category_set2)) + return default_result; + + for (; CONSP (tail); tail = XCONS (tail)->cdr) + { + Lisp_Object elt = XCONS(tail)->car; + + if (CONSP (elt) + && CATEGORYP (XCONS (elt)->car) + && CATEGORYP (XCONS (elt)->cdr) + && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1) + && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2)) + return !default_result; + } + return default_result; +} #endif /* MULE */ void syms_of_chartab (void) { + INIT_LRECORD_IMPLEMENTATION (char_table); + #ifdef MULE + INIT_LRECORD_IMPLEMENTATION (char_table_entry); + defsymbol (&Qcategory_table_p, "category-table-p"); defsymbol (&Qcategory_designator_p, "category-designator-p"); defsymbol (&Qcategory_table_value_p, "category-table-value-p"); @@ -1750,8 +1852,14 @@ syms_of_chartab (void) DEFSUBR (Fcategory_table_value_p); #endif /* MULE */ +} + +void +vars_of_chartab (void) +{ /* DO NOT staticpro this. It works just like Vweak_hash_tables. */ Vall_syntax_tables = Qnil; + dump_add_weak_object_chain (&Vall_syntax_tables); } void @@ -1775,5 +1883,50 @@ complex_vars_of_chartab (void) Vstandard_category_table = Qnil; Vstandard_category_table = Fcopy_category_table (Qnil); staticpro (&Vstandard_category_table); + + DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /* +List of pair (cons) of categories to determine word boundary. + +Emacs treats a sequence of word constituent characters as a single +word (i.e. finds no word boundary between them) iff they belongs to +the same charset. But, exceptions are allowed in the following cases. + +\(1) The case that characters are in different charsets is controlled +by the variable `word-combining-categories'. + +Emacs finds no word boundary between characters of different charsets +if they have categories matching some element of this list. + +More precisely, if an element of this list is a cons of category CAT1 +and CAT2, and a multibyte character C1 which has CAT1 is followed by +C2 which has CAT2, there's no word boundary between C1 and C2. + +For instance, to tell that ASCII characters and Latin-1 characters can +form a single word, the element `(?l . ?l)' should be in this list +because both characters have the category `l' (Latin characters). + +\(2) The case that character are in the same charset is controlled by +the variable `word-separating-categories'. + +Emacs find a word boundary between characters of the same charset +if they have categories matching some element of this list. + +More precisely, if an element of this list is a cons of category CAT1 +and CAT2, and a multibyte character C1 which has CAT1 is followed by +C2 which has CAT2, there's a word boundary between C1 and C2. + +For instance, to tell that there's a word boundary between Japanese +Hiragana and Japanese Kanji (both are in the same charset), the +element `(?H . ?C) should be in this list. +*/ ); + + Vword_combining_categories = Qnil; + + DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /* +List of pair (cons) of categories to determine word boundary. +See the documentation of the variable `word-combining-categories'. +*/ ); + + Vword_separating_categories = Qnil; #endif /* MULE */ }