1/* GNU Emacs case conversion functions. 2 Copyright (C) 1985, 1994, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 3 2005, 2006, 2007 Free Software Foundation, Inc. 4 5This file is part of GNU Emacs. 6 7GNU Emacs is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Emacs is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Emacs; see the file COPYING. If not, write to 19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 20Boston, MA 02110-1301, USA. */ 21 22 23#include <config.h> 24#include "lisp.h" 25#include "buffer.h" 26#include "charset.h" 27#include "commands.h" 28#include "syntax.h" 29#include "composite.h" 30#include "keymap.h" 31 32enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; 33 34Lisp_Object Qidentity; 35 36Lisp_Object 37casify_object (flag, obj) 38 enum case_action flag; 39 Lisp_Object obj; 40{ 41 register int i, c, len; 42 register int inword = flag == CASE_DOWN; 43 44 /* If the case table is flagged as modified, rescan it. */ 45 if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1])) 46 Fset_case_table (current_buffer->downcase_table); 47 48 if (INTEGERP (obj)) 49 { 50 int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER 51 | CHAR_SHIFT | CHAR_CTL | CHAR_META); 52 int flags = XINT (obj) & flagbits; 53 54 /* If the character has higher bits set 55 above the flags, return it unchanged. 56 It is not a real character. */ 57 if ((unsigned) XFASTINT (obj) > (unsigned) flagbits) 58 return obj; 59 60 c = DOWNCASE (XFASTINT (obj) & ~flagbits); 61 if (inword) 62 XSETFASTINT (obj, c | flags); 63 else if (c == (XFASTINT (obj) & ~flagbits)) 64 { 65 c = UPCASE1 ((XFASTINT (obj) & ~flagbits)); 66 XSETFASTINT (obj, c | flags); 67 } 68 return obj; 69 } 70 71 if (STRINGP (obj)) 72 { 73 int multibyte = STRING_MULTIBYTE (obj); 74 int n; 75 76 obj = Fcopy_sequence (obj); 77 len = SBYTES (obj); 78 79 /* I counts bytes, and N counts chars. */ 80 for (i = n = 0; i < len; n++) 81 { 82 int from_len = 1, to_len = 1; 83 84 c = SREF (obj, i); 85 86 if (multibyte && c >= 0x80) 87 c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i, len -i, from_len); 88 if (inword && flag != CASE_CAPITALIZE_UP) 89 c = DOWNCASE (c); 90 else if (!UPPERCASEP (c) 91 && (!inword || flag != CASE_CAPITALIZE_UP)) 92 c = UPCASE1 (c); 93 if ((ASCII_BYTE_P (c) && from_len == 1) 94 || (! multibyte && SINGLE_BYTE_CHAR_P (c))) 95 SSET (obj, i, c); 96 else 97 { 98 to_len = CHAR_BYTES (c); 99 if (from_len == to_len) 100 CHAR_STRING (c, SDATA (obj) + i); 101 else 102 { 103 Faset (obj, make_number (n), make_number (c)); 104 len += to_len - from_len; 105 } 106 } 107 if ((int) flag >= (int) CASE_CAPITALIZE) 108 inword = SYNTAX (c) == Sword; 109 i += to_len; 110 } 111 return obj; 112 } 113 114 wrong_type_argument (Qchar_or_string_p, obj); 115} 116 117DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0, 118 doc: /* Convert argument to upper case and return that. 119The argument may be a character or string. The result has the same type. 120The argument object is not altered--the value is a copy. 121See also `capitalize', `downcase' and `upcase-initials'. */) 122 (obj) 123 Lisp_Object obj; 124{ 125 return casify_object (CASE_UP, obj); 126} 127 128DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0, 129 doc: /* Convert argument to lower case and return that. 130The argument may be a character or string. The result has the same type. 131The argument object is not altered--the value is a copy. */) 132 (obj) 133 Lisp_Object obj; 134{ 135 return casify_object (CASE_DOWN, obj); 136} 137 138DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0, 139 doc: /* Convert argument to capitalized form and return that. 140This means that each word's first character is upper case 141and the rest is lower case. 142The argument may be a character or string. The result has the same type. 143The argument object is not altered--the value is a copy. */) 144 (obj) 145 Lisp_Object obj; 146{ 147 return casify_object (CASE_CAPITALIZE, obj); 148} 149 150/* Like Fcapitalize but change only the initials. */ 151 152DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0, 153 doc: /* Convert the initial of each word in the argument to upper case. 154Do not change the other letters of each word. 155The argument may be a character or string. The result has the same type. 156The argument object is not altered--the value is a copy. */) 157 (obj) 158 Lisp_Object obj; 159{ 160 return casify_object (CASE_CAPITALIZE_UP, obj); 161} 162 163/* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP. 164 b and e specify range of buffer to operate on. */ 165 166void 167casify_region (flag, b, e) 168 enum case_action flag; 169 Lisp_Object b, e; 170{ 171 register int i; 172 register int c; 173 register int inword = flag == CASE_DOWN; 174 register int multibyte = !NILP (current_buffer->enable_multibyte_characters); 175 int start, end; 176 int start_byte, end_byte; 177 int changed = 0; 178 179 if (EQ (b, e)) 180 /* Not modifying because nothing marked */ 181 return; 182 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); 186 187 validate_region (&b, &e); 188 start = XFASTINT (b); 189 end = XFASTINT (e); 190 modify_region (current_buffer, start, end, 0); 191 record_change (start, end - start); 192 start_byte = CHAR_TO_BYTE (start); 193 end_byte = CHAR_TO_BYTE (end); 194 195 for (i = start_byte; i < end_byte; i++, start++) 196 { 197 int c2; 198 c = c2 = FETCH_BYTE (i); 199 if (multibyte && c >= 0x80) 200 /* A multibyte character can't be handled in this simple loop. */ 201 break; 202 if (inword && flag != CASE_CAPITALIZE_UP) 203 c = DOWNCASE (c); 204 else if (!UPPERCASEP (c) 205 && (!inword || flag != CASE_CAPITALIZE_UP)) 206 c = UPCASE1 (c); 207 if (multibyte && c >= 0x80) 208 /* A multibyte result character can't be handled in this 209 simple loop. */ 210 break; 211 FETCH_BYTE (i) = c; 212 if (c != c2) 213 changed = 1; 214 if ((int) flag >= (int) CASE_CAPITALIZE) 215 inword = SYNTAX (c) == Sword && (inword || !SYNTAX_PREFIX (c)); 216 } 217 if (i < end_byte) 218 { 219 /* The work is not yet finished because of a multibyte character 220 just encountered. */ 221 int opoint = PT; 222 int opoint_byte = PT_BYTE; 223 int c2; 224 225 while (start < end) 226 { 227 if ((c = FETCH_BYTE (i)) >= 0x80) 228 c = FETCH_MULTIBYTE_CHAR (i); 229 c2 = c; 230 if (inword && flag != CASE_CAPITALIZE_UP) 231 c2 = DOWNCASE (c); 232 else if (!UPPERCASEP (c) 233 && (!inword || flag != CASE_CAPITALIZE_UP)) 234 c2 = UPCASE1 (c); 235 if (c != c2) 236 { 237 int fromlen, tolen, j; 238 unsigned char str[MAX_MULTIBYTE_LENGTH]; 239 240 changed = 1; 241 /* Handle the most likely case */ 242 if (c < 0400 && c2 < 0400) 243 FETCH_BYTE (i) = c2; 244 else if (fromlen = CHAR_STRING (c, str), 245 tolen = CHAR_STRING (c2, str), 246 fromlen == tolen) 247 { 248 /* Length is unchanged. */ 249 for (j = 0; j < tolen; ++j) 250 FETCH_BYTE (i + j) = str[j]; 251 } 252 else 253 { 254 /* Replace one character with the other, 255 keeping text properties the same. */ 256 replace_range_2 (start, i, 257 start + 1, i + fromlen, 258 str, 1, tolen, 259 1); 260 if (opoint > start) 261 opoint_byte += tolen - fromlen; 262 } 263 } 264 if ((int) flag >= (int) CASE_CAPITALIZE) 265 inword = SYNTAX (c2) == Sword; 266 INC_BOTH (start, i); 267 } 268 TEMP_SET_PT_BOTH (opoint, opoint_byte); 269 } 270 271 start = XFASTINT (b); 272 if (changed) 273 { 274 signal_after_change (start, end - start, end - start); 275 update_compositions (start, end, CHECK_ALL); 276 } 277} 278 279DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r", 280 doc: /* Convert the region to upper case. In programs, wants two arguments. 281These arguments specify the starting and ending character numbers of 282the region to operate on. When used as a command, the text between 283point and the mark is operated on. 284See also `capitalize-region'. */) 285 (beg, end) 286 Lisp_Object beg, end; 287{ 288 casify_region (CASE_UP, beg, end); 289 return Qnil; 290} 291 292DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r", 293 doc: /* Convert the region to lower case. In programs, wants two arguments. 294These arguments specify the starting and ending character numbers of 295the region to operate on. When used as a command, the text between 296point and the mark is operated on. */) 297 (beg, end) 298 Lisp_Object beg, end; 299{ 300 casify_region (CASE_DOWN, beg, end); 301 return Qnil; 302} 303 304DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r", 305 doc: /* Convert the region to capitalized form. 306Capitalized form means each word's first character is upper case 307and the rest of it is lower case. 308In programs, give two arguments, the starting and ending 309character positions to operate on. */) 310 (beg, end) 311 Lisp_Object beg, end; 312{ 313 casify_region (CASE_CAPITALIZE, beg, end); 314 return Qnil; 315} 316 317/* Like Fcapitalize_region but change only the initials. */ 318 319DEFUN ("upcase-initials-region", Fupcase_initials_region, 320 Supcase_initials_region, 2, 2, "r", 321 doc: /* Upcase the initial of each word in the region. 322Subsequent letters of each word are not changed. 323In programs, give two arguments, the starting and ending 324character positions to operate on. */) 325 (beg, end) 326 Lisp_Object beg, end; 327{ 328 casify_region (CASE_CAPITALIZE_UP, beg, end); 329 return Qnil; 330} 331 332Lisp_Object 333operate_on_word (arg, newpoint) 334 Lisp_Object arg; 335 int *newpoint; 336{ 337 Lisp_Object val; 338 int farend; 339 int iarg; 340 341 CHECK_NUMBER (arg); 342 iarg = XINT (arg); 343 farend = scan_words (PT, iarg); 344 if (!farend) 345 farend = iarg > 0 ? ZV : BEGV; 346 347 *newpoint = PT > farend ? PT : farend; 348 XSETFASTINT (val, farend); 349 350 return val; 351} 352 353DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p", 354 doc: /* Convert following word (or ARG words) to upper case, moving over. 355With negative argument, convert previous words but do not move. 356See also `capitalize-word'. */) 357 (arg) 358 Lisp_Object arg; 359{ 360 Lisp_Object beg, end; 361 int newpoint; 362 XSETFASTINT (beg, PT); 363 end = operate_on_word (arg, &newpoint); 364 casify_region (CASE_UP, beg, end); 365 SET_PT (newpoint); 366 return Qnil; 367} 368 369DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p", 370 doc: /* Convert following word (or ARG words) to lower case, moving over. 371With negative argument, convert previous words but do not move. */) 372 (arg) 373 Lisp_Object arg; 374{ 375 Lisp_Object beg, end; 376 int newpoint; 377 XSETFASTINT (beg, PT); 378 end = operate_on_word (arg, &newpoint); 379 casify_region (CASE_DOWN, beg, end); 380 SET_PT (newpoint); 381 return Qnil; 382} 383 384DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p", 385 doc: /* Capitalize the following word (or ARG words), moving over. 386This gives the word(s) a first character in upper case 387and the rest lower case. 388With negative argument, capitalize previous words but do not move. */) 389 (arg) 390 Lisp_Object arg; 391{ 392 Lisp_Object beg, end; 393 int newpoint; 394 XSETFASTINT (beg, PT); 395 end = operate_on_word (arg, &newpoint); 396 casify_region (CASE_CAPITALIZE, beg, end); 397 SET_PT (newpoint); 398 return Qnil; 399} 400 401void 402syms_of_casefiddle () 403{ 404 Qidentity = intern ("identity"); 405 staticpro (&Qidentity); 406 defsubr (&Supcase); 407 defsubr (&Sdowncase); 408 defsubr (&Scapitalize); 409 defsubr (&Supcase_initials); 410 defsubr (&Supcase_region); 411 defsubr (&Sdowncase_region); 412 defsubr (&Scapitalize_region); 413 defsubr (&Supcase_initials_region); 414 defsubr (&Supcase_word); 415 defsubr (&Sdowncase_word); 416 defsubr (&Scapitalize_word); 417} 418 419void 420keys_of_casefiddle () 421{ 422 initial_define_key (control_x_map, Ctl('U'), "upcase-region"); 423 Fput (intern ("upcase-region"), Qdisabled, Qt); 424 initial_define_key (control_x_map, Ctl('L'), "downcase-region"); 425 Fput (intern ("downcase-region"), Qdisabled, Qt); 426 427 initial_define_key (meta_map, 'u', "upcase-word"); 428 initial_define_key (meta_map, 'l', "downcase-word"); 429 initial_define_key (meta_map, 'c', "capitalize-word"); 430} 431 432/* arch-tag: 60a73c66-5489-47e7-a81f-cead4057c526 433 (do not change this comment) */ 434