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