/* XEmacs case conversion functions.
- Copyright (C) 1985, 1992, 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1992, 1993, 1994, 1997, 1998 Free Software Foundation, Inc.
+ Copyright (C) 2001 MORIOKA Tomohiko
This file is part of XEmacs.
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
-/* Synched up with: FSF 19.34. */
+/* Synched up with: FSF 19.34, but substantially rewritten by Martin. */
#include <config.h>
#include "lisp.h"
#include "buffer.h"
-#include "commands.h"
#include "insdel.h"
#include "syntax.h"
enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
\f
static Lisp_Object
-casify_object (enum case_action flag, Lisp_Object obj, Lisp_Object buffer)
+casify_object (enum case_action flag, Lisp_Object string_or_char,
+ Lisp_Object buffer)
{
struct buffer *buf = decode_buffer (buffer, 0);
- REGISTER int inword = (flag == CASE_DOWN);
- struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
- while (1)
+ retry:
+
+ if (CHAR_OR_CHAR_INTP (string_or_char))
{
- if (CHAR_OR_CHAR_INTP (obj))
- {
- Emchar c;
- CHECK_CHAR_COERCE_INT (obj);
- c = XCHAR (obj);
- if (IN_TRT_TABLE_DOMAIN (c))
- {
- if (inword)
- obj = make_char (DOWNCASE (buf, c));
- else if (!UPPERCASEP (buf, c))
- obj = make_char (UPCASE1 (buf, c));
- }
- return obj;
- }
- if (STRINGP (obj))
+ Emchar c;
+ CHECK_CHAR_COERCE_INT (string_or_char);
+ c = XCHAR (string_or_char);
+ c = (flag == CASE_DOWN) ? DOWNCASE (buf, c) : UPCASE (buf, c);
+ return make_char (c);
+ }
+
+ if (STRINGP (string_or_char))
+ {
+#ifdef UTF2000
+ Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->syntax_table);
+#else
+ Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
+#endif
+ Bufbyte *storage =
+ alloca_array (Bufbyte, XSTRING_LENGTH (string_or_char) * MAX_EMCHAR_LEN);
+ Bufbyte *newp = storage;
+ Bufbyte *oldp = XSTRING_DATA (string_or_char);
+ int wordp = 0, wordp_prev;
+
+ while (*oldp)
{
- Charcount i;
- Charcount len = XSTRING_CHAR_LENGTH (obj);
- obj = Fcopy_sequence (obj);
- for (i = 0; i < len; i++)
+ Emchar c = charptr_emchar (oldp);
+ switch (flag)
{
- Emchar c = string_char (XSTRING (obj), i);
- if (inword && flag != CASE_CAPITALIZE_UP)
- c = DOWNCASE (buf, c);
- else if (!UPPERCASEP (buf, c)
- && (!inword || flag != CASE_CAPITALIZE_UP))
- c = UPCASE1 (buf, c);
- set_string_char (XSTRING (obj), i, c);
- if ((int) flag >= (int) CASE_CAPITALIZE)
- inword = WORD_SYNTAX_P (syntax_table, c);
+ case CASE_UP:
+ c = UPCASE (buf, c);
+ break;
+ case CASE_DOWN:
+ c = DOWNCASE (buf, c);
+ break;
+ case CASE_CAPITALIZE:
+ case CASE_CAPITALIZE_UP:
+ wordp_prev = wordp;
+ wordp = WORD_SYNTAX_P (syntax_table, c);
+ if (!wordp) break;
+ if (wordp_prev)
+ {
+ if (flag == CASE_CAPITALIZE)
+ c = DOWNCASE (buf, c);
+ }
+ else
+ c = UPCASE (buf, c);
+ break;
}
- return obj;
+
+ newp += set_charptr_emchar (newp, c);
+ INC_CHARPTR (oldp);
}
- obj = wrong_type_argument (Qchar_or_string_p, obj);
+
+ return make_string (storage, newp - storage);
}
+
+ string_or_char = wrong_type_argument (Qchar_or_string_p, string_or_char);
+ goto retry;
}
DEFUN ("upcase", Fupcase, 1, 2, 0, /*
-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.
+Convert STRING-OR-CHAR to upper case and return that.
+STRING-OR-CHAR may be a character or string. The result has the same type.
+STRING-OR-CHAR is not altered--the value is a copy.
See also `capitalize', `downcase' and `upcase-initials'.
Optional second arg BUFFER specifies which buffer's case tables to use,
and defaults to the current buffer.
*/
- (obj, buffer))
+ (string_or_char, buffer))
{
- return casify_object (CASE_UP, obj, buffer);
+ return casify_object (CASE_UP, string_or_char, buffer);
}
DEFUN ("downcase", Fdowncase, 1, 2, 0, /*
-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.
+Convert STRING-OR-CHAR to lower case and return that.
+STRING-OR-CHAR may be a character or string. The result has the same type.
+STRING-OR-CHAR is not altered--the value is a copy.
Optional second arg BUFFER specifies which buffer's case tables to use,
and defaults to the current buffer.
*/
- (obj, buffer))
+ (string_or_char, buffer))
{
- return casify_object (CASE_DOWN, obj, buffer);
+ return casify_object (CASE_DOWN, string_or_char, buffer);
}
DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /*
-Convert argument to capitalized form and return that.
+Convert STRING-OR-CHAR 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.
+STRING-OR-CHAR may be a character or string. The result has the same type.
+STRING-OR-CHAR is not altered--the value is a copy.
Optional second arg BUFFER specifies which buffer's case tables to use,
and defaults to the current buffer.
*/
- (obj, buffer))
+ (string_or_char, buffer))
{
- return casify_object (CASE_CAPITALIZE, obj, buffer);
+ return casify_object (CASE_CAPITALIZE, string_or_char, buffer);
}
-/* Like Fcapitalize but change only the initials. */
+/* Like Fcapitalize but change only the initial characters. */
DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /*
-Convert the initial of each word in the argument to upper case.
+Convert the initial of each word in STRING-OR-CHAR 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.
+STRING-OR-CHAR may be a character or string. The result has the same type.
+STRING-OR-CHAR is not altered--the value is a copy.
Optional second arg BUFFER specifies which buffer's case tables to use,
and defaults to the current buffer.
*/
- (obj, buffer))
+ (string_or_char, buffer))
{
- return casify_object (CASE_CAPITALIZE_UP, obj, buffer);
+ return casify_object (CASE_CAPITALIZE_UP, string_or_char, buffer);
}
\f
/* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
- b and e specify range of buffer to operate on. */
+ START and END specify range of buffer to operate on. */
static void
-casify_region_internal (enum case_action flag, Lisp_Object b, Lisp_Object e,
- struct buffer *buf)
+casify_region_internal (enum case_action flag, Lisp_Object start,
+ Lisp_Object end, struct buffer *buf)
{
/* This function can GC */
- REGISTER Bufpos i;
- Bufpos start, end;
- REGISTER int inword = (flag == CASE_DOWN);
- struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
+ Bufpos pos, s, e;
+#ifdef UTF2000
+ Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->syntax_table);
+#else
+ Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
+#endif
int mccount;
+ int wordp = 0, wordp_prev;
- if (EQ (b, e))
+ if (EQ (start, end))
/* Not modifying because nothing marked */
return;
- get_buffer_range_char (buf, b, e, &start, &end, 0);
+ get_buffer_range_char (buf, start, end, &s, &e, 0);
- mccount = begin_multiple_change (buf, start, end);
- record_change (buf, start, end - start);
+ mccount = begin_multiple_change (buf, s, e);
+ record_change (buf, s, e - s);
- for (i = start; i < end; i++)
+ for (pos = s; pos < e; pos++)
{
- Emchar c = BUF_FETCH_CHAR (buf, i);
- Emchar oldc = c;
+ Emchar oldc = BUF_FETCH_CHAR (buf, pos);
+ Emchar c = oldc;
- if (inword && flag != CASE_CAPITALIZE_UP)
- c = DOWNCASE (buf, c);
- else if (!UPPERCASEP (buf, c)
- && (!inword || flag != CASE_CAPITALIZE_UP))
- c = UPCASE1 (buf, c);
-
- if (oldc != c)
+ switch (flag)
{
- buffer_replace_char (buf, i, c, 1, (i == start));
- BUF_MODIFF (buf)++;
+ case CASE_UP:
+ c = UPCASE (buf, oldc);
+ break;
+ case CASE_DOWN:
+ c = DOWNCASE (buf, oldc);
+ break;
+ case CASE_CAPITALIZE:
+ case CASE_CAPITALIZE_UP:
+ /* !!#### need to revalidate the start and end pointers in case
+ the buffer was changed */
+ wordp_prev = wordp;
+ wordp = WORD_SYNTAX_P (syntax_table, c);
+ if (!wordp) continue;
+ if (wordp_prev)
+ {
+ if (flag == CASE_CAPITALIZE)
+ c = DOWNCASE (buf, c);
+ }
+ else
+ c = UPCASE (buf, c);
+ break;
}
- /* !!#### need to revalidate the start and end pointers in case
- the buffer was changed */
- if ((int) flag >= (int) CASE_CAPITALIZE)
- inword = WORD_SYNTAX_P (syntax_table, c);
+
+ if (oldc == c) continue;
+ buffer_replace_char (buf, pos, c, 1, (pos == s));
+ BUF_MODIFF (buf)++;
}
+
end_multiple_change (buf, mccount);
}
static Lisp_Object
-casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e,
+casify_region (enum case_action flag, Lisp_Object start, Lisp_Object end,
Lisp_Object buffer)
{
- casify_region_internal (flag, b, e, decode_buffer (buffer, 1));
+ casify_region_internal (flag, start, end, decode_buffer (buffer, 1));
return Qnil;
}
See also `capitalize-region'.
Optional third arg BUFFER defaults to the current buffer.
*/
- (b, e, buffer))
+ (start, end, buffer))
{
/* This function can GC */
- return casify_region (CASE_UP, b, e, buffer);
+ return casify_region (CASE_UP, start, end, buffer);
}
DEFUN ("downcase-region", Fdowncase_region, 2, 3, "r", /*
point and the mark is operated on.
Optional third arg BUFFER defaults to the current buffer.
*/
- (b, e, buffer))
+ (start, end, buffer))
{
/* This function can GC */
- return casify_region (CASE_DOWN, b, e, buffer);
+ return casify_region (CASE_DOWN, start, end, buffer);
}
DEFUN ("capitalize-region", Fcapitalize_region, 2, 3, "r", /*
character positions to operate on.
Optional third arg BUFFER defaults to the current buffer.
*/
- (b, e, buffer))
+ (start, end, buffer))
{
/* This function can GC */
- return casify_region (CASE_CAPITALIZE, b, e, buffer);
+ return casify_region (CASE_CAPITALIZE, start, end, buffer);
}
/* Like Fcapitalize_region but change only the initials. */
character positions to operate on.
Optional third arg BUFFER defaults to the current buffer.
*/
- (b, e, buffer))
+ (start, end, buffer))
{
- return casify_region (CASE_CAPITALIZE_UP, b, e, buffer);
+ return casify_region (CASE_CAPITALIZE_UP, start, end, buffer);
}
\f
}
DEFUN ("upcase-word", Fupcase_word, 1, 2, "p", /*
-Convert following word (or ARG words) to upper case, moving over.
+Convert following word (or COUNT words) to upper case, moving over.
With negative argument, convert previous words but do not move.
See also `capitalize-word'.
Optional second arg BUFFER defaults to the current buffer.
*/
- (arg, buffer))
+ (count, buffer))
{
/* This function can GC */
- return casify_word (CASE_UP, arg, buffer);
+ return casify_word (CASE_UP, count, buffer);
}
DEFUN ("downcase-word", Fdowncase_word, 1, 2, "p", /*
-Convert following word (or ARG words) to lower case, moving over.
+Convert following word (or COUNT words) to lower case, moving over.
With negative argument, convert previous words but do not move.
Optional second arg BUFFER defaults to the current buffer.
*/
- (arg, buffer))
+ (count, buffer))
{
/* This function can GC */
- return casify_word (CASE_DOWN, arg, buffer);
+ return casify_word (CASE_DOWN, count, buffer);
}
DEFUN ("capitalize-word", Fcapitalize_word, 1, 2, "p", /*
-Capitalize the following word (or ARG words), moving over.
+Capitalize the following word (or COUNT 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.
Optional second arg BUFFER defaults to the current buffer.
*/
- (arg, buffer))
+ (count, buffer))
{
/* This function can GC */
- return casify_word (CASE_CAPITALIZE, arg, buffer);
+ return casify_word (CASE_CAPITALIZE, count, buffer);
}
\f