src/casefiddle.c

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