casefiddle.c 13 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* GNU Emacs case conversion functions.
Kim F. Storm's avatar
Kim F. Storm committed
2 3
   Copyright (C) 1985,94,97,98,99, 2001, 2002, 2004
   Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6 7 8

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Karl Heuer's avatar
Karl Heuer committed
9
the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
10 11 12 13 14 15 16 17 18
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
19 20
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Jim Blandy's avatar
Jim Blandy committed
21 22


23
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
24 25
#include "lisp.h"
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
26
#include "charset.h"
Jim Blandy's avatar
Jim Blandy committed
27 28
#include "commands.h"
#include "syntax.h"
Kenichi Handa's avatar
Kenichi Handa committed
29
#include "composite.h"
Stefan Monnier's avatar
Stefan Monnier committed
30
#include "keymap.h"
Jim Blandy's avatar
Jim Blandy committed
31 32

enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
Karl Heuer's avatar
Karl Heuer committed
33 34

Lisp_Object Qidentity;
Jim Blandy's avatar
Jim Blandy committed
35 36 37 38 39 40 41 42 43

Lisp_Object
casify_object (flag, obj)
     enum case_action flag;
     Lisp_Object obj;
{
  register int i, c, len;
  register int inword = flag == CASE_DOWN;

44 45 46 47
  /* If the case table is flagged as modified, rescan it.  */
  if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
    Fset_case_table (current_buffer->downcase_table);

Jim Blandy's avatar
Jim Blandy committed
48 49
  while (1)
    {
50
      if (INTEGERP (obj))
Jim Blandy's avatar
Jim Blandy committed
51
	{
52 53 54 55
	  int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
			  | CHAR_SHIFT | CHAR_CTL | CHAR_META);
	  int flags = XINT (obj) & flagbits;

56 57 58 59 60 61
	  /* If the character has higher bits set
	     above the flags, return it unchanged.
	     It is not a real character.  */
	  if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
	    return obj;

62
	  c = DOWNCASE (XFASTINT (obj) & ~flagbits);
63
	  if (inword)
64 65
	    XSETFASTINT (obj, c | flags);
	  else if (c == (XFASTINT (obj) & ~flagbits))
66
	    {
67 68
	      c = UPCASE1 ((XFASTINT (obj) & ~flagbits));
	      XSETFASTINT (obj, c | flags);
69
	    }
Jim Blandy's avatar
Jim Blandy committed
70 71
	  return obj;
	}
72

73
      if (STRINGP (obj))
Jim Blandy's avatar
Jim Blandy committed
74
	{
75
	  int multibyte = STRING_MULTIBYTE (obj);
76

Jim Blandy's avatar
Jim Blandy committed
77
	  obj = Fcopy_sequence (obj);
78
	  len = SBYTES (obj);
79 80 81

	  /* Scan all single-byte characters from start of string.  */
	  for (i = 0; i < len;)
Jim Blandy's avatar
Jim Blandy committed
82
	    {
83
	      c = SREF (obj, i);
84

85 86 87 88
	      if (multibyte && c >= 0x80)
		/* A multibyte character can't be handled in this
                   simple loop.  */
		break;
89
	      if (inword && flag != CASE_CAPITALIZE_UP)
Jim Blandy's avatar
Jim Blandy committed
90
		c = DOWNCASE (c);
91 92
	      else if (!UPPERCASEP (c)
		       && (!inword || flag != CASE_CAPITALIZE_UP))
Jim Blandy's avatar
Jim Blandy committed
93
		c = UPCASE1 (c);
94 95 96 97 98 99
	      /* If this char won't fit in a single-byte string.
		 fall out to the multibyte case.  */
	      if (multibyte ? ! ASCII_BYTE_P (c)
		  : ! SINGLE_BYTE_CHAR_P (c))
		break;

100
	      SSET (obj, i, c);
101
	      if ((int) flag >= (int) CASE_CAPITALIZE)
Jim Blandy's avatar
Jim Blandy committed
102
		inword = SYNTAX (c) == Sword;
103
	      i++;
Jim Blandy's avatar
Jim Blandy committed
104
	    }
105 106 107

	  /* If we didn't do the whole string as single-byte,
	     scan the rest in a more complex way.  */
108 109 110 111
	  if (i < len)
	    {
	      /* The work is not yet finished because of a multibyte
		 character just encountered.  */
112
	      int fromlen, j_byte = i;
113 114 115 116 117 118
	      char *buf;
	      int bufsize;
	      USE_SAFE_ALLOCA;

	      bufsize = (len - i) * MAX_MULTIBYTE_LENGTH + i;
	      SAFE_ALLOCA (buf, char *, bufsize);
119 120

	      /* Copy data already handled.  */
121
	      bcopy (SDATA (obj), buf, i);
122

123
	      /* From now on, I counts bytes.  */
124 125
	      while (i < len)
		{
126
		  c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i,
127 128 129 130 131 132 133
					      len - i, fromlen);
		  if (inword && flag != CASE_CAPITALIZE_UP)
		    c = DOWNCASE (c);
		  else if (!UPPERCASEP (c)
			   && (!inword || flag != CASE_CAPITALIZE_UP))
		    c = UPCASE1 (c);
		  i += fromlen;
Kenichi Handa's avatar
Kenichi Handa committed
134
		  j_byte += CHAR_STRING (c, buf + j_byte);
135 136 137
		  if ((int) flag >= (int) CASE_CAPITALIZE)
		    inword = SYNTAX (c) == Sword;
		}
138
	      obj = make_multibyte_string (buf, SCHARS (obj),
139
					   j_byte);
140
	      SAFE_FREE (bufsize);
141
	    }
Jim Blandy's avatar
Jim Blandy committed
142 143
	  return obj;
	}
