Mercurial > emacs
annotate src/casetab.c @ 111796:0bee817318b0
* lisp/gnus/mm-extern.el (message-goto-body): Update declaration.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Thu, 02 Dec 2010 18:57:46 -0800 |
parents | 8cfee7d2955f |
children | 417b1e4d63cd |
rev | line source |
---|---|
118 | 1 /* GNU Emacs routines to deal with case tables. |
101099 | 2 Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
106815 | 3 2008, 2009, 2010 Free Software Foundation, Inc. |
101099 | 4 |
5 Author: Howard Gayle | |
118 | 6 |
7 This file is part of GNU Emacs. | |
8 | |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91327
diff
changeset
|
9 GNU Emacs is free software: you can redistribute it and/or modify |
118 | 10 it under the terms of the GNU General Public License as published by |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91327
diff
changeset
|
11 the Free Software Foundation, either version 3 of the License, or |
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91327
diff
changeset
|
12 (at your option) any later version. |
118 | 13 |
14 GNU Emacs is distributed in the hope that it will be useful, | |
15 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 GNU General Public License for more details. | |
18 | |
19 You should have received a copy of the GNU General Public License | |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91327
diff
changeset
|
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ |
118 | 21 |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
3069
diff
changeset
|
22 #include <config.h> |
105669
68dd71358159
* alloc.c: Do not define struct catchtag.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
103939
diff
changeset
|
23 #include <setjmp.h> |
118 | 24 #include "lisp.h" |
25 #include "buffer.h" | |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
26 #include "character.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 | |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
32 /* 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
|
33 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
|
34 int case_temp1; |
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18004
diff
changeset
|
35 Lisp_Object case_temp2; |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
36 |
109126
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
37 static void set_canon (Lisp_Object case_table, Lisp_Object range, Lisp_Object elt); |
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
38 static void set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt); |
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
39 static void shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt); |
118 | 40 |
41 DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, | |
78501 | 42 doc: /* Return t if OBJECT is a case table. |
40103
6b389fb978bc
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
21514
diff
changeset
|
43 See `set-case-table' for more information on these data structures. */) |
109179
8cfee7d2955f
Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
109126
diff
changeset
|
44 (Lisp_Object object) |
118 | 45 { |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
46 Lisp_Object up, canon, eqv; |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
47 |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
48 if (! CHAR_TABLE_P (object)) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
49 return Qnil; |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
50 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
|
51 return Qnil; |
118 | 52 |
14064
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
53 up = XCHAR_TABLE (object)->extras[0]; |
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
54 canon = XCHAR_TABLE (object)->extras[1]; |
d090a0a25ac8
(Fcase_table_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
13321
diff
changeset
|
55 eqv = XCHAR_TABLE (object)->extras[2]; |
118 | 56 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
57 return ((NILP (up) || CHAR_TABLE_P (up)) |
484 | 58 && ((NILP (canon) && NILP (eqv)) |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
59 || (CHAR_TABLE_P (canon) |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
60 && (NILP (eqv) || CHAR_TABLE_P (eqv)))) |
118 | 61 ? Qt : Qnil); |
62 } | |
63 | |
64 static Lisp_Object | |
109126
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
65 check_case_table (Lisp_Object obj) |
118 | 66 { |
71828
10b94d33e0d8
* casetab.c (check_case_table): Use CHECK_TYPE.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
67 CHECK_TYPE (!NILP (Fcase_table_p (obj)), Qcase_table_p, obj); |
118 | 68 return (obj); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47292
diff
changeset
|
69 } |
118 | 70 |
71 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
|
72 doc: /* Return the case table of the current buffer. */) |
109179
8cfee7d2955f
Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
109126
diff
changeset
|
73 (void) |
118 | 74 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
75 return current_buffer->downcase_table; |
118 | 76 } |
77 | |
3069
93ff3c50bd1d
* casetab.c: Fix formatting, so as not to confuse etags.
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
78 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
|
79 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
|
80 This is the one used for new buffers. */) |
109179
8cfee7d2955f
Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
109126
diff
changeset
|
81 (void) |
118 | 82 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
83 return Vascii_downcase_table; |
118 | 84 } |
85 | |
109126
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
86 static Lisp_Object set_case_table (Lisp_Object table, int standard); |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
87 |
118 | 88 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
|
89 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
|
90 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
|
91 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
|
92 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
|
93 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
|
94 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
|
95 (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
|
96 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
|
97 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
|
98 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
|
99 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
|
100 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
|
101 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
|
102 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
|
103 (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
|
104 in which case it is deduced from CANONICALIZE. */) |
109179
8cfee7d2955f
Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
109126
diff
changeset
|
105 (Lisp_Object table) |
118 | 106 { |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
107 return set_case_table (table, 0); |
118 | 108 } |
109 | |
3069
93ff3c50bd1d
* casetab.c: Fix formatting, so as not to confuse etags.
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
110 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
|
111 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
|
112 See `set-case-table' for more info on case tables. */) |
109179
8cfee7d2955f
Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
109126
diff
changeset
|
113 (Lisp_Object table) |
118 | 114 { |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
115 return set_case_table (table, 1); |
118 | 116 } |
117 | |
1506
5fe52748a72c
* casetab.c (set_case_table): Declare this to be static, and
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
118 static Lisp_Object |
109126
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
119 set_case_table (Lisp_Object table, int standard) |
118 | 120 { |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
121 Lisp_Object up, canon, eqv; |
118 | 122 |
123 check_case_table (table); | |
124 | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
125 up = XCHAR_TABLE (table)->extras[0]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
126 canon = XCHAR_TABLE (table)->extras[1]; |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
127 eqv = XCHAR_TABLE (table)->extras[2]; |
118 | 128 |
484 | 129 if (NILP (up)) |
118 | 130 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
131 up = Fmake_char_table (Qcase_table, Qnil); |
89483 | 132 map_char_table (set_identity, Qnil, table, up); |
133 map_char_table (shuffle, Qnil, 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 { |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
139 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
|
140 XCHAR_TABLE (table)->extras[1] = canon; |
89483 | 141 map_char_table (set_canon, Qnil, table, table); |
6937
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
142 } |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
143 |
c5a85ac1d292
(set_case_table): Handle nil for EQV with non-nil CANON.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
144 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
|
145 { |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
146 eqv = Fmake_char_table (Qcase_table, Qnil); |
89483 | 147 map_char_table (set_identity, Qnil, canon, eqv); |
148 map_char_table (shuffle, Qnil, canon, eqv); | |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
149 XCHAR_TABLE (table)->extras[2] = eqv; |
118 | 150 } |
151 | |
47292
644bd031ece8
(set_case_table): Make canon table point to eqv table.
Richard M. Stallman <rms@gnu.org>
parents:
40103
diff
changeset
|
152 /* 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
|
153 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
|
154 |
118 | 155 if (standard) |
61188
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
156 { |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
157 Vascii_downcase_table = table; |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
158 Vascii_upcase_table = up; |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
159 Vascii_canon_table = canon; |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
160 Vascii_eqv_table = eqv; |
a96e8bdd2b37
(set_case_table): If standard is nonzero, setup
Kenichi Handa <handa@m17n.org>
parents:
59779
diff
changeset
|
161 } |
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 | |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
173 /* 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
|
174 |
89483 | 175 /* Set CANON char-table element for characters in RANGE to a |
176 translated ELT by UP and DOWN char-tables. This is done only when | |
177 ELT is a character. The char-tables CANON, UP, and DOWN are in | |
178 CASE_TABLE. */ | |
17815
c407a3aca56f
(compute_trt_identity, compute_trt_shuffle): Add comments.
Karl Heuer <kwzh@gnu.org>
parents:
17807
diff
changeset
|
179 |
17804 | 180 static void |
109126
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
181 set_canon (Lisp_Object case_table, Lisp_Object range, Lisp_Object elt) |
17804 | 182 { |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
183 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
|
184 Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; |
17804 | 185 |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
186 if (NATNUMP (elt)) |
89031
5fd1f8a7e007
(set_canon, set_identity, shuffle): Simplified.
Kenichi Handa <handa@m17n.org>
parents:
88851
diff
changeset
|
187 Fset_char_table_range (canon, range, Faref (case_table, Faref (up, elt))); |
17804 | 188 } |
189 | |
89483 | 190 /* Set elements of char-table TABLE for C to C itself. C may be a |
191 cons specifying a character range. In that case, set characters in | |
192 that range to themselves. This is done only when ELT is a | |
193 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
|
194 |
17804 | 195 static void |
109126
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
196 set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt) |
17804 | 197 { |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
198 if (NATNUMP (elt)) |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
199 { |
89483 | 200 int from, to; |
201 | |
202 if (CONSP (c)) | |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
203 { |
89483 | 204 from = XINT (XCAR (c)); |
205 to = XINT (XCDR (c)); | |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
206 } |
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
207 else |
89483 | 208 from = to = XINT (c); |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
209 for (; from <= to; from++) |
89031
5fd1f8a7e007
(set_canon, set_identity, shuffle): Simplified.
Kenichi Handa <handa@m17n.org>
parents:
88851
diff
changeset
|
210 CHAR_TABLE_SET (table, from, make_number (from)); |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
211 } |
17804 | 212 } |
213 | |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
214 /* 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
|
215 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
|
216 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
|
217 operated. */ |
118 | 218 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
219 static void |
109126
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
220 shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt) |
118 | 221 { |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
222 if (NATNUMP (elt)) |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
223 { |
89483 | 224 int from, to; |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
225 |
89483 | 226 if (CONSP (c)) |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
227 { |
89483 | 228 from = XINT (XCAR (c)); |
229 to = XINT (XCDR (c)); | |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
230 } |
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
231 else |
89483 | 232 from = to = XINT (c); |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
233 |
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
234 for (; from <= to; from++) |
103939
fb9d149af914
(shuffle): Fix the logic of setting up the cycle.
Kenichi Handa <handa@m17n.org>
parents:
101943
diff
changeset
|
235 { |
fb9d149af914
(shuffle): Fix the logic of setting up the cycle.
Kenichi Handa <handa@m17n.org>
parents:
101943
diff
changeset
|
236 Lisp_Object tem = Faref (table, elt); |
fb9d149af914
(shuffle): Fix the logic of setting up the cycle.
Kenichi Handa <handa@m17n.org>
parents:
101943
diff
changeset
|
237 Faset (table, elt, make_number (from)); |
fb9d149af914
(shuffle): Fix the logic of setting up the cycle.
Kenichi Handa <handa@m17n.org>
parents:
101943
diff
changeset
|
238 Faset (table, make_number (from), tem); |
fb9d149af914
(shuffle): Fix the logic of setting up the cycle.
Kenichi Handa <handa@m17n.org>
parents:
101943
diff
changeset
|
239 } |
18004
40ce43a92060
(case_temp1, case_temp2): New variables temporarily
Kenichi Handa <handa@m17n.org>
parents:
17815
diff
changeset
|
240 } |
118 | 241 } |
242 | |
21514 | 243 void |
109126
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
244 init_casetab_once (void) |
118 | 245 { |
246 register int i; | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
247 Lisp_Object down, up; |
105877
21bdda3ded62
* xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105669
diff
changeset
|
248 Qcase_table = intern_c_string ("case-table"); |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
249 staticpro (&Qcase_table); |
118 | 250 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
251 /* 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
|
252 Setting this variable twice is harmless. |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
253 But don't staticpro it here--that is done in alloc.c. */ |
105877
21bdda3ded62
* xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105669
diff
changeset
|
254 Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots"); |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
255 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
256 /* 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
|
257 create char tables. */ |
13276
a09ec2a2f6dd
(Fcase_table_p, Fcurrent_case_table): Delete unused local variables.
Erik Naggum <erik@naggum.no>
parents:
13242
diff
changeset
|
258 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
|
259 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
260 down = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
261 Vascii_downcase_table = down; |
17340
64722b193f14
(init_casetab_once): Initialize the purpose slot.
Richard M. Stallman <rms@gnu.org>
parents:
16224
diff
changeset
|
262 XCHAR_TABLE (down)->purpose = Qcase_table; |
118 | 263 |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
264 for (i = 0; i < 128; i++) |
89483 | 265 { |
266 int c = (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i; | |
267 CHAR_TABLE_SET (down, i, make_number (c)); | |
268 } | |
118 | 269 |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
270 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
|
271 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
272 up = Fmake_char_table (Qcase_table, Qnil); |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
273 XCHAR_TABLE (down)->extras[0] = up; |
118 | 274 |
88357
1cf6a8acec39
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
40103
diff
changeset
|
275 for (i = 0; i < 128; i++) |
89483 | 276 { |
277 int c = ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A') | |
278 : ((i >= 'a' && i <= 'z') ? i + ('A' - 'a') | |
101943
97c9e9322753
Remove spurious semicolons.
Juanma Barranquero <lekktu@gmail.com>
parents:
101099
diff
changeset
|
279 : i)); |
89483 | 280 CHAR_TABLE_SET (up, i, make_number (c)); |
281 } | |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
282 |
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
283 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
|
284 |
b18e79090a7a
(init_casetab_once): Call set_case_table.
Richard M. Stallman <rms@gnu.org>
parents:
71828
diff
changeset
|
285 /* 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
|
286 set_case_table (down, 1); |
118 | 287 } |
288 | |
21514 | 289 void |
109126
aec1143e8d85
Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
106815
diff
changeset
|
290 syms_of_casetab (void) |
118 | 291 { |
105877
21bdda3ded62
* xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105669
diff
changeset
|
292 Qcase_table_p = intern_c_string ("case-table-p"); |
118 | 293 staticpro (&Qcase_table_p); |
13242
3a8c500b97c3
Case tables are now char-tables,
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
294 |
16224
d4c102d5ac70
(syms_of_casetab): staticpro Vascii_canontable, Vascii_eqv_table, and
Erik Naggum <erik@naggum.no>
parents:
15171
diff
changeset
|
295 staticpro (&Vascii_canon_table); |
118 | 296 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
|
297 staticpro (&Vascii_eqv_table); |
d4c102d5ac70
(syms_of_casetab): staticpro Vascii_canontable, Vascii_eqv_table, and
Erik Naggum <erik@naggum.no>
parents:
15171
diff
changeset
|
298 staticpro (&Vascii_upcase_table); |
118 | 299 |
300 defsubr (&Scase_table_p); | |
301 defsubr (&Scurrent_case_table); | |
302 defsubr (&Sstandard_case_table); | |
303 defsubr (&Sset_case_table); | |
304 defsubr (&Sset_standard_case_table); | |
305 } | |
52401 | 306 |
307 /* arch-tag: e06388ad-99fe-40ec-ba67-9d010fcc4916 | |
308 (do not change this comment) */ |