1: /* GNU Emacs case conversion functions.
    2:    Copyright (C) 1985, 1994, 1997, 1998, 1999, 2001, 2002, 2003, 2004,
    3:                  2005, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
   20: Boston, MA 02110-1301, USA.  */
   21: 
   22: 
   23: #include <config.h>
   24: #include "lisp.h"
   25: #include "buffer.h"
   26: #include "charset.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: ^L
   36: Lisp_Object
   37: casify_object (flag, obj)
   38:      enum case_action flag;
   39:      Lisp_Object obj;
   40: {
   41:   register int i, c, len;
   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:   if (INTEGERP (obj))
   49:     {
   50:       int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
   51:                       | CHAR_SHIFT | CHAR_CTL | CHAR_META);
   52:       int flags = XINT (obj) & flagbits;
   53: 
   54:       /* If the character has higher bits set
   55:          above the flags, return it unchanged.
   56:          It is not a real character.  */
   57:       if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
   58:         return obj;
   59: 
   60:       c = DOWNCASE (XFASTINT (obj) & ~flagbits);
   61:       if (inword)
   62:         XSETFASTINT (obj, c | flags);
   63:       else if (c == (XFASTINT (obj) & ~flagbits))
   64:         {
   65:           c = UPCASE1 ((XFASTINT (obj) & ~flagbits));
   66:           XSETFASTINT (obj, c | flags);
   67:         }
   68:       return obj;
   69:     }
   70: 
   71:   if (STRINGP (obj))
   72:     {
   73:       int multibyte = STRING_MULTIBYTE (obj);
   74:       int n;
   75: 
   76:       obj = Fcopy_sequence (obj);
   77:       len = SBYTES (obj);
   78: 
   79:       /* I counts bytes, and N counts chars.  */
   80:       for (i = n = 0; i < len; n++)
   81:         {
   82:           int from_len = 1, to_len = 1;
   83: 
   84:           c = SREF (obj, i);
   85: 
   86:           if (multibyte && c >= 0x80)
   87:             c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i, len -i, from_len);
   88:           if (inword && flag != CASE_CAPITALIZE_UP)
   89:             c = DOWNCASE (c);
   90:           else if (!UPPERCASEP (c)
   91:                    && (!inword || flag != CASE_CAPITALIZE_UP))
   92:             c = UPCASE1 (c);
   93:           if ((ASCII_BYTE_P (c) && from_len == 1)
   94:               || (! multibyte && SINGLE_BYTE_CHAR_P (c)))
   95:             SSET (obj, i, c);
   96:           else
   97:             {
   98:               to_len = CHAR_BYTES (c);
   99:               if (from_len == to_len)
  100:                 CHAR_STRING (c, SDATA (obj) + i);
  101:               else
  102:                 {
  103:                   Faset (obj, make_number (n), make_number (c));
  104:                   len += to_len - from_len;
  105:                 }
  106:             }
  107:           if ((int) flag >= (int) CASE_CAPITALIZE)
  108:             inword = SYNTAX (c) == Sword;
  109:           i += to_len;
  110:         }
  111:       return obj;
  112:     }
  113: 
  114:   wrong_type_argument (Qchar_or_string_p, obj);
  115: }
  116: 
  117: DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
  118:        doc: /* Convert argument to upper case and return that.
  119: The argument may be a character or string.  The result has the same type.
  120: The argument object is not altered--the value is a copy.
  121: See also `capitalize', `downcase' and `upcase-initials'.  */)
  122:      (obj)
  123:      Lisp_Object obj;
  124: {
  125:   return casify_object (CASE_UP, obj);
  126: }
  127: 
  128: DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
  129:        doc: /* Convert argument to lower case and return that.
  130: The argument may be a character or string.  The result has the same type.
  131: The argument object is not altered--the value is a copy.  */)
  132:      (obj)
  133:      Lisp_Object obj;
  134: {
  135:   return casify_object (CASE_DOWN, obj);
  136: }
  137: 
  138: DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
  139:        doc: /* Convert argument to capitalized form and return that.
  140: This means that each word's first character is upper case
  141: and the rest is lower case.
  142: The argument may be a character or string.  The result has the same type.
  143: The argument object is not altered--the value is a copy.  */)
  144:      (obj)
  145:      Lisp_Object obj;
  146: {
  147:   return casify_object (CASE_CAPITALIZE, obj);
  148: }
  149: 
  150: /* Like Fcapitalize but change only the initials.  */
  151: 
  152: DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
  153:        doc: /* Convert the initial of each word in the argument to upper case.
  154: Do not change the other letters of each word.
  155: The argument may be a character or string.  The result has the same type.
  156: The argument object is not altered--the value is a copy.  */)
  157:      (obj)
  158:      Lisp_Object obj;
  159: {
  160:   return casify_object (CASE_CAPITALIZE_UP, obj);
  161: }
  162: ^L
  163: /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
  164:    b and e specify range of buffer to operate on. */
  165: 
  166: void
  167: casify_region (flag, b, e)
  168:      enum case_action flag;
  169:      Lisp_Object b, e;
  170: {
  171:   register int i;
  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: 
  179:   if (EQ (b, e))
  180:     /* Not modifying because nothing marked */
  181:     return;
  182: 
  183:   /* If the case table is flagged as modified, rescan it.  */
  184:   if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
  185:     Fset_case_table (current_buffer->downcase_table);
  186: 
  187:   validate_region (&b, &e);
  188:   start = XFASTINT (b);
  189:   end = XFASTINT (e);
  190:   modify_region (current_buffer, start, end, 0);
  191:   record_change (start, end - start);
  192:   start_byte = CHAR_TO_BYTE (start);
  193:   end_byte = CHAR_TO_BYTE (end);
  194: 
  195:   for (i = start_byte; i < end_byte; i++, start++)
  196:     {
  197:       int c2;
  198:       c = c2 = FETCH_BYTE (i);
  199:       if (multibyte && c >= 0x80)
  200:         /* A multibyte character can't be handled in this simple loop.  */
  201:         break;
  202:       if (inword && flag != CASE_CAPITALIZE_UP)
  203:         c = DOWNCASE (c);
  204:       else if (!UPPERCASEP (c)
  205:                && (!inword || flag != CASE_CAPITALIZE_UP))
  206:         c = UPCASE1 (c);
  207:       if (multibyte && c >= 0x80)
  208:         /* A multibyte result character can't be handled in this
  209:            simple loop.  */
  210:         break;
  211:       FETCH_BYTE (i) = c;
  212:       if (c != c2)
  213:         changed = 1;
  214:       if ((int) flag >= (int) CASE_CAPITALIZE)
  215:         inword = SYNTAX (c) == Sword && (inword || !SYNTAX_PREFIX (c));
  216:     }
  217:   if (i < end_byte)
  218:     {
  219:       /* The work is not yet finished because of a multibyte character
  220:          just encountered.  */
  221:       int opoint = PT;
  222:       int opoint_byte = PT_BYTE;
  223:       int c2;
  224: 
  225:       while (start < end)
  226:         {
  227:           if ((c = FETCH_BYTE (i)) >= 0x80)
  228:             c = FETCH_MULTIBYTE_CHAR (i);
  229:           c2 = c;
  230:           if (inword && flag != CASE_CAPITALIZE_UP)
  231:             c2 = DOWNCASE (c);
  232:           else if (!UPPERCASEP (c)
  233:                    && (!inword || flag != CASE_CAPITALIZE_UP))
  234:             c2 = UPCASE1 (c);
  235:           if (c != c2)
  236:             {
  237:               int fromlen, tolen, j;
  238:               unsigned char str[MAX_MULTIBYTE_LENGTH];
  239: 
  240:               changed = 1;
  241:               /* Handle the most likely case */
  242:               if (c < 0400 && c2 < 0400)
  243:                 FETCH_BYTE (i) = c2;
  244:               else if (fromlen = CHAR_STRING (c, str),
  245:                        tolen = CHAR_STRING (c2, str),
  246:                        fromlen == tolen)
  247:                 {
  248:                   /* Length is unchanged.  */
  249:                   for (j = 0; j < tolen; ++j)
  250:                     FETCH_BYTE (i + 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, i,
  257:                                    start + 1, i + fromlen,
  258:                                    str, 1, tolen,
  259:                                    1);
  260:                   if (opoint > start)
  261:                     opoint_byte += tolen - fromlen;
  262:                 }
  263:             }
  264:           if ((int) flag >= (int) CASE_CAPITALIZE)
  265:             inword = SYNTAX (c2) == Sword;
  266:           INC_BOTH (start, i);
  267:         }
  268:       TEMP_SET_PT_BOTH (opoint, opoint_byte);
  269:     }
  270: 
  271:   start = XFASTINT (b);
  272:   if (changed)
  273:     {
  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: ^L
  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: ^L
  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) */