src/casefiddle.c

   1 /* GNU Emacs case conversion functions.
   2    Copyright (C) 1985, 1994, 1997, 1998, 1999, 2001, 2002, 2003, 2004,
   3                  2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 3, or (at your option)
  10 any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 Boston, MA 02110-1301, USA.  */
  21
  22
  23 #include <config.h>
  24 #include "lisp.h"
  25 #include "buffer.h"
  26 #include "character.h"
  27 #include "commands.h"
  28 #include "syntax.h"
  29 #include "composite.h"
  30 #include "keymap.h"
  31
  32 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
  33
  34 Lisp_Object Qidentity;
  35 \f
  36 Lisp_Object
  37 casify_object (flag, obj)
  38      enum case_action flag;
  39      Lisp_Object obj;
  40 {
  41   register int c, c1;
  42   register int inword = flag == CASE_DOWN;
  43
  44   /* If the case table is flagged as modified, rescan it.  */
  45   if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
  46     Fset_case_table (current_buffer->downcase_table);
  47
  48   if (INTEGERP (obj))
  49     {
  50       int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
  51                       | CHAR_SHIFT | CHAR_CTL | CHAR_META);
  52       int flags = XINT (obj) & flagbits;
  53       int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
  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       c1 = XFASTINT (obj) & ~flagbits;
  62       if (! multibyte)
  63         MAKE_CHAR_MULTIBYTE (c1);
  64       c = DOWNCASE (c1);
  65       if (inword)
  66         XSETFASTINT (obj, c | flags);
  67       else if (c == (XFASTINT (obj) & ~flagbits))
  68         {
  69           if (! inword)
  70             c = UPCASE1 (c1);
  71           if (! multibyte)
  72             MAKE_CHAR_UNIBYTE (c);
  73           XSETFASTINT (obj, c | flags);
  74         }
  75       return obj;
  76     }
  77
  78   if (STRINGP (obj))
  79     {
  80       int multibyte = STRING_MULTIBYTE (obj);
  81       int i, i_byte, len;
  82       int size = SCHARS (obj);
  83
  84       obj = Fcopy_sequence (obj);
  85       for (i = i_byte = 0; i < size; i++, i_byte += len)
  86         {
  87           if (multibyte)
  88             c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, 0, len);
  89           else
  90             {
  91               c = SREF (obj, i_byte);
  92               len = 1;
  93               MAKE_CHAR_MULTIBYTE (c);
  94             }
  95           c1 = c;
  96           if (inword && flag != CASE_CAPITALIZE_UP)
  97             c = DOWNCASE (c);
  98           else if (!UPPERCASEP (c)
  99                    && (!inword || flag != CASE_CAPITALIZE_UP))
 100             c = UPCASE1 (c1);
 101           if ((int) flag >= (int) CASE_CAPITALIZE)
 102             inword = (SYNTAX (c) == Sword);
 103           if (c != c1)
 104             {
 105               if (! multibyte)
 106                 {
 107                   MAKE_CHAR_UNIBYTE (c);
 108                   SSET (obj, i_byte, c);
 109                 }
 110               else if (ASCII_CHAR_P (c1) && ASCII_CHAR_P (c))
 111                 SSET (obj, i_byte,  c);
 112               else
 113                 {
 114                   Faset (obj, make_number (i), make_number (c));
 115                   i_byte += CHAR_BYTES (c) - len;
 116                 }
 117             }
 118         }
 119       return obj;
 120     }
 121
 122   wrong_type_argument (Qchar_or_string_p, obj);
 123 }
 124
 125 DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
 126        doc: /* Convert argument to upper case and return that.
 127 The argument may be a character or string.  The result has the same type.
 128 The argument object is not altered--the value is a copy.
 129 See also `capitalize', `downcase' and `upcase-initials'.  */)
 130      (obj)
 131      Lisp_Object obj;
 132 {
 133   return casify_object (CASE_UP, obj);
 134 }
 135
 136 DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
 137        doc: /* Convert argument to lower case and return that.
 138 The argument may be a character or string.  The result has the same type.
 139 The argument object is not altered--the value is a copy.  */)
 140      (obj)
 141      Lisp_Object obj;
 142 {
 143   return casify_object (CASE_DOWN, obj);
 144 }
 145
 146 DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
 147        doc: /* Convert argument to capitalized form and return that.
 148 This means that each word's first character is upper case
 149 and the rest is lower case.
 150 The argument may be a character or string.  The result has the same type.
 151 The argument object is not altered--the value is a copy.  */)
 152      (obj)
 153      Lisp_Object obj;
 154 {
 155   return casify_object (CASE_CAPITALIZE, obj);
 156 }
 157
 158 /* Like Fcapitalize but change only the initials.  */
 159
 160 DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
 161        doc: /* Convert the initial of each word in the argument to upper case.
 162 Do not change the other letters of each word.
 163 The argument may be a character or string.  The result has the same type.
 164 The argument object is not altered--the value is a copy.  */)
 165      (obj)
 166      Lisp_Object obj;
 167 {
 168   return casify_object (CASE_CAPITALIZE_UP, obj);
 169 }
 170 \f
 171 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
 172    b and e specify range of buffer to operate on. */
 173
 174 void
 175 casify_region (flag, b, e)
 176      enum case_action flag;
 177      Lisp_Object b, e;
 178 {
 179   register int c;
 180   register int inword = flag == CASE_DOWN;
 181   register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
 182   EMACS_INT start, end;
 183   EMACS_INT start_byte, end_byte;
 184   EMACS_INT first = -1, last;   /* Position of first and last changes.  */
 185   EMACS_INT opoint = PT;
 186   EMACS_INT opoint_byte = PT_BYTE;
 187
 188   if (EQ (b, e))
 189     /* Not modifying because nothing marked */
 190     return;
 191
 192   /* If the case table is flagged as modified, rescan it.  */
 193   if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
 194     Fset_case_table (current_buffer->downcase_table);
 195
 196   validate_region (&b, &e);
 197   start = XFASTINT (b);
 198   end = XFASTINT (e);
 199   modify_region (current_buffer, start, end, 0);
 200   record_change (start, end - start);
 201   start_byte = CHAR_TO_BYTE (start);
 202   end_byte = CHAR_TO_BYTE (end);
 203
 204   while (start < end)
 205     {
 206       int c2, len;
 207
 208       if (multibyte)
 209         {
 210           c = FETCH_MULTIBYTE_CHAR (start_byte);
 211           len = CHAR_BYTES (c);
 212         }
 213       else
 214         {
 215           c = FETCH_BYTE (start_byte);
 216           MAKE_CHAR_MULTIBYTE (c);
 217           len = 1;
 218         }
 219       c2 = c;
 220       if (inword && flag != CASE_CAPITALIZE_UP)
 221         c = DOWNCASE (c);
 222       else if (!UPPERCASEP (c)
 223                && (!inword || flag != CASE_CAPITALIZE_UP))
 224         c = UPCASE1 (c);
 225       if ((int) flag >= (int) CASE_CAPITALIZE)
 226         inword = ((SYNTAX (c) == Sword) && (inword || !SYNTAX_PREFIX (c)));
 227       if (c != c2)
 228         {
 229           last = start;
 230           if (first < 0)
 231             first = start;
 232
 233           if (! multibyte)
 234             {
 235               MAKE_CHAR_UNIBYTE (c);
 236               FETCH_BYTE (start_byte) = c;
 237             }
 238           else if (ASCII_CHAR_P (c2) && ASCII_CHAR_P (c))
 239             FETCH_BYTE (start_byte) = c;
 240           else
 241             {
 242               int tolen = CHAR_BYTES (c);
 243               int j;
 244               unsigned char str[MAX_MULTIBYTE_LENGTH];
 245
 246               CHAR_STRING (c, str);
 247               if (len == tolen)
 248                 {
 249                   /* Length is unchanged.  */
 250                   for (j = 0; j < len; ++j)
 251                     FETCH_BYTE (start_byte + j) = str[j];
 252                 }
 253               else
 254                 {
 255                   /* Replace one character with the other,
 256                      keeping text properties the same.  */
 257                   replace_range_2 (start, start_byte,
 258                                    start + 1, start_byte + len,
 259                                    str, 1, tolen,
 260                                    0);
 261                   len = tolen;
 262                 }
 263             }
 264         }
 265       start++;
 266       start_byte += len;
 267     }
 268
 269   if (PT != opoint)
 270     TEMP_SET_PT_BOTH (opoint, opoint_byte);
 271
 272   if (first >= 0)
 273     {
 274       signal_after_change (first, last + 1 - first, last + 1 - first);
 275       update_compositions (first, last + 1, CHECK_ALL);
 276     }
 277 }
 278
 279 DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
 280        doc: /* Convert the region to upper case.  In programs, wants two arguments.
 281 These arguments specify the starting and ending character numbers of
 282 the region to operate on.  When used as a command, the text between
 283 point and the mark is operated on.
 284 See also `capitalize-region'.  */)
 285      (beg, end)
 286      Lisp_Object beg, end;
 287 {
 288   casify_region (CASE_UP, beg, end);
 289   return Qnil;
 290 }
 291
 292 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
 293        doc: /* Convert the region to lower case.  In programs, wants two arguments.
 294 These arguments specify the starting and ending character numbers of
 295 the region to operate on.  When used as a command, the text between
 296 point and the mark is operated on.  */)
 297      (beg, end)
 298      Lisp_Object beg, end;
 299 {
 300   casify_region (CASE_DOWN, beg, end);
 301   return Qnil;
 302 }
 303
 304 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
 305        doc: /* Convert the region to capitalized form.
 306 Capitalized form means each word's first character is upper case
 307 and the rest of it is lower case.
 308 In programs, give two arguments, the starting and ending
 309 character positions to operate on.  */)
 310      (beg, end)
 311      Lisp_Object beg, end;
 312 {
 313   casify_region (CASE_CAPITALIZE, beg, end);
 314   return Qnil;
 315 }
 316
 317 /* Like Fcapitalize_region but change only the initials.  */
 318
 319 DEFUN ("upcase-initials-region", Fupcase_initials_region,
 320        Supcase_initials_region, 2, 2, "r",
 321        doc: /* Upcase the initial of each word in the region.
 322 Subsequent letters of each word are not changed.
 323 In programs, give two arguments, the starting and ending
 324 character positions to operate on.  */)
 325      (beg, end)
 326      Lisp_Object beg, end;
 327 {
 328   casify_region (CASE_CAPITALIZE_UP, beg, end);
 329   return Qnil;
 330 }
 331 \f
 332 Lisp_Object
 333 operate_on_word (arg, newpoint)
 334      Lisp_Object arg;
 335      int *newpoint;
 336 {
 337   Lisp_Object val;
 338   int farend;
 339   int iarg;
 340
 341   CHECK_NUMBER (arg);
 342   iarg = XINT (arg);
 343   farend = scan_words (PT, iarg);
 344   if (!farend)
 345     farend = iarg > 0 ? ZV : BEGV;
 346
 347   *newpoint = PT > farend ? PT : farend;
 348   XSETFASTINT (val, farend);
 349
 350   return val;
 351 }
 352
 353 DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
 354        doc: /* Convert following word (or ARG words) to upper case, moving over.
 355 With negative argument, convert previous words but do not move.
 356 See also `capitalize-word'.  */)
 357      (arg)
 358      Lisp_Object arg;
 359 {
 360   Lisp_Object beg, end;
 361   int newpoint;
 362   XSETFASTINT (beg, PT);
 363   end = operate_on_word (arg, &newpoint);
 364   casify_region (CASE_UP, beg, end);
 365   SET_PT (newpoint);
 366   return Qnil;
 367 }
 368
 369 DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
 370        doc: /* Convert following word (or ARG words) to lower case, moving over.
 371 With negative argument, convert previous words but do not move.  */)
 372      (arg)
 373      Lisp_Object arg;
 374 {
 375   Lisp_Object beg, end;
 376   int newpoint;
 377   XSETFASTINT (beg, PT);
 378   end = operate_on_word (arg, &newpoint);
 379   casify_region (CASE_DOWN, beg, end);
 380   SET_PT (newpoint);
 381   return Qnil;
 382 }
 383
 384 DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
 385        doc: /* Capitalize the following word (or ARG words), moving over.
 386 This gives the word(s) a first character in upper case
 387 and the rest lower case.
 388 With negative argument, capitalize previous words but do not move.  */)
 389      (arg)
 390      Lisp_Object arg;
 391 {
 392   Lisp_Object beg, end;
 393   int newpoint;
 394   XSETFASTINT (beg, PT);
 395   end = operate_on_word (arg, &newpoint);
 396   casify_region (CASE_CAPITALIZE, beg, end);
 397   SET_PT (newpoint);
 398   return Qnil;
 399 }
 400 \f
 401 void
 402 syms_of_casefiddle ()
 403 {
 404   Qidentity = intern ("identity");
 405   staticpro (&Qidentity);
 406   defsubr (&Supcase);
 407   defsubr (&Sdowncase);
 408   defsubr (&Scapitalize);
 409   defsubr (&Supcase_initials);
 410   defsubr (&Supcase_region);
 411   defsubr (&Sdowncase_region);
 412   defsubr (&Scapitalize_region);
 413   defsubr (&Supcase_initials_region);
 414   defsubr (&Supcase_word);
 415   defsubr (&Sdowncase_word);
 416   defsubr (&Scapitalize_word);
 417 }
 418
 419 void
 420 keys_of_casefiddle ()
 421 {
 422   initial_define_key (control_x_map, Ctl('U'), "upcase-region");
 423   Fput (intern ("upcase-region"), Qdisabled, Qt);
 424   initial_define_key (control_x_map, Ctl('L'), "downcase-region");
 425   Fput (intern ("downcase-region"), Qdisabled, Qt);
 426
 427   initial_define_key (meta_map, 'u', "upcase-word");
 428   initial_define_key (meta_map, 'l', "downcase-word");
 429   initial_define_key (meta_map, 'c', "capitalize-word");
 430 }
 431
 432 /* arch-tag: 60a73c66-5489-47e7-a81f-cead4057c526
 433    (do not change this comment) */