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 = SCHARS (obj);
  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 (SDATA (obj) + i_byte, 0, len);
  82               else
  83                 {
  84                   c = SREF (obj, i_byte);
  85                   len = 1;
  86                   MAKE_CHAR_MULTIBYTE (c);
  87                 }
  88               c1 = c;
  89               if (inword && flag != CASE_CAPITALIZE_UP)
  90                 c = DOWNCASE (c);
  91               else if (!UPPERCASEP (c)
  92                        && (!inword || flag != CASE_CAPITALIZE_UP))
  93                 c = UPCASE1 (c1);
  94               if ((int) flag >= (int) CASE_CAPITALIZE)
  95                 inword = (SYNTAX (c) == Sword);
  96               if (c != c1)
  97                 {
  98                   if (! multibyte)
  99                     {
 100                       MAKE_CHAR_UNIBYTE (c);
 101                       SSET (obj, i_byte, c);
 102                     }
 103                   else if (ASCII_CHAR_P (c1) && ASCII_CHAR_P (c))
 104                     SSET (obj, i_byte,  c);
 105                   else
 106                     {
 107                       Faset (obj, make_number (i), make_number (c));
 108                       i_byte += CHAR_BYTES (c) - len;
 109                     }
 110                 }
 111             }
 112           return obj;
 113         }
 114       obj = wrong_type_argument (Qchar_or_string_p, obj);
 115     }
 116 }
 117
 118 DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
 119        doc: /* Convert argument to upper case and return that.
 120 The argument may be a character or string.  The result has the same type.
 121 The argument object is not altered--the value is a copy.
 122 See also `capitalize', `downcase' and `upcase-initials'.  */)
 123      (obj)
 124      Lisp_Object obj;
 125 {
 126   return casify_object (CASE_UP, obj);
 127 }
 128
 129 DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
 130        doc: /* Convert argument to lower case and return that.
 131 The argument may be a character or string.  The result has the same type.
 132 The argument object is not altered--the value is a copy.  */)
 133      (obj)
 134      Lisp_Object obj;
 135 {
 136   return casify_object (CASE_DOWN, obj);
 137 }
 138
 139 DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
 140        doc: /* Convert argument to capitalized form and return that.
 141 This means that each word's first character is upper case
 142 and the rest is lower case.
 143 The argument may be a character or string.  The result has the same type.
 144 The argument object is not altered--the value is a copy.  */)
 145      (obj)
 146      Lisp_Object obj;
 147 {
 148   return casify_object (CASE_CAPITALIZE, obj);
 149 }
 150
 151 /* Like Fcapitalize but change only the initials.  */
 152
 153 DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
 154        doc: /* Convert the initial of each word in the argument to upper case.
 155 Do not change the other letters of each word.
 156 The argument may be a character or string.  The result has the same type.
 157 The argument object is not altered--the value is a copy.  */)
 158      (obj)
 159      Lisp_Object obj;
 160 {
 161   return casify_object (CASE_CAPITALIZE_UP, obj);
 162 }
 163 \f
 164 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
 165    b and e specify range of buffer to operate on. */
 166
 167 void
 168 casify_region (flag, b, e)
 169      enum case_action flag;
 170      Lisp_Object b, e;
 171 {
 172   register int c;
 173   register int inword = flag == CASE_DOWN;
 174   register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
 175   int start, end;
 176   int start_byte, end_byte;
 177   int changed = 0;
 178   int opoint = PT;
 179   int opoint_byte = PT_BYTE;
 180
 181   if (EQ (b, e))
 182     /* Not modifying because nothing marked */
 183     return;
 184
 185   /* If the case table is flagged as modified, rescan it.  */
 186   if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
 187     Fset_case_table (current_buffer->downcase_table);
 188
 189   validate_region (&b, &e);
 190   start = XFASTINT (b);
 191   end = XFASTINT (e);
 192   modify_region (current_buffer, start, end);
 193   record_change (start, end - start);
 194   start_byte = CHAR_TO_BYTE (start);
 195   end_byte = CHAR_TO_BYTE (end);
 196
 197   while (start < end)
 198     {
 199       int c2, len;
 200
 201       if (multibyte)
 202         {
 203           c = FETCH_MULTIBYTE_CHAR (start_byte);
 204           len = CHAR_BYTES (c);
 205         }
 206       else
 207         {
 208           c = FETCH_BYTE (start_byte);
 209           MAKE_CHAR_MULTIBYTE (c);
 210           len = 1;
 211         }
 212       c2 = c;
 213       if (inword && flag != CASE_CAPITALIZE_UP)
 214         c = DOWNCASE (c);
 215       else if (!UPPERCASEP (c)
 216                && (!inword || flag != CASE_CAPITALIZE_UP))
 217         c = UPCASE1 (c);
 218       if ((int) flag >= (int) CASE_CAPITALIZE)
 219         inword = ((SYNTAX (c) == Sword) && (inword || !SYNTAX_PREFIX (c)));
 220       if (c != c2)
 221         {
 222           changed = 1;
 223           if (! multibyte)
 224             {
 225               MAKE_CHAR_UNIBYTE (c);
 226               FETCH_BYTE (start_byte) = c;
 227             }
 228           else if (ASCII_CHAR_P (c2) && ASCII_CHAR_P (c))
 229             FETCH_BYTE (start_byte) = c;
 230           else if (len == CHAR_BYTES (c))
 231             {
 232               int j;
 233               unsigned char str[MAX_MULTIBYTE_LENGTH];
 234
 235               CHAR_STRING (c, str);
 236               for (j = 0; j < len; ++j)
 237                 FETCH_BYTE (start_byte + j) = str[j];
 238             }
 239           else
 240             {
 241               TEMP_SET_PT_BOTH (start, start_byte);
 242               del_range_2 (start, start_byte, start + 1, start_byte + len, 0);
 243               insert_char (c);
 244               len = CHAR_BYTES (c);
 245             }
 246         }
 247       start++;
 248       start_byte += len;
 249     }
 250
 251   if (PT != opoint)
 252     TEMP_SET_PT_BOTH (opoint, opoint_byte);
 253
 254   if (changed)
 255     {
 256       start = XFASTINT (b);
 257       signal_after_change (start, end - start, end - start);
 258       update_compositions (start, end, CHECK_ALL);
 259     }
 260 }
 261
 262 DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
 263        doc: /* Convert the region to upper case.  In programs, wants two arguments.
 264 These arguments specify the starting and ending character numbers of
 265 the region to operate on.  When used as a command, the text between
 266 point and the mark is operated on.
 267 See also `capitalize-region'.  */)
 268      (beg, end)
 269      Lisp_Object beg, end;
 270 {
 271   casify_region (CASE_UP, beg, end);
 272   return Qnil;
 273 }
 274
 275 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
 276        doc: /* Convert the region to lower case.  In programs, wants two arguments.
 277 These arguments specify the starting and ending character numbers of
 278 the region to operate on.  When used as a command, the text between
 279 point and the mark is operated on.  */)
 280      (beg, end)
 281      Lisp_Object beg, end;
 282 {
 283   casify_region (CASE_DOWN, beg, end);
 284   return Qnil;
 285 }
 286
 287 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
 288        doc: /* Convert the region to capitalized form.
 289 Capitalized form means each word's first character is upper case
 290 and the rest of it is lower case.
 291 In programs, give two arguments, the starting and ending
 292 character positions to operate on.  */)
 293      (beg, end)
 294      Lisp_Object beg, end;
 295 {
 296   casify_region (CASE_CAPITALIZE, beg, end);
 297   return Qnil;
 298 }
 299
 300 /* Like Fcapitalize_region but change only the initials.  */
 301
 302 DEFUN ("upcase-initials-region", Fupcase_initials_region,
 303        Supcase_initials_region, 2, 2, "r",
 304        doc: /* Upcase the initial of each word in the region.
 305 Subsequent letters of each word are not changed.
 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_UP, beg, end);
 312   return Qnil;
 313 }
 314 \f
 315 Lisp_Object
 316 operate_on_word (arg, newpoint)
 317      Lisp_Object arg;
 318      int *newpoint;
 319 {
 320   Lisp_Object val;
 321   int farend;
 322   int iarg;
 323
 324   CHECK_NUMBER (arg);
 325   iarg = XINT (arg);
 326   farend = scan_words (PT, iarg);
 327   if (!farend)
 328     farend = iarg > 0 ? ZV : BEGV;
 329
 330   *newpoint = PT > farend ? PT : farend;
 331   XSETFASTINT (val, farend);
 332
 333   return val;
 334 }
 335
 336 DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
 337        doc: /* Convert following word (or ARG words) to upper case, moving over.
 338 With negative argument, convert previous words but do not move.
 339 See also `capitalize-word'.  */)
 340      (arg)
 341      Lisp_Object arg;
 342 {
 343   Lisp_Object beg, end;
 344   int newpoint;
 345   XSETFASTINT (beg, PT);
 346   end = operate_on_word (arg, &newpoint);
 347   casify_region (CASE_UP, beg, end);
 348   SET_PT (newpoint);
 349   return Qnil;
 350 }
 351
 352 DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
 353        doc: /* Convert following word (or ARG words) to lower case, moving over.
 354 With negative argument, convert previous words but do not move.  */)
 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_DOWN, beg, end);
 363   SET_PT (newpoint);
 364   return Qnil;
 365 }
 366
 367 DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
 368        doc: /* Capitalize the following word (or ARG words), moving over.
 369 This gives the word(s) a first character in upper case
 370 and the rest lower case.
 371 With negative argument, capitalize 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_CAPITALIZE, beg, end);
 380   SET_PT (newpoint);
 381   return Qnil;
 382 }
 383 \f
 384 void
 385 syms_of_casefiddle ()
 386 {
 387   Qidentity = intern ("identity");
 388   staticpro (&Qidentity);
 389   defsubr (&Supcase);
 390   defsubr (&Sdowncase);
 391   defsubr (&Scapitalize);
 392   defsubr (&Supcase_initials);
 393   defsubr (&Supcase_region);
 394   defsubr (&Sdowncase_region);
 395   defsubr (&Scapitalize_region);
 396   defsubr (&Supcase_initials_region);
 397   defsubr (&Supcase_word);
 398   defsubr (&Sdowncase_word);
 399   defsubr (&Scapitalize_word);
 400 }
 401
 402 void
 403 keys_of_casefiddle ()
 404 {
 405   initial_define_key (control_x_map, Ctl('U'), "upcase-region");
 406   Fput (intern ("upcase-region"), Qdisabled, Qt);
 407   initial_define_key (control_x_map, Ctl('L'), "downcase-region");
 408   Fput (intern ("downcase-region"), Qdisabled, Qt);
 409
 410   initial_define_key (meta_map, 'u', "upcase-word");
 411   initial_define_key (meta_map, 'l', "downcase-word");
 412   initial_define_key (meta_map, 'c', "capitalize-word");
 413 }
 414
 415 /* arch-tag: 60a73c66-5489-47e7-a81f-cead4057c526
 416    (do not change this comment) */