src/casefiddle.c

   1 /* GNU Emacs case conversion functions.
   2    Copyright (C) 1985,94,97,98,99, 2001, 2002, 2004
   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 "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   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           int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
  56
  57           /* If the character has higher bits set
  58              above the flags, return it unchanged.
  59              It is not a real character.  */
  60           if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
  61             return obj;
  62
  63           c1 = XFASTINT (obj) & ~flagbits;
  64           if (! multibyte)
  65             MAKE_CHAR_MULTIBYTE (c1);
  66           c = DOWNCASE (c1);
  67           if (inword)
  68             XSETFASTINT (obj, c | flags);
  69           else if (c == (XFASTINT (obj) & ~flagbits))
  70             {
  71               if (! inword)
  72                 c = UPCASE1 (c1);
  73               if (! multibyte)
  74                 MAKE_CHAR_UNIBYTE (c);
  75               XSETFASTINT (obj, c | flags);
  76             }
  77           return obj;
  78         }
  79
  80       if (STRINGP (obj))
  81         {
  82           int multibyte = STRING_MULTIBYTE (obj);
  83           int i, i_byte, len;
  84           int size = SCHARS (obj);
  85
  86           obj = Fcopy_sequence (obj);
  87           for (i = i_byte = 0; i < size; i++, i_byte += len)
  88             {
  89               if (multibyte)
  90                 c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, 0, len);
  91               else
  92                 {
  93                   c = SREF (obj, i_byte);
  94                   len = 1;
  95                   MAKE_CHAR_MULTIBYTE (c);
  96                 }
  97               c1 = c;
  98               if (inword && flag != CASE_CAPITALIZE_UP)
  99                 c = DOWNCASE (c);
 100               else if (!UPPERCASEP (c)
 101                        && (!inword || flag != CASE_CAPITALIZE_UP))
 102                 c = UPCASE1 (c1);
 103               if ((int) flag >= (int) CASE_CAPITALIZE)
 104                 inword = (SYNTAX (c) == Sword);
 105               if (c != c1)
 106                 {
 107                   if (! multibyte)
 108                     {
 109                       MAKE_CHAR_UNIBYTE (c);
 110                       SSET (obj, i_byte, c);
 111                     }
 112                   else if (ASCII_CHAR_P (c1) && ASCII_CHAR_P (c))
 113                     SSET (obj, i_byte,  c);
 114                   else
 115                     {
 116                       Faset (obj, make_number (i), make_number (c));
 117                       i_byte += CHAR_BYTES (c) - len;
 118                     }
 119                 }
 120             }
 121           return obj;
 122         }
 123       obj = wrong_type_argument (Qchar_or_string_p, obj);
 124     }
 125 }
 126
 127 DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
 128        doc: /* Convert argument to upper case and return that.
 129 The argument may be a character or string.  The result has the same type.
 130 The argument object is not altered--the value is a copy.
 131 See also `capitalize', `downcase' and `upcase-initials'.  */)
 132      (obj)
 133      Lisp_Object obj;
 134 {
 135   return casify_object (CASE_UP, obj);
 136 }
 137
 138 DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
 139        doc: /* Convert argument to lower case and return that.
 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_DOWN, obj);
 146 }
 147
 148 DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
 149        doc: /* Convert argument to capitalized form and return that.
 150 This means that each word's first character is upper case
 151 and the rest is lower case.
 152 The argument may be a character or string.  The result has the same type.
 153 The argument object is not altered--the value is a copy.  */)
 154      (obj)
 155      Lisp_Object obj;
 156 {
 157   return casify_object (CASE_CAPITALIZE, obj);
 158 }
 159
 160 /* Like Fcapitalize but change only the initials.  */
 161
 162 DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
 163        doc: /* Convert the initial of each word in the argument to upper case.
 164 Do not change the other letters of each word.
 165 The argument may be a character or string.  The result has the same type.
 166 The argument object is not altered--the value is a copy.  */)
 167      (obj)
 168      Lisp_Object obj;
 169 {
 170   return casify_object (CASE_CAPITALIZE_UP, obj);
 171 }
 172 \f
 173 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
 174    b and e specify range of buffer to operate on. */
 175
 176 void
 177 casify_region (flag, b, e)
 178      enum case_action flag;
 179      Lisp_Object b, e;
 180 {
 181   register int c;
 182   register int inword = flag == CASE_DOWN;
 183   register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
 184   int start, end;
 185   int start_byte, end_byte;
 186   int changed = 0;
 187   int opoint = PT;
 188   int opoint_byte = PT_BYTE;
 189
 190   if (EQ (b, e))
 191     /* Not modifying because nothing marked */
 192     return;
 193
 194   /* If the case table is flagged as modified, rescan it.  */
 195   if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
 196     Fset_case_table (current_buffer->downcase_table);
 197
 198   validate_region (&b, &e);
 199   start = XFASTINT (b);
 200   end = XFASTINT (e);
 201   modify_region (current_buffer, start, end);
 202   record_change (start, end - start);
 203   start_byte = CHAR_TO_BYTE (start);
 204   end_byte = CHAR_TO_BYTE (end);
 205
 206   while (start < end)
 207     {
 208       int c2, len;
 209
 210       if (multibyte)
 211         {
 212           c = FETCH_MULTIBYTE_CHAR (start_byte);
 213           len = CHAR_BYTES (c);
 214         }
 215       else
 216         {
 217           c = FETCH_BYTE (start_byte);
 218           MAKE_CHAR_MULTIBYTE (c);
 219           len = 1;
 220         }
 221       c2 = c;
 222       if (inword && flag != CASE_CAPITALIZE_UP)
 223         c = DOWNCASE (c);
 224       else if (!UPPERCASEP (c)
 225                && (!inword || flag != CASE_CAPITALIZE_UP))
 226         c = UPCASE1 (c);
 227       if ((int) flag >= (int) CASE_CAPITALIZE)
 228         inword = ((SYNTAX (c) == Sword) && (inword || !SYNTAX_PREFIX (c)));
 229       if (c != c2)
 230         {
 231           changed = 1;
 232           if (! multibyte)
 233             {
 234               MAKE_CHAR_UNIBYTE (c);
 235               FETCH_BYTE (start_byte) = c;
 236             }
 237           else if (ASCII_CHAR_P (c2) && ASCII_CHAR_P (c))
 238             FETCH_BYTE (start_byte) = c;
 239           else
 240             {
 241               int tolen = CHAR_BYTES (c);
 242               int j;
 243               unsigned char str[MAX_MULTIBYTE_LENGTH];
 244
 245               CHAR_STRING (c, str);
 246               if (len == tolen)
 247                 {
 248                   /* Length is unchanged.  */
 249                   for (j = 0; j < len; ++j)
 250                     FETCH_BYTE (start_byte + j) = str[j];
 251                 }
 252               else
 253                 {
 254                   /* Replace one character with the other,
 255                      keeping text properties the same.  */
 256                   replace_range_2 (start, start_byte,
 257                                    start + 1, start_byte + len,
 258                                    str, 1, tolen,
 259                                    0);
 260                   len = tolen;
 261                 }
 262             }
 263         }
 264       start++;
 265       start_byte += len;
 266     }
 267
 268   if (PT != opoint)
 269     TEMP_SET_PT_BOTH (opoint, opoint_byte);
 270
 271   if (changed)
 272     {
 273       start = XFASTINT (b);
 274       signal_after_change (start, end - start, end - start);
 275       update_compositions (start, end, 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) */