X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e16696bacc4aa567d04fa725cc4c1f2913d6e2c7..c90e7e43b102a9732ea4ef7a292f51cec881d463:/src/casetab.c diff --git a/src/casetab.c b/src/casetab.c index c5a4e7a030..6fc2d415fd 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -29,12 +29,19 @@ Lisp_Object Qcase_table_p, Qcase_table; Lisp_Object Vascii_downcase_table, Vascii_upcase_table; Lisp_Object Vascii_canon_table, Vascii_eqv_table; -static void compute_trt_inverse (); +/* Used as a temporary in DOWNCASE and other macros in lisp.h. No + need to mark it, since it is used only very temporarily. */ +int case_temp1; +Lisp_Object case_temp2; + +static void set_canon (); +static void set_identity (); +static void shuffle (); DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, - "Return t iff OBJECT is a case table.\n\ -See `set-case-table' for more information on these data structures.") - (object) + doc: /* Return t iff OBJECT is a case table. +See `set-case-table' for more information on these data structures. */) + (object) Lisp_Object object; { Lisp_Object up, canon, eqv; @@ -64,19 +71,19 @@ check_case_table (obj) while (tem = Fcase_table_p (obj), NILP (tem)) obj = wrong_type_argument (Qcase_table_p, obj); return (obj); -} +} DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0, - "Return the case table of the current buffer.") - () + doc: /* Return the case table of the current buffer. */) + () { return current_buffer->downcase_table; } DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, - "Return the standard case table.\n\ -This is the one used for new buffers.") - () + doc: /* Return the standard case table. +This is the one used for new buffers. */) + () { return Vascii_downcase_table; } @@ -84,31 +91,31 @@ This is the one used for new buffers.") static Lisp_Object set_case_table (); DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0, - "Select a new case table for the current buffer.\n\ -A case table is a char-table which maps characters\n\ -to their lower-case equivalents. It also has three \"extra\" slots\n\ -which may be additional char-tables or nil.\n\ -These slots are called UPCASE, CANONICALIZE and EQUIVALENCES.\n\ -UPCASE maps each character to its upper-case equivalent;\n\ - if lower and upper case characters are in 1-1 correspondence,\n\ - you may use nil and the upcase table will be deduced from DOWNCASE.\n\ -CANONICALIZE maps each character to a canonical equivalent;\n\ - any two characters that are related by case-conversion have the same\n\ - canonical equivalent character; it may be nil, in which case it is\n\ - deduced from DOWNCASE and UPCASE.\n\ -EQUIVALENCES is a map that cyclicly permutes each equivalence class\n\ - (of characters with the same canonical equivalent); it may be nil,\n\ - in which case it is deduced from CANONICALIZE.") - (table) + doc: /* Select a new case table for the current buffer. +A case table is a char-table which maps characters +to their lower-case equivalents. It also has three \"extra\" slots +which may be additional char-tables or nil. +These slots are called UPCASE, CANONICALIZE and EQUIVALENCES. +UPCASE maps each character to its upper-case equivalent; + if lower and upper case characters are in 1-1 correspondence, + you may use nil and the upcase table will be deduced from DOWNCASE. +CANONICALIZE maps each character to a canonical equivalent; + any two characters that are related by case-conversion have the same + canonical equivalent character; it may be nil, in which case it is + deduced from DOWNCASE and UPCASE. +EQUIVALENCES is a map that cyclicly permutes each equivalence class + (of characters with the same canonical equivalent); it may be nil, + in which case it is deduced from CANONICALIZE. */) + (table) Lisp_Object table; { return set_case_table (table, 0); } DEFUN ("set-standard-case-table", Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0, - "Select a new standard case table for new buffers.\n\ -See `set-case-table' for more info on case tables.") - (table) + doc: /* Select a new standard case table for new buffers. +See `set-case-table' for more info on case tables. */) + (table) Lisp_Object table; { return set_case_table (table, 1); @@ -120,6 +127,7 @@ set_case_table (table, standard) int standard; { Lisp_Object up, canon, eqv; + Lisp_Object indices[3]; check_case_table (table); @@ -130,33 +138,29 @@ set_case_table (table, standard) if (NILP (up)) { up = Fmake_char_table (Qcase_table, Qnil); - compute_trt_inverse (table, up); + map_char_table (set_identity, Qnil, table, table, up, 0, indices); + map_char_table (shuffle, Qnil, table, table, up, 0, indices); XCHAR_TABLE (table)->extras[0] = up; } if (NILP (canon)) { - register int i; - Lisp_Object *upvec = XCHAR_TABLE (up)->contents; - Lisp_Object *downvec = XCHAR_TABLE (table)->contents; - canon = Fmake_char_table (Qcase_table, Qnil); - - /* Set up the CANON vector; for each character, - this sequence of upcasing and downcasing ought to - get the "preferred" lowercase equivalent. */ - for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) - XCHAR_TABLE (canon)->contents[i] = downvec[upvec[downvec[i]]]; XCHAR_TABLE (table)->extras[1] = canon; + map_char_table (set_canon, Qnil, table, table, table, 0, indices); } if (NILP (eqv)) { eqv = Fmake_char_table (Qcase_table, Qnil); - compute_trt_inverse (canon, eqv); + map_char_table (set_identity, Qnil, canon, canon, eqv, 0, indices); + map_char_table (shuffle, Qnil, canon, canon, eqv, 0, indices); XCHAR_TABLE (table)->extras[2] = eqv; } + /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ + XCHAR_TABLE (canon)->extras[2] = eqv; + if (standard) Vascii_downcase_table = table; else @@ -170,101 +174,52 @@ set_case_table (table, standard) return table; } -/* Using the scratch array at BYTES of which the first DEPTH elements - are already set, and using the multi-byte structure inherited from - TRT, make INVERSE be an identity mapping. That is, for each slot - that's indexed by a single byte, store that byte in INVERSE. - Where TRT has a subtable, make a corresponding subtable in INVERSE - and recursively initialize that subtable so that its elements are - the multi-byte characters that correspond to the index bytes. - This is the first step in generating an inverse mapping. */ +/* The following functions are called in map_char_table. */ + +/* Set CANON char-table element for C to a translated ELT by UP and + DOWN char-tables. This is done only when ELT is a character. The + char-tables CANON, UP, and DOWN are in CASE_TABLE. */ static void -compute_trt_identity (bytes, depth, trt, inverse) - unsigned char *bytes; - int depth; - struct Lisp_Char_Table *trt, *inverse; +set_canon (case_table, c, elt) + Lisp_Object case_table, c, elt; { - register int i; - int lim = (depth == 0 ? CHAR_TABLE_ORDINARY_SLOTS : SUB_CHAR_TABLE_ORDINARY_SLOTS); + Lisp_Object up = XCHAR_TABLE (case_table)->extras[0]; + Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; - for (i = 0; i < lim; i++) - { - if (NATNUMP (trt->contents[i])) - { - bytes[depth] = i; - XSETFASTINT (inverse->contents[i], - (depth == 0 && i < CHAR_TABLE_SINGLE_BYTE_SLOTS ? i - : MAKE_NON_ASCII_CHAR (bytes[0], bytes[1], bytes[2]))); - } - else if (SUB_CHAR_TABLE_P (trt->contents[i])) - { - bytes[depth] = i - 128; - inverse->contents[i] = make_sub_char_table (Qnil); - compute_trt_identity (bytes, depth + 1, - XCHAR_TABLE (trt->contents[i]), - XCHAR_TABLE (inverse->contents[i])); - } - else /* must be Qnil or Qidentity */ - inverse->contents[i] = trt->contents[i]; - } + if (NATNUMP (elt)) + Faset (canon, c, Faref (case_table, Faref (up, elt))); } -/* Using the scratch array at BYTES of which the first DEPTH elements - are already set, permute the elements of INVERSE (which is initially - an identity mapping) so that it has one cycle for each equivalence - class induced by the translation table TRT. IBASE is the lispy - version of the outermost (depth 0) instance of INVERSE. */ +/* Set elements of char-table TABLE for C to C itself. This is done + only when ELT is a character. This is called in map_char_table. */ static void -compute_trt_shuffle (bytes, depth, ibase, trt, inverse) - unsigned char *bytes; - int depth; - Lisp_Object ibase; - struct Lisp_Char_Table *trt, *inverse; +set_identity (table, c, elt) + Lisp_Object table, c, elt; { - register int i; - Lisp_Object j, tem, q; - int lim = (depth == 0 ? CHAR_TABLE_ORDINARY_SLOTS : SUB_CHAR_TABLE_ORDINARY_SLOTS); - - for (i = 0; i < lim; i++) - { - bytes[depth] = i; - XSETFASTINT (j, - (depth == 0 && i < CHAR_TABLE_SINGLE_BYTE_SLOTS ? i - : MAKE_NON_ASCII_CHAR (bytes[0], bytes[1], bytes[2]))); - q = trt->contents[i]; - if (NATNUMP (q) && XFASTINT (q) != XFASTINT (j)) - { - tem = Faref (ibase, q); - Faset (ibase, q, j); - Faset (ibase, j, tem); - } - else if (SUB_CHAR_TABLE_P (q)) - { - bytes[depth] = i - 128; - compute_trt_shuffle (bytes, depth + 1, ibase, - XCHAR_TABLE (trt->contents[i]), - XCHAR_TABLE (inverse->contents[i])); - } - } + if (NATNUMP (elt)) + Faset (table, c, c); } -/* Given a translate table TRT, store the inverse mapping into INVERSE. - Since TRT is not one-to-one, INVERSE is not a simple mapping. - Instead, it divides the space of characters into equivalence classes. - All characters in a given class form one circular list, chained through - the elements of INVERSE. */ +/* Permute the elements of TABLE (which is initially an identity + mapping) so that it has one cycle for each equivalence class + induced by the translation table on which map_char_table is + operated. */ static void -compute_trt_inverse (trt, inv) - Lisp_Object trt, inv; +shuffle (table, c, elt) + Lisp_Object table, c, elt; { - unsigned char bytes[3]; - compute_trt_identity (bytes, 0, XCHAR_TABLE (trt), XCHAR_TABLE (inv)); - compute_trt_shuffle (bytes, 0, inv, XCHAR_TABLE (trt), XCHAR_TABLE (inv)); + if (NATNUMP (elt) && !EQ (c, elt)) + { + Lisp_Object tem = Faref (table, elt); + Faset (table, elt, c); + Faset (table, c, tem); + } } +void init_casetab_once () { register int i; @@ -305,6 +260,7 @@ init_casetab_once () XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); } +void syms_of_casetab () { Qcase_table_p = intern ("case-table-p"); @@ -321,3 +277,6 @@ syms_of_casetab () defsubr (&Sset_case_table); defsubr (&Sset_standard_case_table); } + +/* arch-tag: e06388ad-99fe-40ec-ba67-9d010fcc4916 + (do not change this comment) */