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)
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. */
26 #include "character.h"
29 #include "composite.h"
32 enum case_action
{CASE_UP
, CASE_DOWN
, CASE_CAPITALIZE
, CASE_CAPITALIZE_UP
};
34 Lisp_Object Qidentity
;
37 casify_object (flag
, obj
)
38 enum case_action flag
;
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
);
52 int flagbits
= (CHAR_ALT
| CHAR_SUPER
| CHAR_HYPER
53 | CHAR_SHIFT
| CHAR_CTL
| CHAR_META
);
54 int flags
= XINT (obj
) & flagbits
;
55 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
57 /* If the character has higher bits set
58 above the flags, return it unchanged.
59 It is not a real character. */
60 if ((unsigned) XFASTINT (obj
) > (unsigned) flagbits
)
63 c1
= XFASTINT (obj
) & ~flagbits
;
65 MAKE_CHAR_MULTIBYTE (c1
);
68 XSETFASTINT (obj
, c
| flags
);
69 else if (c
== (XFASTINT (obj
) & ~flagbits
))
74 MAKE_CHAR_UNIBYTE (c
);
75 XSETFASTINT (obj
, c
| flags
);
82 int multibyte
= STRING_MULTIBYTE (obj
);
84 int size
= SCHARS (obj
);
86 obj
= Fcopy_sequence (obj
);
87 for (i
= i_byte
= 0; i
< size
; i
++, i_byte
+= len
)
90 c
= STRING_CHAR_AND_LENGTH (SDATA (obj
) + i_byte
, 0, len
);
93 c
= SREF (obj
, i_byte
);
95 MAKE_CHAR_MULTIBYTE (c
);
98 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
100 else if (!UPPERCASEP (c
)
101 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
103 if ((int) flag
>= (int) CASE_CAPITALIZE
)
104 inword
= (SYNTAX (c
) == Sword
);
109 MAKE_CHAR_UNIBYTE (c
);
110 SSET (obj
, i_byte
, c
);
112 else if (ASCII_CHAR_P (c1
) && ASCII_CHAR_P (c
))
113 SSET (obj
, i_byte
, c
);
116 Faset (obj
, make_number (i
), make_number (c
));
117 i_byte
+= CHAR_BYTES (c
) - len
;
123 obj
= wrong_type_argument (Qchar_or_string_p
, obj
);
127 DEFUN ("upcase", Fupcase
, Supcase
, 1, 1, 0,
128 doc
: /* Convert argument to upper case and return that.
129 The argument may be a character or string. The result has the same type.
130 The argument object is not altered--the value is a copy.
131 See also `capitalize', `downcase' and `upcase-initials'. */)
135 return casify_object (CASE_UP
, obj
);
138 DEFUN ("downcase", Fdowncase
, Sdowncase
, 1, 1, 0,
139 doc
: /* Convert argument to lower case and return that.
140 The argument may be a character or string. The result has the same type.
141 The argument object is not altered--the value is a copy. */)
145 return casify_object (CASE_DOWN
, obj
);
148 DEFUN ("capitalize", Fcapitalize
, Scapitalize
, 1, 1, 0,
149 doc
: /* Convert argument to capitalized form and return that.
150 This means that each word's first character is upper case
151 and the rest is lower case.
152 The argument may be a character or string. The result has the same type.
153 The argument object is not altered--the value is a copy. */)
157 return casify_object (CASE_CAPITALIZE
, obj
);
160 /* Like Fcapitalize but change only the initials. */
162 DEFUN ("upcase-initials", Fupcase_initials
, Supcase_initials
, 1, 1, 0,
163 doc
: /* Convert the initial of each word in the argument to upper case.
164 Do not change the other letters of each word.
165 The argument may be a character or string. The result has the same type.
166 The argument object is not altered--the value is a copy. */)
170 return casify_object (CASE_CAPITALIZE_UP
, obj
);
173 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
174 b and e specify range of buffer to operate on. */
177 casify_region (flag
, b
, e
)
178 enum case_action flag
;
182 register int inword
= flag
== CASE_DOWN
;
183 register int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
185 int start_byte
, end_byte
;
188 int opoint_byte
= PT_BYTE
;
191 /* Not modifying because nothing marked */
194 /* If the case table is flagged as modified, rescan it. */
195 if (NILP (XCHAR_TABLE (current_buffer
->downcase_table
)->extras
[1]))
196 Fset_case_table (current_buffer
->downcase_table
);
198 validate_region (&b
, &e
);
199 start
= XFASTINT (b
);
201 modify_region (current_buffer
, start
, end
);
202 record_change (start
, end
- start
);
203 start_byte
= CHAR_TO_BYTE (start
);
204 end_byte
= CHAR_TO_BYTE (end
);
212 c
= FETCH_MULTIBYTE_CHAR (start_byte
);
213 len
= CHAR_BYTES (c
);
217 c
= FETCH_BYTE (start_byte
);
218 MAKE_CHAR_MULTIBYTE (c
);
222 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
224 else if (!UPPERCASEP (c
)
225 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
227 if ((int) flag
>= (int) CASE_CAPITALIZE
)
228 inword
= ((SYNTAX (c
) == Sword
) && (inword
|| !SYNTAX_PREFIX (c
)));
234 MAKE_CHAR_UNIBYTE (c
);
235 FETCH_BYTE (start_byte
) = c
;
237 else if (ASCII_CHAR_P (c2
) && ASCII_CHAR_P (c
))
238 FETCH_BYTE (start_byte
) = c
;
239 else if (len
== CHAR_BYTES (c
))
242 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
244 CHAR_STRING (c
, str
);
245 for (j
= 0; j
< len
; ++j
)
246 FETCH_BYTE (start_byte
+ j
) = str
[j
];
250 TEMP_SET_PT_BOTH (start
, start_byte
);
251 del_range_2 (start
, start_byte
, start
+ 1, start_byte
+ len
, 0);
253 len
= CHAR_BYTES (c
);
261 TEMP_SET_PT_BOTH (opoint
, opoint_byte
);
265 start
= XFASTINT (b
);
266 signal_after_change (start
, end
- start
, end
- start
);
267 update_compositions (start
, end
, CHECK_ALL
);
271 DEFUN ("upcase-region", Fupcase_region
, Supcase_region
, 2, 2, "r",
272 doc
: /* Convert the region to upper case. In programs, wants two arguments.
273 These arguments specify the starting and ending character numbers of
274 the region to operate on. When used as a command, the text between
275 point and the mark is operated on.
276 See also `capitalize-region'. */)
278 Lisp_Object beg
, end
;
280 casify_region (CASE_UP
, beg
, end
);
284 DEFUN ("downcase-region", Fdowncase_region
, Sdowncase_region
, 2, 2, "r",
285 doc
: /* Convert the region to lower case. In programs, wants two arguments.
286 These arguments specify the starting and ending character numbers of
287 the region to operate on. When used as a command, the text between
288 point and the mark is operated on. */)
290 Lisp_Object beg
, end
;
292 casify_region (CASE_DOWN
, beg
, end
);
296 DEFUN ("capitalize-region", Fcapitalize_region
, Scapitalize_region
, 2, 2, "r",
297 doc
: /* Convert the region to capitalized form.
298 Capitalized form means each word's first character is upper case
299 and the rest of it is lower case.
300 In programs, give two arguments, the starting and ending
301 character positions to operate on. */)
303 Lisp_Object beg
, end
;
305 casify_region (CASE_CAPITALIZE
, beg
, end
);
309 /* Like Fcapitalize_region but change only the initials. */
311 DEFUN ("upcase-initials-region", Fupcase_initials_region
,
312 Supcase_initials_region
, 2, 2, "r",
313 doc
: /* Upcase the initial of each word in the region.
314 Subsequent letters of each word are not changed.
315 In programs, give two arguments, the starting and ending
316 character positions to operate on. */)
318 Lisp_Object beg
, end
;
320 casify_region (CASE_CAPITALIZE_UP
, beg
, end
);
325 operate_on_word (arg
, newpoint
)
335 farend
= scan_words (PT
, iarg
);
337 farend
= iarg
> 0 ? ZV
: BEGV
;
339 *newpoint
= PT
> farend
? PT
: farend
;
340 XSETFASTINT (val
, farend
);
345 DEFUN ("upcase-word", Fupcase_word
, Supcase_word
, 1, 1, "p",
346 doc
: /* Convert following word (or ARG words) to upper case, moving over.
347 With negative argument, convert previous words but do not move.
348 See also `capitalize-word'. */)
352 Lisp_Object beg
, end
;
354 XSETFASTINT (beg
, PT
);
355 end
= operate_on_word (arg
, &newpoint
);
356 casify_region (CASE_UP
, beg
, end
);
361 DEFUN ("downcase-word", Fdowncase_word
, Sdowncase_word
, 1, 1, "p",
362 doc
: /* Convert following word (or ARG words) to lower case, moving over.
363 With negative argument, convert previous words but do not move. */)
367 Lisp_Object beg
, end
;
369 XSETFASTINT (beg
, PT
);
370 end
= operate_on_word (arg
, &newpoint
);
371 casify_region (CASE_DOWN
, beg
, end
);
376 DEFUN ("capitalize-word", Fcapitalize_word
, Scapitalize_word
, 1, 1, "p",
377 doc
: /* Capitalize the following word (or ARG words), moving over.
378 This gives the word(s) a first character in upper case
379 and the rest lower case.
380 With negative argument, capitalize previous words but do not move. */)
384 Lisp_Object beg
, end
;
386 XSETFASTINT (beg
, PT
);
387 end
= operate_on_word (arg
, &newpoint
);
388 casify_region (CASE_CAPITALIZE
, beg
, end
);
394 syms_of_casefiddle ()
396 Qidentity
= intern ("identity");
397 staticpro (&Qidentity
);
399 defsubr (&Sdowncase
);
400 defsubr (&Scapitalize
);
401 defsubr (&Supcase_initials
);
402 defsubr (&Supcase_region
);
403 defsubr (&Sdowncase_region
);
404 defsubr (&Scapitalize_region
);
405 defsubr (&Supcase_initials_region
);
406 defsubr (&Supcase_word
);
407 defsubr (&Sdowncase_word
);
408 defsubr (&Scapitalize_word
);
412 keys_of_casefiddle ()
414 initial_define_key (control_x_map
, Ctl('U'), "upcase-region");
415 Fput (intern ("upcase-region"), Qdisabled
, Qt
);
416 initial_define_key (control_x_map
, Ctl('L'), "downcase-region");
417 Fput (intern ("downcase-region"), Qdisabled
, Qt
);
419 initial_define_key (meta_map
, 'u', "upcase-word");
420 initial_define_key (meta_map
, 'l', "downcase-word");
421 initial_define_key (meta_map
, 'c', "capitalize-word");
424 /* arch-tag: 60a73c66-5489-47e7-a81f-cead4057c526
425 (do not change this comment) */