144
      obj = wrong_type_argument (Qchar_or_string_p, obj);
Jim Blandy's avatar
Jim Blandy committed
145 146 147 148
    }
}

DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
149 150 151 152 153
       doc: /* Convert argument to upper case and return that.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.
See also `capitalize', `downcase' and `upcase-initials'.  */)
     (obj)
Jim Blandy's avatar
Jim Blandy committed
154 155 156 157 158 159
     Lisp_Object obj;
{
  return casify_object (CASE_UP, obj);
}

DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
160 161 162 163
       doc: /* Convert argument to lower case and return that.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  */)
     (obj)
Jim Blandy's avatar
Jim Blandy committed
164 165 166 167 168 169
     Lisp_Object obj;
{
  return casify_object (CASE_DOWN, obj);
}

DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
170 171 172 173 174 175
       doc: /* Convert argument to capitalized form and return that.
This means that each word's first character is upper case
and the rest is lower case.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  */)
     (obj)
Jim Blandy's avatar
Jim Blandy committed
176 177 178 179
     Lisp_Object obj;
{
  return casify_object (CASE_CAPITALIZE, obj);
}
180

181 182
/* Like Fcapitalize but change only the initials.  */

183
DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
184 185 186 187 188
       doc: /* Convert the initial of each word in the argument to upper case.
Do not change the other letters of each word.
The argument may be a character or string.  The result has the same type.
The argument object is not altered--the value is a copy.  */)
     (obj)
189 190 191 192
     Lisp_Object obj;
{
  return casify_object (CASE_CAPITALIZE_UP, obj);
}
Jim Blandy's avatar
Jim Blandy committed
193 194 195 196

/* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
   b and e specify range of buffer to operate on. */

