Mercurial > hg > xemacs-beta

comparison src/casefiddle.c @ 373:6240c7796c7a r21-2b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b2
author cvs
date Mon, 13 Aug 2007 11:04:06 +0200
parents 6cb5e14cd98e
children 8626e4521993
comparison
equal deleted inserted replaced
372:49e1ed2d7ed8 373:6240c7796c7a
1 /* XEmacs case conversion functions. 1 /* XEmacs case conversion functions.
2 Copyright (C) 1985, 1992, 1993, 1994 Free Software Foundation, Inc. 2 Copyright (C) 1985, 1992, 1993, 1994, 1997, 1998 Free Software Foundation, Inc.
3 3
4 This file is part of XEmacs. 4 This file is part of XEmacs.
5 5
6 XEmacs is free software; you can redistribute it and/or modify it 6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the 7 under the terms of the GNU General Public License as published by the
16 You should have received a copy of the GNU General Public License 16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to 17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */ 19 Boston, MA 02111-1307, USA. */
20 20
21 /* Synched up with: FSF 19.34. */ 21 /* Synched up with: FSF 19.34, but substantially rewritten by Martin. */
22 22
23 #include <config.h> 23 #include <config.h>
24 #include "lisp.h" 24 #include "lisp.h"
25 25
26 #include "buffer.h" 26 #include "buffer.h"
27 #include "commands.h"
28 #include "insdel.h" 27 #include "insdel.h"
29 #include "syntax.h" 28 #include "syntax.h"
30 29
31 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; 30 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
32 31
33 static Lisp_Object 32 static Lisp_Object
34 casify_object (enum case_action flag, Lisp_Object obj, Lisp_Object buffer) 33 casify_object (enum case_action flag, Lisp_Object obj, Lisp_Object buffer)
35 { 34 {
36 struct buffer *buf = decode_buffer (buffer, 0); 35 struct buffer *buf = decode_buffer (buffer, 0);
37 REGISTER int inword = (flag == CASE_DOWN); 36
38 struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); 37 retry:
39 38
40 while (1) 39 if (CHAR_OR_CHAR_INTP (obj))
41 { 40 {
42 if (CHAR_OR_CHAR_INTP (obj)) 41 Emchar c;
42 CHECK_CHAR_COERCE_INT (obj);
43 c = XCHAR (obj);
44 c = (flag == CASE_DOWN) ? DOWNCASE (buf, c) : UPCASE (buf, c);
45 return make_char (c);
46 }
47
48 if (STRINGP (obj))
49 {
50 struct Lisp_Char_Table *syntax_table =
51 XCHAR_TABLE (buf->mirror_syntax_table);
52 Bufbyte *storage =
53 alloca_array (Bufbyte, XSTRING_LENGTH (obj) * MAX_EMCHAR_LEN);
54 Bufbyte *newp = storage;
55 Bufbyte *oldp = XSTRING_DATA (obj);
56 int wordp = 0, wordp_prev;
57
58 while (*oldp)
43 { 59 {
44 Emchar c; 60 Emchar c = charptr_emchar (oldp);
45 CHECK_CHAR_COERCE_INT (obj); 61 switch (flag)
46 c = XCHAR (obj);
47 if (IN_TRT_TABLE_DOMAIN (c))
48 { 62 {
49 if (inword) 63 case CASE_UP:
50 obj = make_char (DOWNCASE (buf, c)); 64 c = UPCASE (buf, c);
51 else if (!UPPERCASEP (buf, c)) 65 break;
52 obj = make_char (UPCASE1 (buf, c)); 66 case CASE_DOWN:
67 c = DOWNCASE (buf, c);
68 break;
69 case CASE_CAPITALIZE:
70 case CASE_CAPITALIZE_UP:
71 wordp_prev = wordp;
72 wordp = WORD_SYNTAX_P (syntax_table, c);
73 if (!wordp) break;
74 if (wordp_prev)
75 {
76 if (flag == CASE_CAPITALIZE)
77 c = DOWNCASE (buf, c);
78 }
79 else
80 c = UPCASE (buf, c);
81 break;
53 } 82 }
54 return obj; 83
84 newp += set_charptr_emchar (newp, c);
85 INC_CHARPTR (oldp);
55 } 86 }
56 if (STRINGP (obj)) 87
57 { 88 return make_string (storage, newp - storage);
58 Charcount i;
59 Charcount len = XSTRING_CHAR_LENGTH (obj);
60 obj = Fcopy_sequence (obj);
61 for (i = 0; i < len; i++)
62 {
63 Emchar c = string_char (XSTRING (obj), i);
64 if (inword && flag != CASE_CAPITALIZE_UP)
65 c = DOWNCASE (buf, c);
66 else if (!UPPERCASEP (buf, c)
67 && (!inword || flag != CASE_CAPITALIZE_UP))
68 c = UPCASE1 (buf, c);
69 set_string_char (XSTRING (obj), i, c);
70 if ((int) flag >= (int) CASE_CAPITALIZE)
71 inword = WORD_SYNTAX_P (syntax_table, c);
72 }
73 return obj;
74 }
75 obj = wrong_type_argument (Qchar_or_string_p, obj);
76 } 89 }
90
91 obj = wrong_type_argument (Qchar_or_string_p, obj);
92 goto retry;
77 } 93 }
78 94
79 DEFUN ("upcase", Fupcase, 1, 2, 0, /* 95 DEFUN ("upcase", Fupcase, 1, 2, 0, /*
80 Convert argument to upper case and return that. 96 Convert OBJECT to upper case and return that.
81 The argument may be a character or string. The result has the same type. 97 OBJECT may be a character or string. The result has the same type.
82 The argument object is not altered--the value is a copy. 98 OBJECT is not altered--the value is a copy.
83 See also `capitalize', `downcase' and `upcase-initials'. 99 See also `capitalize', `downcase' and `upcase-initials'.
84 Optional second arg BUFFER specifies which buffer's case tables to use, 100 Optional second arg BUFFER specifies which buffer's case tables to use,
85 and defaults to the current buffer. 101 and defaults to the current buffer.
86 */ 102 */
87 (obj, buffer)) 103 (object, buffer))
88 { 104 {
89 return casify_object (CASE_UP, obj, buffer); 105 return casify_object (CASE_UP, object, buffer);
90 } 106 }
91 107
92 DEFUN ("downcase", Fdowncase, 1, 2, 0, /* 108 DEFUN ("downcase", Fdowncase, 1, 2, 0, /*
93 Convert argument to lower case and return that. 109 Convert OBJECT to lower case and return that.
94 The argument may be a character or string. The result has the same type. 110 OBJECT may be a character or string. The result has the same type.
95 The argument object is not altered--the value is a copy. 111 OBJECT is not altered--the value is a copy.
96 Optional second arg BUFFER specifies which buffer's case tables to use, 112 Optional second arg BUFFER specifies which buffer's case tables to use,
97 and defaults to the current buffer. 113 and defaults to the current buffer.
98 */ 114 */
99 (obj, buffer)) 115 (object, buffer))
100 { 116 {
101 return casify_object (CASE_DOWN, obj, buffer); 117 return casify_object (CASE_DOWN, object, buffer);
102 } 118 }
103 119
104 DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /* 120 DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /*
105 Convert argument to capitalized form and return that. 121 Convert OBJECT to capitalized form and return that.
106 This means that each word's first character is upper case 122 This means that each word's first character is upper case
107 and the rest is lower case. 123 and the rest is lower case.
108 The argument may be a character or string. The result has the same type. 124 OBJECT may be a character or string. The result has the same type.
109 The argument object is not altered--the value is a copy. 125 OBJECT is not altered--the value is a copy.
110 Optional second arg BUFFER specifies which buffer's case tables to use, 126 Optional second arg BUFFER specifies which buffer's case tables to use,
111 and defaults to the current buffer. 127 and defaults to the current buffer.
112 */ 128 */
113 (obj, buffer)) 129 (object, buffer))
114 { 130 {
115 return casify_object (CASE_CAPITALIZE, obj, buffer); 131 return casify_object (CASE_CAPITALIZE, object, buffer);
116 } 132 }
117 133
118 /* Like Fcapitalize but change only the initials. */ 134 /* Like Fcapitalize but change only the initial characters. */
119 135
120 DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /* 136 DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /*
121 Convert the initial of each word in the argument to upper case. 137 Convert the initial of each word in OBJECT to upper case.
122 Do not change the other letters of each word. 138 Do not change the other letters of each word.
123 The argument may be a character or string. The result has the same type. 139 OBJECT may be a character or string. The result has the same type.
124 The argument object is not altered--the value is a copy. 140 OBJECT is not altered--the value is a copy.
125 Optional second arg BUFFER specifies which buffer's case tables to use, 141 Optional second arg BUFFER specifies which buffer's case tables to use,
126 and defaults to the current buffer. 142 and defaults to the current buffer.
127 */ 143 */
128 (obj, buffer)) 144 (object, buffer))
129 { 145 {
130 return casify_object (CASE_CAPITALIZE_UP, obj, buffer); 146 return casify_object (CASE_CAPITALIZE_UP, object, buffer);
131 } 147 }
132 148
133 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP. 149 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
134 b and e specify range of buffer to operate on. */ 150 b and e specify range of buffer to operate on. */
135 151
138 struct buffer *buf) 154 struct buffer *buf)
139 { 155 {
140 /* This function can GC */ 156 /* This function can GC */
141 REGISTER Bufpos i; 157 REGISTER Bufpos i;
142 Bufpos start, end; 158 Bufpos start, end;
143 REGISTER int inword = (flag == CASE_DOWN);
144 struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); 159 struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
145 int mccount; 160 int mccount;
161 Emchar oldc, c;
162 int wordp = 0, wordp_prev;
146 163
147 if (EQ (b, e)) 164 if (EQ (b, e))
148 /* Not modifying because nothing marked */ 165 /* Not modifying because nothing marked */
149 return; 166 return;
150 167
153 mccount = begin_multiple_change (buf, start, end); 170 mccount = begin_multiple_change (buf, start, end);
154 record_change (buf, start, end - start); 171 record_change (buf, start, end - start);
155 172
156 for (i = start; i < end; i++) 173 for (i = start; i < end; i++)
157 { 174 {
158 Emchar c = BUF_FETCH_CHAR (buf, i); 175 c = oldc = BUF_FETCH_CHAR (buf, i);
159 Emchar oldc = c; 176
160 177 switch (flag)
161 if (inword && flag != CASE_CAPITALIZE_UP)
162 c = DOWNCASE (buf, c);
163 else if (!UPPERCASEP (buf, c)
164 && (!inword || flag != CASE_CAPITALIZE_UP))
165 c = UPCASE1 (buf, c);
166
167 if (oldc != c)
168 { 178 {
169 buffer_replace_char (buf, i, c, 1, (i == start)); 179 case CASE_UP:
170 BUF_MODIFF (buf)++; 180 c = UPCASE (buf, oldc);
181 break;
182 case CASE_DOWN:
183 c = DOWNCASE (buf, oldc);
184 break;
185 case CASE_CAPITALIZE:
186 case CASE_CAPITALIZE_UP:
187 /* !!#### need to revalidate the start and end pointers in case
188 the buffer was changed */
189 wordp_prev = wordp;
190 wordp = WORD_SYNTAX_P (syntax_table, c);
191 if (!wordp) continue;
192 if (wordp_prev)
193 {
194 if (flag == CASE_CAPITALIZE)
195 c = DOWNCASE (buf, c);
196 }
197 else
198 c = UPCASE (buf, c);
199 break;
171 } 200 }
172 /* !!#### need to revalidate the start and end pointers in case 201
173 the buffer was changed */ 202 if (oldc == c) continue;
174 if ((int) flag >= (int) CASE_CAPITALIZE) 203 buffer_replace_char (buf, i, c, 1, (i == start));
175 inword = WORD_SYNTAX_P (syntax_table, c); 204 BUF_MODIFF (buf)++;
176 } 205 }
206
177 end_multiple_change (buf, mccount); 207 end_multiple_change (buf, mccount);
178 } 208 }
179 209
180 static Lisp_Object 210 static Lisp_Object
181 casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e, 211 casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e,