1 /* GNU Emacs case conversion functions.
2 Copyright (C) 1985, 1994 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 c
= DOWNCASE (XFASTINT (obj
));
53 else if (c
== XFASTINT (obj
))
55 c
= UPCASE1 (XFASTINT (obj
));
62 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
64 obj
= Fcopy_sequence (obj
);
65 len
= XSTRING (obj
)->size
;
66 for (i
= 0; i
< len
; i
++)
68 c
= XSTRING (obj
)->data
[i
];
69 if (multibyte
&& c
>= 0x80)
70 /* A multibyte character can't be handled in this
73 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
75 else if (!UPPERCASEP (c
)
76 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
78 XSTRING (obj
)->data
[i
] = c
;
79 if ((int) flag
>= (int) CASE_CAPITALIZE
)
80 inword
= SYNTAX (c
) == Sword
;
84 /* The work is not yet finished because of a multibyte
85 character just encountered. */
86 int fromlen
, tolen
, j
= i
;
88 = (char *) alloca ((len
- i
) * MAX_LENGTH_OF_MULTI_BYTE_FORM
90 char *str
, workbuf
[4];
92 /* Copy data already handled. */
93 bcopy (XSTRING (obj
)->data
, buf
, i
);
97 c
= STRING_CHAR_AND_LENGTH (XSTRING (obj
)->data
+ i
,
99 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
101 else if (!UPPERCASEP (c
)
102 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
104 tolen
= CHAR_STRING (c
, workbuf
, str
);
105 bcopy (str
, buf
+ j
, tolen
);
108 if ((int) flag
>= (int) CASE_CAPITALIZE
)
109 inword
= SYNTAX (c
) == Sword
;
111 obj
= make_string (buf
, j
);
115 obj
= wrong_type_argument (Qchar_or_string_p
, obj
);
119 DEFUN ("upcase", Fupcase
, Supcase
, 1, 1, 0,
120 "Convert argument to upper case and return that.\n\
121 The argument may be a character or string. The result has the same type.\n\
122 The argument object is not altered--the value is a copy.\n\
123 See also `capitalize', `downcase' and `upcase-initials'.")
127 return casify_object (CASE_UP
, obj
);
130 DEFUN ("downcase", Fdowncase
, Sdowncase
, 1, 1, 0,
131 "Convert argument to lower case and return that.\n\
132 The argument may be a character or string. The result has the same type.\n\
133 The argument object is not altered--the value is a copy.")
137 return casify_object (CASE_DOWN
, obj
);
140 DEFUN ("capitalize", Fcapitalize
, Scapitalize
, 1, 1, 0,
141 "Convert argument to capitalized form and return that.\n\
142 This means that each word's first character is upper case\n\
143 and the rest is lower case.\n\
144 The argument may be a character or string. The result has the same type.\n\
145 The argument object is not altered--the value is a copy.")
149 return casify_object (CASE_CAPITALIZE
, obj
);
152 /* Like Fcapitalize but change only the initials. */
154 DEFUN ("upcase-initials", Fupcase_initials
, Supcase_initials
, 1, 1, 0,
155 "Convert the initial of each word in the argument to upper case.\n\
156 Do not change the other letters of each word.\n\
157 The argument may be a character or string. The result has the same type.\n\
158 The argument object is not altered--the value is a copy.")
162 return casify_object (CASE_CAPITALIZE_UP
, obj
);
165 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
166 b and e specify range of buffer to operate on. */
168 casify_region (flag
, b
, e
)
169 enum case_action flag
;
174 register int inword
= flag
== CASE_DOWN
;
175 register int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
177 Lisp_Object ch
, downch
, val
;
180 /* Not modifying because nothing marked */
183 /* If the case table is flagged as modified, rescan it. */
184 if (NILP (XCHAR_TABLE (current_buffer
->downcase_table
)->extras
[1]))
185 Fset_case_table (current_buffer
->downcase_table
);
187 validate_region (&b
, &e
);
188 start
= XFASTINT (b
);
190 modify_region (current_buffer
, start
, end
);
191 record_change (start
, end
- start
);
193 for (i
= start
; i
< end
; i
++)
196 if (multibyte
&& c
>= 0x80)
197 /* A multibyte character can't be handled in this simple loop. */
199 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
201 else if (!UPPERCASEP (c
)
202 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
205 if ((int) flag
>= (int) CASE_CAPITALIZE
)
206 inword
= SYNTAX (c
) == Sword
;
210 /* The work is not yet finished because of a multibyte character
216 if ((c
= FETCH_BYTE (i
)) >= 0x80)
217 c
= FETCH_MULTIBYTE_CHAR (i
);
219 if (inword
&& flag
!= CASE_CAPITALIZE_UP
)
221 else if (!UPPERCASEP (c
)
222 && (!inword
|| flag
!= CASE_CAPITALIZE_UP
))
226 int fromlen
, tolen
, j
;
227 char workbuf
[4], *str
;
229 /* Handle the most likely case */
230 if (c
< 0400 && c2
< 0400)
232 else if (fromlen
= CHAR_STRING (c
, workbuf
, str
),
233 tolen
= CHAR_STRING (c2
, workbuf
, str
),
236 for (j
= 0; j
< tolen
; ++j
)
237 FETCH_BYTE (i
+ j
) = str
[j
];
241 error ("Can't casify letters that change length");
242 #if 0 /* This is approximately what we'd like to be able to do here */
244 del_range_1 (i
+ tolen
, i
+ fromlen
, 0);
245 else if (tolen
> fromlen
)
247 TEMP_SET_PT (i
+ fromlen
);
248 insert_1 (str
+ fromlen
, tolen
- fromlen
, 1, 0);
253 if ((int) flag
>= (int) CASE_CAPITALIZE
)
254 inword
= SYNTAX (c2
) == Sword
;
257 TEMP_SET_PT (opoint
);
260 signal_after_change (start
, end
- start
, end
- start
);
263 DEFUN ("upcase-region", Fupcase_region
, Supcase_region
, 2, 2, "r",
264 "Convert the region to upper case. In programs, wants two arguments.\n\
265 These arguments specify the starting and ending character numbers of\n\
266 the region to operate on. When used as a command, the text between\n\
267 point and the mark is operated on.\n\
268 See also `capitalize-region'.")
270 Lisp_Object beg
, end
;
272 casify_region (CASE_UP
, beg
, end
);
276 DEFUN ("downcase-region", Fdowncase_region
, Sdowncase_region
, 2, 2, "r",
277 "Convert the region to lower case. In programs, wants two arguments.\n\
278 These arguments specify the starting and ending character numbers of\n\
279 the region to operate on. When used as a command, the text between\n\
280 point and the mark is operated on.")
282 Lisp_Object beg
, end
;
284 casify_region (CASE_DOWN
, beg
, end
);
288 DEFUN ("capitalize-region", Fcapitalize_region
, Scapitalize_region
, 2, 2, "r",
289 "Convert the region to capitalized form.\n\
290 Capitalized form means each word's first character is upper case\n\
291 and the rest of it is lower case.\n\
292 In programs, give two arguments, the starting and ending\n\
293 character positions to operate on.")
295 Lisp_Object beg
, end
;
297 casify_region (CASE_CAPITALIZE
, beg
, end
);
301 /* Like Fcapitalize_region but change only the initials. */
303 DEFUN ("upcase-initials-region", Fupcase_initials_region
,
304 Supcase_initials_region
, 2, 2, "r",
305 "Upcase the initial of each word in the region.\n\
306 Subsequent letters of each word are not changed.\n\
307 In programs, give two arguments, the starting and ending\n\
308 character positions to operate on.")
310 Lisp_Object beg
, end
;
312 casify_region (CASE_CAPITALIZE_UP
, beg
, end
);
317 operate_on_word (arg
, newpoint
)
325 CHECK_NUMBER (arg
, 0);
327 farend
= scan_words (PT
, iarg
);
329 farend
= iarg
> 0 ? ZV
: BEGV
;
331 *newpoint
= PT
> farend
? PT
: farend
;
332 XSETFASTINT (val
, farend
);
337 DEFUN ("upcase-word", Fupcase_word
, Supcase_word
, 1, 1, "p",
338 "Convert following word (or ARG words) to upper case, moving over.\n\
339 With negative argument, convert previous words but do not move.\n\
340 See also `capitalize-word'.")
344 Lisp_Object beg
, end
;
346 XSETFASTINT (beg
, PT
);
347 end
= operate_on_word (arg
, &newpoint
);
348 casify_region (CASE_UP
, beg
, end
);
353 DEFUN ("downcase-word", Fdowncase_word
, Sdowncase_word
, 1, 1, "p",
354 "Convert following word (or ARG words) to lower case, moving over.\n\
355 With negative argument, convert previous words but do not move.")
359 Lisp_Object beg
, end
;
361 XSETFASTINT (beg
, PT
);
362 end
= operate_on_word (arg
, &newpoint
);
363 casify_region (CASE_DOWN
, beg
, end
);
368 DEFUN ("capitalize-word", Fcapitalize_word
, Scapitalize_word
, 1, 1, "p",
369 "Capitalize the following word (or ARG words), moving over.\n\
370 This gives the word(s) a first character in upper case\n\
371 and the rest lower case.\n\
372 With negative argument, capitalize previous words but do not move.")
376 Lisp_Object beg
, end
;
378 XSETFASTINT (beg
, PT
);
379 end
= operate_on_word (arg
, &newpoint
);
380 casify_region (CASE_CAPITALIZE
, beg
, end
);
385 syms_of_casefiddle ()
387 Qidentity
= intern ("identity");
388 staticpro (&Qidentity
);
390 defsubr (&Sdowncase
);
391 defsubr (&Scapitalize
);
392 defsubr (&Supcase_initials
);
393 defsubr (&Supcase_region
);
394 defsubr (&Sdowncase_region
);
395 defsubr (&Scapitalize_region
);
396 defsubr (&Supcase_initials_region
);
397 defsubr (&Supcase_word
);
398 defsubr (&Sdowncase_word
);
399 defsubr (&Scapitalize_word
);
402 keys_of_casefiddle ()
404 initial_define_key (control_x_map
, Ctl('U'), "upcase-region");
405 Fput (intern ("upcase-region"), Qdisabled
, Qt
);
406 initial_define_key (control_x_map
, Ctl('L'), "downcase-region");
407 Fput (intern ("downcase-region"), Qdisabled
, Qt
);
409 initial_define_key (meta_map
, 'u', "upcase-word");
410 initial_define_key (meta_map
, 'l', "downcase-word");
411 initial_define_key (meta_map
, 'c', "capitalize-word");