*** empty log message ***
[emacs.git] / src / casefiddle.c
blobcb7c953a3e45caf77b361e2b3269aed60f86b0ba
1 /* GNU Emacs case conversion functions.
2 Copyright (C) 1985, 1994, 1997, 1998, 1999, 2001, 2002, 2003, 2004,
3 2005, 2006 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
23 #include <config.h>
24 #include "lisp.h"
25 #include "buffer.h"
26 #include "charset.h"
27 #include "commands.h"
28 #include "syntax.h"
29 #include "composite.h"
30 #include "keymap.h"
32 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
34 Lisp_Object Qidentity;
36 Lisp_Object
37 casify_object (flag, obj)
38 enum case_action flag;
39 Lisp_Object obj;
41 register int i, c, len;
42 register int inword = flag == CASE_DOWN;
44 /* If the case table is flagged as modified, rescan it. */
45 if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
46 Fset_case_table (current_buffer->downcase_table);
48 if (INTEGERP (obj))
50 int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
51 | CHAR_SHIFT | CHAR_CTL | CHAR_META);
52 int flags = XINT (obj) & flagbits;
54 /* If the character has higher bits set
55 above the flags, return it unchanged.
56 It is not a real character. */
57 if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
58 return obj;
60 c = DOWNCASE (XFASTINT (obj) & ~flagbits);
61 if (inword)
62 XSETFASTINT (obj, c | flags);
63 else if (c == (XFASTINT (obj) & ~flagbits))
65 c = UPCASE1 ((XFASTINT (obj) & ~flagbits));
66 XSETFASTINT (obj, c | flags);
68 return obj;
71 if (STRINGP (obj))
73 int multibyte = STRING_MULTIBYTE (obj);
74 int n;
76 obj = Fcopy_sequence (obj);
77 len = SBYTES (obj);
79 /* I counts bytes, and N counts chars. */
80 for (i = n = 0; i < len; n++)
82 int from_len = 1, to_len = 1;
84 c = SREF (obj, i);
86 if (multibyte && c >= 0x80)
87 c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i, len -i, from_len);
88 if (inword && flag != CASE_CAPITALIZE_UP)
89 c = DOWNCASE (c);
90 else if (!UPPERCASEP (c)
91 && (!inword || flag != CASE_CAPITALIZE_UP))
92 c = UPCASE1 (c);
93 if ((ASCII_BYTE_P (c) && from_len == 1)
94 || (! multibyte && SINGLE_BYTE_CHAR_P (c)))
95 SSET (obj, i, c);
96 else
98 to_len = CHAR_BYTES (c);
99 if (from_len == to_len)
100 CHAR_STRING (c, SDATA (obj) + i);
101 else
103 Faset (obj, make_number (n), make_number (c));
104 len += to_len - from_len;
107 if ((int) flag >= (int) CASE_CAPITALIZE)
108 inword = SYNTAX (c) == Sword;
109 i += to_len;
111 return obj;
114 wrong_type_argument (Qchar_or_string_p, obj);
117 DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
118 doc: /* Convert argument to upper case and return that.
119 The argument may be a character or string. The result has the same type.
120 The argument object is not altered--the value is a copy.
121 See also `capitalize', `downcase' and `upcase-initials'. */)
122 (obj)
123 Lisp_Object obj;
125 return casify_object (CASE_UP, obj);
128 DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
129 doc: /* Convert argument to lower case and return that.
130 The argument may be a character or string. The result has the same type.
131 The argument object is not altered--the value is a copy. */)
132 (obj)
133 Lisp_Object obj;
135 return casify_object (CASE_DOWN, obj);
138 DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
139 doc: /* Convert argument to capitalized form and return that.
140 This means that each word's first character is upper case
141 and the rest is lower case.
142 The argument may be a character or string. The result has the same type.
143 The argument object is not altered--the value is a copy. */)
144 (obj)
145 Lisp_Object obj;
147 return casify_object (CASE_CAPITALIZE, obj);
150 /* Like Fcapitalize but change only the initials. */
152 DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
153 doc: /* Convert the initial of each word in the argument to upper case.
154 Do not change the other letters of each word.
155 The argument may be a character or string. The result has the same type.
156 The argument object is not altered--the value is a copy. */)
157 (obj)
158 Lisp_Object obj;
160 return casify_object (CASE_CAPITALIZE_UP, obj);
163 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
164 b and e specify range of buffer to operate on. */
166 void
167 casify_region (flag, b, e)
168 enum case_action flag;
169 Lisp_Object b, e;
171 register int i;
172 register int c;
173 register int inword = flag == CASE_DOWN;
174 register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
175 int start, end;
176 int start_byte, end_byte;
177 int changed = 0;
179 if (EQ (b, e))
180 /* Not modifying because nothing marked */
181 return;
183 /* If the case table is flagged as modified, rescan it. */
184 if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
185 Fset_case_table (current_buffer->downcase_table);
187 validate_region (&b, &e);
188 start = XFASTINT (b);
189 end = XFASTINT (e);
190 modify_region (current_buffer, start, end, 0);
191 record_change (start, end - start);
192 start_byte = CHAR_TO_BYTE (start);
193 end_byte = CHAR_TO_BYTE (end);
195 for (i = start_byte; i < end_byte; i++, start++)
197 int c2;
198 c = c2 = FETCH_BYTE (i);
199 if (multibyte && c >= 0x80)
200 /* A multibyte character can't be handled in this simple loop. */
201 break;
202 if (inword && flag != CASE_CAPITALIZE_UP)
203 c = DOWNCASE (c);
204 else if (!UPPERCASEP (c)
205 && (!inword || flag != CASE_CAPITALIZE_UP))
206 c = UPCASE1 (c);
207 if (multibyte && c >= 0x80)
208 /* A multibyte result character can't be handled in this
209 simple loop. */
210 break;
211 FETCH_BYTE (i) = c;
212 if (c != c2)
213 changed = 1;
214 if ((int) flag >= (int) CASE_CAPITALIZE)
215 inword = SYNTAX (c) == Sword && (inword || !SYNTAX_PREFIX (c));
217 if (i < end_byte)
219 /* The work is not yet finished because of a multibyte character
220 just encountered. */
221 int opoint = PT;
222 int opoint_byte = PT_BYTE;
223 int c2;
225 while (start < end)
227 if ((c = FETCH_BYTE (i)) >= 0x80)
228 c = FETCH_MULTIBYTE_CHAR (i);
229 c2 = c;
230 if (inword && flag != CASE_CAPITALIZE_UP)
231 c2 = DOWNCASE (c);
232 else if (!UPPERCASEP (c)
233 && (!inword || flag != CASE_CAPITALIZE_UP))
234 c2 = UPCASE1 (c);
235 if (c != c2)
237 int fromlen, tolen, j;
238 unsigned char str[MAX_MULTIBYTE_LENGTH];
240 changed = 1;
241 /* Handle the most likely case */
242 if (c < 0400 && c2 < 0400)
243 FETCH_BYTE (i) = c2;
244 else if (fromlen = CHAR_STRING (c, str),
245 tolen = CHAR_STRING (c2, str),
246 fromlen == tolen)
248 /* Length is unchanged. */
249 for (j = 0; j < tolen; ++j)
250 FETCH_BYTE (i + j) = str[j];
252 else
254 /* Replace one character with the other,
255 keeping text properties the same. */
256 replace_range_2 (start, i,
257 start + 1, i + fromlen,
258 str, 1, tolen,
260 if (opoint > start)
261 opoint_byte += tolen - fromlen;
264 if ((int) flag >= (int) CASE_CAPITALIZE)
265 inword = SYNTAX (c2) == Sword;
266 INC_BOTH (start, i);
268 TEMP_SET_PT_BOTH (opoint, opoint_byte);
271 start = XFASTINT (b);
272 if (changed)
274 signal_after_change (start, end - start, end - start);
275 update_compositions (start, end, CHECK_ALL);
279 DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
280 doc: /* Convert the region to upper case. In programs, wants two arguments.
281 These arguments specify the starting and ending character numbers of
282 the region to operate on. When used as a command, the text between
283 point and the mark is operated on.
284 See also `capitalize-region'. */)
285 (beg, end)
286 Lisp_Object beg, end;
288 casify_region (CASE_UP, beg, end);
289 return Qnil;
292 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
293 doc: /* Convert the region to lower case. In programs, wants two arguments.
294 These arguments specify the starting and ending character numbers of
295 the region to operate on. When used as a command, the text between
296 point and the mark is operated on. */)
297 (beg, end)
298 Lisp_Object beg, end;
300 casify_region (CASE_DOWN, beg, end);
301 return Qnil;
304 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
305 doc: /* Convert the region to capitalized form.
306 Capitalized form means each word's first character is upper case
307 and the rest of it is lower case.
308 In programs, give two arguments, the starting and ending
309 character positions to operate on. */)
310 (beg, end)
311 Lisp_Object beg, end;
313 casify_region (CASE_CAPITALIZE, beg, end);
314 return Qnil;
317 /* Like Fcapitalize_region but change only the initials. */
319 DEFUN ("upcase-initials-region", Fupcase_initials_region,
320 Supcase_initials_region, 2, 2, "r",
321 doc: /* Upcase the initial of each word in the region.
322 Subsequent letters of each word are not changed.
323 In programs, give two arguments, the starting and ending
324 character positions to operate on. */)
325 (beg, end)
326 Lisp_Object beg, end;
328 casify_region (CASE_CAPITALIZE_UP, beg, end);
329 return Qnil;
332 Lisp_Object
333 operate_on_word (arg, newpoint)
334 Lisp_Object arg;
335 int *newpoint;
337 Lisp_Object val;
338 int farend;
339 int iarg;
341 CHECK_NUMBER (arg);
342 iarg = XINT (arg);
343 farend = scan_words (PT, iarg);
344 if (!farend)
345 farend = iarg > 0 ? ZV : BEGV;
347 *newpoint = PT > farend ? PT : farend;
348 XSETFASTINT (val, farend);
350 return val;
353 DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
354 doc: /* Convert following word (or ARG words) to upper case, moving over.
355 With negative argument, convert previous words but do not move.
356 See also `capitalize-word'. */)
357 (arg)
358 Lisp_Object arg;
360 Lisp_Object beg, end;
361 int newpoint;
362 XSETFASTINT (beg, PT);
363 end = operate_on_word (arg, &newpoint);
364 casify_region (CASE_UP, beg, end);
365 SET_PT (newpoint);
366 return Qnil;
369 DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
370 doc: /* Convert following word (or ARG words) to lower case, moving over.
371 With negative argument, convert previous words but do not move. */)
372 (arg)
373 Lisp_Object arg;
375 Lisp_Object beg, end;
376 int newpoint;
377 XSETFASTINT (beg, PT);
378 end = operate_on_word (arg, &newpoint);
379 casify_region (CASE_DOWN, beg, end);
380 SET_PT (newpoint);
381 return Qnil;
384 DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
385 doc: /* Capitalize the following word (or ARG words), moving over.
386 This gives the word(s) a first character in upper case
387 and the rest lower case.
388 With negative argument, capitalize previous words but do not move. */)
389 (arg)
390 Lisp_Object arg;
392 Lisp_Object beg, end;
393 int newpoint;
394 XSETFASTINT (beg, PT);
395 end = operate_on_word (arg, &newpoint);
396 casify_region (CASE_CAPITALIZE, beg, end);
397 SET_PT (newpoint);
398 return Qnil;
401 void
402 syms_of_casefiddle ()
404 Qidentity = intern ("identity");
405 staticpro (&Qidentity);
406 defsubr (&Supcase);
407 defsubr (&Sdowncase);
408 defsubr (&Scapitalize);
409 defsubr (&Supcase_initials);
410 defsubr (&Supcase_region);
411 defsubr (&Sdowncase_region);
412 defsubr (&Scapitalize_region);
413 defsubr (&Supcase_initials_region);
414 defsubr (&Supcase_word);
415 defsubr (&Sdowncase_word);
416 defsubr (&Scapitalize_word);
419 void
420 keys_of_casefiddle ()
422 initial_define_key (control_x_map, Ctl('U'), "upcase-region");
423 Fput (intern ("upcase-region"), Qdisabled, Qt);
424 initial_define_key (control_x_map, Ctl('L'), "downcase-region");
425 Fput (intern ("downcase-region"), Qdisabled, Qt);
427 initial_define_key (meta_map, 'u', "upcase-word");
428 initial_define_key (meta_map, 'l', "downcase-word");
429 initial_define_key (meta_map, 'c', "capitalize-word");
432 /* arch-tag: 60a73c66-5489-47e7-a81f-cead4057c526
433 (do not change this comment) */