diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/casetab.c | 134 |
1 files changed, 42 insertions, 92 deletions
diff --git a/src/casetab.c b/src/casetab.c index c5a4e7a0307..29a237cb948 100644 --- a/src/casetab.c +++ b/src/casetab.c | |||
| @@ -29,7 +29,13 @@ Lisp_Object Qcase_table_p, Qcase_table; | |||
| 29 | Lisp_Object Vascii_downcase_table, Vascii_upcase_table; | 29 | Lisp_Object Vascii_downcase_table, Vascii_upcase_table; |
| 30 | Lisp_Object Vascii_canon_table, Vascii_eqv_table; | 30 | Lisp_Object Vascii_canon_table, Vascii_eqv_table; |
| 31 | 31 | ||
| 32 | static void compute_trt_inverse (); | 32 | /* Used as a temporary in DOWNCASE and other macros in lisp.h. No |
| 33 | need to mark it, since it is used only very temporarily. */ | ||
| 34 | Lisp_Object case_temp1, case_temp2; | ||
| 35 | |||
| 36 | static void set_canon (); | ||
| 37 | static void set_identity (); | ||
| 38 | static void shuffle (); | ||
| 33 | 39 | ||
| 34 | DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, | 40 | DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, |
| 35 | "Return t iff OBJECT is a case table.\n\ | 41 | "Return t iff OBJECT is a case table.\n\ |
| @@ -120,6 +126,7 @@ set_case_table (table, standard) | |||
| 120 | int standard; | 126 | int standard; |
| 121 | { | 127 | { |
| 122 | Lisp_Object up, canon, eqv; | 128 | Lisp_Object up, canon, eqv; |
| 129 | Lisp_Object indices[3]; | ||
| 123 | 130 | ||
| 124 | check_case_table (table); | 131 | check_case_table (table); |
| 125 | 132 | ||
| @@ -130,30 +137,23 @@ set_case_table (table, standard) | |||
| 130 | if (NILP (up)) | 137 | if (NILP (up)) |
| 131 | { | 138 | { |
| 132 | up = Fmake_char_table (Qcase_table, Qnil); | 139 | up = Fmake_char_table (Qcase_table, Qnil); |
| 133 | compute_trt_inverse (table, up); | 140 | map_char_table (set_identity, Qnil, table, up, 0, indices); |
| 141 | map_char_table (shuffle, Qnil, table, up, 0, indices); | ||
| 134 | XCHAR_TABLE (table)->extras[0] = up; | 142 | XCHAR_TABLE (table)->extras[0] = up; |
| 135 | } | 143 | } |
| 136 | 144 | ||
| 137 | if (NILP (canon)) | 145 | if (NILP (canon)) |
| 138 | { | 146 | { |
| 139 | register int i; | ||
| 140 | Lisp_Object *upvec = XCHAR_TABLE (up)->contents; | ||
| 141 | Lisp_Object *downvec = XCHAR_TABLE (table)->contents; | ||
| 142 | |||
| 143 | canon = Fmake_char_table (Qcase_table, Qnil); | 147 | canon = Fmake_char_table (Qcase_table, Qnil); |
| 144 | |||
| 145 | /* Set up the CANON vector; for each character, | ||
| 146 | this sequence of upcasing and downcasing ought to | ||
| 147 | get the "preferred" lowercase equivalent. */ | ||
| 148 | for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) | ||
| 149 | XCHAR_TABLE (canon)->contents[i] = downvec[upvec[downvec[i]]]; | ||
| 150 | XCHAR_TABLE (table)->extras[1] = canon; | 148 | XCHAR_TABLE (table)->extras[1] = canon; |
| 149 | map_char_table (set_canon, Qnil, table, table, 0, indices); | ||
| 151 | } | 150 | } |
| 152 | 151 | ||
| 153 | if (NILP (eqv)) | 152 | if (NILP (eqv)) |
| 154 | { | 153 | { |
| 155 | eqv = Fmake_char_table (Qcase_table, Qnil); | 154 | eqv = Fmake_char_table (Qcase_table, Qnil); |
| 156 | compute_trt_inverse (canon, eqv); | 155 | map_char_table (set_identity, Qnil, canon, eqv, 0, indices); |
| 156 | map_char_table (shuffle, Qnil, canon, eqv, 0, indices); | ||
| 157 | XCHAR_TABLE (table)->extras[2] = eqv; | 157 | XCHAR_TABLE (table)->extras[2] = eqv; |
| 158 | } | 158 | } |
| 159 | 159 | ||
| @@ -170,99 +170,49 @@ set_case_table (table, standard) | |||
| 170 | return table; | 170 | return table; |
| 171 | } | 171 | } |
| 172 | 172 | ||
| 173 | /* Using the scratch array at BYTES of which the first DEPTH elements | 173 | /* The following functions are called in map_char_table. */ |
| 174 | are already set, and using the multi-byte structure inherited from | 174 | |
| 175 | TRT, make INVERSE be an identity mapping. That is, for each slot | 175 | /* Set CANON char-table element for C to a translated ELT by UP and |
| 176 | that's indexed by a single byte, store that byte in INVERSE. | 176 | DOWN char-tables. This is done only when ELT is a character. The |
| 177 | Where TRT has a subtable, make a corresponding subtable in INVERSE | 177 | char-tables CANON, UP, and DOWN are in CASE_TABLE. */ |
| 178 | and recursively initialize that subtable so that its elements are | ||
| 179 | the multi-byte characters that correspond to the index bytes. | ||
| 180 | This is the first step in generating an inverse mapping. */ | ||
| 181 | 178 | ||
| 182 | static void | 179 | static void |
| 183 | compute_trt_identity (bytes, depth, trt, inverse) | 180 | set_canon (case_table, c, elt) |
| 184 | unsigned char *bytes; | 181 | Lisp_Object case_table, c, elt; |
| 185 | int depth; | ||
| 186 | struct Lisp_Char_Table *trt, *inverse; | ||
| 187 | { | 182 | { |
| 188 | register int i; | 183 | Lisp_Object up = XCHAR_TABLE (case_table)->extras[0]; |
| 189 | int lim = (depth == 0 ? CHAR_TABLE_ORDINARY_SLOTS : SUB_CHAR_TABLE_ORDINARY_SLOTS); | 184 | Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; |
| 190 | 185 | ||
| 191 | for (i = 0; i < lim; i++) | 186 | if (NATNUMP (elt)) |
| 192 | { | 187 | Faset (canon, c, Faref (case_table, Faref (up, elt))); |
| 193 | if (NATNUMP (trt->contents[i])) | ||
| 194 | { | ||
| 195 | bytes[depth] = i; | ||
| 196 | XSETFASTINT (inverse->contents[i], | ||
| 197 | (depth == 0 && i < CHAR_TABLE_SINGLE_BYTE_SLOTS ? i | ||
| 198 | : MAKE_NON_ASCII_CHAR (bytes[0], bytes[1], bytes[2]))); | ||
| 199 | } | ||
| 200 | else if (SUB_CHAR_TABLE_P (trt->contents[i])) | ||
| 201 | { | ||
| 202 | bytes[depth] = i - 128; | ||
| 203 | inverse->contents[i] = make_sub_char_table (Qnil); | ||
| 204 | compute_trt_identity (bytes, depth + 1, | ||
| 205 | XCHAR_TABLE (trt->contents[i]), | ||
| 206 | XCHAR_TABLE (inverse->contents[i])); | ||
| 207 | } | ||
| 208 | else /* must be Qnil or Qidentity */ | ||
| 209 | inverse->contents[i] = trt->contents[i]; | ||
| 210 | } | ||
| 211 | } | 188 | } |
| 212 | 189 | ||
| 213 | /* Using the scratch array at BYTES of which the first DEPTH elements | 190 | /* Set elements of char-table TABLE for C to C itself. This is done |
| 214 | are already set, permute the elements of INVERSE (which is initially | 191 | only when ELT is a character. This is called in map_char_table. */ |
| 215 | an identity mapping) so that it has one cycle for each equivalence | ||
| 216 | class induced by the translation table TRT. IBASE is the lispy | ||
| 217 | version of the outermost (depth 0) instance of INVERSE. */ | ||
| 218 | 192 | ||
| 219 | static void | 193 | static void |
| 220 | compute_trt_shuffle (bytes, depth, ibase, trt, inverse) | 194 | set_identity (table, c, elt) |
| 221 | unsigned char *bytes; | 195 | Lisp_Object table, c, elt; |
| 222 | int depth; | ||
| 223 | Lisp_Object ibase; | ||
| 224 | struct Lisp_Char_Table *trt, *inverse; | ||
| 225 | { | 196 | { |
| 226 | register int i; | 197 | if (NATNUMP (elt)) |
| 227 | Lisp_Object j, tem, q; | 198 | Faset (table, c, c); |
| 228 | int lim = (depth == 0 ? CHAR_TABLE_ORDINARY_SLOTS : SUB_CHAR_TABLE_ORDINARY_SLOTS); | ||
| 229 | |||
| 230 | for (i = 0; i < lim; i++) | ||
| 231 | { | ||
| 232 | bytes[depth] = i; | ||
| 233 | XSETFASTINT (j, | ||
| 234 | (depth == 0 && i < CHAR_TABLE_SINGLE_BYTE_SLOTS ? i | ||
| 235 | : MAKE_NON_ASCII_CHAR (bytes[0], bytes[1], bytes[2]))); | ||
| 236 | q = trt->contents[i]; | ||
| 237 | if (NATNUMP (q) && XFASTINT (q) != XFASTINT (j)) | ||
| 238 | { | ||
| 239 | tem = Faref (ibase, q); | ||
| 240 | Faset (ibase, q, j); | ||
| 241 | Faset (ibase, j, tem); | ||
| 242 | } | ||
| 243 | else if (SUB_CHAR_TABLE_P (q)) | ||
| 244 | { | ||
| 245 | bytes[depth] = i - 128; | ||
| 246 | compute_trt_shuffle (bytes, depth + 1, ibase, | ||
| 247 | XCHAR_TABLE (trt->contents[i]), | ||
| 248 | XCHAR_TABLE (inverse->contents[i])); | ||
| 249 | } | ||
| 250 | } | ||
| 251 | } | 199 | } |
| 252 | 200 | ||
| 253 | /* Given a translate table TRT, store the inverse mapping into INVERSE. | 201 | /* Permute the elements of TABLE (which is initially an identity |
| 254 | Since TRT is not one-to-one, INVERSE is not a simple mapping. | 202 | mapping) so that it has one cycle for each equivalence class |
| 255 | Instead, it divides the space of characters into equivalence classes. | 203 | induced by the translation table on which map_char_table is |
| 256 | All characters in a given class form one circular list, chained through | 204 | operated. */ |
| 257 | the elements of INVERSE. */ | ||
| 258 | 205 | ||
| 259 | static void | 206 | static void |
| 260 | compute_trt_inverse (trt, inv) | 207 | shuffle (table, c, elt) |
| 261 | Lisp_Object trt, inv; | 208 | Lisp_Object table, c, elt; |
| 262 | { | 209 | { |
| 263 | unsigned char bytes[3]; | 210 | if (NATNUMP (elt) && c != elt) |
| 264 | compute_trt_identity (bytes, 0, XCHAR_TABLE (trt), XCHAR_TABLE (inv)); | 211 | { |
| 265 | compute_trt_shuffle (bytes, 0, inv, XCHAR_TABLE (trt), XCHAR_TABLE (inv)); | 212 | Lisp_Object tem = Faref (table, elt); |
| 213 | Faset (table, elt, c); | ||
| 214 | Faset (table, c, tem); | ||
| 215 | } | ||
| 266 | } | 216 | } |
| 267 | 217 | ||
| 268 | init_casetab_once () | 218 | init_casetab_once () |