code.delx.au - gnu-emacs/blob - src/casefiddle.c

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