1 /* GNU Emacs case conversion functions.
3 Copyright (C) 1985, 1994, 1997-1999, 2001-2012 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 3 of the License, or
10 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
24 #include "character.h"
28 #include "composite.h"
31 enum case_action
{CASE_UP
, CASE_DOWN
, CASE_CAPITALIZE
, CASE_CAPITALIZE_UP
};
33 Lisp_Object Qidentity
;
36 casify_object (enum case_action flag
, Lisp_Object obj
)
39 register int inword
= flag
== CASE_DOWN
;
41 /* If the case table is flagged as modified, rescan it. */
42 if (NILP (XCHAR_TABLE (BVAR (current_buffer
, downcase_table
))->extras
[1]))
43 Fset_case_table (BVAR (current_buffer
, downcase_table
));
47 int flagbits
= (CHAR_ALT
| CHAR_SUPER
| CHAR_HYPER
48 | CHAR_SHIFT
| CHAR_CTL
| CHAR_META
);
49 int flags
= XINT (obj
) & flagbits
;
50 int multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
52 /* If the character has higher bits set
53 above the flags, return it unchanged.
54 It is not a real character. */
55 if (UNSIGNED_CMP (XFASTINT (obj
), >, flagbits
))
58 c1
= XFASTINT (obj
) & ~flagbits
;
59 /* FIXME: Even if enable-multibyte-characters is nil, we may
60 manipulate multibyte chars. This means we have a bug for latin-1
61 chars since when we receive an int 128-255 we can't tell whether
62 it's an eight-bit byte or a latin-1 char. */
66 MAKE_CHAR_MULTIBYTE (c1
);
69 XSETFASTINT (obj
, c
| flags
);
70 else if (c
== (XFASTINT (obj
) & ~flagbits
))
75 MAKE_CHAR_UNIBYTE (c
);
76 XSETFASTINT (obj
, c
| flags
);
82 wrong_type_argument (Qchar_or_string_p
, obj
);
83 else if (!STRING_MULTIBYTE (obj
))
86 ptrdiff_t size
= SCHARS (obj
);
88 obj
= Fcopy_sequence (obj
);
89 for (i
= 0; i
< size
; i
++)
92 MAKE_CHAR_MULTIBYTE (c
);
94 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
96 else if (!uppercasep (c
)
97 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
99 if ((int) flag
>= (int) CASE_CAPITALIZE
)
100 inword
= (SYNTAX (c
) == Sword
);
103 MAKE_CHAR_UNIBYTE (c
);
104 /* If the char can't be converted to a valid byte, just don't
106 if (c
>= 0 && c
< 256)
114 ptrdiff_t i
, i_byte
, size
= SCHARS (obj
);
117 ptrdiff_t o_size
= (size
< STRING_BYTES_BOUND
/ MAX_MULTIBYTE_LENGTH
118 ? size
* MAX_MULTIBYTE_LENGTH
119 : STRING_BYTES_BOUND
);
120 unsigned char *dst
= SAFE_ALLOCA (o_size
);
121 unsigned char *o
= dst
;
123 for (i
= i_byte
= 0; i
< size
; i
++, i_byte
+= len
)
125 if (o_size
- (o
- dst
) < MAX_MULTIBYTE_LENGTH
)
127 c
= STRING_CHAR_AND_LENGTH (SDATA (obj
) + i_byte
, len
);
128 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
130 else if (!uppercasep (c
)
131 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
133 if ((int) flag
>= (int) CASE_CAPITALIZE
)
134 inword
= (SYNTAX (c
) == Sword
);
135 o
+= CHAR_STRING (c
, o
);
137 eassert (o
- dst
<= o_size
);
138 obj
= make_multibyte_string ((char *) dst
, size
, o
- dst
);
144 DEFUN ("upcase", Fupcase
, Supcase
, 1, 1, 0,
145 doc
: /* Convert argument to upper case and return that.
146 The argument may be a character or string. The result has the same type.
147 The argument object is not altered--the value is a copy.
148 See also `capitalize', `downcase' and `upcase-initials'. */)
151 return casify_object (CASE_UP
, obj
);
154 DEFUN ("downcase", Fdowncase
, Sdowncase
, 1, 1, 0,
155 doc
: /* Convert argument to lower case and return that.
156 The argument may be a character or string. The result has the same type.
157 The argument object is not altered--the value is a copy. */)
160 return casify_object (CASE_DOWN
, obj
);
163 DEFUN ("capitalize", Fcapitalize
, Scapitalize
, 1, 1, 0,
164 doc
: /* Convert argument to capitalized form and return that.
165 This means that each word's first character is upper case
166 and the rest is lower case.
167 The argument may be a character or string. The result has the same type.
168 The argument object is not altered--the value is a copy. */)
171 return casify_object (CASE_CAPITALIZE
, obj
);
174 /* Like Fcapitalize but change only the initials. */
176 DEFUN ("upcase-initials", Fupcase_initials
, Supcase_initials
, 1, 1, 0,
177 doc
: /* Convert the initial of each word in the argument to upper case.
178 Do not change the other letters of each word.
179 The argument may be a character or string. The result has the same type.
180 The argument object is not altered--the value is a copy. */)
183 return casify_object (CASE_CAPITALIZE_UP
, obj
);
186 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
187 b and e specify range of buffer to operate on. */
190 casify_region (enum case_action flag
, Lisp_Object b
, Lisp_Object e
)
193 register int inword
= flag
== CASE_DOWN
;
194 register int multibyte
= !NILP (BVAR (current_buffer
, enable_multibyte_characters
));
195 ptrdiff_t start
, end
;
196 ptrdiff_t start_byte
;
198 /* Position of first and last changes. */
199 ptrdiff_t first
= -1, last
IF_LINT (= 0);
201 ptrdiff_t opoint
= PT
;
202 ptrdiff_t opoint_byte
= PT_BYTE
;
205 /* Not modifying because nothing marked */
208 /* If the case table is flagged as modified, rescan it. */
209 if (NILP (XCHAR_TABLE (BVAR (current_buffer
, downcase_table
))->extras
[1]))
210 Fset_case_table (BVAR (current_buffer
, downcase_table
));
212 validate_region (&b
, &e
);
213 start
= XFASTINT (b
);
215 modify_region (current_buffer
, start
, end
, 0);
216 record_change (start
, end
- start
);
217 start_byte
= CHAR_TO_BYTE (start
);
219 SETUP_BUFFER_SYNTAX_TABLE (); /* For syntax_prefix_flag_p. */
227 c
= FETCH_MULTIBYTE_CHAR (start_byte
);
228 len
= CHAR_BYTES (c
);
232 c
= FETCH_BYTE (start_byte
);
233 MAKE_CHAR_MULTIBYTE (c
);
237 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
239 else if (!uppercasep (c
)
240 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
242 if ((int) flag
>= (int) CASE_CAPITALIZE
)
243 inword
= ((SYNTAX (c
) == Sword
)
244 && (inword
|| !syntax_prefix_flag_p (c
)));
253 MAKE_CHAR_UNIBYTE (c
);
254 FETCH_BYTE (start_byte
) = c
;
256 else if (ASCII_CHAR_P (c2
) && ASCII_CHAR_P (c
))
257 FETCH_BYTE (start_byte
) = c
;
260 int tolen
= CHAR_BYTES (c
);
262 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
264 CHAR_STRING (c
, str
);
267 /* Length is unchanged. */
268 for (j
= 0; j
< len
; ++j
)
269 FETCH_BYTE (start_byte
+ j
) = str
[j
];
273 /* Replace one character with the other,
274 keeping text properties the same. */
275 replace_range_2 (start
, start_byte
,
276 start
+ 1, start_byte
+ len
,
277 (char *) str
, 1, tolen
,
288 TEMP_SET_PT_BOTH (opoint
, opoint_byte
);
292 signal_after_change (first
, last
+ 1 - first
, last
+ 1 - first
);
293 update_compositions (first
, last
+ 1, CHECK_ALL
);
297 DEFUN ("upcase-region", Fupcase_region
, Supcase_region
, 2, 2, "r",
298 doc
: /* Convert the region to upper case. In programs, wants two arguments.
299 These arguments specify the starting and ending character numbers of
300 the region to operate on. When used as a command, the text between
301 point and the mark is operated on.
302 See also `capitalize-region'. */)
303 (Lisp_Object beg
, Lisp_Object end
)
305 casify_region (CASE_UP
, beg
, end
);
309 DEFUN ("downcase-region", Fdowncase_region
, Sdowncase_region
, 2, 2, "r",
310 doc
: /* Convert the region to lower case. In programs, wants two arguments.
311 These arguments specify the starting and ending character numbers of
312 the region to operate on. When used as a command, the text between
313 point and the mark is operated on. */)
314 (Lisp_Object beg
, Lisp_Object end
)
316 casify_region (CASE_DOWN
, beg
, end
);
320 DEFUN ("capitalize-region", Fcapitalize_region
, Scapitalize_region
, 2, 2, "r",
321 doc
: /* Convert the region to capitalized form.
322 Capitalized form means each word's first character is upper case
323 and the rest of it is lower case.
324 In programs, give two arguments, the starting and ending
325 character positions to operate on. */)
326 (Lisp_Object beg
, Lisp_Object end
)
328 casify_region (CASE_CAPITALIZE
, beg
, end
);
332 /* Like Fcapitalize_region but change only the initials. */
334 DEFUN ("upcase-initials-region", Fupcase_initials_region
,
335 Supcase_initials_region
, 2, 2, "r",
336 doc
: /* Upcase the initial of each word in the region.
337 Subsequent letters of each word are not changed.
338 In programs, give two arguments, the starting and ending
339 character positions to operate on. */)
340 (Lisp_Object beg
, Lisp_Object end
)
342 casify_region (CASE_CAPITALIZE_UP
, beg
, end
);
347 operate_on_word (Lisp_Object arg
, ptrdiff_t *newpoint
)
355 farend
= scan_words (PT
, iarg
);
357 farend
= iarg
> 0 ? ZV
: BEGV
;
359 *newpoint
= PT
> farend
? PT
: farend
;
360 XSETFASTINT (val
, farend
);
365 DEFUN ("upcase-word", Fupcase_word
, Supcase_word
, 1, 1, "p",
366 doc
: /* Convert following word (or ARG words) to upper case, moving over.
367 With negative argument, convert previous words but do not move.
368 See also `capitalize-word'. */)
371 Lisp_Object beg
, end
;
373 XSETFASTINT (beg
, PT
);
374 end
= operate_on_word (arg
, &newpoint
);
375 casify_region (CASE_UP
, beg
, end
);
380 DEFUN ("downcase-word", Fdowncase_word
, Sdowncase_word
, 1, 1, "p",
381 doc
: /* Convert following word (or ARG words) to lower case, moving over.
382 With negative argument, convert previous words but do not move. */)
385 Lisp_Object beg
, end
;
387 XSETFASTINT (beg
, PT
);
388 end
= operate_on_word (arg
, &newpoint
);
389 casify_region (CASE_DOWN
, beg
, end
);
394 DEFUN ("capitalize-word", Fcapitalize_word
, Scapitalize_word
, 1, 1, "p",
395 doc
: /* Capitalize the following word (or ARG words), moving over.
396 This gives the word(s) a first character in upper case
397 and the rest lower case.
398 With negative argument, capitalize previous words but do not move. */)
401 Lisp_Object beg
, end
;
403 XSETFASTINT (beg
, PT
);
404 end
= operate_on_word (arg
, &newpoint
);
405 casify_region (CASE_CAPITALIZE
, beg
, end
);
411 syms_of_casefiddle (void)
413 DEFSYM (Qidentity
, "identity");
415 defsubr (&Sdowncase
);
416 defsubr (&Scapitalize
);
417 defsubr (&Supcase_initials
);
418 defsubr (&Supcase_region
);
419 defsubr (&Sdowncase_region
);
420 defsubr (&Scapitalize_region
);
421 defsubr (&Supcase_initials_region
);
422 defsubr (&Supcase_word
);
423 defsubr (&Sdowncase_word
);
424 defsubr (&Scapitalize_word
);
428 keys_of_casefiddle (void)
430 initial_define_key (control_x_map
, Ctl ('U'), "upcase-region");
431 Fput (intern ("upcase-region"), Qdisabled
, Qt
);
432 initial_define_key (control_x_map
, Ctl ('L'), "downcase-region");
433 Fput (intern ("downcase-region"), Qdisabled
, Qt
);
435 initial_define_key (meta_map
, 'u', "upcase-word");
436 initial_define_key (meta_map
, 'l', "downcase-word");
437 initial_define_key (meta_map
, 'c', "capitalize-word");