*** empty log message ***
[emacs.git] / src / casefiddle.c
blob25a5a3d12b83bd8fdcd056d00ee3604827000c36
1 /* GNU Emacs case conversion functions.
2 Copyright (C) 1985,94,97,98,99, 2001, 2002, 2004
3 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., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, 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 while (1)
50 if (INTEGERP (obj))
52 int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
53 | CHAR_SHIFT | CHAR_CTL | CHAR_META);
54 int flags = XINT (obj) & flagbits;
56 /* If the character has higher bits set
57 above the flags, return it unchanged.
58 It is not a real character. */
59 if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
60 return obj;
62 c = DOWNCASE (XFASTINT (obj) & ~flagbits);
63 if (inword)
64 XSETFASTINT (obj, c | flags);
65 else if (c == (XFASTINT (obj) & ~flagbits))
67 c = UPCASE1 ((XFASTINT (obj) & ~flagbits));
68 XSETFASTINT (obj, c | flags);
70 return obj;
73 if (STRINGP (obj))
75 int multibyte = STRING_MULTIBYTE (obj);
77 obj = Fcopy_sequence (obj);
78 len = SBYTES (obj);
80 /* Scan all single-byte characters from start of string. */
81 for (i = 0; i < len;)
83 c = SREF (obj, i);
85 if (multibyte && c >= 0x80)
86 /* A multibyte character can't be handled in this
87 simple loop. */
88 break;
89 if (inword && flag != CASE_CAPITALIZE_UP)
90 c = DOWNCASE (c);
91 else if (!UPPERCASEP (c)
92 && (!inword || flag != CASE_CAPITALIZE_UP))
93 c = UPCASE1 (c);
94 /* If this char won't fit in a single-byte string.
95 fall out to the multibyte case. */
96 if (multibyte ? ! ASCII_BYTE_P (c)
97 : ! SINGLE_BYTE_CHAR_P (c))
98 break;
100 SSET (obj, i, c);
101 if ((int) flag >= (int) CASE_CAPITALIZE)
102 inword = SYNTAX (c) == Sword;
103 i++;
106 /* If we didn't do the whole string as single-byte,
107 scan the rest in a more complex way. */
108 if (i < len)
110 /* The work is not yet finished because of a multibyte
111 character just encountered. */
112 int fromlen, j_byte = i;
113 char *buf;
114 int bufsize;
115 USE_SAFE_ALLOCA;
117 bufsize = (len - i) * MAX_MULTIBYTE_LENGTH + i;
118 SAFE_ALLOCA (buf, char *, bufsize);
120 /* Copy data already handled. */
121 bcopy (SDATA (obj), buf, i);
123 /* From now on, I counts bytes. */
124 while (i < len)
126 c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i,
127 len - i, fromlen);
128 if (inword && flag != CASE_CAPITALIZE_UP)
129 c = DOWNCASE (c);
130 else if (!UPPERCASEP (c)
131 && (!inword || flag != CASE_CAPITALIZE_UP))
132 c = UPCASE1 (c);
133 i += fromlen;
134 j_byte += CHAR_STRING (c, buf + j_byte);
135 if ((int) flag >= (int) CASE_CAPITALIZE)
136 inword = SYNTAX (c) == Sword;
138 obj = make_multibyte_string (buf, SCHARS (obj),
139 j_byte);
140 SAFE_FREE (bufsize);
142 return obj;
144 obj = wrong_type_argument (Qchar_or_string_p, obj);
148 DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
149 doc: /* Convert argument to upper case and return that.
150 The argument may be a character or string. The result has the same type.
151 The argument object is not altered--the value is a copy.
152 See also `capitalize', `downcase' and `upcase-initials'. */)
153 (obj)
154 Lisp_Object obj;
156 return casify_object (CASE_UP, obj);
159 DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
160 doc: /* Convert argument to lower case and return that.
161 The argument may be a character or string. The result has the same type.
162 The argument object is not altered--the value is a copy. */)
163 (obj)
164 Lisp_Object obj;
166 return casify_object (CASE_DOWN, obj);
169 DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
170 doc: /* Convert argument to capitalized form and return that.
171 This means that each word's first character is upper case
172 and the rest is lower case.
173 The argument may be a character or string. The result has the same type.
174 The argument object is not altered--the value is a copy. */)
175 (obj)
176 Lisp_Object obj;
178 return casify_object (CASE_CAPITALIZE, obj);
181 /* Like Fcapitalize but change only the initials. */
183 DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
184 doc: /* Convert the initial of each word in the argument to upper case.
185 Do not change the other letters of each word.
186 The argument may be a character or string. The result has the same type.
187 The argument object is not altered--the value is a copy. */)
188 (obj)
189 Lisp_Object obj;
191 return casify_object (CASE_CAPITALIZE_UP, obj);
194 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
195 b and e specify range of buffer to operate on. */
197 void
198 casify_region (flag, b, e)
199 enum case_action flag;
200 Lisp_Object b, e;
202 register int i;
203 register int c;
204 register int inword = flag == CASE_DOWN;
205 register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
206 int start, end;
207 int start_byte, end_byte;
208 int changed = 0;
210 if (EQ (b, e))
211 /* Not modifying because nothing marked */
212 return;
214 /* If the case table is flagged as modified, rescan it. */
215 if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
216 Fset_case_table (current_buffer->downcase_table);
218 validate_region (&b, &e);
219 start = XFASTINT (b);
220 end = XFASTINT (e);
221 modify_region (current_buffer, start, end);
222 record_change (start, end - start);
223 start_byte = CHAR_TO_BYTE (start);
224 end_byte = CHAR_TO_BYTE (end);
226 for (i = start_byte; i < end_byte; i++, start++)
228 int c2;
229 c = c2 = FETCH_BYTE (i);
230 if (multibyte && c >= 0x80)
231 /* A multibyte character can't be handled in this simple loop. */
232 break;
233 if (inword && flag != CASE_CAPITALIZE_UP)
234 c = DOWNCASE (c);
235 else if (!UPPERCASEP (c)
236 && (!inword || flag != CASE_CAPITALIZE_UP))
237 c = UPCASE1 (c);
238 FETCH_BYTE (i) = c;
239 if (c != c2)
240 changed = 1;
241 if ((int) flag >= (int) CASE_CAPITALIZE)
242 inword = SYNTAX (c) == Sword && (inword || !SYNTAX_PREFIX (c));
244 if (i < end_byte)
246 /* The work is not yet finished because of a multibyte character
247 just encountered. */
248 int opoint = PT;
249 int opoint_byte = PT_BYTE;
250 int c2;
252 while (i < end_byte)
254 if ((c = FETCH_BYTE (i)) >= 0x80)
255 c = FETCH_MULTIBYTE_CHAR (i);
256 c2 = c;
257 if (inword && flag != CASE_CAPITALIZE_UP)
258 c2 = DOWNCASE (c);
259 else if (!UPPERCASEP (c)
260 && (!inword || flag != CASE_CAPITALIZE_UP))
261 c2 = UPCASE1 (c);
262 if (c != c2)
264 int fromlen, tolen, j;
265 unsigned char str[MAX_MULTIBYTE_LENGTH];
267 changed = 1;
268 /* Handle the most likely case */
269 if (c < 0400 && c2 < 0400)
270 FETCH_BYTE (i) = c2;
271 else if (fromlen = CHAR_STRING (c, str),
272 tolen = CHAR_STRING (c2, str),
273 fromlen == tolen)
275 for (j = 0; j < tolen; ++j)
276 FETCH_BYTE (i + j) = str[j];
278 else
280 error ("Can't casify letters that change length");
281 #if 0 /* This is approximately what we'd like to be able to do here */
282 if (tolen < fromlen)
283 del_range_1 (i + tolen, i + fromlen, 0, 0);
284 else if (tolen > fromlen)
286 TEMP_SET_PT (i + fromlen);
287 insert_1 (str + fromlen, tolen - fromlen, 1, 0, 0);
289 #endif
292 if ((int) flag >= (int) CASE_CAPITALIZE)
293 inword = SYNTAX (c2) == Sword;
294 INC_BOTH (start, i);
296 TEMP_SET_PT_BOTH (opoint, opoint_byte);
299 start = XFASTINT (b);
300 if (changed)
302 signal_after_change (start, end - start, end - start);
303 update_compositions (start, end, CHECK_ALL);
307 DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
308 doc: /* Convert the region to upper case. In programs, wants two arguments.
309 These arguments specify the starting and ending character numbers of
310 the region to operate on. When used as a command, the text between
311 point and the mark is operated on.
312 See also `capitalize-region'. */)
313 (beg, end)
314 Lisp_Object beg, end;
316 casify_region (CASE_UP, beg, end);
317 return Qnil;
320 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
321 doc: /* Convert the region to lower case. In programs, wants two arguments.
322 These arguments specify the starting and ending character numbers of
323 the region to operate on. When used as a command, the text between
324 point and the mark is operated on. */)
325 (beg, end)
326 Lisp_Object beg, end;
328 casify_region (CASE_DOWN, beg, end);
329 return Qnil;
332 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
333 doc: /* Convert the region to capitalized form.
334 Capitalized form means each word's first character is upper case
335 and the rest of it is lower case.
336 In programs, give two arguments, the starting and ending
337 character positions to operate on. */)
338 (beg, end)
339 Lisp_Object beg, end;
341 casify_region (CASE_CAPITALIZE, beg, end);
342 return Qnil;
345 /* Like Fcapitalize_region but change only the initials. */
347 DEFUN ("upcase-initials-region", Fupcase_initials_region,
348 Supcase_initials_region, 2, 2, "r",
349 doc: /* Upcase the initial of each word in the region.
350 Subsequent letters of each word are not changed.
351 In programs, give two arguments, the starting and ending
352 character positions to operate on. */)
353 (beg, end)
354 Lisp_Object beg, end;
356 casify_region (CASE_CAPITALIZE_UP, beg, end);
357 return Qnil;
360 Lisp_Object
361 operate_on_word (arg, newpoint)
362 Lisp_Object arg;
363 int *newpoint;
365 Lisp_Object val;
366 int farend;
367 int iarg;
369 CHECK_NUMBER (arg);
370 iarg = XINT (arg);
371 farend = scan_words (PT, iarg);
372 if (!farend)
373 farend = iarg > 0 ? ZV : BEGV;
375 *newpoint = PT > farend ? PT : farend;
376 XSETFASTINT (val, farend);
378 return val;
381 DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
382 doc: /* Convert following word (or ARG words) to upper case, moving over.
383 With negative argument, convert previous words but do not move.
384 See also `capitalize-word'. */)
385 (arg)
386 Lisp_Object arg;
388 Lisp_Object beg, end;
389 int newpoint;
390 XSETFASTINT (beg, PT);
391 end = operate_on_word (arg, &newpoint);
392 casify_region (CASE_UP, beg, end);
393 SET_PT (newpoint);
394 return Qnil;
397 DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
398 doc: /* Convert following word (or ARG words) to lower case, moving over.
399 With negative argument, convert previous words but do not move. */)
400 (arg)
401 Lisp_Object arg;
403 Lisp_Object beg, end;
404 int newpoint;
405 XSETFASTINT (beg, PT);
406 end = operate_on_word (arg, &newpoint);
407 casify_region (CASE_DOWN, beg, end);
408 SET_PT (newpoint);
409 return Qnil;
412 DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
413 doc: /* Capitalize the following word (or ARG words), moving over.
414 This gives the word(s) a first character in upper case
415 and the rest lower case.
416 With negative argument, capitalize previous words but do not move. */)
417 (arg)
418 Lisp_Object arg;
420 Lisp_Object beg, end;
421 int newpoint;
422 XSETFASTINT (beg, PT);
423 end = operate_on_word (arg, &newpoint);
424 casify_region (CASE_CAPITALIZE, beg, end);
425 SET_PT (newpoint);
426 return Qnil;
429 void
430 syms_of_casefiddle ()
432 Qidentity = intern ("identity");
433 staticpro (&Qidentity);
434 defsubr (&Supcase);
435 defsubr (&Sdowncase);
436 defsubr (&Scapitalize);
437 defsubr (&Supcase_initials);
438 defsubr (&Supcase_region);
439 defsubr (&Sdowncase_region);
440 defsubr (&Scapitalize_region);
441 defsubr (&Supcase_initials_region);
442 defsubr (&Supcase_word);
443 defsubr (&Sdowncase_word);
444 defsubr (&Scapitalize_word);
447 void
448 keys_of_casefiddle ()
450 initial_define_key (control_x_map, Ctl('U'), "upcase-region");
451 Fput (intern ("upcase-region"), Qdisabled, Qt);
452 initial_define_key (control_x_map, Ctl('L'), "downcase-region");
453 Fput (intern ("downcase-region"), Qdisabled, Qt);
455 initial_define_key (meta_map, 'u', "upcase-word");
456 initial_define_key (meta_map, 'l', "downcase-word");
457 initial_define_key (meta_map, 'c', "capitalize-word");
460 /* arch-tag: 60a73c66-5489-47e7-a81f-cead4057c526
461 (do not change this comment) */