Mercurial > hg > xemacs-beta

comparison src/casefiddle.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 859a2309aef8
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 /* XEmacs case conversion functions.
2 Copyright (C) 1985, 1992, 1993, 1994 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.30. */
22
23 #include <config.h>
24 #include "lisp.h"
25
26 #include "buffer.h"
27 #include "commands.h"
28 #include "insdel.h"
29 #include "syntax.h"
30
31 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
32
33 static Lisp_Object
34 casify_object (struct buffer *buf, enum case_action flag, Lisp_Object obj)
35 {
36 REGISTER Emchar c;
37 REGISTER Charcount i, len;
38 REGISTER int inword = flag == CASE_DOWN;
39 Lisp_Object syntax_table = buf->syntax_table;
40
41 while (1)
42 {
43 if (CHAR_OR_CHAR_INTP (obj))
44 {
45 CHECK_CHAR_COERCE_INT (obj);
46 c = XCHAR (obj);
47 if (IN_TRT_TABLE_DOMAIN (c))
48 {
49 if (inword)
50 obj = make_char (DOWNCASE (buf, c));
51 else if (!UPPERCASEP (buf, c))
52 obj = make_char (UPCASE1 (buf, c));
53 }
54 return obj;
55 }
56 if (STRINGP (obj))
57 {
58 obj = Fcopy_sequence (obj);
59 len = string_char_length (XSTRING (obj));
60 for (i = 0; i < len; i++)
61 {
62 c = string_char (XSTRING (obj), i);
63 if (inword)
64 c = DOWNCASE (buf, c);
65 else if (!UPPERCASEP (buf, c)
66 && (!inword || flag != CASE_CAPITALIZE_UP))
67 c = UPCASE1 (buf, c);
68 set_string_char (XSTRING (obj), i, c);
69 if ((int) flag >= (int) CASE_CAPITALIZE)
70 inword = WORD_SYNTAX_P (syntax_table, c);
71 }
72 return obj;
73 }
74 obj = wrong_type_argument (Qchar_or_string_p, obj);
75 }
76 }
77
78 DEFUN ("upcase", Fupcase, Supcase, 1, 2, 0 /*
79 Convert argument to upper case and return that.
80 The argument may be a character or string. The result has the same type.
81 The argument object is not altered--the value is a copy.
82 See also `capitalize', `downcase' and `upcase-initials'.
83 Optional second arg BUFFER specifies which buffer's case tables to use,
84 and defaults to the current buffer.
85 */ )
86 (obj, buffer)
87 Lisp_Object obj, buffer;
88 {
89 return casify_object (decode_buffer (buffer, 0), CASE_UP, obj);
90 }
91
92 DEFUN ("downcase", Fdowncase, Sdowncase, 1, 2, 0 /*
93 Convert argument to lower case and return that.
94 The argument may be a character or string. The result has the same type.
95 The argument object is not altered--the value is a copy.
96 Optional second arg BUFFER specifies which buffer's case tables to use,
97 and defaults to the current buffer.
98 */ )
99 (obj, buffer)
100 Lisp_Object obj, buffer;
101 {
102 return casify_object (decode_buffer (buffer, 0), CASE_DOWN, obj);
103 }
104
105 DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 2, 0 /*
106 Convert argument to capitalized form and return that.
107 This means that each word's first character is upper case
108 and the rest is lower case.
109 The argument may be a character or string. The result has the same type.
110 The argument object is not altered--the value is a copy.
111 Optional second arg BUFFER specifies which buffer's case tables to use,
112 and defaults to the current buffer.
113 */ )
114 (obj, buffer)
115 Lisp_Object obj, buffer;
116 {
117 return casify_object (decode_buffer (buffer, 0), CASE_CAPITALIZE, obj);
118 }
119
120 /* Like Fcapitalize but change only the initials. */
121
122 DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 2, 0 /*
123 Convert the initial of each word in the argument to upper case.
124 Do not change the other letters of each word.
125 The argument may be a character or string. The result has the same type.
126 The argument object is not altered--the value is a copy.
127 Optional second arg BUFFER specifies which buffer's case tables to use,
128 and defaults to the current buffer.
129 */ )
130 (obj, buffer)
131 Lisp_Object obj, buffer;
132 {
133 return casify_object (decode_buffer (buffer, 0), CASE_CAPITALIZE_UP, obj);
134 }
135
136 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
137 b and e specify range of buffer to operate on. */
138
139 static void
140 casify_region (struct buffer *buf, enum case_action flag, Lisp_Object b,
141 Lisp_Object e)
142 {
143 /* This function can GC */
144 REGISTER Bufpos i;
145 Bufpos start, end;
146 REGISTER Emchar c;
147 REGISTER int inword = flag == CASE_DOWN;
148 Lisp_Object syntax_table = buf->syntax_table;
149 int mccount;
150
151 if (EQ (b, e))
152 /* Not modifying because nothing marked */
153 return;
154
155 get_buffer_range_char (buf, b, e, &start, &end, 0);
156
157 mccount = begin_multiple_change (buf, start, end);
158 record_change (buf, start, end - start);
159 BUF_MODIFF (buf)++;
160
161 for (i = start; i < end; i++)
162 {
163 c = BUF_FETCH_CHAR (buf, i);
164 if (inword && flag != CASE_CAPITALIZE_UP)
165 c = DOWNCASE (buf, c);
166 else if (!UPPERCASEP (buf, c)
167 && (!inword || flag != CASE_CAPITALIZE_UP))
168 c = UPCASE1 (buf, c);
169
170 buffer_replace_char (buf, i, c, 1, (i == start));
171 /* !!#### need to revalidate the start and end pointers in case
172 the buffer was changed */
173 if ((int) flag >= (int) CASE_CAPITALIZE)
174 inword = WORD_SYNTAX_P (syntax_table, c);
175 }
176 end_multiple_change (buf, mccount);
177 }
178
179 DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 3, "r" /*
180 Convert the region to upper case. In programs, wants two arguments.
181 These arguments specify the starting and ending character numbers of
182 the region to operate on. When used as a command, the text between
183 point and the mark is operated on.
184 See also `capitalize-region'.
185 Optional third arg BUFFER defaults to the current buffer.
186 */ )
187 (b, e, buffer)
188 Lisp_Object b, e, buffer;
189 {
190 /* This function can GC */
191 casify_region (decode_buffer (buffer, 1), CASE_UP, b, e);
192 return Qnil;
193 }
194
195 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3, "r" /*
196 Convert the region to lower case. In programs, wants two arguments.
197 These arguments specify the starting and ending character numbers of
198 the region to operate on. When used as a command, the text between
199 point and the mark is operated on.
200 Optional third arg BUFFER defaults to the current buffer.
201 */ )
202 (b, e, buffer)
203 Lisp_Object b, e, buffer;
204 {
205 /* This function can GC */
206 casify_region (decode_buffer (buffer, 1), CASE_DOWN, b, e);
207 return Qnil;
208 }
209
210 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 3, "r" /*
211 Convert the region to capitalized form.
212 Capitalized form means each word's first character is upper case
213 and the rest of it is lower case.
214 In programs, give two arguments, the starting and ending
215 character positions to operate on.
216 Optional third arg BUFFER defaults to the current buffer.
217 */ )
218 (b, e, buffer)
219 Lisp_Object b, e, buffer;
220 {
221 /* This function can GC */
222 casify_region (decode_buffer (buffer, 1), CASE_CAPITALIZE, b, e);
223 return Qnil;
224 }
225
226 /* Like Fcapitalize_region but change only the initials. */
227
228 DEFUN ("upcase-initials-region", Fupcase_initials_region,
229 Supcase_initials_region, 2, 3, "r" /*
230 Upcase the initial of each word in the region.
231 Subsequent letters of each word are not changed.
232 In programs, give two arguments, the starting and ending
233 character positions to operate on.
234 Optional third arg BUFFER defaults to the current buffer.
235 */ )
236 (b, e, buffer)
237 Lisp_Object b, e, buffer;
238 {
239 casify_region (decode_buffer (buffer, 1), CASE_CAPITALIZE_UP, b, e);
240 return Qnil;
241 }
242
243
244 static Lisp_Object
245 operate_on_word (struct buffer *buf, Lisp_Object arg, int *newpoint)
246 {
247 Bufpos farend;
248
249 CHECK_INT (arg);
250 farend = scan_words (buf, BUF_PT (buf), XINT (arg));
251 if (!farend)
252 farend = XINT (arg) > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
253
254 *newpoint = ((BUF_PT (buf) > farend) ? BUF_PT (buf) : farend);
255 return (make_int (farend));
256 }
257
258 DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 2, "p" /*
259 Convert following word (or ARG words) to upper case, moving over.
260 With negative argument, convert previous words but do not move.
261 See also `capitalize-word'.
262 Optional second arg BUFFER defaults to the current buffer.
263 */ )
264 (arg, buffer)
265 Lisp_Object arg, buffer;
266 {
267 /* This function can GC */
268 Lisp_Object beg, end;
269 Bufpos newpoint;
270 struct buffer *buf = decode_buffer (buffer, 1);
271
272 beg = make_int (BUF_PT (buf));
273 end = operate_on_word (buf, arg, &newpoint);
274 casify_region (buf, CASE_UP, beg, end);
275 BUF_SET_PT (buf, newpoint);
276 return Qnil;
277 }
278
279 DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 2, "p" /*
280 Convert following word (or ARG words) to lower case, moving over.
281 With negative argument, convert previous words but do not move.
282 Optional second arg BUFFER defaults to the current buffer.
283 */ )
284 (arg, buffer)
285 Lisp_Object arg, buffer;
286 {
287 /* This function can GC */
288 Lisp_Object beg, end;
289 Bufpos newpoint;
290 struct buffer *buf = decode_buffer (buffer, 1);
291
292 beg = make_int (BUF_PT (buf));
293 end = operate_on_word (buf, arg, &newpoint);
294 casify_region (buf, CASE_DOWN, beg, end);
295 BUF_SET_PT (buf, newpoint);
296 return Qnil;
297 }
298
299 DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 2, "p" /*
300 Capitalize the following word (or ARG words), moving over.
301 This gives the word(s) a first character in upper case
302 and the rest lower case.
303 With negative argument, capitalize previous words but do not move.
304 Optional second arg BUFFER defaults to the current buffer.
305 */ )
306 (arg, buffer)
307 Lisp_Object arg, buffer;
308 {
309 /* This function can GC */
310 Lisp_Object beg, end;
311 Bufpos newpoint;
312 struct buffer *buf = decode_buffer (buffer, 1);
313
314 beg = make_int (BUF_PT (buf));
315 end = operate_on_word (buf, arg, &newpoint);
316 casify_region (buf, CASE_CAPITALIZE, beg, end);
317 BUF_SET_PT (buf, newpoint);
318 return Qnil;
319 }
320
321
322 void
323 syms_of_casefiddle (void)
324 {
325 defsubr (&Supcase);
326 defsubr (&Sdowncase);
327 defsubr (&Scapitalize);
328 defsubr (&Supcase_initials);
329 defsubr (&Supcase_region);
330 defsubr (&Sdowncase_region);
331 defsubr (&Scapitalize_region);
332 defsubr (&Supcase_initials_region);
333 defsubr (&Supcase_word);
334 defsubr (&Sdowncase_word);
335 defsubr (&Scapitalize_word);
336 }