Mercurial > hg > xemacs-beta

comparison src/casefiddle.c @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents 8de8e3f6228a
children fdefd0186b75
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
28 #include "syntax.h" 28 #include "syntax.h"
29 29
30 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; 30 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
31 31
32 static Lisp_Object 32 static Lisp_Object
33 casify_object (enum case_action flag, Lisp_Object obj, Lisp_Object buffer) 33 casify_object (enum case_action flag, Lisp_Object string_or_char,
34 Lisp_Object buffer)
34 { 35 {
35 struct buffer *buf = decode_buffer (buffer, 0); 36 struct buffer *buf = decode_buffer (buffer, 0);
36 37
37 retry: 38 retry:
38 39
39 if (CHAR_OR_CHAR_INTP (obj)) 40 if (CHAR_OR_CHAR_INTP (string_or_char))
40 { 41 {
41 Emchar c; 42 Emchar c;
42 CHECK_CHAR_COERCE_INT (obj); 43 CHECK_CHAR_COERCE_INT (string_or_char);
43 c = XCHAR (obj); 44 c = XCHAR (string_or_char);
44 c = (flag == CASE_DOWN) ? DOWNCASE (buf, c) : UPCASE (buf, c); 45 c = (flag == CASE_DOWN) ? DOWNCASE (buf, c) : UPCASE (buf, c);
45 return make_char (c); 46 return make_char (c);
46 } 47 }
47 48
48 if (STRINGP (obj)) 49 if (STRINGP (string_or_char))
49 { 50 {
50 Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); 51 Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
51 Bufbyte *storage = 52 Bufbyte *storage =
52 alloca_array (Bufbyte, XSTRING_LENGTH (obj) * MAX_EMCHAR_LEN); 53 alloca_array (Bufbyte, XSTRING_LENGTH (string_or_char) * MAX_EMCHAR_LEN);
53 Bufbyte *newp = storage; 54 Bufbyte *newp = storage;
54 Bufbyte *oldp = XSTRING_DATA (obj); 55 Bufbyte *oldp = XSTRING_DATA (string_or_char);
55 int wordp = 0, wordp_prev; 56 int wordp = 0, wordp_prev;
56 57
57 while (*oldp) 58 while (*oldp)
58 { 59 {
59 Emchar c = charptr_emchar (oldp); 60 Emchar c = charptr_emchar (oldp);
85 } 86 }
86 87
87 return make_string (storage, newp - storage); 88 return make_string (storage, newp - storage);
88 } 89 }
89 90
90 obj = wrong_type_argument (Qchar_or_string_p, obj); 91 string_or_char = wrong_type_argument (Qchar_or_string_p, string_or_char);
91 goto retry; 92 goto retry;
92 } 93 }
93 94
94 DEFUN ("upcase", Fupcase, 1, 2, 0, /* 95 DEFUN ("upcase", Fupcase, 1, 2, 0, /*
95 Convert OBJECT to upper case and return that. 96 Convert STRING-OR-CHAR to upper case and return that.
96 OBJECT may be a character or string. The result has the same type. 97 STRING-OR-CHAR may be a character or string. The result has the same type.
97 OBJECT is not altered--the value is a copy. 98 STRING-OR-CHAR is not altered--the value is a copy.
98 See also `capitalize', `downcase' and `upcase-initials'. 99 See also `capitalize', `downcase' and `upcase-initials'.
99 Optional second arg BUFFER specifies which buffer's case tables to use, 100 Optional second arg BUFFER specifies which buffer's case tables to use,
100 and defaults to the current buffer. 101 and defaults to the current buffer.
101 */ 102 */
102 (object, buffer)) 103 (string_or_char, buffer))
103 { 104 {
104 return casify_object (CASE_UP, object, buffer); 105 return casify_object (CASE_UP, string_or_char, buffer);
105 } 106 }
106 107
107 DEFUN ("downcase", Fdowncase, 1, 2, 0, /* 108 DEFUN ("downcase", Fdowncase, 1, 2, 0, /*
108 Convert OBJECT to lower case and return that. 109 Convert STRING-OR-CHAR to lower case and return that.
109 OBJECT may be a character or string. The result has the same type. 110 STRING-OR-CHAR may be a character or string. The result has the same type.
110 OBJECT is not altered--the value is a copy. 111 STRING-OR-CHAR is not altered--the value is a copy.
111 Optional second arg BUFFER specifies which buffer's case tables to use, 112 Optional second arg BUFFER specifies which buffer's case tables to use,
112 and defaults to the current buffer. 113 and defaults to the current buffer.
113 */ 114 */
114 (object, buffer)) 115 (string_or_char, buffer))
115 { 116 {
116 return casify_object (CASE_DOWN, object, buffer); 117 return casify_object (CASE_DOWN, string_or_char, buffer);
117 } 118 }
118 119
119 DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /* 120 DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /*
120 Convert OBJECT to capitalized form and return that. 121 Convert STRING-OR-CHAR to capitalized form and return that.
121 This means that each word's first character is upper case 122 This means that each word's first character is upper case
122 and the rest is lower case. 123 and the rest is lower case.
123 OBJECT may be a character or string. The result has the same type. 124 STRING-OR-CHAR may be a character or string. The result has the same type.
124 OBJECT is not altered--the value is a copy. 125 STRING-OR-CHAR is not altered--the value is a copy.
125 Optional second arg BUFFER specifies which buffer's case tables to use, 126 Optional second arg BUFFER specifies which buffer's case tables to use,
126 and defaults to the current buffer. 127 and defaults to the current buffer.
127 */ 128 */
128 (object, buffer)) 129 (string_or_char, buffer))
129 { 130 {
130 return casify_object (CASE_CAPITALIZE, object, buffer); 131 return casify_object (CASE_CAPITALIZE, string_or_char, buffer);
131 } 132 }
132 133
133 /* Like Fcapitalize but change only the initial characters. */ 134 /* Like Fcapitalize but change only the initial characters. */
134 135
135 DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /* 136 DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /*
136 Convert the initial of each word in OBJECT to upper case. 137 Convert the initial of each word in STRING-OR-CHAR to upper case.
137 Do not change the other letters of each word. 138 Do not change the other letters of each word.
138 OBJECT may be a character or string. The result has the same type. 139 STRING-OR-CHAR may be a character or string. The result has the same type.
139 OBJECT is not altered--the value is a copy. 140 STRING-OR-CHAR is not altered--the value is a copy.
140 Optional second arg BUFFER specifies which buffer's case tables to use, 141 Optional second arg BUFFER specifies which buffer's case tables to use,
141 and defaults to the current buffer. 142 and defaults to the current buffer.
142 */ 143 */
143 (object, buffer)) 144 (string_or_char, buffer))
144 { 145 {
145 return casify_object (CASE_CAPITALIZE_UP, object, buffer); 146 return casify_object (CASE_CAPITALIZE_UP, string_or_char, buffer);
146 } 147 }
147 148
148 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP. 149 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
149 b and e specify range of buffer to operate on. */ 150 START and END specify range of buffer to operate on. */
150 151
151 static void 152 static void
152 casify_region_internal (enum case_action flag, Lisp_Object b, Lisp_Object e, 153 casify_region_internal (enum case_action flag, Lisp_Object start,
153 struct buffer *buf) 154 Lisp_Object end, struct buffer *buf)
154 { 155 {
155 /* This function can GC */ 156 /* This function can GC */
156 REGISTER Bufpos i; 157 Bufpos pos, s, e;
157 Bufpos start, end;
158 Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); 158 Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
159 int mccount; 159 int mccount;
160 Emchar oldc, c;
161 int wordp = 0, wordp_prev; 160 int wordp = 0, wordp_prev;
162 161
163 if (EQ (b, e)) 162 if (EQ (start, end))
164 /* Not modifying because nothing marked */ 163 /* Not modifying because nothing marked */
165 return; 164 return;
166 165
167 get_buffer_range_char (buf, b, e, &start, &end, 0); 166 get_buffer_range_char (buf, start, end, &s, &e, 0);
168 167
169 mccount = begin_multiple_change (buf, start, end); 168 mccount = begin_multiple_change (buf, s, e);
170 record_change (buf, start, end - start); 169 record_change (buf, s, e - s);
171 170
172 for (i = start; i < end; i++) 171 for (pos = s; pos < e; pos++)
173 { 172 {
174 c = oldc = BUF_FETCH_CHAR (buf, i); 173 Emchar oldc = BUF_FETCH_CHAR (buf, pos);
174 Emchar c = oldc;
175 175
176 switch (flag) 176 switch (flag)
177 { 177 {
178 case CASE_UP: 178 case CASE_UP:
179 c = UPCASE (buf, oldc); 179 c = UPCASE (buf, oldc);
197 c = UPCASE (buf, c); 197 c = UPCASE (buf, c);
198 break; 198 break;
199 } 199 }
200 200
201 if (oldc == c) continue; 201 if (oldc == c) continue;
202 buffer_replace_char (buf, i, c, 1, (i == start)); 202 buffer_replace_char (buf, pos, c, 1, (pos == s));
203 BUF_MODIFF (buf)++; 203 BUF_MODIFF (buf)++;
204 } 204 }
205 205
206 end_multiple_change (buf, mccount); 206 end_multiple_change (buf, mccount);
207 } 207 }
208 208
209 static Lisp_Object 209 static Lisp_Object
210 casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e, 210 casify_region (enum case_action flag, Lisp_Object start, Lisp_Object end,
211 Lisp_Object buffer) 211 Lisp_Object buffer)
212 { 212 {
213 casify_region_internal (flag, b, e, decode_buffer (buffer, 1)); 213 casify_region_internal (flag, start, end, decode_buffer (buffer, 1));
214 return Qnil; 214 return Qnil;
215 } 215 }
216 216
217 DEFUN ("upcase-region", Fupcase_region, 2, 3, "r", /* 217 DEFUN ("upcase-region", Fupcase_region, 2, 3, "r", /*
218 Convert the region to upper case. In programs, wants two arguments. 218 Convert the region to upper case. In programs, wants two arguments.
220 the region to operate on. When used as a command, the text between 220 the region to operate on. When used as a command, the text between
221 point and the mark is operated on. 221 point and the mark is operated on.
222 See also `capitalize-region'. 222 See also `capitalize-region'.
223 Optional third arg BUFFER defaults to the current buffer. 223 Optional third arg BUFFER defaults to the current buffer.
224 */ 224 */
225 (b, e, buffer)) 225 (start, end, buffer))
226 { 226 {
227 /* This function can GC */ 227 /* This function can GC */
228 return casify_region (CASE_UP, b, e, buffer); 228 return casify_region (CASE_UP, start, end, buffer);
229 } 229 }
230 230
231 DEFUN ("downcase-region", Fdowncase_region, 2, 3, "r", /* 231 DEFUN ("downcase-region", Fdowncase_region, 2, 3, "r", /*
232 Convert the region to lower case. In programs, wants two arguments. 232 Convert the region to lower case. In programs, wants two arguments.
233 These arguments specify the starting and ending character numbers of 233 These arguments specify the starting and ending character numbers of
234 the region to operate on. When used as a command, the text between 234 the region to operate on. When used as a command, the text between
235 point and the mark is operated on. 235 point and the mark is operated on.
236 Optional third arg BUFFER defaults to the current buffer. 236 Optional third arg BUFFER defaults to the current buffer.
237 */ 237 */
238 (b, e, buffer)) 238 (start, end, buffer))
239 { 239 {
240 /* This function can GC */ 240 /* This function can GC */
241 return casify_region (CASE_DOWN, b, e, buffer); 241 return casify_region (CASE_DOWN, start, end, buffer);
242 } 242 }
243 243
244 DEFUN ("capitalize-region", Fcapitalize_region, 2, 3, "r", /* 244 DEFUN ("capitalize-region", Fcapitalize_region, 2, 3, "r", /*
245 Convert the region to capitalized form. 245 Convert the region to capitalized form.
246 Capitalized form means each word's first character is upper case 246 Capitalized form means each word's first character is upper case
247 and the rest of it is lower case. 247 and the rest of it is lower case.
248 In programs, give two arguments, the starting and ending 248 In programs, give two arguments, the starting and ending
249 character positions to operate on. 249 character positions to operate on.
250 Optional third arg BUFFER defaults to the current buffer. 250 Optional third arg BUFFER defaults to the current buffer.
251 */ 251 */
252 (b, e, buffer)) 252 (start, end, buffer))
253 { 253 {
254 /* This function can GC */ 254 /* This function can GC */
255 return casify_region (CASE_CAPITALIZE, b, e, buffer); 255 return casify_region (CASE_CAPITALIZE, start, end, buffer);
256 } 256 }
257 257
258 /* Like Fcapitalize_region but change only the initials. */ 258 /* Like Fcapitalize_region but change only the initials. */
259 259
260 DEFUN ("upcase-initials-region", Fupcase_initials_region, 2, 3, "r", /* 260 DEFUN ("upcase-initials-region", Fupcase_initials_region, 2, 3, "r", /*
262 Subsequent letters of each word are not changed. 262 Subsequent letters of each word are not changed.
263 In programs, give two arguments, the starting and ending 263 In programs, give two arguments, the starting and ending
264 character positions to operate on. 264 character positions to operate on.
265 Optional third arg BUFFER defaults to the current buffer. 265 Optional third arg BUFFER defaults to the current buffer.
266 */ 266 */
267 (b, e, buffer)) 267 (start, end, buffer))
268 { 268 {
269 return casify_region (CASE_CAPITALIZE_UP, b, e, buffer); 269 return casify_region (CASE_CAPITALIZE_UP, start, end, buffer);
270 } 270 }
271 271
272 272
273 static Lisp_Object 273 static Lisp_Object
274 casify_word (enum case_action flag, Lisp_Object arg, Lisp_Object buffer) 274 casify_word (enum case_action flag, Lisp_Object arg, Lisp_Object buffer)
286 BUF_SET_PT (buf, max (BUF_PT (buf), farend)); 286 BUF_SET_PT (buf, max (BUF_PT (buf), farend));
287 return Qnil; 287 return Qnil;
288 } 288 }
289 289
290 DEFUN ("upcase-word", Fupcase_word, 1, 2, "p", /* 290 DEFUN ("upcase-word", Fupcase_word, 1, 2, "p", /*
291 Convert following word (or N words) to upper case, moving over. 291 Convert following word (or COUNT words) to upper case, moving over.
292 With negative argument, convert previous words but do not move. 292 With negative argument, convert previous words but do not move.
293 See also `capitalize-word'. 293 See also `capitalize-word'.
294 Optional second arg BUFFER defaults to the current buffer. 294 Optional second arg BUFFER defaults to the current buffer.
295 */ 295 */
296 (n, buffer)) 296 (count, buffer))
297 { 297 {
298 /* This function can GC */ 298 /* This function can GC */
299 return casify_word (CASE_UP, n, buffer); 299 return casify_word (CASE_UP, count, buffer);
300 } 300 }
301 301
302 DEFUN ("downcase-word", Fdowncase_word, 1, 2, "p", /* 302 DEFUN ("downcase-word", Fdowncase_word, 1, 2, "p", /*
303 Convert following word (or N words) to lower case, moving over. 303 Convert following word (or COUNT words) to lower case, moving over.
304 With negative argument, convert previous words but do not move. 304 With negative argument, convert previous words but do not move.
305 Optional second arg BUFFER defaults to the current buffer. 305 Optional second arg BUFFER defaults to the current buffer.
306 */ 306 */
307 (n, buffer)) 307 (count, buffer))
308 { 308 {
309 /* This function can GC */ 309 /* This function can GC */
310 return casify_word (CASE_DOWN, n, buffer); 310 return casify_word (CASE_DOWN, count, buffer);
311 } 311 }
312 312
313 DEFUN ("capitalize-word", Fcapitalize_word, 1, 2, "p", /* 313 DEFUN ("capitalize-word", Fcapitalize_word, 1, 2, "p", /*
314 Capitalize the following word (or N words), moving over. 314 Capitalize the following word (or COUNT words), moving over.
315 This gives the word(s) a first character in upper case 315 This gives the word(s) a first character in upper case
316 and the rest lower case. 316 and the rest lower case.
317 With negative argument, capitalize previous words but do not move. 317 With negative argument, capitalize previous words but do not move.
318 Optional second arg BUFFER defaults to the current buffer. 318 Optional second arg BUFFER defaults to the current buffer.
319 */ 319 */
320 (n, buffer)) 320 (count, buffer))
321 { 321 {
322 /* This function can GC */ 322 /* This function can GC */
323 return casify_word (CASE_CAPITALIZE, n, buffer); 323 return casify_word (CASE_CAPITALIZE, count, buffer);
324 } 324 }
325 325
326 326
327 void 327 void
328 syms_of_casefiddle (void) 328 syms_of_casefiddle (void)