Mercurial > emacs

comparison src/casefiddle.c @ 17816:380442ed6a1c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Include charset.h. (Qidentity): Define this variable. (syms_of_casefiddle): Initialize and staticpro it. (casify_object, casify_region): Handle multibyte.
author Karl Heuer <kwzh@gnu.org>
date Thu, 15 May 1997 07:47:29 +0000
parents 5246c075a643
children ad95aa134d60
comparison
equal deleted inserted replaced
17815:c407a3aca56f 17816:380442ed6a1c
20 20
21 21
22 #include <config.h> 22 #include <config.h>
23 #include "lisp.h" 23 #include "lisp.h"
24 #include "buffer.h" 24 #include "buffer.h"
25 #include "charset.h"
25 #include "commands.h" 26 #include "commands.h"
26 #include "syntax.h" 27 #include "syntax.h"
27 28
28 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; 29 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
30
31 Lisp_Object Qidentity;
29 32
30 Lisp_Object 33 Lisp_Object
31 casify_object (flag, obj) 34 casify_object (flag, obj)
32 enum case_action flag; 35 enum case_action flag;
33 Lisp_Object obj; 36 Lisp_Object obj;
34 { 37 {
35 register int i, c, len; 38 register int i, c, len;
36 register int inword = flag == CASE_DOWN; 39 register int inword = flag == CASE_DOWN;
40 Lisp_Object tem;
37 41
38 /* If the case table is flagged as modified, rescan it. */ 42 /* If the case table is flagged as modified, rescan it. */
39 if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1])) 43 if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
40 Fset_case_table (current_buffer->downcase_table); 44 Fset_case_table (current_buffer->downcase_table);
41 45
42 while (1) 46 while (1)
43 { 47 {
44 if (INTEGERP (obj)) 48 if (INTEGERP (obj))
45 { 49 {
46 c = XINT (obj); 50 tem = Faref (current_buffer->downcase_table, obj);
47 if (c >= 0 && c <= 0400) 51 if (EQ (tem, Qidentity))
52 tem = obj;
53 if (inword)
54 obj = tem;
55 else if (EQ (tem, obj))
48 { 56 {
49 if (inword) 57 tem = Faref (current_buffer->upcase_table, obj);
50 XSETFASTINT (obj, DOWNCASE (c)); 58 if (!EQ (tem, Qidentity))
51 else if (!UPPERCASEP (c)) 59 obj = tem;
52 XSETFASTINT (obj, UPCASE1 (c));
53 } 60 }
54 return obj; 61 return obj;
55 } 62 }
56 if (STRINGP (obj)) 63 if (STRINGP (obj))
57 { 64 {
130 { 137 {
131 register int i; 138 register int i;
132 register int c; 139 register int c;
133 register int inword = flag == CASE_DOWN; 140 register int inword = flag == CASE_DOWN;
134 int start, end; 141 int start, end;
142 Lisp_Object ch, downch, val;
135 143
136 if (EQ (b, e)) 144 if (EQ (b, e))
137 /* Not modifying because nothing marked */ 145 /* Not modifying because nothing marked */
138 return; 146 return;
139 147
145 start = XFASTINT (b); 153 start = XFASTINT (b);
146 end = XFASTINT (e); 154 end = XFASTINT (e);
147 modify_region (current_buffer, start, end); 155 modify_region (current_buffer, start, end);
148 record_change (start, end - start); 156 record_change (start, end - start);
149 157
150 for (i = start; i < end; i++) 158 if (NILP (current_buffer->enable_multibyte_characters))
151 { 159 {
152 c = FETCH_BYTE (i); 160 for (i = start; i < end; i++)
153 if (inword && flag != CASE_CAPITALIZE_UP) 161 {
154 c = DOWNCASE (c); 162 c = FETCH_BYTE (i);
155 else if (!UPPERCASEP (c) 163 if (inword && flag != CASE_CAPITALIZE_UP)
156 && (!inword || flag != CASE_CAPITALIZE_UP)) 164 c = DOWNCASE (c);
157 c = UPCASE1 (c); 165 else if (!UPPERCASEP (c)
158 FETCH_BYTE (i) = c; 166 && (!inword || flag != CASE_CAPITALIZE_UP))
159 if ((int) flag >= (int) CASE_CAPITALIZE) 167 c = UPCASE1 (c);
160 inword = SYNTAX (c) == Sword; 168 FETCH_BYTE (i) = c;
169 if ((int) flag >= (int) CASE_CAPITALIZE)
170 inword = SYNTAX (c) == Sword;
171 }
172 }
173 else
174 {
175 Lisp_Object down, up;
176 int opoint = PT;
177
178 down = current_buffer->downcase_table;
179 up = current_buffer->upcase_table;
180 for (i = start; i < end;)
181 {
182 c = FETCH_MULTIBYTE_CHAR (i);
183 XSETFASTINT (ch, c);
184 downch = Faref (down, ch);
185 if (EQ (downch, Qidentity))
186 downch = ch;
187 if (inword && flag != CASE_CAPITALIZE_UP)
188 val = downch;
189 else if (EQ (downch, ch)
190 && (!inword || flag != CASE_CAPITALIZE_UP))
191 {
192 val = Faref (up, ch);
193 if (EQ (val, Qidentity))
194 val = ch;
195 }
196 else
197 val = ch;
198 if (!EQ (val, ch))
199 {
200 int fromlen, tolen, j;
201 char workbuf[4], *str;
202
203 if (!NATNUMP (val))
204 error ("Inappropriate value found in case table");
205 /* Handle the most likely case */
206 if (c < 0400 && XFASTINT (val) < 0400)
207 FETCH_BYTE (i) = XFASTINT (val);
208 else if (fromlen = CHAR_STRING (c, workbuf, str),
209 tolen = CHAR_STRING (XFASTINT (val), workbuf, str),
210 fromlen == tolen)
211 {
212 for (j = 0; j < tolen; ++j)
213 FETCH_BYTE (i + j) = str[j];
214 }
215 else
216 {
217 error ("Can't casify letters that change length");
218 #if 0 /* This is approximately what we'd like to be able to do here */
219 if (tolen < fromlen)
220 del_range_1 (i + tolen, i + fromlen, 0);
221 else if (tolen > fromlen)
222 {
223 TEMP_SET_PT (i + fromlen);
224 insert_1 (str + fromlen, tolen - fromlen, 1, 0);
225 }
226 #endif
227 }
228 }
229 if ((int) flag >= (int) CASE_CAPITALIZE)
230 inword = SYNTAX (XFASTINT (val)) == Sword;
231 INC_POS (i);
232 }
233 TEMP_SET_PT (opoint);
161 } 234 }
162 235
163 signal_after_change (start, end - start, end - start); 236 signal_after_change (start, end - start, end - start);
164 } 237 }
165 238
285 return Qnil; 358 return Qnil;
286 } 359 }
287 360
288 syms_of_casefiddle () 361 syms_of_casefiddle ()
289 { 362 {
363 Qidentity = intern ("identity");
364 staticpro (&Qidentity);
290 defsubr (&Supcase); 365 defsubr (&Supcase);
291 defsubr (&Sdowncase); 366 defsubr (&Sdowncase);
292 defsubr (&Scapitalize); 367 defsubr (&Scapitalize);
293 defsubr (&Supcase_initials); 368 defsubr (&Supcase_initials);
294 defsubr (&Supcase_region); 369 defsubr (&Supcase_region);