Mercurial > emacs
annotate src/casetab.c @ 13245:2e0c4159e94b
(describe_map_tree): New arg always_title. Callers changed.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 19 Oct 1995 00:17:11 +0000 |
parents | 3a8c500b97c3 |
children | a09ec2a2f6dd |
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 | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
20 /* Written by Howard Gayle. See chartab.c for details. */ | |
21 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
3069
diff
changeset
|
22 #include <config.h> |
118 | 23 #include "lisp.h" |
24 #include "buffer.h" | |
25 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
26 Lisp_Object Qcase_table_p, Qcase_table; |
118 | 27 Lisp_Object Vascii_downcase_table, Vascii_upcase_table; |
28 Lisp_Object Vascii_canon_table, Vascii_eqv_table; | |
29 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
30 static void compute_trt_inverse (); |
118 | 31 |
32 DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, | |
33 "Return t iff ARG is a case table.\n\ | |
34 See `set-case-table' for more information on these data structures.") | |
35 (table) | |
36 Lisp_Object table; | |
37 { | |
38 Lisp_Object down, up, canon, eqv; | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
39 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
40 if (! CHAR_TABLE_P (table)) |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
41 return Qnil; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
42 if (! EQ (XCHAR_TABLE (table)->purpose, Qcase_table)) |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
43 return Qnil; |
118 | 44 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
45 up = XCHAR_TABLE (table)->extras[0]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
46 canon = XCHAR_TABLE (table)->extras[1]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
47 eqv = XCHAR_TABLE (table)->extras[2]; |
118 | 48 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
49 return ((NILP (up) || CHAR_TABLE_P (up)) |
484 | 50 && ((NILP (canon) && NILP (eqv)) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
51 || (CHAR_TABLE_P (canon) |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
52 && (NILP (eqv) || CHAR_TABLE_P (eqv)))) |
118 | 53 ? Qt : Qnil); |
54 } | |
55 | |
56 static Lisp_Object | |
57 check_case_table (obj) | |
58 Lisp_Object obj; | |
59 { | |
60 register Lisp_Object tem; | |
61 | |
484 | 62 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
|
63 obj = wrong_type_argument (Qcase_table_p, obj); |
118 | 64 return (obj); |
65 } | |
66 | |
67 DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0, | |
68 "Return the case table of the current buffer.") | |
69 () | |
70 { | |
71 Lisp_Object down, up, canon, eqv; | |
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\ | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
88 A case table is a char-table which maps characters |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
89 to their lower-case equivalents. It also has three \"extra\" slots |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
90 which may be additional char-tables or nil. |
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 { | |
122 Lisp_Object down, up, canon, eqv; | |
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); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
133 compute_trt_inverse (XCHAR_TABLE (down), XCHAR_TABLE (up)); |
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; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
141 Lisp_Object *downvec = XCHAR_TABLE (down)->contents; |
118 | 142 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
143 up = 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. */ | |
148 for (i = 0; i < 256; 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); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
156 compute_trt_inverse (XCHAR_TABLE (canon), XCHAR_TABLE (eqv)); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
157 XCHAR_TABLE (table)->extras[0] = eqv; |
118 | 158 } |
159 | |
160 if (standard) | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
161 Vascii_downcase_table = down; |
118 | 162 else |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
163 current_buffer->downcase_table = down; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
164 |
118 | 165 return table; |
166 } | |
167 | |
168 /* Given a translate table TRT, store the inverse mapping into INVERSE. | |
169 Since TRT is not one-to-one, INVERSE is not a simple mapping. | |
170 Instead, it divides the space of characters into equivalence classes. | |
171 All characters in a given class form one circular list, chained through | |
172 the elements of INVERSE. */ | |
173 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
174 static void |
118 | 175 compute_trt_inverse (trt, inverse) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
176 struct Lisp_Char_Table *trt, *inverse; |
118 | 177 { |
178 register int i = 0400; | |
179 register unsigned char c, q; | |
180 | |
181 while (i--) | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
182 inverse->contents[i] = i; |
118 | 183 i = 0400; |
184 while (i--) | |
185 { | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
186 if ((q = trt->contents[i]) != (unsigned char) i) |
118 | 187 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
188 c = inverse->contents[q]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
189 inverse->contents[q] = i; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
190 inverse->contents[i] = c; |
118 | 191 } |
192 } | |
193 } | |
194 | |
195 init_casetab_once () | |
196 { | |
197 register int i; | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
198 Lisp_Object down, up; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
199 Qcase_table = intern ("case-table"); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
200 staticpro (&Qcase_table); |
118 | 201 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
202 /* 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
|
203 Setting this variable twice is harmless. |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
204 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
|
205 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
|
206 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
207 /* 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
|
208 create char tables. */ |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
209 Fput (Qcase_table, Qchar_table_extra_slots, make_number (4)); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
210 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
211 down = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
212 Vascii_downcase_table = down; |
118 | 213 |
214 for (i = 0; i < 256; i++) | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
215 XCHAR_TABLE (down)->contents[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; |
118 | 216 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
217 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
|
218 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
219 up = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
220 XCHAR_TABLE (down)->extras[0] = up; |
118 | 221 |
222 for (i = 0; i < 256; i++) | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
223 XCHAR_TABLE (up)->contents[i] |
118 | 224 = ((i >= 'A' && i <= 'Z') |
225 ? i + ('a' - 'A') | |
226 : ((i >= 'a' && i <= 'z') | |
227 ? i + ('A' - 'a') | |
228 : i)); | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
229 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
230 XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); |
118 | 231 } |
232 | |
233 syms_of_casetab () | |
234 { | |
235 Qcase_table_p = intern ("case-table-p"); | |
236 staticpro (&Qcase_table_p); | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
237 |
118 | 238 staticpro (&Vascii_downcase_table); |
239 | |
240 defsubr (&Scase_table_p); | |
241 defsubr (&Scurrent_case_table); | |
242 defsubr (&Sstandard_case_table); | |
243 defsubr (&Sset_case_table); | |
244 defsubr (&Sset_standard_case_table); | |
245 } |