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 "charset.h"
  26 #include "commands.h"
  27 #include "syntax.h"
  28
  29 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
  30
  31 Lisp_Object Qidentity;
  32 \f
  33 Lisp_Object
  34 casify_object (flag, obj)
  35      enum case_action flag;
  36      Lisp_Object obj;
  37 {
  38   register int i, c, len;
  39   register int inword = flag == CASE_DOWN;
  40   Lisp_Object tem;
  41
  42   /* If the case table is flagged as modified, rescan it.  */
  43   if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
  44     Fset_case_table (current_buffer->downcase_table);
  45
  46   while (1)
  47     {
  48       if (INTEGERP (obj))
  49         {
  50           c = DOWNCASE (XFASTINT (obj));
  51           if (inword)
  52             XSETFASTINT (obj, c);
  53           else if (c == XFASTINT (obj))
  54             {
  55               c = UPCASE1 (XFASTINT (obj));
  56               XSETFASTINT (obj, c);
  57             }
  58           return obj;
  59         }
  60       if (STRINGP (obj))
  61         {
  62           int multibyte = !NILP (current_buffer->enable_multibyte_characters);
  63
  64           obj = Fcopy_sequence (obj);
  65           len = XSTRING (obj)->size;
  66           for (i = 0; i < len; i++)
  67             {
  68               c = XSTRING (obj)->data[i];
  69               if (multibyte && c >= 0x80)
  70                 /* A multibyte character can't be handled in this
  71                    simple loop.  */
  72                 break;
  73               if (inword && flag != CASE_CAPITALIZE_UP)
  74                 c = DOWNCASE (c);
  75               else if (!UPPERCASEP (c)
  76                        && (!inword || flag != CASE_CAPITALIZE_UP))
  77                 c = UPCASE1 (c);
  78               XSTRING (obj)->data[i] = c;
  79               if ((int) flag >= (int) CASE_CAPITALIZE)
  80                 inword = SYNTAX (c) == Sword;
  81             }
  82           if (i < len)
  83             {
  84               /* The work is not yet finished because of a multibyte
  85                  character just encountered.  */
  86               int fromlen, tolen, j = i;
  87               char *buf
  88                 = (char *) alloca ((len - i) * MAX_LENGTH_OF_MULTI_BYTE_FORM
  89                                    + i);
  90               char *str, workbuf[4];
  91
  92               /* Copy data already handled.  */
  93               bcopy (XSTRING (obj)->data, buf, i);
  94
  95               while (i < len)
  96                 {
  97                   c = STRING_CHAR_AND_LENGTH (XSTRING (obj)->data + i,
  98                                               len - i, fromlen);
  99                   if (inword && flag != CASE_CAPITALIZE_UP)
 100                     c = DOWNCASE (c);
 101                   else if (!UPPERCASEP (c)
 102                            && (!inword || flag != CASE_CAPITALIZE_UP))
 103                     c = UPCASE1 (c);
 104                   tolen = CHAR_STRING (c, workbuf, str);
 105                   bcopy (str, buf + j, tolen);
 106                   i += fromlen;
 107                   j += tolen;
 108                   if ((int) flag >= (int) CASE_CAPITALIZE)
 109                     inword = SYNTAX (c) == Sword;
 110                 }
 111               obj = make_string (buf, j);
 112             }
 113           return obj;
 114         }
 115       obj = wrong_type_argument (Qchar_or_string_p, obj);
 116     }
 117 }
 118
 119 DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
 120   "Convert argument to upper case and return that.\n\
 121 The argument may be a character or string.  The result has the same type.\n\
 122 The argument object is not altered--the value is a copy.\n\
 123 See also `capitalize', `downcase' and `upcase-initials'.")
 124   (obj)
 125      Lisp_Object obj;
 126 {
 127   return casify_object (CASE_UP, obj);
 128 }
 129
 130 DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
 131   "Convert argument to lower case and return that.\n\
 132 The argument may be a character or string.  The result has the same type.\n\
 133 The argument object is not altered--the value is a copy.")
 134   (obj)
 135      Lisp_Object obj;
 136 {
 137   return casify_object (CASE_DOWN, obj);
 138 }
 139
 140 DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
 141   "Convert argument to capitalized form and return that.\n\
 142 This means that each word's first character is upper case\n\
 143 and the rest is lower case.\n\
 144 The argument may be a character or string.  The result has the same type.\n\
 145 The argument object is not altered--the value is a copy.")
 146   (obj)
 147      Lisp_Object obj;
 148 {
 149   return casify_object (CASE_CAPITALIZE, obj);
 150 }
 151
 152 /* Like Fcapitalize but change only the initials.  */
 153
 154 DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
 155   "Convert the initial of each word in the argument to upper case.\n\
 156 Do not change the other letters of each word.\n\
 157 The argument may be a character or string.  The result has the same type.\n\
 158 The argument object is not altered--the value is a copy.")
 159   (obj)
 160      Lisp_Object obj;
 161 {
 162   return casify_object (CASE_CAPITALIZE_UP, obj);
 163 }
 164 \f
 165 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
 166    b and e specify range of buffer to operate on. */
 167
 168 casify_region (flag, b, e)
 169      enum case_action flag;
 170      Lisp_Object b, e;
 171 {
 172   register int i;
 173   register int c;
 174   register int inword = flag == CASE_DOWN;
 175   register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
 176   int start, end;
 177   Lisp_Object ch, downch, val;
 178
 179   if (EQ (b, e))
 180     /* Not modifying because nothing marked */
 181     return;
 182
 183   /* If the case table is flagged as modified, rescan it.  */
 184   if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
 185     Fset_case_table (current_buffer->downcase_table);
 186
 187   validate_region (&b, &e);
 188   start = XFASTINT (b);
 189   end = XFASTINT (e);
 190   modify_region (current_buffer, start, end);
 191   record_change (start, end - start);
 192
 193   for (i = start; i < end; i++)
 194     {
 195       c = FETCH_BYTE (i);
 196       if (multibyte && c >= 0x80)
 197         /* A multibyte character can't be handled in this simple loop.  */
 198         break;
 199       if (inword && flag != CASE_CAPITALIZE_UP)
 200         c = DOWNCASE (c);
 201       else if (!UPPERCASEP (c)
 202                && (!inword || flag != CASE_CAPITALIZE_UP))
 203         c = UPCASE1 (c);
 204       FETCH_BYTE (i) = c;
 205       if ((int) flag >= (int) CASE_CAPITALIZE)
 206         inword = SYNTAX (c) == Sword;
 207     }
 208   if (i < end)
 209     {
 210       /* The work is not yet finished because of a multibyte character
 211          just encountered.  */
 212       int opoint = PT, c2;
 213
 214       while (i < end)
 215         {
 216           if ((c = FETCH_BYTE (i)) >= 0x80)
 217             c = FETCH_MULTIBYTE_CHAR (i);
 218           c2 = c;
 219           if (inword && flag != CASE_CAPITALIZE_UP)
 220             c2 = DOWNCASE (c);
 221           else if (!UPPERCASEP (c)
 222                    && (!inword || flag != CASE_CAPITALIZE_UP))
 223             c2 = UPCASE1 (c);
 224           if (c != c2)
 225             {
 226               int fromlen, tolen, j;
 227               char workbuf[4], *str;
 228
 229               /* Handle the most likely case */
 230               if (c < 0400 && c2 < 0400)
 231                 FETCH_BYTE (i) = c2;
 232               else if (fromlen = CHAR_STRING (c, workbuf, str),
 233                        tolen = CHAR_STRING (c2, workbuf, str),
 234                        fromlen == tolen)
 235                 {
 236                   for (j = 0; j < tolen; ++j)
 237                     FETCH_BYTE (i + j) = str[j];
 238                 }
 239               else
 240                 {
 241                   error ("Can't casify letters that change length");
 242 #if 0 /* This is approximately what we'd like to be able to do here */
 243                   if (tolen < fromlen)
 244                     del_range_1 (i + tolen, i + fromlen, 0);
 245                   else if (tolen > fromlen)
 246                     {
 247                       TEMP_SET_PT (i + fromlen);
 248                       insert_1 (str + fromlen, tolen - fromlen, 1, 0);
 249                     }
 250 #endif
 251                 }
 252             }
 253           if ((int) flag >= (int) CASE_CAPITALIZE)
 254             inword = SYNTAX (c2) == Sword;
 255           INC_POS (i);
 256         }
 257       TEMP_SET_PT (opoint);
 258     }
 259
 260   signal_after_change (start, end - start, end - start);
 261 }
 262
 263 DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
 264   "Convert the region to upper case.  In programs, wants two arguments.\n\
 265 These arguments specify the starting and ending character numbers of\n\
 266 the region to operate on.  When used as a command, the text between\n\
 267 point and the mark is operated on.\n\
 268 See also `capitalize-region'.")
 269   (beg, end)
 270      Lisp_Object beg, end;
 271 {
 272   casify_region (CASE_UP, beg, end);
 273   return Qnil;
 274 }
 275
 276 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
 277   "Convert the region to lower case.  In programs, wants two arguments.\n\
 278 These arguments specify the starting and ending character numbers of\n\
 279 the region to operate on.  When used as a command, the text between\n\
 280 point and the mark is operated on.")
 281   (beg, end)
 282      Lisp_Object beg, end;
 283 {
 284   casify_region (CASE_DOWN, beg, end);
 285   return Qnil;
 286 }
 287
 288 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
 289   "Convert the region to capitalized form.\n\
 290 Capitalized form means each word's first character is upper case\n\
 291 and the rest of it is lower case.\n\
 292 In programs, give two arguments, the starting and ending\n\
 293 character positions to operate on.")
 294   (beg, end)
 295      Lisp_Object beg, end;
 296 {
 297   casify_region (CASE_CAPITALIZE, beg, end);
 298   return Qnil;
 299 }
 300
 301 /* Like Fcapitalize_region but change only the initials.  */
 302
 303 DEFUN ("upcase-initials-region", Fupcase_initials_region,
 304        Supcase_initials_region, 2, 2, "r",
 305   "Upcase the initial of each word in the region.\n\
 306 Subsequent letters of each word are not changed.\n\
 307 In programs, give two arguments, the starting and ending\n\
 308 character positions to operate on.")
 309   (beg, end)
 310      Lisp_Object beg, end;
 311 {
 312   casify_region (CASE_CAPITALIZE_UP, beg, end);
 313   return Qnil;
 314 }
 315 \f
 316 Lisp_Object
 317 operate_on_word (arg, newpoint)
 318      Lisp_Object arg;
 319      int *newpoint;
 320 {
 321   Lisp_Object val;
 322   int farend;
 323   int iarg;
 324
 325   CHECK_NUMBER (arg, 0);
 326   iarg = XINT (arg);
 327   farend = scan_words (PT, iarg);
 328   if (!farend)
 329     farend = iarg > 0 ? ZV : BEGV;
 330
 331   *newpoint = PT > farend ? PT : farend;
 332   XSETFASTINT (val, farend);
 333
 334   return val;
 335 }
 336
 337 DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
 338   "Convert following word (or ARG words) to upper case, moving over.\n\
 339 With negative argument, convert previous words but do not move.\n\
 340 See also `capitalize-word'.")
 341   (arg)
 342      Lisp_Object arg;
 343 {
 344   Lisp_Object beg, end;
 345   int newpoint;
 346   XSETFASTINT (beg, PT);
 347   end = operate_on_word (arg, &newpoint);
 348   casify_region (CASE_UP, beg, end);
 349   SET_PT (newpoint);
 350   return Qnil;
 351 }
 352
 353 DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
 354   "Convert following word (or ARG words) to lower case, moving over.\n\
 355 With negative argument, convert previous words but do not move.")
 356   (arg)
 357      Lisp_Object arg;
 358 {
 359   Lisp_Object beg, end;
 360   int newpoint;
 361   XSETFASTINT (beg, PT);
 362   end = operate_on_word (arg, &newpoint);
 363   casify_region (CASE_DOWN, beg, end);
 364   SET_PT (newpoint);
 365   return Qnil;
 366 }
 367
 368 DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
 369   "Capitalize the following word (or ARG words), moving over.\n\
 370 This gives the word(s) a first character in upper case\n\
 371 and the rest lower case.\n\
 372 With negative argument, capitalize previous words but do not move.")
 373   (arg)
 374      Lisp_Object arg;
 375 {
 376   Lisp_Object beg, end;
 377   int newpoint;
 378   XSETFASTINT (beg, PT);
 379   end = operate_on_word (arg, &newpoint);
 380   casify_region (CASE_CAPITALIZE, beg, end);
 381   SET_PT (newpoint);
 382   return Qnil;
 383 }
 384 \f
 385 syms_of_casefiddle ()
 386 {
 387   Qidentity = intern ("identity");
 388   staticpro (&Qidentity);
 389   defsubr (&Supcase);
 390   defsubr (&Sdowncase);
 391   defsubr (&Scapitalize);
 392   defsubr (&Supcase_initials);
 393   defsubr (&Supcase_region);
 394   defsubr (&Sdowncase_region);
 395   defsubr (&Scapitalize_region);
 396   defsubr (&Supcase_initials_region);
 397   defsubr (&Supcase_word);
 398   defsubr (&Sdowncase_word);
 399   defsubr (&Scapitalize_word);
 400 }
 401
 402 keys_of_casefiddle ()
 403 {
 404   initial_define_key (control_x_map, Ctl('U'), "upcase-region");
 405   Fput (intern ("upcase-region"), Qdisabled, Qt);
 406   initial_define_key (control_x_map, Ctl('L'), "downcase-region");
 407   Fput (intern ("downcase-region"), Qdisabled, Qt);
 408
 409   initial_define_key (meta_map, 'u', "upcase-word");
 410   initial_define_key (meta_map, 'l', "downcase-word");
 411   initial_define_key (meta_map, 'c', "capitalize-word");
 412 }