Mercurial > emacs
annotate src/casetab.c @ 17956:7af8470b665a
Use insert to preserve marker positions (pmark) and delete last.
author | Simon Marshall <simon@gnu.org> |
---|---|
date | Mon, 26 May 1997 09:53:59 +0000 |
parents | c407a3aca56f |
children | 40ce43a92060 |
rev | line source |
---|---|
118 | 1 /* GNU Emacs routines to deal with case tables. |
7307 | 2 Copyright (C) 1993, 1994 Free Software Foundation, Inc. |
118 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
12244 | 8 the Free Software Foundation; either version 2, or (at your option) |
118 | 9 any later version. |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
14186
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14064
diff
changeset
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14064
diff
changeset
|
19 Boston, MA 02111-1307, USA. */ |
118 | 20 |
21 /* Written by Howard Gayle. See chartab.c for details. */ | |
22 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
3069
diff
changeset
|
23 #include <config.h> |
118 | 24 #include "lisp.h" |
25 #include "buffer.h" | |
17804 | 26 #include "charset.h" |
118 | 27 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
28 Lisp_Object Qcase_table_p, Qcase_table; |
118 | 29 Lisp_Object Vascii_downcase_table, Vascii_upcase_table; |
30 Lisp_Object Vascii_canon_table, Vascii_eqv_table; | |
31 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
32 static void compute_trt_inverse (); |
118 | 33 |
34 DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, | |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
35 "Return t iff OBJECT is a case table.\n\ |
118 | 36 See `set-case-table' for more information on these data structures.") |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
37 (object) |
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
38 Lisp_Object object; |
118 | 39 { |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
40 Lisp_Object up, canon, eqv; |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
41 |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
42 if (! CHAR_TABLE_P (object)) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
43 return Qnil; |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
44 if (! EQ (XCHAR_TABLE (object)->purpose, Qcase_table)) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
45 return Qnil; |
118 | 46 |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
47 up = XCHAR_TABLE (object)->extras[0]; |
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
48 canon = XCHAR_TABLE (object)->extras[1]; |
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
49 eqv = XCHAR_TABLE (object)->extras[2]; |
118 | 50 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
51 return ((NILP (up) || CHAR_TABLE_P (up)) |
484 | 52 && ((NILP (canon) && NILP (eqv)) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
53 || (CHAR_TABLE_P (canon) |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
54 && (NILP (eqv) || CHAR_TABLE_P (eqv)))) |
118 | 55 ? Qt : Qnil); |
56 } | |
57 | |
58 static Lisp_Object | |
59 check_case_table (obj) | |
60 Lisp_Object obj; | |
61 { | |
62 register Lisp_Object tem; | |
63 | |
484 | 64 while (tem = Fcase_table_p (obj), NILP (tem)) |
1926
952f2a18f83d
* callint.c (Fcall_interactively): Pass the correct number of
Jim Blandy <jimb@redhat.com>
parents:
1506
diff
changeset
|
65 obj = wrong_type_argument (Qcase_table_p, obj); |
118 | 66 return (obj); |
67 } | |
68 | |
69 DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0, | |
70 "Return the case table of the current buffer.") | |
71 () | |
72 { | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
73 return current_buffer->downcase_table; |
118 | 74 } |
75 | |
3069
93ff3c50bd1d
* casetab.c: Fix formatting, so as not to confuse etags.
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
76 DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, |
118 | 77 "Return the standard case table.\n\ |
78 This is the one used for new buffers.") | |
79 () | |
80 { | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
81 return Vascii_downcase_table; |
118 | 82 } |
83 | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
84 static Lisp_Object set_case_table (); |
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
85 |
118 | 86 DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0, |
87 "Select a new case table for the current buffer.\n\ | |
13321
a0437a2c2dd4
(Fset_case_table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
13276
diff
changeset
|
88 A case table is a char-table which maps characters\n\ |
a0437a2c2dd4
(Fset_case_table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
13276
diff
changeset
|
89 to their lower-case equivalents. It also has three \"extra\" slots\n\ |
a0437a2c2dd4
(Fset_case_table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
13276
diff
changeset
|
90 which may be additional char-tables or nil.\n\ |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
91 These slots are called UPCASE, CANONICALIZE and EQUIVALENCES.\n\ |
118 | 92 UPCASE maps each character to its upper-case equivalent;\n\ |
93 if lower and upper case characters are in 1-1 correspondence,\n\ | |
94 you may use nil and the upcase table will be deduced from DOWNCASE.\n\ | |
95 CANONICALIZE maps each character to a canonical equivalent;\n\ | |
96 any two characters that are related by case-conversion have the same\n\ | |
6937
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
97 canonical equivalent character; it may be nil, in which case it is\n\ |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
98 deduced from DOWNCASE and UPCASE.\n\ |
118 | 99 EQUIVALENCES is a map that cyclicly permutes each equivalence class\n\ |
6937
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
100 (of characters with the same canonical equivalent); it may be nil,\n\ |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
101 in which case it is deduced from CANONICALIZE.") |
118 | 102 (table) |
103 Lisp_Object table; | |
104 { | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
105 return set_case_table (table, 0); |
118 | 106 } |
107 | |
3069
93ff3c50bd1d
* casetab.c: Fix formatting, so as not to confuse etags.
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
108 DEFUN ("set-standard-case-table", Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0, |
118 | 109 "Select a new standard case table for new buffers.\n\ |
110 See `set-case-table' for more info on case tables.") | |
111 (table) | |
112 Lisp_Object table; | |
113 { | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
114 return set_case_table (table, 1); |
118 | 115 } |
116 | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
117 static Lisp_Object |
118 | 118 set_case_table (table, standard) |
119 Lisp_Object table; | |
120 int standard; | |
121 { | |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
122 Lisp_Object up, canon, eqv; |
118 | 123 |
124 check_case_table (table); | |
125 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
126 up = XCHAR_TABLE (table)->extras[0]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
127 canon = XCHAR_TABLE (table)->extras[1]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
128 eqv = XCHAR_TABLE (table)->extras[2]; |
118 | 129 |
484 | 130 if (NILP (up)) |
118 | 131 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
132 up = Fmake_char_table (Qcase_table, Qnil); |
17804 | 133 compute_trt_inverse (table, up); |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
134 XCHAR_TABLE (table)->extras[0] = up; |
118 | 135 } |
136 | |
484 | 137 if (NILP (canon)) |
118 | 138 { |
139 register int i; | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
140 Lisp_Object *upvec = XCHAR_TABLE (up)->contents; |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
141 Lisp_Object *downvec = XCHAR_TABLE (table)->contents; |
118 | 142 |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
143 canon = Fmake_char_table (Qcase_table, Qnil); |
118 | 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. */ | |
17804 | 148 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
149 XCHAR_TABLE (canon)->contents[i] = downvec[upvec[downvec[i]]]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
150 XCHAR_TABLE (table)->extras[1] = canon; |
6937
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
151 } |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
152 |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
153 if (NILP (eqv)) |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
154 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
155 eqv = Fmake_char_table (Qcase_table, Qnil); |
17804 | 156 compute_trt_inverse (canon, eqv); |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
157 XCHAR_TABLE (table)->extras[2] = eqv; |
118 | 158 } |
159 | |
160 if (standard) | |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
161 Vascii_downcase_table = table; |
118 | 162 else |
15171
36c329b45867
(set_case_table): Set upcase_table, case_canon_table
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
163 { |
36c329b45867
(set_case_table): Set upcase_table, case_canon_table
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
164 current_buffer->downcase_table = table; |
36c329b45867
(set_case_table): Set upcase_table, case_canon_table
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
165 current_buffer->upcase_table = up; |
36c329b45867
(set_case_table): Set upcase_table, case_canon_table
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
166 current_buffer->case_canon_table = canon; |
36c329b45867
(set_case_table): Set upcase_table, case_canon_table
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
167 current_buffer->case_eqv_table = eqv; |
36c329b45867
(set_case_table): Set upcase_table, case_canon_table
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
168 } |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
169 |
118 | 170 return table; |
171 } | |
172 | |
17815
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
173 /* Using the scratch array at BYTES of which the first DEPTH elements |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
174 are already set, and using the multi-byte structure inherited from |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
175 TRT, make INVERSE be an identity mapping. That is, for each slot |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
176 that's indexed by a single byte, store that byte in INVERSE. |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
177 Where TRT has a subtable, make a corresponding subtable in INVERSE |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
178 and recursively initialize that subtable so that its elements are |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
179 the multi-byte characters that correspond to the index bytes. |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
180 This is the first step in generating an inverse mapping. */ |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
181 |
17804 | 182 static void |
183 compute_trt_identity (bytes, depth, trt, inverse) | |
184 unsigned char *bytes; | |
185 int depth; | |
186 struct Lisp_Char_Table *trt, *inverse; | |
187 { | |
188 register int i; | |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
189 int lim = (depth == 0 ? CHAR_TABLE_ORDINARY_SLOTS : SUB_CHAR_TABLE_ORDINARY_SLOTS); |
17804 | 190 |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
191 for (i = 0; i < lim; i++) |
17804 | 192 { |
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 | |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
198 : MAKE_NON_ASCII_CHAR (bytes[0], bytes[1], bytes[2]))); |
17804 | 199 } |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
200 else if (SUB_CHAR_TABLE_P (trt->contents[i])) |
17804 | 201 { |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
202 bytes[depth] = i - 128; |
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
203 inverse->contents[i] = make_sub_char_table (Qnil); |
17804 | 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 } | |
212 | |
17815
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
213 /* Using the scratch array at BYTES of which the first DEPTH elements |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
214 are already set, permute the elements of INVERSE (which is initially |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
215 an identity mapping) so that it has one cycle for each equivalence |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
216 class induced by the translation table TRT. IBASE is the lispy |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
217 version of the outermost (depth 0) instance of INVERSE. */ |
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
218 |
17804 | 219 static void |
220 compute_trt_shuffle (bytes, depth, ibase, trt, inverse) | |
221 unsigned char *bytes; | |
222 int depth; | |
223 Lisp_Object ibase; | |
224 struct Lisp_Char_Table *trt, *inverse; | |
225 { | |
226 register int i; | |
227 Lisp_Object j, tem, q; | |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
228 int lim = (depth == 0 ? CHAR_TABLE_ORDINARY_SLOTS : SUB_CHAR_TABLE_ORDINARY_SLOTS); |
17804 | 229 |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
230 for (i = 0; i < lim; i++) |
17804 | 231 { |
232 bytes[depth] = i; | |
233 XSETFASTINT (j, | |
234 (depth == 0 && i < CHAR_TABLE_SINGLE_BYTE_SLOTS ? i | |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
235 : MAKE_NON_ASCII_CHAR (bytes[0], bytes[1], bytes[2]))); |
17804 | 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 } | |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
243 else if (SUB_CHAR_TABLE_P (q)) |
17804 | 244 { |
17807
8a8e26aa76ed
(compute_trt_identity): Use make_sub_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
17804
diff
changeset
|
245 bytes[depth] = i - 128; |
17804 | 246 compute_trt_shuffle (bytes, depth + 1, ibase, |
247 XCHAR_TABLE (trt->contents[i]), | |
248 XCHAR_TABLE (inverse->contents[i])); | |
249 } | |
250 } | |
251 } | |
252 | |
118 | 253 /* Given a translate table TRT, store the inverse mapping into INVERSE. |
254 Since TRT is not one-to-one, INVERSE is not a simple mapping. | |
255 Instead, it divides the space of characters into equivalence classes. | |
256 All characters in a given class form one circular list, chained through | |
257 the elements of INVERSE. */ | |
258 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
259 static void |
17804 | 260 compute_trt_inverse (trt, inv) |
261 Lisp_Object trt, inv; | |
118 | 262 { |
17804 | 263 unsigned char bytes[3]; |
264 compute_trt_identity (bytes, 0, XCHAR_TABLE (trt), XCHAR_TABLE (inv)); | |
265 compute_trt_shuffle (bytes, 0, inv, XCHAR_TABLE (trt), XCHAR_TABLE (inv)); | |
118 | 266 } |
267 | |
268 init_casetab_once () | |
269 { | |
270 register int i; | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
271 Lisp_Object down, up; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
272 Qcase_table = intern ("case-table"); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
273 staticpro (&Qcase_table); |
118 | 274 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
275 /* Intern this now in case it isn't already done. |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
276 Setting this variable twice is harmless. |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
277 But don't staticpro it here--that is done in alloc.c. */ |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
278 Qchar_table_extra_slots = intern ("char-table-extra-slots"); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
279 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
280 /* Now we are ready to set up this property, so we can |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
281 create char tables. */ |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
282 Fput (Qcase_table, Qchar_table_extra_slots, make_number (3)); |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
283 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
284 down = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
285 Vascii_downcase_table = down; |
17340
64722b193f14
(init_casetab_once): Initialize the purpose slot.
Richard M. Stallman <rms@gnu.org>
parents:
16224
diff
changeset
|
286 XCHAR_TABLE (down)->purpose = Qcase_table; |
118 | 287 |
17804 | 288 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) |
289 XSETFASTINT (XCHAR_TABLE (down)->contents[i], | |
290 (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i); | |
118 | 291 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
292 XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
293 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
294 up = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
295 XCHAR_TABLE (down)->extras[0] = up; |
118 | 296 |
17804 | 297 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) |
298 XSETFASTINT (XCHAR_TABLE (up)->contents[i], | |
299 ((i >= 'A' && i <= 'Z') | |
300 ? i + ('a' - 'A') | |
301 : ((i >= 'a' && i <= 'z') | |
302 ? i + ('A' - 'a') | |
303 : i))); | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
304 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
305 XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); |
118 | 306 } |
307 | |
308 syms_of_casetab () | |
309 { | |
310 Qcase_table_p = intern ("case-table-p"); | |
311 staticpro (&Qcase_table_p); | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
312 |
16224
d4c102d5ac70
(syms_of_casetab): staticpro Vascii_canontable, Vascii_eqv_table, and
Erik Naggum <erik@naggum.no>
parents:
15171
diff
changeset
|
313 staticpro (&Vascii_canon_table); |
118 | 314 staticpro (&Vascii_downcase_table); |
16224
d4c102d5ac70
(syms_of_casetab): staticpro Vascii_canontable, Vascii_eqv_table, and
Erik Naggum <erik@naggum.no>
parents:
15171
diff
changeset
|
315 staticpro (&Vascii_eqv_table); |
d4c102d5ac70
(syms_of_casetab): staticpro Vascii_canontable, Vascii_eqv_table, and
Erik Naggum <erik@naggum.no>
parents:
15171
diff
changeset
|
316 staticpro (&Vascii_upcase_table); |
118 | 317 |
318 defsubr (&Scase_table_p); | |
319 defsubr (&Scurrent_case_table); | |
320 defsubr (&Sstandard_case_table); | |
321 defsubr (&Sset_case_table); | |
322 defsubr (&Sset_standard_case_table); | |
323 } |