|
|
1.1 ! root 1: /* GNU Emacs case conversion functions. ! 2: Copyright (C) 1985 Free Software Foundation, Inc. ! 3: ! 4: This file is part of GNU Emacs. ! 5: ! 6: GNU Emacs is distributed in the hope that it will be useful, ! 7: but WITHOUT ANY WARRANTY. No author or distributor ! 8: accepts responsibility to anyone for the consequences of using it ! 9: or for whether it serves any particular purpose or works at all, ! 10: unless he says so in writing. Refer to the GNU Emacs General Public ! 11: License for full details. ! 12: ! 13: Everyone is granted permission to copy, modify and redistribute ! 14: GNU Emacs, but only under the conditions described in the ! 15: GNU Emacs General Public License. A copy of this license is ! 16: supposed to have been given to you along with GNU Emacs so you ! 17: can know your rights and responsibilities. It should be in a ! 18: file named COPYING. Among other things, the copyright notice ! 19: and this notice must be preserved on all copies. */ ! 20: ! 21: ! 22: #include "config.h" ! 23: #include "lisp.h" ! 24: #include "buffer.h" ! 25: #include "commands.h" ! 26: #include "syntax.h" ! 27: ! 28: enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; ! 29: ! 30: Lisp_Object ! 31: casify_object (flag, obj) ! 32: enum case_action flag; ! 33: Lisp_Object obj; ! 34: { ! 35: register int i, c, len; ! 36: register int inword = flag == CASE_DOWN; ! 37: ! 38: while (1) ! 39: { ! 40: if (XTYPE (obj) == Lisp_Int) ! 41: { ! 42: c = XINT (obj); ! 43: if (c >= 0 && c <= 0400) ! 44: { ! 45: if (inword) ! 46: XFASTINT (obj) = DOWNCASE (c); ! 47: else if (!UPPERCASEP (c)) ! 48: XFASTINT (obj) = UPCASE1 (c); ! 49: } ! 50: return obj; ! 51: } ! 52: if (XTYPE (obj) == Lisp_String) ! 53: { ! 54: obj = Fcopy_sequence (obj); ! 55: len = XSTRING (obj)->size; ! 56: for (i = 0; i < len; i++) ! 57: { ! 58: c = XSTRING (obj)->data[i]; ! 59: if (inword) ! 60: c = DOWNCASE (c); ! 61: else if (!UPPERCASEP (c)) ! 62: c = UPCASE1 (c); ! 63: XSTRING (obj)->data[i] = c; ! 64: if (flag == CASE_CAPITALIZE) ! 65: inword = SYNTAX (c) == Sword; ! 66: } ! 67: return obj; ! 68: } ! 69: obj = wrong_type_argument (Qchar_or_string_p, obj, 0); ! 70: } ! 71: } ! 72: ! 73: DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0, ! 74: "One arg, a character or string. Convert it to upper case and return that.") ! 75: (obj) ! 76: Lisp_Object obj; ! 77: { ! 78: return casify_object (CASE_UP, obj); ! 79: } ! 80: ! 81: DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0, ! 82: "One arg, a character or string. Convert it to lower case and return that.") ! 83: (obj) ! 84: Lisp_Object obj; ! 85: { ! 86: return casify_object (CASE_DOWN, obj); ! 87: } ! 88: ! 89: DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0, ! 90: "One arg, a character or string. Convert it to capitalized form and return that.\n\ ! 91: This means that each word's first character is upper case and the rest is lower case.") ! 92: (obj) ! 93: Lisp_Object obj; ! 94: { ! 95: return casify_object (CASE_CAPITALIZE, obj); ! 96: } ! 97: ! 98: /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP. ! 99: b and e specify range of buffer to operate on. */ ! 100: ! 101: casify_region (flag, b, e) ! 102: enum case_action flag; ! 103: Lisp_Object b, e; ! 104: { ! 105: register int i; ! 106: register int c; ! 107: register int inword = flag == CASE_DOWN; ! 108: ! 109: validate_region (&b, &e); ! 110: prepare_to_modify_buffer (); ! 111: record_change (XFASTINT (b), XFASTINT (e) - XFASTINT (b)); ! 112: ! 113: for (i = XFASTINT (b); i < XFASTINT (e); i++) ! 114: { ! 115: c = CharAt (i); ! 116: if (inword && flag != CASE_CAPITALIZE_UP) ! 117: c = DOWNCASE (c); ! 118: else if (!UPPERCASEP (c) ! 119: && (!inword || flag != CASE_CAPITALIZE_UP)) ! 120: c = UPCASE1 (c); ! 121: CharAt (i) = c; ! 122: if ((int) flag >= (int) CASE_CAPITALIZE) ! 123: inword = SYNTAX (c) == Sword; ! 124: } ! 125: ! 126: modify_region (XFASTINT (b), XFASTINT (e)); ! 127: } ! 128: ! 129: DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r", ! 130: "Convert the region to upper case. In programs, wants two arguments.\n\ ! 131: These arguments specify the starting and ending character numbers of\n\ ! 132: the region to operate on. When used as a command, the text between\n\ ! 133: point and the mark is operated on.") ! 134: (b, e) ! 135: Lisp_Object b, e; ! 136: { ! 137: casify_region (CASE_UP, b, e); ! 138: return Qnil; ! 139: } ! 140: ! 141: DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r", ! 142: "Convert the region to lower case. In programs, wants two arguments.\n\ ! 143: These arguments specify the starting and ending character numbers of\n\ ! 144: the region to operate on. When used as a command, the text between\n\ ! 145: point and the mark is operated on.") ! 146: (b, e) ! 147: Lisp_Object b, e; ! 148: { ! 149: casify_region (CASE_DOWN, b, e); ! 150: return Qnil; ! 151: } ! 152: ! 153: DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r", ! 154: "Convert the region to upper case. In programs, wants two arguments.\n\ ! 155: These arguments specify the starting and ending character numbers of\n\ ! 156: the region to operate on. When used as a command, the text between\n\ ! 157: point and the mark is operated on.\n\ ! 158: Capitalized form means each word's first character is upper case\n\ ! 159: and the rest of it is lower case.") ! 160: (b, e) ! 161: Lisp_Object b, e; ! 162: { ! 163: casify_region (CASE_CAPITALIZE, b, e); ! 164: return Qnil; ! 165: } ! 166: ! 167: /* Like Fcapitalize but change only the initials. */ ! 168: ! 169: Lisp_Object ! 170: upcase_initials_region (b, e) ! 171: Lisp_Object b, e; ! 172: { ! 173: casify_region (CASE_CAPITALIZE_UP, b, e); ! 174: return Qnil; ! 175: } ! 176: ! 177: void ! 178: operate_on_word (flag, arg) ! 179: int flag; ! 180: Lisp_Object arg; ! 181: { ! 182: Lisp_Object beg, end; ! 183: int farend; ! 184: CHECK_NUMBER (arg, 0); ! 185: farend = scan_words (point, XINT (arg)); ! 186: if (!farend) ! 187: farend = XINT (arg) > 0 ? NumCharacters + 1 : FirstCharacter; ! 188: XFASTINT (beg) = point < farend ? point : farend; ! 189: XFASTINT (end) = point > farend ? point : farend; ! 190: casify_region (flag, beg, end); ! 191: SetPoint (XFASTINT (end)); ! 192: } ! 193: ! 194: DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p", ! 195: "Convert following word (or ARG words) to upper case, moving over.\n\ ! 196: With negative argument, convert previous words but do not move.") ! 197: (arg) ! 198: Lisp_Object arg; ! 199: { ! 200: operate_on_word (CASE_UP, arg); ! 201: return Qnil; ! 202: } ! 203: ! 204: DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p", ! 205: "Convert following word (or ARG words) to lower case, moving over.\n\ ! 206: With negative argument, convert previous words but do not move.") ! 207: (arg) ! 208: Lisp_Object arg; ! 209: { ! 210: operate_on_word (CASE_DOWN, arg); ! 211: return Qnil; ! 212: } ! 213: ! 214: DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p", ! 215: "Capitalize the following word (or ARG words), moving over.\n\ ! 216: This gives the word(s) a first character in upper case\n\ ! 217: and the rest lower case.\n\ ! 218: With negative argument, capitalize previous words but do not move.") ! 219: (arg) ! 220: Lisp_Object arg; ! 221: { ! 222: operate_on_word (CASE_CAPITALIZE, arg); ! 223: return Qnil; ! 224: } ! 225: ! 226: syms_of_casefiddle () ! 227: { ! 228: defsubr (&Supcase); ! 229: defsubr (&Sdowncase); ! 230: defsubr (&Scapitalize); ! 231: defsubr (&Supcase_region); ! 232: defsubr (&Sdowncase_region); ! 233: defsubr (&Scapitalize_region); ! 234: defsubr (&Supcase_word); ! 235: defsubr (&Sdowncase_word); ! 236: defsubr (&Scapitalize_word); ! 237: } ! 238: ! 239: keys_of_casefiddle () ! 240: { ! 241: defkey (CtlXmap, Ctl('U'), "upcase-region"); ! 242: defkey (CtlXmap, Ctl('L'), "downcase-region"); ! 243: defkey (ESCmap, 'u', "upcase-word"); ! 244: defkey (ESCmap, 'l', "downcase-word"); ! 245: defkey (ESCmap, 'c', "capitalize-word"); ! 246: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.