casefiddle.c 11.7 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 81 82
  if (STRINGP (obj))
    {
      int multibyte = STRING_MULTIBYTE (obj);
      int i, i_byte, len;
      int size = SCHARS (obj);
83

84 85 86 87 88 89
      obj = Fcopy_sequence (obj);
      for (i = i_byte = 0; i < size; i++, i_byte += len)
	{
	  if (multibyte)
	    c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, 0, len);
	  else
Jim Blandy's avatar
Jim Blandy committed
90
	    {
91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
	      c = SREF (obj, i_byte);
	      len = 1;
	      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)
	    {
	      if (! multibyte)
106
		{
107 108
		  MAKE_CHAR_UNIBYTE (c);
		  SSET (obj, i_byte, c);
109
		}
110 111 112
	      else if (ASCII_CHAR_P (c1) && ASCII_CHAR_P (c))
		SSET (obj, i_byte,  c);
	      else
113
		{
114 115
		  Faset (obj, make_number (i), make_number (c));
		  i_byte += CHAR_BYTES (c) - len;
116 117
		}
	    }
Jim Blandy's avatar
Jim Blandy committed
118
	}
119
      return obj;
Jim Blandy's avatar
Jim Blandy committed
120
    }
121 122

  wrong_type_argument (Qchar_or_string_p, obj);
Jim Blandy's avatar
Jim Blandy committed
123 124 125
}

DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0,
126 127 128 129 130
       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
131 132 133 134 135 136
     Lisp_Object obj;
{
  return casify_object (CASE_UP, obj);
}

DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0,
137 138 139 140
       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
141 142 143 144 145 146
     Lisp_Object obj;
{
  return casify_object (CASE_DOWN, obj);
}

DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0,
147 148 149 150 151 152
       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
153 154 155 156
     Lisp_Object obj;
{
  return casify_object (CASE_CAPITALIZE, obj);
}
157

158 159
/* Like Fcapitalize but change only the initials.  */

160
DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0,
161 162 163 164 165
       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)
166 167 168 169
     Lisp_Object obj;
{
  return casify_object (CASE_CAPITALIZE_UP, obj);
}
Jim Blandy's avatar
Jim Blandy committed
170 171 172 173

/* 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
174
void
Jim Blandy's avatar
Jim Blandy committed
175 176 177 178 179 180
casify_region (flag, b, e)
     enum case_action flag;
     Lisp_Object b, e;
{
  register int c;
  register int inword = flag == CASE_DOWN;
181
  register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
182
  int start, end;
183
  int start_byte, end_byte;
Kenichi Handa's avatar
Kenichi Handa committed
184
  int changed = 0;
185 186
  int opoint = PT;
  int opoint_byte = PT_BYTE;
Jim Blandy's avatar
Jim Blandy committed
187 188 189 190 191

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

192 193 194 195
  /* 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
196
  validate_region (&b, &e);
197 198
  start = XFASTINT (b);
  end = XFASTINT (e);
199
  modify_region (current_buffer, start, end, 0);
200
  record_change (start, end - start);
201 202
  start_byte = CHAR_TO_BYTE (start);
  end_byte = CHAR_TO_BYTE (end);
Jim Blandy's avatar
Jim Blandy committed
203

204
  while (start < end)
Karl Heuer's avatar
Karl Heuer committed
205
    {
206 207 208 209 210 211 212 213 214 215 216 217 218 219
      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;
220 221 222 223 224 225
      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
226
	inword = ((SYNTAX (c) == Sword) && (inword || !SYNTAX_PREFIX (c)));
227
      if (c != c2)
Karl Heuer's avatar
Karl Heuer committed
228
	{
229 230 231 232 233 234 235 236
	  changed = 1;
	  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;
237
	  else
Karl Heuer's avatar
Karl Heuer committed
238
	    {
239
	      int tolen = CHAR_BYTES (c);
240
	      int j;
Kenichi Handa's avatar
Kenichi Handa committed
241
	      unsigned char str[MAX_MULTIBYTE_LENGTH];
Karl Heuer's avatar
Karl Heuer committed
242

243
	      CHAR_STRING (c, str);
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259
	      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
260 261
	    }
	}
262 263
      start++;
      start_byte += len;
Jim Blandy's avatar
Jim Blandy committed
264 265
    }

Kenichi Handa's avatar
Kenichi Handa committed
266 267 268
  if (PT != opoint)
    TEMP_SET_PT_BOTH (opoint, opoint_byte);

Kenichi Handa's avatar
Kenichi Handa committed
269 270
  if (changed)
    {
271
      start = XFASTINT (b);
Kenichi Handa's avatar
Kenichi Handa committed
272 273 274
      signal_after_change (start, end - start, end - start);
      update_compositions (start, end, CHECK_ALL);
    }
Jim Blandy's avatar
Jim Blandy committed
275 276 277
}

DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r",
278 279 280 281 282 283
       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)
284
     Lisp_Object beg, end;
Jim Blandy's avatar
Jim Blandy committed
285
{
286
  casify_region (CASE_UP, beg, end);
Jim Blandy's avatar
Jim Blandy committed
287 288 289 290
  return Qnil;
}

DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
291 292 293 294 295
       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)
296
     Lisp_Object beg, end;
Jim Blandy's avatar
Jim Blandy committed
297
{
298
  casify_region (CASE_DOWN, beg, end);
Jim Blandy's avatar
Jim Blandy committed
299 300 301 302
  return Qnil;
}

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

315 316
/* Like Fcapitalize_region but change only the initials.  */

