src/casefiddle.c

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