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