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