diff options
| author | Richard M. Stallman | 1995-10-19 00:14:14 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1995-10-19 00:14:14 +0000 |
| commit | 7f7fef044cc38f5457d91de2ed35d8f142b86a0a (patch) | |
| tree | c46811d778e35572b9d157230187ada524ba8ab0 /src | |
| parent | c6a3c83c505cfe9924ea160c54c78c7562d065ab (diff) | |
| download | emacs-7f7fef044cc38f5457d91de2ed35d8f142b86a0a.tar.gz emacs-7f7fef044cc38f5457d91de2ed35d8f142b86a0a.zip | |
Case tables are now char-tables,
and the case table is stored in the downcase_table slot only.
(Fcurrent_case_table, Fstandard_case_table, set_case_table)
(compute_trt_inverse, init_casetab_once): Use new data format.
Diffstat (limited to 'src')
| -rw-r--r-- | src/casetab.c | 142 |
1 files changed, 66 insertions, 76 deletions
diff --git a/src/casetab.c b/src/casetab.c index 417597543e3..fa6ad91a155 100644 --- a/src/casetab.c +++ b/src/casetab.c | |||
| @@ -23,11 +23,11 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |||
| 23 | #include "lisp.h" | 23 | #include "lisp.h" |
| 24 | #include "buffer.h" | 24 | #include "buffer.h" |
| 25 | 25 | ||
| 26 | Lisp_Object Qcase_table_p; | 26 | Lisp_Object Qcase_table_p, Qcase_table; |
| 27 | Lisp_Object Vascii_downcase_table, Vascii_upcase_table; | 27 | Lisp_Object Vascii_downcase_table, Vascii_upcase_table; |
| 28 | Lisp_Object Vascii_canon_table, Vascii_eqv_table; | 28 | Lisp_Object Vascii_canon_table, Vascii_eqv_table; |
| 29 | 29 | ||
| 30 | void compute_trt_inverse (); | 30 | static void compute_trt_inverse (); |
| 31 | 31 | ||
| 32 | DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, | 32 | DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, |
| 33 | "Return t iff ARG is a case table.\n\ | 33 | "Return t iff ARG is a case table.\n\ |
| @@ -36,18 +36,20 @@ See `set-case-table' for more information on these data structures.") | |||
| 36 | Lisp_Object table; | 36 | Lisp_Object table; |
| 37 | { | 37 | { |
| 38 | Lisp_Object down, up, canon, eqv; | 38 | Lisp_Object down, up, canon, eqv; |
| 39 | down = Fcar_safe (table); | ||
| 40 | up = Fcar_safe (Fcdr_safe (table)); | ||
| 41 | canon = Fcar_safe (Fcdr_safe (Fcdr_safe (table))); | ||
| 42 | eqv = Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table)))); | ||
| 43 | 39 | ||
| 44 | #define STRING256_P(obj) (STRINGP (obj) && XSTRING (obj)->size == 256) | 40 | if (! CHAR_TABLE_P (table)) |
| 41 | return Qnil; | ||
| 42 | if (! EQ (XCHAR_TABLE (table)->purpose, Qcase_table)) | ||
| 43 | return Qnil; | ||
| 45 | 44 | ||
| 46 | return (STRING256_P (down) | 45 | up = XCHAR_TABLE (table)->extras[0]; |
| 47 | && (NILP (up) || STRING256_P (up)) | 46 | canon = XCHAR_TABLE (table)->extras[1]; |
| 47 | eqv = XCHAR_TABLE (table)->extras[2]; | ||
| 48 | |||
| 49 | return ((NILP (up) || CHAR_TABLE_P (up)) | ||
| 48 | && ((NILP (canon) && NILP (eqv)) | 50 | && ((NILP (canon) && NILP (eqv)) |
| 49 | || (STRING256_P (canon) | 51 | || (CHAR_TABLE_P (canon) |
| 50 | && (NILP (eqv) || STRING256_P (eqv)))) | 52 | && (NILP (eqv) || CHAR_TABLE_P (eqv)))) |
| 51 | ? Qt : Qnil); | 53 | ? Qt : Qnil); |
| 52 | } | 54 | } |
| 53 | 55 | ||
| @@ -68,12 +70,7 @@ DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0, | |||
| 68 | { | 70 | { |
| 69 | Lisp_Object down, up, canon, eqv; | 71 | Lisp_Object down, up, canon, eqv; |
| 70 | 72 | ||
| 71 | down = current_buffer->downcase_table; | 73 | return current_buffer->downcase_table; |
| 72 | up = current_buffer->upcase_table; | ||
| 73 | canon = current_buffer->case_canon_table; | ||
| 74 | eqv = current_buffer->case_eqv_table; | ||
| 75 | |||
| 76 | return Fcons (down, Fcons (up, Fcons (canon, Fcons (eqv, Qnil)))); | ||
| 77 | } | 74 | } |
| 78 | 75 | ||
| 79 | DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, | 76 | DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, |
| @@ -81,19 +78,17 @@ DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, | |||
| 81 | This is the one used for new buffers.") | 78 | This is the one used for new buffers.") |
| 82 | () | 79 | () |
| 83 | { | 80 | { |
| 84 | return Fcons (Vascii_downcase_table, | 81 | return Vascii_downcase_table; |
| 85 | Fcons (Vascii_upcase_table, | ||
| 86 | Fcons (Vascii_canon_table, | ||
| 87 | Fcons (Vascii_eqv_table, Qnil)))); | ||
| 88 | } | 82 | } |
| 89 | 83 | ||
| 90 | static Lisp_Object set_case_table (); | 84 | static Lisp_Object set_case_table (); |
| 91 | 85 | ||
| 92 | DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0, | 86 | DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0, |
| 93 | "Select a new case table for the current buffer.\n\ | 87 | "Select a new case table for the current buffer.\n\ |
| 94 | A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)\n\ | 88 | A case table is a char-table which maps characters |
| 95 | where each element is either nil or a string of length 256.\n\ | 89 | to their lower-case equivalents. It also has three \"extra\" slots |
| 96 | DOWNCASE maps each character to its lower-case equivalent.\n\ | 90 | which may be additional char-tables or nil. |
| 91 | These slots are called UPCASE, CANONICALIZE and EQUIVALENCES.\n\ | ||
| 97 | UPCASE maps each character to its upper-case equivalent;\n\ | 92 | UPCASE maps each character to its upper-case equivalent;\n\ |
| 98 | if lower and upper case characters are in 1-1 correspondence,\n\ | 93 | if lower and upper case characters are in 1-1 correspondence,\n\ |
| 99 | you may use nil and the upcase table will be deduced from DOWNCASE.\n\ | 94 | you may use nil and the upcase table will be deduced from DOWNCASE.\n\ |
| @@ -128,53 +123,45 @@ set_case_table (table, standard) | |||
| 128 | 123 | ||
| 129 | check_case_table (table); | 124 | check_case_table (table); |
| 130 | 125 | ||
| 131 | down = Fcar_safe (table); | 126 | up = XCHAR_TABLE (table)->extras[0]; |
| 132 | up = Fcar_safe (Fcdr_safe (table)); | 127 | canon = XCHAR_TABLE (table)->extras[1]; |
| 133 | canon = Fcar_safe (Fcdr_safe (Fcdr_safe (table))); | 128 | eqv = XCHAR_TABLE (table)->extras[2]; |
| 134 | eqv = Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table)))); | ||
| 135 | 129 | ||
| 136 | if (NILP (up)) | 130 | if (NILP (up)) |
| 137 | { | 131 | { |
| 138 | up = Fmake_string (make_number (256), make_number (0)); | 132 | up = Fmake_char_table (Qcase_table, Qnil); |
| 139 | compute_trt_inverse (XSTRING (down)->data, XSTRING (up)->data); | 133 | compute_trt_inverse (XCHAR_TABLE (down), XCHAR_TABLE (up)); |
| 134 | XCHAR_TABLE (table)->extras[0] = up; | ||
| 140 | } | 135 | } |
| 141 | 136 | ||
| 142 | if (NILP (canon)) | 137 | if (NILP (canon)) |
| 143 | { | 138 | { |
| 144 | register int i; | 139 | register int i; |
| 145 | unsigned char *upvec = XSTRING (up)->data; | 140 | Lisp_Object *upvec = XCHAR_TABLE (up)->contents; |
| 146 | unsigned char *downvec = XSTRING (down)->data; | 141 | Lisp_Object *downvec = XCHAR_TABLE (down)->contents; |
| 147 | 142 | ||
| 148 | canon = Fmake_string (make_number (256), make_number (0)); | 143 | up = Fmake_char_table (Qcase_table, Qnil); |
| 149 | 144 | ||
| 150 | /* Set up the CANON vector; for each character, | 145 | /* Set up the CANON vector; for each character, |
| 151 | this sequence of upcasing and downcasing ought to | 146 | this sequence of upcasing and downcasing ought to |
| 152 | get the "preferred" lowercase equivalent. */ | 147 | get the "preferred" lowercase equivalent. */ |
| 153 | for (i = 0; i < 256; i++) | 148 | for (i = 0; i < 256; i++) |
| 154 | XSTRING (canon)->data[i] = downvec[upvec[downvec[i]]]; | 149 | XCHAR_TABLE (canon)->contents[i] = downvec[upvec[downvec[i]]]; |
| 150 | XCHAR_TABLE (table)->extras[1] = canon; | ||
| 155 | } | 151 | } |
| 156 | 152 | ||
| 157 | if (NILP (eqv)) | 153 | if (NILP (eqv)) |
| 158 | { | 154 | { |
| 159 | eqv = Fmake_string (make_number (256), make_number (0)); | 155 | eqv = Fmake_char_table (Qcase_table, Qnil); |
| 160 | 156 | compute_trt_inverse (XCHAR_TABLE (canon), XCHAR_TABLE (eqv)); | |
| 161 | compute_trt_inverse (XSTRING (canon)->data, XSTRING (eqv)->data); | 157 | XCHAR_TABLE (table)->extras[0] = eqv; |
| 162 | } | 158 | } |
| 163 | 159 | ||
| 164 | if (standard) | 160 | if (standard) |
| 165 | { | 161 | Vascii_downcase_table = down; |
| 166 | Vascii_downcase_table = down; | ||
| 167 | Vascii_upcase_table = up; | ||
| 168 | Vascii_canon_table = canon; | ||
| 169 | Vascii_eqv_table = eqv; | ||
| 170 | } | ||
| 171 | else | 162 | else |
| 172 | { | 163 | current_buffer->downcase_table = down; |
| 173 | current_buffer->downcase_table = down; | 164 | |
| 174 | current_buffer->upcase_table = up; | ||
| 175 | current_buffer->case_canon_table = canon; | ||
| 176 | current_buffer->case_eqv_table = eqv; | ||
| 177 | } | ||
| 178 | return table; | 165 | return table; |
| 179 | } | 166 | } |
| 180 | 167 | ||
| @@ -184,24 +171,23 @@ set_case_table (table, standard) | |||
| 184 | All characters in a given class form one circular list, chained through | 171 | All characters in a given class form one circular list, chained through |
| 185 | the elements of INVERSE. */ | 172 | the elements of INVERSE. */ |
| 186 | 173 | ||
| 187 | void | 174 | static void |
| 188 | compute_trt_inverse (trt, inverse) | 175 | compute_trt_inverse (trt, inverse) |
| 189 | register unsigned char *trt; | 176 | struct Lisp_Char_Table *trt, *inverse; |
| 190 | register unsigned char *inverse; | ||
| 191 | { | 177 | { |
| 192 | register int i = 0400; | 178 | register int i = 0400; |
| 193 | register unsigned char c, q; | 179 | register unsigned char c, q; |
| 194 | 180 | ||
| 195 | while (i--) | 181 | while (i--) |
| 196 | inverse[i] = i; | 182 | inverse->contents[i] = i; |
| 197 | i = 0400; | 183 | i = 0400; |
| 198 | while (i--) | 184 | while (i--) |
| 199 | { | 185 | { |
| 200 | if ((q = trt[i]) != (unsigned char) i) | 186 | if ((q = trt->contents[i]) != (unsigned char) i) |
| 201 | { | 187 | { |
| 202 | c = inverse[q]; | 188 | c = inverse->contents[q]; |
| 203 | inverse[q] = i; | 189 | inverse->contents[q] = i; |
| 204 | inverse[i] = c; | 190 | inverse->contents[i] = c; |
| 205 | } | 191 | } |
| 206 | } | 192 | } |
| 207 | } | 193 | } |
| @@ -209,47 +195,51 @@ compute_trt_inverse (trt, inverse) | |||
| 209 | init_casetab_once () | 195 | init_casetab_once () |
| 210 | { | 196 | { |
| 211 | register int i; | 197 | register int i; |
| 212 | Lisp_Object tem; | 198 | Lisp_Object down, up; |
| 199 | Qcase_table = intern ("case-table"); | ||
| 200 | staticpro (&Qcase_table); | ||
| 201 | |||
| 202 | /* Intern this now in case it isn't already done. | ||
| 203 | Setting this variable twice is harmless. | ||
| 204 | But don't staticpro it here--that is done in alloc.c. */ | ||
| 205 | Qchar_table_extra_slots = intern ("char-table-extra-slots"); | ||
| 213 | 206 | ||
| 214 | tem = Fmake_string (make_number (256), make_number (0)); | 207 | /* Now we are ready to set up this property, so we can |
| 215 | Vascii_downcase_table = tem; | 208 | create char tables. */ |
| 216 | Vascii_canon_table = tem; | 209 | Fput (Qcase_table, Qchar_table_extra_slots, make_number (4)); |
| 210 | |||
| 211 | down = Fmake_char_table (Qcase_table, Qnil); | ||
| 212 | Vascii_downcase_table = down; | ||
| 217 | 213 | ||
| 218 | for (i = 0; i < 256; i++) | 214 | for (i = 0; i < 256; i++) |
| 219 | XSTRING (tem)->data[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; | 215 | XCHAR_TABLE (down)->contents[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; |
| 216 | |||
| 217 | XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down); | ||
| 220 | 218 | ||
| 221 | tem = Fmake_string (make_number (256), make_number (0)); | 219 | up = Fmake_char_table (Qcase_table, Qnil); |
| 222 | Vascii_upcase_table = tem; | 220 | XCHAR_TABLE (down)->extras[0] = up; |
| 223 | Vascii_eqv_table = tem; | ||
| 224 | 221 | ||
| 225 | for (i = 0; i < 256; i++) | 222 | for (i = 0; i < 256; i++) |
| 226 | XSTRING (tem)->data[i] | 223 | XCHAR_TABLE (up)->contents[i] |
| 227 | = ((i >= 'A' && i <= 'Z') | 224 | = ((i >= 'A' && i <= 'Z') |
| 228 | ? i + ('a' - 'A') | 225 | ? i + ('a' - 'A') |
| 229 | : ((i >= 'a' && i <= 'z') | 226 | : ((i >= 'a' && i <= 'z') |
| 230 | ? i + ('A' - 'a') | 227 | ? i + ('A' - 'a') |
| 231 | : i)); | 228 | : i)); |
| 229 | |||
| 230 | XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); | ||
| 232 | } | 231 | } |
| 233 | 232 | ||
| 234 | syms_of_casetab () | 233 | syms_of_casetab () |
| 235 | { | 234 | { |
| 236 | Qcase_table_p = intern ("case-table-p"); | 235 | Qcase_table_p = intern ("case-table-p"); |
| 237 | staticpro (&Qcase_table_p); | 236 | staticpro (&Qcase_table_p); |
| 237 | |||
| 238 | staticpro (&Vascii_downcase_table); | 238 | staticpro (&Vascii_downcase_table); |
| 239 | staticpro (&Vascii_upcase_table); | ||
| 240 | staticpro (&Vascii_canon_table); | ||
| 241 | staticpro (&Vascii_eqv_table); | ||
| 242 | 239 | ||
| 243 | defsubr (&Scase_table_p); | 240 | defsubr (&Scase_table_p); |
| 244 | defsubr (&Scurrent_case_table); | 241 | defsubr (&Scurrent_case_table); |
| 245 | defsubr (&Sstandard_case_table); | 242 | defsubr (&Sstandard_case_table); |
| 246 | defsubr (&Sset_case_table); | 243 | defsubr (&Sset_case_table); |
| 247 | defsubr (&Sset_standard_case_table); | 244 | defsubr (&Sset_standard_case_table); |
| 248 | |||
| 249 | #if 0 | ||
| 250 | DEFVAR_LISP ("ascii-downcase-table", &Vascii_downcase_table, | ||
| 251 | "String mapping ASCII characters to lowercase equivalents."); | ||
| 252 | DEFVAR_LISP ("ascii-upcase-table", &Vascii_upcase_table, | ||
| 253 | "String mapping ASCII characters to uppercase equivalents."); | ||
| 254 | #endif | ||
| 255 | } | 245 | } |