1 /* GNU Emacs case conversion functions.
2 Copyright (C) 1985, 1994, 1997 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 2, or (at your option)
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; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
29 enum case_action
{CASE_UP
, CASE_DOWN
, CASE_CAPITALIZE
, CASE_CAPITALIZE_UP
};
31 Lisp_Object Qidentity
;
34 casify_object (flag
, obj
)
35 enum case_action flag
;
38 register int i
, c
, len
;
39 register int inword
= flag
== CASE_DOWN
;
42 /* If the case table is flagged as modified, rescan it. */
43 if (NILP (XCHAR_TABLE (current_buffer
->downcase_table
)->extras
[1]))
44 Fset_case_table (current_buffer
->downcase_table
);
50 int flagbits
= (CHAR_ALT
| CHAR_SUPER
| CHAR_HYPER
51 | CHAR_SHIFT
| CHAR_CTL
| CHAR_META
);
52 int flags
= XINT (obj
) & flagbits
;
54 c
= DOWNCASE (XFASTINT (obj
) & ~flagbits
);
56 XSETFASTINT (obj
, c
| flags
);
57 else if (c
== (XFASTINT (obj
) & ~flagbits
))
59 c
= UPCASE1 ((XFASTINT (obj
) & ~flagbits
));
60 XSETFASTINT (obj
, c
| flags
);
67 int multibyte
= STRING_MULTIBYTE (obj
);
69 obj
= Fcopy_sequence (obj
);
70 len
= STRING_BYTES (XSTRING (obj
));
72 /* Scan all single-byte characters from start of string. */
75 c
= XSTRING (obj
)->data
[i
];
77 if (multibyte
&& c
>= 0x80)
78 /* A multibyte character can't be handled in this
81 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
83 else if (!UPPERCASEP (c
)
84 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
86 /* If this char won't fit in a single-byte string.
87 fall out to the multibyte case. */
88 if (multibyte
? ! ASCII_BYTE_P (c
)
89 : ! SINGLE_BYTE_CHAR_P (c
))
92 XSTRING (obj
)->data
[i
] = c
;
93 if ((int) flag
>= (int) CASE_CAPITALIZE
)
94 inword
= SYNTAX (c
) == Sword
;
98 /* If we didn't do the whole string as single-byte,
99 scan the rest in a more complex way. */
102 /* The work is not yet finished because of a multibyte
103 character just encountered. */
104 int fromlen
, tolen
, j_byte
= i
;
106 = (char *) alloca ((len
- i
) * MAX_LENGTH_OF_MULTI_BYTE_FORM
108 unsigned char *str
, workbuf
[4];
110 /* Copy data already handled. */
111 bcopy (XSTRING (obj
)->data
, buf
, i
);
113 /* From now on, I counts bytes. */
116 c
= STRING_CHAR_AND_LENGTH (XSTRING (obj
)->data
+ i
,
118 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
120 else if (!UPPERCASEP (c
)
121 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
123 tolen
= CHAR_STRING (c
, workbuf
, str
);
124 bcopy (str
, buf
+ j_byte
, tolen
);
127 if ((int) flag
>= (int) CASE_CAPITALIZE
)
128 inword
= SYNTAX (c
) == Sword
;
130 obj
= make_multibyte_string (buf
, XSTRING (obj
)->size
,
135 obj
= wrong_type_argument (Qchar_or_string_p
, obj
);
139 DEFUN ("upcase", Fupcase
, Supcase
, 1, 1, 0,
140 "Convert argument to upper case and return that.\n\
141 The argument may be a character or string. The result has the same type.\n\
142 The argument object is not altered--the value is a copy.\n\
143 See also `capitalize', `downcase' and `upcase-initials'.")
147 return casify_object (CASE_UP
, obj
);
150 DEFUN ("downcase", Fdowncase
, Sdowncase
, 1, 1, 0,
151 "Convert argument to lower case and return that.\n\
152 The argument may be a character or string. The result has the same type.\n\
153 The argument object is not altered--the value is a copy.")
157 return casify_object (CASE_DOWN
, obj
);
160 DEFUN ("capitalize", Fcapitalize
, Scapitalize
, 1, 1, 0,
161 "Convert argument to capitalized form and return that.\n\
162 This means that each word's first character is upper case\n\
163 and the rest is lower case.\n\
164 The argument may be a character or string. The result has the same type.\n\
165 The argument object is not altered--the value is a copy.")
169 return casify_object (CASE_CAPITALIZE
, obj
);
172 /* Like Fcapitalize but change only the initials. */
174 DEFUN ("upcase-initials", Fupcase_initials
, Supcase_initials
, 1, 1, 0,
175 "Convert the initial of each word in the argument to upper case.\n\
176 Do not change the other letters of each word.\n\
177 The argument may be a character or string. The result has the same type.\n\
178 The argument object is not altered--the value is a copy.")
182 return casify_object (CASE_CAPITALIZE_UP
, obj
);
185 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
186 b and e specify range of buffer to operate on. */
189 casify_region (flag
, b
, e
)
190 enum case_action flag
;
195 register int inword
= flag
== CASE_DOWN
;
196 register int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
198 int start_byte
, end_byte
;
199 Lisp_Object ch
, downch
, val
;
202 /* Not modifying because nothing marked */
205 /* If the case table is flagged as modified, rescan it. */
206 if (NILP (XCHAR_TABLE (current_buffer
->downcase_table
)->extras
[1]))
207 Fset_case_table (current_buffer
->downcase_table
);
209 validate_region (&b
, &e
);
210 start
= XFASTINT (b
);
212 modify_region (current_buffer
, start
, end
);
213 record_change (start
, end
- start
);
214 start_byte
= CHAR_TO_BYTE (start
);
215 end_byte
= CHAR_TO_BYTE (end
);
217 for (i
= start_byte
; i
< end_byte
; i
++)
220 if (multibyte
&& c
>= 0x80)
221 /* A multibyte character can't be handled in this simple loop. */
223 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
225 else if (!UPPERCASEP (c
)
226 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
229 if ((int) flag
>= (int) CASE_CAPITALIZE
)
230 inword
= SYNTAX (c
) == Sword
;
234 /* The work is not yet finished because of a multibyte character
237 int opoint_byte
= PT_BYTE
;
242 if ((c
= FETCH_BYTE (i
)) >= 0x80)
243 c
= FETCH_MULTIBYTE_CHAR (i
);
245 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
247 else if (!UPPERCASEP (c
)
248 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
252 int fromlen
, tolen
, j
;
253 unsigned char workbuf
[4], *str
;
255 /* Handle the most likely case */
256 if (c
< 0400 && c2
< 0400)
258 else if (fromlen
= CHAR_STRING (c
, workbuf
, str
),
259 tolen
= CHAR_STRING (c2
, workbuf
, str
),
262 for (j
= 0; j
< tolen
; ++j
)
263 FETCH_BYTE (i
+ j
) = str
[j
];
267 error ("Can't casify letters that change length");
268 #if 0 /* This is approximately what we'd like to be able to do here */
270 del_range_1 (i
+ tolen
, i
+ fromlen
, 0);
271 else if (tolen
> fromlen
)
273 TEMP_SET_PT (i
+ fromlen
);
274 insert_1 (str
+ fromlen
, tolen
- fromlen
, 1, 0, 0);
279 if ((int) flag
>= (int) CASE_CAPITALIZE
)
280 inword
= SYNTAX (c2
) == Sword
;
283 TEMP_SET_PT_BOTH (opoint
, opoint_byte
);
286 signal_after_change (start
, end
- start
, end
- start
);
289 DEFUN ("upcase-region", Fupcase_region
, Supcase_region
, 2, 2, "r",
290 "Convert the region to upper case. In programs, wants two arguments.\n\
291 These arguments specify the starting and ending character numbers of\n\
292 the region to operate on. When used as a command, the text between\n\
293 point and the mark is operated on.\n\
294 See also `capitalize-region'.")
296 Lisp_Object beg
, end
;
298 casify_region (CASE_UP
, beg
, end
);
302 DEFUN ("downcase-region", Fdowncase_region
, Sdowncase_region
, 2, 2, "r",
303 "Convert the region to lower case. In programs, wants two arguments.\n\
304 These arguments specify the starting and ending character numbers of\n\
305 the region to operate on. When used as a command, the text between\n\
306 point and the mark is operated on.")
308 Lisp_Object beg
, end
;
310 casify_region (CASE_DOWN
, beg
, end
);
314 DEFUN ("capitalize-region", Fcapitalize_region
, Scapitalize_region
, 2, 2, "r",
315 "Convert the region to capitalized form.\n\
316 Capitalized form means each word's first character is upper case\n\
317 and the rest of it is lower case.\n\
318 In programs, give two arguments, the starting and ending\n\
319 character positions to operate on.")
321 Lisp_Object beg
, end
;
323 casify_region (CASE_CAPITALIZE
, beg
, end
);
327 /* Like Fcapitalize_region but change only the initials. */
329 DEFUN ("upcase-initials-region", Fupcase_initials_region
,
330 Supcase_initials_region
, 2, 2, "r",
331 "Upcase the initial of each word in the region.\n\
332 Subsequent letters of each word are not changed.\n\
333 In programs, give two arguments, the starting and ending\n\
334 character positions to operate on.")
336 Lisp_Object beg
, end
;
338 casify_region (CASE_CAPITALIZE_UP
, beg
, end
);
343 operate_on_word (arg
, newpoint
)
351 CHECK_NUMBER (arg
, 0);
353 farend
= scan_words (PT
, iarg
);
355 farend
= iarg
> 0 ? ZV
: BEGV
;
357 *newpoint
= PT
> farend
? PT
: farend
;
358 XSETFASTINT (val
, farend
);
363 DEFUN ("upcase-word", Fupcase_word
, Supcase_word
, 1, 1, "p",
364 "Convert following word (or ARG words) to upper case, moving over.\n\
365 With negative argument, convert previous words but do not move.\n\
366 See also `capitalize-word'.")
370 Lisp_Object beg
, end
;
372 XSETFASTINT (beg
, PT
);
373 end
= operate_on_word (arg
, &newpoint
);
374 casify_region (CASE_UP
, beg
, end
);
379 DEFUN ("downcase-word", Fdowncase_word
, Sdowncase_word
, 1, 1, "p",
380 "Convert following word (or ARG words) to lower case, moving over.\n\
381 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 "Capitalize the following word (or ARG words), moving over.\n\
396 This gives the word(s) a first character in upper case\n\
397 and the rest lower case.\n\
398 With negative argument, capitalize previous words but do not move.")
402 Lisp_Object beg
, end
;
404 XSETFASTINT (beg
, PT
);
405 end
= operate_on_word (arg
, &newpoint
);
406 casify_region (CASE_CAPITALIZE
, beg
, end
);
412 syms_of_casefiddle ()
414 Qidentity
= intern ("identity");
415 staticpro (&Qidentity
);
417 defsubr (&Sdowncase
);
418 defsubr (&Scapitalize
);
419 defsubr (&Supcase_initials
);
420 defsubr (&Supcase_region
);
421 defsubr (&Sdowncase_region
);
422 defsubr (&Scapitalize_region
);
423 defsubr (&Supcase_initials_region
);
424 defsubr (&Supcase_word
);
425 defsubr (&Sdowncase_word
);
426 defsubr (&Scapitalize_word
);
430 keys_of_casefiddle ()
432 initial_define_key (control_x_map
, Ctl('U'), "upcase-region");
433 Fput (intern ("upcase-region"), Qdisabled
, Qt
);
434 initial_define_key (control_x_map
, Ctl('L'), "downcase-region");
435 Fput (intern ("downcase-region"), Qdisabled
, Qt
);
437 initial_define_key (meta_map
, 'u', "upcase-word");
438 initial_define_key (meta_map
, 'l', "downcase-word");
439 initial_define_key (meta_map
, 'c', "capitalize-word");