code.delx.au - gnu-emacs/blob - 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 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., 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   int start, end;
 183   int start_byte, end_byte;
 184   int changed = 0;
 185   int opoint = PT;
 186   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           changed = 1;
 230           if (! multibyte)
 231             {
 232               MAKE_CHAR_UNIBYTE (c);
 233               FETCH_BYTE (start_byte) = c;
 234             }
 235           else if (ASCII_CHAR_P (c2) && ASCII_CHAR_P (c))
 236             FETCH_BYTE (start_byte) = c;
 237           else
 238             {
 239               int tolen = CHAR_BYTES (c);
 240               int j;
 241               unsigned char str[MAX_MULTIBYTE_LENGTH];
 242
 243               CHAR_STRING (c, str);
 244               if (len == tolen)
 245                 {
 246                   /* Length is unchanged.  */
 247                   for (j = 0; j < len; ++j)
 248                     FETCH_BYTE (start_byte + 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, start_byte,
 255                                    start + 1, start_byte + len,
 256                                    str, 1, tolen,
 257                                    0);
 258                   len = tolen;
 259                 }
 260             }
 261         }
 262       start++;
 263       start_byte += len;
 264     }
 265
 266   if (PT != opoint)
 267     TEMP_SET_PT_BOTH (opoint, opoint_byte);
 268
 269   if (changed)
 270     {
 271       start = XFASTINT (b);
 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) */