4.3BSD - /usr/src/new/emacs/src/casefiddle.c

   1: /* GNU Emacs case conversion functions.
   2:    Copyright (C) 1985 Richard M. Stallman.
   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: #define UPCASE 0
  29: #define DOWNCASE 1
  30: #define CAPITALIZE 2
  31: #define CAPITALIZE_UP 3
  32: 
  33: Lisp_Object
  34: casify_object (flag, obj)
  35:      int flag;
  36:      Lisp_Object obj;
  37: {
  38:   register int i, c, len;
  39:   register int inword = flag == DOWNCASE;
  40: 
  41:   while (1)
  42:     {
  43:       if (XTYPE (obj) == Lisp_Int)
  44:     {
  45:       c = XINT (obj);
  46:       if (inword
  47:           ? (c >= 'A' && c <= 'Z')
  48:           : (c >= 'a' && c <= 'z'))
  49:         XFASTINT (obj) = c ^ ('a' - 'A');
  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 >= 'A' && c <= 'Z')
  61:           : (c >= 'a' && c <= 'z'))
  62:         XSTRING (obj)->data[i] = c ^ ('a' - 'A');
  63:           if (flag == 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 (UPCASE, 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 (DOWNCASE, 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 (CAPITALIZE, obj);
  95: }
  96: 
  97: /* flag is UPCASE, DOWNCASE or CAPITALIZE or CAPITALIZE_UP.
  98:    b and e specify range of buffer to operate on. */
  99: 
 100: casify_region (flag, b, e)
 101:      Lisp_Object b, e;
 102: {
 103:   register int i;
 104:   register int c;
 105:   register int inword = flag == DOWNCASE;
 106: 
 107:   validate_region (&b, &e);
 108:   if (!NULL (bf_cur->read_only))
 109:     Fbarf_if_buffer_read_only();
 110:   RecordChange (XFASTINT (b), XFASTINT (e) - XFASTINT (b));
 111:   modify_region (XFASTINT (b), XFASTINT (e));
 112: 
 113:   for (i = XFASTINT (b); i < XFASTINT (e); i++)
 114:     {
 115:       c = CharAt (i);
 116:       if (inword
 117:       ? (c >= 'A' && c <= 'Z' && flag != CAPITALIZE_UP)
 118:       : (c >= 'a' && c <= 'z'))
 119:     CharAt (i) = c ^ ('a' - 'A');
 120:       if (flag >= CAPITALIZE)
 121:     inword = SYNTAX (c) == Sword;
 122:     }
 123: }
 124: 
 125: DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
 126:   "Convert the region to upper case.  In programs, wants two arguments.\n\
 127: These arguments specify the starting and ending character numbers of\n\
 128: the region to operate on.  When used as a command, the text between\n\
 129: point and the mark is operated on.")
 130:   (b, e)
 131:      Lisp_Object b, e;
 132: {
 133:   casify_region (UPCASE, b, e);
 134:   return Qnil;
 135: }
 136: 
 137: DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
 138:   "Convert the region to lower case.  In programs, wants two arguments.\n\
 139: These arguments specify the starting and ending character numbers of\n\
 140: the region to operate on.  When used as a command, the text between\n\
 141: point and the mark is operated on.")
 142:   (b, e)
 143:      Lisp_Object b, e;
 144: {
 145:   casify_region (DOWNCASE, b, e);
 146:   return Qnil;
 147: }
 148: 
 149: DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
 150:   "Convert the region to upper case.  In programs, wants two arguments.\n\
 151: These arguments specify the starting and ending character numbers of\n\
 152: the region to operate on.  When used as a command, the text between\n\
 153: point and the mark is operated on.\n\
 154: Capitalized form means each word's first character is upper case\n\
 155: and the rest of it is lower case.")
 156:   (b, e)
 157:      Lisp_Object b, e;
 158: {
 159:   casify_region (CAPITALIZE, b, e);
 160:   return Qnil;
 161: }
 162: 
 163: /* Like Fcapitalize but change only the initials.  */
 164: 
 165: Lisp_Object
 166: upcase_initials_region (b, e)
 167:      Lisp_Object b, e;
 168: {
 169:   casify_region (CAPITALIZE_UP, b, e);
 170:   return Qnil;
 171: }
 172: 
 173: void
 174: operate_on_word (flag, arg)
 175:      int flag;
 176:      Lisp_Object arg;
 177: {
 178:   Lisp_Object beg, end;
 179:   int farend;
 180:   CHECK_NUMBER (arg, 0);
 181:   farend = scan_words (point, XINT (arg));
 182:   if (!farend)
 183:     farend = XINT (arg) > 0 ? NumCharacters + 1 : FirstCharacter;
 184:   XFASTINT (beg) = point < farend ? point : farend;
 185:   XFASTINT (end) = point > farend ? point : farend;
 186:   casify_region (flag, beg, end);
 187:   SetPoint (XFASTINT (end));
 188: }
 189: 
 190: DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
 191:   "Convert following word (or ARG words) to upper case, moving over.\n\
 192: With negative argument, convert previous words but do not move.")
 193:   (arg)
 194:      Lisp_Object arg;
 195: {
 196:   operate_on_word (UPCASE, arg);
 197:   return Qnil;
 198: }
 199: 
 200: DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
 201:   "Convert following word (or ARG words) to lower case, moving over.\n\
 202: With negative argument, convert previous words but do not move.")
 203:   (arg)
 204:      Lisp_Object arg;
 205: {
 206:   operate_on_word (DOWNCASE, arg);
 207:   return Qnil;
 208: }
 209: 
 210: DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
 211:   "Capitalize the following word (or ARG words), moving over.\n\
 212: This gives the word(s) a first character in upper case\n\
 213: and the rest lower case.\n\
 214: With negative argument, capitalize previous words but do not move.")
 215:   (arg)
 216:      Lisp_Object arg;
 217: {
 218:   operate_on_word (CAPITALIZE, arg);
 219:   return Qnil;
 220: }
 221: 
 222: syms_of_casefiddle ()
 223: {
 224:   defsubr (&Supcase);
 225:   defsubr (&Sdowncase);
 226:   defsubr (&Scapitalize);
 227:   defsubr (&Supcase_region);
 228:   defsubr (&Sdowncase_region);
 229:   defsubr (&Scapitalize_region);
 230:   defsubr (&Supcase_word);
 231:   defsubr (&Sdowncase_word);
 232:   defsubr (&Scapitalize_word);
 233: }
 234: 
 235: keys_of_casefiddle ()
 236: {
 237:   defkey (CtlXmap, Ctl('U'), "upcase-region");
 238:   defkey (CtlXmap, Ctl('L'), "downcase-region");
 239:   defkey (ESCmap, 'u', "upcase-word");
 240:   defkey (ESCmap, 'l', "downcase-word");
 241:   defkey (ESCmap, 'c', "capitalize-word");
 242: }

Defined functions

Defined macros