1 /* GNU Emacs case conversion functions.
3 Copyright (C) 1985, 1994, 1997-1999, 2001-2016 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include "character.h"
29 #include "composite.h"
32 enum case_action
{CASE_UP
, CASE_DOWN
, CASE_CAPITALIZE
, CASE_CAPITALIZE_UP
};
35 casify_object (enum case_action flag
, Lisp_Object obj
)
38 bool inword
= flag
== CASE_DOWN
;
40 /* If the case table is flagged as modified, rescan it. */
41 if (NILP (XCHAR_TABLE (BVAR (current_buffer
, downcase_table
))->extras
[1]))
42 Fset_case_table (BVAR (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 bool multibyte
= ! NILP (BVAR (current_buffer
,
50 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
);
118 if (INT_MULTIPLY_WRAPV (size
, MAX_MULTIBYTE_LENGTH
, &o_size
))
119 o_size
= PTRDIFF_MAX
;
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
- MAX_MULTIBYTE_LENGTH
< o
- dst
)
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 bool inword
= flag
== CASE_DOWN
;
194 bool 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
;
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_text (start
, end
);
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, 3,
298 "(list (region-beginning) (region-end) (region-noncontiguous-p))",
299 doc
: /* Convert the region to upper case. In programs, wants two arguments.
300 These arguments specify the starting and ending character numbers of
301 the region to operate on. When used as a command, the text between
302 point and the mark is operated on.
303 See also `capitalize-region'. */)
304 (Lisp_Object beg
, Lisp_Object end
, Lisp_Object region_noncontiguous_p
)
306 Lisp_Object bounds
= Qnil
;
308 if (!NILP (region_noncontiguous_p
))
310 bounds
= call1 (Fsymbol_value (intern ("region-extract-function")),
313 while (CONSP (bounds
))
315 casify_region (CASE_UP
, XCAR (XCAR (bounds
)), XCDR (XCAR (bounds
)));
316 bounds
= XCDR (bounds
);
320 casify_region (CASE_UP
, beg
, end
);
325 DEFUN ("downcase-region", Fdowncase_region
, Sdowncase_region
, 2, 3,
326 "(list (region-beginning) (region-end) (region-noncontiguous-p))",
327 doc
: /* Convert the region to lower case. In programs, wants two arguments.
328 These arguments specify the starting and ending character numbers of
329 the region to operate on. When used as a command, the text between
330 point and the mark is operated on. */)
331 (Lisp_Object beg
, Lisp_Object end
, Lisp_Object region_noncontiguous_p
)
333 Lisp_Object bounds
= Qnil
;
335 if (!NILP (region_noncontiguous_p
))
337 bounds
= call1 (Fsymbol_value (intern ("region-extract-function")),
340 while (CONSP (bounds
))
342 casify_region (CASE_DOWN
, XCAR (XCAR (bounds
)), XCDR (XCAR (bounds
)));
343 bounds
= XCDR (bounds
);
347 casify_region (CASE_DOWN
, beg
, end
);
352 DEFUN ("capitalize-region", Fcapitalize_region
, Scapitalize_region
, 2, 2, "r",
353 doc
: /* Convert the region to capitalized form.
354 Capitalized form means each word's first character is upper case
355 and the rest of it is lower case.
356 In programs, give two arguments, the starting and ending
357 character positions to operate on. */)
358 (Lisp_Object beg
, Lisp_Object end
)
360 casify_region (CASE_CAPITALIZE
, beg
, end
);
364 /* Like Fcapitalize_region but change only the initials. */
366 DEFUN ("upcase-initials-region", Fupcase_initials_region
,
367 Supcase_initials_region
, 2, 2, "r",
368 doc
: /* Upcase the initial of each word in the region.
369 Subsequent letters of each word are not changed.
370 In programs, give two arguments, the starting and ending
371 character positions to operate on. */)
372 (Lisp_Object beg
, Lisp_Object end
)
374 casify_region (CASE_CAPITALIZE_UP
, beg
, end
);
379 casify_word (enum case_action flag
, Lisp_Object arg
)
381 Lisp_Object beg
, end
;
388 newpoint
= scan_words (PT
, iarg
);
390 newpoint
= iarg
> 0 ? ZV
: BEGV
;
392 XSETFASTINT (beg
, PT
);
393 XSETFASTINT (end
, newpoint
);
397 casify_region (flag
, beg
, end
);
403 DEFUN ("upcase-word", Fupcase_word
, Supcase_word
, 1, 1, "p",
404 doc
: /* Convert to upper case from point to end of word, moving over.
406 If point is in the middle of a word, the part of that word before point
407 is ignored when moving forward.
409 With negative argument, convert previous words but do not move.
410 See also `capitalize-word'. */)
413 return casify_word (CASE_UP
, arg
);
416 DEFUN ("downcase-word", Fdowncase_word
, Sdowncase_word
, 1, 1, "p",
417 doc
: /* Convert to lower case from point to end of word, moving over.
419 If point is in the middle of a word, the part of that word before point
420 is ignored when moving forward.
422 With negative argument, convert previous words but do not move. */)
425 return casify_word (CASE_DOWN
, arg
);
428 DEFUN ("capitalize-word", Fcapitalize_word
, Scapitalize_word
, 1, 1, "p",
429 doc
: /* Capitalize from point to the end of word, moving over.
430 With numerical argument ARG, capitalize the next ARG-1 words as well.
431 This gives the word(s) a first character in upper case
432 and the rest lower case.
434 If point is in the middle of a word, the part of that word before point
435 is ignored when moving forward.
437 With negative argument, capitalize previous words but do not move. */)
440 return casify_word (CASE_CAPITALIZE
, arg
);
444 syms_of_casefiddle (void)
446 DEFSYM (Qidentity
, "identity");
448 defsubr (&Sdowncase
);
449 defsubr (&Scapitalize
);
450 defsubr (&Supcase_initials
);
451 defsubr (&Supcase_region
);
452 defsubr (&Sdowncase_region
);
453 defsubr (&Scapitalize_region
);
454 defsubr (&Supcase_initials_region
);
455 defsubr (&Supcase_word
);
456 defsubr (&Sdowncase_word
);
457 defsubr (&Scapitalize_word
);
461 keys_of_casefiddle (void)
463 initial_define_key (control_x_map
, Ctl ('U'), "upcase-region");
464 Fput (intern ("upcase-region"), Qdisabled
, Qt
);
465 initial_define_key (control_x_map
, Ctl ('L'), "downcase-region");
466 Fput (intern ("downcase-region"), Qdisabled
, Qt
);
468 initial_define_key (meta_map
, 'u', "upcase-word");
469 initial_define_key (meta_map
, 'l', "downcase-word");
470 initial_define_key (meta_map
, 'c', "capitalize-word");