casefiddle.c 12.9 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* GNU Emacs case conversion functions.
2
   Copyright (C) 1985, 1994, 1997, 1998, 1999, 2001, 2002, 2003, 2004,
Glenn Morris's avatar
Glenn Morris committed
3
                 2005, 2006, 2007, 2008 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
9
the Free Software Foundation; either version 3, 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
Lute Kamstra's avatar
Lute Kamstra committed
19 20
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, 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"
26
#include "character.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

Lisp_Object
casify_object (flag, obj)
     enum case_action flag;
     Lisp_Object obj;
{
41
  register int c, c1;
Jim Blandy's avatar
Jim Blandy committed
42 43
  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);

48
  if (INTEGERP (obj))
Jim Blandy's avatar
Jim Blandy committed
49
    {
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
      int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
		      | CHAR_SHIFT | CHAR_CTL | CHAR_META);
      int flags = XINT (obj) & flagbits;
      int multibyte = ! NILP (current_buffer->enable_multibyte_characters);

      /* 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;

      c1 = XFASTINT (obj) & ~flagbits;
      if (! multibyte)
	MAKE_CHAR_MULTIBYTE (c1);
      c = DOWNCASE (c1);
      if (inword)
	XSETFASTINT (obj, c | flags);
      else if (c == (XFASTINT (obj) & ~flagbits))
Jim Blandy's avatar
Jim Blandy committed
68
	{
69 70
	  if (! inword)
	    c = UPCASE1 (c1);
71
	  if (! multibyte)
72 73
	    MAKE_CHAR_UNIBYTE (c);
	  XSETFASTINT (obj, c | flags);
Jim Blandy's avatar
Jim Blandy committed
74
	}
75 76
      return obj;
    }
77

78 79 80
  if (!STRINGP (obj))
    wrong_type_argument (Qchar_or_string_p, obj);
  else if (!STRING_MULTIBYTE (obj))
81
    {
82 83
      EMACS_INT i;
      EMACS_INT size = SCHARS (obj);
84

85
      obj = Fcopy_sequence (obj);
86
      for (i = 0; i < size; i++)
87
	{
88
	  c = SREF (obj, i);
89 90 91 92 93 94 95 96 97 98 99 100
	      MAKE_CHAR_MULTIBYTE (c);
	  c1 = c;
	  if (inword && flag != CASE_CAPITALIZE_UP)
	    c = DOWNCASE (c);
	  else if (!UPPERCASEP (c)
		   && (!inword || flag != CASE_CAPITALIZE_UP))
	    c = UPCASE1 (c1);
	  if ((int) flag >= (int) CASE_CAPITALIZE)
	    inword = (SYNTAX (c) == Sword);
	  if (c != c1)
	    {
		  MAKE_CHAR_UNIBYTE (c);
101 102 103 104 105 106 107
	      /* If the char can't be converted to a valid byte, just don't
		 change it.  */
	      if (c >= 0 && c < 256)
		SSET (obj, i, c);
	    }
	}
      return obj;
108 109 110 111 112
    }
  else
    {
      EMACS_INT i, i_byte, size = SCHARS (obj);
      int len;
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
      USE_SAFE_ALLOCA;
      unsigned char *dst, *o;
      /* Over-allocate by 12%: this is a minor overhead, but should be
	 sufficient in 99.999% of the cases to avoid a reallocation.  */
      EMACS_INT o_size = SBYTES (obj) + SBYTES (obj) / 8 + MAX_MULTIBYTE_LENGTH;
      SAFE_ALLOCA (dst, void *, o_size);
      o = dst;

      for (i = i_byte = 0; i < size; i++, i_byte += len)
	{
	  if ((o - dst) + MAX_MULTIBYTE_LENGTH > o_size)
	    { /* Not enough space for the next char: grow the destination.  */
	      unsigned char *old_dst = dst;
	      o_size += o_size;	/* Probably overkill, but extremely rare.  */
	      SAFE_ALLOCA (dst, void *, o_size);
	      bcopy (old_dst, dst, o - old_dst);
	      o = dst + (o - old_dst);
130
	    }
131 132 133 134 135 136 137 138 139
	  c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, 0, len);
	  if (inword && flag != CASE_CAPITALIZE_UP)
	    c = DOWNCASE (c);
	  else if (!UPPERCASEP (c)
		   && (!inword || flag != CASE_CAPITALIZE_UP))
	    c = UPCASE1 (c);
	  if ((int) flag >= (int) CASE_CAPITALIZE)
	    inword = (SYNTAX (c) == Sword);
	  o += CHAR_STRING (c, o);
Jim Blandy's avatar
Jim Blandy committed
140
	}
141 142 143
      eassert (o - dst <= o_size);
      obj = make_multibyte_string (dst, size, o - dst);
      SAFE_FREE ();
144
      return 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