317 318
DEFUN ("upcase-initials-region", Fupcase_initials_region,
       Supcase_initials_region, 2, 2, "r",
319 320 321 322 323
       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)
324
     Lisp_Object beg, end;
325
{
326
  casify_region (CASE_CAPITALIZE_UP, beg, end);
327 328
  return Qnil;
}
Jim Blandy's avatar
Jim Blandy committed
329 330

Lisp_Object
331
operate_on_word (arg, newpoint)
Jim Blandy's avatar
Jim Blandy committed
332
     Lisp_Object arg;
333
     int *newpoint;
Jim Blandy's avatar
Jim Blandy committed
334
{
335
  Lisp_Object val;
336
  int farend;
337
  int iarg;
Jim Blandy's avatar
Jim Blandy committed
338

339
  CHECK_NUMBER (arg);
340
  iarg = XINT (arg);
341
  farend = scan_words (PT, iarg);
Jim Blandy's avatar
Jim Blandy committed
342
  if (!farend)
343
    farend = iarg > 0 ? ZV : BEGV;
Jim Blandy's avatar
Jim Blandy committed
344

345
  *newpoint = PT > farend ? PT : farend;
346
  XSETFASTINT (val, farend);
Jim Blandy's avatar
Jim Blandy committed
347 348 349 350 351

  return val;
}

DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p",
352 353 354 355
       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
356 357
     Lisp_Object arg;
{
358 359
  Lisp_Object beg, end;
  int newpoint;
360
  XSETFASTINT (beg, PT);
361 362 363
  end = operate_on_word (arg, &newpoint);
  casify_region (CASE_UP, beg, end);
  SET_PT (newpoint);
Jim Blandy's avatar
Jim Blandy committed
364 365 366 367
  return Qnil;
}

DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p",
368 369 370
       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
371 372
     Lisp_Object arg;
{
373 374
  Lisp_Object beg, end;
  int newpoint;
375
  XSETFASTINT (beg, PT);
376 377 378
  end = operate_on_word (arg, &newpoint);
  casify_region (CASE_DOWN, beg, end);
  SET_PT (newpoint);
Jim Blandy's avatar
Jim Blandy committed
379 380 381 382
  return Qnil;
}

DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p",
383 384 385 386 387
       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
388 389
     Lisp_Object arg;
{
390 391
  Lisp_Object beg, end;
  int newpoint;
392
  XSETFASTINT (beg, PT);
393 394 395
  end = operate_on_word (arg, &newpoint);
  casify_region (CASE_CAPITALIZE, beg, end);
  SET_PT (newpoint);
Jim Blandy's avatar
Jim Blandy committed
396 397 398
  return Qnil;
}

Andreas Schwab's avatar
Andreas Schwab committed
399
void
Jim Blandy's avatar
Jim Blandy committed
400 401
syms_of_casefiddle ()
{
Karl Heuer's avatar
Karl Heuer committed
402 403
  Qidentity = intern ("identity");
  staticpro (&Qidentity);
Jim Blandy's avatar
Jim Blandy committed
404 405 406
  defsubr (&Supcase);
  defsubr (&Sdowncase);
  defsubr (&Scapitalize);
407
  defsubr (&Supcase_initials);
Jim Blandy's avatar
Jim Blandy committed
408 409 410
  defsubr (&Supcase_region);
  defsubr (&Sdowncase_region);
  defsubr (&Scapitalize_region);
411
  defsubr (&Supcase_initials_region);
Jim Blandy's avatar
Jim Blandy committed
412 413 414 415 416
  defsubr (&Supcase_word);
  defsubr (&Sdowncase_word);
  defsubr (&Scapitalize_word);
}

Andreas Schwab's avatar
Andreas Schwab committed
417
void
Jim Blandy's avatar
Jim Blandy committed
418 419 420
keys_of_casefiddle ()
{
  initial_define_key (control_x_map, Ctl('U'), "upcase-region");
Jim Blandy's avatar
Jim Blandy committed
421
  Fput (intern ("upcase-region"), Qdisabled, Qt);
Jim Blandy's avatar
Jim Blandy committed
422
  initial_define_key (control_x_map, Ctl('L'), "downcase-region");
Jim Blandy's avatar
Jim Blandy committed
423 424
  Fput (intern ("downcase-region"), Qdisabled, Qt);

Jim Blandy's avatar
Jim Blandy committed
425 426 427 428
  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
429 430 431

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