Mercurial > emacs
annotate src/casetab.c @ 75303:528bac1f7b32
*** empty log message ***
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Sat, 20 Jan 2007 15:43:48 +0000 |
parents | e90d04cd455a |
children | 922696f363b0 c1184a3d99c9 95d0cdf160ea |
rev | line source |
---|---|
118 | 1 /* GNU Emacs routines to deal with case tables. |
75227
e90d04cd455a
Update copyright for years from Emacs 21 to present (mainly adding
Glenn Morris <rgm@gnu.org>
parents:
72729
diff
changeset
|
2 Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, |
e90d04cd455a
Update copyright for years from Emacs 21 to present (mainly adding
Glenn Morris <rgm@gnu.org>
parents:
72729
diff
changeset
|
3 2005, 2006, 2007 Free Software Foundation, Inc. |
118 | 4 |
5 This file is part of GNU Emacs. | |
6 | |
7 GNU Emacs is free software; you can redistribute it and/or modify | |
8 it under the terms of the GNU General Public License as published by | |
12244 | 9 the Free Software Foundation; either version 2, or (at your option) |
118 | 10 any later version. |
11 | |
12 GNU Emacs is distributed in the hope that it will be useful, | |
13 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 GNU General Public License for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with GNU Emacs; see the file COPYING. If not, write to | |
64084 | 19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
20 Boston, MA 02110-1301, USA. */ | |
118 | 21 |
59779 | 22 /* Written by Howard Gayle. */ |
118 | 23 |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
3069
diff
changeset
|
24 #include <config.h> |
118 | 25 #include "lisp.h" |
26 #include "buffer.h" | |
17804 | 27 #include "charset.h" |
118 | 28 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
29 Lisp_Object Qcase_table_p, Qcase_table; |
118 | 30 Lisp_Object Vascii_downcase_table, Vascii_upcase_table; |
31 Lisp_Object Vascii_canon_table, Vascii_eqv_table; | |
32 | |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
33 /* Used as a temporary in DOWNCASE and other macros in lisp.h. No |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
34 need to mark it, since it is used only very temporarily. */ |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18004
diff
changeset
|
35 int case_temp1; |
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18004
diff
changeset
|
36 Lisp_Object case_temp2; |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
37 |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
38 static void set_canon (); |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
39 static void set_identity (); |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
40 static void shuffle (); |
118 | 41 |
42 DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, | |
40103
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
43 doc: /* Return t iff OBJECT is a case table. |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
44 See `set-case-table' for more information on these data structures. */) |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
45 (object) |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
46 Lisp_Object object; |
118 | 47 { |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
48 Lisp_Object up, canon, eqv; |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
49 |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
50 if (! CHAR_TABLE_P (object)) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
51 return Qnil; |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
52 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
|
53 return Qnil; |
118 | 54 |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
55 up = XCHAR_TABLE (object)->extras[0]; |
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
56 canon = XCHAR_TABLE (object)->extras[1]; |
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
57 eqv = XCHAR_TABLE (object)->extras[2]; |
118 | 58 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
59 return ((NILP (up) || CHAR_TABLE_P (up)) |
484 | 60 && ((NILP (canon) && NILP (eqv)) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
61 || (CHAR_TABLE_P (canon) |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
62 && (NILP (eqv) || CHAR_TABLE_P (eqv)))) |
118 | 63 ? Qt : Qnil); |
64 } | |
65 | |
66 static Lisp_Object | |
67 check_case_table (obj) | |
68 Lisp_Object obj; | |
69 { | |
71828
10b94d33e0d8
* casetab.c (check_case_table): Use CHECK_TYPE.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
70 CHECK_TYPE (!NILP (Fcase_table_p (obj)), Qcase_table_p, obj); |
118 | 71 return (obj); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47292
diff
changeset
|
72 } |
118 | 73 |
74 DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0, | |
40103
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
75 doc: /* Return the case table of the current buffer. */) |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
76 () |
118 | 77 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
78 return current_buffer->downcase_table; |
118 | 79 } |
80 | |
3069
93ff3c50bd1d
* casetab.c: Fix formatting, so as not to confuse etags.
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
81 DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, |
40103
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
82 doc: /* Return the standard case table. |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
83 This is the one used for new buffers. */) |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
84 () |
118 | 85 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
86 return Vascii_downcase_table; |
118 | 87 } |
88 | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
89 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
|
90 |
118 | 91 DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0, |
40103
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
92 doc: /* Select a new case table for the current buffer. |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
93 A case table is a char-table which maps characters |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
94 to their lower-case equivalents. It also has three \"extra\" slots |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
95 which may be additional char-tables or nil. |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
96 These slots are called UPCASE, CANONICALIZE and EQUIVALENCES. |
66334
1bd74e01cf90
(Fset_case_table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
64770
diff
changeset
|
97 UPCASE maps each non-upper-case character to its upper-case equivalent. |
1bd74e01cf90
(Fset_case_table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
64770
diff
changeset
|
98 (The value in UPCASE for an upper-case character is never used.) |
1bd74e01cf90
(Fset_case_table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
64770
diff
changeset
|
99 If lower and upper case characters are in 1-1 correspondence, |
40103
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
100 you may use nil and the upcase table will be deduced from DOWNCASE. |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
101 CANONICALIZE maps each character to a canonical equivalent; |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
102 any two characters that are related by case-conversion have the same |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
103 canonical equivalent character; it may be nil, in which case it is |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
104 deduced from DOWNCASE and UPCASE. |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
105 EQUIVALENCES is a map that cyclicly permutes each equivalence class |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
106 (of characters with the same canonical equivalent); it may be nil, |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
107 in which case it is deduced from CANONICALIZE. */) |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
108 (table) |
118 | 109 Lisp_Object table; |
110 { | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
111 return set_case_table (table, 0); |
118 | 112 } |
113 | |
3069
93ff3c50bd1d
* casetab.c: Fix formatting, so as not to confuse etags.
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
114 DEFUN ("set-standard-case-table", Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0, |
40103
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
115 doc: /* Select a new standard case table for new buffers. |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
116 See `set-case-table' for more info on case tables. */) |
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
117 (table) |
118 | 118 Lisp_Object table; |
119 { | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
120 return set_case_table (table, 1); |
118 | 121 } |
122 | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
123 static Lisp_Object |
118 | 124 set_case_table (table, standard) |
125 Lisp_Object table; | |
126 int standard; | |
127 { | |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
128 Lisp_Object up, canon, eqv; |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
129 Lisp_Object indices[3]; |
118 | 130 |
131 check_case_table (table); | |
132 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
133 up = XCHAR_TABLE (table)->extras[0]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
134 canon = XCHAR_TABLE (table)->extras[1]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
135 eqv = XCHAR_TABLE (table)->extras[2]; |
118 | 136 |
484 | 137 if (NILP (up)) |
118 | 138 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
139 up = Fmake_char_table (Qcase_table, Qnil); |
51031
0c0b80172350
(set_case_table): Pass new arg to map_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
49600
diff
changeset
|
140 map_char_table (set_identity, Qnil, table, table, up, 0, indices); |
0c0b80172350
(set_case_table): Pass new arg to map_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
49600
diff
changeset
|
141 map_char_table (shuffle, Qnil, table, table, up, 0, indices); |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
142 XCHAR_TABLE (table)->extras[0] = up; |
118 | 143 } |
144 | |
484 | 145 if (NILP (canon)) |
118 | 146 { |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
147 canon = Fmake_char_table (Qcase_table, Qnil); |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
148 XCHAR_TABLE (table)->extras[1] = canon; |
51031
0c0b80172350
(set_case_table): Pass new arg to map_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
49600
diff
changeset
|
149 map_char_table (set_canon, Qnil, table, table, table, 0, indices); |
6937
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 |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
152 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
|
153 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
154 eqv = Fmake_char_table (Qcase_table, Qnil); |
51031
0c0b80172350
(set_case_table): Pass new arg to map_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
49600
diff
changeset
|
155 map_char_table (set_identity, Qnil, canon, canon, eqv, 0, indices); |
0c0b80172350
(set_case_table): Pass new arg to map_char_table.
Richard M. Stallman <rms@gnu.org>
parents:
49600
diff
changeset
|
156 map_char_table (shuffle, Qnil, canon, canon, eqv, 0, indices); |
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 | |
47292
644bd031ece8
(set_case_table): Make canon table point to eqv table.
Richard M. Stallman <rms@gnu.org>
parents:
40103
diff
changeset
|
160 /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ |
644bd031ece8
(set_case_table): Make canon table point to eqv table.
Richard M. Stallman <rms@gnu.org>
parents:
40103
diff
changeset
|
161 XCHAR_TABLE (canon)->extras[2] = eqv; |
644bd031ece8
(set_case_table): Make canon table point to eqv table.
Richard M. Stallman <rms@gnu.org>
parents:
40103
diff
changeset
|
162 |
118 | 163 if (standard) |
61188
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
164 { |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
165 Vascii_downcase_table = table; |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
166 Vascii_upcase_table = up; |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
167 Vascii_canon_table = canon; |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
168 Vascii_eqv_table = eqv; |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
169 } |
118 | 170 else |
15171
36c329b45867
(set_case_table): Set upcase_table, case_canon_table
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
171 { |
36c329b45867
(set_case_table): Set upcase_table, case_canon_table
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
172 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
|
173 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
|
174 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
|
175 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
|
176 } |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
177 |
118 | 178 return table; |
179 } | |
180 | |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
181 /* The following functions are called in map_char_table. */ |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
182 |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
183 /* Set CANON char-table element for C to a translated ELT by UP and |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
184 DOWN char-tables. This is done only when ELT is a character. The |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
185 char-tables CANON, UP, and DOWN are in CASE_TABLE. */ |
17815
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
186 |
17804 | 187 static void |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
188 set_canon (case_table, c, elt) |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
189 Lisp_Object case_table, c, elt; |
17804 | 190 { |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
191 Lisp_Object up = XCHAR_TABLE (case_table)->extras[0]; |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
192 Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; |
17804 | 193 |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
194 if (NATNUMP (elt)) |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
195 Faset (canon, c, Faref (case_table, Faref (up, elt))); |
17804 | 196 } |
197 | |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
198 /* Set elements of char-table TABLE for C to C itself. This is done |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
199 only when ELT is a character. This is called in map_char_table. */ |
17815
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
200 |
17804 | 201 static void |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
202 set_identity (table, c, elt) |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
203 Lisp_Object table, c, elt; |
17804 | 204 { |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
205 if (NATNUMP (elt)) |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
206 Faset (table, c, c); |
17804 | 207 } |
208 | |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
209 /* Permute the elements of TABLE (which is initially an identity |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
210 mapping) so that it has one cycle for each equivalence class |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
211 induced by the translation table on which map_char_table is |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
212 operated. */ |
118 | 213 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
214 static void |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
215 shuffle (table, c, elt) |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
216 Lisp_Object table, c, elt; |
118 | 217 { |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18004
diff
changeset
|
218 if (NATNUMP (elt) && !EQ (c, elt)) |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
219 { |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
220 Lisp_Object tem = Faref (table, elt); |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
221 Faset (table, elt, c); |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
222 Faset (table, c, tem); |
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
223 } |
118 | 224 } |
225 | |
21514 | 226 void |
118 | 227 init_casetab_once () |
228 { | |
229 register int i; | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
230 Lisp_Object down, up; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
231 Qcase_table = intern ("case-table"); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
232 staticpro (&Qcase_table); |
118 | 233 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
234 /* 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
|
235 Setting this variable twice is harmless. |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
236 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
|
237 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
|
238 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
239 /* 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
|
240 create char tables. */ |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
241 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
|
242 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
243 down = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
244 Vascii_downcase_table = down; |
17340
64722b193f14
(init_casetab_once): Initialize the purpose slot.
Richard M. Stallman <rms@gnu.org>
parents:
16224
diff
changeset
|
245 XCHAR_TABLE (down)->purpose = Qcase_table; |
118 | 246 |
17804 | 247 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) |
248 XSETFASTINT (XCHAR_TABLE (down)->contents[i], | |
249 (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i); | |
118 | 250 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
251 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
|
252 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
253 up = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
254 XCHAR_TABLE (down)->extras[0] = up; |
118 | 255 |
17804 | 256 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) |
257 XSETFASTINT (XCHAR_TABLE (up)->contents[i], | |
258 ((i >= 'A' && i <= 'Z') | |
259 ? i + ('a' - 'A') | |
260 : ((i >= 'a' && i <= 'z') | |
261 ? i + ('A' - 'a') | |
262 : i))); | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
263 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
264 XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); |
72729
b18e79090a7a
(init_casetab_once): Call set_case_table.
Richard M. Stallman <rms@gnu.org>
parents:
71828
diff
changeset
|
265 |
b18e79090a7a
(init_casetab_once): Call set_case_table.
Richard M. Stallman <rms@gnu.org>
parents:
71828
diff
changeset
|
266 /* Fill in what isn't filled in. */ |
b18e79090a7a
(init_casetab_once): Call set_case_table.
Richard M. Stallman <rms@gnu.org>
parents:
71828
diff
changeset
|
267 set_case_table (down, 1); |
118 | 268 } |
269 | |
21514 | 270 void |
118 | 271 syms_of_casetab () |
272 { | |
273 Qcase_table_p = intern ("case-table-p"); | |
274 staticpro (&Qcase_table_p); | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
275 |
16224
d4c102d5ac70
(syms_of_casetab): staticpro Vascii_canontable, Vascii_eqv_table, and
Erik Naggum <erik@naggum.no>
parents:
15171
diff
changeset
|
276 staticpro (&Vascii_canon_table); |
118 | 277 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
|
278 staticpro (&Vascii_eqv_table); |
d4c102d5ac70
(syms_of_casetab): staticpro Vascii_canontable, Vascii_eqv_table, and
Erik Naggum <erik@naggum.no>
parents:
15171
diff
changeset
|
279 staticpro (&Vascii_upcase_table); |
118 | 280 |
281 defsubr (&Scase_table_p); | |
282 defsubr (&Scurrent_case_table); | |
283 defsubr (&Sstandard_case_table); | |
284 defsubr (&Sset_case_table); | |
285 defsubr (&Sset_standard_case_table); | |
286 } | |
52401 | 287 |
288 /* arch-tag: e06388ad-99fe-40ec-ba67-9d010fcc4916 | |
289 (do not change this comment) */ |