1 /* GNU Emacs case conversion functions.
2 Copyright (C) 1985, 1994, 1997-1999, 2001-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include "character.h"
27 #include "composite.h"
30 enum case_action
{CASE_UP
, CASE_DOWN
, CASE_CAPITALIZE
, CASE_CAPITALIZE_UP
};
32 Lisp_Object Qidentity
;
35 casify_object (enum case_action flag
, Lisp_Object obj
)
38 register int inword
= flag
== CASE_DOWN
;
40 /* If the case table is flagged as modified, rescan it. */
41 if (NILP (XCHAR_TABLE (current_buffer
->downcase_table
)->extras
[1]))
42 Fset_case_table (current_buffer
->downcase_table
);
46 int flagbits
= (CHAR_ALT
| CHAR_SUPER
| CHAR_HYPER
47 | CHAR_SHIFT
| CHAR_CTL
| CHAR_META
);
48 int flags
= XINT (obj
) & flagbits
;
49 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
51 /* If the character has higher bits set
52 above the flags, return it unchanged.
53 It is not a real character. */
54 if ((unsigned) XFASTINT (obj
) > (unsigned) flagbits
)
57 c1
= XFASTINT (obj
) & ~flagbits
;
58 /* FIXME: Even if enable-multibyte-characters is nil, we may
59 manipulate multibyte chars. This means we have a bug for latin-1
60 chars since when we receive an int 128-255 we can't tell whether
61 it's an eight-bit byte or a latin-1 char. */
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
);
81 wrong_type_argument (Qchar_or_string_p
, obj
);
82 else if (!STRING_MULTIBYTE (obj
))
85 EMACS_INT size
= SCHARS (obj
);
87 obj
= Fcopy_sequence (obj
);
88 for (i
= 0; i
< size
; i
++)
91 MAKE_CHAR_MULTIBYTE (c
);
93 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
95 else if (!UPPERCASEP (c
)
96 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
98 if ((int) flag
>= (int) CASE_CAPITALIZE
)
99 inword
= (SYNTAX (c
) == Sword
);
102 MAKE_CHAR_UNIBYTE (c
);
103 /* If the char can't be converted to a valid byte, just don't
105 if (c
>= 0 && c
< 256)
113 EMACS_INT i
, i_byte
, size
= SCHARS (obj
);
116 unsigned char *dst
, *o
;
117 /* Over-allocate by 12%: this is a minor overhead, but should be
118 sufficient in 99.999% of the cases to avoid a reallocation. */
119 EMACS_INT o_size
= SBYTES (obj
) + SBYTES (obj
) / 8 + MAX_MULTIBYTE_LENGTH
;
120 SAFE_ALLOCA (dst
, void *, o_size
);
123 for (i
= i_byte
= 0; i
< size
; i
++, i_byte
+= len
)
125 if ((o
- dst
) + MAX_MULTIBYTE_LENGTH
> o_size
)
126 { /* Not enough space for the next char: grow the destination. */
127 unsigned char *old_dst
= dst
;
128 o_size
+= o_size
; /* Probably overkill, but extremely rare. */
129 SAFE_ALLOCA (dst
, void *, o_size
);
130 memcpy (dst
, old_dst
, o
- old_dst
);
131 o
= dst
+ (o
- old_dst
);
133 c
= STRING_CHAR_AND_LENGTH (SDATA (obj
) + i_byte
, len
);
134 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
136 else if (!UPPERCASEP (c
)
137 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
139 if ((int) flag
>= (int) CASE_CAPITALIZE
)
140 inword
= (SYNTAX (c
) == Sword
);
141 o
+= CHAR_STRING (c
, o
);
143 eassert (o
- dst
<= o_size
);
144 obj
= make_multibyte_string (dst
, size
, o
- dst
);
150 DEFUN ("upcase", Fupcase
, Supcase
, 1, 1, 0,
151 doc
: /* Convert argument to upper case and return that.
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.
154 See also `capitalize', `downcase' and `upcase-initials'. */)
157 return casify_object (CASE_UP
, obj
);
160 DEFUN ("downcase", Fdowncase
, Sdowncase
, 1, 1, 0,
161 doc
: /* Convert argument to lower case and return that.
162 The argument may be a character or string. The result has the same type.
163 The argument object is not altered--the value is a copy. */)
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. */)
177 return casify_object (CASE_CAPITALIZE
, obj
);
180 /* Like Fcapitalize but change only the initials. */
182 DEFUN ("upcase-initials", Fupcase_initials
, Supcase_initials
, 1, 1, 0,
183 doc
: /* Convert the initial of each word in the argument to upper case.
184 Do not change the other letters of each word.
185 The argument may be a character or string. The result has the same type.
186 The argument object is not altered--the value is a copy. */)
189 return casify_object (CASE_CAPITALIZE_UP
, obj
);
192 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
193 b and e specify range of buffer to operate on. */
196 casify_region (enum case_action flag
, Lisp_Object b
, Lisp_Object e
)
199 register int inword
= flag
== CASE_DOWN
;
200 register int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
201 EMACS_INT start
, end
;
202 EMACS_INT start_byte
, end_byte
;
203 EMACS_INT first
= -1, last
; /* Position of first and last changes. */
204 EMACS_INT opoint
= PT
;
205 EMACS_INT opoint_byte
= PT_BYTE
;
208 /* Not modifying because nothing marked */
211 /* If the case table is flagged as modified, rescan it. */
212 if (NILP (XCHAR_TABLE (current_buffer
->downcase_table
)->extras
[1]))
213 Fset_case_table (current_buffer
->downcase_table
);
215 validate_region (&b
, &e
);
216 start
= XFASTINT (b
);
218 modify_region (current_buffer
, start
, end
, 0);
219 record_change (start
, end
- start
);
220 start_byte
= CHAR_TO_BYTE (start
);
221 end_byte
= CHAR_TO_BYTE (end
);
223 SETUP_BUFFER_SYNTAX_TABLE(); /* For syntax_prefix_flag_p. */
231 c
= FETCH_MULTIBYTE_CHAR (start_byte
);
232 len
= CHAR_BYTES (c
);
236 c
= FETCH_BYTE (start_byte
);
237 MAKE_CHAR_MULTIBYTE (c
);
241 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
243 else if (!UPPERCASEP (c
)
244 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
246 if ((int) flag
>= (int) CASE_CAPITALIZE
)
247 inword
= ((SYNTAX (c
) == Sword
)
248 && (inword
|| !syntax_prefix_flag_p (c
)));
257 MAKE_CHAR_UNIBYTE (c
);
258 FETCH_BYTE (start_byte
) = c
;
260 else if (ASCII_CHAR_P (c2
) && ASCII_CHAR_P (c
))
261 FETCH_BYTE (start_byte
) = c
;
264 int tolen
= CHAR_BYTES (c
);
266 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
268 CHAR_STRING (c
, str
);
271 /* Length is unchanged. */
272 for (j
= 0; j
< len
; ++j
)
273 FETCH_BYTE (start_byte
+ j
) = str
[j
];
277 /* Replace one character with the other,
278 keeping text properties the same. */
279 replace_range_2 (start
, start_byte
,
280 start
+ 1, start_byte
+ len
,
292 TEMP_SET_PT_BOTH (opoint
, opoint_byte
);
296 signal_after_change (first
, last
+ 1 - first
, last
+ 1 - first
);
297 update_compositions (first
, last
+ 1, CHECK_ALL
);
301 DEFUN ("upcase-region", Fupcase_region
, Supcase_region
, 2, 2, "r",
302 doc
: /* Convert the region to upper case. In programs, wants two arguments.
303 These arguments specify the starting and ending character numbers of
304 the region to operate on. When used as a command, the text between
305 point and the mark is operated on.
306 See also `capitalize-region'. */)
307 (Lisp_Object beg
, Lisp_Object end
)
309 casify_region (CASE_UP
, beg
, end
);
313 DEFUN ("downcase-region", Fdowncase_region
, Sdowncase_region
, 2, 2, "r",
314 doc
: /* Convert the region to lower case. In programs, wants two arguments.
315 These arguments specify the starting and ending character numbers of
316 the region to operate on. When used as a command, the text between
317 point and the mark is operated on. */)
318 (Lisp_Object beg
, Lisp_Object end
)
320 casify_region (CASE_DOWN
, beg
, end
);
324 DEFUN ("capitalize-region", Fcapitalize_region
, Scapitalize_region
, 2, 2, "r",
325 doc
: /* Convert the region to capitalized form.
326 Capitalized form means each word's first character is upper case
327 and the rest of it is lower case.
328 In programs, give two arguments, the starting and ending
329 character positions to operate on. */)
330 (Lisp_Object beg
, Lisp_Object end
)
332 casify_region (CASE_CAPITALIZE
, beg
, end
);
336 /* Like Fcapitalize_region but change only the initials. */
338 DEFUN ("upcase-initials-region", Fupcase_initials_region
,
339 Supcase_initials_region
, 2, 2, "r",
340 doc
: /* Upcase the initial of each word in the region.
341 Subsequent letters of each word are not changed.
342 In programs, give two arguments, the starting and ending
343 character positions to operate on. */)
344 (Lisp_Object beg
, Lisp_Object end
)
346 casify_region (CASE_CAPITALIZE_UP
, beg
, end
);
351 operate_on_word (Lisp_Object arg
, EMACS_INT
*newpoint
)
359 farend
= scan_words (PT
, iarg
);
361 farend
= iarg
> 0 ? ZV
: BEGV
;
363 *newpoint
= PT
> farend
? PT
: farend
;
364 XSETFASTINT (val
, farend
);
369 DEFUN ("upcase-word", Fupcase_word
, Supcase_word
, 1, 1, "p",
370 doc
: /* Convert following word (or ARG words) to upper case, moving over.
371 With negative argument, convert previous words but do not move.
372 See also `capitalize-word'. */)
375 Lisp_Object beg
, end
;
377 XSETFASTINT (beg
, PT
);
378 end
= operate_on_word (arg
, &newpoint
);
379 casify_region (CASE_UP
, beg
, end
);
384 DEFUN ("downcase-word", Fdowncase_word
, Sdowncase_word
, 1, 1, "p",
385 doc
: /* Convert following word (or ARG words) to lower case, moving over.
386 With negative argument, convert previous words but do not move. */)
389 Lisp_Object beg
, end
;
391 XSETFASTINT (beg
, PT
);
392 end
= operate_on_word (arg
, &newpoint
);
393 casify_region (CASE_DOWN
, beg
, end
);
398 DEFUN ("capitalize-word", Fcapitalize_word
, Scapitalize_word
, 1, 1, "p",
399 doc
: /* Capitalize the following word (or ARG words), moving over.
400 This gives the word(s) a first character in upper case
401 and the rest lower case.
402 With negative argument, capitalize previous words but do not move. */)
405 Lisp_Object beg
, end
;
407 XSETFASTINT (beg
, PT
);
408 end
= operate_on_word (arg
, &newpoint
);
409 casify_region (CASE_CAPITALIZE
, beg
, end
);
415 syms_of_casefiddle (void)
417 Qidentity
= intern_c_string ("identity");
418 staticpro (&Qidentity
);
420 defsubr (&Sdowncase
);
421 defsubr (&Scapitalize
);
422 defsubr (&Supcase_initials
);
423 defsubr (&Supcase_region
);
424 defsubr (&Sdowncase_region
);
425 defsubr (&Scapitalize_region
);
426 defsubr (&Supcase_initials_region
);
427 defsubr (&Supcase_word
);
428 defsubr (&Sdowncase_word
);
429 defsubr (&Scapitalize_word
);
433 keys_of_casefiddle (void)
435 initial_define_key (control_x_map
, Ctl('U'), "upcase-region");
436 Fput (intern ("upcase-region"), Qdisabled
, Qt
);
437 initial_define_key (control_x_map
, Ctl('L'), "downcase-region");
438 Fput (intern ("downcase-region"), Qdisabled
, Qt
);
440 initial_define_key (meta_map
, 'u', "upcase-word");
441 initial_define_key (meta_map
, 'l', "downcase-word");
442 initial_define_key (meta_map
, 'c', "capitalize-word");