casify_region (flag, b, e)
     enum case_action flag;
     Lisp_Object b, e;
{
  register int c;
  register int inword = flag == CASE_DOWN;
204
  register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
205 206 207 208 209
  EMACS_INT start, end;
  EMACS_INT start_byte, end_byte;
  EMACS_INT first = -1, last;	/* Position of first and last changes.  */
  EMACS_INT opoint = PT;
  EMACS_INT opoint_byte = PT_BYTE;
Jim Blandy's avatar
Jim Blandy committed
210 211 212 213 214

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

215 216 217 218
  /* 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
219
  validate_region (&b, &e);
220 221
  start = XFASTINT (b);
  end = XFASTINT (e);
222
  modify_region (current_buffer, start, end, 0);
223
  record_change (start, end - start);
224 225
  start_byte = CHAR_TO_BYTE (start);
  end_byte = CHAR_TO_BYTE (end);
Jim Blandy's avatar
Jim Blandy committed
226

227
  while (start < end)
Karl Heuer's avatar
Karl Heuer committed
228
    {
229 230 231 232 233 234 235 236 237 238 239 240 241 242
      int c2, len;

      if (multibyte)
	{
	  c = FETCH_MULTIBYTE_CHAR (start_byte);
	  len = CHAR_BYTES (c);
	}
      else
	{
	  c = FETCH_BYTE (start_byte);
	  MAKE_CHAR_MULTIBYTE (c);
	  len = 1;
	}
      c2 = c;
243 244 245 246 247 248
      if (inword && flag != CASE_CAPITALIZE_UP)
	c = DOWNCASE (c);
      else if (!UPPERCASEP (c)
	       && (!inword || flag != CASE_CAPITALIZE_UP))
	c = UPCASE1 (c);
      if ((int) flag >= (int) CASE_CAPITALIZE)
Kenichi Handa's avatar
Kenichi Handa committed
249
	inword = ((SYNTAX (c) == Sword) && (inword || !SYNTAX_PREFIX (c)));
250
      if (c != c2)
Karl Heuer's avatar
Karl Heuer committed
251
	{
252 253 254 255
	  last = start;
	  if (first < 0)
	    first = start;

256 257 258 259 260 261 262
	  if (! multibyte)
	    {
	      MAKE_CHAR_UNIBYTE (c);
	      FETCH_BYTE (start_byte) = c;
	    }
	  else if (ASCII_CHAR_P (c2) && ASCII_CHAR_P (c))
	    FETCH_BYTE (start_byte) = c;
263
	  else
Karl Heuer's avatar
Karl Heuer committed
264
	    {
265
	      int tolen = CHAR_BYTES (c);
266
	      int j;
Kenichi Handa's avatar
Kenichi Handa committed
267
	      unsigned char str[MAX_MULTIBYTE_LENGTH];
Karl Heuer's avatar
Karl Heuer committed
268

269
	      CHAR_STRING (c, str);
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285
	      if (len == tolen)
		{
		  /* Length is unchanged.  */
		  for (j = 0; j < len; ++j)
		    FETCH_BYTE (start_byte + j) = str[j];
		}
	      else
		{
		  /* Replace one character with the other,
		     keeping text properties the same.  */
		  replace_range_2 (start, start_byte,
				   start + 1, start_byte + len,
				   str, 1, tolen,
				   0);
		  len = tolen;
		}
Karl Heuer's avatar
Karl Heuer committed
286 287
	    }
	}
288 289
      start++;
      start_byte += len;
Jim Blandy's avatar
Jim Blandy committed
290 291
    }

Kenichi Handa's avatar
Kenichi Handa committed
292 293 294
  if (PT != opoint)
    TEMP_SET_PT_BOTH (opoint, opoint_byte);

295
  if (first >= 0)
Kenichi Handa's avatar
Kenichi Handa committed
296
    {
297 298
      signal_after_change (first, last + 1 - first, last + 1 - first);
      update_compositions (first, last + 1, CHECK_ALL);
Kenichi Handa's avatar
Kenichi Handa committed
299
    }
Jim Blandy's avatar
Jim Blandy committed
300 301 302
}

DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
303 304 305 306 307 308
       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)
309
     Lisp_Object beg, end;
Jim Blandy's avatar
Jim Blandy committed
310
{
311
  casify_region (CASE_UP, beg, end);
Jim Blandy's avatar
Jim Blandy committed
312 313 314 315
  return Qnil;
}

DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
316 317 318 319 320
       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)
321
     Lisp_Object beg, end;
Jim Blandy's avatar
Jim Blandy committed
322
{
323
  casify_region (CASE_DOWN, beg, end);
Jim Blandy's avatar
Jim Blandy committed
324 325 326 327
  return Qnil;
}

DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r",
328 329 330 331 332 333
       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)
334
     Lisp_Object beg, end;
Jim Blandy's avatar
Jim Blandy committed
335
{
336
  casify_region (CASE_CAPITALIZE, beg, end);
Jim Blandy's avatar
Jim Blandy committed
337 338 339
  return Qnil;
}

