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