Mercurial > hg > xemacs-beta

comparison src/casefiddle.c @ 183:e121b013d1f0 r20-3b18

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b18
author cvs
date Mon, 13 Aug 2007 09:54:23 +0200
parents 85ec50267440
children 3d6bfa290dbd
comparison
equal deleted inserted replaced
182:f07455f06202 183:e121b013d1f0
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.30. */ 21 /* Synched up with: FSF 19.34. */
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"
29 #include "syntax.h" 29 #include "syntax.h"
30 30
31 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; 31 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
32 32
33 static Lisp_Object 33 static Lisp_Object
34 casify_object (struct buffer *buf, enum case_action flag, Lisp_Object obj) 34 casify_object (enum case_action flag, Lisp_Object obj, Lisp_Object buffer)
35 { 35 {
36 REGISTER Emchar c; 36 struct buffer *buf = decode_buffer (buffer, 0);
37 REGISTER Charcount i, len; 37 REGISTER int inword = (flag == CASE_DOWN);
38 REGISTER int inword = flag == CASE_DOWN; 38 struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
39 struct Lisp_Char_Table *syntax_table =
40 XCHAR_TABLE (buf->mirror_syntax_table);
41 39
42 while (1) 40 while (1)
43 { 41 {
44 if (CHAR_OR_CHAR_INTP (obj)) 42 if (CHAR_OR_CHAR_INTP (obj))
45 { 43 {
44 Emchar c;
46 CHECK_CHAR_COERCE_INT (obj); 45 CHECK_CHAR_COERCE_INT (obj);
47 c = XCHAR (obj); 46 c = XCHAR (obj);
48 if (IN_TRT_TABLE_DOMAIN (c)) 47 if (IN_TRT_TABLE_DOMAIN (c))
49 { 48 obj = make_char (inword ? DOWNCASE (buf, c) : UPCASE1 (buf, c));
50 if (inword)
51 obj = make_char (DOWNCASE (buf, c));
52 else if (!UPPERCASEP (buf, c))
53 obj = make_char (UPCASE1 (buf, c));
54 }
55 return obj; 49 return obj;
56 } 50 }
57 if (STRINGP (obj)) 51 if (STRINGP (obj))
58 { 52 {
53 Charcount i;
54 Charcount len = string_char_length (XSTRING (obj));
59 obj = Fcopy_sequence (obj); 55 obj = Fcopy_sequence (obj);
60 len = string_char_length (XSTRING (obj));
61 for (i = 0; i < len; i++) 56 for (i = 0; i < len; i++)
62 { 57 {
63 c = string_char (XSTRING (obj), i); 58 Emchar c = string_char (XSTRING (obj), i);
64 if (inword) 59 if (inword)
65 c = DOWNCASE (buf, c); 60 c = DOWNCASE (buf, c);
66 else if (!UPPERCASEP (buf, c) 61 else if (!UPPERCASEP (buf, c)
67 && (!inword || flag != CASE_CAPITALIZE_UP)) 62 && (!inword || flag != CASE_CAPITALIZE_UP))
68 c = UPCASE1 (buf, c); 63 c = UPCASE1 (buf, c);
84 Optional second arg BUFFER specifies which buffer's case tables to use, 79 Optional second arg BUFFER specifies which buffer's case tables to use,
85 and defaults to the current buffer. 80 and defaults to the current buffer.
86 */ 81 */
87 (obj, buffer)) 82 (obj, buffer))
88 { 83 {
89 return casify_object (decode_buffer (buffer, 0), CASE_UP, obj); 84 return casify_object (CASE_UP, obj, buffer);
90 } 85 }
91 86
92 DEFUN ("downcase", Fdowncase, 1, 2, 0, /* 87 DEFUN ("downcase", Fdowncase, 1, 2, 0, /*
93 Convert argument to lower case and return that. 88 Convert argument to lower case and return that.
94 The argument may be a character or string. The result has the same type. 89 The argument may be a character or string. The result has the same type.
96 Optional second arg BUFFER specifies which buffer's case tables to use, 91 Optional second arg BUFFER specifies which buffer's case tables to use,
97 and defaults to the current buffer. 92 and defaults to the current buffer.
98 */ 93 */
99 (obj, buffer)) 94 (obj, buffer))
100 { 95 {
101 return casify_object (decode_buffer (buffer, 0), CASE_DOWN, obj); 96 return casify_object (CASE_DOWN, obj, buffer);
102 } 97 }
103 98
104 DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /* 99 DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /*
105 Convert argument to capitalized form and return that. 100 Convert argument to capitalized form and return that.
106 This means that each word's first character is upper case 101 This means that each word's first character is upper case
110 Optional second arg BUFFER specifies which buffer's case tables to use, 105 Optional second arg BUFFER specifies which buffer's case tables to use,
111 and defaults to the current buffer. 106 and defaults to the current buffer.
112 */ 107 */
113 (obj, buffer)) 108 (obj, buffer))
114 { 109 {
115 return casify_object (decode_buffer (buffer, 0), CASE_CAPITALIZE, obj); 110 return casify_object (CASE_CAPITALIZE, obj, buffer);
116 } 111 }
117 112
118 /* Like Fcapitalize but change only the initials. */ 113 /* Like Fcapitalize but change only the initials. */
119 114
120 DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /* 115 DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /*
125 Optional second arg BUFFER specifies which buffer's case tables to use, 120 Optional second arg BUFFER specifies which buffer's case tables to use,
126 and defaults to the current buffer. 121 and defaults to the current buffer.
127 */ 122 */
128 (obj, buffer)) 123 (obj, buffer))
129 { 124 {
130 return casify_object (decode_buffer (buffer, 0), CASE_CAPITALIZE_UP, obj); 125 return casify_object (CASE_CAPITALIZE_UP, obj, buffer);
131 } 126 }
132 127
133 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP. 128 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
134 b and e specify range of buffer to operate on. */ 129 b and e specify range of buffer to operate on. */
135 130
136 static void 131 static void
137 casify_region (struct buffer *buf, enum case_action flag, Lisp_Object b, 132 casify_region_internal (enum case_action flag, Lisp_Object b, Lisp_Object e,
138 Lisp_Object e) 133 struct buffer *buf)
139 { 134 {
140 /* This function can GC */ 135 /* This function can GC */
141 REGISTER Bufpos i; 136 REGISTER Bufpos i;
142 Bufpos start, end; 137 Bufpos start, end;
143 REGISTER Emchar c;
144 REGISTER int inword = (flag == CASE_DOWN); 138 REGISTER int inword = (flag == CASE_DOWN);
145 struct Lisp_Char_Table *syntax_table = 139 struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
146 XCHAR_TABLE (buf->mirror_syntax_table);
147 int mccount; 140 int mccount;
148 141
149 if (EQ (b, e)) 142 if (EQ (b, e))
150 /* Not modifying because nothing marked */ 143 /* Not modifying because nothing marked */
151 return; 144 return;
152 145
153 get_buffer_range_char (buf, b, e, &start, &end, 0); 146 get_buffer_range_char (buf, b, e, &start, &end, 0);
154 147
155 mccount = begin_multiple_change (buf, start, end); 148 mccount = begin_multiple_change (buf, start, end);
156 record_change (buf, start, end - start); 149 record_change (buf, start, end - start);
157 BUF_MODIFF (buf)++;
158 150
159 for (i = start; i < end; i++) 151 for (i = start; i < end; i++)
160 { 152 {
161 c = BUF_FETCH_CHAR (buf, i); 153 Emchar c = BUF_FETCH_CHAR (buf, i);
154 Emchar oldc = c;
155
162 if (inword && flag != CASE_CAPITALIZE_UP) 156 if (inword && flag != CASE_CAPITALIZE_UP)
163 c = DOWNCASE (buf, c); 157 c = DOWNCASE (buf, c);
164 else if (!UPPERCASEP (buf, c) 158 else if (!UPPERCASEP (buf, c)
165 && (!inword || flag != CASE_CAPITALIZE_UP)) 159 && (!inword || flag != CASE_CAPITALIZE_UP))
166 c = UPCASE1 (buf, c); 160 c = UPCASE1 (buf, c);
167 161
168 buffer_replace_char (buf, i, c, 1, (i == start)); 162 if (oldc != c)
163 {
164 buffer_replace_char (buf, i, c, 1, (i == start));
165 BUF_MODIFF (buf)++;
166 }
169 /* !!#### need to revalidate the start and end pointers in case 167 /* !!#### need to revalidate the start and end pointers in case
170 the buffer was changed */ 168 the buffer was changed */
171 if ((int) flag >= (int) CASE_CAPITALIZE) 169 if ((int) flag >= (int) CASE_CAPITALIZE)
172 inword = WORD_SYNTAX_P (syntax_table, c); 170 inword = WORD_SYNTAX_P (syntax_table, c);
173 } 171 }
174 end_multiple_change (buf, mccount); 172 end_multiple_change (buf, mccount);
173 }
174
175 INLINE Lisp_Object
176 casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e,
177 Lisp_Object buffer)
178 {
179 casify_region_internal (flag, b, e, decode_buffer (buffer, 1));
180 return Qnil;
175 } 181 }
176 182
177 DEFUN ("upcase-region", Fupcase_region, 2, 3, "r", /* 183 DEFUN ("upcase-region", Fupcase_region, 2, 3, "r", /*
178 Convert the region to upper case. In programs, wants two arguments. 184 Convert the region to upper case. In programs, wants two arguments.
179 These arguments specify the starting and ending character numbers of 185 These arguments specify the starting and ending character numbers of
183 Optional third arg BUFFER defaults to the current buffer. 189 Optional third arg BUFFER defaults to the current buffer.
184 */ 190 */
185 (b, e, buffer)) 191 (b, e, buffer))
186 { 192 {
187 /* This function can GC */ 193 /* This function can GC */
188 casify_region (decode_buffer (buffer, 1), CASE_UP, b, e); 194 return casify_region (CASE_UP, b, e, buffer);
189 return Qnil;
190 } 195 }
191 196
192 DEFUN ("downcase-region", Fdowncase_region, 2, 3, "r", /* 197 DEFUN ("downcase-region", Fdowncase_region, 2, 3, "r", /*
193 Convert the region to lower case. In programs, wants two arguments. 198 Convert the region to lower case. In programs, wants two arguments.
194 These arguments specify the starting and ending character numbers of 199 These arguments specify the starting and ending character numbers of
197 Optional third arg BUFFER defaults to the current buffer. 202 Optional third arg BUFFER defaults to the current buffer.
198 */ 203 */
199 (b, e, buffer)) 204 (b, e, buffer))
200 { 205 {
201 /* This function can GC */ 206 /* This function can GC */
202 casify_region (decode_buffer (buffer, 1), CASE_DOWN, b, e); 207 return casify_region (CASE_DOWN, b, e, buffer);
203 return Qnil;
204 } 208 }
205 209
206 DEFUN ("capitalize-region", Fcapitalize_region, 2, 3, "r", /* 210 DEFUN ("capitalize-region", Fcapitalize_region, 2, 3, "r", /*
207 Convert the region to capitalized form. 211 Convert the region to capitalized form.
208 Capitalized form means each word's first character is upper case 212 Capitalized form means each word's first character is upper case
212 Optional third arg BUFFER defaults to the current buffer. 216 Optional third arg BUFFER defaults to the current buffer.
213 */ 217 */
214 (b, e, buffer)) 218 (b, e, buffer))
215 { 219 {
216 /* This function can GC */ 220 /* This function can GC */
217 casify_region (decode_buffer (buffer, 1), CASE_CAPITALIZE, b, e); 221 return casify_region (CASE_CAPITALIZE, b, e, buffer);
218 return Qnil;
219 } 222 }
220 223
221 /* Like Fcapitalize_region but change only the initials. */ 224 /* Like Fcapitalize_region but change only the initials. */
222 225
223 DEFUN ("upcase-initials-region", Fupcase_initials_region, 2, 3, "r", /* 226 DEFUN ("upcase-initials-region", Fupcase_initials_region, 2, 3, "r", /*
227 character positions to operate on. 230 character positions to operate on.
228 Optional third arg BUFFER defaults to the current buffer. 231 Optional third arg BUFFER defaults to the current buffer.
229 */ 232 */
230 (b, e, buffer)) 233 (b, e, buffer))
231 { 234 {
232 casify_region (decode_buffer (buffer, 1), CASE_CAPITALIZE_UP, b, e); 235 return casify_region (CASE_CAPITALIZE_UP, b, e, buffer);
233 return Qnil;
234 } 236 }
235 237
236 238
237 static Lisp_Object 239 static Lisp_Object
238 operate_on_word (struct buffer *buf, Lisp_Object arg, int *newpoint) 240 casify_word (enum case_action flag, Lisp_Object arg, Lisp_Object buffer)
239 { 241 {
240 Bufpos farend; 242 Bufpos farend;
243 struct buffer *buf = decode_buffer (buffer, 1);
241 244
242 CHECK_INT (arg); 245 CHECK_INT (arg);
246
243 farend = scan_words (buf, BUF_PT (buf), XINT (arg)); 247 farend = scan_words (buf, BUF_PT (buf), XINT (arg));
244 if (!farend) 248 if (!farend)
245 farend = XINT (arg) > 0 ? BUF_ZV (buf) : BUF_BEGV (buf); 249 farend = XINT (arg) > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
246 250
247 *newpoint = ((BUF_PT (buf) > farend) ? BUF_PT (buf) : farend); 251 casify_region_internal (flag, make_int (BUF_PT (buf)), make_int (farend), buf);
248 return (make_int (farend)); 252 BUF_SET_PT (buf, max (BUF_PT (buf), farend));
253 return Qnil;
249 } 254 }
250 255
251 DEFUN ("upcase-word", Fupcase_word, 1, 2, "p", /* 256 DEFUN ("upcase-word", Fupcase_word, 1, 2, "p", /*
252 Convert following word (or ARG words) to upper case, moving over. 257 Convert following word (or ARG words) to upper case, moving over.
253 With negative argument, convert previous words but do not move. 258 With negative argument, convert previous words but do not move.
255 Optional second arg BUFFER defaults to the current buffer. 260 Optional second arg BUFFER defaults to the current buffer.
256 */ 261 */
257 (arg, buffer)) 262 (arg, buffer))
258 { 263 {
259 /* This function can GC */ 264 /* This function can GC */
260 Lisp_Object beg, end; 265 return casify_word (CASE_UP, arg, buffer);
261 Bufpos newpoint;
262 struct buffer *buf = decode_buffer (buffer, 1);
263
264 beg = make_int (BUF_PT (buf));
265 end = operate_on_word (buf, arg, &newpoint);
266 casify_region (buf, CASE_UP, beg, end);
267 BUF_SET_PT (buf, newpoint);
268 return Qnil;
269 } 266 }
270 267
271 DEFUN ("downcase-word", Fdowncase_word, 1, 2, "p", /* 268 DEFUN ("downcase-word", Fdowncase_word, 1, 2, "p", /*
272 Convert following word (or ARG words) to lower case, moving over. 269 Convert following word (or ARG words) to lower case, moving over.
273 With negative argument, convert previous words but do not move. 270 With negative argument, convert previous words but do not move.
274 Optional second arg BUFFER defaults to the current buffer. 271 Optional second arg BUFFER defaults to the current buffer.
275 */ 272 */
276 (arg, buffer)) 273 (arg, buffer))
277 { 274 {
278 /* This function can GC */ 275 /* This function can GC */
279 Lisp_Object beg, end; 276 return casify_word (CASE_DOWN, arg, buffer);
280 Bufpos newpoint;
281 struct buffer *buf = decode_buffer (buffer, 1);
282
283 beg = make_int (BUF_PT (buf));
284 end = operate_on_word (buf, arg, &newpoint);
285 casify_region (buf, CASE_DOWN, beg, end);
286 BUF_SET_PT (buf, newpoint);
287 return Qnil;
288 } 277 }
289 278
290 DEFUN ("capitalize-word", Fcapitalize_word, 1, 2, "p", /* 279 DEFUN ("capitalize-word", Fcapitalize_word, 1, 2, "p", /*
291 Capitalize the following word (or ARG words), moving over. 280 Capitalize the following word (or ARG words), moving over.
292 This gives the word(s) a first character in upper case 281 This gives the word(s) a first character in upper case
295 Optional second arg BUFFER defaults to the current buffer. 284 Optional second arg BUFFER defaults to the current buffer.
296 */ 285 */
297 (arg, buffer)) 286 (arg, buffer))
298 { 287 {
299 /* This function can GC */ 288 /* This function can GC */
300 Lisp_Object beg, end; 289 return casify_word (CASE_CAPITALIZE, arg, buffer);
301 Bufpos newpoint;
302 struct buffer *buf = decode_buffer (buffer, 1);
303
304 beg = make_int (BUF_PT (buf));
305 end = operate_on_word (buf, arg, &newpoint);
306 casify_region (buf, CASE_CAPITALIZE, beg, end);
307 BUF_SET_PT (buf, newpoint);
308 return Qnil;
309 } 290 }
310 291
311 292
312 void 293 void
313 syms_of_casefiddle (void) 294 syms_of_casefiddle (void)