Mercurial > hg > xemacs-beta

comparison src/casefiddle.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 8de8e3f6228a
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* XEmacs case conversion functions.
2 Copyright (C) 1985, 1992, 1993, 1994, 1997, 1998 Free Software Foundation, Inc.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Synched up with: FSF 19.34, but substantially rewritten by Martin. */
22
23 #include <config.h>
24 #include "lisp.h"
25
26 #include "buffer.h"
27 #include "insdel.h"
28 #include "syntax.h"
29
30 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
31
32 static Lisp_Object
33 casify_object (enum case_action flag, Lisp_Object obj, Lisp_Object buffer)
34 {
35 struct buffer *buf = decode_buffer (buffer, 0);
36
37 retry:
38
39 if (CHAR_OR_CHAR_INTP (obj))
40 {
41 Emchar c;
42 CHECK_CHAR_COERCE_INT (obj);
43 c = XCHAR (obj);
44 c = (flag == CASE_DOWN) ? DOWNCASE (buf, c) : UPCASE (buf, c);
45 return make_char (c);
46 }
47
48 if (STRINGP (obj))
49 {
50 struct Lisp_Char_Table *syntax_table =
51 XCHAR_TABLE (buf->mirror_syntax_table);
52 Bufbyte *storage =
53 alloca_array (Bufbyte, XSTRING_LENGTH (obj) * MAX_EMCHAR_LEN);
54 Bufbyte *newp = storage;
55 Bufbyte *oldp = XSTRING_DATA (obj);
56 int wordp = 0, wordp_prev;
57
58 while (*oldp)
59 {
60 Emchar c = charptr_emchar (oldp);
61 switch (flag)
62 {
63 case CASE_UP:
64 c = UPCASE (buf, c);
65 break;
66 case CASE_DOWN:
67 c = DOWNCASE (buf, c);
68 break;
69 case CASE_CAPITALIZE:
70 case CASE_CAPITALIZE_UP:
71 wordp_prev = wordp;
72 wordp = WORD_SYNTAX_P (syntax_table, c);
73 if (!wordp) break;
74 if (wordp_prev)
75 {
76 if (flag == CASE_CAPITALIZE)
77 c = DOWNCASE (buf, c);
78 }
79 else
80 c = UPCASE (buf, c);
81 break;
82 }
83
84 newp += set_charptr_emchar (newp, c);
85 INC_CHARPTR (oldp);
86 }
87
88 return make_string (storage, newp - storage);
89 }
90
91 obj = wrong_type_argument (Qchar_or_string_p, obj);
92 goto retry;
93 }
94
95 DEFUN ("upcase", Fupcase, 1, 2, 0, /*
96 Convert OBJECT to upper case and return that.
97 OBJECT may be a character or string. The result has the same type.
98 OBJECT is not altered--the value is a copy.
99 See also `capitalize', `downcase' and `upcase-initials'.
100 Optional second arg BUFFER specifies which buffer's case tables to use,
101 and defaults to the current buffer.
102 */
103 (object, buffer))
104 {
105 return casify_object (CASE_UP, object, buffer);
106 }
107
108 DEFUN ("downcase", Fdowncase, 1, 2, 0, /*
109 Convert OBJECT to lower case and return that.
110 OBJECT may be a character or string. The result has the same type.
111 OBJECT is not altered--the value is a copy.
112 Optional second arg BUFFER specifies which buffer's case tables to use,
113 and defaults to the current buffer.
114 */
115 (object, buffer))
116 {
117 return casify_object (CASE_DOWN, object, buffer);
118 }
119
120 DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /*
121 Convert OBJECT to capitalized form and return that.
122 This means that each word's first character is upper case
123 and the rest is lower case.
124 OBJECT may be a character or string. The result has the same type.
125 OBJECT is not altered--the value is a copy.
126 Optional second arg BUFFER specifies which buffer's case tables to use,
127 and defaults to the current buffer.
128 */
129 (object, buffer))
130 {
131 return casify_object (CASE_CAPITALIZE, object, buffer);
132 }
133
134 /* Like Fcapitalize but change only the initial characters. */
135
136 DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /*
137 Convert the initial of each word in OBJECT to upper case.
138 Do not change the other letters of each word.
139 OBJECT may be a character or string. The result has the same type.
140 OBJECT is not altered--the value is a copy.
141 Optional second arg BUFFER specifies which buffer's case tables to use,
142 and defaults to the current buffer.
143 */
144 (object, buffer))
145 {
146 return casify_object (CASE_CAPITALIZE_UP, object, buffer);
147 }
148
149 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
150 b and e specify range of buffer to operate on. */
151
152 static void
153 casify_region_internal (enum case_action flag, Lisp_Object b, Lisp_Object e,
154 struct buffer *buf)
155 {
156 /* This function can GC */
157 REGISTER Bufpos i;
158 Bufpos start, end;
159 struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
160 int mccount;
161 Emchar oldc, c;
162 int wordp = 0, wordp_prev;
163
164 if (EQ (b, e))
165 /* Not modifying because nothing marked */
166 return;
167
168 get_buffer_range_char (buf, b, e, &start, &end, 0);
169
170 mccount = begin_multiple_change (buf, start, end);
171 record_change (buf, start, end - start);
172
173 for (i = start; i < end; i++)
174 {
175 c = oldc = BUF_FETCH_CHAR (buf, i);
176
177 switch (flag)
178 {
179 case CASE_UP:
180 c = UPCASE (buf, oldc);
181 break;
182 case CASE_DOWN:
183 c = DOWNCASE (buf, oldc);
184 break;
185 case CASE_CAPITALIZE:
186 case CASE_CAPITALIZE_UP:
187 /* !!#### need to revalidate the start and end pointers in case
188 the buffer was changed */
189 wordp_prev = wordp;
190 wordp = WORD_SYNTAX_P (syntax_table, c);
191 if (!wordp) continue;
192 if (wordp_prev)
193 {
194 if (flag == CASE_CAPITALIZE)
195 c = DOWNCASE (buf, c);
196 }
197 else
198 c = UPCASE (buf, c);
199 break;
200 }
201
202 if (oldc == c) continue;
203 buffer_replace_char (buf, i, c, 1, (i == start));
204 BUF_MODIFF (buf)++;
205 }
206
207 end_multiple_change (buf, mccount);
208 }
209
210 static Lisp_Object
211 casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e,
212 Lisp_Object buffer)
213 {
214 casify_region_internal (flag, b, e, decode_buffer (buffer, 1));
215 return Qnil;
216 }
217
218 DEFUN ("upcase-region", Fupcase_region, 2, 3, "r", /*
219 Convert the region to upper case. In programs, wants two arguments.
220 These arguments specify the starting and ending character numbers of
221 the region to operate on. When used as a command, the text between
222 point and the mark is operated on.
223 See also `capitalize-region'.
224 Optional third arg BUFFER defaults to the current buffer.
225 */
226 (b, e, buffer))
227 {
228 /* This function can GC */
229 return casify_region (CASE_UP, b, e, buffer);
230 }
231
232 DEFUN ("downcase-region", Fdowncase_region, 2, 3, "r", /*
233 Convert the region to lower case. In programs, wants two arguments.
234 These arguments specify the starting and ending character numbers of
235 the region to operate on. When used as a command, the text between
236 point and the mark is operated on.
237 Optional third arg BUFFER defaults to the current buffer.
238 */
239 (b, e, buffer))
240 {
241 /* This function can GC */
242 return casify_region (CASE_DOWN, b, e, buffer);
243 }
244
245 DEFUN ("capitalize-region", Fcapitalize_region, 2, 3, "r", /*
246 Convert the region to capitalized form.
247 Capitalized form means each word's first character is upper case
248 and the rest of it is lower case.
249 In programs, give two arguments, the starting and ending
250 character positions to operate on.
251 Optional third arg BUFFER defaults to the current buffer.
252 */
253 (b, e, buffer))
254 {
255 /* This function can GC */
256 return casify_region (CASE_CAPITALIZE, b, e, buffer);
257 }
258
259 /* Like Fcapitalize_region but change only the initials. */
260
261 DEFUN ("upcase-initials-region", Fupcase_initials_region, 2, 3, "r", /*
262 Upcase the initial of each word in the region.
263 Subsequent letters of each word are not changed.
264 In programs, give two arguments, the starting and ending
265 character positions to operate on.
266 Optional third arg BUFFER defaults to the current buffer.
267 */
268 (b, e, buffer))
269 {
270 return casify_region (CASE_CAPITALIZE_UP, b, e, buffer);
271 }
272
273
274 static Lisp_Object
275 casify_word (enum case_action flag, Lisp_Object arg, Lisp_Object buffer)
276 {
277 Bufpos farend;
278 struct buffer *buf = decode_buffer (buffer, 1);
279
280 CHECK_INT (arg);
281
282 farend = scan_words (buf, BUF_PT (buf), XINT (arg));
283 if (!farend)
284 farend = XINT (arg) > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
285
286 casify_region_internal (flag, make_int (BUF_PT (buf)), make_int (farend), buf);
287 BUF_SET_PT (buf, max (BUF_PT (buf), farend));
288 return Qnil;
289 }
290
291 DEFUN ("upcase-word", Fupcase_word, 1, 2, "p", /*
292 Convert following word (or N words) to upper case, moving over.
293 With negative argument, convert previous words but do not move.
294 See also `capitalize-word'.
295 Optional second arg BUFFER defaults to the current buffer.
296 */
297 (n, buffer))
298 {
299 /* This function can GC */
300 return casify_word (CASE_UP, n, buffer);
301 }
302
303 DEFUN ("downcase-word", Fdowncase_word, 1, 2, "p", /*
304 Convert following word (or N words) to lower case, moving over.
305 With negative argument, convert previous words but do not move.
306 Optional second arg BUFFER defaults to the current buffer.
307 */
308 (n, buffer))
309 {
310 /* This function can GC */
311 return casify_word (CASE_DOWN, n, buffer);
312 }
313
314 DEFUN ("capitalize-word", Fcapitalize_word, 1, 2, "p", /*
315 Capitalize the following word (or N words), moving over.
316 This gives the word(s) a first character in upper case
317 and the rest lower case.
318 With negative argument, capitalize previous words but do not move.
319 Optional second arg BUFFER defaults to the current buffer.
320 */
321 (n, buffer))
322 {
323 /* This function can GC */
324 return casify_word (CASE_CAPITALIZE, n, buffer);
325 }
326
327
328 void
329 syms_of_casefiddle (void)
330 {
331 DEFSUBR (Fupcase);
332 DEFSUBR (Fdowncase);
333 DEFSUBR (Fcapitalize);
334 DEFSUBR (Fupcase_initials);
335 DEFSUBR (Fupcase_region);
336 DEFSUBR (Fdowncase_region);
337 DEFSUBR (Fcapitalize_region);
338 DEFSUBR (Fupcase_initials_region);
339 DEFSUBR (Fupcase_word);
340 DEFSUBR (Fdowncase_word);
341 DEFSUBR (Fcapitalize_word);
342 }