Mercurial > emacs
annotate src/casetab.c @ 13833:467bc73e8734
(redisplay_window): Clear force_start field
before running the Qwindow_scroll_functions.
In the recenter case, set w->start before running them.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 24 Dec 1995 16:03:05 +0000 |
parents | a0437a2c2dd4 |
children | d090a0a25ac8 |
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 { | |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
38 Lisp_Object 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 { | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
71 return current_buffer->downcase_table; |
118 | 72 } |
73 | |
3069
93ff3c50bd1d
* casetab.c: Fix formatting, so as not to confuse etags.
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
74 DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, |
118 | 75 "Return the standard case table.\n\ |
76 This is the one used for new buffers.") | |
77 () | |
78 { | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
79 return Vascii_downcase_table; |
118 | 80 } |
81 | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
82 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
|
83 |
118 | 84 DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0, |
85 "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
|
86 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
|
87 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
|
88 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
|
89 These slots are called UPCASE, CANONICALIZE and EQUIVALENCES.\n\ |
118 | 90 UPCASE maps each character to its upper-case equivalent;\n\ |
91 if lower and upper case characters are in 1-1 correspondence,\n\ | |
92 you may use nil and the upcase table will be deduced from DOWNCASE.\n\ | |
93 CANONICALIZE maps each character to a canonical equivalent;\n\ | |
94 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
|
95 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
|
96 deduced from DOWNCASE and UPCASE.\n\ |
118 | 97 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
|
98 (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
|
99 in which case it is deduced from CANONICALIZE.") |
118 | 100 (table) |
101 Lisp_Object table; | |
102 { | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
103 return set_case_table (table, 0); |
118 | 104 } |
105 | |
3069
93ff3c50bd1d
* casetab.c: Fix formatting, so as not to confuse etags.
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
106 DEFUN ("set-standard-case-table", Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0, |
118 | 107 "Select a new standard case table for new buffers.\n\ |
108 See `set-case-table' for more info on case tables.") | |
109 (table) | |
110 Lisp_Object table; | |
111 { | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
112 return set_case_table (table, 1); |
118 | 113 } |
114 | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
115 static Lisp_Object |
118 | 116 set_case_table (table, standard) |
117 Lisp_Object table; | |
118 int standard; | |
119 { | |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
120 Lisp_Object up, canon, eqv; |
118 | 121 |
122 check_case_table (table); | |
123 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
124 up = XCHAR_TABLE (table)->extras[0]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
125 canon = XCHAR_TABLE (table)->extras[1]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
126 eqv = XCHAR_TABLE (table)->extras[2]; |
118 | 127 |
484 | 128 if (NILP (up)) |
118 | 129 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
130 up = Fmake_char_table (Qcase_table, Qnil); |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
131 compute_trt_inverse (XCHAR_TABLE (table), XCHAR_TABLE (up)); |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
132 XCHAR_TABLE (table)->extras[0] = up; |
118 | 133 } |
134 | |
484 | 135 if (NILP (canon)) |
118 | 136 { |
137 register int i; | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
138 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
|
139 Lisp_Object *downvec = XCHAR_TABLE (table)->contents; |
118 | 140 |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
141 canon = Fmake_char_table (Qcase_table, Qnil); |
118 | 142 |
143 /* Set up the CANON vector; for each character, | |
144 this sequence of upcasing and downcasing ought to | |
145 get the "preferred" lowercase equivalent. */ | |
146 for (i = 0; i < 256; i++) | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
147 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
|
148 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
|
149 } |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
150 |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
151 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
|
152 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
153 eqv = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
154 compute_trt_inverse (XCHAR_TABLE (canon), XCHAR_TABLE (eqv)); |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
155 XCHAR_TABLE (table)->extras[2] = eqv; |
118 | 156 } |
157 | |
158 if (standard) | |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
159 Vascii_downcase_table = table; |
118 | 160 else |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
161 current_buffer->downcase_table = table; |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
162 |
118 | 163 return table; |
164 } | |
165 | |
166 /* Given a translate table TRT, store the inverse mapping into INVERSE. | |
167 Since TRT is not one-to-one, INVERSE is not a simple mapping. | |
168 Instead, it divides the space of characters into equivalence classes. | |
169 All characters in a given class form one circular list, chained through | |
170 the elements of INVERSE. */ | |
171 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
172 static void |
118 | 173 compute_trt_inverse (trt, inverse) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
174 struct Lisp_Char_Table *trt, *inverse; |
118 | 175 { |
176 register int i = 0400; | |
177 register unsigned char c, q; | |
178 | |
179 while (i--) | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
180 inverse->contents[i] = i; |
118 | 181 i = 0400; |
182 while (i--) | |
183 { | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
184 if ((q = trt->contents[i]) != (unsigned char) i) |
118 | 185 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
186 c = inverse->contents[q]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
187 inverse->contents[q] = i; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
188 inverse->contents[i] = c; |
118 | 189 } |
190 } | |
191 } | |
192 | |
193 init_casetab_once () | |
194 { | |
195 register int i; | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
196 Lisp_Object down, up; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
197 Qcase_table = intern ("case-table"); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
198 staticpro (&Qcase_table); |
118 | 199 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
200 /* 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
|
201 Setting this variable twice is harmless. |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
202 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
|
203 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
|
204 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
205 /* 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
|
206 create char tables. */ |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
207 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
|
208 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
209 down = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
210 Vascii_downcase_table = down; |
118 | 211 |
212 for (i = 0; i < 256; i++) | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
213 XCHAR_TABLE (down)->contents[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; |
118 | 214 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
215 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
|
216 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
217 up = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
218 XCHAR_TABLE (down)->extras[0] = up; |
118 | 219 |
220 for (i = 0; i < 256; i++) | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
221 XCHAR_TABLE (up)->contents[i] |
118 | 222 = ((i >= 'A' && i <= 'Z') |
223 ? i + ('a' - 'A') | |
224 : ((i >= 'a' && i <= 'z') | |
225 ? i + ('A' - 'a') | |
226 : i)); | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
227 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
228 XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); |
118 | 229 } |
230 | |
231 syms_of_casetab () | |
232 { | |
233 Qcase_table_p = intern ("case-table-p"); | |
234 staticpro (&Qcase_table_p); | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
235 |
118 | 236 staticpro (&Vascii_downcase_table); |
237 | |
238 defsubr (&Scase_table_p); | |
239 defsubr (&Scurrent_case_table); | |
240 defsubr (&Sstandard_case_table); | |
241 defsubr (&Sset_case_table); | |
242 defsubr (&Sset_standard_case_table); | |
243 } |