code.delx.au - gnu-emacs/blob - src/casefiddle.c

   1 /* GNU Emacs case conversion functions.
   2    Copyright (C) 1985, 1994 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 \f
  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 (INTEGERP (obj))
  40         {
  41           c = XINT (obj);
  42           if (c >= 0 && c <= 0400)
  43             {
  44               if (inword)
  45                 XSETFASTINT (obj, DOWNCASE (c));
  46               else if (!UPPERCASEP (c))
  47                 XSETFASTINT (obj, UPCASE1 (c));
  48             }
  49           return obj;
  50         }
  51       if (STRINGP (obj))
  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 && flag != CASE_CAPITALIZE_UP)
  59                 c = DOWNCASE (c);
  60               else if (!UPPERCASEP (c)
  61                        && (!inword || flag != CASE_CAPITALIZE_UP))
  62                 c = UPCASE1 (c);
  63               XSTRING (obj)->data[i] = c;
  64               if ((int) flag >= (int) CASE_CAPITALIZE)
  65                 inword = SYNTAX (c) == Sword;
  66             }
  67           return obj;
  68         }
  69       obj = wrong_type_argument (Qchar_or_string_p, obj);
  70     }
  71 }
  72
  73 DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
  74   "Convert argument to upper case and return that.\n\
  75 The argument may be a character or string.  The result has the same type.\n\
  76 The argument object is not altered--the value is a copy.\n\
  77 See also `capitalize', `downcase' and `upcase-initials'.")
  78   (obj)
  79      Lisp_Object obj;
  80 {
  81   return casify_object (CASE_UP, obj);
  82 }
  83
  84 DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
  85   "Convert argument to lower case and return that.\n\
  86 The argument may be a character or string.  The result has the same type.\n\
  87 The argument object is not altered--the value is a copy.")
  88   (obj)
  89      Lisp_Object obj;
  90 {
  91   return casify_object (CASE_DOWN, obj);
  92 }
  93
  94 DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
  95   "Convert argument to capitalized form and return that.\n\
  96 This means that each word's first character is upper case\n\
  97 and the rest is lower case.\n\
  98 The argument may be a character or string.  The result has the same type.\n\
  99 The argument object is not altered--the value is a copy.")
 100   (obj)
 101      Lisp_Object obj;
 102 {
 103   return casify_object (CASE_CAPITALIZE, obj);
 104 }
 105
 106 /* Like Fcapitalize but change only the initials.  */
 107
 108 DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
 109   "Convert the initial of each word in the argument to upper case.\n\
 110 Do not change the other letters of each word.\n\
 111 The argument may be a character or string.  The result has the same type.\n\
 112 The argument object is not altered--the value is a copy.")
 113   (obj)
 114      Lisp_Object obj;
 115 {
 116   return casify_object (CASE_CAPITALIZE_UP, obj);
 117 }
 118 \f
 119 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
 120    b and e specify range of buffer to operate on. */
 121
 122 casify_region (flag, b, e)
 123      enum case_action flag;
 124      Lisp_Object b, e;
 125 {
 126   register int i;
 127   register int c;
 128   register int inword = flag == CASE_DOWN;
 129   int start, end;
 130
 131   if (EQ (b, e))
 132     /* Not modifying because nothing marked */
 133     return;
 134
 135   validate_region (&b, &e);
 136   start = XFASTINT (b);
 137   end = XFASTINT (e);
 138   modify_region (current_buffer, start, end);
 139   record_change (start, end - start);
 140
 141   for (i = start; i < end; i++)
 142     {
 143       c = FETCH_CHAR (i);
 144       if (inword && flag != CASE_CAPITALIZE_UP)
 145         c = DOWNCASE (c);
 146       else if (!UPPERCASEP (c)
 147                && (!inword || flag != CASE_CAPITALIZE_UP))
 148         c = UPCASE1 (c);
 149       FETCH_CHAR (i) = c;
 150       if ((int) flag >= (int) CASE_CAPITALIZE)
 151         inword = SYNTAX (c) == Sword;
 152     }
 153
 154   signal_after_change (start, end - start, end - start);
 155 }
 156
 157 DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
 158   "Convert the region to upper case.  In programs, wants two arguments.\n\
 159 These arguments specify the starting and ending character numbers of\n\
 160 the region to operate on.  When used as a command, the text between\n\
 161 point and the mark is operated on.\n\
 162 See also `capitalize-region'.")
 163   (b, e)
 164      Lisp_Object b, e;
 165 {
 166   casify_region (CASE_UP, b, e);
 167   return Qnil;
 168 }
 169
 170 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
 171   "Convert the region to lower case.  In programs, wants two arguments.\n\
 172 These arguments specify the starting and ending character numbers of\n\
 173 the region to operate on.  When used as a command, the text between\n\
 174 point and the mark is operated on.")
 175   (b, e)
 176      Lisp_Object b, e;
 177 {
 178   casify_region (CASE_DOWN, b, e);
 179   return Qnil;
 180 }
 181
 182 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
 183   "Convert the region to capitalized form.\n\
 184 Capitalized form means each word's first character is upper case\n\
 185 and the rest of it is lower case.\n\
 186 In programs, give two arguments, the starting and ending\n\
 187 character positions to operate on.")
 188   (b, e)
 189      Lisp_Object b, e;
 190 {
 191   casify_region (CASE_CAPITALIZE, b, e);
 192   return Qnil;
 193 }
 194
 195 /* Like Fcapitalize_region but change only the initials.  */
 196
 197 DEFUN ("upcase-initials-region", Fupcase_initials_region,
 198        Supcase_initials_region, 2, 2, "r",
 199   "Upcase the initial of each word in the region.\n\
 200 Subsequent letters of each word are not changed.\n\
 201 In programs, give two arguments, the starting and ending\n\
 202 character positions to operate on.")
 203   (b, e)
 204      Lisp_Object b, e;
 205 {
 206   casify_region (CASE_CAPITALIZE_UP, b, e);
 207   return Qnil;
 208 }
 209 \f
 210 Lisp_Object
 211 operate_on_word (arg, newpoint)
 212      Lisp_Object arg;
 213      int *newpoint;
 214 {
 215   Lisp_Object val;
 216   int farend;
 217   int iarg;
 218
 219   CHECK_NUMBER (arg, 0);
 220   iarg = XINT (arg);
 221   farend = scan_words (point, iarg);
 222   if (!farend)
 223     farend = iarg > 0 ? ZV : BEGV;
 224
 225   *newpoint = point > farend ? point : farend;
 226   XSETFASTINT (val, farend);
 227
 228   return val;
 229 }
 230
 231 DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
 232   "Convert following word (or ARG words) to upper case, moving over.\n\
 233 With negative argument, convert previous words but do not move.\n\
 234 See also `capitalize-word'.")
 235   (arg)
 236      Lisp_Object arg;
 237 {
 238   Lisp_Object beg, end;
 239   int newpoint;
 240   XSETFASTINT (beg, point);
 241   end = operate_on_word (arg, &newpoint);
 242   casify_region (CASE_UP, beg, end);
 243   SET_PT (newpoint);
 244   return Qnil;
 245 }
 246
 247 DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
 248   "Convert following word (or ARG words) to lower case, moving over.\n\
 249 With negative argument, convert previous words but do not move.")
 250   (arg)
 251      Lisp_Object arg;
 252 {
 253   Lisp_Object beg, end;
 254   int newpoint;
 255   XSETFASTINT (beg, point);
 256   end = operate_on_word (arg, &newpoint);
 257   casify_region (CASE_DOWN, beg, end);
 258   SET_PT (newpoint);
 259   return Qnil;
 260 }
 261
 262 DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
 263   "Capitalize the following word (or ARG words), moving over.\n\
 264 This gives the word(s) a first character in upper case\n\
 265 and the rest lower case.\n\
 266 With negative argument, capitalize previous words but do not move.")
 267   (arg)
 268      Lisp_Object arg;
 269 {
 270   Lisp_Object beg, end;
 271   int newpoint;
 272   XSETFASTINT (beg, point);
 273   end = operate_on_word (arg, &newpoint);
 274   casify_region (CASE_CAPITALIZE, beg, end);
 275   SET_PT (newpoint);
 276   return Qnil;
 277 }
 278 \f
 279 syms_of_casefiddle ()
 280 {
 281   defsubr (&Supcase);
 282   defsubr (&Sdowncase);
 283   defsubr (&Scapitalize);
 284   defsubr (&Supcase_initials);
 285   defsubr (&Supcase_region);
 286   defsubr (&Sdowncase_region);
 287   defsubr (&Scapitalize_region);
 288   defsubr (&Supcase_initials_region);
 289   defsubr (&Supcase_word);
 290   defsubr (&Sdowncase_word);
 291   defsubr (&Scapitalize_word);
 292 }
 293
 294 keys_of_casefiddle ()
 295 {
 296   initial_define_key (control_x_map, Ctl('U'), "upcase-region");
 297   Fput (intern ("upcase-region"), Qdisabled, Qt);
 298   initial_define_key (control_x_map, Ctl('L'), "downcase-region");
 299   Fput (intern ("downcase-region"), Qdisabled, Qt);
 300
 301   initial_define_key (meta_map, 'u', "upcase-word");
 302   initial_define_key (meta_map, 'l', "downcase-word");
 303   initial_define_key (meta_map, 'c', "capitalize-word");
 304 }