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 if (len == CHAR_BYTES (c))
 240             {
 241               int j;
 242               unsigned char str[MAX_MULTIBYTE_LENGTH];
 243
 244               CHAR_STRING (c, str);
 245               for (j = 0; j < len; ++j)
 246                 FETCH_BYTE (start_byte + j) = str[j];
 247             }
 248           else
 249             {
 250               TEMP_SET_PT_BOTH (start, start_byte);
 251               del_range_2 (start, start_byte, start + 1, start_byte + len, 0);
 252               insert_char (c);
 253               len = CHAR_BYTES (c);
 254             }
 255         }
 256       start++;
 257       start_byte += len;
 258     }
 259
 260   if (PT != opoint)
 261     TEMP_SET_PT_BOTH (opoint, opoint_byte);
 262
 263   if (changed)
 264     {
 265       start = XFASTINT (b);
 266       signal_after_change (start, end - start, end - start);
 267       update_compositions (start, end, CHECK_ALL);
 268     }
 269 }
 270
 271 DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
 272        doc: /* Convert the region to upper case.  In programs, wants two arguments.
 273 These arguments specify the starting and ending character numbers of
 274 the region to operate on.  When used as a command, the text between
 275 point and the mark is operated on.
 276 See also `capitalize-region'.  */)
 277      (beg, end)
 278      Lisp_Object beg, end;
 279 {
 280   casify_region (CASE_UP, beg, end);
 281   return Qnil;
 282 }
 283
 284 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
 285        doc: /* Convert the region to lower case.  In programs, wants two arguments.
 286 These arguments specify the starting and ending character numbers of
 287 the region to operate on.  When used as a command, the text between
 288 point and the mark is operated on.  */)
 289      (beg, end)
 290      Lisp_Object beg, end;
 291 {
 292   casify_region (CASE_DOWN, beg, end);
 293   return Qnil;
 294 }
 295
 296 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
 297        doc: /* Convert the region to capitalized form.
 298 Capitalized form means each word's first character is upper case
 299 and the rest of it is lower case.
 300 In programs, give two arguments, the starting and ending
 301 character positions to operate on.  */)
 302      (beg, end)
 303      Lisp_Object beg, end;
 304 {
 305   casify_region (CASE_CAPITALIZE, beg, end);
 306   return Qnil;
 307 }
 308
 309 /* Like Fcapitalize_region but change only the initials.  */
 310
 311 DEFUN ("upcase-initials-region", Fupcase_initials_region,
 312        Supcase_initials_region, 2, 2, "r",
 313        doc: /* Upcase the initial of each word in the region.
 314 Subsequent letters of each word are not changed.
 315 In programs, give two arguments, the starting and ending
 316 character positions to operate on.  */)
 317      (beg, end)
 318      Lisp_Object beg, end;
 319 {
 320   casify_region (CASE_CAPITALIZE_UP, beg, end);
 321   return Qnil;
 322 }
 323 \f
 324 Lisp_Object
 325 operate_on_word (arg, newpoint)
 326      Lisp_Object arg;
 327      int *newpoint;
 328 {
 329   Lisp_Object val;
 330   int farend;
 331   int iarg;
 332
 333   CHECK_NUMBER (arg);
 334   iarg = XINT (arg);
 335   farend = scan_words (PT, iarg);
 336   if (!farend)
 337     farend = iarg > 0 ? ZV : BEGV;
 338
 339   *newpoint = PT > farend ? PT : farend;
 340   XSETFASTINT (val, farend);
 341
 342   return val;
 343 }
 344
 345 DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
 346        doc: /* Convert following word (or ARG words) to upper case, moving over.
 347 With negative argument, convert previous words but do not move.
 348 See also `capitalize-word'.  */)
 349      (arg)
 350      Lisp_Object arg;
 351 {
 352   Lisp_Object beg, end;
 353   int newpoint;
 354   XSETFASTINT (beg, PT);
 355   end = operate_on_word (arg, &newpoint);
 356   casify_region (CASE_UP, beg, end);
 357   SET_PT (newpoint);
 358   return Qnil;
 359 }
 360
 361 DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
 362        doc: /* Convert following word (or ARG words) to lower case, moving over.
 363 With negative argument, convert previous words but do not move.  */)
 364      (arg)
 365      Lisp_Object arg;
 366 {
 367   Lisp_Object beg, end;
 368   int newpoint;
 369   XSETFASTINT (beg, PT);
 370   end = operate_on_word (arg, &newpoint);
 371   casify_region (CASE_DOWN, beg, end);
 372   SET_PT (newpoint);
 373   return Qnil;
 374 }
 375
 376 DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
 377        doc: /* Capitalize the following word (or ARG words), moving over.
 378 This gives the word(s) a first character in upper case
 379 and the rest lower case.
 380 With negative argument, capitalize previous words but do not move.  */)
 381      (arg)
 382      Lisp_Object arg;
 383 {
 384   Lisp_Object beg, end;
 385   int newpoint;
 386   XSETFASTINT (beg, PT);
 387   end = operate_on_word (arg, &newpoint);
 388   casify_region (CASE_CAPITALIZE, beg, end);
 389   SET_PT (newpoint);
 390   return Qnil;
 391 }
 392 \f
 393 void
 394 syms_of_casefiddle ()
 395 {
 396   Qidentity = intern ("identity");
 397   staticpro (&Qidentity);
 398   defsubr (&Supcase);
 399   defsubr (&Sdowncase);
 400   defsubr (&Scapitalize);
 401   defsubr (&Supcase_initials);
 402   defsubr (&Supcase_region);
 403   defsubr (&Sdowncase_region);
 404   defsubr (&Scapitalize_region);
 405   defsubr (&Supcase_initials_region);
 406   defsubr (&Supcase_word);
 407   defsubr (&Sdowncase_word);
 408   defsubr (&Scapitalize_word);
 409 }
 410
 411 void
 412 keys_of_casefiddle ()
 413 {
 414   initial_define_key (control_x_map, Ctl('U'), "upcase-region");
 415   Fput (intern ("upcase-region"), Qdisabled, Qt);
 416   initial_define_key (control_x_map, Ctl('L'), "downcase-region");
 417   Fput (intern ("downcase-region"), Qdisabled, Qt);
 418
 419   initial_define_key (meta_map, 'u', "upcase-word");
 420   initial_define_key (meta_map, 'l', "downcase-word");
 421   initial_define_key (meta_map, 'c', "capitalize-word");
 422 }
 423
 424 /* arch-tag: 60a73c66-5489-47e7-a81f-cead4057c526
 425    (do not change this comment) */