Andreas Schwab's avatar
Andreas Schwab committed
197
void
Jim Blandy's avatar
Jim Blandy committed
198 199 200 201 202 203 204
casify_region (flag, b, e)
     enum case_action flag;
     Lisp_Object b, e;
{
  register int i;
  register int c;
  register int inword = flag == CASE_DOWN;
205
  register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
206
  int start, end;
207
  int start_byte, end_byte;
Kenichi Handa's avatar
Kenichi Handa committed
208
  int changed = 0;
Jim Blandy's avatar
Jim Blandy committed
209 210 211 212 213

  if (EQ (b, e))
    /* Not modifying because nothing marked */
    return;

214 215 216 217
  /* If the case table is flagged as modified, rescan it.  */
  if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
    Fset_case_table (current_buffer->downcase_table);

Jim Blandy's avatar
Jim Blandy committed
218
  validate_region (&b, &e);
219 220 221 222
  start = XFASTINT (b);
  end = XFASTINT (e);
  modify_region (current_buffer, start, end);
  record_change (start, end - start);
223 224
  start_byte = CHAR_TO_BYTE (start);
  end_byte = CHAR_TO_BYTE (end);
Jim Blandy's avatar
Jim Blandy committed
225

Kenichi Handa's avatar
Kenichi Handa committed
226
  for (i = start_byte; i < end_byte; i++, start++)
Karl Heuer's avatar
Karl Heuer committed
227
    {
Kenichi Handa's avatar
Kenichi Handa committed
228 229
      int c2;
      c = c2 = FETCH_BYTE (i);
230 231 232 233 234 235 236 237 238
      if (multibyte && c >= 0x80)
	/* A multibyte character can't be handled in this simple loop.  */
	break;
      if (inword && flag != CASE_CAPITALIZE_UP)
	c = DOWNCASE (c);
      else if (!UPPERCASEP (c)
	       && (!inword || flag != CASE_CAPITALIZE_UP))
	c = UPCASE1 (c);
      FETCH_BYTE (i) = c;
Kenichi Handa's avatar
Kenichi Handa committed
239 240
      if (c != c2)
	changed = 1;
241
      if ((int) flag >= (int) CASE_CAPITALIZE)
242
	inword = SYNTAX (c) == Sword && (inword || !SYNTAX_PREFIX (c));
Karl Heuer's avatar
Karl Heuer committed
243
    }
244
  if (i < end_byte)
Jim Blandy's avatar
Jim Blandy committed
245
    {
246 247
      /* The work is not yet finished because of a multibyte character
	 just encountered.  */
248 249 250
      int opoint = PT;
      int opoint_byte = PT_BYTE;
      int c2;
Karl Heuer's avatar
Karl Heuer committed
251

252
      while (i < end_byte)
Karl Heuer's avatar
Karl Heuer committed
253
	{
254 255 256
	  if ((c = FETCH_BYTE (i)) >= 0x80)
	    c = FETCH_MULTIBYTE_CHAR (i);
	  c2 = c;
Karl Heuer's avatar
Karl Heuer committed
257
	  if (inword && flag != CASE_CAPITALIZE_UP)
258 259
	    c2 = DOWNCASE (c);
	  else if (!UPPERCASEP (c)
Karl Heuer's avatar
Karl Heuer committed
260
		   && (!inword || flag != CASE_CAPITALIZE_UP))
261 262
	    c2 = UPCASE1 (c);
	  if (c != c2)
Karl Heuer's avatar
Karl Heuer committed
263 264
	    {
	      int fromlen, tolen, j;
Kenichi Handa's avatar
Kenichi Handa committed
265
	      unsigned char str[MAX_MULTIBYTE_LENGTH];
Karl Heuer's avatar
Karl Heuer committed
266

Kenichi Handa's avatar
Kenichi Handa committed
267
	      changed = 1;
Karl Heuer's avatar
Karl Heuer committed
268
	      /* Handle the most likely case */
269 270
	      if (c < 0400 && c2 < 0400)
		FETCH_BYTE (i) = c2;
Kenichi Handa's avatar
Kenichi Handa committed
271 272
	      else if (fromlen = CHAR_STRING (c, str),
		       tolen = CHAR_STRING (c2, str),
Karl Heuer's avatar
Karl Heuer committed
273 274 275 276 277 278 279 280 281 282
		       fromlen == tolen)
		{
		  for (j = 0; j < tolen; ++j)
		    FETCH_BYTE (i + j) = str[j];
		}
	      else
		{
		  error ("Can't casify letters that change length");
#if 0 /* This is approximately what we'd like to be able to do here */
		  if (tolen < fromlen)
283
		    del_range_1 (i + tolen, i + fromlen, 0, 0);
Karl Heuer's avatar
Karl Heuer committed
284 285 286
		  else if (tolen > fromlen)
		    {
		      TEMP_SET_PT (i + fromlen);
287
		      insert_1 (str + fromlen, tolen - fromlen, 1, 0, 0);
Karl Heuer's avatar
Karl Heuer committed
288 289 290 291 292
		    }
#endif
		}
	    }
	  if ((int) flag >= (int) CASE_CAPITALIZE)
293
	    inword = SYNTAX (c2) == Sword;
Kenichi Handa's avatar
Kenichi Handa committed
294
	  INC_BOTH (start, i);
Karl Heuer's avatar
Karl Heuer committed
295
	}
296
      TEMP_SET_PT_BOTH (opoint, opoint_byte);
Jim Blandy's avatar
Jim Blandy committed
297 298
    }

Kenichi Handa's avatar
Kenichi Handa committed
299 300 301 302 303 304
  start = XFASTINT (b);
  if (changed)
    {
      signal_after_change (start, end - start, end - start);
      update_compositions (start, end, CHECK_ALL);
    }
Jim Blandy's avatar
Jim Blandy committed
305 306 307
}

DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
308 309 310 311 312 313
       doc: /* Convert the region to upper case.  In programs, wants two arguments.
These arguments specify the starting and ending character numbers of
the region to operate on.  When used as a command, the text between
point and the mark is operated on.
See also `capitalize-region'.  */)
     (beg, end)
314
     Lisp_Object beg, end;
Jim Blandy's avatar
Jim Blandy committed
315
{
316
  casify_region (CASE_UP, beg, end);
Jim Blandy's avatar
Jim Blandy committed
317 318 319 320
  return Qnil;
}

DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
321 322 323 324 325
       doc: /* Convert the region to lower case.  In programs, wants two arguments.
These arguments specify the starting and ending character numbers of
the region to operate on.  When used as a command, the text between
point and the mark is operated on.  */)
     (beg, end)
326
     Lisp_Object beg, end;
Jim Blandy's avatar
Jim Blandy committed
327
{
328
  casify_region (CASE_DOWN, beg, end);
Jim Blandy's avatar
Jim Blandy committed
329 330 331 332
  return Qnil;
}

DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
333 334 335 336 337 338
       doc: /* Convert the region to capitalized form.
Capitalized form means each word's first character is upper case
and the rest of it is lower case.
In programs, give two arguments, the starting and ending
character positions to operate on.  */)
     (beg, end)
339
     Lisp_Object beg, end;
Jim Blandy's avatar
Jim Blandy committed
340
{
341
  casify_region (CASE_CAPITALIZE, beg, end);
Jim Blandy's avatar
Jim Blandy committed
342 343 344
  return Qnil;
}

345 346
/* Like Fcapitalize_region but change only the initials.  */

347 348
DEFUN ("upcase-initials-region", Fupcase_initials_region,
       Supcase_initials_region, 2, 2, "r",
349 350 351 352 353
       doc: /* Upcase the initial of each word in the region.
Subsequent letters of each word are not changed.
In programs, give two arguments, the starting and ending
character positions to operate on.  */)
     (beg, end)
354
     Lisp_Object beg, end;
355
{
356
  casify_region (CASE_CAPITALIZE_UP, beg, end);
357 358
  return Qnil;
}
Jim Blandy's avatar
Jim Blandy committed
359 360

Lisp_Object
361
operate_on_word (arg, newpoint)
Jim Blandy's avatar
Jim Blandy committed
362
     Lisp_Object arg;
363
     int *newpoint;
Jim Blandy's avatar
Jim Blandy committed
364
{
365
  Lisp_Object val;
366
  int farend;
367
  int iarg;
Jim Blandy's avatar
Jim Blandy committed
368

369
  CHECK_NUMBER (arg);
370
  iarg = XINT (arg);
371
  farend = scan_words (PT, iarg);
Jim Blandy's avatar
Jim Blandy committed
372
  if (!farend)
373
    farend = iarg > 0 ? ZV : BEGV;
Jim Blandy's avatar
Jim Blandy committed
374

375
  *newpoint = PT > farend ? PT : farend;
376
  XSETFASTINT (val, farend);
Jim Blandy's avatar
Jim Blandy committed
377 378 379 380 381

  return val;
}

DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
382 383 384 385
       doc: /* Convert following word (or ARG words) to upper case, moving over.
With negative argument, convert previous words but do not move.
See also `capitalize-word'.  */)
     (arg)
Jim Blandy's avatar
Jim Blandy committed
386 387
     Lisp_Object arg;
{
388 389
  Lisp_Object beg, end;
  int newpoint;
390
  XSETFASTINT (beg, PT);
391 392 393
  end = operate_on_word (arg, &newpoint);
  casify_region (CASE_UP, beg, end);
  SET_PT (newpoint);
Jim Blandy's avatar
Jim Blandy committed
394 395 396 397
  return Qnil;
}

DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
398 399 400
       doc: /* Convert following word (or ARG words) to lower case, moving over.
With negative argument, convert previous words but do not move.  */)
     (arg)
Jim Blandy's avatar
Jim Blandy committed
401 402
     Lisp_Object arg;
{
403 404
  Lisp_Object beg, end;
  int newpoint;
405
  XSETFASTINT (beg, PT);
406 407 408
  end = operate_on_word (arg, &newpoint);
  casify_region (CASE_DOWN, beg, end);
  SET_PT (newpoint);
Jim Blandy's avatar
Jim Blandy committed
409 410 411 412
  return Qnil;
}

DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
413 414 415 416 417
       doc: /* Capitalize the following word (or ARG words), moving over.
This gives the word(s) a first character in upper case
and the rest lower case.
With negative argument, capitalize previous words but do not move.  */)
     (arg)
Jim Blandy's avatar
Jim Blandy committed
418 419
     Lisp_Object arg;
{
420 421
  Lisp_Object beg, end;
  int newpoint;
422
  XSETFASTINT (beg, PT);
423 424 425
  end = operate_on_word (arg, &newpoint);
  casify_region (CASE_CAPITALIZE, beg, end);
  SET_PT (newpoint);
Jim Blandy's avatar
Jim Blandy committed
426 427 428
  return Qnil;
}

Andreas Schwab's avatar
Andreas Schwab committed
429
void
Jim Blandy's avatar
Jim Blandy committed
430 431
syms_of_casefiddle ()
{
Karl Heuer's avatar
Karl Heuer committed
432 433
  Qidentity = intern ("identity");
  staticpro (&Qidentity);
Jim Blandy's avatar
Jim Blandy committed
434 435 436
  defsubr (&Supcase);
  defsubr (&Sdowncase);
  defsubr (&Scapitalize);
437
  defsubr (&Supcase_initials);
Jim Blandy's avatar
Jim Blandy committed
438 439 440
  defsubr (&Supcase_region);
  defsubr (&Sdowncase_region);
  defsubr (&Scapitalize_region);
441
  defsubr (&Supcase_initials_region);
Jim Blandy's avatar
Jim Blandy committed
442 443 444 445 446
  defsubr (&Supcase_word);
  defsubr (&Sdowncase_word);
  defsubr (&Scapitalize_word);
}

Andreas Schwab's avatar
Andreas Schwab committed
447
void
Jim Blandy's avatar
Jim Blandy committed
448 449 450
keys_of_casefiddle ()
{
  initial_define_key (control_x_map, Ctl('U'), "upcase-region");
Jim Blandy's avatar
Jim Blandy committed
451
  Fput (intern ("upcase-region"), Qdisabled, Qt);
Jim Blandy's avatar
Jim Blandy committed
452
  initial_define_key (control_x_map, Ctl('L'), "downcase-region");
Jim Blandy's avatar
Jim Blandy committed
453 454
  Fput (intern ("downcase-region"), Qdisabled, Qt);

Jim Blandy's avatar
Jim Blandy committed
455 456 457 458
  initial_define_key (meta_map, 'u', "upcase-word");
  initial_define_key (meta_map, 'l', "downcase-word");
  initial_define_key (meta_map, 'c', "capitalize-word");
}
Miles Bader's avatar
Miles Bader committed
459 460 461

/* arch-tag: 60a73c66-5489-47e7-a81f-cead4057c526
   (do not change this comment) */