X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8f84b1a1be7c933e56b69cf3382e389ff13f1bfa..5a9807a8bda5980633db765300dad40ee3aed2c6:/src/casetab.c diff --git a/src/casetab.c b/src/casetab.c index 3a008da5f4..874bb7599f 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -1,5 +1,6 @@ /* GNU Emacs routines to deal with case tables. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1993, 1994, 2002, 2003, 2004, + 2005 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,25 +16,33 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ -/* Written by Howard Gayle. See chartab.c for details. */ +/* Written by Howard Gayle. */ #include #include "lisp.h" #include "buffer.h" +#include "charset.h" 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; @@ -63,19 +72,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; } @@ -83,31 +92,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); @@ -119,6 +128,7 @@ set_case_table (table, standard) int standard; { Lisp_Object up, canon, eqv; + Lisp_Object indices[3]; check_case_table (table); @@ -129,35 +139,36 @@ set_case_table (table, standard) if (NILP (up)) { up = Fmake_char_table (Qcase_table, Qnil); - compute_trt_inverse (XCHAR_TABLE (table), XCHAR_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 < 256; 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 (XCHAR_TABLE (canon), XCHAR_TABLE (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; + { + Vascii_downcase_table = table; + Vascii_upcase_table = up; + Vascii_canon_table = canon; + Vascii_eqv_table = eqv; + } else { current_buffer->downcase_table = table; @@ -169,33 +180,52 @@ set_case_table (table, standard) return table; } -/* 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. */ +/* 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_inverse (trt, inverse) - struct Lisp_Char_Table *trt, *inverse; +set_canon (case_table, c, elt) + Lisp_Object case_table, c, elt; { - register int i = 0400; - register unsigned char c, q; + Lisp_Object up = XCHAR_TABLE (case_table)->extras[0]; + Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; + + if (NATNUMP (elt)) + Faset (canon, c, Faref (case_table, Faref (up, elt))); +} - while (i--) - inverse->contents[i] = i; - i = 0400; - while (i--) +/* 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 +set_identity (table, c, elt) + Lisp_Object table, c, elt; +{ + if (NATNUMP (elt)) + Faset (table, c, c); +} + +/* 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 +shuffle (table, c, elt) + Lisp_Object table, c, elt; +{ + if (NATNUMP (elt) && !EQ (c, elt)) { - if ((q = trt->contents[i]) != (unsigned char) i) - { - c = inverse->contents[q]; - inverse->contents[q] = i; - inverse->contents[i] = c; - } + Lisp_Object tem = Faref (table, elt); + Faset (table, elt, c); + Faset (table, c, tem); } } +void init_casetab_once () { register int i; @@ -214,26 +244,29 @@ init_casetab_once () down = Fmake_char_table (Qcase_table, Qnil); Vascii_downcase_table = down; + XCHAR_TABLE (down)->purpose = Qcase_table; - for (i = 0; i < 256; i++) - XCHAR_TABLE (down)->contents[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; + for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) + XSETFASTINT (XCHAR_TABLE (down)->contents[i], + (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i); XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down); up = Fmake_char_table (Qcase_table, Qnil); XCHAR_TABLE (down)->extras[0] = up; - for (i = 0; i < 256; i++) - XCHAR_TABLE (up)->contents[i] - = ((i >= 'A' && i <= 'Z') - ? i + ('a' - 'A') - : ((i >= 'a' && i <= 'z') - ? i + ('A' - 'a') - : i)); + for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) + XSETFASTINT (XCHAR_TABLE (up)->contents[i], + ((i >= 'A' && i <= 'Z') + ? i + ('a' - 'A') + : ((i >= 'a' && i <= 'z') + ? i + ('A' - 'a') + : i))); XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); } +void syms_of_casetab () { Qcase_table_p = intern ("case-table-p"); @@ -250,3 +283,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) */