340 341
/* Like Fcapitalize_region but change only the initials.  */

342 343
DEFUN ("upcase-initials-region", Fupcase_initials_region,
       Supcase_initials_region, 2, 2, "r",
344 345 346 347 348
       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)
349
     Lisp_Object beg, end;
350
{
351
  casify_region (CASE_CAPITALIZE_UP, beg, end);
352 353
  return Qnil;
}
Jim Blandy's avatar
Jim Blandy committed
354

355
static Lisp_Object
356
operate_on_word (arg, newpoint)
Jim Blandy's avatar
Jim Blandy committed
357
     Lisp_Object arg;
358
     EMACS_INT *newpoint;
Jim Blandy's avatar
Jim Blandy committed
359
{
360
  Lisp_Object val;
361
  int farend;
362
  int iarg;
Jim Blandy's avatar
Jim Blandy committed
363

364
  CHECK_NUMBER (arg);
365
  iarg = XINT (arg);
366
  farend = scan_words (PT, iarg);
Jim Blandy's avatar
Jim Blandy committed
367
  if (!farend)
368
    farend = iarg > 0 ? ZV : BEGV;
Jim Blandy's avatar
Jim Blandy committed
369

370
  *newpoint = PT > farend ? PT : farend;
371
  XSETFASTINT (val, farend);
Jim Blandy's avatar
Jim Blandy committed
372 373 374 375 376

  return val;
}

DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
377 378 379 380
       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
381 382
     Lisp_Object arg;
{
383
  Lisp_Object beg, end;
384
  EMACS_INT newpoint;
385
  XSETFASTINT (beg, PT);
386 387 388
  end = operate_on_word (arg, &newpoint);
  casify_region (CASE_UP, beg, end);
  SET_PT (newpoint);
Jim Blandy's avatar
Jim Blandy committed
389 390 391 392
  return Qnil;
}

DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
393 394 395
       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
396 397
     Lisp_Object arg;
{
398
  Lisp_Object beg, end;
399
  EMACS_INT newpoint;
400
  XSETFASTINT (beg, PT);
401 402 403
  end = operate_on_word (arg, &newpoint);
  casify_region (CASE_DOWN, beg, end);
  SET_PT (newpoint);
Jim Blandy's avatar
Jim Blandy committed
404 405 406 407
  return Qnil;
}

DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
408 409 410 411 412
       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
413 414
     Lisp_Object arg;
{
415
  Lisp_Object beg, end;
416
  EMACS_INT newpoint;
417
  XSETFASTINT (beg, PT);
418 419 420
  end = operate_on_word (arg, &newpoint);
  casify_region (CASE_CAPITALIZE, beg, end);
  SET_PT (newpoint);
Jim Blandy's avatar
Jim Blandy committed
421 422 423
  return Qnil;
}

Andreas Schwab's avatar
Andreas Schwab committed
424
void
Jim Blandy's avatar
Jim Blandy committed
425 426
syms_of_casefiddle ()
{
Karl Heuer's avatar
Karl Heuer committed
427 428
  Qidentity = intern ("identity");
  staticpro (&Qidentity);
Jim Blandy's avatar
Jim Blandy committed
429 430 431
  defsubr (&Supcase);
  defsubr (&Sdowncase);
  defsubr (&Scapitalize);
432
  defsubr (&Supcase_initials);
Jim Blandy's avatar
Jim Blandy committed
433 434 435
  defsubr (&Supcase_region);
  defsubr (&Sdowncase_region);
  defsubr (&Scapitalize_region);
436
  defsubr (&Supcase_initials_region);
Jim Blandy's avatar
Jim Blandy committed
437 438 439 440 441
  defsubr (&Supcase_word);
  defsubr (&Sdowncase_word);
  defsubr (&Scapitalize_word);
}

Andreas Schwab's avatar
Andreas Schwab committed
442
void
Jim Blandy's avatar
Jim Blandy committed
443 444 445
keys_of_casefiddle ()
{
  initial_define_key (control_x_map, Ctl('U'), "upcase-region");
Jim Blandy's avatar
Jim Blandy committed
446
  Fput (intern ("upcase-region"), Qdisabled, Qt);
Jim Blandy's avatar
Jim Blandy committed
447
  initial_define_key (control_x_map, Ctl('L'), "downcase-region");
Jim Blandy's avatar
Jim Blandy committed
448 449
  Fput (intern ("downcase-region"), Qdisabled, Qt);

Jim Blandy's avatar
Jim Blandy committed
450 451 452 453
  initial_define_key (meta_map, 'u', "upcase-word");
  initial_define_key (meta_map, 'l', "downcase-word");
  initial_define_key (meta_map, 'c', "capitalize-word");
}
Kenichi Handa's avatar
Kenichi Handa committed
454 455 456

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